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
68 void syms_of_w32fns ();
69 void globals_of_w32fns ();
71 extern void free_frame_menubar ();
72 extern double atof ();
73 extern int w32_console_toggle_lock_key
P_ ((int, Lisp_Object
));
74 extern void w32_menu_display_help
P_ ((HWND
, HMENU
, UINT
, UINT
));
75 extern void w32_free_menu_strings
P_ ((HWND
));
77 extern XCharStruct
*w32_per_char_metric
P_ ((XFontStruct
*, wchar_t *, int));
82 extern char *lispy_function_keys
[];
84 /* The colormap for converting color names to RGB values */
85 Lisp_Object Vw32_color_map
;
87 /* Non nil if alt key presses are passed on to Windows. */
88 Lisp_Object Vw32_pass_alt_to_system
;
90 /* Non nil if alt key is translated to meta_modifier, nil if it is translated
92 Lisp_Object Vw32_alt_is_meta
;
94 /* If non-zero, the windows virtual key code for an alternative quit key. */
97 /* Non nil if left window key events are passed on to Windows (this only
98 affects whether "tapping" the key opens the Start menu). */
99 Lisp_Object Vw32_pass_lwindow_to_system
;
101 /* Non nil if right window key events are passed on to Windows (this
102 only affects whether "tapping" the key opens the Start menu). */
103 Lisp_Object Vw32_pass_rwindow_to_system
;
105 /* Virtual key code used to generate "phantom" key presses in order
106 to stop system from acting on Windows key events. */
107 Lisp_Object Vw32_phantom_key_code
;
109 /* Modifier associated with the left "Windows" key, or nil to act as a
111 Lisp_Object Vw32_lwindow_modifier
;
113 /* Modifier associated with the right "Windows" key, or nil to act as a
115 Lisp_Object Vw32_rwindow_modifier
;
117 /* Modifier associated with the "Apps" key, or nil to act as a normal
119 Lisp_Object Vw32_apps_modifier
;
121 /* Value is nil if Num Lock acts as a function key. */
122 Lisp_Object Vw32_enable_num_lock
;
124 /* Value is nil if Caps Lock acts as a function key. */
125 Lisp_Object Vw32_enable_caps_lock
;
127 /* Modifier associated with Scroll Lock, or nil to act as a normal key. */
128 Lisp_Object Vw32_scroll_lock_modifier
;
130 /* Switch to control whether we inhibit requests for synthesized bold
131 and italic versions of fonts. */
132 int w32_enable_synthesized_fonts
;
134 /* Enable palette management. */
135 Lisp_Object Vw32_enable_palette
;
137 /* Control how close left/right button down events must be to
138 be converted to a middle button down event. */
139 int w32_mouse_button_tolerance
;
141 /* Minimum interval between mouse movement (and scroll bar drag)
142 events that are passed on to the event loop. */
143 int w32_mouse_move_interval
;
145 /* Flag to indicate if XBUTTON events should be passed on to Windows. */
146 static int w32_pass_extra_mouse_buttons_to_system
;
148 /* Flag to indicate if media keys should be passed on to Windows. */
149 static int w32_pass_multimedia_buttons_to_system
;
151 /* Non nil if no window manager is in use. */
152 Lisp_Object Vx_no_window_manager
;
154 /* Non-zero means we're allowed to display a hourglass pointer. */
156 int display_hourglass_p
;
158 /* If non-zero, a w32 timer that, when it expires, displays an
159 hourglass cursor on all frames. */
160 static unsigned hourglass_timer
= 0;
161 static HWND hourglass_hwnd
= NULL
;
163 /* The background and shape of the mouse pointer, and shape when not
164 over text or in the modeline. */
166 Lisp_Object Vx_pointer_shape
, Vx_nontext_pointer_shape
, Vx_mode_pointer_shape
;
167 Lisp_Object Vx_hourglass_pointer_shape
, Vx_window_horizontal_drag_shape
;
169 /* The shape when over mouse-sensitive text. */
171 Lisp_Object Vx_sensitive_text_pointer_shape
;
174 #define IDC_HAND MAKEINTRESOURCE(32649)
177 /* Color of chars displayed in cursor box. */
179 Lisp_Object Vx_cursor_fore_pixel
;
181 /* Nonzero if using Windows. */
183 static int w32_in_use
;
185 /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
187 Lisp_Object Vx_pixel_size_width_font_regexp
;
189 /* Alist of bdf fonts and the files that define them. */
190 Lisp_Object Vw32_bdf_filename_alist
;
192 /* A flag to control whether fonts are matched strictly or not. */
193 static int w32_strict_fontnames
;
195 /* A flag to control whether we should only repaint if GetUpdateRect
196 indicates there is an update region. */
197 static int w32_strict_painting
;
199 /* Associative list linking character set strings to Windows codepages. */
200 static Lisp_Object Vw32_charset_info_alist
;
202 /* VIETNAMESE_CHARSET is not defined in some versions of MSVC. */
203 #ifndef VIETNAMESE_CHARSET
204 #define VIETNAMESE_CHARSET 163
208 Lisp_Object Qsuppress_icon
;
209 Lisp_Object Qundefined_color
;
210 Lisp_Object Qcancel_timer
;
216 Lisp_Object Qcontrol
;
219 Lisp_Object Qw32_charset_ansi
;
220 Lisp_Object Qw32_charset_default
;
221 Lisp_Object Qw32_charset_symbol
;
222 Lisp_Object Qw32_charset_shiftjis
;
223 Lisp_Object Qw32_charset_hangeul
;
224 Lisp_Object Qw32_charset_gb2312
;
225 Lisp_Object Qw32_charset_chinesebig5
;
226 Lisp_Object Qw32_charset_oem
;
228 #ifndef JOHAB_CHARSET
229 #define JOHAB_CHARSET 130
232 Lisp_Object Qw32_charset_easteurope
;
233 Lisp_Object Qw32_charset_turkish
;
234 Lisp_Object Qw32_charset_baltic
;
235 Lisp_Object Qw32_charset_russian
;
236 Lisp_Object Qw32_charset_arabic
;
237 Lisp_Object Qw32_charset_greek
;
238 Lisp_Object Qw32_charset_hebrew
;
239 Lisp_Object Qw32_charset_vietnamese
;
240 Lisp_Object Qw32_charset_thai
;
241 Lisp_Object Qw32_charset_johab
;
242 Lisp_Object Qw32_charset_mac
;
245 #ifdef UNICODE_CHARSET
246 Lisp_Object Qw32_charset_unicode
;
249 /* The ANSI codepage. */
250 int w32_ansi_code_page
;
252 /* Prefix for system colors. */
253 #define SYSTEM_COLOR_PREFIX "System"
254 #define SYSTEM_COLOR_PREFIX_LEN (sizeof (SYSTEM_COLOR_PREFIX) - 1)
256 /* State variables for emulating a three button mouse. */
261 static int button_state
= 0;
262 static W32Msg saved_mouse_button_msg
;
263 static unsigned mouse_button_timer
= 0; /* non-zero when timer is active */
264 static W32Msg saved_mouse_move_msg
;
265 static unsigned mouse_move_timer
= 0;
267 /* Window that is tracking the mouse. */
268 static HWND track_mouse_window
;
270 /* Multi-monitor API definitions that are not pulled from the headers
271 since we are compiling for NT 4. */
272 #ifndef MONITOR_DEFAULT_TO_NEAREST
273 #define MONITOR_DEFAULT_TO_NEAREST 2
275 /* MinGW headers define MONITORINFO unconditionally, but MSVC ones don't.
276 To avoid a compile error on one or the other, redefine with a new name. */
285 typedef BOOL (WINAPI
* TrackMouseEvent_Proc
)
286 (IN OUT LPTRACKMOUSEEVENT lpEventTrack
);
287 typedef LONG (WINAPI
* ImmGetCompositionString_Proc
)
288 (IN HIMC context
, IN DWORD index
, OUT LPVOID buffer
, IN DWORD bufLen
);
289 typedef HIMC (WINAPI
* ImmGetContext_Proc
) (IN HWND window
);
290 typedef HMONITOR (WINAPI
* MonitorFromPoint_Proc
) (IN POINT pt
, IN DWORD flags
);
291 typedef BOOL (WINAPI
* GetMonitorInfo_Proc
)
292 (IN HMONITOR monitor
, OUT
struct MONITOR_INFO
* info
);
294 TrackMouseEvent_Proc track_mouse_event_fn
= NULL
;
295 ClipboardSequence_Proc clipboard_sequence_fn
= NULL
;
296 ImmGetCompositionString_Proc get_composition_string_fn
= NULL
;
297 ImmGetContext_Proc get_ime_context_fn
= NULL
;
298 MonitorFromPoint_Proc monitor_from_point_fn
= NULL
;
299 GetMonitorInfo_Proc get_monitor_info_fn
= NULL
;
301 extern AppendMenuW_Proc unicode_append_menu
;
303 /* Flag to selectively ignore WM_IME_CHAR messages. */
304 static int ignore_ime_char
= 0;
306 /* W95 mousewheel handler */
307 unsigned int msh_mousewheel
= 0;
310 #define MOUSE_BUTTON_ID 1
311 #define MOUSE_MOVE_ID 2
312 #define MENU_FREE_ID 3
313 #define HOURGLASS_ID 4
314 /* The delay (milliseconds) before a menu is freed after WM_EXITMENULOOP
316 #define MENU_FREE_DELAY 1000
317 static unsigned menu_free_timer
= 0;
319 /* The below are defined in frame.c. */
321 extern Lisp_Object Vwindow_system_version
;
324 int image_cache_refcount
, dpyinfo_refcount
;
328 /* From w32term.c. */
329 extern int w32_num_mouse_buttons
;
330 extern Lisp_Object Vw32_recognize_altgr
;
332 extern HWND w32_system_caret_hwnd
;
334 extern int w32_system_caret_height
;
335 extern int w32_system_caret_x
;
336 extern int w32_system_caret_y
;
337 extern int w32_use_visible_system_caret
;
339 static HWND w32_visible_system_caret_hwnd
;
342 extern HMENU current_popup_menu
;
343 static int menubar_in_use
= 0;
345 /* From w32uniscribe.c */
346 extern void syms_of_w32uniscribe ();
347 extern int uniscribe_available
;
349 /* Function prototypes for hourglass support. */
350 static void show_hourglass
P_ ((struct frame
*));
351 static void hide_hourglass
P_ ((void));
355 /* Error if we are not connected to MS-Windows. */
360 error ("MS-Windows not in use or not initialized");
363 /* Nonzero if we can use mouse menus.
364 You should not call this unless HAVE_MENUS is defined. */
372 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
373 and checking validity for W32. */
376 check_x_frame (frame
)
382 frame
= selected_frame
;
383 CHECK_LIVE_FRAME (frame
);
385 if (! FRAME_W32_P (f
))
386 error ("Non-W32 frame used");
390 /* Let the user specify a display with a frame.
391 nil stands for the selected frame--or, if that is not a w32 frame,
392 the first display on the list. */
394 struct w32_display_info
*
395 check_x_display_info (frame
)
400 struct frame
*sf
= XFRAME (selected_frame
);
402 if (FRAME_W32_P (sf
) && FRAME_LIVE_P (sf
))
403 return FRAME_W32_DISPLAY_INFO (sf
);
405 return &one_w32_display_info
;
407 else if (STRINGP (frame
))
408 return x_display_info_for_name (frame
);
413 CHECK_LIVE_FRAME (frame
);
415 if (! FRAME_W32_P (f
))
416 error ("Non-W32 frame used");
417 return FRAME_W32_DISPLAY_INFO (f
);
421 /* Return the Emacs frame-object corresponding to an w32 window.
422 It could be the frame's main window or an icon window. */
424 /* This function can be called during GC, so use GC_xxx type test macros. */
427 x_window_to_frame (dpyinfo
, wdesc
)
428 struct w32_display_info
*dpyinfo
;
431 Lisp_Object tail
, frame
;
434 for (tail
= Vframe_list
; CONSP (tail
); tail
= XCDR (tail
))
440 if (!FRAME_W32_P (f
) || FRAME_W32_DISPLAY_INFO (f
) != dpyinfo
)
443 if (FRAME_W32_WINDOW (f
) == wdesc
)
450 static Lisp_Object unwind_create_frame
P_ ((Lisp_Object
));
451 static Lisp_Object unwind_create_tip_frame
P_ ((Lisp_Object
));
452 static void my_create_window
P_ ((struct frame
*));
453 static void my_create_tip_window
P_ ((struct frame
*));
455 /* TODO: Native Input Method support; see x_create_im. */
456 void x_set_foreground_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
457 void x_set_background_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
458 void x_set_mouse_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
459 void x_set_cursor_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
460 void x_set_border_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
461 void x_set_cursor_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
462 void x_set_icon_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
463 void x_set_icon_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
464 void x_explicitly_set_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
465 void x_set_menu_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
466 void x_set_title
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
467 void x_set_tool_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
468 static void x_edge_detection
P_ ((struct frame
*, struct image
*, Lisp_Object
,
474 /* Store the screen positions of frame F into XPTR and YPTR.
475 These are the positions of the containing window manager window,
476 not Emacs's own window. */
479 x_real_positions (f
, xptr
, yptr
)
486 /* Get the bounds of the WM window. */
487 GetWindowRect (FRAME_W32_WINDOW (f
), &rect
);
492 /* Convert (0, 0) in the client area to screen co-ordinates. */
493 ClientToScreen (FRAME_W32_WINDOW (f
), &pt
);
495 /* Remember x_pixels_diff and y_pixels_diff. */
496 f
->x_pixels_diff
= pt
.x
- rect
.left
;
497 f
->y_pixels_diff
= pt
.y
- rect
.top
;
505 DEFUN ("w32-define-rgb-color", Fw32_define_rgb_color
,
506 Sw32_define_rgb_color
, 4, 4, 0,
507 doc
: /* Convert RGB numbers to a Windows color reference and associate with NAME.
508 This adds or updates a named color to `w32-color-map', making it
509 available for use. The original entry's RGB ref is returned, or nil
510 if the entry is new. */)
511 (red
, green
, blue
, name
)
512 Lisp_Object red
, green
, blue
, name
;
515 Lisp_Object oldrgb
= Qnil
;
519 CHECK_NUMBER (green
);
523 XSETINT (rgb
, RGB (XUINT (red
), XUINT (green
), XUINT (blue
)));
527 /* replace existing entry in w32-color-map or add new entry. */
528 entry
= Fassoc (name
, Vw32_color_map
);
531 entry
= Fcons (name
, rgb
);
532 Vw32_color_map
= Fcons (entry
, Vw32_color_map
);
536 oldrgb
= Fcdr (entry
);
537 Fsetcdr (entry
, rgb
);
545 DEFUN ("w32-load-color-file", Fw32_load_color_file
,
546 Sw32_load_color_file
, 1, 1, 0,
547 doc
: /* Create an alist of color entries from an external file.
548 Assign this value to `w32-color-map' to replace the existing color map.
550 The file should define one named RGB color per line like so:
552 where R,G,B are numbers between 0 and 255 and name is an arbitrary string. */)
554 Lisp_Object filename
;
557 Lisp_Object cmap
= Qnil
;
560 CHECK_STRING (filename
);
561 abspath
= Fexpand_file_name (filename
, Qnil
);
563 fp
= fopen (SDATA (filename
), "rt");
567 int red
, green
, blue
;
572 while (fgets (buf
, sizeof (buf
), fp
) != NULL
) {
573 if (sscanf (buf
, "%u %u %u %n", &red
, &green
, &blue
, &num
) == 3)
575 char *name
= buf
+ num
;
576 num
= strlen (name
) - 1;
577 if (name
[num
] == '\n')
579 cmap
= Fcons (Fcons (build_string (name
),
580 make_number (RGB (red
, green
, blue
))),
592 /* The default colors for the w32 color map */
593 typedef struct colormap_t
599 colormap_t w32_color_map
[] =
601 {"snow" , PALETTERGB (255,250,250)},
602 {"ghost white" , PALETTERGB (248,248,255)},
603 {"GhostWhite" , PALETTERGB (248,248,255)},
604 {"white smoke" , PALETTERGB (245,245,245)},
605 {"WhiteSmoke" , PALETTERGB (245,245,245)},
606 {"gainsboro" , PALETTERGB (220,220,220)},
607 {"floral white" , PALETTERGB (255,250,240)},
608 {"FloralWhite" , PALETTERGB (255,250,240)},
609 {"old lace" , PALETTERGB (253,245,230)},
610 {"OldLace" , PALETTERGB (253,245,230)},
611 {"linen" , PALETTERGB (250,240,230)},
612 {"antique white" , PALETTERGB (250,235,215)},
613 {"AntiqueWhite" , PALETTERGB (250,235,215)},
614 {"papaya whip" , PALETTERGB (255,239,213)},
615 {"PapayaWhip" , PALETTERGB (255,239,213)},
616 {"blanched almond" , PALETTERGB (255,235,205)},
617 {"BlanchedAlmond" , PALETTERGB (255,235,205)},
618 {"bisque" , PALETTERGB (255,228,196)},
619 {"peach puff" , PALETTERGB (255,218,185)},
620 {"PeachPuff" , PALETTERGB (255,218,185)},
621 {"navajo white" , PALETTERGB (255,222,173)},
622 {"NavajoWhite" , PALETTERGB (255,222,173)},
623 {"moccasin" , PALETTERGB (255,228,181)},
624 {"cornsilk" , PALETTERGB (255,248,220)},
625 {"ivory" , PALETTERGB (255,255,240)},
626 {"lemon chiffon" , PALETTERGB (255,250,205)},
627 {"LemonChiffon" , PALETTERGB (255,250,205)},
628 {"seashell" , PALETTERGB (255,245,238)},
629 {"honeydew" , PALETTERGB (240,255,240)},
630 {"mint cream" , PALETTERGB (245,255,250)},
631 {"MintCream" , PALETTERGB (245,255,250)},
632 {"azure" , PALETTERGB (240,255,255)},
633 {"alice blue" , PALETTERGB (240,248,255)},
634 {"AliceBlue" , PALETTERGB (240,248,255)},
635 {"lavender" , PALETTERGB (230,230,250)},
636 {"lavender blush" , PALETTERGB (255,240,245)},
637 {"LavenderBlush" , PALETTERGB (255,240,245)},
638 {"misty rose" , PALETTERGB (255,228,225)},
639 {"MistyRose" , PALETTERGB (255,228,225)},
640 {"white" , PALETTERGB (255,255,255)},
641 {"black" , PALETTERGB ( 0, 0, 0)},
642 {"dark slate gray" , PALETTERGB ( 47, 79, 79)},
643 {"DarkSlateGray" , PALETTERGB ( 47, 79, 79)},
644 {"dark slate grey" , PALETTERGB ( 47, 79, 79)},
645 {"DarkSlateGrey" , PALETTERGB ( 47, 79, 79)},
646 {"dim gray" , PALETTERGB (105,105,105)},
647 {"DimGray" , PALETTERGB (105,105,105)},
648 {"dim grey" , PALETTERGB (105,105,105)},
649 {"DimGrey" , PALETTERGB (105,105,105)},
650 {"slate gray" , PALETTERGB (112,128,144)},
651 {"SlateGray" , PALETTERGB (112,128,144)},
652 {"slate grey" , PALETTERGB (112,128,144)},
653 {"SlateGrey" , PALETTERGB (112,128,144)},
654 {"light slate gray" , PALETTERGB (119,136,153)},
655 {"LightSlateGray" , PALETTERGB (119,136,153)},
656 {"light slate grey" , PALETTERGB (119,136,153)},
657 {"LightSlateGrey" , PALETTERGB (119,136,153)},
658 {"gray" , PALETTERGB (190,190,190)},
659 {"grey" , PALETTERGB (190,190,190)},
660 {"light grey" , PALETTERGB (211,211,211)},
661 {"LightGrey" , PALETTERGB (211,211,211)},
662 {"light gray" , PALETTERGB (211,211,211)},
663 {"LightGray" , PALETTERGB (211,211,211)},
664 {"midnight blue" , PALETTERGB ( 25, 25,112)},
665 {"MidnightBlue" , PALETTERGB ( 25, 25,112)},
666 {"navy" , PALETTERGB ( 0, 0,128)},
667 {"navy blue" , PALETTERGB ( 0, 0,128)},
668 {"NavyBlue" , PALETTERGB ( 0, 0,128)},
669 {"cornflower blue" , PALETTERGB (100,149,237)},
670 {"CornflowerBlue" , PALETTERGB (100,149,237)},
671 {"dark slate blue" , PALETTERGB ( 72, 61,139)},
672 {"DarkSlateBlue" , PALETTERGB ( 72, 61,139)},
673 {"slate blue" , PALETTERGB (106, 90,205)},
674 {"SlateBlue" , PALETTERGB (106, 90,205)},
675 {"medium slate blue" , PALETTERGB (123,104,238)},
676 {"MediumSlateBlue" , PALETTERGB (123,104,238)},
677 {"light slate blue" , PALETTERGB (132,112,255)},
678 {"LightSlateBlue" , PALETTERGB (132,112,255)},
679 {"medium blue" , PALETTERGB ( 0, 0,205)},
680 {"MediumBlue" , PALETTERGB ( 0, 0,205)},
681 {"royal blue" , PALETTERGB ( 65,105,225)},
682 {"RoyalBlue" , PALETTERGB ( 65,105,225)},
683 {"blue" , PALETTERGB ( 0, 0,255)},
684 {"dodger blue" , PALETTERGB ( 30,144,255)},
685 {"DodgerBlue" , PALETTERGB ( 30,144,255)},
686 {"deep sky blue" , PALETTERGB ( 0,191,255)},
687 {"DeepSkyBlue" , PALETTERGB ( 0,191,255)},
688 {"sky blue" , PALETTERGB (135,206,235)},
689 {"SkyBlue" , PALETTERGB (135,206,235)},
690 {"light sky blue" , PALETTERGB (135,206,250)},
691 {"LightSkyBlue" , PALETTERGB (135,206,250)},
692 {"steel blue" , PALETTERGB ( 70,130,180)},
693 {"SteelBlue" , PALETTERGB ( 70,130,180)},
694 {"light steel blue" , PALETTERGB (176,196,222)},
695 {"LightSteelBlue" , PALETTERGB (176,196,222)},
696 {"light blue" , PALETTERGB (173,216,230)},
697 {"LightBlue" , PALETTERGB (173,216,230)},
698 {"powder blue" , PALETTERGB (176,224,230)},
699 {"PowderBlue" , PALETTERGB (176,224,230)},
700 {"pale turquoise" , PALETTERGB (175,238,238)},
701 {"PaleTurquoise" , PALETTERGB (175,238,238)},
702 {"dark turquoise" , PALETTERGB ( 0,206,209)},
703 {"DarkTurquoise" , PALETTERGB ( 0,206,209)},
704 {"medium turquoise" , PALETTERGB ( 72,209,204)},
705 {"MediumTurquoise" , PALETTERGB ( 72,209,204)},
706 {"turquoise" , PALETTERGB ( 64,224,208)},
707 {"cyan" , PALETTERGB ( 0,255,255)},
708 {"light cyan" , PALETTERGB (224,255,255)},
709 {"LightCyan" , PALETTERGB (224,255,255)},
710 {"cadet blue" , PALETTERGB ( 95,158,160)},
711 {"CadetBlue" , PALETTERGB ( 95,158,160)},
712 {"medium aquamarine" , PALETTERGB (102,205,170)},
713 {"MediumAquamarine" , PALETTERGB (102,205,170)},
714 {"aquamarine" , PALETTERGB (127,255,212)},
715 {"dark green" , PALETTERGB ( 0,100, 0)},
716 {"DarkGreen" , PALETTERGB ( 0,100, 0)},
717 {"dark olive green" , PALETTERGB ( 85,107, 47)},
718 {"DarkOliveGreen" , PALETTERGB ( 85,107, 47)},
719 {"dark sea green" , PALETTERGB (143,188,143)},
720 {"DarkSeaGreen" , PALETTERGB (143,188,143)},
721 {"sea green" , PALETTERGB ( 46,139, 87)},
722 {"SeaGreen" , PALETTERGB ( 46,139, 87)},
723 {"medium sea green" , PALETTERGB ( 60,179,113)},
724 {"MediumSeaGreen" , PALETTERGB ( 60,179,113)},
725 {"light sea green" , PALETTERGB ( 32,178,170)},
726 {"LightSeaGreen" , PALETTERGB ( 32,178,170)},
727 {"pale green" , PALETTERGB (152,251,152)},
728 {"PaleGreen" , PALETTERGB (152,251,152)},
729 {"spring green" , PALETTERGB ( 0,255,127)},
730 {"SpringGreen" , PALETTERGB ( 0,255,127)},
731 {"lawn green" , PALETTERGB (124,252, 0)},
732 {"LawnGreen" , PALETTERGB (124,252, 0)},
733 {"green" , PALETTERGB ( 0,255, 0)},
734 {"chartreuse" , PALETTERGB (127,255, 0)},
735 {"medium spring green" , PALETTERGB ( 0,250,154)},
736 {"MediumSpringGreen" , PALETTERGB ( 0,250,154)},
737 {"green yellow" , PALETTERGB (173,255, 47)},
738 {"GreenYellow" , PALETTERGB (173,255, 47)},
739 {"lime green" , PALETTERGB ( 50,205, 50)},
740 {"LimeGreen" , PALETTERGB ( 50,205, 50)},
741 {"yellow green" , PALETTERGB (154,205, 50)},
742 {"YellowGreen" , PALETTERGB (154,205, 50)},
743 {"forest green" , PALETTERGB ( 34,139, 34)},
744 {"ForestGreen" , PALETTERGB ( 34,139, 34)},
745 {"olive drab" , PALETTERGB (107,142, 35)},
746 {"OliveDrab" , PALETTERGB (107,142, 35)},
747 {"dark khaki" , PALETTERGB (189,183,107)},
748 {"DarkKhaki" , PALETTERGB (189,183,107)},
749 {"khaki" , PALETTERGB (240,230,140)},
750 {"pale goldenrod" , PALETTERGB (238,232,170)},
751 {"PaleGoldenrod" , PALETTERGB (238,232,170)},
752 {"light goldenrod yellow" , PALETTERGB (250,250,210)},
753 {"LightGoldenrodYellow" , PALETTERGB (250,250,210)},
754 {"light yellow" , PALETTERGB (255,255,224)},
755 {"LightYellow" , PALETTERGB (255,255,224)},
756 {"yellow" , PALETTERGB (255,255, 0)},
757 {"gold" , PALETTERGB (255,215, 0)},
758 {"light goldenrod" , PALETTERGB (238,221,130)},
759 {"LightGoldenrod" , PALETTERGB (238,221,130)},
760 {"goldenrod" , PALETTERGB (218,165, 32)},
761 {"dark goldenrod" , PALETTERGB (184,134, 11)},
762 {"DarkGoldenrod" , PALETTERGB (184,134, 11)},
763 {"rosy brown" , PALETTERGB (188,143,143)},
764 {"RosyBrown" , PALETTERGB (188,143,143)},
765 {"indian red" , PALETTERGB (205, 92, 92)},
766 {"IndianRed" , PALETTERGB (205, 92, 92)},
767 {"saddle brown" , PALETTERGB (139, 69, 19)},
768 {"SaddleBrown" , PALETTERGB (139, 69, 19)},
769 {"sienna" , PALETTERGB (160, 82, 45)},
770 {"peru" , PALETTERGB (205,133, 63)},
771 {"burlywood" , PALETTERGB (222,184,135)},
772 {"beige" , PALETTERGB (245,245,220)},
773 {"wheat" , PALETTERGB (245,222,179)},
774 {"sandy brown" , PALETTERGB (244,164, 96)},
775 {"SandyBrown" , PALETTERGB (244,164, 96)},
776 {"tan" , PALETTERGB (210,180,140)},
777 {"chocolate" , PALETTERGB (210,105, 30)},
778 {"firebrick" , PALETTERGB (178,34, 34)},
779 {"brown" , PALETTERGB (165,42, 42)},
780 {"dark salmon" , PALETTERGB (233,150,122)},
781 {"DarkSalmon" , PALETTERGB (233,150,122)},
782 {"salmon" , PALETTERGB (250,128,114)},
783 {"light salmon" , PALETTERGB (255,160,122)},
784 {"LightSalmon" , PALETTERGB (255,160,122)},
785 {"orange" , PALETTERGB (255,165, 0)},
786 {"dark orange" , PALETTERGB (255,140, 0)},
787 {"DarkOrange" , PALETTERGB (255,140, 0)},
788 {"coral" , PALETTERGB (255,127, 80)},
789 {"light coral" , PALETTERGB (240,128,128)},
790 {"LightCoral" , PALETTERGB (240,128,128)},
791 {"tomato" , PALETTERGB (255, 99, 71)},
792 {"orange red" , PALETTERGB (255, 69, 0)},
793 {"OrangeRed" , PALETTERGB (255, 69, 0)},
794 {"red" , PALETTERGB (255, 0, 0)},
795 {"hot pink" , PALETTERGB (255,105,180)},
796 {"HotPink" , PALETTERGB (255,105,180)},
797 {"deep pink" , PALETTERGB (255, 20,147)},
798 {"DeepPink" , PALETTERGB (255, 20,147)},
799 {"pink" , PALETTERGB (255,192,203)},
800 {"light pink" , PALETTERGB (255,182,193)},
801 {"LightPink" , PALETTERGB (255,182,193)},
802 {"pale violet red" , PALETTERGB (219,112,147)},
803 {"PaleVioletRed" , PALETTERGB (219,112,147)},
804 {"maroon" , PALETTERGB (176, 48, 96)},
805 {"medium violet red" , PALETTERGB (199, 21,133)},
806 {"MediumVioletRed" , PALETTERGB (199, 21,133)},
807 {"violet red" , PALETTERGB (208, 32,144)},
808 {"VioletRed" , PALETTERGB (208, 32,144)},
809 {"magenta" , PALETTERGB (255, 0,255)},
810 {"violet" , PALETTERGB (238,130,238)},
811 {"plum" , PALETTERGB (221,160,221)},
812 {"orchid" , PALETTERGB (218,112,214)},
813 {"medium orchid" , PALETTERGB (186, 85,211)},
814 {"MediumOrchid" , PALETTERGB (186, 85,211)},
815 {"dark orchid" , PALETTERGB (153, 50,204)},
816 {"DarkOrchid" , PALETTERGB (153, 50,204)},
817 {"dark violet" , PALETTERGB (148, 0,211)},
818 {"DarkViolet" , PALETTERGB (148, 0,211)},
819 {"blue violet" , PALETTERGB (138, 43,226)},
820 {"BlueViolet" , PALETTERGB (138, 43,226)},
821 {"purple" , PALETTERGB (160, 32,240)},
822 {"medium purple" , PALETTERGB (147,112,219)},
823 {"MediumPurple" , PALETTERGB (147,112,219)},
824 {"thistle" , PALETTERGB (216,191,216)},
825 {"gray0" , PALETTERGB ( 0, 0, 0)},
826 {"grey0" , PALETTERGB ( 0, 0, 0)},
827 {"dark grey" , PALETTERGB (169,169,169)},
828 {"DarkGrey" , PALETTERGB (169,169,169)},
829 {"dark gray" , PALETTERGB (169,169,169)},
830 {"DarkGray" , PALETTERGB (169,169,169)},
831 {"dark blue" , PALETTERGB ( 0, 0,139)},
832 {"DarkBlue" , PALETTERGB ( 0, 0,139)},
833 {"dark cyan" , PALETTERGB ( 0,139,139)},
834 {"DarkCyan" , PALETTERGB ( 0,139,139)},
835 {"dark magenta" , PALETTERGB (139, 0,139)},
836 {"DarkMagenta" , PALETTERGB (139, 0,139)},
837 {"dark red" , PALETTERGB (139, 0, 0)},
838 {"DarkRed" , PALETTERGB (139, 0, 0)},
839 {"light green" , PALETTERGB (144,238,144)},
840 {"LightGreen" , PALETTERGB (144,238,144)},
843 DEFUN ("w32-default-color-map", Fw32_default_color_map
, Sw32_default_color_map
,
844 0, 0, 0, doc
: /* Return the default color map. */)
848 colormap_t
*pc
= w32_color_map
;
855 for (i
= 0; i
< sizeof (w32_color_map
) / sizeof (w32_color_map
[0]);
857 cmap
= Fcons (Fcons (build_string (pc
->name
),
858 make_number (pc
->colorref
)),
876 color
= Frassq (rgb
, Vw32_color_map
);
881 return (Fcar (color
));
887 w32_color_map_lookup (colorname
)
890 Lisp_Object tail
, ret
= Qnil
;
894 for (tail
= Vw32_color_map
; CONSP (tail
); tail
= XCDR (tail
))
896 register Lisp_Object elt
, tem
;
899 if (!CONSP (elt
)) continue;
903 if (lstrcmpi (SDATA (tem
), colorname
) == 0)
920 add_system_logical_colors_to_map (system_colors
)
921 Lisp_Object
*system_colors
;
925 /* Other registry operations are done with input blocked. */
928 /* Look for "Control Panel/Colors" under User and Machine registry
930 if (RegOpenKeyEx (HKEY_CURRENT_USER
, "Control Panel\\Colors", 0,
931 KEY_READ
, &colors_key
) == ERROR_SUCCESS
932 || RegOpenKeyEx (HKEY_LOCAL_MACHINE
, "Control Panel\\Colors", 0,
933 KEY_READ
, &colors_key
) == ERROR_SUCCESS
)
936 char color_buffer
[64];
937 char full_name_buffer
[MAX_PATH
+ SYSTEM_COLOR_PREFIX_LEN
];
939 DWORD name_size
, color_size
;
940 char *name_buffer
= full_name_buffer
+ SYSTEM_COLOR_PREFIX_LEN
;
942 name_size
= sizeof (full_name_buffer
) - SYSTEM_COLOR_PREFIX_LEN
;
943 color_size
= sizeof (color_buffer
);
945 strcpy (full_name_buffer
, SYSTEM_COLOR_PREFIX
);
947 while (RegEnumValueA (colors_key
, index
, name_buffer
, &name_size
,
948 NULL
, NULL
, color_buffer
, &color_size
)
952 if (sscanf (color_buffer
, " %u %u %u", &r
, &g
, &b
) == 3)
953 *system_colors
= Fcons (Fcons (build_string (full_name_buffer
),
954 make_number (RGB (r
, g
, b
))),
957 name_size
= sizeof (full_name_buffer
) - SYSTEM_COLOR_PREFIX_LEN
;
958 color_size
= sizeof (color_buffer
);
961 RegCloseKey (colors_key
);
969 x_to_w32_color (colorname
)
972 register Lisp_Object ret
= Qnil
;
976 if (colorname
[0] == '#')
978 /* Could be an old-style RGB Device specification. */
981 color
= colorname
+ 1;
983 size
= strlen (color
);
984 if (size
== 3 || size
== 6 || size
== 9 || size
== 12)
992 for (i
= 0; i
< 3; i
++)
998 /* The check for 'x' in the following conditional takes into
999 account the fact that strtol allows a "0x" in front of
1000 our numbers, and we don't. */
1001 if (!isxdigit (color
[0]) || color
[1] == 'x')
1005 value
= strtoul (color
, &end
, 16);
1007 if (errno
== ERANGE
|| end
- color
!= size
)
1012 value
= value
* 0x10;
1023 colorval
|= (value
<< pos
);
1028 XSETINT (ret
, colorval
);
1035 else if (strnicmp (colorname
, "rgb:", 4) == 0)
1043 color
= colorname
+ 4;
1044 for (i
= 0; i
< 3; i
++)
1047 unsigned long value
;
1049 /* The check for 'x' in the following conditional takes into
1050 account the fact that strtol allows a "0x" in front of
1051 our numbers, and we don't. */
1052 if (!isxdigit (color
[0]) || color
[1] == 'x')
1054 value
= strtoul (color
, &end
, 16);
1055 if (errno
== ERANGE
)
1057 switch (end
- color
)
1060 value
= value
* 0x10 + value
;
1073 if (value
== ULONG_MAX
)
1075 colorval
|= (value
<< pos
);
1082 XSETINT (ret
, colorval
);
1090 else if (strnicmp (colorname
, "rgbi:", 5) == 0)
1092 /* This is an RGB Intensity specification. */
1099 color
= colorname
+ 5;
1100 for (i
= 0; i
< 3; i
++)
1106 value
= strtod (color
, &end
);
1107 if (errno
== ERANGE
)
1109 if (value
< 0.0 || value
> 1.0)
1111 val
= (UINT
)(0x100 * value
);
1112 /* We used 0x100 instead of 0xFF to give a continuous
1113 range between 0.0 and 1.0 inclusive. The next statement
1114 fixes the 1.0 case. */
1117 colorval
|= (val
<< pos
);
1124 XSETINT (ret
, colorval
);
1132 /* I am not going to attempt to handle any of the CIE color schemes
1133 or TekHVC, since I don't know the algorithms for conversion to
1136 /* If we fail to lookup the color name in w32_color_map, then check the
1137 colorname to see if it can be crudely approximated: If the X color
1138 ends in a number (e.g., "darkseagreen2"), strip the number and
1139 return the result of looking up the base color name. */
1140 ret
= w32_color_map_lookup (colorname
);
1143 int len
= strlen (colorname
);
1145 if (isdigit (colorname
[len
- 1]))
1147 char *ptr
, *approx
= alloca (len
+ 1);
1149 strcpy (approx
, colorname
);
1150 ptr
= &approx
[len
- 1];
1151 while (ptr
> approx
&& isdigit (*ptr
))
1154 ret
= w32_color_map_lookup (approx
);
1163 w32_regenerate_palette (FRAME_PTR f
)
1165 struct w32_palette_entry
* list
;
1166 LOGPALETTE
* log_palette
;
1167 HPALETTE new_palette
;
1170 /* don't bother trying to create palette if not supported */
1171 if (! FRAME_W32_DISPLAY_INFO (f
)->has_palette
)
1174 log_palette
= (LOGPALETTE
*)
1175 alloca (sizeof (LOGPALETTE
) +
1176 FRAME_W32_DISPLAY_INFO (f
)->num_colors
* sizeof (PALETTEENTRY
));
1177 log_palette
->palVersion
= 0x300;
1178 log_palette
->palNumEntries
= FRAME_W32_DISPLAY_INFO (f
)->num_colors
;
1180 list
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1182 i
< FRAME_W32_DISPLAY_INFO (f
)->num_colors
;
1183 i
++, list
= list
->next
)
1184 log_palette
->palPalEntry
[i
] = list
->entry
;
1186 new_palette
= CreatePalette (log_palette
);
1190 if (FRAME_W32_DISPLAY_INFO (f
)->palette
)
1191 DeleteObject (FRAME_W32_DISPLAY_INFO (f
)->palette
);
1192 FRAME_W32_DISPLAY_INFO (f
)->palette
= new_palette
;
1194 /* Realize display palette and garbage all frames. */
1195 release_frame_dc (f
, get_frame_dc (f
));
1200 #define W32_COLOR(pe) RGB (pe.peRed, pe.peGreen, pe.peBlue)
1201 #define SET_W32_COLOR(pe, color) \
1204 pe.peRed = GetRValue (color); \
1205 pe.peGreen = GetGValue (color); \
1206 pe.peBlue = GetBValue (color); \
1211 /* Keep these around in case we ever want to track color usage. */
1213 w32_map_color (FRAME_PTR f
, COLORREF color
)
1215 struct w32_palette_entry
* list
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1217 if (NILP (Vw32_enable_palette
))
1220 /* check if color is already mapped */
1223 if (W32_COLOR (list
->entry
) == color
)
1231 /* not already mapped, so add to list and recreate Windows palette */
1232 list
= (struct w32_palette_entry
*)
1233 xmalloc (sizeof (struct w32_palette_entry
));
1234 SET_W32_COLOR (list
->entry
, color
);
1236 list
->next
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1237 FRAME_W32_DISPLAY_INFO (f
)->color_list
= list
;
1238 FRAME_W32_DISPLAY_INFO (f
)->num_colors
++;
1240 /* set flag that palette must be regenerated */
1241 FRAME_W32_DISPLAY_INFO (f
)->regen_palette
= TRUE
;
1245 w32_unmap_color (FRAME_PTR f
, COLORREF color
)
1247 struct w32_palette_entry
* list
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1248 struct w32_palette_entry
**prev
= &FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1250 if (NILP (Vw32_enable_palette
))
1253 /* check if color is already mapped */
1256 if (W32_COLOR (list
->entry
) == color
)
1258 if (--list
->refcount
== 0)
1262 FRAME_W32_DISPLAY_INFO (f
)->num_colors
--;
1272 /* set flag that palette must be regenerated */
1273 FRAME_W32_DISPLAY_INFO (f
)->regen_palette
= TRUE
;
1278 /* Gamma-correct COLOR on frame F. */
1281 gamma_correct (f
, color
)
1287 *color
= PALETTERGB (
1288 pow (GetRValue (*color
) / 255.0, f
->gamma
) * 255.0 + 0.5,
1289 pow (GetGValue (*color
) / 255.0, f
->gamma
) * 255.0 + 0.5,
1290 pow (GetBValue (*color
) / 255.0, f
->gamma
) * 255.0 + 0.5);
1295 /* Decide if color named COLOR is valid for the display associated with
1296 the selected frame; if so, return the rgb values in COLOR_DEF.
1297 If ALLOC is nonzero, allocate a new colormap cell. */
1300 w32_defined_color (f
, color
, color_def
, alloc
)
1306 register Lisp_Object tem
;
1307 COLORREF w32_color_ref
;
1309 tem
= x_to_w32_color (color
);
1315 /* Apply gamma correction. */
1316 w32_color_ref
= XUINT (tem
);
1317 gamma_correct (f
, &w32_color_ref
);
1318 XSETINT (tem
, w32_color_ref
);
1321 /* Map this color to the palette if it is enabled. */
1322 if (!NILP (Vw32_enable_palette
))
1324 struct w32_palette_entry
* entry
=
1325 one_w32_display_info
.color_list
;
1326 struct w32_palette_entry
** prev
=
1327 &one_w32_display_info
.color_list
;
1329 /* check if color is already mapped */
1332 if (W32_COLOR (entry
->entry
) == XUINT (tem
))
1334 prev
= &entry
->next
;
1335 entry
= entry
->next
;
1338 if (entry
== NULL
&& alloc
)
1340 /* not already mapped, so add to list */
1341 entry
= (struct w32_palette_entry
*)
1342 xmalloc (sizeof (struct w32_palette_entry
));
1343 SET_W32_COLOR (entry
->entry
, XUINT (tem
));
1346 one_w32_display_info
.num_colors
++;
1348 /* set flag that palette must be regenerated */
1349 one_w32_display_info
.regen_palette
= TRUE
;
1352 /* Ensure COLORREF value is snapped to nearest color in (default)
1353 palette by simulating the PALETTERGB macro. This works whether
1354 or not the display device has a palette. */
1355 w32_color_ref
= XUINT (tem
) | 0x2000000;
1357 color_def
->pixel
= w32_color_ref
;
1358 color_def
->red
= GetRValue (w32_color_ref
) * 256;
1359 color_def
->green
= GetGValue (w32_color_ref
) * 256;
1360 color_def
->blue
= GetBValue (w32_color_ref
) * 256;
1370 /* Given a string ARG naming a color, compute a pixel value from it
1371 suitable for screen F.
1372 If F is not a color screen, return DEF (default) regardless of what
1376 x_decode_color (f
, arg
, def
)
1385 if (strcmp (SDATA (arg
), "black") == 0)
1386 return BLACK_PIX_DEFAULT (f
);
1387 else if (strcmp (SDATA (arg
), "white") == 0)
1388 return WHITE_PIX_DEFAULT (f
);
1390 if ((FRAME_W32_DISPLAY_INFO (f
)->n_planes
* FRAME_W32_DISPLAY_INFO (f
)->n_cbits
) == 1)
1393 /* w32_defined_color is responsible for coping with failures
1394 by looking for a near-miss. */
1395 if (w32_defined_color (f
, SDATA (arg
), &cdef
, 1))
1398 /* defined_color failed; return an ultimate default. */
1404 /* Functions called only from `x_set_frame_param'
1405 to set individual parameters.
1407 If FRAME_W32_WINDOW (f) is 0,
1408 the frame is being created and its window does not exist yet.
1409 In that case, just record the parameter's new value
1410 in the standard place; do not attempt to change the window. */
1413 x_set_foreground_color (f
, arg
, oldval
)
1415 Lisp_Object arg
, oldval
;
1417 struct w32_output
*x
= f
->output_data
.w32
;
1418 PIX_TYPE fg
, old_fg
;
1420 fg
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1421 old_fg
= FRAME_FOREGROUND_PIXEL (f
);
1422 FRAME_FOREGROUND_PIXEL (f
) = fg
;
1424 if (FRAME_W32_WINDOW (f
) != 0)
1426 if (x
->cursor_pixel
== old_fg
)
1427 x
->cursor_pixel
= fg
;
1429 update_face_from_frame_parameter (f
, Qforeground_color
, arg
);
1430 if (FRAME_VISIBLE_P (f
))
1436 x_set_background_color (f
, arg
, oldval
)
1438 Lisp_Object arg
, oldval
;
1440 FRAME_BACKGROUND_PIXEL (f
)
1441 = x_decode_color (f
, arg
, WHITE_PIX_DEFAULT (f
));
1443 if (FRAME_W32_WINDOW (f
) != 0)
1445 SetWindowLong (FRAME_W32_WINDOW (f
), WND_BACKGROUND_INDEX
,
1446 FRAME_BACKGROUND_PIXEL (f
));
1448 update_face_from_frame_parameter (f
, Qbackground_color
, arg
);
1450 if (FRAME_VISIBLE_P (f
))
1456 x_set_mouse_color (f
, arg
, oldval
)
1458 Lisp_Object arg
, oldval
;
1460 Cursor cursor
, nontext_cursor
, mode_cursor
, hand_cursor
;
1464 if (!EQ (Qnil
, arg
))
1465 f
->output_data
.w32
->mouse_pixel
1466 = x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1467 mask_color
= FRAME_BACKGROUND_PIXEL (f
);
1469 /* Don't let pointers be invisible. */
1470 if (mask_color
== f
->output_data
.w32
->mouse_pixel
1471 && mask_color
== FRAME_BACKGROUND_PIXEL (f
))
1472 f
->output_data
.w32
->mouse_pixel
= FRAME_FOREGROUND_PIXEL (f
);
1474 #if 0 /* TODO : cursor changes */
1477 /* It's not okay to crash if the user selects a screwy cursor. */
1478 count
= x_catch_errors (FRAME_W32_DISPLAY (f
));
1480 if (!EQ (Qnil
, Vx_pointer_shape
))
1482 CHECK_NUMBER (Vx_pointer_shape
);
1483 cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XINT (Vx_pointer_shape
));
1486 cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_xterm
);
1487 x_check_errors (FRAME_W32_DISPLAY (f
), "bad text pointer cursor: %s");
1489 if (!EQ (Qnil
, Vx_nontext_pointer_shape
))
1491 CHECK_NUMBER (Vx_nontext_pointer_shape
);
1492 nontext_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
),
1493 XINT (Vx_nontext_pointer_shape
));
1496 nontext_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_left_ptr
);
1497 x_check_errors (FRAME_W32_DISPLAY (f
), "bad nontext pointer cursor: %s");
1499 if (!EQ (Qnil
, Vx_hourglass_pointer_shape
))
1501 CHECK_NUMBER (Vx_hourglass_pointer_shape
);
1502 hourglass_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
),
1503 XINT (Vx_hourglass_pointer_shape
));
1506 hourglass_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_watch
);
1507 x_check_errors (FRAME_W32_DISPLAY (f
), "bad busy pointer cursor: %s");
1509 x_check_errors (FRAME_W32_DISPLAY (f
), "bad nontext pointer cursor: %s");
1510 if (!EQ (Qnil
, Vx_mode_pointer_shape
))
1512 CHECK_NUMBER (Vx_mode_pointer_shape
);
1513 mode_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
),
1514 XINT (Vx_mode_pointer_shape
));
1517 mode_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_xterm
);
1518 x_check_errors (FRAME_W32_DISPLAY (f
), "bad modeline pointer cursor: %s");
1520 if (!EQ (Qnil
, Vx_sensitive_text_pointer_shape
))
1522 CHECK_NUMBER (Vx_sensitive_text_pointer_shape
);
1524 = XCreateFontCursor (FRAME_W32_DISPLAY (f
),
1525 XINT (Vx_sensitive_text_pointer_shape
));
1528 hand_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_crosshair
);
1530 if (!NILP (Vx_window_horizontal_drag_shape
))
1532 CHECK_NUMBER (Vx_window_horizontal_drag_shape
);
1533 horizontal_drag_cursor
1534 = XCreateFontCursor (FRAME_X_DISPLAY (f
),
1535 XINT (Vx_window_horizontal_drag_shape
));
1538 horizontal_drag_cursor
1539 = XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_sb_h_double_arrow
);
1541 /* Check and report errors with the above calls. */
1542 x_check_errors (FRAME_W32_DISPLAY (f
), "can't set cursor shape: %s");
1543 x_uncatch_errors (FRAME_W32_DISPLAY (f
), count
);
1546 XColor fore_color
, back_color
;
1548 fore_color
.pixel
= f
->output_data
.w32
->mouse_pixel
;
1549 back_color
.pixel
= mask_color
;
1550 XQueryColor (FRAME_W32_DISPLAY (f
),
1551 DefaultColormap (FRAME_W32_DISPLAY (f
),
1552 DefaultScreen (FRAME_W32_DISPLAY (f
))),
1554 XQueryColor (FRAME_W32_DISPLAY (f
),
1555 DefaultColormap (FRAME_W32_DISPLAY (f
),
1556 DefaultScreen (FRAME_W32_DISPLAY (f
))),
1558 XRecolorCursor (FRAME_W32_DISPLAY (f
), cursor
,
1559 &fore_color
, &back_color
);
1560 XRecolorCursor (FRAME_W32_DISPLAY (f
), nontext_cursor
,
1561 &fore_color
, &back_color
);
1562 XRecolorCursor (FRAME_W32_DISPLAY (f
), mode_cursor
,
1563 &fore_color
, &back_color
);
1564 XRecolorCursor (FRAME_W32_DISPLAY (f
), hand_cursor
,
1565 &fore_color
, &back_color
);
1566 XRecolorCursor (FRAME_W32_DISPLAY (f
), hourglass_cursor
,
1567 &fore_color
, &back_color
);
1570 if (FRAME_W32_WINDOW (f
) != 0)
1571 XDefineCursor (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
), cursor
);
1573 if (cursor
!= f
->output_data
.w32
->text_cursor
&& f
->output_data
.w32
->text_cursor
!= 0)
1574 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->text_cursor
);
1575 f
->output_data
.w32
->text_cursor
= cursor
;
1577 if (nontext_cursor
!= f
->output_data
.w32
->nontext_cursor
1578 && f
->output_data
.w32
->nontext_cursor
!= 0)
1579 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->nontext_cursor
);
1580 f
->output_data
.w32
->nontext_cursor
= nontext_cursor
;
1582 if (hourglass_cursor
!= f
->output_data
.w32
->hourglass_cursor
1583 && f
->output_data
.w32
->hourglass_cursor
!= 0)
1584 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->hourglass_cursor
);
1585 f
->output_data
.w32
->hourglass_cursor
= hourglass_cursor
;
1587 if (mode_cursor
!= f
->output_data
.w32
->modeline_cursor
1588 && f
->output_data
.w32
->modeline_cursor
!= 0)
1589 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->modeline_cursor
);
1590 f
->output_data
.w32
->modeline_cursor
= mode_cursor
;
1592 if (hand_cursor
!= f
->output_data
.w32
->hand_cursor
1593 && f
->output_data
.w32
->hand_cursor
!= 0)
1594 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->hand_cursor
);
1595 f
->output_data
.w32
->hand_cursor
= hand_cursor
;
1597 XFlush (FRAME_W32_DISPLAY (f
));
1600 update_face_from_frame_parameter (f
, Qmouse_color
, arg
);
1605 x_set_cursor_color (f
, arg
, oldval
)
1607 Lisp_Object arg
, oldval
;
1609 unsigned long fore_pixel
, pixel
;
1611 if (!NILP (Vx_cursor_fore_pixel
))
1612 fore_pixel
= x_decode_color (f
, Vx_cursor_fore_pixel
,
1613 WHITE_PIX_DEFAULT (f
));
1615 fore_pixel
= FRAME_BACKGROUND_PIXEL (f
);
1617 pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1619 /* Make sure that the cursor color differs from the background color. */
1620 if (pixel
== FRAME_BACKGROUND_PIXEL (f
))
1622 pixel
= f
->output_data
.w32
->mouse_pixel
;
1623 if (pixel
== fore_pixel
)
1624 fore_pixel
= FRAME_BACKGROUND_PIXEL (f
);
1627 f
->output_data
.w32
->cursor_foreground_pixel
= fore_pixel
;
1628 f
->output_data
.w32
->cursor_pixel
= pixel
;
1630 if (FRAME_W32_WINDOW (f
) != 0)
1633 /* Update frame's cursor_gc. */
1634 f
->output_data
.w32
->cursor_gc
->foreground
= fore_pixel
;
1635 f
->output_data
.w32
->cursor_gc
->background
= pixel
;
1639 if (FRAME_VISIBLE_P (f
))
1641 x_update_cursor (f
, 0);
1642 x_update_cursor (f
, 1);
1646 update_face_from_frame_parameter (f
, Qcursor_color
, arg
);
1649 /* Set the border-color of frame F to pixel value PIX.
1650 Note that this does not fully take effect if done before
1654 x_set_border_pixel (f
, pix
)
1659 f
->output_data
.w32
->border_pixel
= pix
;
1661 if (FRAME_W32_WINDOW (f
) != 0 && f
->border_width
> 0)
1663 if (FRAME_VISIBLE_P (f
))
1668 /* Set the border-color of frame F to value described by ARG.
1669 ARG can be a string naming a color.
1670 The border-color is used for the border that is drawn by the server.
1671 Note that this does not fully take effect if done before
1672 F has a window; it must be redone when the window is created. */
1675 x_set_border_color (f
, arg
, oldval
)
1677 Lisp_Object arg
, oldval
;
1682 pix
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1683 x_set_border_pixel (f
, pix
);
1684 update_face_from_frame_parameter (f
, Qborder_color
, arg
);
1689 x_set_cursor_type (f
, arg
, oldval
)
1691 Lisp_Object arg
, oldval
;
1693 set_frame_cursor_types (f
, arg
);
1695 /* Make sure the cursor gets redrawn. */
1696 cursor_type_changed
= 1;
1700 x_set_icon_type (f
, arg
, oldval
)
1702 Lisp_Object arg
, oldval
;
1706 if (NILP (arg
) && NILP (oldval
))
1709 if (STRINGP (arg
) && STRINGP (oldval
)
1710 && EQ (Fstring_equal (oldval
, arg
), Qt
))
1713 if (SYMBOLP (arg
) && SYMBOLP (oldval
) && EQ (arg
, oldval
))
1718 result
= x_bitmap_icon (f
, arg
);
1722 error ("No icon window available");
1729 x_set_icon_name (f
, arg
, oldval
)
1731 Lisp_Object arg
, oldval
;
1735 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1738 else if (!NILP (arg
) || NILP (oldval
))
1744 if (f
->output_data
.w32
->icon_bitmap
!= 0)
1749 result
= x_text_icon (f
,
1750 (char *) SDATA ((!NILP (f
->icon_name
)
1759 error ("No icon window available");
1762 /* If the window was unmapped (and its icon was mapped),
1763 the new icon is not mapped, so map the window in its stead. */
1764 if (FRAME_VISIBLE_P (f
))
1766 #ifdef USE_X_TOOLKIT
1767 XtPopup (f
->output_data
.w32
->widget
, XtGrabNone
);
1769 XMapWindow (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
));
1772 XFlush (FRAME_W32_DISPLAY (f
));
1779 x_set_menu_bar_lines (f
, value
, oldval
)
1781 Lisp_Object value
, oldval
;
1784 int olines
= FRAME_MENU_BAR_LINES (f
);
1786 /* Right now, menu bars don't work properly in minibuf-only frames;
1787 most of the commands try to apply themselves to the minibuffer
1788 frame itself, and get an error because you can't switch buffers
1789 in or split the minibuffer window. */
1790 if (FRAME_MINIBUF_ONLY_P (f
))
1793 if (INTEGERP (value
))
1794 nlines
= XINT (value
);
1798 FRAME_MENU_BAR_LINES (f
) = 0;
1800 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
1803 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
1804 free_frame_menubar (f
);
1805 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
1807 /* Adjust the frame size so that the client (text) dimensions
1808 remain the same. This depends on FRAME_EXTERNAL_MENU_BAR being
1810 x_set_window_size (f
, 0, FRAME_COLS (f
), FRAME_LINES (f
));
1811 do_pending_window_change (0);
1817 /* Set the number of lines used for the tool bar of frame F to VALUE.
1818 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
1819 is the old number of tool bar lines. This function changes the
1820 height of all windows on frame F to match the new tool bar height.
1821 The frame's height doesn't change. */
1824 x_set_tool_bar_lines (f
, value
, oldval
)
1826 Lisp_Object value
, oldval
;
1828 int delta
, nlines
, root_height
;
1829 Lisp_Object root_window
;
1831 /* Treat tool bars like menu bars. */
1832 if (FRAME_MINIBUF_ONLY_P (f
))
1835 /* Use VALUE only if an integer >= 0. */
1836 if (INTEGERP (value
) && XINT (value
) >= 0)
1837 nlines
= XFASTINT (value
);
1841 /* Make sure we redisplay all windows in this frame. */
1842 ++windows_or_buffers_changed
;
1844 delta
= nlines
- FRAME_TOOL_BAR_LINES (f
);
1846 /* Don't resize the tool-bar to more than we have room for. */
1847 root_window
= FRAME_ROOT_WINDOW (f
);
1848 root_height
= WINDOW_TOTAL_LINES (XWINDOW (root_window
));
1849 if (root_height
- delta
< 1)
1851 delta
= root_height
- 1;
1852 nlines
= FRAME_TOOL_BAR_LINES (f
) + delta
;
1855 FRAME_TOOL_BAR_LINES (f
) = nlines
;
1856 change_window_heights (root_window
, delta
);
1859 /* We also have to make sure that the internal border at the top of
1860 the frame, below the menu bar or tool bar, is redrawn when the
1861 tool bar disappears. This is so because the internal border is
1862 below the tool bar if one is displayed, but is below the menu bar
1863 if there isn't a tool bar. The tool bar draws into the area
1864 below the menu bar. */
1865 if (FRAME_W32_WINDOW (f
) && FRAME_TOOL_BAR_LINES (f
) == 0)
1868 clear_current_matrices (f
);
1871 /* If the tool bar gets smaller, the internal border below it
1872 has to be cleared. It was formerly part of the display
1873 of the larger tool bar, and updating windows won't clear it. */
1876 int height
= FRAME_INTERNAL_BORDER_WIDTH (f
);
1877 int width
= FRAME_PIXEL_WIDTH (f
);
1878 int y
= nlines
* FRAME_LINE_HEIGHT (f
);
1882 HDC hdc
= get_frame_dc (f
);
1883 w32_clear_area (f
, hdc
, 0, y
, width
, height
);
1884 release_frame_dc (f
, hdc
);
1888 if (WINDOWP (f
->tool_bar_window
))
1889 clear_glyph_matrix (XWINDOW (f
->tool_bar_window
)->current_matrix
);
1894 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
1897 If EXPLICIT is non-zero, that indicates that lisp code is setting the
1898 name; if NAME is a string, set F's name to NAME and set
1899 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
1901 If EXPLICIT is zero, that indicates that Emacs redisplay code is
1902 suggesting a new name, which lisp code should override; if
1903 F->explicit_name is set, ignore the new name; otherwise, set it. */
1906 x_set_name (f
, name
, explicit)
1911 /* Make sure that requests from lisp code override requests from
1912 Emacs redisplay code. */
1915 /* If we're switching from explicit to implicit, we had better
1916 update the mode lines and thereby update the title. */
1917 if (f
->explicit_name
&& NILP (name
))
1918 update_mode_lines
= 1;
1920 f
->explicit_name
= ! NILP (name
);
1922 else if (f
->explicit_name
)
1925 /* If NAME is nil, set the name to the w32_id_name. */
1928 /* Check for no change needed in this very common case
1929 before we do any consing. */
1930 if (!strcmp (FRAME_W32_DISPLAY_INFO (f
)->w32_id_name
,
1933 name
= build_string (FRAME_W32_DISPLAY_INFO (f
)->w32_id_name
);
1936 CHECK_STRING (name
);
1938 /* Don't change the name if it's already NAME. */
1939 if (! NILP (Fstring_equal (name
, f
->name
)))
1944 /* For setting the frame title, the title parameter should override
1945 the name parameter. */
1946 if (! NILP (f
->title
))
1949 if (FRAME_W32_WINDOW (f
))
1951 if (STRING_MULTIBYTE (name
))
1952 name
= ENCODE_SYSTEM (name
);
1955 SetWindowText (FRAME_W32_WINDOW (f
), SDATA (name
));
1960 /* This function should be called when the user's lisp code has
1961 specified a name for the frame; the name will override any set by the
1964 x_explicitly_set_name (f
, arg
, oldval
)
1966 Lisp_Object arg
, oldval
;
1968 x_set_name (f
, arg
, 1);
1971 /* This function should be called by Emacs redisplay code to set the
1972 name; names set this way will never override names set by the user's
1975 x_implicitly_set_name (f
, arg
, oldval
)
1977 Lisp_Object arg
, oldval
;
1979 x_set_name (f
, arg
, 0);
1982 /* Change the title of frame F to NAME.
1983 If NAME is nil, use the frame name as the title. */
1986 x_set_title (f
, name
, old_name
)
1988 Lisp_Object name
, old_name
;
1990 /* Don't change the title if it's already NAME. */
1991 if (EQ (name
, f
->title
))
1994 update_mode_lines
= 1;
2001 if (FRAME_W32_WINDOW (f
))
2003 if (STRING_MULTIBYTE (name
))
2004 name
= ENCODE_SYSTEM (name
);
2007 SetWindowText (FRAME_W32_WINDOW (f
), SDATA (name
));
2013 void x_set_scroll_bar_default_width (f
)
2016 int wid
= FRAME_COLUMN_WIDTH (f
);
2018 FRAME_CONFIG_SCROLL_BAR_WIDTH (f
) = GetSystemMetrics (SM_CXVSCROLL
);
2019 FRAME_CONFIG_SCROLL_BAR_COLS (f
) = (FRAME_CONFIG_SCROLL_BAR_WIDTH (f
) +
2024 /* Subroutines of creating a frame. */
2027 /* Return the value of parameter PARAM.
2029 First search ALIST, then Vdefault_frame_alist, then the X defaults
2030 database, using ATTRIBUTE as the attribute name and CLASS as its class.
2032 Convert the resource to the type specified by desired_type.
2034 If no default is specified, return Qunbound. If you call
2035 w32_get_arg, make sure you deal with Qunbound in a reasonable way,
2036 and don't let it get stored in any Lisp-visible variables! */
2039 w32_get_arg (alist
, param
, attribute
, class, type
)
2040 Lisp_Object alist
, param
;
2043 enum resource_types type
;
2045 return x_get_arg (check_x_display_info (Qnil
),
2046 alist
, param
, attribute
, class, type
);
2051 w32_load_cursor (LPCTSTR name
)
2053 /* Try first to load cursor from application resource. */
2054 Cursor cursor
= LoadImage ((HINSTANCE
) GetModuleHandle (NULL
),
2055 name
, IMAGE_CURSOR
, 0, 0,
2056 LR_DEFAULTCOLOR
| LR_DEFAULTSIZE
| LR_SHARED
);
2059 /* Then try to load a shared predefined cursor. */
2060 cursor
= LoadImage (NULL
, name
, IMAGE_CURSOR
, 0, 0,
2061 LR_DEFAULTCOLOR
| LR_DEFAULTSIZE
| LR_SHARED
);
2066 extern LRESULT CALLBACK
w32_wnd_proc ();
2069 w32_init_class (hinst
)
2074 wc
.style
= CS_HREDRAW
| CS_VREDRAW
;
2075 wc
.lpfnWndProc
= (WNDPROC
) w32_wnd_proc
;
2077 wc
.cbWndExtra
= WND_EXTRA_BYTES
;
2078 wc
.hInstance
= hinst
;
2079 wc
.hIcon
= LoadIcon (hinst
, EMACS_CLASS
);
2080 wc
.hCursor
= w32_load_cursor (IDC_ARROW
);
2081 wc
.hbrBackground
= NULL
; /* GetStockObject (WHITE_BRUSH); */
2082 wc
.lpszMenuName
= NULL
;
2083 wc
.lpszClassName
= EMACS_CLASS
;
2085 return (RegisterClass (&wc
));
2089 w32_createscrollbar (f
, bar
)
2091 struct scroll_bar
* bar
;
2093 return (CreateWindow ("SCROLLBAR", "", SBS_VERT
| WS_CHILD
| WS_VISIBLE
,
2094 /* Position and size of scroll bar. */
2095 XINT (bar
->left
) + VERTICAL_SCROLL_BAR_WIDTH_TRIM
,
2097 XINT (bar
->width
) - VERTICAL_SCROLL_BAR_WIDTH_TRIM
* 2,
2099 FRAME_W32_WINDOW (f
),
2106 w32_createwindow (f
)
2111 Lisp_Object top
= Qunbound
;
2112 Lisp_Object left
= Qunbound
;
2114 rect
.left
= rect
.top
= 0;
2115 rect
.right
= FRAME_PIXEL_WIDTH (f
);
2116 rect
.bottom
= FRAME_PIXEL_HEIGHT (f
);
2118 AdjustWindowRect (&rect
, f
->output_data
.w32
->dwStyle
,
2119 FRAME_EXTERNAL_MENU_BAR (f
));
2121 /* Do first time app init */
2125 w32_init_class (hinst
);
2128 if (f
->size_hint_flags
& USPosition
|| f
->size_hint_flags
& PPosition
)
2130 XSETINT (left
, f
->left_pos
);
2131 XSETINT (top
, f
->top_pos
);
2133 else if (EQ (left
, Qunbound
) && EQ (top
, Qunbound
))
2135 /* When called with RES_TYPE_NUMBER, w32_get_arg will return zero
2136 for anything that is not a number and is not Qunbound. */
2137 left
= w32_get_arg (Qnil
, Qleft
, "left", "Left", RES_TYPE_NUMBER
);
2138 top
= w32_get_arg (Qnil
, Qtop
, "top", "Top", RES_TYPE_NUMBER
);
2141 FRAME_W32_WINDOW (f
) = hwnd
2142 = CreateWindow (EMACS_CLASS
,
2144 f
->output_data
.w32
->dwStyle
| WS_CLIPCHILDREN
,
2145 EQ (left
, Qunbound
) ? CW_USEDEFAULT
: XINT (left
),
2146 EQ (top
, Qunbound
) ? CW_USEDEFAULT
: XINT (top
),
2147 rect
.right
- rect
.left
,
2148 rect
.bottom
- rect
.top
,
2156 SetWindowLong (hwnd
, WND_FONTWIDTH_INDEX
, FRAME_COLUMN_WIDTH (f
));
2157 SetWindowLong (hwnd
, WND_LINEHEIGHT_INDEX
, FRAME_LINE_HEIGHT (f
));
2158 SetWindowLong (hwnd
, WND_BORDER_INDEX
, FRAME_INTERNAL_BORDER_WIDTH (f
));
2159 SetWindowLong (hwnd
, WND_SCROLLBAR_INDEX
, f
->scroll_bar_actual_width
);
2160 SetWindowLong (hwnd
, WND_BACKGROUND_INDEX
, FRAME_BACKGROUND_PIXEL (f
));
2162 /* Enable drag-n-drop. */
2163 DragAcceptFiles (hwnd
, TRUE
);
2165 /* Do this to discard the default setting specified by our parent. */
2166 ShowWindow (hwnd
, SW_HIDE
);
2168 /* Update frame positions. */
2169 GetWindowRect (hwnd
, &rect
);
2170 f
->left_pos
= rect
.left
;
2171 f
->top_pos
= rect
.top
;
2176 my_post_msg (wmsg
, hwnd
, msg
, wParam
, lParam
)
2183 wmsg
->msg
.hwnd
= hwnd
;
2184 wmsg
->msg
.message
= msg
;
2185 wmsg
->msg
.wParam
= wParam
;
2186 wmsg
->msg
.lParam
= lParam
;
2187 wmsg
->msg
.time
= GetMessageTime ();
2192 /* GetKeyState and MapVirtualKey on Windows 95 do not actually distinguish
2193 between left and right keys as advertised. We test for this
2194 support dynamically, and set a flag when the support is absent. If
2195 absent, we keep track of the left and right control and alt keys
2196 ourselves. This is particularly necessary on keyboards that rely
2197 upon the AltGr key, which is represented as having the left control
2198 and right alt keys pressed. For these keyboards, we need to know
2199 when the left alt key has been pressed in addition to the AltGr key
2200 so that we can properly support M-AltGr-key sequences (such as M-@
2201 on Swedish keyboards). */
2203 #define EMACS_LCONTROL 0
2204 #define EMACS_RCONTROL 1
2205 #define EMACS_LMENU 2
2206 #define EMACS_RMENU 3
2208 static int modifiers
[4];
2209 static int modifiers_recorded
;
2210 static int modifier_key_support_tested
;
2213 test_modifier_support (unsigned int wparam
)
2217 if (wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
)
2219 if (wparam
== VK_CONTROL
)
2229 if (!(GetKeyState (l
) & 0x8000) && !(GetKeyState (r
) & 0x8000))
2230 modifiers_recorded
= 1;
2232 modifiers_recorded
= 0;
2233 modifier_key_support_tested
= 1;
2237 record_keydown (unsigned int wparam
, unsigned int lparam
)
2241 if (!modifier_key_support_tested
)
2242 test_modifier_support (wparam
);
2244 if ((wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
) || !modifiers_recorded
)
2247 if (wparam
== VK_CONTROL
)
2248 i
= (lparam
& 0x1000000) ? EMACS_RCONTROL
: EMACS_LCONTROL
;
2250 i
= (lparam
& 0x1000000) ? EMACS_RMENU
: EMACS_LMENU
;
2256 record_keyup (unsigned int wparam
, unsigned int lparam
)
2260 if ((wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
) || !modifiers_recorded
)
2263 if (wparam
== VK_CONTROL
)
2264 i
= (lparam
& 0x1000000) ? EMACS_RCONTROL
: EMACS_LCONTROL
;
2266 i
= (lparam
& 0x1000000) ? EMACS_RMENU
: EMACS_LMENU
;
2271 /* Emacs can lose focus while a modifier key has been pressed. When
2272 it regains focus, be conservative and clear all modifiers since
2273 we cannot reconstruct the left and right modifier state. */
2279 if (GetFocus () == NULL
)
2280 /* Emacs doesn't have keyboard focus. Do nothing. */
2283 ctrl
= GetAsyncKeyState (VK_CONTROL
);
2284 alt
= GetAsyncKeyState (VK_MENU
);
2286 if (!(ctrl
& 0x08000))
2287 /* Clear any recorded control modifier state. */
2288 modifiers
[EMACS_RCONTROL
] = modifiers
[EMACS_LCONTROL
] = 0;
2290 if (!(alt
& 0x08000))
2291 /* Clear any recorded alt modifier state. */
2292 modifiers
[EMACS_RMENU
] = modifiers
[EMACS_LMENU
] = 0;
2294 /* Update the state of all modifier keys, because modifiers used in
2295 hot-key combinations can get stuck on if Emacs loses focus as a
2296 result of a hot-key being pressed. */
2300 #define CURRENT_STATE(key) ((GetAsyncKeyState (key) & 0x8000) >> 8)
2302 GetKeyboardState (keystate
);
2303 keystate
[VK_SHIFT
] = CURRENT_STATE (VK_SHIFT
);
2304 keystate
[VK_CONTROL
] = CURRENT_STATE (VK_CONTROL
);
2305 keystate
[VK_LCONTROL
] = CURRENT_STATE (VK_LCONTROL
);
2306 keystate
[VK_RCONTROL
] = CURRENT_STATE (VK_RCONTROL
);
2307 keystate
[VK_MENU
] = CURRENT_STATE (VK_MENU
);
2308 keystate
[VK_LMENU
] = CURRENT_STATE (VK_LMENU
);
2309 keystate
[VK_RMENU
] = CURRENT_STATE (VK_RMENU
);
2310 keystate
[VK_LWIN
] = CURRENT_STATE (VK_LWIN
);
2311 keystate
[VK_RWIN
] = CURRENT_STATE (VK_RWIN
);
2312 keystate
[VK_APPS
] = CURRENT_STATE (VK_APPS
);
2313 SetKeyboardState (keystate
);
2317 /* Synchronize modifier state with what is reported with the current
2318 keystroke. Even if we cannot distinguish between left and right
2319 modifier keys, we know that, if no modifiers are set, then neither
2320 the left or right modifier should be set. */
2324 if (!modifiers_recorded
)
2327 if (!(GetKeyState (VK_CONTROL
) & 0x8000))
2328 modifiers
[EMACS_RCONTROL
] = modifiers
[EMACS_LCONTROL
] = 0;
2330 if (!(GetKeyState (VK_MENU
) & 0x8000))
2331 modifiers
[EMACS_RMENU
] = modifiers
[EMACS_LMENU
] = 0;
2335 modifier_set (int vkey
)
2337 if (vkey
== VK_CAPITAL
|| vkey
== VK_SCROLL
)
2338 return (GetKeyState (vkey
) & 0x1);
2339 if (!modifiers_recorded
)
2340 return (GetKeyState (vkey
) & 0x8000);
2345 return modifiers
[EMACS_LCONTROL
];
2347 return modifiers
[EMACS_RCONTROL
];
2349 return modifiers
[EMACS_LMENU
];
2351 return modifiers
[EMACS_RMENU
];
2353 return (GetKeyState (vkey
) & 0x8000);
2356 /* Convert between the modifier bits W32 uses and the modifier bits
2360 w32_key_to_modifier (int key
)
2362 Lisp_Object key_mapping
;
2367 key_mapping
= Vw32_lwindow_modifier
;
2370 key_mapping
= Vw32_rwindow_modifier
;
2373 key_mapping
= Vw32_apps_modifier
;
2376 key_mapping
= Vw32_scroll_lock_modifier
;
2382 /* NB. This code runs in the input thread, asychronously to the lisp
2383 thread, so we must be careful to ensure access to lisp data is
2384 thread-safe. The following code is safe because the modifier
2385 variable values are updated atomically from lisp and symbols are
2386 not relocated by GC. Also, we don't have to worry about seeing GC
2388 if (EQ (key_mapping
, Qhyper
))
2389 return hyper_modifier
;
2390 if (EQ (key_mapping
, Qsuper
))
2391 return super_modifier
;
2392 if (EQ (key_mapping
, Qmeta
))
2393 return meta_modifier
;
2394 if (EQ (key_mapping
, Qalt
))
2395 return alt_modifier
;
2396 if (EQ (key_mapping
, Qctrl
))
2397 return ctrl_modifier
;
2398 if (EQ (key_mapping
, Qcontrol
)) /* synonym for ctrl */
2399 return ctrl_modifier
;
2400 if (EQ (key_mapping
, Qshift
))
2401 return shift_modifier
;
2403 /* Don't generate any modifier if not explicitly requested. */
2408 w32_get_modifiers ()
2410 return ((modifier_set (VK_SHIFT
) ? shift_modifier
: 0) |
2411 (modifier_set (VK_CONTROL
) ? ctrl_modifier
: 0) |
2412 (modifier_set (VK_LWIN
) ? w32_key_to_modifier (VK_LWIN
) : 0) |
2413 (modifier_set (VK_RWIN
) ? w32_key_to_modifier (VK_RWIN
) : 0) |
2414 (modifier_set (VK_APPS
) ? w32_key_to_modifier (VK_APPS
) : 0) |
2415 (modifier_set (VK_SCROLL
) ? w32_key_to_modifier (VK_SCROLL
) : 0) |
2416 (modifier_set (VK_MENU
) ?
2417 ((NILP (Vw32_alt_is_meta
)) ? alt_modifier
: meta_modifier
) : 0));
2420 /* We map the VK_* modifiers into console modifier constants
2421 so that we can use the same routines to handle both console
2422 and window input. */
2425 construct_console_modifiers ()
2430 mods
|= (modifier_set (VK_SHIFT
)) ? SHIFT_PRESSED
: 0;
2431 mods
|= (modifier_set (VK_CAPITAL
)) ? CAPSLOCK_ON
: 0;
2432 mods
|= (modifier_set (VK_SCROLL
)) ? SCROLLLOCK_ON
: 0;
2433 mods
|= (modifier_set (VK_NUMLOCK
)) ? NUMLOCK_ON
: 0;
2434 mods
|= (modifier_set (VK_LCONTROL
)) ? LEFT_CTRL_PRESSED
: 0;
2435 mods
|= (modifier_set (VK_RCONTROL
)) ? RIGHT_CTRL_PRESSED
: 0;
2436 mods
|= (modifier_set (VK_LMENU
)) ? LEFT_ALT_PRESSED
: 0;
2437 mods
|= (modifier_set (VK_RMENU
)) ? RIGHT_ALT_PRESSED
: 0;
2438 mods
|= (modifier_set (VK_LWIN
)) ? LEFT_WIN_PRESSED
: 0;
2439 mods
|= (modifier_set (VK_RWIN
)) ? RIGHT_WIN_PRESSED
: 0;
2440 mods
|= (modifier_set (VK_APPS
)) ? APPS_PRESSED
: 0;
2446 w32_get_key_modifiers (unsigned int wparam
, unsigned int lparam
)
2450 /* Convert to emacs modifiers. */
2451 mods
= w32_kbd_mods_to_emacs (construct_console_modifiers (), wparam
);
2457 map_keypad_keys (unsigned int virt_key
, unsigned int extended
)
2459 if (virt_key
< VK_CLEAR
|| virt_key
> VK_DELETE
)
2462 if (virt_key
== VK_RETURN
)
2463 return (extended
? VK_NUMPAD_ENTER
: VK_RETURN
);
2465 if (virt_key
>= VK_PRIOR
&& virt_key
<= VK_DOWN
)
2466 return (!extended
? (VK_NUMPAD_PRIOR
+ (virt_key
- VK_PRIOR
)) : virt_key
);
2468 if (virt_key
== VK_INSERT
|| virt_key
== VK_DELETE
)
2469 return (!extended
? (VK_NUMPAD_INSERT
+ (virt_key
- VK_INSERT
)) : virt_key
);
2471 if (virt_key
== VK_CLEAR
)
2472 return (!extended
? VK_NUMPAD_CLEAR
: virt_key
);
2477 /* List of special key combinations which w32 would normally capture,
2478 but Emacs should grab instead. Not directly visible to lisp, to
2479 simplify synchronization. Each item is an integer encoding a virtual
2480 key code and modifier combination to capture. */
2481 static Lisp_Object w32_grabbed_keys
;
2483 #define HOTKEY(vk, mods) make_number (((vk) & 255) | ((mods) << 8))
2484 #define HOTKEY_ID(k) (XFASTINT (k) & 0xbfff)
2485 #define HOTKEY_VK_CODE(k) (XFASTINT (k) & 255)
2486 #define HOTKEY_MODIFIERS(k) (XFASTINT (k) >> 8)
2488 #define RAW_HOTKEY_ID(k) ((k) & 0xbfff)
2489 #define RAW_HOTKEY_VK_CODE(k) ((k) & 255)
2490 #define RAW_HOTKEY_MODIFIERS(k) ((k) >> 8)
2492 /* Register hot-keys for reserved key combinations when Emacs has
2493 keyboard focus, since this is the only way Emacs can receive key
2494 combinations like Alt-Tab which are used by the system. */
2497 register_hot_keys (hwnd
)
2500 Lisp_Object keylist
;
2502 /* Use CONSP, since we are called asynchronously. */
2503 for (keylist
= w32_grabbed_keys
; CONSP (keylist
); keylist
= XCDR (keylist
))
2505 Lisp_Object key
= XCAR (keylist
);
2507 /* Deleted entries get set to nil. */
2508 if (!INTEGERP (key
))
2511 RegisterHotKey (hwnd
, HOTKEY_ID (key
),
2512 HOTKEY_MODIFIERS (key
), HOTKEY_VK_CODE (key
));
2517 unregister_hot_keys (hwnd
)
2520 Lisp_Object keylist
;
2522 for (keylist
= w32_grabbed_keys
; CONSP (keylist
); keylist
= XCDR (keylist
))
2524 Lisp_Object key
= XCAR (keylist
);
2526 if (!INTEGERP (key
))
2529 UnregisterHotKey (hwnd
, HOTKEY_ID (key
));
2533 /* Main message dispatch loop. */
2536 w32_msg_pump (deferred_msg
* msg_buf
)
2542 msh_mousewheel
= RegisterWindowMessage (MSH_MOUSEWHEEL
);
2544 while (GetMessage (&msg
, NULL
, 0, 0))
2546 if (msg
.hwnd
== NULL
)
2548 switch (msg
.message
)
2551 /* Produced by complete_deferred_msg; just ignore. */
2553 case WM_EMACS_CREATEWINDOW
:
2554 /* Initialize COM for this window. Even though we don't use it,
2555 some third party shell extensions can cause it to be used in
2556 system dialogs, which causes a crash if it is not initialized.
2557 This is a known bug in Windows, which was fixed long ago, but
2558 the patch for XP is not publically available until XP SP3,
2559 and older versions will never be patched. */
2560 CoInitialize (NULL
);
2561 w32_createwindow ((struct frame
*) msg
.wParam
);
2562 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
, 0, 0))
2565 case WM_EMACS_SETLOCALE
:
2566 SetThreadLocale (msg
.wParam
);
2567 /* Reply is not expected. */
2569 case WM_EMACS_SETKEYBOARDLAYOUT
:
2570 result
= (int) ActivateKeyboardLayout ((HKL
) msg
.wParam
, 0);
2571 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
,
2575 case WM_EMACS_REGISTER_HOT_KEY
:
2576 focus_window
= GetFocus ();
2577 if (focus_window
!= NULL
)
2578 RegisterHotKey (focus_window
,
2579 RAW_HOTKEY_ID (msg
.wParam
),
2580 RAW_HOTKEY_MODIFIERS (msg
.wParam
),
2581 RAW_HOTKEY_VK_CODE (msg
.wParam
));
2582 /* Reply is not expected. */
2584 case WM_EMACS_UNREGISTER_HOT_KEY
:
2585 focus_window
= GetFocus ();
2586 if (focus_window
!= NULL
)
2587 UnregisterHotKey (focus_window
, RAW_HOTKEY_ID (msg
.wParam
));
2588 /* Mark item as erased. NB: this code must be
2589 thread-safe. The next line is okay because the cons
2590 cell is never made into garbage and is not relocated by
2592 XSETCAR ((Lisp_Object
) ((EMACS_INT
) msg
.lParam
), Qnil
);
2593 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
, 0, 0))
2596 case WM_EMACS_TOGGLE_LOCK_KEY
:
2598 int vk_code
= (int) msg
.wParam
;
2599 int cur_state
= (GetKeyState (vk_code
) & 1);
2600 Lisp_Object new_state
= (Lisp_Object
) ((EMACS_INT
) msg
.lParam
);
2602 /* NB: This code must be thread-safe. It is safe to
2603 call NILP because symbols are not relocated by GC,
2604 and pointer here is not touched by GC (so the markbit
2605 can't be set). Numbers are safe because they are
2606 immediate values. */
2607 if (NILP (new_state
)
2608 || (NUMBERP (new_state
)
2609 && ((XUINT (new_state
)) & 1) != cur_state
))
2611 one_w32_display_info
.faked_key
= vk_code
;
2613 keybd_event ((BYTE
) vk_code
,
2614 (BYTE
) MapVirtualKey (vk_code
, 0),
2615 KEYEVENTF_EXTENDEDKEY
| KEYEVENTF_KEYUP
, 0);
2616 keybd_event ((BYTE
) vk_code
,
2617 (BYTE
) MapVirtualKey (vk_code
, 0),
2618 KEYEVENTF_EXTENDEDKEY
| 0, 0);
2619 keybd_event ((BYTE
) vk_code
,
2620 (BYTE
) MapVirtualKey (vk_code
, 0),
2621 KEYEVENTF_EXTENDEDKEY
| KEYEVENTF_KEYUP
, 0);
2622 cur_state
= !cur_state
;
2624 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
,
2630 /* Broadcast messages make it here, so you need to be looking
2631 for something in particular for this to be useful. */
2633 DebPrint (("msg %x not expected by w32_msg_pump\n", msg
.message
));
2639 DispatchMessage (&msg
);
2642 /* Exit nested loop when our deferred message has completed. */
2643 if (msg_buf
->completed
)
2648 deferred_msg
* deferred_msg_head
;
2650 static deferred_msg
*
2651 find_deferred_msg (HWND hwnd
, UINT msg
)
2653 deferred_msg
* item
;
2655 /* Don't actually need synchronization for read access, since
2656 modification of single pointer is always atomic. */
2657 /* enter_crit (); */
2659 for (item
= deferred_msg_head
; item
!= NULL
; item
= item
->next
)
2660 if (item
->w32msg
.msg
.hwnd
== hwnd
2661 && item
->w32msg
.msg
.message
== msg
)
2664 /* leave_crit (); */
2670 send_deferred_msg (deferred_msg
* msg_buf
,
2676 /* Only input thread can send deferred messages. */
2677 if (GetCurrentThreadId () != dwWindowsThreadId
)
2680 /* It is an error to send a message that is already deferred. */
2681 if (find_deferred_msg (hwnd
, msg
) != NULL
)
2684 /* Enforced synchronization is not needed because this is the only
2685 function that alters deferred_msg_head, and the following critical
2686 section is guaranteed to only be serially reentered (since only the
2687 input thread can call us). */
2689 /* enter_crit (); */
2691 msg_buf
->completed
= 0;
2692 msg_buf
->next
= deferred_msg_head
;
2693 deferred_msg_head
= msg_buf
;
2694 my_post_msg (&msg_buf
->w32msg
, hwnd
, msg
, wParam
, lParam
);
2696 /* leave_crit (); */
2698 /* Start a new nested message loop to process other messages until
2699 this one is completed. */
2700 w32_msg_pump (msg_buf
);
2702 deferred_msg_head
= msg_buf
->next
;
2704 return msg_buf
->result
;
2708 complete_deferred_msg (HWND hwnd
, UINT msg
, LRESULT result
)
2710 deferred_msg
* msg_buf
= find_deferred_msg (hwnd
, msg
);
2712 if (msg_buf
== NULL
)
2713 /* Message may have been cancelled, so don't abort. */
2716 msg_buf
->result
= result
;
2717 msg_buf
->completed
= 1;
2719 /* Ensure input thread is woken so it notices the completion. */
2720 PostThreadMessage (dwWindowsThreadId
, WM_NULL
, 0, 0);
2724 cancel_all_deferred_msgs ()
2726 deferred_msg
* item
;
2728 /* Don't actually need synchronization for read access, since
2729 modification of single pointer is always atomic. */
2730 /* enter_crit (); */
2732 for (item
= deferred_msg_head
; item
!= NULL
; item
= item
->next
)
2735 item
->completed
= 1;
2738 /* leave_crit (); */
2740 /* Ensure input thread is woken so it notices the completion. */
2741 PostThreadMessage (dwWindowsThreadId
, WM_NULL
, 0, 0);
2745 w32_msg_worker (void *arg
)
2748 deferred_msg dummy_buf
;
2750 /* Ensure our message queue is created */
2752 PeekMessage (&msg
, NULL
, 0, 0, PM_NOREMOVE
);
2754 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
, 0, 0))
2757 memset (&dummy_buf
, 0, sizeof (dummy_buf
));
2758 dummy_buf
.w32msg
.msg
.hwnd
= NULL
;
2759 dummy_buf
.w32msg
.msg
.message
= WM_NULL
;
2761 /* This is the initial message loop which should only exit when the
2762 application quits. */
2763 w32_msg_pump (&dummy_buf
);
2769 signal_user_input ()
2771 /* Interrupt any lisp that wants to be interrupted by input. */
2772 if (!NILP (Vthrow_on_input
))
2774 Vquit_flag
= Vthrow_on_input
;
2775 /* If we're inside a function that wants immediate quits,
2777 if (immediate_quit
&& NILP (Vinhibit_quit
))
2787 post_character_message (hwnd
, msg
, wParam
, lParam
, modifiers
)
2797 wmsg
.dwModifiers
= modifiers
;
2799 /* Detect quit_char and set quit-flag directly. Note that we
2800 still need to post a message to ensure the main thread will be
2801 woken up if blocked in sys_select, but we do NOT want to post
2802 the quit_char message itself (because it will usually be as if
2803 the user had typed quit_char twice). Instead, we post a dummy
2804 message that has no particular effect. */
2807 if (isalpha (c
) && wmsg
.dwModifiers
== ctrl_modifier
)
2808 c
= make_ctrl_char (c
) & 0377;
2810 || (wmsg
.dwModifiers
== 0 &&
2811 w32_quit_key
&& wParam
== w32_quit_key
))
2815 /* The choice of message is somewhat arbitrary, as long as
2816 the main thread handler just ignores it. */
2819 /* Interrupt any blocking system calls. */
2822 /* As a safety precaution, forcibly complete any deferred
2823 messages. This is a kludge, but I don't see any particularly
2824 clean way to handle the situation where a deferred message is
2825 "dropped" in the lisp thread, and will thus never be
2826 completed, eg. by the user trying to activate the menubar
2827 when the lisp thread is busy, and then typing C-g when the
2828 menubar doesn't open promptly (with the result that the
2829 menubar never responds at all because the deferred
2830 WM_INITMENU message is never completed). Another problem
2831 situation is when the lisp thread calls SendMessage (to send
2832 a window manager command) when a message has been deferred;
2833 the lisp thread gets blocked indefinitely waiting for the
2834 deferred message to be completed, which itself is waiting for
2835 the lisp thread to respond.
2837 Note that we don't want to block the input thread waiting for
2838 a reponse from the lisp thread (although that would at least
2839 solve the deadlock problem above), because we want to be able
2840 to receive C-g to interrupt the lisp thread. */
2841 cancel_all_deferred_msgs ();
2844 signal_user_input ();
2847 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
2850 /* Main window procedure */
2853 w32_wnd_proc (hwnd
, msg
, wParam
, lParam
)
2860 struct w32_display_info
*dpyinfo
= &one_w32_display_info
;
2862 int windows_translate
;
2865 /* Note that it is okay to call x_window_to_frame, even though we are
2866 not running in the main lisp thread, because frame deletion
2867 requires the lisp thread to synchronize with this thread. Thus, if
2868 a frame struct is returned, it can be used without concern that the
2869 lisp thread might make it disappear while we are using it.
2871 NB. Walking the frame list in this thread is safe (as long as
2872 writes of Lisp_Object slots are atomic, which they are on Windows).
2873 Although delete-frame can destructively modify the frame list while
2874 we are walking it, a garbage collection cannot occur until after
2875 delete-frame has synchronized with this thread.
2877 It is also safe to use functions that make GDI calls, such as
2878 w32_clear_rect, because these functions must obtain a DC handle
2879 from the frame struct using get_frame_dc which is thread-aware. */
2884 f
= x_window_to_frame (dpyinfo
, hwnd
);
2887 HDC hdc
= get_frame_dc (f
);
2888 GetUpdateRect (hwnd
, &wmsg
.rect
, FALSE
);
2889 w32_clear_rect (f
, hdc
, &wmsg
.rect
);
2890 release_frame_dc (f
, hdc
);
2892 #if defined (W32_DEBUG_DISPLAY)
2893 DebPrint (("WM_ERASEBKGND (frame %p): erasing %d,%d-%d,%d\n",
2895 wmsg
.rect
.left
, wmsg
.rect
.top
,
2896 wmsg
.rect
.right
, wmsg
.rect
.bottom
));
2897 #endif /* W32_DEBUG_DISPLAY */
2900 case WM_PALETTECHANGED
:
2901 /* ignore our own changes */
2902 if ((HWND
)wParam
!= hwnd
)
2904 f
= x_window_to_frame (dpyinfo
, hwnd
);
2906 /* get_frame_dc will realize our palette and force all
2907 frames to be redrawn if needed. */
2908 release_frame_dc (f
, get_frame_dc (f
));
2913 PAINTSTRUCT paintStruct
;
2915 bzero (&update_rect
, sizeof (update_rect
));
2917 f
= x_window_to_frame (dpyinfo
, hwnd
);
2920 DebPrint (("WM_PAINT received for unknown window %p\n", hwnd
));
2924 /* MSDN Docs say not to call BeginPaint if GetUpdateRect
2925 fails. Apparently this can happen under some
2927 if (GetUpdateRect (hwnd
, &update_rect
, FALSE
) || !w32_strict_painting
)
2930 BeginPaint (hwnd
, &paintStruct
);
2932 /* The rectangles returned by GetUpdateRect and BeginPaint
2933 do not always match. Play it safe by assuming both areas
2935 UnionRect (&(wmsg
.rect
), &update_rect
, &(paintStruct
.rcPaint
));
2937 #if defined (W32_DEBUG_DISPLAY)
2938 DebPrint (("WM_PAINT (frame %p): painting %d,%d-%d,%d\n",
2940 wmsg
.rect
.left
, wmsg
.rect
.top
,
2941 wmsg
.rect
.right
, wmsg
.rect
.bottom
));
2942 DebPrint ((" [update region is %d,%d-%d,%d]\n",
2943 update_rect
.left
, update_rect
.top
,
2944 update_rect
.right
, update_rect
.bottom
));
2946 EndPaint (hwnd
, &paintStruct
);
2949 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
2954 /* If GetUpdateRect returns 0 (meaning there is no update
2955 region), assume the whole window needs to be repainted. */
2956 GetClientRect (hwnd
, &wmsg
.rect
);
2957 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
2961 case WM_INPUTLANGCHANGE
:
2962 /* Inform lisp thread of keyboard layout changes. */
2963 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
2965 /* Clear dead keys in the keyboard state; for simplicity only
2966 preserve modifier key states. */
2971 GetKeyboardState (keystate
);
2972 for (i
= 0; i
< 256; i
++)
2989 SetKeyboardState (keystate
);
2994 /* Synchronize hot keys with normal input. */
2995 PostMessage (hwnd
, WM_KEYDOWN
, HIWORD (lParam
), 0);
3000 record_keyup (wParam
, lParam
);
3005 /* Ignore keystrokes we fake ourself; see below. */
3006 if (dpyinfo
->faked_key
== wParam
)
3008 dpyinfo
->faked_key
= 0;
3009 /* Make sure TranslateMessage sees them though (as long as
3010 they don't produce WM_CHAR messages). This ensures that
3011 indicator lights are toggled promptly on Windows 9x, for
3013 if (wParam
< 256 && lispy_function_keys
[wParam
])
3015 windows_translate
= 1;
3021 /* Synchronize modifiers with current keystroke. */
3023 record_keydown (wParam
, lParam
);
3024 wParam
= map_keypad_keys (wParam
, (lParam
& 0x1000000L
) != 0);
3026 windows_translate
= 0;
3031 if (NILP (Vw32_pass_lwindow_to_system
))
3033 /* Prevent system from acting on keyup (which opens the
3034 Start menu if no other key was pressed) by simulating a
3035 press of Space which we will ignore. */
3036 if (GetAsyncKeyState (wParam
) & 1)
3038 if (NUMBERP (Vw32_phantom_key_code
))
3039 key
= XUINT (Vw32_phantom_key_code
) & 255;
3042 dpyinfo
->faked_key
= key
;
3043 keybd_event (key
, (BYTE
) MapVirtualKey (key
, 0), 0, 0);
3046 if (!NILP (Vw32_lwindow_modifier
))
3050 if (NILP (Vw32_pass_rwindow_to_system
))
3052 if (GetAsyncKeyState (wParam
) & 1)
3054 if (NUMBERP (Vw32_phantom_key_code
))
3055 key
= XUINT (Vw32_phantom_key_code
) & 255;
3058 dpyinfo
->faked_key
= key
;
3059 keybd_event (key
, (BYTE
) MapVirtualKey (key
, 0), 0, 0);
3062 if (!NILP (Vw32_rwindow_modifier
))
3066 if (!NILP (Vw32_apps_modifier
))
3070 if (NILP (Vw32_pass_alt_to_system
))
3071 /* Prevent DefWindowProc from activating the menu bar if an
3072 Alt key is pressed and released by itself. */
3074 windows_translate
= 1;
3077 /* Decide whether to treat as modifier or function key. */
3078 if (NILP (Vw32_enable_caps_lock
))
3079 goto disable_lock_key
;
3080 windows_translate
= 1;
3083 /* Decide whether to treat as modifier or function key. */
3084 if (NILP (Vw32_enable_num_lock
))
3085 goto disable_lock_key
;
3086 windows_translate
= 1;
3089 /* Decide whether to treat as modifier or function key. */
3090 if (NILP (Vw32_scroll_lock_modifier
))
3091 goto disable_lock_key
;
3092 windows_translate
= 1;
3095 /* Ensure the appropriate lock key state (and indicator light)
3096 remains in the same state. We do this by faking another
3097 press of the relevant key. Apparently, this really is the
3098 only way to toggle the state of the indicator lights. */
3099 dpyinfo
->faked_key
= wParam
;
3100 keybd_event ((BYTE
) wParam
, (BYTE
) MapVirtualKey (wParam
, 0),
3101 KEYEVENTF_EXTENDEDKEY
| KEYEVENTF_KEYUP
, 0);
3102 keybd_event ((BYTE
) wParam
, (BYTE
) MapVirtualKey (wParam
, 0),
3103 KEYEVENTF_EXTENDEDKEY
| 0, 0);
3104 keybd_event ((BYTE
) wParam
, (BYTE
) MapVirtualKey (wParam
, 0),
3105 KEYEVENTF_EXTENDEDKEY
| KEYEVENTF_KEYUP
, 0);
3106 /* Ensure indicator lights are updated promptly on Windows 9x
3107 (TranslateMessage apparently does this), after forwarding
3109 post_character_message (hwnd
, msg
, wParam
, lParam
,
3110 w32_get_key_modifiers (wParam
, lParam
));
3111 windows_translate
= 1;
3115 case VK_PROCESSKEY
: /* Generated by IME. */
3116 windows_translate
= 1;
3119 /* Windows maps Ctrl-Pause (aka Ctrl-Break) into VK_CANCEL,
3120 which is confusing for purposes of key binding; convert
3121 VK_CANCEL events into VK_PAUSE events. */
3125 /* Windows maps Ctrl-NumLock into VK_PAUSE, which is confusing
3126 for purposes of key binding; convert these back into
3127 VK_NUMLOCK events, at least when we want to see NumLock key
3128 presses. (Note that there is never any possibility that
3129 VK_PAUSE with Ctrl really is C-Pause as per above.) */
3130 if (NILP (Vw32_enable_num_lock
) && modifier_set (VK_CONTROL
))
3131 wParam
= VK_NUMLOCK
;
3134 /* If not defined as a function key, change it to a WM_CHAR message. */
3135 if (wParam
> 255 || !lispy_function_keys
[wParam
])
3137 DWORD modifiers
= construct_console_modifiers ();
3139 if (!NILP (Vw32_recognize_altgr
)
3140 && modifier_set (VK_LCONTROL
) && modifier_set (VK_RMENU
))
3142 /* Always let TranslateMessage handle AltGr key chords;
3143 for some reason, ToAscii doesn't always process AltGr
3144 chords correctly. */
3145 windows_translate
= 1;
3147 else if ((modifiers
& (~SHIFT_PRESSED
& ~CAPSLOCK_ON
)) != 0)
3149 /* Handle key chords including any modifiers other
3150 than shift directly, in order to preserve as much
3151 modifier information as possible. */
3152 if ('A' <= wParam
&& wParam
<= 'Z')
3154 /* Don't translate modified alphabetic keystrokes,
3155 so the user doesn't need to constantly switch
3156 layout to type control or meta keystrokes when
3157 the normal layout translates alphabetic
3158 characters to non-ascii characters. */
3159 if (!modifier_set (VK_SHIFT
))
3160 wParam
+= ('a' - 'A');
3165 /* Try to handle other keystrokes by determining the
3166 base character (ie. translating the base key plus
3170 KEY_EVENT_RECORD key
;
3172 key
.bKeyDown
= TRUE
;
3173 key
.wRepeatCount
= 1;
3174 key
.wVirtualKeyCode
= wParam
;
3175 key
.wVirtualScanCode
= (lParam
& 0xFF0000) >> 16;
3176 key
.uChar
.AsciiChar
= 0;
3177 key
.dwControlKeyState
= modifiers
;
3179 add
= w32_kbd_patch_key (&key
);
3180 /* 0 means an unrecognised keycode, negative means
3181 dead key. Ignore both. */
3184 /* Forward asciified character sequence. */
3185 post_character_message
3187 (unsigned char) key
.uChar
.AsciiChar
, lParam
,
3188 w32_get_key_modifiers (wParam
, lParam
));
3189 w32_kbd_patch_key (&key
);
3196 /* Let TranslateMessage handle everything else. */
3197 windows_translate
= 1;
3203 if (windows_translate
)
3205 MSG windows_msg
= { hwnd
, msg
, wParam
, lParam
, 0, {0,0} };
3206 windows_msg
.time
= GetMessageTime ();
3207 TranslateMessage (&windows_msg
);
3215 post_character_message (hwnd
, msg
, wParam
, lParam
,
3216 w32_get_key_modifiers (wParam
, lParam
));
3220 /* WM_UNICHAR looks promising from the docs, but the exact
3221 circumstances in which TranslateMessage sends it is one of those
3222 Microsoft secret API things that EU and US courts are supposed
3223 to have put a stop to already. Spy++ shows it being sent to Notepad
3224 and other MS apps, but never to Emacs.
3226 Some third party IMEs send it in accordance with the official
3227 documentation though, so handle it here.
3229 UNICODE_NOCHAR is used to test for support for this message.
3230 TRUE indicates that the message is supported. */
3231 if (wParam
== UNICODE_NOCHAR
)
3236 wmsg
.dwModifiers
= w32_get_key_modifiers (wParam
, lParam
);
3237 signal_user_input ();
3238 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3243 /* If we can't get the IME result as unicode, use default processing,
3244 which will at least allow characters decodable in the system locale
3246 if (!get_composition_string_fn
)
3249 else if (!ignore_ime_char
)
3254 HIMC context
= get_ime_context_fn (hwnd
);
3255 wmsg
.dwModifiers
= w32_get_key_modifiers (wParam
, lParam
);
3256 /* Get buffer size. */
3257 size
= get_composition_string_fn (context
, GCS_RESULTSTR
, buffer
, 0);
3258 buffer
= alloca(size
);
3259 size
= get_composition_string_fn (context
, GCS_RESULTSTR
,
3261 signal_user_input ();
3262 for (i
= 0; i
< size
/ sizeof (wchar_t); i
++)
3264 my_post_msg (&wmsg
, hwnd
, WM_UNICHAR
, (WPARAM
) buffer
[i
],
3267 /* We output the whole string above, so ignore following ones
3268 until we are notified of the end of composition. */
3269 ignore_ime_char
= 1;
3273 case WM_IME_ENDCOMPOSITION
:
3274 ignore_ime_char
= 0;
3277 /* Simulate middle mouse button events when left and right buttons
3278 are used together, but only if user has two button mouse. */
3279 case WM_LBUTTONDOWN
:
3280 case WM_RBUTTONDOWN
:
3281 if (w32_num_mouse_buttons
> 2)
3282 goto handle_plain_button
;
3285 int this = (msg
== WM_LBUTTONDOWN
) ? LMOUSE
: RMOUSE
;
3286 int other
= (msg
== WM_LBUTTONDOWN
) ? RMOUSE
: LMOUSE
;
3288 if (button_state
& this)
3291 if (button_state
== 0)
3294 button_state
|= this;
3296 if (button_state
& other
)
3298 if (mouse_button_timer
)
3300 KillTimer (hwnd
, mouse_button_timer
);
3301 mouse_button_timer
= 0;
3303 /* Generate middle mouse event instead. */
3304 msg
= WM_MBUTTONDOWN
;
3305 button_state
|= MMOUSE
;
3307 else if (button_state
& MMOUSE
)
3309 /* Ignore button event if we've already generated a
3310 middle mouse down event. This happens if the
3311 user releases and press one of the two buttons
3312 after we've faked a middle mouse event. */
3317 /* Flush out saved message. */
3318 post_msg (&saved_mouse_button_msg
);
3320 wmsg
.dwModifiers
= w32_get_modifiers ();
3321 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3322 signal_user_input ();
3324 /* Clear message buffer. */
3325 saved_mouse_button_msg
.msg
.hwnd
= 0;
3329 /* Hold onto message for now. */
3330 mouse_button_timer
=
3331 SetTimer (hwnd
, MOUSE_BUTTON_ID
,
3332 w32_mouse_button_tolerance
, NULL
);
3333 saved_mouse_button_msg
.msg
.hwnd
= hwnd
;
3334 saved_mouse_button_msg
.msg
.message
= msg
;
3335 saved_mouse_button_msg
.msg
.wParam
= wParam
;
3336 saved_mouse_button_msg
.msg
.lParam
= lParam
;
3337 saved_mouse_button_msg
.msg
.time
= GetMessageTime ();
3338 saved_mouse_button_msg
.dwModifiers
= w32_get_modifiers ();
3345 if (w32_num_mouse_buttons
> 2)
3346 goto handle_plain_button
;
3349 int this = (msg
== WM_LBUTTONUP
) ? LMOUSE
: RMOUSE
;
3350 int other
= (msg
== WM_LBUTTONUP
) ? RMOUSE
: LMOUSE
;
3352 if ((button_state
& this) == 0)
3355 button_state
&= ~this;
3357 if (button_state
& MMOUSE
)
3359 /* Only generate event when second button is released. */
3360 if ((button_state
& other
) == 0)
3363 button_state
&= ~MMOUSE
;
3365 if (button_state
) abort ();
3372 /* Flush out saved message if necessary. */
3373 if (saved_mouse_button_msg
.msg
.hwnd
)
3375 post_msg (&saved_mouse_button_msg
);
3378 wmsg
.dwModifiers
= w32_get_modifiers ();
3379 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3380 signal_user_input ();
3382 /* Always clear message buffer and cancel timer. */
3383 saved_mouse_button_msg
.msg
.hwnd
= 0;
3384 KillTimer (hwnd
, mouse_button_timer
);
3385 mouse_button_timer
= 0;
3387 if (button_state
== 0)
3392 case WM_XBUTTONDOWN
:
3394 if (w32_pass_extra_mouse_buttons_to_system
)
3396 /* else fall through and process them. */
3397 case WM_MBUTTONDOWN
:
3399 handle_plain_button
:
3404 /* Ignore middle and extra buttons as long as the menu is active. */
3405 f
= x_window_to_frame (dpyinfo
, hwnd
);
3406 if (f
&& f
->output_data
.w32
->menubar_active
)
3409 if (parse_button (msg
, HIWORD (wParam
), &button
, &up
))
3411 if (up
) ReleaseCapture ();
3412 else SetCapture (hwnd
);
3413 button
= (button
== 0) ? LMOUSE
:
3414 ((button
== 1) ? MMOUSE
: RMOUSE
);
3416 button_state
&= ~button
;
3418 button_state
|= button
;
3422 wmsg
.dwModifiers
= w32_get_modifiers ();
3423 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3424 signal_user_input ();
3426 /* Need to return true for XBUTTON messages, false for others,
3427 to indicate that we processed the message. */
3428 return (msg
== WM_XBUTTONDOWN
|| msg
== WM_XBUTTONUP
);
3431 /* Ignore mouse movements as long as the menu is active. These
3432 movements are processed by the window manager anyway, and
3433 it's wrong to handle them as if they happened on the
3434 underlying frame. */
3435 f
= x_window_to_frame (dpyinfo
, hwnd
);
3436 if (f
&& f
->output_data
.w32
->menubar_active
)
3439 /* If the mouse has just moved into the frame, start tracking
3440 it, so we will be notified when it leaves the frame. Mouse
3441 tracking only works under W98 and NT4 and later. On earlier
3442 versions, there is no way of telling when the mouse leaves the
3443 frame, so we just have to put up with help-echo and mouse
3444 highlighting remaining while the frame is not active. */
3445 if (track_mouse_event_fn
&& !track_mouse_window
)
3447 TRACKMOUSEEVENT tme
;
3448 tme
.cbSize
= sizeof (tme
);
3449 tme
.dwFlags
= TME_LEAVE
;
3450 tme
.hwndTrack
= hwnd
;
3452 track_mouse_event_fn (&tme
);
3453 track_mouse_window
= hwnd
;
3456 if (w32_mouse_move_interval
<= 0
3457 || (msg
== WM_MOUSEMOVE
&& button_state
== 0))
3459 wmsg
.dwModifiers
= w32_get_modifiers ();
3460 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3464 /* Hang onto mouse move and scroll messages for a bit, to avoid
3465 sending such events to Emacs faster than it can process them.
3466 If we get more events before the timer from the first message
3467 expires, we just replace the first message. */
3469 if (saved_mouse_move_msg
.msg
.hwnd
== 0)
3471 SetTimer (hwnd
, MOUSE_MOVE_ID
,
3472 w32_mouse_move_interval
, NULL
);
3474 /* Hold onto message for now. */
3475 saved_mouse_move_msg
.msg
.hwnd
= hwnd
;
3476 saved_mouse_move_msg
.msg
.message
= msg
;
3477 saved_mouse_move_msg
.msg
.wParam
= wParam
;
3478 saved_mouse_move_msg
.msg
.lParam
= lParam
;
3479 saved_mouse_move_msg
.msg
.time
= GetMessageTime ();
3480 saved_mouse_move_msg
.dwModifiers
= w32_get_modifiers ();
3486 wmsg
.dwModifiers
= w32_get_modifiers ();
3487 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3488 signal_user_input ();
3492 if (w32_pass_multimedia_buttons_to_system
)
3494 /* Otherwise, pass to lisp, the same way we do with mousehwheel. */
3495 case WM_MOUSEHWHEEL
:
3496 wmsg
.dwModifiers
= w32_get_modifiers ();
3497 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3498 signal_user_input ();
3499 /* Non-zero must be returned when WM_MOUSEHWHEEL messages are
3500 handled, to prevent the system trying to handle it by faking
3501 scroll bar events. */
3505 /* Flush out saved messages if necessary. */
3506 if (wParam
== mouse_button_timer
)
3508 if (saved_mouse_button_msg
.msg
.hwnd
)
3510 post_msg (&saved_mouse_button_msg
);
3511 signal_user_input ();
3512 saved_mouse_button_msg
.msg
.hwnd
= 0;
3514 KillTimer (hwnd
, mouse_button_timer
);
3515 mouse_button_timer
= 0;
3517 else if (wParam
== mouse_move_timer
)
3519 if (saved_mouse_move_msg
.msg
.hwnd
)
3521 post_msg (&saved_mouse_move_msg
);
3522 saved_mouse_move_msg
.msg
.hwnd
= 0;
3524 KillTimer (hwnd
, mouse_move_timer
);
3525 mouse_move_timer
= 0;
3527 else if (wParam
== menu_free_timer
)
3529 KillTimer (hwnd
, menu_free_timer
);
3530 menu_free_timer
= 0;
3531 f
= x_window_to_frame (dpyinfo
, hwnd
);
3532 /* If a popup menu is active, don't wipe its strings. */
3534 && current_popup_menu
== NULL
)
3536 /* Free memory used by owner-drawn and help-echo strings. */
3537 w32_free_menu_strings (hwnd
);
3538 f
->output_data
.w32
->menubar_active
= 0;
3542 else if (wParam
== hourglass_timer
)
3544 KillTimer (hwnd
, hourglass_timer
);
3545 hourglass_timer
= 0;
3546 show_hourglass (x_window_to_frame (dpyinfo
, hwnd
));
3551 /* Windows doesn't send us focus messages when putting up and
3552 taking down a system popup dialog as for Ctrl-Alt-Del on Windows 95.
3553 The only indication we get that something happened is receiving
3554 this message afterwards. So this is a good time to reset our
3555 keyboard modifiers' state. */
3562 /* We must ensure menu bar is fully constructed and up to date
3563 before allowing user interaction with it. To achieve this
3564 we send this message to the lisp thread and wait for a
3565 reply (whose value is not actually needed) to indicate that
3566 the menu bar is now ready for use, so we can now return.
3568 To remain responsive in the meantime, we enter a nested message
3569 loop that can process all other messages.
3571 However, we skip all this if the message results from calling
3572 TrackPopupMenu - in fact, we must NOT attempt to send the lisp
3573 thread a message because it is blocked on us at this point. We
3574 set menubar_active before calling TrackPopupMenu to indicate
3575 this (there is no possibility of confusion with real menubar
3578 f
= x_window_to_frame (dpyinfo
, hwnd
);
3580 && (f
->output_data
.w32
->menubar_active
3581 /* We can receive this message even in the absence of a
3582 menubar (ie. when the system menu is activated) - in this
3583 case we do NOT want to forward the message, otherwise it
3584 will cause the menubar to suddenly appear when the user
3585 had requested it to be turned off! */
3586 || f
->output_data
.w32
->menubar_widget
== NULL
))
3590 deferred_msg msg_buf
;
3592 /* Detect if message has already been deferred; in this case
3593 we cannot return any sensible value to ignore this. */
3594 if (find_deferred_msg (hwnd
, msg
) != NULL
)
3599 return send_deferred_msg (&msg_buf
, hwnd
, msg
, wParam
, lParam
);
3602 case WM_EXITMENULOOP
:
3603 f
= x_window_to_frame (dpyinfo
, hwnd
);
3605 /* If a menu is still active, check again after a short delay,
3606 since Windows often (always?) sends the WM_EXITMENULOOP
3607 before the corresponding WM_COMMAND message.
3608 Don't do this if a popup menu is active, since it is only
3609 menubar menus that require cleaning up in this way.
3611 if (f
&& menubar_in_use
&& current_popup_menu
== NULL
)
3612 menu_free_timer
= SetTimer (hwnd
, MENU_FREE_ID
, MENU_FREE_DELAY
, NULL
);
3614 /* If hourglass cursor should be displayed, display it now. */
3615 if (f
&& f
->output_data
.w32
->hourglass_p
)
3616 SetCursor (f
->output_data
.w32
->hourglass_cursor
);
3621 /* Direct handling of help_echo in menus. Should be safe now
3622 that we generate the help_echo by placing a help event in the
3625 HMENU menu
= (HMENU
) lParam
;
3626 UINT menu_item
= (UINT
) LOWORD (wParam
);
3627 UINT flags
= (UINT
) HIWORD (wParam
);
3629 w32_menu_display_help (hwnd
, menu
, menu_item
, flags
);
3633 case WM_MEASUREITEM
:
3634 f
= x_window_to_frame (dpyinfo
, hwnd
);
3637 MEASUREITEMSTRUCT
* pMis
= (MEASUREITEMSTRUCT
*) lParam
;
3639 if (pMis
->CtlType
== ODT_MENU
)
3641 /* Work out dimensions for popup menu titles. */
3642 char * title
= (char *) pMis
->itemData
;
3643 HDC hdc
= GetDC (hwnd
);
3644 HFONT menu_font
= GetCurrentObject (hdc
, OBJ_FONT
);
3645 LOGFONT menu_logfont
;
3649 GetObject (menu_font
, sizeof (menu_logfont
), &menu_logfont
);
3650 menu_logfont
.lfWeight
= FW_BOLD
;
3651 menu_font
= CreateFontIndirect (&menu_logfont
);
3652 old_font
= SelectObject (hdc
, menu_font
);
3654 pMis
->itemHeight
= GetSystemMetrics (SM_CYMENUSIZE
);
3657 if (unicode_append_menu
)
3658 GetTextExtentPoint32W (hdc
, (WCHAR
*) title
,
3659 wcslen ((WCHAR
*) title
),
3662 GetTextExtentPoint32 (hdc
, title
, strlen (title
), &size
);
3664 pMis
->itemWidth
= size
.cx
;
3665 if (pMis
->itemHeight
< size
.cy
)
3666 pMis
->itemHeight
= size
.cy
;
3669 pMis
->itemWidth
= 0;
3671 SelectObject (hdc
, old_font
);
3672 DeleteObject (menu_font
);
3673 ReleaseDC (hwnd
, hdc
);
3680 f
= x_window_to_frame (dpyinfo
, hwnd
);
3683 DRAWITEMSTRUCT
* pDis
= (DRAWITEMSTRUCT
*) lParam
;
3685 if (pDis
->CtlType
== ODT_MENU
)
3687 /* Draw popup menu title. */
3688 char * title
= (char *) pDis
->itemData
;
3691 HDC hdc
= pDis
->hDC
;
3692 HFONT menu_font
= GetCurrentObject (hdc
, OBJ_FONT
);
3693 LOGFONT menu_logfont
;
3696 GetObject (menu_font
, sizeof (menu_logfont
), &menu_logfont
);
3697 menu_logfont
.lfWeight
= FW_BOLD
;
3698 menu_font
= CreateFontIndirect (&menu_logfont
);
3699 old_font
= SelectObject (hdc
, menu_font
);
3701 /* Always draw title as if not selected. */
3702 if (unicode_append_menu
)
3705 + GetSystemMetrics (SM_CXMENUCHECK
),
3707 ETO_OPAQUE
, &pDis
->rcItem
,
3709 wcslen ((WCHAR
*) title
), NULL
);
3713 + GetSystemMetrics (SM_CXMENUCHECK
),
3715 ETO_OPAQUE
, &pDis
->rcItem
,
3716 title
, strlen (title
), NULL
);
3718 SelectObject (hdc
, old_font
);
3719 DeleteObject (menu_font
);
3727 /* Still not right - can't distinguish between clicks in the
3728 client area of the frame from clicks forwarded from the scroll
3729 bars - may have to hook WM_NCHITTEST to remember the mouse
3730 position and then check if it is in the client area ourselves. */
3731 case WM_MOUSEACTIVATE
:
3732 /* Discard the mouse click that activates a frame, allowing the
3733 user to click anywhere without changing point (or worse!).
3734 Don't eat mouse clicks on scrollbars though!! */
3735 if (LOWORD (lParam
) == HTCLIENT
)
3736 return MA_ACTIVATEANDEAT
;
3741 /* No longer tracking mouse. */
3742 track_mouse_window
= NULL
;
3744 case WM_ACTIVATEAPP
:
3746 case WM_WINDOWPOSCHANGED
:
3748 /* Inform lisp thread that a frame might have just been obscured
3749 or exposed, so should recheck visibility of all frames. */
3750 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3754 dpyinfo
->faked_key
= 0;
3756 register_hot_keys (hwnd
);
3759 unregister_hot_keys (hwnd
);
3762 /* Relinquish the system caret. */
3763 if (w32_system_caret_hwnd
)
3765 w32_visible_system_caret_hwnd
= NULL
;
3766 w32_system_caret_hwnd
= NULL
;
3772 f
= x_window_to_frame (dpyinfo
, hwnd
);
3773 if (f
&& HIWORD (wParam
) == 0)
3775 if (menu_free_timer
)
3777 KillTimer (hwnd
, menu_free_timer
);
3778 menu_free_timer
= 0;
3784 wmsg
.dwModifiers
= w32_get_modifiers ();
3785 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3793 wmsg
.dwModifiers
= w32_get_modifiers ();
3794 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3797 case WM_WINDOWPOSCHANGING
:
3798 /* Don't restrict the sizing of tip frames. */
3799 if (hwnd
== tip_window
)
3803 LPWINDOWPOS lppos
= (WINDOWPOS
*) lParam
;
3805 wp
.length
= sizeof (WINDOWPLACEMENT
);
3806 GetWindowPlacement (hwnd
, &wp
);
3808 if (wp
.showCmd
!= SW_SHOWMINIMIZED
&& (lppos
->flags
& SWP_NOSIZE
) == 0)
3815 DWORD internal_border
;
3816 DWORD scrollbar_extra
;
3819 wp
.length
= sizeof (wp
);
3820 GetWindowRect (hwnd
, &wr
);
3824 font_width
= GetWindowLong (hwnd
, WND_FONTWIDTH_INDEX
);
3825 line_height
= GetWindowLong (hwnd
, WND_LINEHEIGHT_INDEX
);
3826 internal_border
= GetWindowLong (hwnd
, WND_BORDER_INDEX
);
3827 scrollbar_extra
= GetWindowLong (hwnd
, WND_SCROLLBAR_INDEX
);
3831 memset (&rect
, 0, sizeof (rect
));
3832 AdjustWindowRect (&rect
, GetWindowLong (hwnd
, GWL_STYLE
),
3833 GetMenu (hwnd
) != NULL
);
3835 /* Force width and height of client area to be exact
3836 multiples of the character cell dimensions. */
3837 wdiff
= (lppos
->cx
- (rect
.right
- rect
.left
)
3838 - 2 * internal_border
- scrollbar_extra
)
3840 hdiff
= (lppos
->cy
- (rect
.bottom
- rect
.top
)
3841 - 2 * internal_border
)
3846 /* For right/bottom sizing we can just fix the sizes.
3847 However for top/left sizing we will need to fix the X
3848 and Y positions as well. */
3850 int cx_mintrack
= GetSystemMetrics (SM_CXMINTRACK
);
3851 int cy_mintrack
= GetSystemMetrics (SM_CYMINTRACK
);
3853 lppos
->cx
= max (lppos
->cx
- wdiff
, cx_mintrack
);
3854 lppos
->cy
= max (lppos
->cy
- hdiff
, cy_mintrack
);
3856 if (wp
.showCmd
!= SW_SHOWMAXIMIZED
3857 && (lppos
->flags
& SWP_NOMOVE
) == 0)
3859 if (lppos
->x
!= wr
.left
|| lppos
->y
!= wr
.top
)
3866 lppos
->flags
|= SWP_NOMOVE
;
3877 case WM_GETMINMAXINFO
:
3878 /* Hack to allow resizing the Emacs frame above the screen size.
3879 Note that Windows 9x limits coordinates to 16-bits. */
3880 ((LPMINMAXINFO
) lParam
)->ptMaxTrackSize
.x
= 32767;
3881 ((LPMINMAXINFO
) lParam
)->ptMaxTrackSize
.y
= 32767;
3885 if (LOWORD (lParam
) == HTCLIENT
)
3887 f
= x_window_to_frame (dpyinfo
, hwnd
);
3888 if (f
->output_data
.w32
->hourglass_p
&& !menubar_in_use
3889 && !current_popup_menu
)
3890 SetCursor (f
->output_data
.w32
->hourglass_cursor
);
3892 SetCursor (f
->output_data
.w32
->current_cursor
);
3897 case WM_EMACS_SETCURSOR
:
3899 Cursor cursor
= (Cursor
) wParam
;
3900 f
= x_window_to_frame (dpyinfo
, hwnd
);
3903 f
->output_data
.w32
->current_cursor
= cursor
;
3904 if (!f
->output_data
.w32
->hourglass_p
)
3910 case WM_EMACS_CREATESCROLLBAR
:
3911 return (LRESULT
) w32_createscrollbar ((struct frame
*) wParam
,
3912 (struct scroll_bar
*) lParam
);
3914 case WM_EMACS_SHOWWINDOW
:
3915 return ShowWindow ((HWND
) wParam
, (WPARAM
) lParam
);
3917 case WM_EMACS_SETFOREGROUND
:
3919 HWND foreground_window
;
3920 DWORD foreground_thread
, retval
;
3922 /* On NT 5.0, and apparently Windows 98, it is necessary to
3923 attach to the thread that currently has focus in order to
3924 pull the focus away from it. */
3925 foreground_window
= GetForegroundWindow ();
3926 foreground_thread
= GetWindowThreadProcessId (foreground_window
, NULL
);
3927 if (!foreground_window
3928 || foreground_thread
== GetCurrentThreadId ()
3929 || !AttachThreadInput (GetCurrentThreadId (),
3930 foreground_thread
, TRUE
))
3931 foreground_thread
= 0;
3933 retval
= SetForegroundWindow ((HWND
) wParam
);
3935 /* Detach from the previous foreground thread. */
3936 if (foreground_thread
)
3937 AttachThreadInput (GetCurrentThreadId (),
3938 foreground_thread
, FALSE
);
3943 case WM_EMACS_SETWINDOWPOS
:
3945 WINDOWPOS
* pos
= (WINDOWPOS
*) wParam
;
3946 return SetWindowPos (hwnd
, pos
->hwndInsertAfter
,
3947 pos
->x
, pos
->y
, pos
->cx
, pos
->cy
, pos
->flags
);
3950 case WM_EMACS_DESTROYWINDOW
:
3951 DragAcceptFiles ((HWND
) wParam
, FALSE
);
3952 return DestroyWindow ((HWND
) wParam
);
3954 case WM_EMACS_HIDE_CARET
:
3955 return HideCaret (hwnd
);
3957 case WM_EMACS_SHOW_CARET
:
3958 return ShowCaret (hwnd
);
3960 case WM_EMACS_DESTROY_CARET
:
3961 w32_system_caret_hwnd
= NULL
;
3962 w32_visible_system_caret_hwnd
= NULL
;
3963 return DestroyCaret ();
3965 case WM_EMACS_TRACK_CARET
:
3966 /* If there is currently no system caret, create one. */
3967 if (w32_system_caret_hwnd
== NULL
)
3969 /* Use the default caret width, and avoid changing it
3970 unneccesarily, as it confuses screen reader software. */
3971 w32_system_caret_hwnd
= hwnd
;
3972 CreateCaret (hwnd
, NULL
, 0,
3973 w32_system_caret_height
);
3976 if (!SetCaretPos (w32_system_caret_x
, w32_system_caret_y
))
3978 /* Ensure visible caret gets turned on when requested. */
3979 else if (w32_use_visible_system_caret
3980 && w32_visible_system_caret_hwnd
!= hwnd
)
3982 w32_visible_system_caret_hwnd
= hwnd
;
3983 return ShowCaret (hwnd
);
3985 /* Ensure visible caret gets turned off when requested. */
3986 else if (!w32_use_visible_system_caret
3987 && w32_visible_system_caret_hwnd
)
3989 w32_visible_system_caret_hwnd
= NULL
;
3990 return HideCaret (hwnd
);
3995 case WM_EMACS_TRACKPOPUPMENU
:
4000 pos
= (POINT
*)lParam
;
4001 flags
= TPM_CENTERALIGN
;
4002 if (button_state
& LMOUSE
)
4003 flags
|= TPM_LEFTBUTTON
;
4004 else if (button_state
& RMOUSE
)
4005 flags
|= TPM_RIGHTBUTTON
;
4007 /* Remember we did a SetCapture on the initial mouse down event,
4008 so for safety, we make sure the capture is cancelled now. */
4012 /* Use menubar_active to indicate that WM_INITMENU is from
4013 TrackPopupMenu below, and should be ignored. */
4014 f
= x_window_to_frame (dpyinfo
, hwnd
);
4016 f
->output_data
.w32
->menubar_active
= 1;
4018 if (TrackPopupMenu ((HMENU
)wParam
, flags
, pos
->x
, pos
->y
,
4022 /* Eat any mouse messages during popupmenu */
4023 while (PeekMessage (&amsg
, hwnd
, WM_MOUSEFIRST
, WM_MOUSELAST
,
4025 /* Get the menu selection, if any */
4026 if (PeekMessage (&amsg
, hwnd
, WM_COMMAND
, WM_COMMAND
, PM_REMOVE
))
4028 retval
= LOWORD (amsg
.wParam
);
4044 /* Check for messages registered at runtime. */
4045 if (msg
== msh_mousewheel
)
4047 wmsg
.dwModifiers
= w32_get_modifiers ();
4048 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4049 signal_user_input ();
4054 return DefWindowProc (hwnd
, msg
, wParam
, lParam
);
4058 /* The most common default return code for handled messages is 0. */
4063 my_create_window (f
)
4068 if (!PostThreadMessage (dwWindowsThreadId
, WM_EMACS_CREATEWINDOW
, (WPARAM
)f
, 0))
4070 GetMessage (&msg
, NULL
, WM_EMACS_DONE
, WM_EMACS_DONE
);
4074 /* Create a tooltip window. Unlike my_create_window, we do not do this
4075 indirectly via the Window thread, as we do not need to process Window
4076 messages for the tooltip. Creating tooltips indirectly also creates
4077 deadlocks when tooltips are created for menu items. */
4079 my_create_tip_window (f
)
4084 rect
.left
= rect
.top
= 0;
4085 rect
.right
= FRAME_PIXEL_WIDTH (f
);
4086 rect
.bottom
= FRAME_PIXEL_HEIGHT (f
);
4088 AdjustWindowRect (&rect
, f
->output_data
.w32
->dwStyle
,
4089 FRAME_EXTERNAL_MENU_BAR (f
));
4091 tip_window
= FRAME_W32_WINDOW (f
)
4092 = CreateWindow (EMACS_CLASS
,
4094 f
->output_data
.w32
->dwStyle
,
4097 rect
.right
- rect
.left
,
4098 rect
.bottom
- rect
.top
,
4099 FRAME_W32_WINDOW (SELECTED_FRAME ()), /* owner */
4106 SetWindowLong (tip_window
, WND_FONTWIDTH_INDEX
, FRAME_COLUMN_WIDTH (f
));
4107 SetWindowLong (tip_window
, WND_LINEHEIGHT_INDEX
, FRAME_LINE_HEIGHT (f
));
4108 SetWindowLong (tip_window
, WND_BORDER_INDEX
, FRAME_INTERNAL_BORDER_WIDTH (f
));
4109 SetWindowLong (tip_window
, WND_BACKGROUND_INDEX
, FRAME_BACKGROUND_PIXEL (f
));
4111 /* Tip frames have no scrollbars. */
4112 SetWindowLong (tip_window
, WND_SCROLLBAR_INDEX
, 0);
4114 /* Do this to discard the default setting specified by our parent. */
4115 ShowWindow (tip_window
, SW_HIDE
);
4120 /* Create and set up the w32 window for frame F. */
4123 w32_window (f
, window_prompting
, minibuffer_only
)
4125 long window_prompting
;
4126 int minibuffer_only
;
4130 /* Use the resource name as the top-level window name
4131 for looking up resources. Make a non-Lisp copy
4132 for the window manager, so GC relocation won't bother it.
4134 Elsewhere we specify the window name for the window manager. */
4137 char *str
= (char *) SDATA (Vx_resource_name
);
4138 f
->namebuf
= (char *) xmalloc (strlen (str
) + 1);
4139 strcpy (f
->namebuf
, str
);
4142 my_create_window (f
);
4144 validate_x_resource_name ();
4146 /* x_set_name normally ignores requests to set the name if the
4147 requested name is the same as the current name. This is the one
4148 place where that assumption isn't correct; f->name is set, but
4149 the server hasn't been told. */
4152 int explicit = f
->explicit_name
;
4154 f
->explicit_name
= 0;
4157 x_set_name (f
, name
, explicit);
4162 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
4163 initialize_frame_menubar (f
);
4165 if (FRAME_W32_WINDOW (f
) == 0)
4166 error ("Unable to create window");
4169 /* Handle the icon stuff for this window. Perhaps later we might
4170 want an x_set_icon_position which can be called interactively as
4178 Lisp_Object icon_x
, icon_y
;
4180 /* Set the position of the icon. Note that Windows 95 groups all
4181 icons in the tray. */
4182 icon_x
= w32_get_arg (parms
, Qicon_left
, 0, 0, RES_TYPE_NUMBER
);
4183 icon_y
= w32_get_arg (parms
, Qicon_top
, 0, 0, RES_TYPE_NUMBER
);
4184 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
4186 CHECK_NUMBER (icon_x
);
4187 CHECK_NUMBER (icon_y
);
4189 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
4190 error ("Both left and top icon corners of icon must be specified");
4194 if (! EQ (icon_x
, Qunbound
))
4195 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
4198 /* Start up iconic or window? */
4199 x_wm_set_window_state
4200 (f
, (EQ (w32_get_arg (parms
, Qvisibility
, 0, 0, RES_TYPE_SYMBOL
), Qicon
)
4204 x_text_icon (f
, (char *) SDATA ((!NILP (f
->icon_name
)
4217 XGCValues gc_values
;
4221 /* Create the GC's of this frame.
4222 Note that many default values are used. */
4225 gc_values
.font
= FRAME_FONT (f
);
4227 /* Cursor has cursor-color background, background-color foreground. */
4228 gc_values
.foreground
= FRAME_BACKGROUND_PIXEL (f
);
4229 gc_values
.background
= f
->output_data
.w32
->cursor_pixel
;
4230 f
->output_data
.w32
->cursor_gc
4231 = XCreateGC (NULL
, FRAME_W32_WINDOW (f
),
4232 (GCFont
| GCForeground
| GCBackground
),
4236 f
->output_data
.w32
->white_relief
.gc
= 0;
4237 f
->output_data
.w32
->black_relief
.gc
= 0;
4243 /* Handler for signals raised during x_create_frame and
4244 x_create_top_frame. FRAME is the frame which is partially
4248 unwind_create_frame (frame
)
4251 struct frame
*f
= XFRAME (frame
);
4253 /* If frame is ``official'', nothing to do. */
4254 if (!CONSP (Vframe_list
) || !EQ (XCAR (Vframe_list
), frame
))
4257 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
4260 x_free_frame_resources (f
);
4262 /* Check that reference counts are indeed correct. */
4263 xassert (dpyinfo
->reference_count
== dpyinfo_refcount
);
4264 xassert (dpyinfo
->image_cache
->refcount
== image_cache_refcount
);
4273 x_default_font_parameter (f
, parms
)
4277 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
4278 Lisp_Object font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font",
4281 if (!STRINGP (font
))
4284 static char *names
[]
4285 = { "Courier New-10",
4286 "-*-Courier-normal-r-*-*-13-*-*-*-c-*-iso8859-1",
4287 "-*-Fixedsys-normal-r-*-*-12-*-*-*-c-*-iso8859-1",
4291 for (i
= 0; names
[i
]; i
++)
4293 font
= font_open_by_name (f
, names
[i
]);
4298 error ("No suitable font was found");
4300 x_default_parameter (f
, parms
, Qfont
, font
, "font", "Font", RES_TYPE_STRING
);
4303 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
4305 doc
: /* Make a new window, which is called a \"frame\" in Emacs terms.
4306 Return an Emacs frame object.
4307 PARAMETERS is an alist of frame parameters.
4308 If the parameters specify that the frame should not have a minibuffer,
4309 and do not specify a specific minibuffer window to use,
4310 then `default-minibuffer-frame' must be a frame whose minibuffer can
4311 be shared by the new frame.
4313 This function is an internal primitive--use `make-frame' instead. */)
4315 Lisp_Object parameters
;
4318 Lisp_Object frame
, tem
;
4320 int minibuffer_only
= 0;
4321 long window_prompting
= 0;
4323 int count
= SPECPDL_INDEX ();
4324 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
4325 Lisp_Object display
;
4326 struct w32_display_info
*dpyinfo
= NULL
;
4332 /* Make copy of frame parameters because the original is in pure
4334 parameters
= Fcopy_alist (parameters
);
4336 /* Use this general default value to start with
4337 until we know if this frame has a specified name. */
4338 Vx_resource_name
= Vinvocation_name
;
4340 display
= w32_get_arg (parameters
, Qdisplay
, 0, 0, RES_TYPE_STRING
);
4341 if (EQ (display
, Qunbound
))
4343 dpyinfo
= check_x_display_info (display
);
4345 kb
= dpyinfo
->terminal
->kboard
;
4347 kb
= &the_only_kboard
;
4350 name
= w32_get_arg (parameters
, Qname
, "name", "Name", RES_TYPE_STRING
);
4352 && ! EQ (name
, Qunbound
)
4354 error ("Invalid frame name--not a string or nil");
4357 Vx_resource_name
= name
;
4359 /* See if parent window is specified. */
4360 parent
= w32_get_arg (parameters
, Qparent_id
, NULL
, NULL
, RES_TYPE_NUMBER
);
4361 if (EQ (parent
, Qunbound
))
4363 if (! NILP (parent
))
4364 CHECK_NUMBER (parent
);
4366 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
4367 /* No need to protect DISPLAY because that's not used after passing
4368 it to make_frame_without_minibuffer. */
4370 GCPRO4 (parameters
, parent
, name
, frame
);
4371 tem
= w32_get_arg (parameters
, Qminibuffer
, "minibuffer", "Minibuffer",
4373 if (EQ (tem
, Qnone
) || NILP (tem
))
4374 f
= make_frame_without_minibuffer (Qnil
, kb
, display
);
4375 else if (EQ (tem
, Qonly
))
4377 f
= make_minibuffer_frame ();
4378 minibuffer_only
= 1;
4380 else if (WINDOWP (tem
))
4381 f
= make_frame_without_minibuffer (tem
, kb
, display
);
4385 XSETFRAME (frame
, f
);
4387 /* Note that Windows does support scroll bars. */
4388 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
4390 /* By default, make scrollbars the system standard width. */
4391 FRAME_CONFIG_SCROLL_BAR_WIDTH (f
) = GetSystemMetrics (SM_CXVSCROLL
);
4393 f
->terminal
= dpyinfo
->terminal
;
4394 f
->terminal
->reference_count
++;
4396 f
->output_method
= output_w32
;
4397 f
->output_data
.w32
=
4398 (struct w32_output
*) xmalloc (sizeof (struct w32_output
));
4399 bzero (f
->output_data
.w32
, sizeof (struct w32_output
));
4400 FRAME_FONTSET (f
) = -1;
4401 record_unwind_protect (unwind_create_frame
, frame
);
4404 = w32_get_arg (parameters
, Qicon_name
, "iconName", "Title", RES_TYPE_STRING
);
4405 if (! STRINGP (f
->icon_name
))
4406 f
->icon_name
= Qnil
;
4408 /* FRAME_W32_DISPLAY_INFO (f) = dpyinfo; */
4410 FRAME_KBOARD (f
) = kb
;
4413 /* Specify the parent under which to make this window. */
4417 f
->output_data
.w32
->parent_desc
= (Window
) XFASTINT (parent
);
4418 f
->output_data
.w32
->explicit_parent
= 1;
4422 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
4423 f
->output_data
.w32
->explicit_parent
= 0;
4426 /* Set the name; the functions to which we pass f expect the name to
4428 if (EQ (name
, Qunbound
) || NILP (name
))
4430 f
->name
= build_string (dpyinfo
->w32_id_name
);
4431 f
->explicit_name
= 0;
4436 f
->explicit_name
= 1;
4437 /* use the frame's title when getting resources for this frame. */
4438 specbind (Qx_resource_name
, name
);
4441 f
->resx
= dpyinfo
->resx
;
4442 f
->resy
= dpyinfo
->resy
;
4444 if (uniscribe_available
)
4445 register_font_driver (&uniscribe_font_driver
, f
);
4446 register_font_driver (&w32font_driver
, f
);
4448 x_default_parameter (f
, parameters
, Qfont_backend
, Qnil
,
4449 "fontBackend", "FontBackend", RES_TYPE_STRING
);
4450 /* Extract the window parameters from the supplied values
4451 that are needed to determine window geometry. */
4452 x_default_font_parameter (f
, parameters
);
4453 x_default_parameter (f
, parameters
, Qborder_width
, make_number (2),
4454 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
4455 /* This defaults to 2 in order to match xterm. We recognize either
4456 internalBorderWidth or internalBorder (which is what xterm calls
4458 if (NILP (Fassq (Qinternal_border_width
, parameters
)))
4462 value
= w32_get_arg (parameters
, Qinternal_border_width
,
4463 "internalBorder", "InternalBorder", RES_TYPE_NUMBER
);
4464 if (! EQ (value
, Qunbound
))
4465 parameters
= Fcons (Fcons (Qinternal_border_width
, value
),
4468 /* Default internalBorderWidth to 0 on Windows to match other programs. */
4469 x_default_parameter (f
, parameters
, Qinternal_border_width
, make_number (0),
4470 "internalBorderWidth", "InternalBorder", RES_TYPE_NUMBER
);
4471 x_default_parameter (f
, parameters
, Qvertical_scroll_bars
, Qright
,
4472 "verticalScrollBars", "ScrollBars", RES_TYPE_SYMBOL
);
4474 /* Also do the stuff which must be set before the window exists. */
4475 x_default_parameter (f
, parameters
, Qforeground_color
, build_string ("black"),
4476 "foreground", "Foreground", RES_TYPE_STRING
);
4477 x_default_parameter (f
, parameters
, Qbackground_color
, build_string ("white"),
4478 "background", "Background", RES_TYPE_STRING
);
4479 x_default_parameter (f
, parameters
, Qmouse_color
, build_string ("black"),
4480 "pointerColor", "Foreground", RES_TYPE_STRING
);
4481 x_default_parameter (f
, parameters
, Qcursor_color
, build_string ("black"),
4482 "cursorColor", "Foreground", RES_TYPE_STRING
);
4483 x_default_parameter (f
, parameters
, Qborder_color
, build_string ("black"),
4484 "borderColor", "BorderColor", RES_TYPE_STRING
);
4485 x_default_parameter (f
, parameters
, Qscreen_gamma
, Qnil
,
4486 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT
);
4487 x_default_parameter (f
, parameters
, Qline_spacing
, Qnil
,
4488 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER
);
4489 x_default_parameter (f
, parameters
, Qleft_fringe
, Qnil
,
4490 "leftFringe", "LeftFringe", RES_TYPE_NUMBER
);
4491 x_default_parameter (f
, parameters
, Qright_fringe
, Qnil
,
4492 "rightFringe", "RightFringe", RES_TYPE_NUMBER
);
4495 /* Init faces before x_default_parameter is called for scroll-bar
4496 parameters because that function calls x_set_scroll_bar_width,
4497 which calls change_frame_size, which calls Fset_window_buffer,
4498 which runs hooks, which call Fvertical_motion. At the end, we
4499 end up in init_iterator with a null face cache, which should not
4501 init_frame_faces (f
);
4503 x_default_parameter (f
, parameters
, Qmenu_bar_lines
, make_number (1),
4504 "menuBar", "MenuBar", RES_TYPE_NUMBER
);
4505 x_default_parameter (f
, parameters
, Qtool_bar_lines
, make_number (1),
4506 "toolBar", "ToolBar", RES_TYPE_NUMBER
);
4508 x_default_parameter (f
, parameters
, Qbuffer_predicate
, Qnil
,
4509 "bufferPredicate", "BufferPredicate", RES_TYPE_SYMBOL
);
4510 x_default_parameter (f
, parameters
, Qtitle
, Qnil
,
4511 "title", "Title", RES_TYPE_STRING
);
4512 x_default_parameter (f
, parameters
, Qfullscreen
, Qnil
,
4513 "fullscreen", "Fullscreen", RES_TYPE_SYMBOL
);
4515 f
->output_data
.w32
->dwStyle
= WS_OVERLAPPEDWINDOW
;
4516 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
4518 f
->output_data
.w32
->text_cursor
= w32_load_cursor (IDC_IBEAM
);
4519 f
->output_data
.w32
->nontext_cursor
= w32_load_cursor (IDC_ARROW
);
4520 f
->output_data
.w32
->modeline_cursor
= w32_load_cursor (IDC_ARROW
);
4521 f
->output_data
.w32
->hand_cursor
= w32_load_cursor (IDC_HAND
);
4522 f
->output_data
.w32
->hourglass_cursor
= w32_load_cursor (IDC_WAIT
);
4523 f
->output_data
.w32
->horizontal_drag_cursor
= w32_load_cursor (IDC_SIZEWE
);
4525 f
->output_data
.w32
->current_cursor
= f
->output_data
.w32
->nontext_cursor
;
4527 window_prompting
= x_figure_window_size (f
, parameters
, 1);
4529 tem
= w32_get_arg (parameters
, Qunsplittable
, 0, 0, RES_TYPE_BOOLEAN
);
4530 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
4532 w32_window (f
, window_prompting
, minibuffer_only
);
4533 x_icon (f
, parameters
);
4537 /* Now consider the frame official. */
4538 FRAME_W32_DISPLAY_INFO (f
)->reference_count
++;
4539 Vframe_list
= Fcons (frame
, Vframe_list
);
4541 /* We need to do this after creating the window, so that the
4542 icon-creation functions can say whose icon they're describing. */
4543 x_default_parameter (f
, parameters
, Qicon_type
, Qnil
,
4544 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL
);
4546 x_default_parameter (f
, parameters
, Qauto_raise
, Qnil
,
4547 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4548 x_default_parameter (f
, parameters
, Qauto_lower
, Qnil
,
4549 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4550 x_default_parameter (f
, parameters
, Qcursor_type
, Qbox
,
4551 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
4552 x_default_parameter (f
, parameters
, Qscroll_bar_width
, Qnil
,
4553 "scrollBarWidth", "ScrollBarWidth", RES_TYPE_NUMBER
);
4555 /* Dimensions, especially FRAME_LINES (f), must be done via change_frame_size.
4556 Change will not be effected unless different from the current
4558 width
= FRAME_COLS (f
);
4559 height
= FRAME_LINES (f
);
4561 FRAME_LINES (f
) = 0;
4562 SET_FRAME_COLS (f
, 0);
4563 change_frame_size (f
, height
, width
, 1, 0, 0);
4565 /* Tell the server what size and position, etc, we want, and how
4566 badly we want them. This should be done after we have the menu
4567 bar so that its size can be taken into account. */
4569 x_wm_set_size_hint (f
, window_prompting
, 0);
4572 /* Make the window appear on the frame and enable display, unless
4573 the caller says not to. However, with explicit parent, Emacs
4574 cannot control visibility, so don't try. */
4575 if (! f
->output_data
.w32
->explicit_parent
)
4577 Lisp_Object visibility
;
4579 visibility
= w32_get_arg (parameters
, Qvisibility
, 0, 0, RES_TYPE_SYMBOL
);
4580 if (EQ (visibility
, Qunbound
))
4583 if (EQ (visibility
, Qicon
))
4584 x_iconify_frame (f
);
4585 else if (! NILP (visibility
))
4586 x_make_frame_visible (f
);
4588 /* Must have been Qnil. */
4592 /* Initialize `default-minibuffer-frame' in case this is the first
4593 frame on this terminal. */
4594 if (FRAME_HAS_MINIBUF_P (f
)
4595 && (!FRAMEP (kb
->Vdefault_minibuffer_frame
)
4596 || !FRAME_LIVE_P (XFRAME (kb
->Vdefault_minibuffer_frame
))))
4597 kb
->Vdefault_minibuffer_frame
= frame
;
4599 /* All remaining specified parameters, which have not been "used"
4600 by x_get_arg and friends, now go in the misc. alist of the frame. */
4601 for (tem
= parameters
; CONSP (tem
); tem
= XCDR (tem
))
4602 if (CONSP (XCAR (tem
)) && !NILP (XCAR (XCAR (tem
))))
4603 f
->param_alist
= Fcons (XCAR (tem
), f
->param_alist
);
4607 /* Make sure windows on this frame appear in calls to next-window
4608 and similar functions. */
4609 Vwindow_list
= Qnil
;
4611 return unbind_to (count
, frame
);
4614 /* FRAME is used only to get a handle on the X display. We don't pass the
4615 display info directly because we're called from frame.c, which doesn't
4616 know about that structure. */
4618 x_get_focus_frame (frame
)
4619 struct frame
*frame
;
4621 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (frame
);
4623 if (! dpyinfo
->w32_focus_frame
)
4626 XSETFRAME (xfocus
, dpyinfo
->w32_focus_frame
);
4630 DEFUN ("x-focus-frame", Fx_focus_frame
, Sx_focus_frame
, 1, 1, 0,
4631 doc
: /* Give FRAME input focus, raising to foreground if necessary. */)
4635 x_focus_on_frame (check_x_frame (frame
));
4642 /* Return the charset portion of a font name. */
4644 xlfd_charset_of_font (char * fontname
)
4646 char *charset
, *encoding
;
4648 encoding
= strrchr (fontname
, '-');
4649 if (!encoding
|| encoding
== fontname
)
4652 for (charset
= encoding
- 1; charset
>= fontname
; charset
--)
4653 if (*charset
== '-')
4656 if (charset
== fontname
|| strcmp (charset
, "-*-*") == 0)
4662 struct font_info
*w32_load_bdf_font (struct frame
*f
, char *fontname
,
4663 int size
, char* filename
);
4664 static Lisp_Object
w32_list_bdf_fonts (Lisp_Object pattern
, int max_names
);
4665 static BOOL
w32_to_x_font (LOGFONT
* lplf
, char * lpxstr
, int len
,
4667 static BOOL
x_to_w32_font (char *lpxstr
, LOGFONT
*lplogfont
);
4669 static struct font_info
*
4670 w32_load_system_font (f
, fontname
, size
)
4675 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
4676 Lisp_Object font_names
;
4678 /* Get a list of all the fonts that match this name. Once we
4679 have a list of matching fonts, we compare them against the fonts
4680 we already have loaded by comparing names. */
4681 font_names
= w32_list_fonts (f
, build_string (fontname
), size
, 100);
4683 if (!NILP (font_names
))
4688 /* First check if any are already loaded, as that is cheaper
4689 than loading another one. */
4690 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
4691 for (tail
= font_names
; CONSP (tail
); tail
= XCDR (tail
))
4692 if (dpyinfo
->font_table
[i
].name
4693 && (!strcmp (dpyinfo
->font_table
[i
].name
,
4694 SDATA (XCAR (tail
)))
4695 || !strcmp (dpyinfo
->font_table
[i
].full_name
,
4696 SDATA (XCAR (tail
)))))
4697 return (dpyinfo
->font_table
+ i
);
4699 fontname
= (char *) SDATA (XCAR (font_names
));
4701 else if (w32_strict_fontnames
)
4703 /* If EnumFontFamiliesEx was available, we got a full list of
4704 fonts back so stop now to avoid the possibility of loading a
4705 random font. If we had to fall back to EnumFontFamilies, the
4706 list is incomplete, so continue whether the font we want was
4708 HMODULE gdi32
= GetModuleHandle ("gdi32.dll");
4709 FARPROC enum_font_families_ex
4710 = GetProcAddress (gdi32
, "EnumFontFamiliesExA");
4711 if (enum_font_families_ex
)
4715 /* Load the font and add it to the table. */
4717 char *full_name
, *encoding
, *charset
;
4719 struct font_info
*fontp
;
4725 if (!fontname
|| !x_to_w32_font (fontname
, &lf
))
4728 if (!*lf
.lfFaceName
)
4729 /* If no name was specified for the font, we get a random font
4730 from CreateFontIndirect - this is not particularly
4731 desirable, especially since CreateFontIndirect does not
4732 fill out the missing name in lf, so we never know what we
4736 lf
.lfQuality
= DEFAULT_QUALITY
;
4738 font
= (XFontStruct
*) xmalloc (sizeof (XFontStruct
));
4739 bzero (font
, sizeof (*font
));
4741 /* Set bdf to NULL to indicate that this is a Windows font. */
4746 font
->hfont
= CreateFontIndirect (&lf
);
4748 if (font
->hfont
== NULL
)
4757 codepage
= w32_codepage_for_font (fontname
);
4759 hdc
= GetDC (dpyinfo
->root_window
);
4760 oldobj
= SelectObject (hdc
, font
->hfont
);
4762 ok
= GetTextMetrics (hdc
, &font
->tm
);
4763 if (codepage
== CP_UNICODE
)
4764 font
->double_byte_p
= 1;
4767 /* Unfortunately, some fonts (eg. MingLiU, a big5 ttf font)
4768 don't report themselves as double byte fonts, when
4769 patently they are. So instead of trusting
4770 GetFontLanguageInfo, we check the properties of the
4771 codepage directly, since that is ultimately what we are
4772 working from anyway. */
4773 /* font->double_byte_p = GetFontLanguageInfo (hdc) & GCP_DBCS; */
4775 GetCPInfo (codepage
, &cpi
);
4776 font
->double_byte_p
= cpi
.MaxCharSize
> 1;
4779 SelectObject (hdc
, oldobj
);
4780 ReleaseDC (dpyinfo
->root_window
, hdc
);
4781 /* Fill out details in lf according to the font that was
4783 lf
.lfHeight
= font
->tm
.tmInternalLeading
- font
->tm
.tmHeight
;
4784 lf
.lfWidth
= font
->tm
.tmMaxCharWidth
;
4785 lf
.lfWeight
= font
->tm
.tmWeight
;
4786 lf
.lfItalic
= font
->tm
.tmItalic
;
4787 lf
.lfCharSet
= font
->tm
.tmCharSet
;
4788 lf
.lfPitchAndFamily
= ((font
->tm
.tmPitchAndFamily
& TMPF_FIXED_PITCH
)
4789 ? VARIABLE_PITCH
: FIXED_PITCH
);
4790 lf
.lfOutPrecision
= ((font
->tm
.tmPitchAndFamily
& TMPF_VECTOR
)
4791 ? OUT_STROKE_PRECIS
: OUT_STRING_PRECIS
);
4793 w32_cache_char_metrics (font
);
4800 w32_unload_font (dpyinfo
, font
);
4804 /* Find a free slot in the font table. */
4805 for (i
= 0; i
< dpyinfo
->n_fonts
; ++i
)
4806 if (dpyinfo
->font_table
[i
].name
== NULL
)
4809 /* If no free slot found, maybe enlarge the font table. */
4810 if (i
== dpyinfo
->n_fonts
4811 && dpyinfo
->n_fonts
== dpyinfo
->font_table_size
)
4814 dpyinfo
->font_table_size
= max (16, 2 * dpyinfo
->font_table_size
);
4815 sz
= dpyinfo
->font_table_size
* sizeof *dpyinfo
->font_table
;
4817 = (struct font_info
*) xrealloc (dpyinfo
->font_table
, sz
);
4820 fontp
= dpyinfo
->font_table
+ i
;
4821 if (i
== dpyinfo
->n_fonts
)
4824 /* Now fill in the slots of *FONTP. */
4826 bzero (fontp
, sizeof (*fontp
));
4828 fontp
->font_idx
= i
;
4829 fontp
->name
= (char *) xmalloc (strlen (fontname
) + 1);
4830 bcopy (fontname
, fontp
->name
, strlen (fontname
) + 1);
4832 if ((lf
.lfPitchAndFamily
& 0x03) == FIXED_PITCH
)
4834 /* Fixed width font. */
4835 fontp
->average_width
= fontp
->space_width
= FONT_AVG_WIDTH (font
);
4841 pcm
= w32_per_char_metric (font
, &space
, ANSI_FONT
);
4843 fontp
->space_width
= pcm
->width
;
4845 fontp
->space_width
= FONT_AVG_WIDTH (font
);
4847 fontp
->average_width
= font
->tm
.tmAveCharWidth
;
4850 fontp
->charset
= -1;
4851 charset
= xlfd_charset_of_font (fontname
);
4853 /* Cache the W32 codepage for a font. This makes w32_encode_char
4854 (called for every glyph during redisplay) much faster. */
4855 fontp
->codepage
= codepage
;
4857 /* Work out the font's full name. */
4858 full_name
= (char *)xmalloc (100);
4859 if (full_name
&& w32_to_x_font (&lf
, full_name
, 100, charset
))
4860 fontp
->full_name
= full_name
;
4863 /* If all else fails - just use the name we used to load it. */
4865 fontp
->full_name
= fontp
->name
;
4868 fontp
->size
= FONT_WIDTH (font
);
4869 fontp
->height
= FONT_HEIGHT (font
);
4871 /* The slot `encoding' specifies how to map a character
4872 code-points (0x20..0x7F or 0x2020..0x7F7F) of each charset to
4873 the font code-points (0:0x20..0x7F, 1:0xA0..0xFF), or
4874 (0:0x20..0x7F, 1:0xA0..0xFF,
4875 (0:0x2020..0x7F7F, 1:0xA0A0..0xFFFF, 3:0x20A0..0x7FFF,
4876 2:0xA020..0xFF7F). For the moment, we don't know which charset
4877 uses this font. So, we set information in fontp->encoding_type
4878 which is never used by any charset. If mapping can't be
4879 decided, set FONT_ENCODING_NOT_DECIDED. */
4881 /* SJIS fonts need to be set to type 4, all others seem to work as
4882 type FONT_ENCODING_NOT_DECIDED. */
4883 encoding
= strrchr (fontp
->name
, '-');
4884 if (encoding
&& strnicmp (encoding
+1, "sjis", 4) == 0)
4885 fontp
->encoding_type
= 4;
4887 fontp
->encoding_type
= FONT_ENCODING_NOT_DECIDED
;
4889 /* The following three values are set to 0 under W32, which is
4890 what they get set to if XGetFontProperty fails under X. */
4891 fontp
->baseline_offset
= 0;
4892 fontp
->relative_compose
= 0;
4893 fontp
->default_ascent
= 0;
4895 /* Set global flag fonts_changed_p to non-zero if the font loaded
4896 has a character with a smaller width than any other character
4897 before, or if the font loaded has a smaller height than any
4898 other font loaded before. If this happens, it will make a
4899 glyph matrix reallocation necessary. */
4900 fonts_changed_p
|= x_compute_min_glyph_bounds (f
);
4906 /* Load font named FONTNAME of size SIZE for frame F, and return a
4907 pointer to the structure font_info while allocating it dynamically.
4908 If loading fails, return NULL. */
4910 w32_load_font (f
, fontname
, size
)
4915 Lisp_Object bdf_fonts
;
4916 struct font_info
*retval
= NULL
;
4917 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
4919 bdf_fonts
= w32_list_bdf_fonts (build_string (fontname
), 1);
4921 while (!retval
&& CONSP (bdf_fonts
))
4923 char *bdf_name
, *bdf_file
;
4924 Lisp_Object bdf_pair
;
4927 bdf_name
= SDATA (XCAR (bdf_fonts
));
4928 bdf_pair
= Fassoc (XCAR (bdf_fonts
), Vw32_bdf_filename_alist
);
4929 bdf_file
= SDATA (XCDR (bdf_pair
));
4931 /* If the font is already loaded, do not load it again. */
4932 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
4934 if ((dpyinfo
->font_table
[i
].name
4935 && !strcmp (dpyinfo
->font_table
[i
].name
, bdf_name
))
4936 || (dpyinfo
->font_table
[i
].full_name
4937 && !strcmp (dpyinfo
->font_table
[i
].full_name
, bdf_name
)))
4938 return dpyinfo
->font_table
+ i
;
4941 retval
= w32_load_bdf_font (f
, bdf_name
, size
, bdf_file
);
4943 bdf_fonts
= XCDR (bdf_fonts
);
4949 return w32_load_system_font (f
, fontname
, size
);
4954 w32_unload_font (dpyinfo
, font
)
4955 struct w32_display_info
*dpyinfo
;
4960 if (font
->per_char
) xfree (font
->per_char
);
4961 if (font
->bdf
) w32_free_bdf_font (font
->bdf
);
4963 if (font
->hfont
) DeleteObject (font
->hfont
);
4967 #endif /* OLD_FONT */
4969 /* The font conversion stuff between x and w32 */
4971 /* X font string is as follows (from faces.el)
4975 * (weight "\\(bold\\|demibold\\|medium\\)") ; 1
4976 * (weight\? "\\([^-]*\\)") ; 1
4977 * (slant "\\([ior]\\)") ; 2
4978 * (slant\? "\\([^-]?\\)") ; 2
4979 * (swidth "\\([^-]*\\)") ; 3
4980 * (adstyle "[^-]*") ; 4
4981 * (pixelsize "[0-9]+")
4982 * (pointsize "[0-9][0-9]+")
4983 * (resx "[0-9][0-9]+")
4984 * (resy "[0-9][0-9]+")
4985 * (spacing "[cmp?*]")
4986 * (avgwidth "[0-9]+")
4987 * (registry "[^-]+")
4988 * (encoding "[^-]+")
4993 x_to_w32_weight (lpw
)
4996 if (!lpw
) return (FW_DONTCARE
);
4998 if (stricmp (lpw
, "heavy") == 0) return FW_HEAVY
;
4999 else if (stricmp (lpw
, "extrabold") == 0) return FW_EXTRABOLD
;
5000 else if (stricmp (lpw
, "bold") == 0) return FW_BOLD
;
5001 else if (stricmp (lpw
, "demibold") == 0) return FW_SEMIBOLD
;
5002 else if (stricmp (lpw
, "semibold") == 0) return FW_SEMIBOLD
;
5003 else if (stricmp (lpw
, "medium") == 0) return FW_MEDIUM
;
5004 else if (stricmp (lpw
, "normal") == 0) return FW_NORMAL
;
5005 else if (stricmp (lpw
, "light") == 0) return FW_LIGHT
;
5006 else if (stricmp (lpw
, "extralight") == 0) return FW_EXTRALIGHT
;
5007 else if (stricmp (lpw
, "thin") == 0) return FW_THIN
;
5014 w32_to_x_weight (fnweight
)
5017 if (fnweight
>= FW_HEAVY
) return "heavy";
5018 if (fnweight
>= FW_EXTRABOLD
) return "extrabold";
5019 if (fnweight
>= FW_BOLD
) return "bold";
5020 if (fnweight
>= FW_SEMIBOLD
) return "demibold";
5021 if (fnweight
>= FW_MEDIUM
) return "medium";
5022 if (fnweight
>= FW_NORMAL
) return "normal";
5023 if (fnweight
>= FW_LIGHT
) return "light";
5024 if (fnweight
>= FW_EXTRALIGHT
) return "extralight";
5025 if (fnweight
>= FW_THIN
) return "thin";
5031 x_to_w32_charset (lpcs
)
5034 Lisp_Object this_entry
, w32_charset
;
5036 int len
= strlen (lpcs
);
5038 /* Support "*-#nnn" format for unknown charsets. */
5039 if (strncmp (lpcs
, "*-#", 3) == 0)
5040 return atoi (lpcs
+ 3);
5042 /* All Windows fonts qualify as unicode. */
5043 if (!strncmp (lpcs
, "iso10646", 8))
5044 return DEFAULT_CHARSET
;
5046 /* Handle wildcards by ignoring them; eg. treat "big5*-*" as "big5". */
5047 charset
= alloca (len
+ 1);
5048 strcpy (charset
, lpcs
);
5049 lpcs
= strchr (charset
, '*');
5053 /* Look through w32-charset-info-alist for the character set.
5054 Format of each entry is
5055 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
5057 this_entry
= Fassoc (build_string (charset
), Vw32_charset_info_alist
);
5059 if (NILP (this_entry
))
5061 /* At startup, we want iso8859-1 fonts to come up properly. */
5062 if (stricmp (charset
, "iso8859-1") == 0)
5063 return ANSI_CHARSET
;
5065 return DEFAULT_CHARSET
;
5068 w32_charset
= Fcar (Fcdr (this_entry
));
5070 /* Translate Lisp symbol to number. */
5071 if (EQ (w32_charset
, Qw32_charset_ansi
))
5072 return ANSI_CHARSET
;
5073 if (EQ (w32_charset
, Qw32_charset_symbol
))
5074 return SYMBOL_CHARSET
;
5075 if (EQ (w32_charset
, Qw32_charset_shiftjis
))
5076 return SHIFTJIS_CHARSET
;
5077 if (EQ (w32_charset
, Qw32_charset_hangeul
))
5078 return HANGEUL_CHARSET
;
5079 if (EQ (w32_charset
, Qw32_charset_chinesebig5
))
5080 return CHINESEBIG5_CHARSET
;
5081 if (EQ (w32_charset
, Qw32_charset_gb2312
))
5082 return GB2312_CHARSET
;
5083 if (EQ (w32_charset
, Qw32_charset_oem
))
5085 #ifdef JOHAB_CHARSET
5086 if (EQ (w32_charset
, Qw32_charset_johab
))
5087 return JOHAB_CHARSET
;
5088 if (EQ (w32_charset
, Qw32_charset_easteurope
))
5089 return EASTEUROPE_CHARSET
;
5090 if (EQ (w32_charset
, Qw32_charset_turkish
))
5091 return TURKISH_CHARSET
;
5092 if (EQ (w32_charset
, Qw32_charset_baltic
))
5093 return BALTIC_CHARSET
;
5094 if (EQ (w32_charset
, Qw32_charset_russian
))
5095 return RUSSIAN_CHARSET
;
5096 if (EQ (w32_charset
, Qw32_charset_arabic
))
5097 return ARABIC_CHARSET
;
5098 if (EQ (w32_charset
, Qw32_charset_greek
))
5099 return GREEK_CHARSET
;
5100 if (EQ (w32_charset
, Qw32_charset_hebrew
))
5101 return HEBREW_CHARSET
;
5102 if (EQ (w32_charset
, Qw32_charset_vietnamese
))
5103 return VIETNAMESE_CHARSET
;
5104 if (EQ (w32_charset
, Qw32_charset_thai
))
5105 return THAI_CHARSET
;
5106 if (EQ (w32_charset
, Qw32_charset_mac
))
5108 #endif /* JOHAB_CHARSET */
5109 #ifdef UNICODE_CHARSET
5110 if (EQ (w32_charset
, Qw32_charset_unicode
))
5111 return UNICODE_CHARSET
;
5114 return DEFAULT_CHARSET
;
5119 w32_to_x_charset (fncharset
, matching
)
5123 static char buf
[32];
5124 Lisp_Object charset_type
;
5129 /* If fully specified, accept it as it is. Otherwise use a
5131 char *wildcard
= strchr (matching
, '*');
5134 else if (strchr (matching
, '-'))
5137 match_len
= strlen (matching
);
5143 /* Handle startup case of w32-charset-info-alist not
5144 being set up yet. */
5145 if (NILP (Vw32_charset_info_alist
))
5147 charset_type
= Qw32_charset_ansi
;
5149 case DEFAULT_CHARSET
:
5150 charset_type
= Qw32_charset_default
;
5152 case SYMBOL_CHARSET
:
5153 charset_type
= Qw32_charset_symbol
;
5155 case SHIFTJIS_CHARSET
:
5156 charset_type
= Qw32_charset_shiftjis
;
5158 case HANGEUL_CHARSET
:
5159 charset_type
= Qw32_charset_hangeul
;
5161 case GB2312_CHARSET
:
5162 charset_type
= Qw32_charset_gb2312
;
5164 case CHINESEBIG5_CHARSET
:
5165 charset_type
= Qw32_charset_chinesebig5
;
5168 charset_type
= Qw32_charset_oem
;
5171 /* More recent versions of Windows (95 and NT4.0) define more
5173 #ifdef EASTEUROPE_CHARSET
5174 case EASTEUROPE_CHARSET
:
5175 charset_type
= Qw32_charset_easteurope
;
5177 case TURKISH_CHARSET
:
5178 charset_type
= Qw32_charset_turkish
;
5180 case BALTIC_CHARSET
:
5181 charset_type
= Qw32_charset_baltic
;
5183 case RUSSIAN_CHARSET
:
5184 charset_type
= Qw32_charset_russian
;
5186 case ARABIC_CHARSET
:
5187 charset_type
= Qw32_charset_arabic
;
5190 charset_type
= Qw32_charset_greek
;
5192 case HEBREW_CHARSET
:
5193 charset_type
= Qw32_charset_hebrew
;
5195 case VIETNAMESE_CHARSET
:
5196 charset_type
= Qw32_charset_vietnamese
;
5199 charset_type
= Qw32_charset_thai
;
5202 charset_type
= Qw32_charset_mac
;
5205 charset_type
= Qw32_charset_johab
;
5209 #ifdef UNICODE_CHARSET
5210 case UNICODE_CHARSET
:
5211 charset_type
= Qw32_charset_unicode
;
5215 /* Encode numerical value of unknown charset. */
5216 sprintf (buf
, "*-#%u", fncharset
);
5222 char * best_match
= NULL
;
5223 int matching_found
= 0;
5225 /* Look through w32-charset-info-alist for the character set.
5226 Prefer ISO codepages, and prefer lower numbers in the ISO
5227 range. Only return charsets for codepages which are installed.
5229 Format of each entry is
5230 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
5232 for (rest
= Vw32_charset_info_alist
; CONSP (rest
); rest
= XCDR (rest
))
5235 Lisp_Object w32_charset
;
5236 Lisp_Object codepage
;
5238 Lisp_Object this_entry
= XCAR (rest
);
5240 /* Skip invalid entries in alist. */
5241 if (!CONSP (this_entry
) || !STRINGP (XCAR (this_entry
))
5242 || !CONSP (XCDR (this_entry
))
5243 || !SYMBOLP (XCAR (XCDR (this_entry
))))
5246 x_charset
= SDATA (XCAR (this_entry
));
5247 w32_charset
= XCAR (XCDR (this_entry
));
5248 codepage
= XCDR (XCDR (this_entry
));
5250 /* Look for Same charset and a valid codepage (or non-int
5251 which means ignore). */
5252 if (EQ (w32_charset
, charset_type
)
5253 && (!INTEGERP (codepage
) || XINT (codepage
) == CP_DEFAULT
5254 || IsValidCodePage (XINT (codepage
))))
5256 /* If we don't have a match already, then this is the
5260 best_match
= x_charset
;
5261 if (matching
&& !strnicmp (x_charset
, matching
, match_len
))
5264 /* If we already found a match for MATCHING, then
5265 only consider other matches. */
5266 else if (matching_found
5267 && strnicmp (x_charset
, matching
, match_len
))
5269 /* If this matches what we want, and the best so far doesn't,
5270 then this is better. */
5271 else if (!matching_found
&& matching
5272 && !strnicmp (x_charset
, matching
, match_len
))
5274 best_match
= x_charset
;
5277 /* If this is fully specified, and the best so far isn't,
5278 then this is better. */
5279 else if ((!strchr (best_match
, '-') && strchr (x_charset
, '-'))
5280 /* If this is an ISO codepage, and the best so far isn't,
5281 then this is better, but only if it fully specifies the
5283 || (strnicmp (best_match
, "iso", 3) != 0
5284 && strnicmp (x_charset
, "iso", 3) == 0
5285 && strchr (x_charset
, '-')))
5286 best_match
= x_charset
;
5287 /* If both are ISO8859 codepages, choose the one with the
5288 lowest number in the encoding field. */
5289 else if (strnicmp (best_match
, "iso8859-", 8) == 0
5290 && strnicmp (x_charset
, "iso8859-", 8) == 0)
5292 int best_enc
= atoi (best_match
+ 8);
5293 int this_enc
= atoi (x_charset
+ 8);
5294 if (this_enc
> 0 && this_enc
< best_enc
)
5295 best_match
= x_charset
;
5300 /* If no match, encode the numeric value. */
5303 sprintf (buf
, "*-#%u", fncharset
);
5307 strncpy (buf
, best_match
, 31);
5308 /* If the charset is not fully specified, put -0 on the end. */
5309 if (!strchr (best_match
, '-'))
5311 int pos
= strlen (best_match
);
5312 /* Charset specifiers shouldn't be very long. If it is a made
5313 up one, truncating it should not do any harm since it isn't
5314 recognized anyway. */
5317 strcpy (buf
+ pos
, "-0");
5325 /* Return all the X charsets that map to a font. */
5327 w32_to_all_x_charsets (fncharset
)
5330 static char buf
[32];
5331 Lisp_Object charset_type
;
5332 Lisp_Object retval
= Qnil
;
5337 /* Handle startup case of w32-charset-info-alist not
5338 being set up yet. */
5339 if (NILP (Vw32_charset_info_alist
))
5340 return Fcons (build_string ("iso8859-1"), Qnil
);
5342 charset_type
= Qw32_charset_ansi
;
5344 case DEFAULT_CHARSET
:
5345 charset_type
= Qw32_charset_default
;
5347 case SYMBOL_CHARSET
:
5348 charset_type
= Qw32_charset_symbol
;
5350 case SHIFTJIS_CHARSET
:
5351 charset_type
= Qw32_charset_shiftjis
;
5353 case HANGEUL_CHARSET
:
5354 charset_type
= Qw32_charset_hangeul
;
5356 case GB2312_CHARSET
:
5357 charset_type
= Qw32_charset_gb2312
;
5359 case CHINESEBIG5_CHARSET
:
5360 charset_type
= Qw32_charset_chinesebig5
;
5363 charset_type
= Qw32_charset_oem
;
5366 /* More recent versions of Windows (95 and NT4.0) define more
5368 #ifdef EASTEUROPE_CHARSET
5369 case EASTEUROPE_CHARSET
:
5370 charset_type
= Qw32_charset_easteurope
;
5372 case TURKISH_CHARSET
:
5373 charset_type
= Qw32_charset_turkish
;
5375 case BALTIC_CHARSET
:
5376 charset_type
= Qw32_charset_baltic
;
5378 case RUSSIAN_CHARSET
:
5379 charset_type
= Qw32_charset_russian
;
5381 case ARABIC_CHARSET
:
5382 charset_type
= Qw32_charset_arabic
;
5385 charset_type
= Qw32_charset_greek
;
5387 case HEBREW_CHARSET
:
5388 charset_type
= Qw32_charset_hebrew
;
5390 case VIETNAMESE_CHARSET
:
5391 charset_type
= Qw32_charset_vietnamese
;
5394 charset_type
= Qw32_charset_thai
;
5397 charset_type
= Qw32_charset_mac
;
5400 charset_type
= Qw32_charset_johab
;
5404 #ifdef UNICODE_CHARSET
5405 case UNICODE_CHARSET
:
5406 charset_type
= Qw32_charset_unicode
;
5410 /* Encode numerical value of unknown charset. */
5411 sprintf (buf
, "*-#%u", fncharset
);
5412 return Fcons (build_string (buf
), Qnil
);
5417 /* Look through w32-charset-info-alist for the character set.
5418 Only return fully specified charsets for codepages which are
5421 Format of each entry in Vw32_charset_info_alist is
5422 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
5424 for (rest
= Vw32_charset_info_alist
; CONSP (rest
); rest
= XCDR (rest
))
5426 Lisp_Object x_charset
;
5427 Lisp_Object w32_charset
;
5428 Lisp_Object codepage
;
5430 Lisp_Object this_entry
= XCAR (rest
);
5432 /* Skip invalid entries in alist. */
5433 if (!CONSP (this_entry
) || !STRINGP (XCAR (this_entry
))
5434 || !CONSP (XCDR (this_entry
))
5435 || !SYMBOLP (XCAR (XCDR (this_entry
))))
5438 x_charset
= XCAR (this_entry
);
5439 w32_charset
= XCAR (XCDR (this_entry
));
5440 codepage
= XCDR (XCDR (this_entry
));
5442 if (!strchr (SDATA (x_charset
), '-'))
5445 /* Look for Same charset and a valid codepage (or non-int
5446 which means ignore). */
5447 if (EQ (w32_charset
, charset_type
)
5448 && (!INTEGERP (codepage
) || XINT (codepage
) == CP_DEFAULT
5449 || IsValidCodePage (XINT (codepage
))))
5451 retval
= Fcons (x_charset
, retval
);
5455 /* If no match, encode the numeric value. */
5458 sprintf (buf
, "*-#%u", fncharset
);
5459 return Fcons (build_string (buf
), Qnil
);
5468 /* Get the Windows codepage corresponding to the specified font. The
5469 charset info in the font name is used to look up
5470 w32-charset-to-codepage-alist. */
5472 w32_codepage_for_font (char *fontname
)
5474 Lisp_Object codepage
, entry
;
5475 char *charset_str
, *charset
, *end
;
5477 /* Extract charset part of font string. */
5478 charset
= xlfd_charset_of_font (fontname
);
5483 charset_str
= (char *) alloca (strlen (charset
) + 1);
5484 strcpy (charset_str
, charset
);
5487 /* Remove leading "*-". */
5488 if (strncmp ("*-", charset_str
, 2) == 0)
5489 charset
= charset_str
+ 2;
5492 charset
= charset_str
;
5494 /* Stop match at wildcard (including preceding '-'). */
5495 if (end
= strchr (charset
, '*'))
5497 if (end
> charset
&& *(end
-1) == '-')
5502 if (!strcmp (charset
, "iso10646"))
5505 if (NILP (Vw32_charset_info_alist
))
5508 entry
= Fassoc (build_string(charset
), Vw32_charset_info_alist
);
5512 codepage
= Fcdr (Fcdr (entry
));
5514 if (NILP (codepage
))
5516 else if (XFASTINT (codepage
) == XFASTINT (Qt
))
5518 else if (INTEGERP (codepage
))
5519 return XINT (codepage
);
5523 #endif /* OLD_FONT */
5526 w32_to_x_font (lplogfont
, lpxstr
, len
, specific_charset
)
5527 LOGFONT
* lplogfont
;
5530 char * specific_charset
;
5534 char height_pixels
[8];
5536 char width_pixels
[8];
5537 char *fontname_dash
;
5538 int display_resy
= (int) one_w32_display_info
.resy
;
5539 int display_resx
= (int) one_w32_display_info
.resx
;
5540 struct coding_system coding
;
5542 if (!lpxstr
) abort ();
5547 if (lplogfont
->lfOutPrecision
== OUT_STRING_PRECIS
)
5548 fonttype
= "raster";
5549 else if (lplogfont
->lfOutPrecision
== OUT_STROKE_PRECIS
)
5550 fonttype
= "outline";
5552 fonttype
= "unknown";
5554 setup_coding_system (Fcheck_coding_system (Vlocale_coding_system
),
5556 coding
.src_multibyte
= 0;
5557 coding
.dst_multibyte
= 1;
5558 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5559 /* We explicitely disable composition handling because selection
5560 data should not contain any composition sequence. */
5561 coding
.common_flags
&= ~CODING_ANNOTATION_MASK
;
5563 coding
.dst_bytes
= LF_FACESIZE
* 2;
5564 coding
.destination
= (unsigned char *) xmalloc (coding
.dst_bytes
+ 1);
5565 decode_coding_c_string (&coding
, lplogfont
->lfFaceName
,
5566 strlen(lplogfont
->lfFaceName
), Qnil
);
5567 fontname
= coding
.destination
;
5569 *(fontname
+ coding
.produced
) = '\0';
5571 /* Replace dashes with underscores so the dashes are not
5573 fontname_dash
= fontname
;
5574 while (fontname_dash
= strchr (fontname_dash
, '-'))
5575 *fontname_dash
= '_';
5577 if (lplogfont
->lfHeight
)
5579 sprintf (height_pixels
, "%u", eabs (lplogfont
->lfHeight
));
5580 sprintf (height_dpi
, "%u",
5581 eabs (lplogfont
->lfHeight
) * 720 / display_resy
);
5585 strcpy (height_pixels
, "*");
5586 strcpy (height_dpi
, "*");
5589 #if 0 /* Never put the width in the xfld. It fails on fonts with
5590 double-width characters. */
5591 if (lplogfont
->lfWidth
)
5592 sprintf (width_pixels
, "%u", lplogfont
->lfWidth
* 10);
5595 strcpy (width_pixels
, "*");
5597 _snprintf (lpxstr
, len
- 1,
5598 "-%s-%s-%s-%c-normal-normal-%s-%s-%d-%d-%c-%s-%s",
5599 fonttype
, /* foundry */
5600 fontname
, /* family */
5601 w32_to_x_weight (lplogfont
->lfWeight
), /* weight */
5602 lplogfont
->lfItalic
?'i':'r', /* slant */
5604 /* add style name */
5605 height_pixels
, /* pixel size */
5606 height_dpi
, /* point size */
5607 display_resx
, /* resx */
5608 display_resy
, /* resy */
5609 ((lplogfont
->lfPitchAndFamily
& 0x3) == VARIABLE_PITCH
)
5610 ? 'p' : 'c', /* spacing */
5611 width_pixels
, /* avg width */
5612 w32_to_x_charset (lplogfont
->lfCharSet
, specific_charset
)
5613 /* charset registry and encoding */
5616 lpxstr
[len
- 1] = 0; /* just to be sure */
5621 x_to_w32_font (lpxstr
, lplogfont
)
5623 LOGFONT
* lplogfont
;
5625 struct coding_system coding
;
5627 if (!lplogfont
) return (FALSE
);
5629 memset (lplogfont
, 0, sizeof (*lplogfont
));
5631 /* Set default value for each field. */
5633 lplogfont
->lfOutPrecision
= OUT_DEFAULT_PRECIS
;
5634 lplogfont
->lfClipPrecision
= CLIP_DEFAULT_PRECIS
;
5635 lplogfont
->lfQuality
= DEFAULT_QUALITY
;
5637 /* go for maximum quality */
5638 lplogfont
->lfOutPrecision
= OUT_STROKE_PRECIS
;
5639 lplogfont
->lfClipPrecision
= CLIP_STROKE_PRECIS
;
5640 lplogfont
->lfQuality
= PROOF_QUALITY
;
5643 lplogfont
->lfCharSet
= DEFAULT_CHARSET
;
5644 lplogfont
->lfWeight
= FW_DONTCARE
;
5645 lplogfont
->lfPitchAndFamily
= DEFAULT_PITCH
| FF_DONTCARE
;
5650 /* Provide a simple escape mechanism for specifying Windows font names
5651 * directly -- if font spec does not beginning with '-', assume this
5653 * "<font name>[:height in pixels[:width in pixels[:weight]]]"
5659 char name
[50], weight
[20], slant
, pitch
, pixels
[10], height
[10],
5660 width
[10], resy
[10], remainder
[50];
5662 int dpi
= (int) one_w32_display_info
.resy
;
5664 fields
= sscanf (lpxstr
,
5665 "-%*[^-]-%49[^-]-%19[^-]-%c-%*[^-]-%*[^-]-%9[^-]-%9[^-]-%*[^-]-%9[^-]-%c-%9[^-]-%49s",
5666 name
, weight
, &slant
, pixels
, height
, resy
, &pitch
, width
, remainder
);
5670 /* In the general case when wildcards cover more than one field,
5671 we don't know which field is which, so don't fill any in.
5672 However, we need to cope with this particular form, which is
5673 generated by font_list_1 (invoked by try_font_list):
5674 "-raster-6x10-*-gb2312*-*"
5675 and make sure to correctly parse the charset field. */
5678 fields
= sscanf (lpxstr
,
5679 "-%*[^-]-%49[^-]-*-%49s",
5682 else if (fields
< 9)
5688 if (fields
> 0 && name
[0] != '*')
5690 Lisp_Object string
= build_string (name
);
5692 (Fcheck_coding_system (Vlocale_coding_system
), &coding
);
5693 coding
.mode
|= (CODING_MODE_SAFE_ENCODING
| CODING_MODE_LAST_BLOCK
);
5694 /* Disable composition/charset annotation. */
5695 coding
.common_flags
&= ~CODING_ANNOTATION_MASK
;
5696 coding
.dst_bytes
= SCHARS (string
) * 2;
5698 coding
.destination
= (unsigned char *) xmalloc (coding
.dst_bytes
);
5699 encode_coding_object (&coding
, string
, 0, 0,
5700 SCHARS (string
), SBYTES (string
), Qnil
);
5701 if (coding
.produced
>= LF_FACESIZE
)
5702 coding
.produced
= LF_FACESIZE
- 1;
5704 coding
.destination
[coding
.produced
] = '\0';
5706 strcpy (lplogfont
->lfFaceName
, coding
.destination
);
5707 xfree (coding
.destination
);
5711 lplogfont
->lfFaceName
[0] = '\0';
5716 lplogfont
->lfWeight
= x_to_w32_weight ((fields
> 0 ? weight
: ""));
5720 lplogfont
->lfItalic
= (fields
> 0 && slant
== 'i');
5724 if (fields
> 0 && pixels
[0] != '*')
5725 lplogfont
->lfHeight
= atoi (pixels
);
5729 if (fields
> 0 && resy
[0] != '*')
5732 if (tem
> 0) dpi
= tem
;
5735 if (fields
> -1 && lplogfont
->lfHeight
== 0 && height
[0] != '*')
5736 lplogfont
->lfHeight
= atoi (height
) * dpi
/ 720;
5741 lplogfont
->lfPitchAndFamily
= VARIABLE_PITCH
| FF_DONTCARE
;
5742 else if (pitch
== 'c')
5743 lplogfont
->lfPitchAndFamily
= FIXED_PITCH
| FF_DONTCARE
;
5748 if (fields
> 0 && width
[0] != '*')
5749 lplogfont
->lfWidth
= atoi (width
) / 10;
5753 /* Strip the trailing '-' if present. (it shouldn't be, as it
5754 fails the test against xlfd-tight-regexp in fontset.el). */
5756 int len
= strlen (remainder
);
5757 if (len
> 0 && remainder
[len
-1] == '-')
5758 remainder
[len
-1] = 0;
5760 encoding
= remainder
;
5762 if (strncmp (encoding
, "*-", 2) == 0)
5765 lplogfont
->lfCharSet
= x_to_w32_charset (encoding
);
5770 char name
[100], height
[10], width
[10], weight
[20];
5772 fields
= sscanf (lpxstr
,
5773 "%99[^:]:%9[^:]:%9[^:]:%19s",
5774 name
, height
, width
, weight
);
5776 if (fields
== EOF
) return (FALSE
);
5780 strncpy (lplogfont
->lfFaceName
, name
, LF_FACESIZE
);
5781 lplogfont
->lfFaceName
[LF_FACESIZE
-1] = 0;
5785 lplogfont
->lfFaceName
[0] = 0;
5791 lplogfont
->lfHeight
= atoi (height
);
5796 lplogfont
->lfWidth
= atoi (width
);
5800 lplogfont
->lfWeight
= x_to_w32_weight ((fields
> 0 ? weight
: ""));
5803 /* This makes TrueType fonts work better. */
5804 lplogfont
->lfHeight
= - eabs (lplogfont
->lfHeight
);
5811 /* Strip the pixel height and point height from the given xlfd, and
5812 return the pixel height. If no pixel height is specified, calculate
5813 one from the point height, or if that isn't defined either, return
5814 0 (which usually signifies a scalable font).
5817 xlfd_strip_height (char *fontname
)
5819 int pixel_height
, field_number
;
5820 char *read_from
, *write_to
;
5824 pixel_height
= field_number
= 0;
5827 /* Look for height fields. */
5828 for (read_from
= fontname
; *read_from
; read_from
++)
5830 if (*read_from
== '-')
5833 if (field_number
== 7) /* Pixel height. */
5836 write_to
= read_from
;
5838 /* Find end of field. */
5839 for (;*read_from
&& *read_from
!= '-'; read_from
++)
5842 /* Split the fontname at end of field. */
5848 pixel_height
= atoi (write_to
);
5849 /* Blank out field. */
5850 if (read_from
> write_to
)
5855 /* If the pixel height field is at the end (partial xlfd),
5858 return pixel_height
;
5860 /* If we got a pixel height, the point height can be
5861 ignored. Just blank it out and break now. */
5864 /* Find end of point size field. */
5865 for (; *read_from
&& *read_from
!= '-'; read_from
++)
5871 /* Blank out the point size field. */
5872 if (read_from
> write_to
)
5878 return pixel_height
;
5882 /* If the point height is already blank, break now. */
5883 if (*read_from
== '-')
5889 else if (field_number
== 8)
5891 /* If we didn't get a pixel height, try to get the point
5892 height and convert that. */
5894 char *point_size_start
= read_from
++;
5896 /* Find end of field. */
5897 for (; *read_from
&& *read_from
!= '-'; read_from
++)
5906 point_size
= atoi (point_size_start
);
5908 /* Convert to pixel height. */
5909 pixel_height
= point_size
5910 * one_w32_display_info
.height_in
/ 720;
5912 /* Blank out this field and break. */
5920 /* Shift the rest of the font spec into place. */
5921 if (write_to
&& read_from
> write_to
)
5923 for (; *read_from
; read_from
++, write_to
++)
5924 *write_to
= *read_from
;
5928 return pixel_height
;
5931 /* Assume parameter 1 is fully qualified, no wildcards. */
5933 w32_font_match (fontname
, pattern
)
5938 char *font_name_copy
;
5939 char *regex
= alloca (strlen (pattern
) * 2 + 3);
5941 font_name_copy
= alloca (strlen (fontname
) + 1);
5942 strcpy (font_name_copy
, fontname
);
5947 /* Turn pattern into a regexp and do a regexp match. */
5948 for (; *pattern
; pattern
++)
5950 if (*pattern
== '?')
5952 else if (*pattern
== '*')
5963 /* Strip out font heights and compare them seperately, since
5964 rounding error can cause mismatches. This also allows a
5965 comparison between a font that declares only a pixel height and a
5966 pattern that declares the point height.
5969 int font_height
, pattern_height
;
5971 font_height
= xlfd_strip_height (font_name_copy
);
5972 pattern_height
= xlfd_strip_height (regex
);
5974 /* Compare now, and don't bother doing expensive regexp matching
5975 if the heights differ. */
5976 if (font_height
&& pattern_height
&& (font_height
!= pattern_height
))
5980 return (fast_string_match_ignore_case (build_string (regex
),
5981 build_string (font_name_copy
)) >= 0);
5984 /* Callback functions, and a structure holding info they need, for
5985 listing system fonts on W32. We need one set of functions to do the
5986 job properly, but these don't work on NT 3.51 and earlier, so we
5987 have a second set which don't handle character sets properly to
5990 In both cases, there are two passes made. The first pass gets one
5991 font from each family, the second pass lists all the fonts from
5994 typedef struct enumfont_t
5999 XFontStruct
*size_ref
;
6000 Lisp_Object pattern
;
6006 enum_font_maybe_add_to_list (enumfont_t
*, LOGFONT
*, char *, Lisp_Object
);
6010 enum_font_cb2 (lplf
, lptm
, FontType
, lpef
)
6012 NEWTEXTMETRIC
* lptm
;
6016 /* Ignore struck out and underlined versions of fonts. */
6017 if (lplf
->elfLogFont
.lfStrikeOut
|| lplf
->elfLogFont
.lfUnderline
)
6020 /* Only return fonts with names starting with @ if they were
6021 explicitly specified, since Microsoft uses an initial @ to
6022 denote fonts for vertical writing, without providing a more
6023 convenient way of identifying them. */
6024 if (lplf
->elfLogFont
.lfFaceName
[0] == '@'
6025 && lpef
->logfont
.lfFaceName
[0] != '@')
6028 /* Check that the character set matches if it was specified */
6029 if (lpef
->logfont
.lfCharSet
!= DEFAULT_CHARSET
&&
6030 lplf
->elfLogFont
.lfCharSet
!= lpef
->logfont
.lfCharSet
)
6033 if (FontType
== RASTER_FONTTYPE
)
6035 /* DBCS raster fonts have problems displaying, so skip them. */
6036 int charset
= lplf
->elfLogFont
.lfCharSet
;
6037 if (charset
== SHIFTJIS_CHARSET
6038 || charset
== HANGEUL_CHARSET
6039 || charset
== CHINESEBIG5_CHARSET
6040 || charset
== GB2312_CHARSET
6041 #ifdef JOHAB_CHARSET
6042 || charset
== JOHAB_CHARSET
6050 Lisp_Object width
= Qnil
;
6051 Lisp_Object charset_list
= Qnil
;
6052 char *charset
= NULL
;
6054 /* Truetype fonts do not report their true metrics until loaded */
6055 if (FontType
!= RASTER_FONTTYPE
)
6057 if (!NILP (lpef
->pattern
))
6059 /* Scalable fonts are as big as you want them to be. */
6060 lplf
->elfLogFont
.lfHeight
= lpef
->logfont
.lfHeight
;
6061 lplf
->elfLogFont
.lfWidth
= lpef
->logfont
.lfWidth
;
6062 width
= make_number (lpef
->logfont
.lfWidth
);
6066 lplf
->elfLogFont
.lfHeight
= 0;
6067 lplf
->elfLogFont
.lfWidth
= 0;
6071 /* Make sure the height used here is the same as everywhere
6072 else (ie character height, not cell height). */
6073 if (lplf
->elfLogFont
.lfHeight
> 0)
6075 /* lptm can be trusted for RASTER fonts, but not scalable ones. */
6076 if (FontType
== RASTER_FONTTYPE
)
6077 lplf
->elfLogFont
.lfHeight
= lptm
->tmInternalLeading
- lptm
->tmHeight
;
6079 lplf
->elfLogFont
.lfHeight
= -lplf
->elfLogFont
.lfHeight
;
6082 if (!NILP (lpef
->pattern
))
6084 charset
= xlfd_charset_of_font (SDATA (lpef
->pattern
));
6086 /* We already checked charsets above, but DEFAULT_CHARSET
6087 slipped through. So only allow exact matches for DEFAULT_CHARSET. */
6089 && strncmp (charset
, "*-*", 3) != 0
6090 && lpef
->logfont
.lfCharSet
== DEFAULT_CHARSET
6091 && strcmp (charset
, w32_to_x_charset (DEFAULT_CHARSET
, NULL
)) != 0)
6094 /* Reject raster fonts if we are looking for a unicode font. */
6096 && FontType
== RASTER_FONTTYPE
6097 && strncmp (charset
, "iso10646", 8) == 0)
6102 charset_list
= Fcons (build_string (charset
), Qnil
);
6104 /* Always prefer unicode. */
6106 = Fcons (build_string ("iso10646-1"),
6107 w32_to_all_x_charsets (lplf
->elfLogFont
.lfCharSet
));
6109 /* Loop through the charsets. */
6110 for ( ; CONSP (charset_list
); charset_list
= Fcdr (charset_list
))
6112 Lisp_Object this_charset
= Fcar (charset_list
);
6113 charset
= SDATA (this_charset
);
6115 /* Don't list raster fonts as unicode. */
6117 && FontType
== RASTER_FONTTYPE
6118 && strncmp (charset
, "iso10646", 8) == 0)
6121 enum_font_maybe_add_to_list (lpef
, &(lplf
->elfLogFont
),
6124 /* List bold and italic variations if w32-enable-synthesized-fonts
6125 is non-nil and this is a plain font. */
6126 if (w32_enable_synthesized_fonts
6127 && lplf
->elfLogFont
.lfWeight
== FW_NORMAL
6128 && lplf
->elfLogFont
.lfItalic
== FALSE
)
6131 lplf
->elfLogFont
.lfWeight
= FW_BOLD
;
6132 enum_font_maybe_add_to_list (lpef
, &(lplf
->elfLogFont
),
6135 lplf
->elfLogFont
.lfItalic
= TRUE
;
6136 enum_font_maybe_add_to_list (lpef
, &(lplf
->elfLogFont
),
6139 lplf
->elfLogFont
.lfWeight
= FW_NORMAL
;
6140 enum_font_maybe_add_to_list (lpef
, &(lplf
->elfLogFont
),
6150 enum_font_maybe_add_to_list (lpef
, logfont
, match_charset
, width
)
6153 char * match_charset
;
6158 if (!w32_to_x_font (logfont
, buf
, 100, match_charset
))
6161 if (NILP (lpef
->pattern
)
6162 || w32_font_match (buf
, SDATA (lpef
->pattern
)))
6164 /* Check if we already listed this font. This may happen if
6165 w32_enable_synthesized_fonts is non-nil, and there are real
6166 bold and italic versions of the font. */
6167 Lisp_Object font_name
= build_string (buf
);
6168 if (NILP (Fmember (font_name
, lpef
->list
)))
6170 Lisp_Object entry
= Fcons (font_name
, width
);
6171 lpef
->list
= Fcons (entry
, lpef
->list
);
6179 enum_font_cb1 (lplf
, lptm
, FontType
, lpef
)
6181 NEWTEXTMETRIC
* lptm
;
6185 return EnumFontFamilies (lpef
->hdc
,
6186 lplf
->elfLogFont
.lfFaceName
,
6187 (FONTENUMPROC
) enum_font_cb2
,
6193 enum_fontex_cb2 (lplf
, lptm
, font_type
, lpef
)
6194 ENUMLOGFONTEX
* lplf
;
6195 NEWTEXTMETRICEX
* lptm
;
6199 /* We are not interested in the extra info we get back from the 'Ex
6200 version - only the fact that we get character set variations
6201 enumerated seperately. */
6202 return enum_font_cb2 ((ENUMLOGFONT
*) lplf
, (NEWTEXTMETRIC
*) lptm
,
6207 enum_fontex_cb1 (lplf
, lptm
, font_type
, lpef
)
6208 ENUMLOGFONTEX
* lplf
;
6209 NEWTEXTMETRICEX
* lptm
;
6213 HMODULE gdi32
= GetModuleHandle ("gdi32.dll");
6214 FARPROC enum_font_families_ex
6215 = GetProcAddress ( gdi32
, "EnumFontFamiliesExA");
6216 /* We don't really expect EnumFontFamiliesEx to disappear once we
6217 get here, so don't bother handling it gracefully. */
6218 if (enum_font_families_ex
== NULL
)
6219 error ("gdi32.dll has disappeared!");
6220 return enum_font_families_ex (lpef
->hdc
,
6222 (FONTENUMPROC
) enum_fontex_cb2
,
6226 /* Interface to fontset handler. (adapted from mw32font.c in Meadow
6227 and xterm.c in Emacs 20.3) */
6230 w32_list_bdf_fonts (Lisp_Object pattern
, int max_names
)
6232 char *fontname
, *ptnstr
;
6233 Lisp_Object list
, tem
, newlist
= Qnil
;
6236 list
= Vw32_bdf_filename_alist
;
6237 ptnstr
= SDATA (pattern
);
6239 for ( ; CONSP (list
); list
= XCDR (list
))
6243 fontname
= SDATA (XCAR (tem
));
6244 else if (STRINGP (tem
))
6245 fontname
= SDATA (tem
);
6249 if (w32_font_match (fontname
, ptnstr
))
6251 newlist
= Fcons (XCAR (tem
), newlist
);
6253 if (max_names
>= 0 && n_fonts
>= max_names
)
6262 /* Return a list of names of available fonts matching PATTERN on frame
6263 F. If SIZE is not 0, it is the size (maximum bound width) of fonts
6264 to be listed. Frame F NULL means we have not yet created any
6265 frame, which means we can't get proper size info, as we don't have
6266 a device context to use for GetTextMetrics.
6267 MAXNAMES sets a limit on how many fonts to match. If MAXNAMES is
6268 negative, then all matching fonts are returned. */
6271 w32_list_fonts (f
, pattern
, size
, maxnames
)
6273 Lisp_Object pattern
;
6277 Lisp_Object patterns
, key
= Qnil
, tem
, tpat
;
6278 Lisp_Object list
= Qnil
, newlist
= Qnil
, second_best
= Qnil
;
6279 struct w32_display_info
*dpyinfo
= &one_w32_display_info
;
6282 patterns
= Fassoc (pattern
, Valternate_fontname_alist
);
6283 if (NILP (patterns
))
6284 patterns
= Fcons (pattern
, Qnil
);
6286 for (; CONSP (patterns
); patterns
= XCDR (patterns
))
6291 tpat
= XCAR (patterns
);
6293 if (!STRINGP (tpat
))
6296 /* Avoid expensive EnumFontFamilies functions if we are not
6297 going to be able to output one of these anyway. */
6298 codepage
= w32_codepage_for_font (SDATA (tpat
));
6299 if (codepage
!= CP_8BIT
&& codepage
!= CP_UNICODE
6300 && codepage
!= CP_DEFAULT
&& codepage
!= CP_UNKNOWN
6301 && !IsValidCodePage (codepage
))
6304 /* See if we cached the result for this particular query.
6305 The cache is an alist of the form:
6306 ((PATTERN (FONTNAME . WIDTH) ...) ...)
6308 if (tem
= XCDR (dpyinfo
->name_list_element
),
6309 !NILP (list
= Fassoc (tpat
, tem
)))
6311 list
= Fcdr_safe (list
);
6312 /* We have a cached list. Don't have to get the list again. */
6317 /* At first, put PATTERN in the cache. */
6322 /* Use EnumFontFamiliesEx where it is available, as it knows
6323 about character sets. Fall back to EnumFontFamilies for
6324 older versions of NT that don't support the 'Ex function. */
6325 x_to_w32_font (SDATA (tpat
), &ef
.logfont
);
6327 LOGFONT font_match_pattern
;
6328 HMODULE gdi32
= GetModuleHandle ("gdi32.dll");
6329 FARPROC enum_font_families_ex
6330 = GetProcAddress ( gdi32
, "EnumFontFamiliesExA");
6332 /* We do our own pattern matching so we can handle wildcards. */
6333 font_match_pattern
.lfFaceName
[0] = 0;
6334 font_match_pattern
.lfPitchAndFamily
= 0;
6335 /* We can use the charset, because if it is a wildcard it will
6336 be DEFAULT_CHARSET anyway. */
6337 font_match_pattern
.lfCharSet
= ef
.logfont
.lfCharSet
;
6339 ef
.hdc
= GetDC (dpyinfo
->root_window
);
6341 if (enum_font_families_ex
)
6342 enum_font_families_ex (ef
.hdc
,
6343 &font_match_pattern
,
6344 (FONTENUMPROC
) enum_fontex_cb1
,
6347 EnumFontFamilies (ef
.hdc
, NULL
, (FONTENUMPROC
) enum_font_cb1
,
6350 ReleaseDC (dpyinfo
->root_window
, ef
.hdc
);
6356 /* Make a list of the fonts we got back.
6357 Store that in the font cache for the display. */
6358 XSETCDR (dpyinfo
->name_list_element
,
6359 Fcons (Fcons (tpat
, list
),
6360 XCDR (dpyinfo
->name_list_element
)));
6363 if (NILP (list
)) continue; /* Try the remaining alternatives. */
6365 newlist
= second_best
= Qnil
;
6367 /* Make a list of the fonts that have the right width. */
6368 for (; CONSP (list
); list
= XCDR (list
))
6375 if (NILP (XCAR (tem
)))
6379 newlist
= Fcons (XCAR (tem
), newlist
);
6381 if (maxnames
>= 0 && n_fonts
>= maxnames
)
6386 if (!INTEGERP (XCDR (tem
)))
6388 /* Since we don't yet know the size of the font, we must
6389 load it and try GetTextMetrics. */
6390 W32FontStruct thisinfo
;
6395 if (!x_to_w32_font (SDATA (XCAR (tem
)), &lf
))
6399 thisinfo
.bdf
= NULL
;
6400 thisinfo
.hfont
= CreateFontIndirect (&lf
);
6401 if (thisinfo
.hfont
== NULL
)
6404 hdc
= GetDC (dpyinfo
->root_window
);
6405 oldobj
= SelectObject (hdc
, thisinfo
.hfont
);
6406 if (GetTextMetrics (hdc
, &thisinfo
.tm
))
6407 XSETCDR (tem
, make_number (FONT_AVG_WIDTH (&thisinfo
)));
6409 XSETCDR (tem
, make_number (0));
6410 SelectObject (hdc
, oldobj
);
6411 ReleaseDC (dpyinfo
->root_window
, hdc
);
6412 DeleteObject (thisinfo
.hfont
);
6415 found_size
= XINT (XCDR (tem
));
6416 if (found_size
== size
)
6418 newlist
= Fcons (XCAR (tem
), newlist
);
6420 if (maxnames
>= 0 && n_fonts
>= maxnames
)
6423 /* keep track of the closest matching size in case
6424 no exact match is found. */
6425 else if (found_size
> 0)
6427 if (NILP (second_best
))
6430 else if (found_size
< size
)
6432 if (XINT (XCDR (second_best
)) > size
6433 || XINT (XCDR (second_best
)) < found_size
)
6438 if (XINT (XCDR (second_best
)) > size
6439 && XINT (XCDR (second_best
)) >
6446 if (!NILP (newlist
))
6448 else if (!NILP (second_best
))
6450 newlist
= Fcons (XCAR (second_best
), Qnil
);
6455 /* Include any bdf fonts. */
6456 if (n_fonts
< maxnames
|| maxnames
< 0)
6458 Lisp_Object combined
[2];
6459 combined
[0] = w32_list_bdf_fonts (pattern
, maxnames
- n_fonts
);
6460 combined
[1] = newlist
;
6461 newlist
= Fnconc (2, combined
);
6468 /* Return a pointer to struct font_info of font FONT_IDX of frame F. */
6470 w32_get_font_info (f
, font_idx
)
6474 return (FRAME_W32_FONT_TABLE (f
) + font_idx
);
6479 w32_query_font (struct frame
*f
, char *fontname
)
6482 struct font_info
*pfi
;
6484 pfi
= FRAME_W32_FONT_TABLE (f
);
6486 for (i
= 0; i
< one_w32_display_info
.n_fonts
;i
++, pfi
++)
6488 if (stricmp (pfi
->name
, fontname
) == 0) return pfi
;
6494 /* Find a CCL program for a font specified by FONTP, and set the member
6495 `encoder' of the structure. */
6498 w32_find_ccl_program (fontp
)
6499 struct font_info
*fontp
;
6501 Lisp_Object list
, elt
;
6503 for (list
= Vfont_ccl_encoder_alist
; CONSP (list
); list
= XCDR (list
))
6507 && STRINGP (XCAR (elt
))
6508 && (fast_c_string_match_ignore_case (XCAR (elt
), fontp
->name
)
6514 struct ccl_program
*ccl
6515 = (struct ccl_program
*) xmalloc (sizeof (struct ccl_program
));
6517 if (setup_ccl_program (ccl
, XCDR (elt
)) < 0)
6520 fontp
->font_encoder
= ccl
;
6524 #endif /* OLD_FONT */
6526 /* directory-files from dired.c. */
6527 Lisp_Object Fdirectory_files
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
, Lisp_Object
));
6532 /* Find BDF files in a specified directory. (use GCPRO when calling,
6533 as this calls lisp to get a directory listing). */
6535 w32_find_bdf_fonts_in_dir (Lisp_Object directory
)
6537 Lisp_Object filelist
, list
= Qnil
;
6540 if (!STRINGP (directory
))
6543 filelist
= Fdirectory_files (directory
, Qt
,
6544 build_string (".*\\.[bB][dD][fF]"), Qt
);
6546 for ( ; CONSP (filelist
); filelist
= XCDR (filelist
))
6548 Lisp_Object filename
= XCAR (filelist
);
6549 if (w32_BDF_to_x_font (SDATA (filename
), fontname
, 100))
6550 store_in_alist (&list
, build_string (fontname
), filename
);
6555 DEFUN ("w32-find-bdf-fonts", Fw32_find_bdf_fonts
, Sw32_find_bdf_fonts
,
6557 doc
: /* Return a list of BDF fonts in DIRECTORY.
6558 The list is suitable for appending to `w32-bdf-filename-alist'.
6559 Fonts which do not contain an xlfd description will not be included
6560 in the list. DIRECTORY may be a list of directories. */)
6562 Lisp_Object directory
;
6564 Lisp_Object list
= Qnil
;
6565 struct gcpro gcpro1
, gcpro2
;
6567 if (!CONSP (directory
))
6568 return w32_find_bdf_fonts_in_dir (directory
);
6570 for ( ; CONSP (directory
); directory
= XCDR (directory
))
6572 Lisp_Object pair
[2];
6575 GCPRO2 (directory
, list
);
6576 pair
[1] = w32_find_bdf_fonts_in_dir ( XCAR (directory
) );
6577 list
= Fnconc ( 2, pair
);
6582 #endif /* OLD_FONT */
6585 DEFUN ("xw-color-defined-p", Fxw_color_defined_p
, Sxw_color_defined_p
, 1, 2, 0,
6586 doc
: /* Internal function called by `color-defined-p', which see. */)
6588 Lisp_Object color
, frame
;
6591 FRAME_PTR f
= check_x_frame (frame
);
6593 CHECK_STRING (color
);
6595 if (w32_defined_color (f
, SDATA (color
), &foo
, 0))
6601 DEFUN ("xw-color-values", Fxw_color_values
, Sxw_color_values
, 1, 2, 0,
6602 doc
: /* Internal function called by `color-values', which see. */)
6604 Lisp_Object color
, frame
;
6607 FRAME_PTR f
= check_x_frame (frame
);
6609 CHECK_STRING (color
);
6611 if (w32_defined_color (f
, SDATA (color
), &foo
, 0))
6612 return list3 (make_number ((GetRValue (foo
.pixel
) << 8)
6613 | GetRValue (foo
.pixel
)),
6614 make_number ((GetGValue (foo
.pixel
) << 8)
6615 | GetGValue (foo
.pixel
)),
6616 make_number ((GetBValue (foo
.pixel
) << 8)
6617 | GetBValue (foo
.pixel
)));
6622 DEFUN ("xw-display-color-p", Fxw_display_color_p
, Sxw_display_color_p
, 0, 1, 0,
6623 doc
: /* Internal function called by `display-color-p', which see. */)
6625 Lisp_Object display
;
6627 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6629 if ((dpyinfo
->n_planes
* dpyinfo
->n_cbits
) <= 2)
6635 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
,
6636 Sx_display_grayscale_p
, 0, 1, 0,
6637 doc
: /* Return t if DISPLAY supports shades of gray.
6638 Note that color displays do support shades of gray.
6639 The optional argument DISPLAY specifies which display to ask about.
6640 DISPLAY should be either a frame or a display name (a string).
6641 If omitted or nil, that stands for the selected frame's display. */)
6643 Lisp_Object display
;
6645 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6647 if ((dpyinfo
->n_planes
* dpyinfo
->n_cbits
) <= 1)
6653 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
,
6654 Sx_display_pixel_width
, 0, 1, 0,
6655 doc
: /* Return the width in pixels of DISPLAY.
6656 The optional argument DISPLAY specifies which display to ask about.
6657 DISPLAY should be either a frame or a display name (a string).
6658 If omitted or nil, that stands for the selected frame's display. */)
6660 Lisp_Object display
;
6662 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6664 return make_number (dpyinfo
->width
);
6667 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
6668 Sx_display_pixel_height
, 0, 1, 0,
6669 doc
: /* Return the height in pixels of DISPLAY.
6670 The optional argument DISPLAY specifies which display to ask about.
6671 DISPLAY should be either a frame or a display name (a string).
6672 If omitted or nil, that stands for the selected frame's display. */)
6674 Lisp_Object display
;
6676 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6678 return make_number (dpyinfo
->height
);
6681 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
6683 doc
: /* Return the number of bitplanes of DISPLAY.
6684 The optional argument DISPLAY specifies which display to ask about.
6685 DISPLAY should be either a frame or a display name (a string).
6686 If omitted or nil, that stands for the selected frame's display. */)
6688 Lisp_Object display
;
6690 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6692 return make_number (dpyinfo
->n_planes
* dpyinfo
->n_cbits
);
6695 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
6697 doc
: /* Return the number of color cells of DISPLAY.
6698 The optional argument DISPLAY specifies which display to ask about.
6699 DISPLAY should be either a frame or a display name (a string).
6700 If omitted or nil, that stands for the selected frame's display. */)
6702 Lisp_Object display
;
6704 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6708 hdc
= GetDC (dpyinfo
->root_window
);
6709 if (dpyinfo
->has_palette
)
6710 cap
= GetDeviceCaps (hdc
, SIZEPALETTE
);
6712 cap
= GetDeviceCaps (hdc
, NUMCOLORS
);
6714 /* We force 24+ bit depths to 24-bit, both to prevent an overflow
6715 and because probably is more meaningful on Windows anyway */
6717 cap
= 1 << min (dpyinfo
->n_planes
* dpyinfo
->n_cbits
, 24);
6719 ReleaseDC (dpyinfo
->root_window
, hdc
);
6721 return make_number (cap
);
6724 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
6725 Sx_server_max_request_size
,
6727 doc
: /* Return the maximum request size of the server of DISPLAY.
6728 The optional argument DISPLAY specifies which display to ask about.
6729 DISPLAY should be either a frame or a display name (a string).
6730 If omitted or nil, that stands for the selected frame's display. */)
6732 Lisp_Object display
;
6734 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6736 return make_number (1);
6739 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
6740 doc
: /* Return the "vendor ID" string of the W32 system (Microsoft).
6741 The optional argument DISPLAY specifies which display to ask about.
6742 DISPLAY should be either a frame or a display name (a string).
6743 If omitted or nil, that stands for the selected frame's display. */)
6745 Lisp_Object display
;
6747 return build_string ("Microsoft Corp.");
6750 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
6751 doc
: /* Return the version numbers of the server of DISPLAY.
6752 The value is a list of three integers: the major and minor
6753 version numbers of the X Protocol in use, and the distributor-specific
6754 release number. See also the function `x-server-vendor'.
6756 The optional argument DISPLAY specifies which display to ask about.
6757 DISPLAY should be either a frame or a display name (a string).
6758 If omitted or nil, that stands for the selected frame's display. */)
6760 Lisp_Object display
;
6762 return Fcons (make_number (w32_major_version
),
6763 Fcons (make_number (w32_minor_version
),
6764 Fcons (make_number (w32_build_number
), Qnil
)));
6767 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
6768 doc
: /* Return the number of screens on the server of DISPLAY.
6769 The optional argument DISPLAY specifies which display to ask about.
6770 DISPLAY should be either a frame or a display name (a string).
6771 If omitted or nil, that stands for the selected frame's display. */)
6773 Lisp_Object display
;
6775 return make_number (1);
6778 DEFUN ("x-display-mm-height", Fx_display_mm_height
,
6779 Sx_display_mm_height
, 0, 1, 0,
6780 doc
: /* Return the height in millimeters of DISPLAY.
6781 The optional argument DISPLAY specifies which display to ask about.
6782 DISPLAY should be either a frame or a display name (a string).
6783 If omitted or nil, that stands for the selected frame's display. */)
6785 Lisp_Object display
;
6787 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6791 hdc
= GetDC (dpyinfo
->root_window
);
6793 cap
= GetDeviceCaps (hdc
, VERTSIZE
);
6795 ReleaseDC (dpyinfo
->root_window
, hdc
);
6797 return make_number (cap
);
6800 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
6801 doc
: /* Return the width in millimeters of DISPLAY.
6802 The optional argument DISPLAY specifies which display to ask about.
6803 DISPLAY should be either a frame or a display name (a string).
6804 If omitted or nil, that stands for the selected frame's display. */)
6806 Lisp_Object display
;
6808 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6813 hdc
= GetDC (dpyinfo
->root_window
);
6815 cap
= GetDeviceCaps (hdc
, HORZSIZE
);
6817 ReleaseDC (dpyinfo
->root_window
, hdc
);
6819 return make_number (cap
);
6822 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
6823 Sx_display_backing_store
, 0, 1, 0,
6824 doc
: /* Return an indication of whether DISPLAY does backing store.
6825 The value may be `always', `when-mapped', or `not-useful'.
6826 The optional argument DISPLAY specifies which display to ask about.
6827 DISPLAY should be either a frame or a display name (a string).
6828 If omitted or nil, that stands for the selected frame's display. */)
6830 Lisp_Object display
;
6832 return intern ("not-useful");
6835 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
6836 Sx_display_visual_class
, 0, 1, 0,
6837 doc
: /* Return the visual class of DISPLAY.
6838 The value is one of the symbols `static-gray', `gray-scale',
6839 `static-color', `pseudo-color', `true-color', or `direct-color'.
6841 The optional argument DISPLAY specifies which display to ask about.
6842 DISPLAY should be either a frame or a display name (a string).
6843 If omitted or nil, that stands for the selected frame's display. */)
6845 Lisp_Object display
;
6847 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6848 Lisp_Object result
= Qnil
;
6850 if (dpyinfo
->has_palette
)
6851 result
= intern ("pseudo-color");
6852 else if (dpyinfo
->n_planes
* dpyinfo
->n_cbits
== 1)
6853 result
= intern ("static-grey");
6854 else if (dpyinfo
->n_planes
* dpyinfo
->n_cbits
== 4)
6855 result
= intern ("static-color");
6856 else if (dpyinfo
->n_planes
* dpyinfo
->n_cbits
> 8)
6857 result
= intern ("true-color");
6862 DEFUN ("x-display-save-under", Fx_display_save_under
,
6863 Sx_display_save_under
, 0, 1, 0,
6864 doc
: /* Return t if DISPLAY supports the save-under feature.
6865 The optional argument DISPLAY specifies which display to ask about.
6866 DISPLAY should be either a frame or a display name (a string).
6867 If omitted or nil, that stands for the selected frame's display. */)
6869 Lisp_Object display
;
6876 register struct frame
*f
;
6878 return FRAME_PIXEL_WIDTH (f
);
6883 register struct frame
*f
;
6885 return FRAME_PIXEL_HEIGHT (f
);
6890 register struct frame
*f
;
6892 return FRAME_COLUMN_WIDTH (f
);
6897 register struct frame
*f
;
6899 return FRAME_LINE_HEIGHT (f
);
6904 register struct frame
*f
;
6906 return FRAME_W32_DISPLAY_INFO (f
)->n_planes
;
6909 /* Return the display structure for the display named NAME.
6910 Open a new connection if necessary. */
6912 struct w32_display_info
*
6913 x_display_info_for_name (name
)
6917 struct w32_display_info
*dpyinfo
;
6919 CHECK_STRING (name
);
6921 for (dpyinfo
= &one_w32_display_info
, names
= w32_display_name_list
;
6923 dpyinfo
= dpyinfo
->next
, names
= XCDR (names
))
6926 tem
= Fstring_equal (XCAR (XCAR (names
)), name
);
6931 /* Use this general default value to start with. */
6932 Vx_resource_name
= Vinvocation_name
;
6934 validate_x_resource_name ();
6936 dpyinfo
= w32_term_init (name
, (unsigned char *)0,
6937 (char *) SDATA (Vx_resource_name
));
6940 error ("Cannot connect to server %s", SDATA (name
));
6943 XSETFASTINT (Vwindow_system_version
, 3);
6948 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
6949 1, 3, 0, doc
: /* Open a connection to a server.
6950 DISPLAY is the name of the display to connect to.
6951 Optional second arg XRM-STRING is a string of resources in xrdb format.
6952 If the optional third arg MUST-SUCCEED is non-nil,
6953 terminate Emacs if we can't open the connection. */)
6954 (display
, xrm_string
, must_succeed
)
6955 Lisp_Object display
, xrm_string
, must_succeed
;
6957 unsigned char *xrm_option
;
6958 struct w32_display_info
*dpyinfo
;
6960 /* If initialization has already been done, return now to avoid
6961 overwriting critical parts of one_w32_display_info. */
6965 CHECK_STRING (display
);
6966 if (! NILP (xrm_string
))
6967 CHECK_STRING (xrm_string
);
6970 if (! EQ (Vwindow_system
, intern ("w32")))
6971 error ("Not using Microsoft Windows");
6974 /* Allow color mapping to be defined externally; first look in user's
6975 HOME directory, then in Emacs etc dir for a file called rgb.txt. */
6977 Lisp_Object color_file
;
6978 struct gcpro gcpro1
;
6980 color_file
= build_string ("~/rgb.txt");
6982 GCPRO1 (color_file
);
6984 if (NILP (Ffile_readable_p (color_file
)))
6986 Fexpand_file_name (build_string ("rgb.txt"),
6987 Fsymbol_value (intern ("data-directory")));
6989 Vw32_color_map
= Fw32_load_color_file (color_file
);
6993 if (NILP (Vw32_color_map
))
6994 Vw32_color_map
= Fw32_default_color_map ();
6996 /* Merge in system logical colors. */
6997 add_system_logical_colors_to_map (&Vw32_color_map
);
6999 if (! NILP (xrm_string
))
7000 xrm_option
= (unsigned char *) SDATA (xrm_string
);
7002 xrm_option
= (unsigned char *) 0;
7004 /* Use this general default value to start with. */
7005 /* First remove .exe suffix from invocation-name - it looks ugly. */
7007 char basename
[ MAX_PATH
], *str
;
7009 strcpy (basename
, SDATA (Vinvocation_name
));
7010 str
= strrchr (basename
, '.');
7012 Vinvocation_name
= build_string (basename
);
7014 Vx_resource_name
= Vinvocation_name
;
7016 validate_x_resource_name ();
7018 /* This is what opens the connection and sets x_current_display.
7019 This also initializes many symbols, such as those used for input. */
7020 dpyinfo
= w32_term_init (display
, xrm_option
,
7021 (char *) SDATA (Vx_resource_name
));
7025 if (!NILP (must_succeed
))
7026 fatal ("Cannot connect to server %s.\n",
7029 error ("Cannot connect to server %s", SDATA (display
));
7034 XSETFASTINT (Vwindow_system_version
, 3);
7038 DEFUN ("x-close-connection", Fx_close_connection
,
7039 Sx_close_connection
, 1, 1, 0,
7040 doc
: /* Close the connection to DISPLAY's server.
7041 For DISPLAY, specify either a frame or a display name (a string).
7042 If DISPLAY is nil, that stands for the selected frame's display. */)
7044 Lisp_Object display
;
7046 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7049 if (dpyinfo
->reference_count
> 0)
7050 error ("Display still has frames on it");
7054 /* Free the fonts in the font table. */
7055 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
7056 if (dpyinfo
->font_table
[i
].name
)
7058 if (dpyinfo
->font_table
[i
].name
!= dpyinfo
->font_table
[i
].full_name
)
7059 xfree (dpyinfo
->font_table
[i
].full_name
);
7060 xfree (dpyinfo
->font_table
[i
].name
);
7061 w32_unload_font (dpyinfo
, dpyinfo
->font_table
[i
].font
);
7064 x_destroy_all_bitmaps (dpyinfo
);
7066 x_delete_display (dpyinfo
);
7072 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
7073 doc
: /* Return the list of display names that Emacs has connections to. */)
7076 Lisp_Object tail
, result
;
7079 for (tail
= w32_display_name_list
; CONSP (tail
); tail
= XCDR (tail
))
7080 result
= Fcons (XCAR (XCAR (tail
)), result
);
7085 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
7086 doc
: /* This is a noop on W32 systems. */)
7088 Lisp_Object display
, on
;
7095 /***********************************************************************
7097 ***********************************************************************/
7099 DEFUN ("x-change-window-property", Fx_change_window_property
,
7100 Sx_change_window_property
, 2, 6, 0,
7101 doc
: /* Change window property PROP to VALUE on the X window of FRAME.
7102 VALUE may be a string or a list of conses, numbers and/or strings.
7103 If an element in the list is a string, it is converted to
7104 an Atom and the value of the Atom is used. If an element is a cons,
7105 it is converted to a 32 bit number where the car is the 16 top bits and the
7106 cdr is the lower 16 bits.
7107 FRAME nil or omitted means use the selected frame.
7108 If TYPE is given and non-nil, it is the name of the type of VALUE.
7109 If TYPE is not given or nil, the type is STRING.
7110 FORMAT gives the size in bits of each element if VALUE is a list.
7111 It must be one of 8, 16 or 32.
7112 If VALUE is a string or FORMAT is nil or not given, FORMAT defaults to 8.
7113 If OUTER_P is non-nil, the property is changed for the outer X window of
7114 FRAME. Default is to change on the edit X window.
7117 (prop
, value
, frame
, type
, format
, outer_p
)
7118 Lisp_Object prop
, value
, frame
, type
, format
, outer_p
;
7120 #if 0 /* TODO : port window properties to W32 */
7121 struct frame
*f
= check_x_frame (frame
);
7124 CHECK_STRING (prop
);
7125 CHECK_STRING (value
);
7128 prop_atom
= XInternAtom (FRAME_W32_DISPLAY (f
), SDATA (prop
), False
);
7129 XChangeProperty (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
7130 prop_atom
, XA_STRING
, 8, PropModeReplace
,
7131 SDATA (value
), SCHARS (value
));
7133 /* Make sure the property is set when we return. */
7134 XFlush (FRAME_W32_DISPLAY (f
));
7143 DEFUN ("x-delete-window-property", Fx_delete_window_property
,
7144 Sx_delete_window_property
, 1, 2, 0,
7145 doc
: /* Remove window property PROP from X window of FRAME.
7146 FRAME nil or omitted means use the selected frame. Value is PROP. */)
7148 Lisp_Object prop
, frame
;
7150 #if 0 /* TODO : port window properties to W32 */
7152 struct frame
*f
= check_x_frame (frame
);
7155 CHECK_STRING (prop
);
7157 prop_atom
= XInternAtom (FRAME_W32_DISPLAY (f
), SDATA (prop
), False
);
7158 XDeleteProperty (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
), prop_atom
);
7160 /* Make sure the property is removed when we return. */
7161 XFlush (FRAME_W32_DISPLAY (f
));
7169 DEFUN ("x-window-property", Fx_window_property
, Sx_window_property
,
7171 doc
: /* Value is the value of window property PROP on FRAME.
7172 If FRAME is nil or omitted, use the selected frame. Value is nil
7173 if FRAME hasn't a property with name PROP or if PROP has no string
7176 Lisp_Object prop
, frame
;
7178 #if 0 /* TODO : port window properties to W32 */
7180 struct frame
*f
= check_x_frame (frame
);
7183 Lisp_Object prop_value
= Qnil
;
7184 char *tmp_data
= NULL
;
7187 unsigned long actual_size
, bytes_remaining
;
7189 CHECK_STRING (prop
);
7191 prop_atom
= XInternAtom (FRAME_W32_DISPLAY (f
), SDATA (prop
), False
);
7192 rc
= XGetWindowProperty (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
7193 prop_atom
, 0, 0, False
, XA_STRING
,
7194 &actual_type
, &actual_format
, &actual_size
,
7195 &bytes_remaining
, (unsigned char **) &tmp_data
);
7198 int size
= bytes_remaining
;
7203 rc
= XGetWindowProperty (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
7204 prop_atom
, 0, bytes_remaining
,
7206 &actual_type
, &actual_format
,
7207 &actual_size
, &bytes_remaining
,
7208 (unsigned char **) &tmp_data
);
7210 prop_value
= make_string (tmp_data
, size
);
7225 /***********************************************************************
7227 ***********************************************************************/
7229 /* Non-zero means an hourglass cursor is currently shown. */
7231 static int hourglass_shown_p
;
7233 /* Number of seconds to wait before displaying an hourglass cursor. */
7235 static Lisp_Object Vhourglass_delay
;
7237 /* Default number of seconds to wait before displaying an hourglass
7240 #define DEFAULT_HOURGLASS_DELAY 1
7242 /* Return non-zero if houglass timer has been started or hourglass is shown. */
7245 hourglass_started ()
7247 return hourglass_shown_p
|| hourglass_timer
;
7250 /* Cancel a currently active hourglass timer, and start a new one. */
7256 int secs
, msecs
= 0;
7257 struct frame
* f
= SELECTED_FRAME ();
7259 /* No cursors on non GUI frames. */
7260 if (!FRAME_W32_P (f
))
7263 cancel_hourglass ();
7265 if (INTEGERP (Vhourglass_delay
)
7266 && XINT (Vhourglass_delay
) > 0)
7267 secs
= XFASTINT (Vhourglass_delay
);
7268 else if (FLOATP (Vhourglass_delay
)
7269 && XFLOAT_DATA (Vhourglass_delay
) > 0)
7272 tem
= Ftruncate (Vhourglass_delay
, Qnil
);
7273 secs
= XFASTINT (tem
);
7274 msecs
= (XFLOAT_DATA (Vhourglass_delay
) - secs
) * 1000;
7277 secs
= DEFAULT_HOURGLASS_DELAY
;
7279 delay
= secs
* 1000 + msecs
;
7280 hourglass_hwnd
= FRAME_W32_WINDOW (f
);
7281 hourglass_timer
= SetTimer (hourglass_hwnd
, HOURGLASS_ID
, delay
, NULL
);
7285 /* Cancel the hourglass cursor timer if active, hide an hourglass
7291 if (hourglass_timer
)
7293 KillTimer (hourglass_hwnd
, hourglass_timer
);
7294 hourglass_timer
= 0;
7297 if (hourglass_shown_p
)
7302 /* Timer function of hourglass_timer.
7304 Display an hourglass cursor. Set the hourglass_p flag in display info
7305 to indicate that an hourglass cursor is shown. */
7311 if (!hourglass_shown_p
)
7313 f
->output_data
.w32
->hourglass_p
= 1;
7314 if (!menubar_in_use
&& !current_popup_menu
)
7315 SetCursor (f
->output_data
.w32
->hourglass_cursor
);
7316 hourglass_shown_p
= 1;
7321 /* Hide the hourglass cursor on all frames, if it is currently shown. */
7326 if (hourglass_shown_p
)
7328 struct frame
*f
= x_window_to_frame (&one_w32_display_info
,
7331 f
->output_data
.w32
->hourglass_p
= 0;
7332 SetCursor (f
->output_data
.w32
->current_cursor
);
7333 hourglass_shown_p
= 0;
7339 /***********************************************************************
7341 ***********************************************************************/
7343 static Lisp_Object x_create_tip_frame
P_ ((struct w32_display_info
*,
7344 Lisp_Object
, Lisp_Object
));
7345 static void compute_tip_xy
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
7346 Lisp_Object
, int, int, int *, int *));
7348 /* The frame of a currently visible tooltip. */
7350 Lisp_Object tip_frame
;
7352 /* If non-nil, a timer started that hides the last tooltip when it
7355 Lisp_Object tip_timer
;
7358 /* If non-nil, a vector of 3 elements containing the last args
7359 with which x-show-tip was called. See there. */
7361 Lisp_Object last_show_tip_args
;
7363 /* Maximum size for tooltips; a cons (COLUMNS . ROWS). */
7365 Lisp_Object Vx_max_tooltip_size
;
7369 unwind_create_tip_frame (frame
)
7372 Lisp_Object deleted
;
7374 deleted
= unwind_create_frame (frame
);
7375 if (EQ (deleted
, Qt
))
7385 /* Create a frame for a tooltip on the display described by DPYINFO.
7386 PARMS is a list of frame parameters. TEXT is the string to
7387 display in the tip frame. Value is the frame.
7389 Note that functions called here, esp. x_default_parameter can
7390 signal errors, for instance when a specified color name is
7391 undefined. We have to make sure that we're in a consistent state
7392 when this happens. */
7395 x_create_tip_frame (dpyinfo
, parms
, text
)
7396 struct w32_display_info
*dpyinfo
;
7397 Lisp_Object parms
, text
;
7400 Lisp_Object frame
, tem
;
7402 long window_prompting
= 0;
7404 int count
= SPECPDL_INDEX ();
7405 struct gcpro gcpro1
, gcpro2
, gcpro3
;
7407 int face_change_count_before
= face_change_count
;
7409 struct buffer
*old_buffer
;
7413 /* Use this general default value to start with until we know if
7414 this frame has a specified name. */
7415 Vx_resource_name
= Vinvocation_name
;
7418 kb
= dpyinfo
->terminal
->kboard
;
7420 kb
= &the_only_kboard
;
7423 /* Get the name of the frame to use for resource lookup. */
7424 name
= w32_get_arg (parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
7426 && !EQ (name
, Qunbound
)
7428 error ("Invalid frame name--not a string or nil");
7429 Vx_resource_name
= name
;
7432 GCPRO3 (parms
, name
, frame
);
7433 /* Make a frame without minibuffer nor mode-line. */
7435 f
->wants_modeline
= 0;
7436 XSETFRAME (frame
, f
);
7438 buffer
= Fget_buffer_create (build_string (" *tip*"));
7439 Fset_window_buffer (FRAME_ROOT_WINDOW (f
), buffer
, Qnil
);
7440 old_buffer
= current_buffer
;
7441 set_buffer_internal_1 (XBUFFER (buffer
));
7442 current_buffer
->truncate_lines
= Qnil
;
7443 specbind (Qinhibit_read_only
, Qt
);
7444 specbind (Qinhibit_modification_hooks
, Qt
);
7447 set_buffer_internal_1 (old_buffer
);
7449 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 0;
7450 record_unwind_protect (unwind_create_tip_frame
, frame
);
7452 /* By setting the output method, we're essentially saying that
7453 the frame is live, as per FRAME_LIVE_P. If we get a signal
7454 from this point on, x_destroy_window might screw up reference
7456 f
->terminal
= dpyinfo
->terminal
;
7457 f
->terminal
->reference_count
++;
7458 f
->output_method
= output_w32
;
7459 f
->output_data
.w32
=
7460 (struct w32_output
*) xmalloc (sizeof (struct w32_output
));
7461 bzero (f
->output_data
.w32
, sizeof (struct w32_output
));
7463 FRAME_FONTSET (f
) = -1;
7464 f
->icon_name
= Qnil
;
7466 #if 0 /* GLYPH_DEBUG TODO: image support. */
7467 image_cache_refcount
= FRAME_IMAGE_CACHE (f
)->refcount
;
7468 dpyinfo_refcount
= dpyinfo
->reference_count
;
7469 #endif /* GLYPH_DEBUG */
7471 FRAME_KBOARD (f
) = kb
;
7473 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
7474 f
->output_data
.w32
->explicit_parent
= 0;
7476 /* Set the name; the functions to which we pass f expect the name to
7478 if (EQ (name
, Qunbound
) || NILP (name
))
7480 f
->name
= build_string (dpyinfo
->w32_id_name
);
7481 f
->explicit_name
= 0;
7486 f
->explicit_name
= 1;
7487 /* use the frame's title when getting resources for this frame. */
7488 specbind (Qx_resource_name
, name
);
7491 f
->resx
= dpyinfo
->resx
;
7492 f
->resy
= dpyinfo
->resy
;
7494 /* Perhaps, we must allow frame parameter, say `font-backend',
7495 to specify which font backends to use. */
7496 register_font_driver (&w32font_driver
, f
);
7498 x_default_parameter (f
, parms
, Qfont_backend
, Qnil
,
7499 "fontBackend", "FontBackend", RES_TYPE_STRING
);
7501 /* Extract the window parameters from the supplied values
7502 that are needed to determine window geometry. */
7503 x_default_font_parameter (f
, parms
);
7505 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
7506 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
7507 /* This defaults to 2 in order to match xterm. We recognize either
7508 internalBorderWidth or internalBorder (which is what xterm calls
7510 if (NILP (Fassq (Qinternal_border_width
, parms
)))
7514 value
= w32_get_arg (parms
, Qinternal_border_width
,
7515 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
7516 if (! EQ (value
, Qunbound
))
7517 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
7520 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
7521 "internalBorderWidth", "internalBorderWidth",
7524 /* Also do the stuff which must be set before the window exists. */
7525 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
7526 "foreground", "Foreground", RES_TYPE_STRING
);
7527 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
7528 "background", "Background", RES_TYPE_STRING
);
7529 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
7530 "pointerColor", "Foreground", RES_TYPE_STRING
);
7531 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
7532 "cursorColor", "Foreground", RES_TYPE_STRING
);
7533 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
7534 "borderColor", "BorderColor", RES_TYPE_STRING
);
7536 /* Init faces before x_default_parameter is called for scroll-bar
7537 parameters because that function calls x_set_scroll_bar_width,
7538 which calls change_frame_size, which calls Fset_window_buffer,
7539 which runs hooks, which call Fvertical_motion. At the end, we
7540 end up in init_iterator with a null face cache, which should not
7542 init_frame_faces (f
);
7544 f
->output_data
.w32
->dwStyle
= WS_BORDER
| WS_POPUP
| WS_DISABLED
;
7545 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
7547 window_prompting
= x_figure_window_size (f
, parms
, 0);
7549 /* No fringes on tip frame. */
7551 f
->left_fringe_width
= 0;
7552 f
->right_fringe_width
= 0;
7555 my_create_tip_window (f
);
7560 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
7561 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
7562 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
7563 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
7564 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
7565 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
7567 /* Dimensions, especially FRAME_LINES (f), must be done via change_frame_size.
7568 Change will not be effected unless different from the current
7570 width
= FRAME_COLS (f
);
7571 height
= FRAME_LINES (f
);
7572 FRAME_LINES (f
) = 0;
7573 SET_FRAME_COLS (f
, 0);
7574 change_frame_size (f
, height
, width
, 1, 0, 0);
7576 /* Add `tooltip' frame parameter's default value. */
7577 if (NILP (Fframe_parameter (frame
, intern ("tooltip"))))
7578 Fmodify_frame_parameters (frame
, Fcons (Fcons (intern ("tooltip"), Qt
),
7581 /* Set up faces after all frame parameters are known. This call
7582 also merges in face attributes specified for new frames.
7584 Frame parameters may be changed if .Xdefaults contains
7585 specifications for the default font. For example, if there is an
7586 `Emacs.default.attributeBackground: pink', the `background-color'
7587 attribute of the frame get's set, which let's the internal border
7588 of the tooltip frame appear in pink. Prevent this. */
7590 Lisp_Object bg
= Fframe_parameter (frame
, Qbackground_color
);
7592 /* Set tip_frame here, so that */
7594 call1 (Qface_set_after_frame_default
, frame
);
7596 if (!EQ (bg
, Fframe_parameter (frame
, Qbackground_color
)))
7597 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qbackground_color
, bg
),
7605 /* It is now ok to make the frame official even if we get an error
7606 below. And the frame needs to be on Vframe_list or making it
7607 visible won't work. */
7608 Vframe_list
= Fcons (frame
, Vframe_list
);
7610 /* Now that the frame is official, it counts as a reference to
7612 FRAME_W32_DISPLAY_INFO (f
)->reference_count
++;
7614 /* Setting attributes of faces of the tooltip frame from resources
7615 and similar will increment face_change_count, which leads to the
7616 clearing of all current matrices. Since this isn't necessary
7617 here, avoid it by resetting face_change_count to the value it
7618 had before we created the tip frame. */
7619 face_change_count
= face_change_count_before
;
7621 /* Discard the unwind_protect. */
7622 return unbind_to (count
, frame
);
7626 /* Compute where to display tip frame F. PARMS is the list of frame
7627 parameters for F. DX and DY are specified offsets from the current
7628 location of the mouse. WIDTH and HEIGHT are the width and height
7629 of the tooltip. Return coordinates relative to the root window of
7630 the display in *ROOT_X, and *ROOT_Y. */
7633 compute_tip_xy (f
, parms
, dx
, dy
, width
, height
, root_x
, root_y
)
7635 Lisp_Object parms
, dx
, dy
;
7637 int *root_x
, *root_y
;
7639 Lisp_Object left
, top
;
7640 int min_x
, min_y
, max_x
, max_y
;
7642 /* User-specified position? */
7643 left
= Fcdr (Fassq (Qleft
, parms
));
7644 top
= Fcdr (Fassq (Qtop
, parms
));
7646 /* Move the tooltip window where the mouse pointer is. Resize and
7648 if (!INTEGERP (left
) || !INTEGERP (top
))
7652 /* Default min and max values. */
7655 max_x
= FRAME_W32_DISPLAY_INFO (f
)->width
;
7656 max_y
= FRAME_W32_DISPLAY_INFO (f
)->height
;
7664 /* If multiple monitor support is available, constrain the tip onto
7665 the current monitor. This improves the above by allowing negative
7666 co-ordinates if monitor positions are such that they are valid, and
7667 snaps a tooltip onto a single monitor if we are close to the edge
7668 where it would otherwise flow onto the other monitor (or into
7669 nothingness if there is a gap in the overlap). */
7670 if (monitor_from_point_fn
&& get_monitor_info_fn
)
7672 struct MONITOR_INFO info
;
7674 = monitor_from_point_fn (pt
, MONITOR_DEFAULT_TO_NEAREST
);
7675 info
.cbSize
= sizeof (info
);
7677 if (get_monitor_info_fn (monitor
, &info
))
7679 min_x
= info
.rcWork
.left
;
7680 min_y
= info
.rcWork
.top
;
7681 max_x
= info
.rcWork
.right
;
7682 max_y
= info
.rcWork
.bottom
;
7688 *root_y
= XINT (top
);
7689 else if (*root_y
+ XINT (dy
) <= min_y
)
7690 *root_y
= min_y
; /* Can happen for negative dy */
7691 else if (*root_y
+ XINT (dy
) + height
<= max_y
)
7692 /* It fits below the pointer */
7693 *root_y
+= XINT (dy
);
7694 else if (height
+ XINT (dy
) + min_y
<= *root_y
)
7695 /* It fits above the pointer. */
7696 *root_y
-= height
+ XINT (dy
);
7698 /* Put it on the top. */
7701 if (INTEGERP (left
))
7702 *root_x
= XINT (left
);
7703 else if (*root_x
+ XINT (dx
) <= min_x
)
7704 *root_x
= 0; /* Can happen for negative dx */
7705 else if (*root_x
+ XINT (dx
) + width
<= max_x
)
7706 /* It fits to the right of the pointer. */
7707 *root_x
+= XINT (dx
);
7708 else if (width
+ XINT (dx
) + min_x
<= *root_x
)
7709 /* It fits to the left of the pointer. */
7710 *root_x
-= width
+ XINT (dx
);
7712 /* Put it left justified on the screen -- it ought to fit that way. */
7717 DEFUN ("x-show-tip", Fx_show_tip
, Sx_show_tip
, 1, 6, 0,
7718 doc
: /* Show STRING in a \"tooltip\" window on frame FRAME.
7719 A tooltip window is a small window displaying a string.
7721 This is an internal function; Lisp code should call `tooltip-show'.
7723 FRAME nil or omitted means use the selected frame.
7725 PARMS is an optional list of frame parameters which can be
7726 used to change the tooltip's appearance.
7728 Automatically hide the tooltip after TIMEOUT seconds. TIMEOUT nil
7729 means use the default timeout of 5 seconds.
7731 If the list of frame parameters PARMS contains a `left' parameter,
7732 the tooltip is displayed at that x-position. Otherwise it is
7733 displayed at the mouse position, with offset DX added (default is 5 if
7734 DX isn't specified). Likewise for the y-position; if a `top' frame
7735 parameter is specified, it determines the y-position of the tooltip
7736 window, otherwise it is displayed at the mouse position, with offset
7737 DY added (default is -10).
7739 A tooltip's maximum size is specified by `x-max-tooltip-size'.
7740 Text larger than the specified size is clipped. */)
7741 (string
, frame
, parms
, timeout
, dx
, dy
)
7742 Lisp_Object string
, frame
, parms
, timeout
, dx
, dy
;
7747 struct buffer
*old_buffer
;
7748 struct text_pos pos
;
7749 int i
, width
, height
;
7750 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
7751 int old_windows_or_buffers_changed
= windows_or_buffers_changed
;
7752 int count
= SPECPDL_INDEX ();
7754 specbind (Qinhibit_redisplay
, Qt
);
7756 GCPRO4 (string
, parms
, frame
, timeout
);
7758 CHECK_STRING (string
);
7759 f
= check_x_frame (frame
);
7761 timeout
= make_number (5);
7763 CHECK_NATNUM (timeout
);
7766 dx
= make_number (5);
7771 dy
= make_number (-10);
7775 if (NILP (last_show_tip_args
))
7776 last_show_tip_args
= Fmake_vector (make_number (3), Qnil
);
7778 if (!NILP (tip_frame
))
7780 Lisp_Object last_string
= AREF (last_show_tip_args
, 0);
7781 Lisp_Object last_frame
= AREF (last_show_tip_args
, 1);
7782 Lisp_Object last_parms
= AREF (last_show_tip_args
, 2);
7784 if (EQ (frame
, last_frame
)
7785 && !NILP (Fequal (last_string
, string
))
7786 && !NILP (Fequal (last_parms
, parms
)))
7788 struct frame
*f
= XFRAME (tip_frame
);
7790 /* Only DX and DY have changed. */
7791 if (!NILP (tip_timer
))
7793 Lisp_Object timer
= tip_timer
;
7795 call1 (Qcancel_timer
, timer
);
7799 compute_tip_xy (f
, parms
, dx
, dy
, FRAME_PIXEL_WIDTH (f
),
7800 FRAME_PIXEL_HEIGHT (f
), &root_x
, &root_y
);
7802 /* Put tooltip in topmost group and in position. */
7803 SetWindowPos (FRAME_W32_WINDOW (f
), HWND_TOPMOST
,
7804 root_x
, root_y
, 0, 0,
7805 SWP_NOSIZE
| SWP_NOACTIVATE
);
7807 /* Ensure tooltip is on top of other topmost windows (eg menus). */
7808 SetWindowPos (FRAME_W32_WINDOW (f
), HWND_TOP
,
7810 SWP_NOMOVE
| SWP_NOSIZE
| SWP_NOACTIVATE
);
7817 /* Hide a previous tip, if any. */
7820 ASET (last_show_tip_args
, 0, string
);
7821 ASET (last_show_tip_args
, 1, frame
);
7822 ASET (last_show_tip_args
, 2, parms
);
7824 /* Add default values to frame parameters. */
7825 if (NILP (Fassq (Qname
, parms
)))
7826 parms
= Fcons (Fcons (Qname
, build_string ("tooltip")), parms
);
7827 if (NILP (Fassq (Qinternal_border_width
, parms
)))
7828 parms
= Fcons (Fcons (Qinternal_border_width
, make_number (3)), parms
);
7829 if (NILP (Fassq (Qborder_width
, parms
)))
7830 parms
= Fcons (Fcons (Qborder_width
, make_number (1)), parms
);
7831 if (NILP (Fassq (Qborder_color
, parms
)))
7832 parms
= Fcons (Fcons (Qborder_color
, build_string ("lightyellow")), parms
);
7833 if (NILP (Fassq (Qbackground_color
, parms
)))
7834 parms
= Fcons (Fcons (Qbackground_color
, build_string ("lightyellow")),
7837 /* Block input until the tip has been fully drawn, to avoid crashes
7838 when drawing tips in menus. */
7841 /* Create a frame for the tooltip, and record it in the global
7842 variable tip_frame. */
7843 frame
= x_create_tip_frame (FRAME_W32_DISPLAY_INFO (f
), parms
, string
);
7846 /* Set up the frame's root window. */
7847 w
= XWINDOW (FRAME_ROOT_WINDOW (f
));
7848 w
->left_col
= w
->top_line
= make_number (0);
7850 if (CONSP (Vx_max_tooltip_size
)
7851 && INTEGERP (XCAR (Vx_max_tooltip_size
))
7852 && XINT (XCAR (Vx_max_tooltip_size
)) > 0
7853 && INTEGERP (XCDR (Vx_max_tooltip_size
))
7854 && XINT (XCDR (Vx_max_tooltip_size
)) > 0)
7856 w
->total_cols
= XCAR (Vx_max_tooltip_size
);
7857 w
->total_lines
= XCDR (Vx_max_tooltip_size
);
7861 w
->total_cols
= make_number (80);
7862 w
->total_lines
= make_number (40);
7865 FRAME_TOTAL_COLS (f
) = XINT (w
->total_cols
);
7867 w
->pseudo_window_p
= 1;
7869 /* Display the tooltip text in a temporary buffer. */
7870 old_buffer
= current_buffer
;
7871 set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f
))->buffer
));
7872 current_buffer
->truncate_lines
= Qnil
;
7873 clear_glyph_matrix (w
->desired_matrix
);
7874 clear_glyph_matrix (w
->current_matrix
);
7875 SET_TEXT_POS (pos
, BEGV
, BEGV_BYTE
);
7876 try_window (FRAME_ROOT_WINDOW (f
), pos
, 0);
7878 /* Compute width and height of the tooltip. */
7880 for (i
= 0; i
< w
->desired_matrix
->nrows
; ++i
)
7882 struct glyph_row
*row
= &w
->desired_matrix
->rows
[i
];
7886 /* Stop at the first empty row at the end. */
7887 if (!row
->enabled_p
|| !row
->displays_text_p
)
7890 /* Let the row go over the full width of the frame. */
7891 row
->full_width_p
= 1;
7893 #ifdef TODO /* Investigate why some fonts need more width than is
7894 calculated for some tooltips. */
7895 /* There's a glyph at the end of rows that is use to place
7896 the cursor there. Don't include the width of this glyph. */
7897 if (row
->used
[TEXT_AREA
])
7899 last
= &row
->glyphs
[TEXT_AREA
][row
->used
[TEXT_AREA
] - 1];
7900 row_width
= row
->pixel_width
- last
->pixel_width
;
7904 row_width
= row
->pixel_width
;
7906 /* TODO: find why tips do not draw along baseline as instructed. */
7907 height
+= row
->height
;
7908 width
= max (width
, row_width
);
7911 /* Add the frame's internal border to the width and height the X
7912 window should have. */
7913 height
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
7914 width
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
7916 /* Move the tooltip window where the mouse pointer is. Resize and
7918 compute_tip_xy (f
, parms
, dx
, dy
, width
, height
, &root_x
, &root_y
);
7921 /* Adjust Window size to take border into account. */
7923 rect
.left
= rect
.top
= 0;
7925 rect
.bottom
= height
;
7926 AdjustWindowRect (&rect
, f
->output_data
.w32
->dwStyle
,
7927 FRAME_EXTERNAL_MENU_BAR (f
));
7929 /* Position and size tooltip, and put it in the topmost group.
7930 The add-on of 3 to the 5th argument is a kludge: without it,
7931 some fonts cause the last character of the tip to be truncated,
7932 for some obscure reason. */
7933 SetWindowPos (FRAME_W32_WINDOW (f
), HWND_TOPMOST
,
7934 root_x
, root_y
, rect
.right
- rect
.left
+ 3,
7935 rect
.bottom
- rect
.top
, SWP_NOACTIVATE
);
7937 /* Ensure tooltip is on top of other topmost windows (eg menus). */
7938 SetWindowPos (FRAME_W32_WINDOW (f
), HWND_TOP
,
7940 SWP_NOMOVE
| SWP_NOSIZE
| SWP_NOACTIVATE
);
7942 /* Let redisplay know that we have made the frame visible already. */
7943 f
->async_visible
= 1;
7945 ShowWindow (FRAME_W32_WINDOW (f
), SW_SHOWNOACTIVATE
);
7948 /* Draw into the window. */
7949 w
->must_be_updated_p
= 1;
7950 update_single_window (w
, 1);
7954 /* Restore original current buffer. */
7955 set_buffer_internal_1 (old_buffer
);
7956 windows_or_buffers_changed
= old_windows_or_buffers_changed
;
7959 /* Let the tip disappear after timeout seconds. */
7960 tip_timer
= call3 (intern ("run-at-time"), timeout
, Qnil
,
7961 intern ("x-hide-tip"));
7964 return unbind_to (count
, Qnil
);
7968 DEFUN ("x-hide-tip", Fx_hide_tip
, Sx_hide_tip
, 0, 0, 0,
7969 doc
: /* Hide the current tooltip window, if there is any.
7970 Value is t if tooltip was open, nil otherwise. */)
7974 Lisp_Object deleted
, frame
, timer
;
7975 struct gcpro gcpro1
, gcpro2
;
7977 /* Return quickly if nothing to do. */
7978 if (NILP (tip_timer
) && NILP (tip_frame
))
7983 GCPRO2 (frame
, timer
);
7984 tip_frame
= tip_timer
= deleted
= Qnil
;
7986 count
= SPECPDL_INDEX ();
7987 specbind (Qinhibit_redisplay
, Qt
);
7988 specbind (Qinhibit_quit
, Qt
);
7991 call1 (Qcancel_timer
, timer
);
7995 Fdelete_frame (frame
, Qnil
);
8000 return unbind_to (count
, deleted
);
8005 /***********************************************************************
8006 File selection dialog
8007 ***********************************************************************/
8008 extern Lisp_Object Qfile_name_history
;
8010 /* Callback for altering the behaviour of the Open File dialog.
8011 Makes the Filename text field contain "Current Directory" and be
8012 read-only when "Directories" is selected in the filter. This
8013 allows us to work around the fact that the standard Open File
8014 dialog does not support directories. */
8016 file_dialog_callback (hwnd
, msg
, wParam
, lParam
)
8022 if (msg
== WM_NOTIFY
)
8024 OFNOTIFY
* notify
= (OFNOTIFY
*)lParam
;
8025 /* Detect when the Filter dropdown is changed. */
8026 if (notify
->hdr
.code
== CDN_TYPECHANGE
8027 || notify
->hdr
.code
== CDN_INITDONE
)
8029 HWND dialog
= GetParent (hwnd
);
8030 HWND edit_control
= GetDlgItem (dialog
, FILE_NAME_TEXT_FIELD
);
8032 /* Directories is in index 2. */
8033 if (notify
->lpOFN
->nFilterIndex
== 2)
8035 CommDlg_OpenSave_SetControlText (dialog
, FILE_NAME_TEXT_FIELD
,
8036 "Current Directory");
8037 EnableWindow (edit_control
, FALSE
);
8041 /* Don't override default filename on init done. */
8042 if (notify
->hdr
.code
== CDN_TYPECHANGE
)
8043 CommDlg_OpenSave_SetControlText (dialog
,
8044 FILE_NAME_TEXT_FIELD
, "");
8045 EnableWindow (edit_control
, TRUE
);
8052 /* Since we compile with _WIN32_WINNT set to 0x0400 (for NT4 compatibility)
8053 we end up with the old file dialogs. Define a big enough struct for the
8054 new dialog to trick GetOpenFileName into giving us the new dialogs on
8055 Windows 2000 and XP. */
8058 OPENFILENAME real_details
;
8065 DEFUN ("x-file-dialog", Fx_file_dialog
, Sx_file_dialog
, 2, 5, 0,
8066 doc
: /* Read file name, prompting with PROMPT in directory DIR.
8067 Use a file selection dialog.
8068 Select DEFAULT-FILENAME in the dialog's file selection box, if
8069 specified. Ensure that file exists if MUSTMATCH is non-nil.
8070 If ONLY-DIR-P is non-nil, the user can only select directories. */)
8071 (prompt
, dir
, default_filename
, mustmatch
, only_dir_p
)
8072 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, only_dir_p
;
8074 struct frame
*f
= SELECTED_FRAME ();
8075 Lisp_Object file
= Qnil
;
8076 int count
= SPECPDL_INDEX ();
8077 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
8078 char filename
[MAX_PATH
+ 1];
8079 char init_dir
[MAX_PATH
+ 1];
8080 int default_filter_index
= 1; /* 1: All Files, 2: Directories only */
8082 GCPRO6 (prompt
, dir
, default_filename
, mustmatch
, only_dir_p
, file
);
8083 CHECK_STRING (prompt
);
8086 /* Create the dialog with PROMPT as title, using DIR as initial
8087 directory and using "*" as pattern. */
8088 dir
= Fexpand_file_name (dir
, Qnil
);
8089 strncpy (init_dir
, SDATA (ENCODE_FILE (dir
)), MAX_PATH
);
8090 init_dir
[MAX_PATH
] = '\0';
8091 unixtodos_filename (init_dir
);
8093 if (STRINGP (default_filename
))
8095 char *file_name_only
;
8096 char *full_path_name
= SDATA (ENCODE_FILE (default_filename
));
8098 unixtodos_filename (full_path_name
);
8100 file_name_only
= strrchr (full_path_name
, '\\');
8101 if (!file_name_only
)
8102 file_name_only
= full_path_name
;
8106 strncpy (filename
, file_name_only
, MAX_PATH
);
8107 filename
[MAX_PATH
] = '\0';
8113 NEWOPENFILENAME new_file_details
;
8114 BOOL file_opened
= FALSE
;
8115 OPENFILENAME
* file_details
= &new_file_details
.real_details
;
8117 /* Prevent redisplay. */
8118 specbind (Qinhibit_redisplay
, Qt
);
8121 bzero (&new_file_details
, sizeof (new_file_details
));
8122 /* Apparently NT4 crashes if you give it an unexpected size.
8123 I'm not sure about Windows 9x, so play it safe. */
8124 if (w32_major_version
> 4 && w32_major_version
< 95)
8125 file_details
->lStructSize
= sizeof (NEWOPENFILENAME
);
8127 file_details
->lStructSize
= sizeof (OPENFILENAME
);
8129 file_details
->hwndOwner
= FRAME_W32_WINDOW (f
);
8130 /* Undocumented Bug in Common File Dialog:
8131 If a filter is not specified, shell links are not resolved. */
8132 file_details
->lpstrFilter
= "All Files (*.*)\0*.*\0Directories\0*|*\0\0";
8133 file_details
->lpstrFile
= filename
;
8134 file_details
->nMaxFile
= sizeof (filename
);
8135 file_details
->lpstrInitialDir
= init_dir
;
8136 file_details
->lpstrTitle
= SDATA (prompt
);
8138 if (! NILP (only_dir_p
))
8139 default_filter_index
= 2;
8141 file_details
->nFilterIndex
= default_filter_index
;
8143 file_details
->Flags
= (OFN_HIDEREADONLY
| OFN_NOCHANGEDIR
8144 | OFN_EXPLORER
| OFN_ENABLEHOOK
);
8145 if (!NILP (mustmatch
))
8147 /* Require that the path to the parent directory exists. */
8148 file_details
->Flags
|= OFN_PATHMUSTEXIST
;
8149 /* If we are looking for a file, require that it exists. */
8150 if (NILP (only_dir_p
))
8151 file_details
->Flags
|= OFN_FILEMUSTEXIST
;
8154 file_details
->lpfnHook
= (LPOFNHOOKPROC
) file_dialog_callback
;
8156 file_opened
= GetOpenFileName (file_details
);
8162 dostounix_filename (filename
);
8164 if (file_details
->nFilterIndex
== 2)
8166 /* "Directories" selected - strip dummy file name. */
8167 char * last
= strrchr (filename
, '/');
8171 file
= DECODE_FILE (build_string (filename
));
8173 /* User cancelled the dialog without making a selection. */
8174 else if (!CommDlgExtendedError ())
8176 /* An error occurred, fallback on reading from the mini-buffer. */
8178 file
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
8179 dir
, mustmatch
, dir
, Qfile_name_history
,
8180 default_filename
, Qnil
);
8182 file
= unbind_to (count
, file
);
8187 /* Make "Cancel" equivalent to C-g. */
8189 Fsignal (Qquit
, Qnil
);
8191 return unbind_to (count
, file
);
8196 /***********************************************************************
8197 w32 specialized functions
8198 ***********************************************************************/
8200 DEFUN ("w32-select-font", Fw32_select_font
, Sw32_select_font
, 0, 2, 0,
8201 doc
: /* Select a font for the named FRAME using the W32 font dialog.
8202 Return an X-style font string corresponding to the selection.
8204 If FRAME is omitted or nil, it defaults to the selected frame.
8205 If INCLUDE-PROPORTIONAL is non-nil, include proportional fonts
8206 in the font selection dialog. */)
8207 (frame
, include_proportional
)
8208 Lisp_Object frame
, include_proportional
;
8210 FRAME_PTR f
= check_x_frame (frame
);
8218 bzero (&cf
, sizeof (cf
));
8219 bzero (&lf
, sizeof (lf
));
8221 cf
.lStructSize
= sizeof (cf
);
8222 cf
.hwndOwner
= FRAME_W32_WINDOW (f
);
8223 cf
.Flags
= CF_FORCEFONTEXIST
| CF_SCREENFONTS
| CF_NOVERTFONTS
;
8225 /* Unless include_proportional is non-nil, limit the selection to
8226 monospaced fonts. */
8227 if (NILP (include_proportional
))
8228 cf
.Flags
|= CF_FIXEDPITCHONLY
;
8232 /* Initialize as much of the font details as we can from the current
8234 hdc
= GetDC (FRAME_W32_WINDOW (f
));
8235 oldobj
= SelectObject (hdc
, FONT_COMPAT (FRAME_FONT (f
))->hfont
);
8236 GetTextFace (hdc
, LF_FACESIZE
, lf
.lfFaceName
);
8237 if (GetTextMetrics (hdc
, &tm
))
8239 lf
.lfHeight
= tm
.tmInternalLeading
- tm
.tmHeight
;
8240 lf
.lfWeight
= tm
.tmWeight
;
8241 lf
.lfItalic
= tm
.tmItalic
;
8242 lf
.lfUnderline
= tm
.tmUnderlined
;
8243 lf
.lfStrikeOut
= tm
.tmStruckOut
;
8244 lf
.lfCharSet
= tm
.tmCharSet
;
8245 cf
.Flags
|= CF_INITTOLOGFONTSTRUCT
;
8247 SelectObject (hdc
, oldobj
);
8248 ReleaseDC (FRAME_W32_WINDOW (f
), hdc
);
8250 if (!ChooseFont (&cf
) || !w32_to_x_font (&lf
, buf
, 100, NULL
))
8253 return build_string (buf
);
8256 DEFUN ("w32-send-sys-command", Fw32_send_sys_command
,
8257 Sw32_send_sys_command
, 1, 2, 0,
8258 doc
: /* Send frame a Windows WM_SYSCOMMAND message of type COMMAND.
8259 Some useful values for COMMAND are #xf030 to maximize frame (#xf020
8260 to minimize), #xf120 to restore frame to original size, and #xf100
8261 to activate the menubar for keyboard access. #xf140 activates the
8262 screen saver if defined.
8264 If optional parameter FRAME is not specified, use selected frame. */)
8266 Lisp_Object command
, frame
;
8268 FRAME_PTR f
= check_x_frame (frame
);
8270 CHECK_NUMBER (command
);
8272 PostMessage (FRAME_W32_WINDOW (f
), WM_SYSCOMMAND
, XINT (command
), 0);
8277 DEFUN ("w32-shell-execute", Fw32_shell_execute
, Sw32_shell_execute
, 2, 4, 0,
8278 doc
: /* Get Windows to perform OPERATION on DOCUMENT.
8279 This is a wrapper around the ShellExecute system function, which
8280 invokes the application registered to handle OPERATION for DOCUMENT.
8282 OPERATION is either nil or a string that names a supported operation.
8283 What operations can be used depends on the particular DOCUMENT and its
8284 handler application, but typically it is one of the following common
8287 \"open\" - open DOCUMENT, which could be a file, a directory, or an
8288 executable program. If it is an application, that
8289 application is launched in the current buffer's default
8290 directory. Otherwise, the application associated with
8291 DOCUMENT is launched in the buffer's default directory.
8292 \"print\" - print DOCUMENT, which must be a file
8293 \"explore\" - start the Windows Explorer on DOCUMENT
8294 \"edit\" - launch an editor and open DOCUMENT for editing; which
8295 editor is launched depends on the association for the
8297 \"find\" - initiate search starting from DOCUMENT which must specify
8299 nil - invoke the default OPERATION, or \"open\" if default is
8300 not defined or unavailable
8302 DOCUMENT is typically the name of a document file or a URL, but can
8303 also be a program executable to run, or a directory to open in the
8306 If DOCUMENT is a program executable, the optional third arg PARAMETERS
8307 can be a string containing command line parameters that will be passed
8308 to the program; otherwise, PARAMETERS should be nil or unspecified.
8310 Optional fourth argument SHOW-FLAG can be used to control how the
8311 application will be displayed when it is invoked. If SHOW-FLAG is nil
8312 or unspecified, the application is displayed normally, otherwise it is
8313 an integer representing a ShowWindow flag:
8318 6 - start minimized */)
8319 (operation
, document
, parameters
, show_flag
)
8320 Lisp_Object operation
, document
, parameters
, show_flag
;
8322 Lisp_Object current_dir
;
8324 CHECK_STRING (document
);
8326 /* Encode filename, current directory and parameters. */
8327 current_dir
= ENCODE_FILE (current_buffer
->directory
);
8328 document
= ENCODE_FILE (document
);
8329 if (STRINGP (parameters
))
8330 parameters
= ENCODE_SYSTEM (parameters
);
8332 if ((int) ShellExecute (NULL
,
8333 (STRINGP (operation
) ?
8334 SDATA (operation
) : NULL
),
8336 (STRINGP (parameters
) ?
8337 SDATA (parameters
) : NULL
),
8338 SDATA (current_dir
),
8339 (INTEGERP (show_flag
) ?
8340 XINT (show_flag
) : SW_SHOWDEFAULT
))
8343 error ("ShellExecute failed: %s", w32_strerror (0));
8346 /* Lookup virtual keycode from string representing the name of a
8347 non-ascii keystroke into the corresponding virtual key, using
8348 lispy_function_keys. */
8350 lookup_vk_code (char *key
)
8354 for (i
= 0; i
< 256; i
++)
8355 if (lispy_function_keys
[i
]
8356 && strcmp (lispy_function_keys
[i
], key
) == 0)
8362 /* Convert a one-element vector style key sequence to a hot key
8365 w32_parse_hot_key (key
)
8368 /* Copied from Fdefine_key and store_in_keymap. */
8369 register Lisp_Object c
;
8373 struct gcpro gcpro1
;
8377 if (XFASTINT (Flength (key
)) != 1)
8382 c
= Faref (key
, make_number (0));
8384 if (CONSP (c
) && lucid_event_type_list_p (c
))
8385 c
= Fevent_convert_list (c
);
8389 if (! INTEGERP (c
) && ! SYMBOLP (c
))
8390 error ("Key definition is invalid");
8392 /* Work out the base key and the modifiers. */
8395 c
= parse_modifiers (c
);
8396 lisp_modifiers
= XINT (Fcar (Fcdr (c
)));
8400 vk_code
= lookup_vk_code (SDATA (SYMBOL_NAME (c
)));
8402 else if (INTEGERP (c
))
8404 lisp_modifiers
= XINT (c
) & ~CHARACTERBITS
;
8405 /* Many ascii characters are their own virtual key code. */
8406 vk_code
= XINT (c
) & CHARACTERBITS
;
8409 if (vk_code
< 0 || vk_code
> 255)
8412 if ((lisp_modifiers
& meta_modifier
) != 0
8413 && !NILP (Vw32_alt_is_meta
))
8414 lisp_modifiers
|= alt_modifier
;
8416 /* Supply defs missing from mingw32. */
8418 #define MOD_ALT 0x0001
8419 #define MOD_CONTROL 0x0002
8420 #define MOD_SHIFT 0x0004
8421 #define MOD_WIN 0x0008
8424 /* Convert lisp modifiers to Windows hot-key form. */
8425 w32_modifiers
= (lisp_modifiers
& hyper_modifier
) ? MOD_WIN
: 0;
8426 w32_modifiers
|= (lisp_modifiers
& alt_modifier
) ? MOD_ALT
: 0;
8427 w32_modifiers
|= (lisp_modifiers
& ctrl_modifier
) ? MOD_CONTROL
: 0;
8428 w32_modifiers
|= (lisp_modifiers
& shift_modifier
) ? MOD_SHIFT
: 0;
8430 return HOTKEY (vk_code
, w32_modifiers
);
8433 DEFUN ("w32-register-hot-key", Fw32_register_hot_key
,
8434 Sw32_register_hot_key
, 1, 1, 0,
8435 doc
: /* Register KEY as a hot-key combination.
8436 Certain key combinations like Alt-Tab are reserved for system use on
8437 Windows, and therefore are normally intercepted by the system. However,
8438 most of these key combinations can be received by registering them as
8439 hot-keys, overriding their special meaning.
8441 KEY must be a one element key definition in vector form that would be
8442 acceptable to `define-key' (e.g. [A-tab] for Alt-Tab). The meta
8443 modifier is interpreted as Alt if `w32-alt-is-meta' is t, and hyper
8444 is always interpreted as the Windows modifier keys.
8446 The return value is the hotkey-id if registered, otherwise nil. */)
8450 key
= w32_parse_hot_key (key
);
8452 if (!NILP (key
) && NILP (Fmemq (key
, w32_grabbed_keys
)))
8454 /* Reuse an empty slot if possible. */
8455 Lisp_Object item
= Fmemq (Qnil
, w32_grabbed_keys
);
8457 /* Safe to add new key to list, even if we have focus. */
8459 w32_grabbed_keys
= Fcons (key
, w32_grabbed_keys
);
8461 XSETCAR (item
, key
);
8463 /* Notify input thread about new hot-key definition, so that it
8464 takes effect without needing to switch focus. */
8465 #ifdef USE_LISP_UNION_TYPE
8466 PostThreadMessage (dwWindowsThreadId
, WM_EMACS_REGISTER_HOT_KEY
,
8469 PostThreadMessage (dwWindowsThreadId
, WM_EMACS_REGISTER_HOT_KEY
,
8477 DEFUN ("w32-unregister-hot-key", Fw32_unregister_hot_key
,
8478 Sw32_unregister_hot_key
, 1, 1, 0,
8479 doc
: /* Unregister KEY as a hot-key combination. */)
8485 if (!INTEGERP (key
))
8486 key
= w32_parse_hot_key (key
);
8488 item
= Fmemq (key
, w32_grabbed_keys
);
8492 /* Notify input thread about hot-key definition being removed, so
8493 that it takes effect without needing focus switch. */
8494 #ifdef USE_LISP_UNION_TYPE
8495 if (PostThreadMessage (dwWindowsThreadId
, WM_EMACS_UNREGISTER_HOT_KEY
,
8496 (WPARAM
) XINT (XCAR (item
)), (LPARAM
) item
.i
))
8498 if (PostThreadMessage (dwWindowsThreadId
, WM_EMACS_UNREGISTER_HOT_KEY
,
8499 (WPARAM
) XINT (XCAR (item
)), (LPARAM
) item
))
8503 GetMessage (&msg
, NULL
, WM_EMACS_DONE
, WM_EMACS_DONE
);
8510 DEFUN ("w32-registered-hot-keys", Fw32_registered_hot_keys
,
8511 Sw32_registered_hot_keys
, 0, 0, 0,
8512 doc
: /* Return list of registered hot-key IDs. */)
8515 return Fdelq (Qnil
, Fcopy_sequence (w32_grabbed_keys
));
8518 DEFUN ("w32-reconstruct-hot-key", Fw32_reconstruct_hot_key
,
8519 Sw32_reconstruct_hot_key
, 1, 1, 0,
8520 doc
: /* Convert hot-key ID to a lisp key combination.
8521 usage: (w32-reconstruct-hot-key ID) */)
8523 Lisp_Object hotkeyid
;
8525 int vk_code
, w32_modifiers
;
8528 CHECK_NUMBER (hotkeyid
);
8530 vk_code
= HOTKEY_VK_CODE (hotkeyid
);
8531 w32_modifiers
= HOTKEY_MODIFIERS (hotkeyid
);
8533 if (vk_code
< 256 && lispy_function_keys
[vk_code
])
8534 key
= intern (lispy_function_keys
[vk_code
]);
8536 key
= make_number (vk_code
);
8538 key
= Fcons (key
, Qnil
);
8539 if (w32_modifiers
& MOD_SHIFT
)
8540 key
= Fcons (Qshift
, key
);
8541 if (w32_modifiers
& MOD_CONTROL
)
8542 key
= Fcons (Qctrl
, key
);
8543 if (w32_modifiers
& MOD_ALT
)
8544 key
= Fcons (NILP (Vw32_alt_is_meta
) ? Qalt
: Qmeta
, key
);
8545 if (w32_modifiers
& MOD_WIN
)
8546 key
= Fcons (Qhyper
, key
);
8551 DEFUN ("w32-toggle-lock-key", Fw32_toggle_lock_key
,
8552 Sw32_toggle_lock_key
, 1, 2, 0,
8553 doc
: /* Toggle the state of the lock key KEY.
8554 KEY can be `capslock', `kp-numlock', or `scroll'.
8555 If the optional parameter NEW-STATE is a number, then the state of KEY
8556 is set to off if the low bit of NEW-STATE is zero, otherwise on. */)
8558 Lisp_Object key
, new_state
;
8562 if (EQ (key
, intern ("capslock")))
8563 vk_code
= VK_CAPITAL
;
8564 else if (EQ (key
, intern ("kp-numlock")))
8565 vk_code
= VK_NUMLOCK
;
8566 else if (EQ (key
, intern ("scroll")))
8567 vk_code
= VK_SCROLL
;
8571 if (!dwWindowsThreadId
)
8572 return make_number (w32_console_toggle_lock_key (vk_code
, new_state
));
8574 #ifdef USE_LISP_UNION_TYPE
8575 if (PostThreadMessage (dwWindowsThreadId
, WM_EMACS_TOGGLE_LOCK_KEY
,
8576 (WPARAM
) vk_code
, (LPARAM
) new_state
.i
))
8578 if (PostThreadMessage (dwWindowsThreadId
, WM_EMACS_TOGGLE_LOCK_KEY
,
8579 (WPARAM
) vk_code
, (LPARAM
) new_state
))
8583 GetMessage (&msg
, NULL
, WM_EMACS_DONE
, WM_EMACS_DONE
);
8584 return make_number (msg
.wParam
);
8589 DEFUN ("w32-window-exists-p", Fw32_window_exists_p
, Sw32_window_exists_p
,
8591 doc
: /* Return non-nil if a window exists with the specified CLASS and NAME.
8593 This is a direct interface to the Windows API FindWindow function. */)
8595 Lisp_Object
class, name
;
8600 CHECK_STRING (class);
8602 CHECK_STRING (name
);
8604 hnd
= FindWindow (STRINGP (class) ? ((LPCTSTR
) SDATA (class)) : NULL
,
8605 STRINGP (name
) ? ((LPCTSTR
) SDATA (name
)) : NULL
);
8611 DEFUN ("w32-battery-status", Fw32_battery_status
, Sw32_battery_status
, 0, 0, 0,
8612 doc
: /* Get power status information from Windows system.
8614 The following %-sequences are provided:
8615 %L AC line status (verbose)
8616 %B Battery status (verbose)
8617 %b Battery status, empty means high, `-' means low,
8618 `!' means critical, and `+' means charging
8619 %p Battery load percentage
8620 %s Remaining time (to charge or discharge) in seconds
8621 %m Remaining time (to charge or discharge) in minutes
8622 %h Remaining time (to charge or discharge) in hours
8623 %t Remaining time (to charge or discharge) in the form `h:min' */)
8626 Lisp_Object status
= Qnil
;
8628 SYSTEM_POWER_STATUS system_status
;
8629 if (GetSystemPowerStatus (&system_status
))
8631 Lisp_Object line_status
, battery_status
, battery_status_symbol
;
8632 Lisp_Object load_percentage
, seconds
, minutes
, hours
, remain
;
8633 Lisp_Object sequences
[8];
8635 long seconds_left
= (long) system_status
.BatteryLifeTime
;
8637 if (system_status
.ACLineStatus
== 0)
8638 line_status
= build_string ("off-line");
8639 else if (system_status
.ACLineStatus
== 1)
8640 line_status
= build_string ("on-line");
8642 line_status
= build_string ("N/A");
8644 if (system_status
.BatteryFlag
& 128)
8646 battery_status
= build_string ("N/A");
8647 battery_status_symbol
= build_string ("");
8649 else if (system_status
.BatteryFlag
& 8)
8651 battery_status
= build_string ("charging");
8652 battery_status_symbol
= build_string ("+");
8653 if (system_status
.BatteryFullLifeTime
!= -1L)
8654 seconds_left
= system_status
.BatteryFullLifeTime
- seconds_left
;
8656 else if (system_status
.BatteryFlag
& 4)
8658 battery_status
= build_string ("critical");
8659 battery_status_symbol
= build_string ("!");
8661 else if (system_status
.BatteryFlag
& 2)
8663 battery_status
= build_string ("low");
8664 battery_status_symbol
= build_string ("-");
8666 else if (system_status
.BatteryFlag
& 1)
8668 battery_status
= build_string ("high");
8669 battery_status_symbol
= build_string ("");
8673 battery_status
= build_string ("medium");
8674 battery_status_symbol
= build_string ("");
8677 if (system_status
.BatteryLifePercent
> 100)
8678 load_percentage
= build_string ("N/A");
8682 _snprintf (buffer
, 16, "%d", system_status
.BatteryLifePercent
);
8683 load_percentage
= build_string (buffer
);
8686 if (seconds_left
< 0)
8687 seconds
= minutes
= hours
= remain
= build_string ("N/A");
8693 _snprintf (buffer
, 16, "%ld", seconds_left
);
8694 seconds
= build_string (buffer
);
8696 m
= seconds_left
/ 60;
8697 _snprintf (buffer
, 16, "%ld", m
);
8698 minutes
= build_string (buffer
);
8700 h
= seconds_left
/ 3600.0;
8701 _snprintf (buffer
, 16, "%3.1f", h
);
8702 hours
= build_string (buffer
);
8704 _snprintf (buffer
, 16, "%ld:%02ld", m
/ 60, m
% 60);
8705 remain
= build_string (buffer
);
8707 sequences
[0] = Fcons (make_number ('L'), line_status
);
8708 sequences
[1] = Fcons (make_number ('B'), battery_status
);
8709 sequences
[2] = Fcons (make_number ('b'), battery_status_symbol
);
8710 sequences
[3] = Fcons (make_number ('p'), load_percentage
);
8711 sequences
[4] = Fcons (make_number ('s'), seconds
);
8712 sequences
[5] = Fcons (make_number ('m'), minutes
);
8713 sequences
[6] = Fcons (make_number ('h'), hours
);
8714 sequences
[7] = Fcons (make_number ('t'), remain
);
8716 status
= Flist (8, sequences
);
8722 DEFUN ("file-system-info", Ffile_system_info
, Sfile_system_info
, 1, 1, 0,
8723 doc
: /* Return storage information about the file system FILENAME is on.
8724 Value is a list of floats (TOTAL FREE AVAIL), where TOTAL is the total
8725 storage of the file system, FREE is the free storage, and AVAIL is the
8726 storage available to a non-superuser. All 3 numbers are in bytes.
8727 If the underlying system call fails, value is nil. */)
8729 Lisp_Object filename
;
8731 Lisp_Object encoded
, value
;
8733 CHECK_STRING (filename
);
8734 filename
= Fexpand_file_name (filename
, Qnil
);
8735 encoded
= ENCODE_FILE (filename
);
8739 /* Determining the required information on Windows turns out, sadly,
8740 to be more involved than one would hope. The original Win32 api
8741 call for this will return bogus information on some systems, but we
8742 must dynamically probe for the replacement api, since that was
8743 added rather late on. */
8745 HMODULE hKernel
= GetModuleHandle ("kernel32");
8746 BOOL (*pfn_GetDiskFreeSpaceEx
)
8747 (char *, PULARGE_INTEGER
, PULARGE_INTEGER
, PULARGE_INTEGER
)
8748 = (void *) GetProcAddress (hKernel
, "GetDiskFreeSpaceEx");
8750 /* On Windows, we may need to specify the root directory of the
8751 volume holding FILENAME. */
8752 char rootname
[MAX_PATH
];
8753 char *name
= SDATA (encoded
);
8755 /* find the root name of the volume if given */
8756 if (isalpha (name
[0]) && name
[1] == ':')
8758 rootname
[0] = name
[0];
8759 rootname
[1] = name
[1];
8763 else if (IS_DIRECTORY_SEP (name
[0]) && IS_DIRECTORY_SEP (name
[1]))
8765 char *str
= rootname
;
8769 if (IS_DIRECTORY_SEP (*name
) && --slashes
== 0)
8779 if (pfn_GetDiskFreeSpaceEx
)
8781 /* Unsigned large integers cannot be cast to double, so
8782 use signed ones instead. */
8783 LARGE_INTEGER availbytes
;
8784 LARGE_INTEGER freebytes
;
8785 LARGE_INTEGER totalbytes
;
8787 if (pfn_GetDiskFreeSpaceEx (rootname
,
8788 (ULARGE_INTEGER
*)&availbytes
,
8789 (ULARGE_INTEGER
*)&totalbytes
,
8790 (ULARGE_INTEGER
*)&freebytes
))
8791 value
= list3 (make_float ((double) totalbytes
.QuadPart
),
8792 make_float ((double) freebytes
.QuadPart
),
8793 make_float ((double) availbytes
.QuadPart
));
8797 DWORD sectors_per_cluster
;
8798 DWORD bytes_per_sector
;
8799 DWORD free_clusters
;
8800 DWORD total_clusters
;
8802 if (GetDiskFreeSpace (rootname
,
8803 §ors_per_cluster
,
8807 value
= list3 (make_float ((double) total_clusters
8808 * sectors_per_cluster
* bytes_per_sector
),
8809 make_float ((double) free_clusters
8810 * sectors_per_cluster
* bytes_per_sector
),
8811 make_float ((double) free_clusters
8812 * sectors_per_cluster
* bytes_per_sector
));
8819 DEFUN ("default-printer-name", Fdefault_printer_name
, Sdefault_printer_name
,
8820 0, 0, 0, doc
: /* Return the name of Windows default printer device. */)
8823 static char pname_buf
[256];
8826 PRINTER_INFO_2
*ppi2
= NULL
;
8827 DWORD dwNeeded
= 0, dwReturned
= 0;
8829 /* Retrieve the default string from Win.ini (the registry).
8830 * String will be in form "printername,drivername,portname".
8831 * This is the most portable way to get the default printer. */
8832 if (GetProfileString ("windows", "device", ",,", pname_buf
, sizeof (pname_buf
)) <= 0)
8834 /* printername precedes first "," character */
8835 strtok (pname_buf
, ",");
8836 /* We want to know more than the printer name */
8837 if (!OpenPrinter (pname_buf
, &hPrn
, NULL
))
8839 GetPrinter (hPrn
, 2, NULL
, 0, &dwNeeded
);
8842 ClosePrinter (hPrn
);
8845 /* Allocate memory for the PRINTER_INFO_2 struct */
8846 ppi2
= (PRINTER_INFO_2
*) xmalloc (dwNeeded
);
8849 ClosePrinter (hPrn
);
8852 /* Call GetPrinter again with big enouth memory block */
8853 err
= GetPrinter (hPrn
, 2, (LPBYTE
)ppi2
, dwNeeded
, &dwReturned
);
8854 ClosePrinter (hPrn
);
8863 if (ppi2
->Attributes
& PRINTER_ATTRIBUTE_SHARED
&& ppi2
->pServerName
)
8865 /* a remote printer */
8866 if (*ppi2
->pServerName
== '\\')
8867 _snprintf (pname_buf
, sizeof (pname_buf
), "%s\\%s", ppi2
->pServerName
,
8870 _snprintf (pname_buf
, sizeof (pname_buf
), "\\\\%s\\%s", ppi2
->pServerName
,
8872 pname_buf
[sizeof (pname_buf
) - 1] = '\0';
8876 /* a local printer */
8877 strncpy (pname_buf
, ppi2
->pPortName
, sizeof (pname_buf
));
8878 pname_buf
[sizeof (pname_buf
) - 1] = '\0';
8879 /* `pPortName' can include several ports, delimited by ','.
8880 * we only use the first one. */
8881 strtok (pname_buf
, ",");
8886 return build_string (pname_buf
);
8889 /***********************************************************************
8891 ***********************************************************************/
8893 /* Keep this list in the same order as frame_parms in frame.c.
8894 Use 0 for unsupported frame parameters. */
8896 frame_parm_handler w32_frame_parm_handlers
[] =
8900 x_set_background_color
,
8906 x_set_foreground_color
,
8909 x_set_internal_border_width
,
8910 x_set_menu_bar_lines
,
8912 x_explicitly_set_name
,
8913 x_set_scroll_bar_width
,
8916 x_set_vertical_scroll_bars
,
8918 x_set_tool_bar_lines
,
8919 0, /* x_set_scroll_bar_foreground, */
8920 0, /* x_set_scroll_bar_background, */
8925 0, /* x_set_wait_for_wm, */
8933 globals_of_w32fns ();
8934 /* This is zero if not using MS-Windows. */
8936 track_mouse_window
= NULL
;
8938 w32_visible_system_caret_hwnd
= NULL
;
8940 DEFSYM (Qnone
, "none");
8941 DEFSYM (Qsuppress_icon
, "suppress-icon");
8942 DEFSYM (Qundefined_color
, "undefined-color");
8943 DEFSYM (Qcancel_timer
, "cancel-timer");
8944 DEFSYM (Qhyper
, "hyper");
8945 DEFSYM (Qsuper
, "super");
8946 DEFSYM (Qmeta
, "meta");
8947 DEFSYM (Qalt
, "alt");
8948 DEFSYM (Qctrl
, "ctrl");
8949 DEFSYM (Qcontrol
, "control");
8950 DEFSYM (Qshift
, "shift");
8951 /* This is the end of symbol initialization. */
8953 /* Text property `display' should be nonsticky by default. */
8954 Vtext_property_default_nonsticky
8955 = Fcons (Fcons (Qdisplay
, Qt
), Vtext_property_default_nonsticky
);
8958 Fput (Qundefined_color
, Qerror_conditions
,
8959 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
8960 Fput (Qundefined_color
, Qerror_message
,
8961 build_string ("Undefined color"));
8963 staticpro (&w32_grabbed_keys
);
8964 w32_grabbed_keys
= Qnil
;
8966 DEFVAR_LISP ("w32-color-map", &Vw32_color_map
,
8967 doc
: /* An array of color name mappings for Windows. */);
8968 Vw32_color_map
= Qnil
;
8970 DEFVAR_LISP ("w32-pass-alt-to-system", &Vw32_pass_alt_to_system
,
8971 doc
: /* Non-nil if Alt key presses are passed on to Windows.
8972 When non-nil, for example, Alt pressed and released and then space will
8973 open the System menu. When nil, Emacs processes the Alt key events, and
8974 then silently swallows them. */);
8975 Vw32_pass_alt_to_system
= Qnil
;
8977 DEFVAR_LISP ("w32-alt-is-meta", &Vw32_alt_is_meta
,
8978 doc
: /* Non-nil if the Alt key is to be considered the same as the META key.
8979 When nil, Emacs will translate the Alt key to the ALT modifier, not to META. */);
8980 Vw32_alt_is_meta
= Qt
;
8982 DEFVAR_INT ("w32-quit-key", &w32_quit_key
,
8983 doc
: /* If non-zero, the virtual key code for an alternative quit key. */);
8986 DEFVAR_LISP ("w32-pass-lwindow-to-system",
8987 &Vw32_pass_lwindow_to_system
,
8988 doc
: /* If non-nil, the left \"Windows\" key is passed on to Windows.
8990 When non-nil, the Start menu is opened by tapping the key.
8991 If you set this to nil, the left \"Windows\" key is processed by Emacs
8992 according to the value of `w32-lwindow-modifier', which see.
8994 Note that some combinations of the left \"Windows\" key with other keys are
8995 caught by Windows at low level, and so binding them in Emacs will have no
8996 effect. For example, <lwindow>-r always pops up the Windows Run dialog,
8997 <lwindow>-<Pause> pops up the "System Properties" dialog, etc. However, see
8998 the doc string of `w32-phantom-key-code'. */);
8999 Vw32_pass_lwindow_to_system
= Qt
;
9001 DEFVAR_LISP ("w32-pass-rwindow-to-system",
9002 &Vw32_pass_rwindow_to_system
,
9003 doc
: /* If non-nil, the right \"Windows\" key is passed on to Windows.
9005 When non-nil, the Start menu is opened by tapping the key.
9006 If you set this to nil, the right \"Windows\" key is processed by Emacs
9007 according to the value of `w32-rwindow-modifier', which see.
9009 Note that some combinations of the right \"Windows\" key with other keys are
9010 caught by Windows at low level, and so binding them in Emacs will have no
9011 effect. For example, <rwindow>-r always pops up the Windows Run dialog,
9012 <rwindow>-<Pause> pops up the "System Properties" dialog, etc. However, see
9013 the doc string of `w32-phantom-key-code'. */);
9014 Vw32_pass_rwindow_to_system
= Qt
;
9016 DEFVAR_LISP ("w32-phantom-key-code",
9017 &Vw32_phantom_key_code
,
9018 doc
: /* Virtual key code used to generate \"phantom\" key presses.
9019 Value is a number between 0 and 255.
9021 Phantom key presses are generated in order to stop the system from
9022 acting on \"Windows\" key events when `w32-pass-lwindow-to-system' or
9023 `w32-pass-rwindow-to-system' is nil. */);
9024 /* Although 255 is technically not a valid key code, it works and
9025 means that this hack won't interfere with any real key code. */
9026 XSETINT (Vw32_phantom_key_code
, 255);
9028 DEFVAR_LISP ("w32-enable-num-lock",
9029 &Vw32_enable_num_lock
,
9030 doc
: /* If non-nil, the Num Lock key acts normally.
9031 Set to nil to handle Num Lock as the `kp-numlock' key. */);
9032 Vw32_enable_num_lock
= Qt
;
9034 DEFVAR_LISP ("w32-enable-caps-lock",
9035 &Vw32_enable_caps_lock
,
9036 doc
: /* If non-nil, the Caps Lock key acts normally.
9037 Set to nil to handle Caps Lock as the `capslock' key. */);
9038 Vw32_enable_caps_lock
= Qt
;
9040 DEFVAR_LISP ("w32-scroll-lock-modifier",
9041 &Vw32_scroll_lock_modifier
,
9042 doc
: /* Modifier to use for the Scroll Lock ON state.
9043 The value can be hyper, super, meta, alt, control or shift for the
9044 respective modifier, or nil to handle Scroll Lock as the `scroll' key.
9045 Any other value will cause the Scroll Lock key to be ignored. */);
9046 Vw32_scroll_lock_modifier
= Qt
;
9048 DEFVAR_LISP ("w32-lwindow-modifier",
9049 &Vw32_lwindow_modifier
,
9050 doc
: /* Modifier to use for the left \"Windows\" key.
9051 The value can be hyper, super, meta, alt, control or shift for the
9052 respective modifier, or nil to appear as the `lwindow' key.
9053 Any other value will cause the key to be ignored. */);
9054 Vw32_lwindow_modifier
= Qnil
;
9056 DEFVAR_LISP ("w32-rwindow-modifier",
9057 &Vw32_rwindow_modifier
,
9058 doc
: /* Modifier to use for the right \"Windows\" key.
9059 The value can be hyper, super, meta, alt, control or shift for the
9060 respective modifier, or nil to appear as the `rwindow' key.
9061 Any other value will cause the key to be ignored. */);
9062 Vw32_rwindow_modifier
= Qnil
;
9064 DEFVAR_LISP ("w32-apps-modifier",
9065 &Vw32_apps_modifier
,
9066 doc
: /* Modifier to use for the \"Apps\" key.
9067 The value can be hyper, super, meta, alt, control or shift for the
9068 respective modifier, or nil to appear as the `apps' key.
9069 Any other value will cause the key to be ignored. */);
9070 Vw32_apps_modifier
= Qnil
;
9072 DEFVAR_BOOL ("w32-enable-synthesized-fonts", &w32_enable_synthesized_fonts
,
9073 doc
: /* Non-nil enables selection of artificially italicized and bold fonts. */);
9074 w32_enable_synthesized_fonts
= 0;
9076 DEFVAR_LISP ("w32-enable-palette", &Vw32_enable_palette
,
9077 doc
: /* Non-nil enables Windows palette management to map colors exactly. */);
9078 Vw32_enable_palette
= Qt
;
9080 DEFVAR_INT ("w32-mouse-button-tolerance",
9081 &w32_mouse_button_tolerance
,
9082 doc
: /* Analogue of double click interval for faking middle mouse events.
9083 The value is the minimum time in milliseconds that must elapse between
9084 left and right button down events before they are considered distinct events.
9085 If both mouse buttons are depressed within this interval, a middle mouse
9086 button down event is generated instead. */);
9087 w32_mouse_button_tolerance
= GetDoubleClickTime () / 2;
9089 DEFVAR_INT ("w32-mouse-move-interval",
9090 &w32_mouse_move_interval
,
9091 doc
: /* Minimum interval between mouse move events.
9092 The value is the minimum time in milliseconds that must elapse between
9093 successive mouse move (or scroll bar drag) events before they are
9094 reported as lisp events. */);
9095 w32_mouse_move_interval
= 0;
9097 DEFVAR_BOOL ("w32-pass-extra-mouse-buttons-to-system",
9098 &w32_pass_extra_mouse_buttons_to_system
,
9099 doc
: /* If non-nil, the fourth and fifth mouse buttons are passed to Windows.
9100 Recent versions of Windows support mice with up to five buttons.
9101 Since most applications don't support these extra buttons, most mouse
9102 drivers will allow you to map them to functions at the system level.
9103 If this variable is non-nil, Emacs will pass them on, allowing the
9104 system to handle them. */);
9105 w32_pass_extra_mouse_buttons_to_system
= 0;
9107 DEFVAR_BOOL ("w32-pass-multimedia-buttons-to-system",
9108 &w32_pass_multimedia_buttons_to_system
,
9109 doc
: /* If non-nil, media buttons are passed to Windows.
9110 Some modern keyboards contain buttons for controlling media players, web
9111 browsers and other applications. Generally these buttons are handled on a
9112 system wide basis, but by setting this to nil they are made available
9113 to Emacs for binding. Depending on your keyboard, additional keys that
9114 may be available are:
9116 browser-back, browser-forward, browser-refresh, browser-stop,
9117 browser-search, browser-favorites, browser-home,
9118 mail, mail-reply, mail-forward, mail-send,
9120 help, find, new, open, close, save, print, undo, redo, copy, cut, paste,
9121 spell-check, correction-list, toggle-dictate-command,
9122 media-next, media-previous, media-stop, media-play-pause, media-select,
9123 media-play, media-pause, media-record, media-fast-forward, media-rewind,
9124 media-channel-up, media-channel-down,
9125 volume-mute, volume-up, volume-down,
9126 mic-volume-mute, mic-volume-down, mic-volume-up, mic-toggle,
9127 bass-down, bass-boost, bass-up, treble-down, treble-up */);
9128 w32_pass_multimedia_buttons_to_system
= 1;
9130 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
9131 doc
: /* The shape of the pointer when over text.
9132 Changing the value does not affect existing frames
9133 unless you set the mouse color. */);
9134 Vx_pointer_shape
= Qnil
;
9136 Vx_nontext_pointer_shape
= Qnil
;
9138 Vx_mode_pointer_shape
= Qnil
;
9140 DEFVAR_LISP ("x-hourglass-pointer-shape", &Vx_hourglass_pointer_shape
,
9141 doc
: /* The shape of the pointer when Emacs is busy.
9142 This variable takes effect when you create a new frame
9143 or when you set the mouse color. */);
9144 Vx_hourglass_pointer_shape
= Qnil
;
9146 DEFVAR_BOOL ("display-hourglass", &display_hourglass_p
,
9147 doc
: /* Non-zero means Emacs displays an hourglass pointer on window systems. */);
9148 display_hourglass_p
= 1;
9150 DEFVAR_LISP ("hourglass-delay", &Vhourglass_delay
,
9151 doc
: /* *Seconds to wait before displaying an hourglass pointer.
9152 Value must be an integer or float. */);
9153 Vhourglass_delay
= make_number (DEFAULT_HOURGLASS_DELAY
);
9155 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
9156 &Vx_sensitive_text_pointer_shape
,
9157 doc
: /* The shape of the pointer when over mouse-sensitive text.
9158 This variable takes effect when you create a new frame
9159 or when you set the mouse color. */);
9160 Vx_sensitive_text_pointer_shape
= Qnil
;
9162 DEFVAR_LISP ("x-window-horizontal-drag-cursor",
9163 &Vx_window_horizontal_drag_shape
,
9164 doc
: /* Pointer shape to use for indicating a window can be dragged horizontally.
9165 This variable takes effect when you create a new frame
9166 or when you set the mouse color. */);
9167 Vx_window_horizontal_drag_shape
= Qnil
;
9169 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
9170 doc
: /* A string indicating the foreground color of the cursor box. */);
9171 Vx_cursor_fore_pixel
= Qnil
;
9173 DEFVAR_LISP ("x-max-tooltip-size", &Vx_max_tooltip_size
,
9174 doc
: /* Maximum size for tooltips.
9175 Value is a pair (COLUMNS . ROWS). Text larger than this is clipped. */);
9176 Vx_max_tooltip_size
= Fcons (make_number (80), make_number (40));
9178 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
9179 doc
: /* Non-nil if no window manager is in use.
9180 Emacs doesn't try to figure this out; this is always nil
9181 unless you set it to something else. */);
9182 /* We don't have any way to find this out, so set it to nil
9183 and maybe the user would like to set it to t. */
9184 Vx_no_window_manager
= Qnil
;
9186 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
9187 &Vx_pixel_size_width_font_regexp
,
9188 doc
: /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'.
9190 Since Emacs gets width of a font matching with this regexp from
9191 PIXEL_SIZE field of the name, font finding mechanism gets faster for
9192 such a font. This is especially effective for such large fonts as
9193 Chinese, Japanese, and Korean. */);
9194 Vx_pixel_size_width_font_regexp
= Qnil
;
9196 DEFVAR_LISP ("w32-bdf-filename-alist",
9197 &Vw32_bdf_filename_alist
,
9198 doc
: /* List of bdf fonts and their corresponding filenames. */);
9199 Vw32_bdf_filename_alist
= Qnil
;
9201 DEFVAR_BOOL ("w32-strict-fontnames",
9202 &w32_strict_fontnames
,
9203 doc
: /* Non-nil means only use fonts that are exact matches for those requested.
9204 Default is nil, which allows old fontnames that are not XLFD compliant,
9205 and allows third-party CJK display to work by specifying false charset
9206 fields to trick Emacs into translating to Big5, SJIS etc.
9207 Setting this to t will prevent wrong fonts being selected when
9208 fontsets are automatically created. */);
9209 w32_strict_fontnames
= 0;
9211 DEFVAR_BOOL ("w32-strict-painting",
9212 &w32_strict_painting
,
9213 doc
: /* Non-nil means use strict rules for repainting frames.
9214 Set this to nil to get the old behavior for repainting; this should
9215 only be necessary if the default setting causes problems. */);
9216 w32_strict_painting
= 1;
9218 DEFVAR_LISP ("w32-charset-info-alist",
9219 &Vw32_charset_info_alist
,
9220 doc
: /* Alist linking Emacs character sets to Windows fonts and codepages.
9221 Each entry should be of the form:
9223 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE))
9225 where CHARSET_NAME is a string used in font names to identify the charset,
9226 WINDOWS_CHARSET is a symbol that can be one of:
9227 w32-charset-ansi, w32-charset-default, w32-charset-symbol,
9228 w32-charset-shiftjis, w32-charset-hangeul, w32-charset-gb2312,
9229 w32-charset-chinesebig5,
9230 w32-charset-johab, w32-charset-hebrew,
9231 w32-charset-arabic, w32-charset-greek, w32-charset-turkish,
9232 w32-charset-vietnamese, w32-charset-thai, w32-charset-easteurope,
9233 w32-charset-russian, w32-charset-mac, w32-charset-baltic,
9234 w32-charset-unicode,
9236 CODEPAGE should be an integer specifying the codepage that should be used
9237 to display the character set, t to do no translation and output as Unicode,
9238 or nil to do no translation and output as 8 bit (or multibyte on far-east
9239 versions of Windows) characters. */);
9240 Vw32_charset_info_alist
= Qnil
;
9242 DEFSYM (Qw32_charset_ansi
, "w32-charset-ansi");
9243 DEFSYM (Qw32_charset_symbol
, "w32-charset-symbol");
9244 DEFSYM (Qw32_charset_default
, "w32-charset-default");
9245 DEFSYM (Qw32_charset_shiftjis
, "w32-charset-shiftjis");
9246 DEFSYM (Qw32_charset_hangeul
, "w32-charset-hangeul");
9247 DEFSYM (Qw32_charset_chinesebig5
, "w32-charset-chinesebig5");
9248 DEFSYM (Qw32_charset_gb2312
, "w32-charset-gb2312");
9249 DEFSYM (Qw32_charset_oem
, "w32-charset-oem");
9251 #ifdef JOHAB_CHARSET
9253 static int w32_extra_charsets_defined
= 1;
9254 DEFVAR_BOOL ("w32-extra-charsets-defined", &w32_extra_charsets_defined
,
9255 doc
: /* Internal variable. */);
9257 DEFSYM (Qw32_charset_johab
, "w32-charset-johab");
9258 DEFSYM (Qw32_charset_easteurope
, "w32-charset-easteurope");
9259 DEFSYM (Qw32_charset_turkish
, "w32-charset-turkish");
9260 DEFSYM (Qw32_charset_baltic
, "w32-charset-baltic");
9261 DEFSYM (Qw32_charset_russian
, "w32-charset-russian");
9262 DEFSYM (Qw32_charset_arabic
, "w32-charset-arabic");
9263 DEFSYM (Qw32_charset_greek
, "w32-charset-greek");
9264 DEFSYM (Qw32_charset_hebrew
, "w32-charset-hebrew");
9265 DEFSYM (Qw32_charset_vietnamese
, "w32-charset-vietnamese");
9266 DEFSYM (Qw32_charset_thai
, "w32-charset-thai");
9267 DEFSYM (Qw32_charset_mac
, "w32-charset-mac");
9271 #ifdef UNICODE_CHARSET
9273 static int w32_unicode_charset_defined
= 1;
9274 DEFVAR_BOOL ("w32-unicode-charset-defined",
9275 &w32_unicode_charset_defined
,
9276 doc
: /* Internal variable. */);
9277 DEFSYM (Qw32_charset_unicode
, "w32-charset-unicode");
9281 #if 0 /* TODO: Port to W32 */
9282 defsubr (&Sx_change_window_property
);
9283 defsubr (&Sx_delete_window_property
);
9284 defsubr (&Sx_window_property
);
9286 defsubr (&Sxw_display_color_p
);
9287 defsubr (&Sx_display_grayscale_p
);
9288 defsubr (&Sxw_color_defined_p
);
9289 defsubr (&Sxw_color_values
);
9290 defsubr (&Sx_server_max_request_size
);
9291 defsubr (&Sx_server_vendor
);
9292 defsubr (&Sx_server_version
);
9293 defsubr (&Sx_display_pixel_width
);
9294 defsubr (&Sx_display_pixel_height
);
9295 defsubr (&Sx_display_mm_width
);
9296 defsubr (&Sx_display_mm_height
);
9297 defsubr (&Sx_display_screens
);
9298 defsubr (&Sx_display_planes
);
9299 defsubr (&Sx_display_color_cells
);
9300 defsubr (&Sx_display_visual_class
);
9301 defsubr (&Sx_display_backing_store
);
9302 defsubr (&Sx_display_save_under
);
9303 defsubr (&Sx_create_frame
);
9304 defsubr (&Sx_open_connection
);
9305 defsubr (&Sx_close_connection
);
9306 defsubr (&Sx_display_list
);
9307 defsubr (&Sx_synchronize
);
9308 defsubr (&Sx_focus_frame
);
9310 /* W32 specific functions */
9312 defsubr (&Sw32_select_font
);
9313 defsubr (&Sw32_define_rgb_color
);
9314 defsubr (&Sw32_default_color_map
);
9315 defsubr (&Sw32_load_color_file
);
9316 defsubr (&Sw32_send_sys_command
);
9317 defsubr (&Sw32_shell_execute
);
9318 defsubr (&Sw32_register_hot_key
);
9319 defsubr (&Sw32_unregister_hot_key
);
9320 defsubr (&Sw32_registered_hot_keys
);
9321 defsubr (&Sw32_reconstruct_hot_key
);
9322 defsubr (&Sw32_toggle_lock_key
);
9323 defsubr (&Sw32_window_exists_p
);
9325 defsubr (&Sw32_find_bdf_fonts
);
9327 defsubr (&Sw32_battery_status
);
9329 defsubr (&Sfile_system_info
);
9330 defsubr (&Sdefault_printer_name
);
9333 /* Setting callback functions for fontset handler. */
9334 get_font_info_func
= w32_get_font_info
;
9336 #if 0 /* This function pointer doesn't seem to be used anywhere.
9337 And the pointer assigned has the wrong type, anyway. */
9338 list_fonts_func
= w32_list_fonts
;
9341 load_font_func
= w32_load_font
;
9342 find_ccl_program_func
= w32_find_ccl_program
;
9343 query_font_func
= w32_query_font
;
9344 set_frame_fontset_func
= x_set_font
;
9345 get_font_repertory_func
= x_get_font_repertory
;
9347 check_window_system_func
= check_w32
;
9350 hourglass_timer
= 0;
9351 hourglass_hwnd
= NULL
;
9352 hourglass_shown_p
= 0;
9353 defsubr (&Sx_show_tip
);
9354 defsubr (&Sx_hide_tip
);
9356 staticpro (&tip_timer
);
9358 staticpro (&tip_frame
);
9360 last_show_tip_args
= Qnil
;
9361 staticpro (&last_show_tip_args
);
9363 defsubr (&Sx_file_dialog
);
9368 globals_of_w32fns is used to initialize those global variables that
9369 must always be initialized on startup even when the global variable
9370 initialized is non zero (see the function main in emacs.c).
9371 globals_of_w32fns is called from syms_of_w32fns when the global
9372 variable initialized is 0 and directly from main when initialized
9376 globals_of_w32fns ()
9378 HMODULE user32_lib
= GetModuleHandle ("user32.dll");
9380 TrackMouseEvent not available in all versions of Windows, so must load
9381 it dynamically. Do it once, here, instead of every time it is used.
9383 track_mouse_event_fn
= (TrackMouseEvent_Proc
)
9384 GetProcAddress (user32_lib
, "TrackMouseEvent");
9385 /* ditto for GetClipboardSequenceNumber. */
9386 clipboard_sequence_fn
= (ClipboardSequence_Proc
)
9387 GetProcAddress (user32_lib
, "GetClipboardSequenceNumber");
9389 monitor_from_point_fn
= (MonitorFromPoint_Proc
)
9390 GetProcAddress (user32_lib
, "MonitorFromPoint");
9391 get_monitor_info_fn
= (GetMonitorInfo_Proc
)
9392 GetProcAddress (user32_lib
, "GetMonitorInfoA");
9395 HMODULE imm32_lib
= GetModuleHandle ("imm32.dll");
9396 get_composition_string_fn
= (ImmGetCompositionString_Proc
)
9397 GetProcAddress (imm32_lib
, "ImmGetCompositionStringW");
9398 get_ime_context_fn
= (ImmGetContext_Proc
)
9399 GetProcAddress (imm32_lib
, "ImmGetContext");
9401 DEFVAR_INT ("w32-ansi-code-page",
9402 &w32_ansi_code_page
,
9403 doc
: /* The ANSI code page used by the system. */);
9404 w32_ansi_code_page
= GetACP ();
9406 /* MessageBox does not work without this when linked to comctl32.dll 6.0. */
9407 InitCommonControls ();
9409 syms_of_w32uniscribe ();
9418 button
= MessageBox (NULL
,
9419 "A fatal error has occurred!\n\n"
9420 "Would you like to attach a debugger?\n\n"
9421 "Select YES to debug, NO to abort Emacs"
9423 "\n\n(type \"gdb -p <emacs-PID>\" and\n"
9424 "\"continue\" inside GDB before clicking YES.)"
9426 , "Emacs Abort Dialog",
9427 MB_ICONEXCLAMATION
| MB_TASKMODAL
9428 | MB_SETFOREGROUND
| MB_YESNO
);
9433 exit (2); /* tell the compiler we will never return */
9441 /* For convenience when debugging. */
9445 return GetLastError ();
9448 /* arch-tag: 707589ab-b9be-4638-8cdd-74629cc9b446
9449 (do not change this comment) */