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 of the License, or
11 (at your option) any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
21 /* Added by Kevin Gallo */
36 #include "intervals.h"
37 #include "dispextern.h"
39 #include "blockinput.h"
41 #include "character.h"
47 #include "termhooks.h"
50 #include "bitmaps/gray.xbm"
61 #define FILE_NAME_TEXT_FIELD edt1
66 void syms_of_w32fns ();
67 void globals_of_w32fns ();
69 extern void free_frame_menubar ();
70 extern double atof ();
71 extern int w32_console_toggle_lock_key
P_ ((int, Lisp_Object
));
72 extern void w32_menu_display_help
P_ ((HWND
, HMENU
, UINT
, UINT
));
73 extern void w32_free_menu_strings
P_ ((HWND
));
75 extern XCharStruct
*w32_per_char_metric
P_ ((XFontStruct
*, wchar_t *, int));
80 extern char *lispy_function_keys
[];
82 /* The colormap for converting color names to RGB values */
83 Lisp_Object Vw32_color_map
;
85 /* Non nil if alt key presses are passed on to Windows. */
86 Lisp_Object Vw32_pass_alt_to_system
;
88 /* Non nil if alt key is translated to meta_modifier, nil if it is translated
90 Lisp_Object Vw32_alt_is_meta
;
92 /* If non-zero, the windows virtual key code for an alternative quit key. */
95 /* Non nil if left window key events are passed on to Windows (this only
96 affects whether "tapping" the key opens the Start menu). */
97 Lisp_Object Vw32_pass_lwindow_to_system
;
99 /* Non nil if right window key events are passed on to Windows (this
100 only affects whether "tapping" the key opens the Start menu). */
101 Lisp_Object Vw32_pass_rwindow_to_system
;
103 /* Virtual key code used to generate "phantom" key presses in order
104 to stop system from acting on Windows key events. */
105 Lisp_Object Vw32_phantom_key_code
;
107 /* Modifier associated with the left "Windows" key, or nil to act as a
109 Lisp_Object Vw32_lwindow_modifier
;
111 /* Modifier associated with the right "Windows" key, or nil to act as a
113 Lisp_Object Vw32_rwindow_modifier
;
115 /* Modifier associated with the "Apps" key, or nil to act as a normal
117 Lisp_Object Vw32_apps_modifier
;
119 /* Value is nil if Num Lock acts as a function key. */
120 Lisp_Object Vw32_enable_num_lock
;
122 /* Value is nil if Caps Lock acts as a function key. */
123 Lisp_Object Vw32_enable_caps_lock
;
125 /* Modifier associated with Scroll Lock, or nil to act as a normal key. */
126 Lisp_Object Vw32_scroll_lock_modifier
;
128 /* Switch to control whether we inhibit requests for synthesized bold
129 and italic versions of fonts. */
130 int w32_enable_synthesized_fonts
;
132 /* Enable palette management. */
133 Lisp_Object Vw32_enable_palette
;
135 /* Control how close left/right button down events must be to
136 be converted to a middle button down event. */
137 int w32_mouse_button_tolerance
;
139 /* Minimum interval between mouse movement (and scroll bar drag)
140 events that are passed on to the event loop. */
141 int w32_mouse_move_interval
;
143 /* Flag to indicate if XBUTTON events should be passed on to Windows. */
144 static int w32_pass_extra_mouse_buttons_to_system
;
146 /* Flag to indicate if media keys should be passed on to Windows. */
147 static int w32_pass_multimedia_buttons_to_system
;
149 /* Non nil if no window manager is in use. */
150 Lisp_Object Vx_no_window_manager
;
152 /* Non-zero means we're allowed to display a hourglass pointer. */
154 int display_hourglass_p
;
156 /* If non-zero, a w32 timer that, when it expires, displays an
157 hourglass cursor on all frames. */
158 static unsigned hourglass_timer
= 0;
159 static HWND hourglass_hwnd
= NULL
;
161 /* The background and shape of the mouse pointer, and shape when not
162 over text or in the modeline. */
164 Lisp_Object Vx_pointer_shape
, Vx_nontext_pointer_shape
, Vx_mode_pointer_shape
;
165 Lisp_Object Vx_hourglass_pointer_shape
, Vx_window_horizontal_drag_shape
;
167 /* The shape when over mouse-sensitive text. */
169 Lisp_Object Vx_sensitive_text_pointer_shape
;
172 #define IDC_HAND MAKEINTRESOURCE(32649)
175 /* Color of chars displayed in cursor box. */
177 Lisp_Object Vx_cursor_fore_pixel
;
179 /* Nonzero if using Windows. */
181 static int w32_in_use
;
183 /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
185 Lisp_Object Vx_pixel_size_width_font_regexp
;
187 /* Alist of bdf fonts and the files that define them. */
188 Lisp_Object Vw32_bdf_filename_alist
;
190 /* A flag to control whether fonts are matched strictly or not. */
191 static int w32_strict_fontnames
;
193 /* A flag to control whether we should only repaint if GetUpdateRect
194 indicates there is an update region. */
195 static int w32_strict_painting
;
197 /* Associative list linking character set strings to Windows codepages. */
198 static Lisp_Object Vw32_charset_info_alist
;
200 /* VIETNAMESE_CHARSET is not defined in some versions of MSVC. */
201 #ifndef VIETNAMESE_CHARSET
202 #define VIETNAMESE_CHARSET 163
206 Lisp_Object Qsuppress_icon
;
207 Lisp_Object Qundefined_color
;
208 Lisp_Object Qcancel_timer
;
209 Lisp_Object Qfont_param
;
215 Lisp_Object Qcontrol
;
218 Lisp_Object Qw32_charset_ansi
;
219 Lisp_Object Qw32_charset_default
;
220 Lisp_Object Qw32_charset_symbol
;
221 Lisp_Object Qw32_charset_shiftjis
;
222 Lisp_Object Qw32_charset_hangeul
;
223 Lisp_Object Qw32_charset_gb2312
;
224 Lisp_Object Qw32_charset_chinesebig5
;
225 Lisp_Object Qw32_charset_oem
;
227 #ifndef JOHAB_CHARSET
228 #define JOHAB_CHARSET 130
231 Lisp_Object Qw32_charset_easteurope
;
232 Lisp_Object Qw32_charset_turkish
;
233 Lisp_Object Qw32_charset_baltic
;
234 Lisp_Object Qw32_charset_russian
;
235 Lisp_Object Qw32_charset_arabic
;
236 Lisp_Object Qw32_charset_greek
;
237 Lisp_Object Qw32_charset_hebrew
;
238 Lisp_Object Qw32_charset_vietnamese
;
239 Lisp_Object Qw32_charset_thai
;
240 Lisp_Object Qw32_charset_johab
;
241 Lisp_Object Qw32_charset_mac
;
244 #ifdef UNICODE_CHARSET
245 Lisp_Object Qw32_charset_unicode
;
248 /* The ANSI codepage. */
249 int w32_ansi_code_page
;
251 /* Prefix for system colors. */
252 #define SYSTEM_COLOR_PREFIX "System"
253 #define SYSTEM_COLOR_PREFIX_LEN (sizeof (SYSTEM_COLOR_PREFIX) - 1)
255 /* State variables for emulating a three button mouse. */
260 static int button_state
= 0;
261 static W32Msg saved_mouse_button_msg
;
262 static unsigned mouse_button_timer
= 0; /* non-zero when timer is active */
263 static W32Msg saved_mouse_move_msg
;
264 static unsigned mouse_move_timer
= 0;
266 /* Window that is tracking the mouse. */
267 static HWND track_mouse_window
;
269 /* Multi-monitor API definitions that are not pulled from the headers
270 since we are compiling for NT 4. */
271 #ifndef MONITOR_DEFAULT_TO_NEAREST
272 #define MONITOR_DEFAULT_TO_NEAREST 2
274 /* MinGW headers define MONITORINFO unconditionally, but MSVC ones don't.
275 To avoid a compile error on one or the other, redefine with a new name. */
284 typedef BOOL (WINAPI
* TrackMouseEvent_Proc
)
285 (IN OUT LPTRACKMOUSEEVENT lpEventTrack
);
286 typedef LONG (WINAPI
* ImmGetCompositionString_Proc
)
287 (IN HIMC context
, IN DWORD index
, OUT LPVOID buffer
, IN DWORD bufLen
);
288 typedef HIMC (WINAPI
* ImmGetContext_Proc
) (IN HWND window
);
289 typedef HMONITOR (WINAPI
* MonitorFromPoint_Proc
) (IN POINT pt
, IN DWORD flags
);
290 typedef BOOL (WINAPI
* GetMonitorInfo_Proc
)
291 (IN HMONITOR monitor
, OUT
struct MONITOR_INFO
* info
);
293 TrackMouseEvent_Proc track_mouse_event_fn
= NULL
;
294 ClipboardSequence_Proc clipboard_sequence_fn
= NULL
;
295 ImmGetCompositionString_Proc get_composition_string_fn
= NULL
;
296 ImmGetContext_Proc get_ime_context_fn
= NULL
;
297 MonitorFromPoint_Proc monitor_from_point_fn
= NULL
;
298 GetMonitorInfo_Proc get_monitor_info_fn
= NULL
;
300 extern AppendMenuW_Proc unicode_append_menu
;
302 /* Flag to selectively ignore WM_IME_CHAR messages. */
303 static int ignore_ime_char
= 0;
305 /* W95 mousewheel handler */
306 unsigned int msh_mousewheel
= 0;
309 #define MOUSE_BUTTON_ID 1
310 #define MOUSE_MOVE_ID 2
311 #define MENU_FREE_ID 3
312 #define HOURGLASS_ID 4
313 /* The delay (milliseconds) before a menu is freed after WM_EXITMENULOOP
315 #define MENU_FREE_DELAY 1000
316 static unsigned menu_free_timer
= 0;
318 /* The below are defined in frame.c. */
320 extern Lisp_Object Vwindow_system_version
;
323 int image_cache_refcount
, dpyinfo_refcount
;
327 /* From w32term.c. */
328 extern int w32_num_mouse_buttons
;
329 extern Lisp_Object Vw32_recognize_altgr
;
331 extern HWND w32_system_caret_hwnd
;
333 extern int w32_system_caret_height
;
334 extern int w32_system_caret_x
;
335 extern int w32_system_caret_y
;
336 extern int w32_use_visible_system_caret
;
338 static HWND w32_visible_system_caret_hwnd
;
341 extern HMENU current_popup_menu
;
342 static int menubar_in_use
= 0;
344 /* From w32uniscribe.c */
345 extern void syms_of_w32uniscribe ();
346 extern int uniscribe_available
;
348 /* Function prototypes for hourglass support. */
349 static void show_hourglass
P_ ((struct frame
*));
350 static void hide_hourglass
P_ ((void));
354 /* Error if we are not connected to MS-Windows. */
359 error ("MS-Windows not in use or not initialized");
362 /* Nonzero if we can use mouse menus.
363 You should not call this unless HAVE_MENUS is defined. */
371 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
372 and checking validity for W32. */
375 check_x_frame (frame
)
381 frame
= selected_frame
;
382 CHECK_LIVE_FRAME (frame
);
384 if (! FRAME_W32_P (f
))
385 error ("Non-W32 frame used");
389 /* Let the user specify a display with a frame.
390 nil stands for the selected frame--or, if that is not a w32 frame,
391 the first display on the list. */
393 struct w32_display_info
*
394 check_x_display_info (frame
)
399 struct frame
*sf
= XFRAME (selected_frame
);
401 if (FRAME_W32_P (sf
) && FRAME_LIVE_P (sf
))
402 return FRAME_W32_DISPLAY_INFO (sf
);
404 return &one_w32_display_info
;
406 else if (STRINGP (frame
))
407 return x_display_info_for_name (frame
);
412 CHECK_LIVE_FRAME (frame
);
414 if (! FRAME_W32_P (f
))
415 error ("Non-W32 frame used");
416 return FRAME_W32_DISPLAY_INFO (f
);
420 /* Return the Emacs frame-object corresponding to an w32 window.
421 It could be the frame's main window or an icon window. */
423 /* This function can be called during GC, so use GC_xxx type test macros. */
426 x_window_to_frame (dpyinfo
, wdesc
)
427 struct w32_display_info
*dpyinfo
;
430 Lisp_Object tail
, frame
;
433 for (tail
= Vframe_list
; CONSP (tail
); tail
= XCDR (tail
))
439 if (!FRAME_W32_P (f
) || FRAME_W32_DISPLAY_INFO (f
) != dpyinfo
)
442 if (FRAME_W32_WINDOW (f
) == wdesc
)
449 static Lisp_Object unwind_create_frame
P_ ((Lisp_Object
));
450 static Lisp_Object unwind_create_tip_frame
P_ ((Lisp_Object
));
451 static void my_create_window
P_ ((struct frame
*));
452 static void my_create_tip_window
P_ ((struct frame
*));
454 /* TODO: Native Input Method support; see x_create_im. */
455 void x_set_foreground_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
456 void x_set_background_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
457 void x_set_mouse_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
458 void x_set_cursor_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
459 void x_set_border_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
460 void x_set_cursor_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
461 void x_set_icon_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
462 void x_set_icon_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
463 void x_explicitly_set_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
464 void x_set_menu_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
465 void x_set_title
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
466 void x_set_tool_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
467 static void x_edge_detection
P_ ((struct frame
*, struct image
*, Lisp_Object
,
473 /* Store the screen positions of frame F into XPTR and YPTR.
474 These are the positions of the containing window manager window,
475 not Emacs's own window. */
478 x_real_positions (f
, xptr
, yptr
)
485 /* Get the bounds of the WM window. */
486 GetWindowRect (FRAME_W32_WINDOW (f
), &rect
);
491 /* Convert (0, 0) in the client area to screen co-ordinates. */
492 ClientToScreen (FRAME_W32_WINDOW (f
), &pt
);
494 /* Remember x_pixels_diff and y_pixels_diff. */
495 f
->x_pixels_diff
= pt
.x
- rect
.left
;
496 f
->y_pixels_diff
= pt
.y
- rect
.top
;
504 DEFUN ("w32-define-rgb-color", Fw32_define_rgb_color
,
505 Sw32_define_rgb_color
, 4, 4, 0,
506 doc
: /* Convert RGB numbers to a Windows color reference and associate with NAME.
507 This adds or updates a named color to `w32-color-map', making it
508 available for use. The original entry's RGB ref is returned, or nil
509 if the entry is new. */)
510 (red
, green
, blue
, name
)
511 Lisp_Object red
, green
, blue
, name
;
514 Lisp_Object oldrgb
= Qnil
;
518 CHECK_NUMBER (green
);
522 XSETINT (rgb
, RGB (XUINT (red
), XUINT (green
), XUINT (blue
)));
526 /* replace existing entry in w32-color-map or add new entry. */
527 entry
= Fassoc (name
, Vw32_color_map
);
530 entry
= Fcons (name
, rgb
);
531 Vw32_color_map
= Fcons (entry
, Vw32_color_map
);
535 oldrgb
= Fcdr (entry
);
536 Fsetcdr (entry
, rgb
);
544 DEFUN ("w32-load-color-file", Fw32_load_color_file
,
545 Sw32_load_color_file
, 1, 1, 0,
546 doc
: /* Create an alist of color entries from an external file.
547 Assign this value to `w32-color-map' to replace the existing color map.
549 The file should define one named RGB color per line like so:
551 where R,G,B are numbers between 0 and 255 and name is an arbitrary string. */)
553 Lisp_Object filename
;
556 Lisp_Object cmap
= Qnil
;
559 CHECK_STRING (filename
);
560 abspath
= Fexpand_file_name (filename
, Qnil
);
562 fp
= fopen (SDATA (filename
), "rt");
566 int red
, green
, blue
;
571 while (fgets (buf
, sizeof (buf
), fp
) != NULL
) {
572 if (sscanf (buf
, "%u %u %u %n", &red
, &green
, &blue
, &num
) == 3)
574 char *name
= buf
+ num
;
575 num
= strlen (name
) - 1;
576 if (name
[num
] == '\n')
578 cmap
= Fcons (Fcons (build_string (name
),
579 make_number (RGB (red
, green
, blue
))),
591 /* The default colors for the w32 color map */
592 typedef struct colormap_t
598 colormap_t w32_color_map
[] =
600 {"snow" , PALETTERGB (255,250,250)},
601 {"ghost white" , PALETTERGB (248,248,255)},
602 {"GhostWhite" , PALETTERGB (248,248,255)},
603 {"white smoke" , PALETTERGB (245,245,245)},
604 {"WhiteSmoke" , PALETTERGB (245,245,245)},
605 {"gainsboro" , PALETTERGB (220,220,220)},
606 {"floral white" , PALETTERGB (255,250,240)},
607 {"FloralWhite" , PALETTERGB (255,250,240)},
608 {"old lace" , PALETTERGB (253,245,230)},
609 {"OldLace" , PALETTERGB (253,245,230)},
610 {"linen" , PALETTERGB (250,240,230)},
611 {"antique white" , PALETTERGB (250,235,215)},
612 {"AntiqueWhite" , PALETTERGB (250,235,215)},
613 {"papaya whip" , PALETTERGB (255,239,213)},
614 {"PapayaWhip" , PALETTERGB (255,239,213)},
615 {"blanched almond" , PALETTERGB (255,235,205)},
616 {"BlanchedAlmond" , PALETTERGB (255,235,205)},
617 {"bisque" , PALETTERGB (255,228,196)},
618 {"peach puff" , PALETTERGB (255,218,185)},
619 {"PeachPuff" , PALETTERGB (255,218,185)},
620 {"navajo white" , PALETTERGB (255,222,173)},
621 {"NavajoWhite" , PALETTERGB (255,222,173)},
622 {"moccasin" , PALETTERGB (255,228,181)},
623 {"cornsilk" , PALETTERGB (255,248,220)},
624 {"ivory" , PALETTERGB (255,255,240)},
625 {"lemon chiffon" , PALETTERGB (255,250,205)},
626 {"LemonChiffon" , PALETTERGB (255,250,205)},
627 {"seashell" , PALETTERGB (255,245,238)},
628 {"honeydew" , PALETTERGB (240,255,240)},
629 {"mint cream" , PALETTERGB (245,255,250)},
630 {"MintCream" , PALETTERGB (245,255,250)},
631 {"azure" , PALETTERGB (240,255,255)},
632 {"alice blue" , PALETTERGB (240,248,255)},
633 {"AliceBlue" , PALETTERGB (240,248,255)},
634 {"lavender" , PALETTERGB (230,230,250)},
635 {"lavender blush" , PALETTERGB (255,240,245)},
636 {"LavenderBlush" , PALETTERGB (255,240,245)},
637 {"misty rose" , PALETTERGB (255,228,225)},
638 {"MistyRose" , PALETTERGB (255,228,225)},
639 {"white" , PALETTERGB (255,255,255)},
640 {"black" , PALETTERGB ( 0, 0, 0)},
641 {"dark slate gray" , PALETTERGB ( 47, 79, 79)},
642 {"DarkSlateGray" , PALETTERGB ( 47, 79, 79)},
643 {"dark slate grey" , PALETTERGB ( 47, 79, 79)},
644 {"DarkSlateGrey" , PALETTERGB ( 47, 79, 79)},
645 {"dim gray" , PALETTERGB (105,105,105)},
646 {"DimGray" , PALETTERGB (105,105,105)},
647 {"dim grey" , PALETTERGB (105,105,105)},
648 {"DimGrey" , PALETTERGB (105,105,105)},
649 {"slate gray" , PALETTERGB (112,128,144)},
650 {"SlateGray" , PALETTERGB (112,128,144)},
651 {"slate grey" , PALETTERGB (112,128,144)},
652 {"SlateGrey" , PALETTERGB (112,128,144)},
653 {"light slate gray" , PALETTERGB (119,136,153)},
654 {"LightSlateGray" , PALETTERGB (119,136,153)},
655 {"light slate grey" , PALETTERGB (119,136,153)},
656 {"LightSlateGrey" , PALETTERGB (119,136,153)},
657 {"gray" , PALETTERGB (190,190,190)},
658 {"grey" , PALETTERGB (190,190,190)},
659 {"light grey" , PALETTERGB (211,211,211)},
660 {"LightGrey" , PALETTERGB (211,211,211)},
661 {"light gray" , PALETTERGB (211,211,211)},
662 {"LightGray" , PALETTERGB (211,211,211)},
663 {"midnight blue" , PALETTERGB ( 25, 25,112)},
664 {"MidnightBlue" , PALETTERGB ( 25, 25,112)},
665 {"navy" , PALETTERGB ( 0, 0,128)},
666 {"navy blue" , PALETTERGB ( 0, 0,128)},
667 {"NavyBlue" , PALETTERGB ( 0, 0,128)},
668 {"cornflower blue" , PALETTERGB (100,149,237)},
669 {"CornflowerBlue" , PALETTERGB (100,149,237)},
670 {"dark slate blue" , PALETTERGB ( 72, 61,139)},
671 {"DarkSlateBlue" , PALETTERGB ( 72, 61,139)},
672 {"slate blue" , PALETTERGB (106, 90,205)},
673 {"SlateBlue" , PALETTERGB (106, 90,205)},
674 {"medium slate blue" , PALETTERGB (123,104,238)},
675 {"MediumSlateBlue" , PALETTERGB (123,104,238)},
676 {"light slate blue" , PALETTERGB (132,112,255)},
677 {"LightSlateBlue" , PALETTERGB (132,112,255)},
678 {"medium blue" , PALETTERGB ( 0, 0,205)},
679 {"MediumBlue" , PALETTERGB ( 0, 0,205)},
680 {"royal blue" , PALETTERGB ( 65,105,225)},
681 {"RoyalBlue" , PALETTERGB ( 65,105,225)},
682 {"blue" , PALETTERGB ( 0, 0,255)},
683 {"dodger blue" , PALETTERGB ( 30,144,255)},
684 {"DodgerBlue" , PALETTERGB ( 30,144,255)},
685 {"deep sky blue" , PALETTERGB ( 0,191,255)},
686 {"DeepSkyBlue" , PALETTERGB ( 0,191,255)},
687 {"sky blue" , PALETTERGB (135,206,235)},
688 {"SkyBlue" , PALETTERGB (135,206,235)},
689 {"light sky blue" , PALETTERGB (135,206,250)},
690 {"LightSkyBlue" , PALETTERGB (135,206,250)},
691 {"steel blue" , PALETTERGB ( 70,130,180)},
692 {"SteelBlue" , PALETTERGB ( 70,130,180)},
693 {"light steel blue" , PALETTERGB (176,196,222)},
694 {"LightSteelBlue" , PALETTERGB (176,196,222)},
695 {"light blue" , PALETTERGB (173,216,230)},
696 {"LightBlue" , PALETTERGB (173,216,230)},
697 {"powder blue" , PALETTERGB (176,224,230)},
698 {"PowderBlue" , PALETTERGB (176,224,230)},
699 {"pale turquoise" , PALETTERGB (175,238,238)},
700 {"PaleTurquoise" , PALETTERGB (175,238,238)},
701 {"dark turquoise" , PALETTERGB ( 0,206,209)},
702 {"DarkTurquoise" , PALETTERGB ( 0,206,209)},
703 {"medium turquoise" , PALETTERGB ( 72,209,204)},
704 {"MediumTurquoise" , PALETTERGB ( 72,209,204)},
705 {"turquoise" , PALETTERGB ( 64,224,208)},
706 {"cyan" , PALETTERGB ( 0,255,255)},
707 {"light cyan" , PALETTERGB (224,255,255)},
708 {"LightCyan" , PALETTERGB (224,255,255)},
709 {"cadet blue" , PALETTERGB ( 95,158,160)},
710 {"CadetBlue" , PALETTERGB ( 95,158,160)},
711 {"medium aquamarine" , PALETTERGB (102,205,170)},
712 {"MediumAquamarine" , PALETTERGB (102,205,170)},
713 {"aquamarine" , PALETTERGB (127,255,212)},
714 {"dark green" , PALETTERGB ( 0,100, 0)},
715 {"DarkGreen" , PALETTERGB ( 0,100, 0)},
716 {"dark olive green" , PALETTERGB ( 85,107, 47)},
717 {"DarkOliveGreen" , PALETTERGB ( 85,107, 47)},
718 {"dark sea green" , PALETTERGB (143,188,143)},
719 {"DarkSeaGreen" , PALETTERGB (143,188,143)},
720 {"sea green" , PALETTERGB ( 46,139, 87)},
721 {"SeaGreen" , PALETTERGB ( 46,139, 87)},
722 {"medium sea green" , PALETTERGB ( 60,179,113)},
723 {"MediumSeaGreen" , PALETTERGB ( 60,179,113)},
724 {"light sea green" , PALETTERGB ( 32,178,170)},
725 {"LightSeaGreen" , PALETTERGB ( 32,178,170)},
726 {"pale green" , PALETTERGB (152,251,152)},
727 {"PaleGreen" , PALETTERGB (152,251,152)},
728 {"spring green" , PALETTERGB ( 0,255,127)},
729 {"SpringGreen" , PALETTERGB ( 0,255,127)},
730 {"lawn green" , PALETTERGB (124,252, 0)},
731 {"LawnGreen" , PALETTERGB (124,252, 0)},
732 {"green" , PALETTERGB ( 0,255, 0)},
733 {"chartreuse" , PALETTERGB (127,255, 0)},
734 {"medium spring green" , PALETTERGB ( 0,250,154)},
735 {"MediumSpringGreen" , PALETTERGB ( 0,250,154)},
736 {"green yellow" , PALETTERGB (173,255, 47)},
737 {"GreenYellow" , PALETTERGB (173,255, 47)},
738 {"lime green" , PALETTERGB ( 50,205, 50)},
739 {"LimeGreen" , PALETTERGB ( 50,205, 50)},
740 {"yellow green" , PALETTERGB (154,205, 50)},
741 {"YellowGreen" , PALETTERGB (154,205, 50)},
742 {"forest green" , PALETTERGB ( 34,139, 34)},
743 {"ForestGreen" , PALETTERGB ( 34,139, 34)},
744 {"olive drab" , PALETTERGB (107,142, 35)},
745 {"OliveDrab" , PALETTERGB (107,142, 35)},
746 {"dark khaki" , PALETTERGB (189,183,107)},
747 {"DarkKhaki" , PALETTERGB (189,183,107)},
748 {"khaki" , PALETTERGB (240,230,140)},
749 {"pale goldenrod" , PALETTERGB (238,232,170)},
750 {"PaleGoldenrod" , PALETTERGB (238,232,170)},
751 {"light goldenrod yellow" , PALETTERGB (250,250,210)},
752 {"LightGoldenrodYellow" , PALETTERGB (250,250,210)},
753 {"light yellow" , PALETTERGB (255,255,224)},
754 {"LightYellow" , PALETTERGB (255,255,224)},
755 {"yellow" , PALETTERGB (255,255, 0)},
756 {"gold" , PALETTERGB (255,215, 0)},
757 {"light goldenrod" , PALETTERGB (238,221,130)},
758 {"LightGoldenrod" , PALETTERGB (238,221,130)},
759 {"goldenrod" , PALETTERGB (218,165, 32)},
760 {"dark goldenrod" , PALETTERGB (184,134, 11)},
761 {"DarkGoldenrod" , PALETTERGB (184,134, 11)},
762 {"rosy brown" , PALETTERGB (188,143,143)},
763 {"RosyBrown" , PALETTERGB (188,143,143)},
764 {"indian red" , PALETTERGB (205, 92, 92)},
765 {"IndianRed" , PALETTERGB (205, 92, 92)},
766 {"saddle brown" , PALETTERGB (139, 69, 19)},
767 {"SaddleBrown" , PALETTERGB (139, 69, 19)},
768 {"sienna" , PALETTERGB (160, 82, 45)},
769 {"peru" , PALETTERGB (205,133, 63)},
770 {"burlywood" , PALETTERGB (222,184,135)},
771 {"beige" , PALETTERGB (245,245,220)},
772 {"wheat" , PALETTERGB (245,222,179)},
773 {"sandy brown" , PALETTERGB (244,164, 96)},
774 {"SandyBrown" , PALETTERGB (244,164, 96)},
775 {"tan" , PALETTERGB (210,180,140)},
776 {"chocolate" , PALETTERGB (210,105, 30)},
777 {"firebrick" , PALETTERGB (178,34, 34)},
778 {"brown" , PALETTERGB (165,42, 42)},
779 {"dark salmon" , PALETTERGB (233,150,122)},
780 {"DarkSalmon" , PALETTERGB (233,150,122)},
781 {"salmon" , PALETTERGB (250,128,114)},
782 {"light salmon" , PALETTERGB (255,160,122)},
783 {"LightSalmon" , PALETTERGB (255,160,122)},
784 {"orange" , PALETTERGB (255,165, 0)},
785 {"dark orange" , PALETTERGB (255,140, 0)},
786 {"DarkOrange" , PALETTERGB (255,140, 0)},
787 {"coral" , PALETTERGB (255,127, 80)},
788 {"light coral" , PALETTERGB (240,128,128)},
789 {"LightCoral" , PALETTERGB (240,128,128)},
790 {"tomato" , PALETTERGB (255, 99, 71)},
791 {"orange red" , PALETTERGB (255, 69, 0)},
792 {"OrangeRed" , PALETTERGB (255, 69, 0)},
793 {"red" , PALETTERGB (255, 0, 0)},
794 {"hot pink" , PALETTERGB (255,105,180)},
795 {"HotPink" , PALETTERGB (255,105,180)},
796 {"deep pink" , PALETTERGB (255, 20,147)},
797 {"DeepPink" , PALETTERGB (255, 20,147)},
798 {"pink" , PALETTERGB (255,192,203)},
799 {"light pink" , PALETTERGB (255,182,193)},
800 {"LightPink" , PALETTERGB (255,182,193)},
801 {"pale violet red" , PALETTERGB (219,112,147)},
802 {"PaleVioletRed" , PALETTERGB (219,112,147)},
803 {"maroon" , PALETTERGB (176, 48, 96)},
804 {"medium violet red" , PALETTERGB (199, 21,133)},
805 {"MediumVioletRed" , PALETTERGB (199, 21,133)},
806 {"violet red" , PALETTERGB (208, 32,144)},
807 {"VioletRed" , PALETTERGB (208, 32,144)},
808 {"magenta" , PALETTERGB (255, 0,255)},
809 {"violet" , PALETTERGB (238,130,238)},
810 {"plum" , PALETTERGB (221,160,221)},
811 {"orchid" , PALETTERGB (218,112,214)},
812 {"medium orchid" , PALETTERGB (186, 85,211)},
813 {"MediumOrchid" , PALETTERGB (186, 85,211)},
814 {"dark orchid" , PALETTERGB (153, 50,204)},
815 {"DarkOrchid" , PALETTERGB (153, 50,204)},
816 {"dark violet" , PALETTERGB (148, 0,211)},
817 {"DarkViolet" , PALETTERGB (148, 0,211)},
818 {"blue violet" , PALETTERGB (138, 43,226)},
819 {"BlueViolet" , PALETTERGB (138, 43,226)},
820 {"purple" , PALETTERGB (160, 32,240)},
821 {"medium purple" , PALETTERGB (147,112,219)},
822 {"MediumPurple" , PALETTERGB (147,112,219)},
823 {"thistle" , PALETTERGB (216,191,216)},
824 {"gray0" , PALETTERGB ( 0, 0, 0)},
825 {"grey0" , PALETTERGB ( 0, 0, 0)},
826 {"dark grey" , PALETTERGB (169,169,169)},
827 {"DarkGrey" , PALETTERGB (169,169,169)},
828 {"dark gray" , PALETTERGB (169,169,169)},
829 {"DarkGray" , PALETTERGB (169,169,169)},
830 {"dark blue" , PALETTERGB ( 0, 0,139)},
831 {"DarkBlue" , PALETTERGB ( 0, 0,139)},
832 {"dark cyan" , PALETTERGB ( 0,139,139)},
833 {"DarkCyan" , PALETTERGB ( 0,139,139)},
834 {"dark magenta" , PALETTERGB (139, 0,139)},
835 {"DarkMagenta" , PALETTERGB (139, 0,139)},
836 {"dark red" , PALETTERGB (139, 0, 0)},
837 {"DarkRed" , PALETTERGB (139, 0, 0)},
838 {"light green" , PALETTERGB (144,238,144)},
839 {"LightGreen" , PALETTERGB (144,238,144)},
842 DEFUN ("w32-default-color-map", Fw32_default_color_map
, Sw32_default_color_map
,
843 0, 0, 0, doc
: /* Return the default color map. */)
847 colormap_t
*pc
= w32_color_map
;
854 for (i
= 0; i
< sizeof (w32_color_map
) / sizeof (w32_color_map
[0]);
856 cmap
= Fcons (Fcons (build_string (pc
->name
),
857 make_number (pc
->colorref
)),
875 color
= Frassq (rgb
, Vw32_color_map
);
880 return (Fcar (color
));
886 w32_color_map_lookup (colorname
)
889 Lisp_Object tail
, ret
= Qnil
;
893 for (tail
= Vw32_color_map
; CONSP (tail
); tail
= XCDR (tail
))
895 register Lisp_Object elt
, tem
;
898 if (!CONSP (elt
)) continue;
902 if (lstrcmpi (SDATA (tem
), colorname
) == 0)
919 add_system_logical_colors_to_map (system_colors
)
920 Lisp_Object
*system_colors
;
924 /* Other registry operations are done with input blocked. */
927 /* Look for "Control Panel/Colors" under User and Machine registry
929 if (RegOpenKeyEx (HKEY_CURRENT_USER
, "Control Panel\\Colors", 0,
930 KEY_READ
, &colors_key
) == ERROR_SUCCESS
931 || RegOpenKeyEx (HKEY_LOCAL_MACHINE
, "Control Panel\\Colors", 0,
932 KEY_READ
, &colors_key
) == ERROR_SUCCESS
)
935 char color_buffer
[64];
936 char full_name_buffer
[MAX_PATH
+ SYSTEM_COLOR_PREFIX_LEN
];
938 DWORD name_size
, color_size
;
939 char *name_buffer
= full_name_buffer
+ SYSTEM_COLOR_PREFIX_LEN
;
941 name_size
= sizeof (full_name_buffer
) - SYSTEM_COLOR_PREFIX_LEN
;
942 color_size
= sizeof (color_buffer
);
944 strcpy (full_name_buffer
, SYSTEM_COLOR_PREFIX
);
946 while (RegEnumValueA (colors_key
, index
, name_buffer
, &name_size
,
947 NULL
, NULL
, color_buffer
, &color_size
)
951 if (sscanf (color_buffer
, " %u %u %u", &r
, &g
, &b
) == 3)
952 *system_colors
= Fcons (Fcons (build_string (full_name_buffer
),
953 make_number (RGB (r
, g
, b
))),
956 name_size
= sizeof (full_name_buffer
) - SYSTEM_COLOR_PREFIX_LEN
;
957 color_size
= sizeof (color_buffer
);
960 RegCloseKey (colors_key
);
968 x_to_w32_color (colorname
)
971 register Lisp_Object ret
= Qnil
;
975 if (colorname
[0] == '#')
977 /* Could be an old-style RGB Device specification. */
980 color
= colorname
+ 1;
982 size
= strlen (color
);
983 if (size
== 3 || size
== 6 || size
== 9 || size
== 12)
991 for (i
= 0; i
< 3; i
++)
997 /* The check for 'x' in the following conditional takes into
998 account the fact that strtol allows a "0x" in front of
999 our numbers, and we don't. */
1000 if (!isxdigit (color
[0]) || color
[1] == 'x')
1004 value
= strtoul (color
, &end
, 16);
1006 if (errno
== ERANGE
|| end
- color
!= size
)
1011 value
= value
* 0x10;
1022 colorval
|= (value
<< pos
);
1027 XSETINT (ret
, colorval
);
1034 else if (strnicmp (colorname
, "rgb:", 4) == 0)
1042 color
= colorname
+ 4;
1043 for (i
= 0; i
< 3; i
++)
1046 unsigned long value
;
1048 /* The check for 'x' in the following conditional takes into
1049 account the fact that strtol allows a "0x" in front of
1050 our numbers, and we don't. */
1051 if (!isxdigit (color
[0]) || color
[1] == 'x')
1053 value
= strtoul (color
, &end
, 16);
1054 if (errno
== ERANGE
)
1056 switch (end
- color
)
1059 value
= value
* 0x10 + value
;
1072 if (value
== ULONG_MAX
)
1074 colorval
|= (value
<< pos
);
1081 XSETINT (ret
, colorval
);
1089 else if (strnicmp (colorname
, "rgbi:", 5) == 0)
1091 /* This is an RGB Intensity specification. */
1098 color
= colorname
+ 5;
1099 for (i
= 0; i
< 3; i
++)
1105 value
= strtod (color
, &end
);
1106 if (errno
== ERANGE
)
1108 if (value
< 0.0 || value
> 1.0)
1110 val
= (UINT
)(0x100 * value
);
1111 /* We used 0x100 instead of 0xFF to give a continuous
1112 range between 0.0 and 1.0 inclusive. The next statement
1113 fixes the 1.0 case. */
1116 colorval
|= (val
<< pos
);
1123 XSETINT (ret
, colorval
);
1131 /* I am not going to attempt to handle any of the CIE color schemes
1132 or TekHVC, since I don't know the algorithms for conversion to
1135 /* If we fail to lookup the color name in w32_color_map, then check the
1136 colorname to see if it can be crudely approximated: If the X color
1137 ends in a number (e.g., "darkseagreen2"), strip the number and
1138 return the result of looking up the base color name. */
1139 ret
= w32_color_map_lookup (colorname
);
1142 int len
= strlen (colorname
);
1144 if (isdigit (colorname
[len
- 1]))
1146 char *ptr
, *approx
= alloca (len
+ 1);
1148 strcpy (approx
, colorname
);
1149 ptr
= &approx
[len
- 1];
1150 while (ptr
> approx
&& isdigit (*ptr
))
1153 ret
= w32_color_map_lookup (approx
);
1162 w32_regenerate_palette (FRAME_PTR f
)
1164 struct w32_palette_entry
* list
;
1165 LOGPALETTE
* log_palette
;
1166 HPALETTE new_palette
;
1169 /* don't bother trying to create palette if not supported */
1170 if (! FRAME_W32_DISPLAY_INFO (f
)->has_palette
)
1173 log_palette
= (LOGPALETTE
*)
1174 alloca (sizeof (LOGPALETTE
) +
1175 FRAME_W32_DISPLAY_INFO (f
)->num_colors
* sizeof (PALETTEENTRY
));
1176 log_palette
->palVersion
= 0x300;
1177 log_palette
->palNumEntries
= FRAME_W32_DISPLAY_INFO (f
)->num_colors
;
1179 list
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1181 i
< FRAME_W32_DISPLAY_INFO (f
)->num_colors
;
1182 i
++, list
= list
->next
)
1183 log_palette
->palPalEntry
[i
] = list
->entry
;
1185 new_palette
= CreatePalette (log_palette
);
1189 if (FRAME_W32_DISPLAY_INFO (f
)->palette
)
1190 DeleteObject (FRAME_W32_DISPLAY_INFO (f
)->palette
);
1191 FRAME_W32_DISPLAY_INFO (f
)->palette
= new_palette
;
1193 /* Realize display palette and garbage all frames. */
1194 release_frame_dc (f
, get_frame_dc (f
));
1199 #define W32_COLOR(pe) RGB (pe.peRed, pe.peGreen, pe.peBlue)
1200 #define SET_W32_COLOR(pe, color) \
1203 pe.peRed = GetRValue (color); \
1204 pe.peGreen = GetGValue (color); \
1205 pe.peBlue = GetBValue (color); \
1210 /* Keep these around in case we ever want to track color usage. */
1212 w32_map_color (FRAME_PTR f
, COLORREF color
)
1214 struct w32_palette_entry
* list
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1216 if (NILP (Vw32_enable_palette
))
1219 /* check if color is already mapped */
1222 if (W32_COLOR (list
->entry
) == color
)
1230 /* not already mapped, so add to list and recreate Windows palette */
1231 list
= (struct w32_palette_entry
*)
1232 xmalloc (sizeof (struct w32_palette_entry
));
1233 SET_W32_COLOR (list
->entry
, color
);
1235 list
->next
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1236 FRAME_W32_DISPLAY_INFO (f
)->color_list
= list
;
1237 FRAME_W32_DISPLAY_INFO (f
)->num_colors
++;
1239 /* set flag that palette must be regenerated */
1240 FRAME_W32_DISPLAY_INFO (f
)->regen_palette
= TRUE
;
1244 w32_unmap_color (FRAME_PTR f
, COLORREF color
)
1246 struct w32_palette_entry
* list
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1247 struct w32_palette_entry
**prev
= &FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1249 if (NILP (Vw32_enable_palette
))
1252 /* check if color is already mapped */
1255 if (W32_COLOR (list
->entry
) == color
)
1257 if (--list
->refcount
== 0)
1261 FRAME_W32_DISPLAY_INFO (f
)->num_colors
--;
1271 /* set flag that palette must be regenerated */
1272 FRAME_W32_DISPLAY_INFO (f
)->regen_palette
= TRUE
;
1277 /* Gamma-correct COLOR on frame F. */
1280 gamma_correct (f
, color
)
1286 *color
= PALETTERGB (
1287 pow (GetRValue (*color
) / 255.0, f
->gamma
) * 255.0 + 0.5,
1288 pow (GetGValue (*color
) / 255.0, f
->gamma
) * 255.0 + 0.5,
1289 pow (GetBValue (*color
) / 255.0, f
->gamma
) * 255.0 + 0.5);
1294 /* Decide if color named COLOR is valid for the display associated with
1295 the selected frame; if so, return the rgb values in COLOR_DEF.
1296 If ALLOC is nonzero, allocate a new colormap cell. */
1299 w32_defined_color (f
, color
, color_def
, alloc
)
1305 register Lisp_Object tem
;
1306 COLORREF w32_color_ref
;
1308 tem
= x_to_w32_color (color
);
1314 /* Apply gamma correction. */
1315 w32_color_ref
= XUINT (tem
);
1316 gamma_correct (f
, &w32_color_ref
);
1317 XSETINT (tem
, w32_color_ref
);
1320 /* Map this color to the palette if it is enabled. */
1321 if (!NILP (Vw32_enable_palette
))
1323 struct w32_palette_entry
* entry
=
1324 one_w32_display_info
.color_list
;
1325 struct w32_palette_entry
** prev
=
1326 &one_w32_display_info
.color_list
;
1328 /* check if color is already mapped */
1331 if (W32_COLOR (entry
->entry
) == XUINT (tem
))
1333 prev
= &entry
->next
;
1334 entry
= entry
->next
;
1337 if (entry
== NULL
&& alloc
)
1339 /* not already mapped, so add to list */
1340 entry
= (struct w32_palette_entry
*)
1341 xmalloc (sizeof (struct w32_palette_entry
));
1342 SET_W32_COLOR (entry
->entry
, XUINT (tem
));
1345 one_w32_display_info
.num_colors
++;
1347 /* set flag that palette must be regenerated */
1348 one_w32_display_info
.regen_palette
= TRUE
;
1351 /* Ensure COLORREF value is snapped to nearest color in (default)
1352 palette by simulating the PALETTERGB macro. This works whether
1353 or not the display device has a palette. */
1354 w32_color_ref
= XUINT (tem
) | 0x2000000;
1356 color_def
->pixel
= w32_color_ref
;
1357 color_def
->red
= GetRValue (w32_color_ref
) * 256;
1358 color_def
->green
= GetGValue (w32_color_ref
) * 256;
1359 color_def
->blue
= GetBValue (w32_color_ref
) * 256;
1369 /* Given a string ARG naming a color, compute a pixel value from it
1370 suitable for screen F.
1371 If F is not a color screen, return DEF (default) regardless of what
1375 x_decode_color (f
, arg
, def
)
1384 if (strcmp (SDATA (arg
), "black") == 0)
1385 return BLACK_PIX_DEFAULT (f
);
1386 else if (strcmp (SDATA (arg
), "white") == 0)
1387 return WHITE_PIX_DEFAULT (f
);
1389 if ((FRAME_W32_DISPLAY_INFO (f
)->n_planes
* FRAME_W32_DISPLAY_INFO (f
)->n_cbits
) == 1)
1392 /* w32_defined_color is responsible for coping with failures
1393 by looking for a near-miss. */
1394 if (w32_defined_color (f
, SDATA (arg
), &cdef
, 1))
1397 /* defined_color failed; return an ultimate default. */
1403 /* Functions called only from `x_set_frame_param'
1404 to set individual parameters.
1406 If FRAME_W32_WINDOW (f) is 0,
1407 the frame is being created and its window does not exist yet.
1408 In that case, just record the parameter's new value
1409 in the standard place; do not attempt to change the window. */
1412 x_set_foreground_color (f
, arg
, oldval
)
1414 Lisp_Object arg
, oldval
;
1416 struct w32_output
*x
= f
->output_data
.w32
;
1417 PIX_TYPE fg
, old_fg
;
1419 fg
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1420 old_fg
= FRAME_FOREGROUND_PIXEL (f
);
1421 FRAME_FOREGROUND_PIXEL (f
) = fg
;
1423 if (FRAME_W32_WINDOW (f
) != 0)
1425 if (x
->cursor_pixel
== old_fg
)
1426 x
->cursor_pixel
= fg
;
1428 update_face_from_frame_parameter (f
, Qforeground_color
, arg
);
1429 if (FRAME_VISIBLE_P (f
))
1435 x_set_background_color (f
, arg
, oldval
)
1437 Lisp_Object arg
, oldval
;
1439 FRAME_BACKGROUND_PIXEL (f
)
1440 = x_decode_color (f
, arg
, WHITE_PIX_DEFAULT (f
));
1442 if (FRAME_W32_WINDOW (f
) != 0)
1444 SetWindowLong (FRAME_W32_WINDOW (f
), WND_BACKGROUND_INDEX
,
1445 FRAME_BACKGROUND_PIXEL (f
));
1447 update_face_from_frame_parameter (f
, Qbackground_color
, arg
);
1449 if (FRAME_VISIBLE_P (f
))
1455 x_set_mouse_color (f
, arg
, oldval
)
1457 Lisp_Object arg
, oldval
;
1459 Cursor cursor
, nontext_cursor
, mode_cursor
, hand_cursor
;
1463 if (!EQ (Qnil
, arg
))
1464 f
->output_data
.w32
->mouse_pixel
1465 = x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1466 mask_color
= FRAME_BACKGROUND_PIXEL (f
);
1468 /* Don't let pointers be invisible. */
1469 if (mask_color
== f
->output_data
.w32
->mouse_pixel
1470 && mask_color
== FRAME_BACKGROUND_PIXEL (f
))
1471 f
->output_data
.w32
->mouse_pixel
= FRAME_FOREGROUND_PIXEL (f
);
1473 #if 0 /* TODO : cursor changes */
1476 /* It's not okay to crash if the user selects a screwy cursor. */
1477 count
= x_catch_errors (FRAME_W32_DISPLAY (f
));
1479 if (!EQ (Qnil
, Vx_pointer_shape
))
1481 CHECK_NUMBER (Vx_pointer_shape
);
1482 cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XINT (Vx_pointer_shape
));
1485 cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_xterm
);
1486 x_check_errors (FRAME_W32_DISPLAY (f
), "bad text pointer cursor: %s");
1488 if (!EQ (Qnil
, Vx_nontext_pointer_shape
))
1490 CHECK_NUMBER (Vx_nontext_pointer_shape
);
1491 nontext_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
),
1492 XINT (Vx_nontext_pointer_shape
));
1495 nontext_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_left_ptr
);
1496 x_check_errors (FRAME_W32_DISPLAY (f
), "bad nontext pointer cursor: %s");
1498 if (!EQ (Qnil
, Vx_hourglass_pointer_shape
))
1500 CHECK_NUMBER (Vx_hourglass_pointer_shape
);
1501 hourglass_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
),
1502 XINT (Vx_hourglass_pointer_shape
));
1505 hourglass_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_watch
);
1506 x_check_errors (FRAME_W32_DISPLAY (f
), "bad busy pointer cursor: %s");
1508 x_check_errors (FRAME_W32_DISPLAY (f
), "bad nontext pointer cursor: %s");
1509 if (!EQ (Qnil
, Vx_mode_pointer_shape
))
1511 CHECK_NUMBER (Vx_mode_pointer_shape
);
1512 mode_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
),
1513 XINT (Vx_mode_pointer_shape
));
1516 mode_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_xterm
);
1517 x_check_errors (FRAME_W32_DISPLAY (f
), "bad modeline pointer cursor: %s");
1519 if (!EQ (Qnil
, Vx_sensitive_text_pointer_shape
))
1521 CHECK_NUMBER (Vx_sensitive_text_pointer_shape
);
1523 = XCreateFontCursor (FRAME_W32_DISPLAY (f
),
1524 XINT (Vx_sensitive_text_pointer_shape
));
1527 hand_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_crosshair
);
1529 if (!NILP (Vx_window_horizontal_drag_shape
))
1531 CHECK_NUMBER (Vx_window_horizontal_drag_shape
);
1532 horizontal_drag_cursor
1533 = XCreateFontCursor (FRAME_X_DISPLAY (f
),
1534 XINT (Vx_window_horizontal_drag_shape
));
1537 horizontal_drag_cursor
1538 = XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_sb_h_double_arrow
);
1540 /* Check and report errors with the above calls. */
1541 x_check_errors (FRAME_W32_DISPLAY (f
), "can't set cursor shape: %s");
1542 x_uncatch_errors (FRAME_W32_DISPLAY (f
), count
);
1545 XColor fore_color
, back_color
;
1547 fore_color
.pixel
= f
->output_data
.w32
->mouse_pixel
;
1548 back_color
.pixel
= mask_color
;
1549 XQueryColor (FRAME_W32_DISPLAY (f
),
1550 DefaultColormap (FRAME_W32_DISPLAY (f
),
1551 DefaultScreen (FRAME_W32_DISPLAY (f
))),
1553 XQueryColor (FRAME_W32_DISPLAY (f
),
1554 DefaultColormap (FRAME_W32_DISPLAY (f
),
1555 DefaultScreen (FRAME_W32_DISPLAY (f
))),
1557 XRecolorCursor (FRAME_W32_DISPLAY (f
), cursor
,
1558 &fore_color
, &back_color
);
1559 XRecolorCursor (FRAME_W32_DISPLAY (f
), nontext_cursor
,
1560 &fore_color
, &back_color
);
1561 XRecolorCursor (FRAME_W32_DISPLAY (f
), mode_cursor
,
1562 &fore_color
, &back_color
);
1563 XRecolorCursor (FRAME_W32_DISPLAY (f
), hand_cursor
,
1564 &fore_color
, &back_color
);
1565 XRecolorCursor (FRAME_W32_DISPLAY (f
), hourglass_cursor
,
1566 &fore_color
, &back_color
);
1569 if (FRAME_W32_WINDOW (f
) != 0)
1570 XDefineCursor (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
), cursor
);
1572 if (cursor
!= f
->output_data
.w32
->text_cursor
&& f
->output_data
.w32
->text_cursor
!= 0)
1573 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->text_cursor
);
1574 f
->output_data
.w32
->text_cursor
= cursor
;
1576 if (nontext_cursor
!= f
->output_data
.w32
->nontext_cursor
1577 && f
->output_data
.w32
->nontext_cursor
!= 0)
1578 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->nontext_cursor
);
1579 f
->output_data
.w32
->nontext_cursor
= nontext_cursor
;
1581 if (hourglass_cursor
!= f
->output_data
.w32
->hourglass_cursor
1582 && f
->output_data
.w32
->hourglass_cursor
!= 0)
1583 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->hourglass_cursor
);
1584 f
->output_data
.w32
->hourglass_cursor
= hourglass_cursor
;
1586 if (mode_cursor
!= f
->output_data
.w32
->modeline_cursor
1587 && f
->output_data
.w32
->modeline_cursor
!= 0)
1588 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->modeline_cursor
);
1589 f
->output_data
.w32
->modeline_cursor
= mode_cursor
;
1591 if (hand_cursor
!= f
->output_data
.w32
->hand_cursor
1592 && f
->output_data
.w32
->hand_cursor
!= 0)
1593 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->hand_cursor
);
1594 f
->output_data
.w32
->hand_cursor
= hand_cursor
;
1596 XFlush (FRAME_W32_DISPLAY (f
));
1599 update_face_from_frame_parameter (f
, Qmouse_color
, arg
);
1604 x_set_cursor_color (f
, arg
, oldval
)
1606 Lisp_Object arg
, oldval
;
1608 unsigned long fore_pixel
, pixel
;
1610 if (!NILP (Vx_cursor_fore_pixel
))
1611 fore_pixel
= x_decode_color (f
, Vx_cursor_fore_pixel
,
1612 WHITE_PIX_DEFAULT (f
));
1614 fore_pixel
= FRAME_BACKGROUND_PIXEL (f
);
1616 pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1618 /* Make sure that the cursor color differs from the background color. */
1619 if (pixel
== FRAME_BACKGROUND_PIXEL (f
))
1621 pixel
= f
->output_data
.w32
->mouse_pixel
;
1622 if (pixel
== fore_pixel
)
1623 fore_pixel
= FRAME_BACKGROUND_PIXEL (f
);
1626 f
->output_data
.w32
->cursor_foreground_pixel
= fore_pixel
;
1627 f
->output_data
.w32
->cursor_pixel
= pixel
;
1629 if (FRAME_W32_WINDOW (f
) != 0)
1632 /* Update frame's cursor_gc. */
1633 f
->output_data
.w32
->cursor_gc
->foreground
= fore_pixel
;
1634 f
->output_data
.w32
->cursor_gc
->background
= pixel
;
1638 if (FRAME_VISIBLE_P (f
))
1640 x_update_cursor (f
, 0);
1641 x_update_cursor (f
, 1);
1645 update_face_from_frame_parameter (f
, Qcursor_color
, arg
);
1648 /* Set the border-color of frame F to pixel value PIX.
1649 Note that this does not fully take effect if done before
1653 x_set_border_pixel (f
, pix
)
1658 f
->output_data
.w32
->border_pixel
= pix
;
1660 if (FRAME_W32_WINDOW (f
) != 0 && f
->border_width
> 0)
1662 if (FRAME_VISIBLE_P (f
))
1667 /* Set the border-color of frame F to value described by ARG.
1668 ARG can be a string naming a color.
1669 The border-color is used for the border that is drawn by the server.
1670 Note that this does not fully take effect if done before
1671 F has a window; it must be redone when the window is created. */
1674 x_set_border_color (f
, arg
, oldval
)
1676 Lisp_Object arg
, oldval
;
1681 pix
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1682 x_set_border_pixel (f
, pix
);
1683 update_face_from_frame_parameter (f
, Qborder_color
, arg
);
1688 x_set_cursor_type (f
, arg
, oldval
)
1690 Lisp_Object arg
, oldval
;
1692 set_frame_cursor_types (f
, arg
);
1694 /* Make sure the cursor gets redrawn. */
1695 cursor_type_changed
= 1;
1699 x_set_icon_type (f
, arg
, oldval
)
1701 Lisp_Object arg
, oldval
;
1705 if (NILP (arg
) && NILP (oldval
))
1708 if (STRINGP (arg
) && STRINGP (oldval
)
1709 && EQ (Fstring_equal (oldval
, arg
), Qt
))
1712 if (SYMBOLP (arg
) && SYMBOLP (oldval
) && EQ (arg
, oldval
))
1717 result
= x_bitmap_icon (f
, arg
);
1721 error ("No icon window available");
1728 x_set_icon_name (f
, arg
, oldval
)
1730 Lisp_Object arg
, oldval
;
1734 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1737 else if (!NILP (arg
) || NILP (oldval
))
1743 if (f
->output_data
.w32
->icon_bitmap
!= 0)
1748 result
= x_text_icon (f
,
1749 (char *) SDATA ((!NILP (f
->icon_name
)
1758 error ("No icon window available");
1761 /* If the window was unmapped (and its icon was mapped),
1762 the new icon is not mapped, so map the window in its stead. */
1763 if (FRAME_VISIBLE_P (f
))
1765 #ifdef USE_X_TOOLKIT
1766 XtPopup (f
->output_data
.w32
->widget
, XtGrabNone
);
1768 XMapWindow (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
));
1771 XFlush (FRAME_W32_DISPLAY (f
));
1778 x_set_menu_bar_lines (f
, value
, oldval
)
1780 Lisp_Object value
, oldval
;
1783 int olines
= FRAME_MENU_BAR_LINES (f
);
1785 /* Right now, menu bars don't work properly in minibuf-only frames;
1786 most of the commands try to apply themselves to the minibuffer
1787 frame itself, and get an error because you can't switch buffers
1788 in or split the minibuffer window. */
1789 if (FRAME_MINIBUF_ONLY_P (f
))
1792 if (INTEGERP (value
))
1793 nlines
= XINT (value
);
1797 FRAME_MENU_BAR_LINES (f
) = 0;
1799 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
1802 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
1803 free_frame_menubar (f
);
1804 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
1806 /* Adjust the frame size so that the client (text) dimensions
1807 remain the same. This depends on FRAME_EXTERNAL_MENU_BAR being
1809 x_set_window_size (f
, 0, FRAME_COLS (f
), FRAME_LINES (f
));
1810 do_pending_window_change (0);
1816 /* Set the number of lines used for the tool bar of frame F to VALUE.
1817 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
1818 is the old number of tool bar lines. This function changes the
1819 height of all windows on frame F to match the new tool bar height.
1820 The frame's height doesn't change. */
1823 x_set_tool_bar_lines (f
, value
, oldval
)
1825 Lisp_Object value
, oldval
;
1827 int delta
, nlines
, root_height
;
1828 Lisp_Object root_window
;
1830 /* Treat tool bars like menu bars. */
1831 if (FRAME_MINIBUF_ONLY_P (f
))
1834 /* Use VALUE only if an integer >= 0. */
1835 if (INTEGERP (value
) && XINT (value
) >= 0)
1836 nlines
= XFASTINT (value
);
1840 /* Make sure we redisplay all windows in this frame. */
1841 ++windows_or_buffers_changed
;
1843 delta
= nlines
- FRAME_TOOL_BAR_LINES (f
);
1845 /* Don't resize the tool-bar to more than we have room for. */
1846 root_window
= FRAME_ROOT_WINDOW (f
);
1847 root_height
= WINDOW_TOTAL_LINES (XWINDOW (root_window
));
1848 if (root_height
- delta
< 1)
1850 delta
= root_height
- 1;
1851 nlines
= FRAME_TOOL_BAR_LINES (f
) + delta
;
1854 FRAME_TOOL_BAR_LINES (f
) = nlines
;
1855 change_window_heights (root_window
, delta
);
1858 /* We also have to make sure that the internal border at the top of
1859 the frame, below the menu bar or tool bar, is redrawn when the
1860 tool bar disappears. This is so because the internal border is
1861 below the tool bar if one is displayed, but is below the menu bar
1862 if there isn't a tool bar. The tool bar draws into the area
1863 below the menu bar. */
1864 if (FRAME_W32_WINDOW (f
) && FRAME_TOOL_BAR_LINES (f
) == 0)
1867 clear_current_matrices (f
);
1870 /* If the tool bar gets smaller, the internal border below it
1871 has to be cleared. It was formerly part of the display
1872 of the larger tool bar, and updating windows won't clear it. */
1875 int height
= FRAME_INTERNAL_BORDER_WIDTH (f
);
1876 int width
= FRAME_PIXEL_WIDTH (f
);
1877 int y
= nlines
* FRAME_LINE_HEIGHT (f
);
1881 HDC hdc
= get_frame_dc (f
);
1882 w32_clear_area (f
, hdc
, 0, y
, width
, height
);
1883 release_frame_dc (f
, hdc
);
1887 if (WINDOWP (f
->tool_bar_window
))
1888 clear_glyph_matrix (XWINDOW (f
->tool_bar_window
)->current_matrix
);
1893 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
1896 If EXPLICIT is non-zero, that indicates that lisp code is setting the
1897 name; if NAME is a string, set F's name to NAME and set
1898 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
1900 If EXPLICIT is zero, that indicates that Emacs redisplay code is
1901 suggesting a new name, which lisp code should override; if
1902 F->explicit_name is set, ignore the new name; otherwise, set it. */
1905 x_set_name (f
, name
, explicit)
1910 /* Make sure that requests from lisp code override requests from
1911 Emacs redisplay code. */
1914 /* If we're switching from explicit to implicit, we had better
1915 update the mode lines and thereby update the title. */
1916 if (f
->explicit_name
&& NILP (name
))
1917 update_mode_lines
= 1;
1919 f
->explicit_name
= ! NILP (name
);
1921 else if (f
->explicit_name
)
1924 /* If NAME is nil, set the name to the w32_id_name. */
1927 /* Check for no change needed in this very common case
1928 before we do any consing. */
1929 if (!strcmp (FRAME_W32_DISPLAY_INFO (f
)->w32_id_name
,
1932 name
= build_string (FRAME_W32_DISPLAY_INFO (f
)->w32_id_name
);
1935 CHECK_STRING (name
);
1937 /* Don't change the name if it's already NAME. */
1938 if (! NILP (Fstring_equal (name
, f
->name
)))
1943 /* For setting the frame title, the title parameter should override
1944 the name parameter. */
1945 if (! NILP (f
->title
))
1948 if (FRAME_W32_WINDOW (f
))
1950 if (STRING_MULTIBYTE (name
))
1951 name
= ENCODE_SYSTEM (name
);
1954 SetWindowText (FRAME_W32_WINDOW (f
), SDATA (name
));
1959 /* This function should be called when the user's lisp code has
1960 specified a name for the frame; the name will override any set by the
1963 x_explicitly_set_name (f
, arg
, oldval
)
1965 Lisp_Object arg
, oldval
;
1967 x_set_name (f
, arg
, 1);
1970 /* This function should be called by Emacs redisplay code to set the
1971 name; names set this way will never override names set by the user's
1974 x_implicitly_set_name (f
, arg
, oldval
)
1976 Lisp_Object arg
, oldval
;
1978 x_set_name (f
, arg
, 0);
1981 /* Change the title of frame F to NAME.
1982 If NAME is nil, use the frame name as the title. */
1985 x_set_title (f
, name
, old_name
)
1987 Lisp_Object name
, old_name
;
1989 /* Don't change the title if it's already NAME. */
1990 if (EQ (name
, f
->title
))
1993 update_mode_lines
= 1;
2000 if (FRAME_W32_WINDOW (f
))
2002 if (STRING_MULTIBYTE (name
))
2003 name
= ENCODE_SYSTEM (name
);
2006 SetWindowText (FRAME_W32_WINDOW (f
), SDATA (name
));
2012 void x_set_scroll_bar_default_width (f
)
2015 int wid
= FRAME_COLUMN_WIDTH (f
);
2017 FRAME_CONFIG_SCROLL_BAR_WIDTH (f
) = GetSystemMetrics (SM_CXVSCROLL
);
2018 FRAME_CONFIG_SCROLL_BAR_COLS (f
) = (FRAME_CONFIG_SCROLL_BAR_WIDTH (f
) +
2023 /* Subroutines of creating a frame. */
2026 /* Return the value of parameter PARAM.
2028 First search ALIST, then Vdefault_frame_alist, then the X defaults
2029 database, using ATTRIBUTE as the attribute name and CLASS as its class.
2031 Convert the resource to the type specified by desired_type.
2033 If no default is specified, return Qunbound. If you call
2034 w32_get_arg, make sure you deal with Qunbound in a reasonable way,
2035 and don't let it get stored in any Lisp-visible variables! */
2038 w32_get_arg (alist
, param
, attribute
, class, type
)
2039 Lisp_Object alist
, param
;
2042 enum resource_types type
;
2044 return x_get_arg (check_x_display_info (Qnil
),
2045 alist
, param
, attribute
, class, type
);
2050 w32_load_cursor (LPCTSTR name
)
2052 /* Try first to load cursor from application resource. */
2053 Cursor cursor
= LoadImage ((HINSTANCE
) GetModuleHandle (NULL
),
2054 name
, IMAGE_CURSOR
, 0, 0,
2055 LR_DEFAULTCOLOR
| LR_DEFAULTSIZE
| LR_SHARED
);
2058 /* Then try to load a shared predefined cursor. */
2059 cursor
= LoadImage (NULL
, name
, IMAGE_CURSOR
, 0, 0,
2060 LR_DEFAULTCOLOR
| LR_DEFAULTSIZE
| LR_SHARED
);
2065 extern LRESULT CALLBACK
w32_wnd_proc ();
2068 w32_init_class (hinst
)
2073 wc
.style
= CS_HREDRAW
| CS_VREDRAW
;
2074 wc
.lpfnWndProc
= (WNDPROC
) w32_wnd_proc
;
2076 wc
.cbWndExtra
= WND_EXTRA_BYTES
;
2077 wc
.hInstance
= hinst
;
2078 wc
.hIcon
= LoadIcon (hinst
, EMACS_CLASS
);
2079 wc
.hCursor
= w32_load_cursor (IDC_ARROW
);
2080 wc
.hbrBackground
= NULL
; /* GetStockObject (WHITE_BRUSH); */
2081 wc
.lpszMenuName
= NULL
;
2082 wc
.lpszClassName
= EMACS_CLASS
;
2084 return (RegisterClass (&wc
));
2088 w32_createscrollbar (f
, bar
)
2090 struct scroll_bar
* bar
;
2092 return (CreateWindow ("SCROLLBAR", "", SBS_VERT
| WS_CHILD
| WS_VISIBLE
,
2093 /* Position and size of scroll bar. */
2094 XINT (bar
->left
) + VERTICAL_SCROLL_BAR_WIDTH_TRIM
,
2096 XINT (bar
->width
) - VERTICAL_SCROLL_BAR_WIDTH_TRIM
* 2,
2098 FRAME_W32_WINDOW (f
),
2105 w32_createwindow (f
)
2110 Lisp_Object top
= Qunbound
;
2111 Lisp_Object left
= Qunbound
;
2113 rect
.left
= rect
.top
= 0;
2114 rect
.right
= FRAME_PIXEL_WIDTH (f
);
2115 rect
.bottom
= FRAME_PIXEL_HEIGHT (f
);
2117 AdjustWindowRect (&rect
, f
->output_data
.w32
->dwStyle
,
2118 FRAME_EXTERNAL_MENU_BAR (f
));
2120 /* Do first time app init */
2124 w32_init_class (hinst
);
2127 if (f
->size_hint_flags
& USPosition
|| f
->size_hint_flags
& PPosition
)
2129 XSETINT (left
, f
->left_pos
);
2130 XSETINT (top
, f
->top_pos
);
2132 else if (EQ (left
, Qunbound
) && EQ (top
, Qunbound
))
2134 /* When called with RES_TYPE_NUMBER, w32_get_arg will return zero
2135 for anything that is not a number and is not Qunbound. */
2136 left
= w32_get_arg (Qnil
, Qleft
, "left", "Left", RES_TYPE_NUMBER
);
2137 top
= w32_get_arg (Qnil
, Qtop
, "top", "Top", RES_TYPE_NUMBER
);
2140 FRAME_W32_WINDOW (f
) = hwnd
2141 = CreateWindow (EMACS_CLASS
,
2143 f
->output_data
.w32
->dwStyle
| WS_CLIPCHILDREN
,
2144 EQ (left
, Qunbound
) ? CW_USEDEFAULT
: XINT (left
),
2145 EQ (top
, Qunbound
) ? CW_USEDEFAULT
: XINT (top
),
2146 rect
.right
- rect
.left
,
2147 rect
.bottom
- rect
.top
,
2155 SetWindowLong (hwnd
, WND_FONTWIDTH_INDEX
, FRAME_COLUMN_WIDTH (f
));
2156 SetWindowLong (hwnd
, WND_LINEHEIGHT_INDEX
, FRAME_LINE_HEIGHT (f
));
2157 SetWindowLong (hwnd
, WND_BORDER_INDEX
, FRAME_INTERNAL_BORDER_WIDTH (f
));
2158 SetWindowLong (hwnd
, WND_SCROLLBAR_INDEX
, f
->scroll_bar_actual_width
);
2159 SetWindowLong (hwnd
, WND_BACKGROUND_INDEX
, FRAME_BACKGROUND_PIXEL (f
));
2161 /* Enable drag-n-drop. */
2162 DragAcceptFiles (hwnd
, TRUE
);
2164 /* Do this to discard the default setting specified by our parent. */
2165 ShowWindow (hwnd
, SW_HIDE
);
2167 /* Update frame positions. */
2168 GetWindowRect (hwnd
, &rect
);
2169 f
->left_pos
= rect
.left
;
2170 f
->top_pos
= rect
.top
;
2175 my_post_msg (wmsg
, hwnd
, msg
, wParam
, lParam
)
2182 wmsg
->msg
.hwnd
= hwnd
;
2183 wmsg
->msg
.message
= msg
;
2184 wmsg
->msg
.wParam
= wParam
;
2185 wmsg
->msg
.lParam
= lParam
;
2186 wmsg
->msg
.time
= GetMessageTime ();
2191 /* GetKeyState and MapVirtualKey on Windows 95 do not actually distinguish
2192 between left and right keys as advertised. We test for this
2193 support dynamically, and set a flag when the support is absent. If
2194 absent, we keep track of the left and right control and alt keys
2195 ourselves. This is particularly necessary on keyboards that rely
2196 upon the AltGr key, which is represented as having the left control
2197 and right alt keys pressed. For these keyboards, we need to know
2198 when the left alt key has been pressed in addition to the AltGr key
2199 so that we can properly support M-AltGr-key sequences (such as M-@
2200 on Swedish keyboards). */
2202 #define EMACS_LCONTROL 0
2203 #define EMACS_RCONTROL 1
2204 #define EMACS_LMENU 2
2205 #define EMACS_RMENU 3
2207 static int modifiers
[4];
2208 static int modifiers_recorded
;
2209 static int modifier_key_support_tested
;
2212 test_modifier_support (unsigned int wparam
)
2216 if (wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
)
2218 if (wparam
== VK_CONTROL
)
2228 if (!(GetKeyState (l
) & 0x8000) && !(GetKeyState (r
) & 0x8000))
2229 modifiers_recorded
= 1;
2231 modifiers_recorded
= 0;
2232 modifier_key_support_tested
= 1;
2236 record_keydown (unsigned int wparam
, unsigned int lparam
)
2240 if (!modifier_key_support_tested
)
2241 test_modifier_support (wparam
);
2243 if ((wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
) || !modifiers_recorded
)
2246 if (wparam
== VK_CONTROL
)
2247 i
= (lparam
& 0x1000000) ? EMACS_RCONTROL
: EMACS_LCONTROL
;
2249 i
= (lparam
& 0x1000000) ? EMACS_RMENU
: EMACS_LMENU
;
2255 record_keyup (unsigned int wparam
, unsigned int lparam
)
2259 if ((wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
) || !modifiers_recorded
)
2262 if (wparam
== VK_CONTROL
)
2263 i
= (lparam
& 0x1000000) ? EMACS_RCONTROL
: EMACS_LCONTROL
;
2265 i
= (lparam
& 0x1000000) ? EMACS_RMENU
: EMACS_LMENU
;
2270 /* Emacs can lose focus while a modifier key has been pressed. When
2271 it regains focus, be conservative and clear all modifiers since
2272 we cannot reconstruct the left and right modifier state. */
2278 if (GetFocus () == NULL
)
2279 /* Emacs doesn't have keyboard focus. Do nothing. */
2282 ctrl
= GetAsyncKeyState (VK_CONTROL
);
2283 alt
= GetAsyncKeyState (VK_MENU
);
2285 if (!(ctrl
& 0x08000))
2286 /* Clear any recorded control modifier state. */
2287 modifiers
[EMACS_RCONTROL
] = modifiers
[EMACS_LCONTROL
] = 0;
2289 if (!(alt
& 0x08000))
2290 /* Clear any recorded alt modifier state. */
2291 modifiers
[EMACS_RMENU
] = modifiers
[EMACS_LMENU
] = 0;
2293 /* Update the state of all modifier keys, because modifiers used in
2294 hot-key combinations can get stuck on if Emacs loses focus as a
2295 result of a hot-key being pressed. */
2299 #define CURRENT_STATE(key) ((GetAsyncKeyState (key) & 0x8000) >> 8)
2301 GetKeyboardState (keystate
);
2302 keystate
[VK_SHIFT
] = CURRENT_STATE (VK_SHIFT
);
2303 keystate
[VK_CONTROL
] = CURRENT_STATE (VK_CONTROL
);
2304 keystate
[VK_LCONTROL
] = CURRENT_STATE (VK_LCONTROL
);
2305 keystate
[VK_RCONTROL
] = CURRENT_STATE (VK_RCONTROL
);
2306 keystate
[VK_MENU
] = CURRENT_STATE (VK_MENU
);
2307 keystate
[VK_LMENU
] = CURRENT_STATE (VK_LMENU
);
2308 keystate
[VK_RMENU
] = CURRENT_STATE (VK_RMENU
);
2309 keystate
[VK_LWIN
] = CURRENT_STATE (VK_LWIN
);
2310 keystate
[VK_RWIN
] = CURRENT_STATE (VK_RWIN
);
2311 keystate
[VK_APPS
] = CURRENT_STATE (VK_APPS
);
2312 SetKeyboardState (keystate
);
2316 /* Synchronize modifier state with what is reported with the current
2317 keystroke. Even if we cannot distinguish between left and right
2318 modifier keys, we know that, if no modifiers are set, then neither
2319 the left or right modifier should be set. */
2323 if (!modifiers_recorded
)
2326 if (!(GetKeyState (VK_CONTROL
) & 0x8000))
2327 modifiers
[EMACS_RCONTROL
] = modifiers
[EMACS_LCONTROL
] = 0;
2329 if (!(GetKeyState (VK_MENU
) & 0x8000))
2330 modifiers
[EMACS_RMENU
] = modifiers
[EMACS_LMENU
] = 0;
2334 modifier_set (int vkey
)
2336 if (vkey
== VK_CAPITAL
|| vkey
== VK_SCROLL
)
2337 return (GetKeyState (vkey
) & 0x1);
2338 if (!modifiers_recorded
)
2339 return (GetKeyState (vkey
) & 0x8000);
2344 return modifiers
[EMACS_LCONTROL
];
2346 return modifiers
[EMACS_RCONTROL
];
2348 return modifiers
[EMACS_LMENU
];
2350 return modifiers
[EMACS_RMENU
];
2352 return (GetKeyState (vkey
) & 0x8000);
2355 /* Convert between the modifier bits W32 uses and the modifier bits
2359 w32_key_to_modifier (int key
)
2361 Lisp_Object key_mapping
;
2366 key_mapping
= Vw32_lwindow_modifier
;
2369 key_mapping
= Vw32_rwindow_modifier
;
2372 key_mapping
= Vw32_apps_modifier
;
2375 key_mapping
= Vw32_scroll_lock_modifier
;
2381 /* NB. This code runs in the input thread, asychronously to the lisp
2382 thread, so we must be careful to ensure access to lisp data is
2383 thread-safe. The following code is safe because the modifier
2384 variable values are updated atomically from lisp and symbols are
2385 not relocated by GC. Also, we don't have to worry about seeing GC
2387 if (EQ (key_mapping
, Qhyper
))
2388 return hyper_modifier
;
2389 if (EQ (key_mapping
, Qsuper
))
2390 return super_modifier
;
2391 if (EQ (key_mapping
, Qmeta
))
2392 return meta_modifier
;
2393 if (EQ (key_mapping
, Qalt
))
2394 return alt_modifier
;
2395 if (EQ (key_mapping
, Qctrl
))
2396 return ctrl_modifier
;
2397 if (EQ (key_mapping
, Qcontrol
)) /* synonym for ctrl */
2398 return ctrl_modifier
;
2399 if (EQ (key_mapping
, Qshift
))
2400 return shift_modifier
;
2402 /* Don't generate any modifier if not explicitly requested. */
2407 w32_get_modifiers ()
2409 return ((modifier_set (VK_SHIFT
) ? shift_modifier
: 0) |
2410 (modifier_set (VK_CONTROL
) ? ctrl_modifier
: 0) |
2411 (modifier_set (VK_LWIN
) ? w32_key_to_modifier (VK_LWIN
) : 0) |
2412 (modifier_set (VK_RWIN
) ? w32_key_to_modifier (VK_RWIN
) : 0) |
2413 (modifier_set (VK_APPS
) ? w32_key_to_modifier (VK_APPS
) : 0) |
2414 (modifier_set (VK_SCROLL
) ? w32_key_to_modifier (VK_SCROLL
) : 0) |
2415 (modifier_set (VK_MENU
) ?
2416 ((NILP (Vw32_alt_is_meta
)) ? alt_modifier
: meta_modifier
) : 0));
2419 /* We map the VK_* modifiers into console modifier constants
2420 so that we can use the same routines to handle both console
2421 and window input. */
2424 construct_console_modifiers ()
2429 mods
|= (modifier_set (VK_SHIFT
)) ? SHIFT_PRESSED
: 0;
2430 mods
|= (modifier_set (VK_CAPITAL
)) ? CAPSLOCK_ON
: 0;
2431 mods
|= (modifier_set (VK_SCROLL
)) ? SCROLLLOCK_ON
: 0;
2432 mods
|= (modifier_set (VK_NUMLOCK
)) ? NUMLOCK_ON
: 0;
2433 mods
|= (modifier_set (VK_LCONTROL
)) ? LEFT_CTRL_PRESSED
: 0;
2434 mods
|= (modifier_set (VK_RCONTROL
)) ? RIGHT_CTRL_PRESSED
: 0;
2435 mods
|= (modifier_set (VK_LMENU
)) ? LEFT_ALT_PRESSED
: 0;
2436 mods
|= (modifier_set (VK_RMENU
)) ? RIGHT_ALT_PRESSED
: 0;
2437 mods
|= (modifier_set (VK_LWIN
)) ? LEFT_WIN_PRESSED
: 0;
2438 mods
|= (modifier_set (VK_RWIN
)) ? RIGHT_WIN_PRESSED
: 0;
2439 mods
|= (modifier_set (VK_APPS
)) ? APPS_PRESSED
: 0;
2445 w32_get_key_modifiers (unsigned int wparam
, unsigned int lparam
)
2449 /* Convert to emacs modifiers. */
2450 mods
= w32_kbd_mods_to_emacs (construct_console_modifiers (), wparam
);
2456 map_keypad_keys (unsigned int virt_key
, unsigned int extended
)
2458 if (virt_key
< VK_CLEAR
|| virt_key
> VK_DELETE
)
2461 if (virt_key
== VK_RETURN
)
2462 return (extended
? VK_NUMPAD_ENTER
: VK_RETURN
);
2464 if (virt_key
>= VK_PRIOR
&& virt_key
<= VK_DOWN
)
2465 return (!extended
? (VK_NUMPAD_PRIOR
+ (virt_key
- VK_PRIOR
)) : virt_key
);
2467 if (virt_key
== VK_INSERT
|| virt_key
== VK_DELETE
)
2468 return (!extended
? (VK_NUMPAD_INSERT
+ (virt_key
- VK_INSERT
)) : virt_key
);
2470 if (virt_key
== VK_CLEAR
)
2471 return (!extended
? VK_NUMPAD_CLEAR
: virt_key
);
2476 /* List of special key combinations which w32 would normally capture,
2477 but Emacs should grab instead. Not directly visible to lisp, to
2478 simplify synchronization. Each item is an integer encoding a virtual
2479 key code and modifier combination to capture. */
2480 static Lisp_Object w32_grabbed_keys
;
2482 #define HOTKEY(vk, mods) make_number (((vk) & 255) | ((mods) << 8))
2483 #define HOTKEY_ID(k) (XFASTINT (k) & 0xbfff)
2484 #define HOTKEY_VK_CODE(k) (XFASTINT (k) & 255)
2485 #define HOTKEY_MODIFIERS(k) (XFASTINT (k) >> 8)
2487 #define RAW_HOTKEY_ID(k) ((k) & 0xbfff)
2488 #define RAW_HOTKEY_VK_CODE(k) ((k) & 255)
2489 #define RAW_HOTKEY_MODIFIERS(k) ((k) >> 8)
2491 /* Register hot-keys for reserved key combinations when Emacs has
2492 keyboard focus, since this is the only way Emacs can receive key
2493 combinations like Alt-Tab which are used by the system. */
2496 register_hot_keys (hwnd
)
2499 Lisp_Object keylist
;
2501 /* Use CONSP, since we are called asynchronously. */
2502 for (keylist
= w32_grabbed_keys
; CONSP (keylist
); keylist
= XCDR (keylist
))
2504 Lisp_Object key
= XCAR (keylist
);
2506 /* Deleted entries get set to nil. */
2507 if (!INTEGERP (key
))
2510 RegisterHotKey (hwnd
, HOTKEY_ID (key
),
2511 HOTKEY_MODIFIERS (key
), HOTKEY_VK_CODE (key
));
2516 unregister_hot_keys (hwnd
)
2519 Lisp_Object keylist
;
2521 for (keylist
= w32_grabbed_keys
; CONSP (keylist
); keylist
= XCDR (keylist
))
2523 Lisp_Object key
= XCAR (keylist
);
2525 if (!INTEGERP (key
))
2528 UnregisterHotKey (hwnd
, HOTKEY_ID (key
));
2532 /* Main message dispatch loop. */
2535 w32_msg_pump (deferred_msg
* msg_buf
)
2541 msh_mousewheel
= RegisterWindowMessage (MSH_MOUSEWHEEL
);
2543 while (GetMessage (&msg
, NULL
, 0, 0))
2545 if (msg
.hwnd
== NULL
)
2547 switch (msg
.message
)
2550 /* Produced by complete_deferred_msg; just ignore. */
2552 case WM_EMACS_CREATEWINDOW
:
2553 /* Initialize COM for this window. Even though we don't use it,
2554 some third party shell extensions can cause it to be used in
2555 system dialogs, which causes a crash if it is not initialized.
2556 This is a known bug in Windows, which was fixed long ago, but
2557 the patch for XP is not publically available until XP SP3,
2558 and older versions will never be patched. */
2559 CoInitialize (NULL
);
2560 w32_createwindow ((struct frame
*) msg
.wParam
);
2561 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
, 0, 0))
2564 case WM_EMACS_SETLOCALE
:
2565 SetThreadLocale (msg
.wParam
);
2566 /* Reply is not expected. */
2568 case WM_EMACS_SETKEYBOARDLAYOUT
:
2569 result
= (int) ActivateKeyboardLayout ((HKL
) msg
.wParam
, 0);
2570 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
,
2574 case WM_EMACS_REGISTER_HOT_KEY
:
2575 focus_window
= GetFocus ();
2576 if (focus_window
!= NULL
)
2577 RegisterHotKey (focus_window
,
2578 RAW_HOTKEY_ID (msg
.wParam
),
2579 RAW_HOTKEY_MODIFIERS (msg
.wParam
),
2580 RAW_HOTKEY_VK_CODE (msg
.wParam
));
2581 /* Reply is not expected. */
2583 case WM_EMACS_UNREGISTER_HOT_KEY
:
2584 focus_window
= GetFocus ();
2585 if (focus_window
!= NULL
)
2586 UnregisterHotKey (focus_window
, RAW_HOTKEY_ID (msg
.wParam
));
2587 /* Mark item as erased. NB: this code must be
2588 thread-safe. The next line is okay because the cons
2589 cell is never made into garbage and is not relocated by
2591 XSETCAR ((Lisp_Object
) ((EMACS_INT
) msg
.lParam
), Qnil
);
2592 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
, 0, 0))
2595 case WM_EMACS_TOGGLE_LOCK_KEY
:
2597 int vk_code
= (int) msg
.wParam
;
2598 int cur_state
= (GetKeyState (vk_code
) & 1);
2599 Lisp_Object new_state
= (Lisp_Object
) ((EMACS_INT
) msg
.lParam
);
2601 /* NB: This code must be thread-safe. It is safe to
2602 call NILP because symbols are not relocated by GC,
2603 and pointer here is not touched by GC (so the markbit
2604 can't be set). Numbers are safe because they are
2605 immediate values. */
2606 if (NILP (new_state
)
2607 || (NUMBERP (new_state
)
2608 && ((XUINT (new_state
)) & 1) != cur_state
))
2610 one_w32_display_info
.faked_key
= vk_code
;
2612 keybd_event ((BYTE
) vk_code
,
2613 (BYTE
) MapVirtualKey (vk_code
, 0),
2614 KEYEVENTF_EXTENDEDKEY
| KEYEVENTF_KEYUP
, 0);
2615 keybd_event ((BYTE
) vk_code
,
2616 (BYTE
) MapVirtualKey (vk_code
, 0),
2617 KEYEVENTF_EXTENDEDKEY
| 0, 0);
2618 keybd_event ((BYTE
) vk_code
,
2619 (BYTE
) MapVirtualKey (vk_code
, 0),
2620 KEYEVENTF_EXTENDEDKEY
| KEYEVENTF_KEYUP
, 0);
2621 cur_state
= !cur_state
;
2623 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
,
2629 /* Broadcast messages make it here, so you need to be looking
2630 for something in particular for this to be useful. */
2632 DebPrint (("msg %x not expected by w32_msg_pump\n", msg
.message
));
2638 DispatchMessage (&msg
);
2641 /* Exit nested loop when our deferred message has completed. */
2642 if (msg_buf
->completed
)
2647 deferred_msg
* deferred_msg_head
;
2649 static deferred_msg
*
2650 find_deferred_msg (HWND hwnd
, UINT msg
)
2652 deferred_msg
* item
;
2654 /* Don't actually need synchronization for read access, since
2655 modification of single pointer is always atomic. */
2656 /* enter_crit (); */
2658 for (item
= deferred_msg_head
; item
!= NULL
; item
= item
->next
)
2659 if (item
->w32msg
.msg
.hwnd
== hwnd
2660 && item
->w32msg
.msg
.message
== msg
)
2663 /* leave_crit (); */
2669 send_deferred_msg (deferred_msg
* msg_buf
,
2675 /* Only input thread can send deferred messages. */
2676 if (GetCurrentThreadId () != dwWindowsThreadId
)
2679 /* It is an error to send a message that is already deferred. */
2680 if (find_deferred_msg (hwnd
, msg
) != NULL
)
2683 /* Enforced synchronization is not needed because this is the only
2684 function that alters deferred_msg_head, and the following critical
2685 section is guaranteed to only be serially reentered (since only the
2686 input thread can call us). */
2688 /* enter_crit (); */
2690 msg_buf
->completed
= 0;
2691 msg_buf
->next
= deferred_msg_head
;
2692 deferred_msg_head
= msg_buf
;
2693 my_post_msg (&msg_buf
->w32msg
, hwnd
, msg
, wParam
, lParam
);
2695 /* leave_crit (); */
2697 /* Start a new nested message loop to process other messages until
2698 this one is completed. */
2699 w32_msg_pump (msg_buf
);
2701 deferred_msg_head
= msg_buf
->next
;
2703 return msg_buf
->result
;
2707 complete_deferred_msg (HWND hwnd
, UINT msg
, LRESULT result
)
2709 deferred_msg
* msg_buf
= find_deferred_msg (hwnd
, msg
);
2711 if (msg_buf
== NULL
)
2712 /* Message may have been cancelled, so don't abort. */
2715 msg_buf
->result
= result
;
2716 msg_buf
->completed
= 1;
2718 /* Ensure input thread is woken so it notices the completion. */
2719 PostThreadMessage (dwWindowsThreadId
, WM_NULL
, 0, 0);
2723 cancel_all_deferred_msgs ()
2725 deferred_msg
* item
;
2727 /* Don't actually need synchronization for read access, since
2728 modification of single pointer is always atomic. */
2729 /* enter_crit (); */
2731 for (item
= deferred_msg_head
; item
!= NULL
; item
= item
->next
)
2734 item
->completed
= 1;
2737 /* leave_crit (); */
2739 /* Ensure input thread is woken so it notices the completion. */
2740 PostThreadMessage (dwWindowsThreadId
, WM_NULL
, 0, 0);
2744 w32_msg_worker (void *arg
)
2747 deferred_msg dummy_buf
;
2749 /* Ensure our message queue is created */
2751 PeekMessage (&msg
, NULL
, 0, 0, PM_NOREMOVE
);
2753 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
, 0, 0))
2756 memset (&dummy_buf
, 0, sizeof (dummy_buf
));
2757 dummy_buf
.w32msg
.msg
.hwnd
= NULL
;
2758 dummy_buf
.w32msg
.msg
.message
= WM_NULL
;
2760 /* This is the initial message loop which should only exit when the
2761 application quits. */
2762 w32_msg_pump (&dummy_buf
);
2768 signal_user_input ()
2770 /* Interrupt any lisp that wants to be interrupted by input. */
2771 if (!NILP (Vthrow_on_input
))
2773 Vquit_flag
= Vthrow_on_input
;
2774 /* If we're inside a function that wants immediate quits,
2776 if (immediate_quit
&& NILP (Vinhibit_quit
))
2786 post_character_message (hwnd
, msg
, wParam
, lParam
, modifiers
)
2796 wmsg
.dwModifiers
= modifiers
;
2798 /* Detect quit_char and set quit-flag directly. Note that we
2799 still need to post a message to ensure the main thread will be
2800 woken up if blocked in sys_select, but we do NOT want to post
2801 the quit_char message itself (because it will usually be as if
2802 the user had typed quit_char twice). Instead, we post a dummy
2803 message that has no particular effect. */
2806 if (isalpha (c
) && wmsg
.dwModifiers
== ctrl_modifier
)
2807 c
= make_ctrl_char (c
) & 0377;
2809 || (wmsg
.dwModifiers
== 0 &&
2810 w32_quit_key
&& wParam
== w32_quit_key
))
2814 /* The choice of message is somewhat arbitrary, as long as
2815 the main thread handler just ignores it. */
2818 /* Interrupt any blocking system calls. */
2821 /* As a safety precaution, forcibly complete any deferred
2822 messages. This is a kludge, but I don't see any particularly
2823 clean way to handle the situation where a deferred message is
2824 "dropped" in the lisp thread, and will thus never be
2825 completed, eg. by the user trying to activate the menubar
2826 when the lisp thread is busy, and then typing C-g when the
2827 menubar doesn't open promptly (with the result that the
2828 menubar never responds at all because the deferred
2829 WM_INITMENU message is never completed). Another problem
2830 situation is when the lisp thread calls SendMessage (to send
2831 a window manager command) when a message has been deferred;
2832 the lisp thread gets blocked indefinitely waiting for the
2833 deferred message to be completed, which itself is waiting for
2834 the lisp thread to respond.
2836 Note that we don't want to block the input thread waiting for
2837 a reponse from the lisp thread (although that would at least
2838 solve the deadlock problem above), because we want to be able
2839 to receive C-g to interrupt the lisp thread. */
2840 cancel_all_deferred_msgs ();
2843 signal_user_input ();
2846 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
2849 /* Main window procedure */
2852 w32_wnd_proc (hwnd
, msg
, wParam
, lParam
)
2859 struct w32_display_info
*dpyinfo
= &one_w32_display_info
;
2861 int windows_translate
;
2864 /* Note that it is okay to call x_window_to_frame, even though we are
2865 not running in the main lisp thread, because frame deletion
2866 requires the lisp thread to synchronize with this thread. Thus, if
2867 a frame struct is returned, it can be used without concern that the
2868 lisp thread might make it disappear while we are using it.
2870 NB. Walking the frame list in this thread is safe (as long as
2871 writes of Lisp_Object slots are atomic, which they are on Windows).
2872 Although delete-frame can destructively modify the frame list while
2873 we are walking it, a garbage collection cannot occur until after
2874 delete-frame has synchronized with this thread.
2876 It is also safe to use functions that make GDI calls, such as
2877 w32_clear_rect, because these functions must obtain a DC handle
2878 from the frame struct using get_frame_dc which is thread-aware. */
2883 f
= x_window_to_frame (dpyinfo
, hwnd
);
2886 HDC hdc
= get_frame_dc (f
);
2887 GetUpdateRect (hwnd
, &wmsg
.rect
, FALSE
);
2888 w32_clear_rect (f
, hdc
, &wmsg
.rect
);
2889 release_frame_dc (f
, hdc
);
2891 #if defined (W32_DEBUG_DISPLAY)
2892 DebPrint (("WM_ERASEBKGND (frame %p): erasing %d,%d-%d,%d\n",
2894 wmsg
.rect
.left
, wmsg
.rect
.top
,
2895 wmsg
.rect
.right
, wmsg
.rect
.bottom
));
2896 #endif /* W32_DEBUG_DISPLAY */
2899 case WM_PALETTECHANGED
:
2900 /* ignore our own changes */
2901 if ((HWND
)wParam
!= hwnd
)
2903 f
= x_window_to_frame (dpyinfo
, hwnd
);
2905 /* get_frame_dc will realize our palette and force all
2906 frames to be redrawn if needed. */
2907 release_frame_dc (f
, get_frame_dc (f
));
2912 PAINTSTRUCT paintStruct
;
2914 bzero (&update_rect
, sizeof (update_rect
));
2916 f
= x_window_to_frame (dpyinfo
, hwnd
);
2919 DebPrint (("WM_PAINT received for unknown window %p\n", hwnd
));
2923 /* MSDN Docs say not to call BeginPaint if GetUpdateRect
2924 fails. Apparently this can happen under some
2926 if (GetUpdateRect (hwnd
, &update_rect
, FALSE
) || !w32_strict_painting
)
2929 BeginPaint (hwnd
, &paintStruct
);
2931 /* The rectangles returned by GetUpdateRect and BeginPaint
2932 do not always match. Play it safe by assuming both areas
2934 UnionRect (&(wmsg
.rect
), &update_rect
, &(paintStruct
.rcPaint
));
2936 #if defined (W32_DEBUG_DISPLAY)
2937 DebPrint (("WM_PAINT (frame %p): painting %d,%d-%d,%d\n",
2939 wmsg
.rect
.left
, wmsg
.rect
.top
,
2940 wmsg
.rect
.right
, wmsg
.rect
.bottom
));
2941 DebPrint ((" [update region is %d,%d-%d,%d]\n",
2942 update_rect
.left
, update_rect
.top
,
2943 update_rect
.right
, update_rect
.bottom
));
2945 EndPaint (hwnd
, &paintStruct
);
2948 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
2953 /* If GetUpdateRect returns 0 (meaning there is no update
2954 region), assume the whole window needs to be repainted. */
2955 GetClientRect (hwnd
, &wmsg
.rect
);
2956 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
2960 case WM_INPUTLANGCHANGE
:
2961 /* Inform lisp thread of keyboard layout changes. */
2962 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
2964 /* Clear dead keys in the keyboard state; for simplicity only
2965 preserve modifier key states. */
2970 GetKeyboardState (keystate
);
2971 for (i
= 0; i
< 256; i
++)
2988 SetKeyboardState (keystate
);
2993 /* Synchronize hot keys with normal input. */
2994 PostMessage (hwnd
, WM_KEYDOWN
, HIWORD (lParam
), 0);
2999 record_keyup (wParam
, lParam
);
3004 /* Ignore keystrokes we fake ourself; see below. */
3005 if (dpyinfo
->faked_key
== wParam
)
3007 dpyinfo
->faked_key
= 0;
3008 /* Make sure TranslateMessage sees them though (as long as
3009 they don't produce WM_CHAR messages). This ensures that
3010 indicator lights are toggled promptly on Windows 9x, for
3012 if (wParam
< 256 && lispy_function_keys
[wParam
])
3014 windows_translate
= 1;
3020 /* Synchronize modifiers with current keystroke. */
3022 record_keydown (wParam
, lParam
);
3023 wParam
= map_keypad_keys (wParam
, (lParam
& 0x1000000L
) != 0);
3025 windows_translate
= 0;
3030 if (NILP (Vw32_pass_lwindow_to_system
))
3032 /* Prevent system from acting on keyup (which opens the
3033 Start menu if no other key was pressed) by simulating a
3034 press of Space which we will ignore. */
3035 if (GetAsyncKeyState (wParam
) & 1)
3037 if (NUMBERP (Vw32_phantom_key_code
))
3038 key
= XUINT (Vw32_phantom_key_code
) & 255;
3041 dpyinfo
->faked_key
= key
;
3042 keybd_event (key
, (BYTE
) MapVirtualKey (key
, 0), 0, 0);
3045 if (!NILP (Vw32_lwindow_modifier
))
3049 if (NILP (Vw32_pass_rwindow_to_system
))
3051 if (GetAsyncKeyState (wParam
) & 1)
3053 if (NUMBERP (Vw32_phantom_key_code
))
3054 key
= XUINT (Vw32_phantom_key_code
) & 255;
3057 dpyinfo
->faked_key
= key
;
3058 keybd_event (key
, (BYTE
) MapVirtualKey (key
, 0), 0, 0);
3061 if (!NILP (Vw32_rwindow_modifier
))
3065 if (!NILP (Vw32_apps_modifier
))
3069 if (NILP (Vw32_pass_alt_to_system
))
3070 /* Prevent DefWindowProc from activating the menu bar if an
3071 Alt key is pressed and released by itself. */
3073 windows_translate
= 1;
3076 /* Decide whether to treat as modifier or function key. */
3077 if (NILP (Vw32_enable_caps_lock
))
3078 goto disable_lock_key
;
3079 windows_translate
= 1;
3082 /* Decide whether to treat as modifier or function key. */
3083 if (NILP (Vw32_enable_num_lock
))
3084 goto disable_lock_key
;
3085 windows_translate
= 1;
3088 /* Decide whether to treat as modifier or function key. */
3089 if (NILP (Vw32_scroll_lock_modifier
))
3090 goto disable_lock_key
;
3091 windows_translate
= 1;
3094 /* Ensure the appropriate lock key state (and indicator light)
3095 remains in the same state. We do this by faking another
3096 press of the relevant key. Apparently, this really is the
3097 only way to toggle the state of the indicator lights. */
3098 dpyinfo
->faked_key
= wParam
;
3099 keybd_event ((BYTE
) wParam
, (BYTE
) MapVirtualKey (wParam
, 0),
3100 KEYEVENTF_EXTENDEDKEY
| KEYEVENTF_KEYUP
, 0);
3101 keybd_event ((BYTE
) wParam
, (BYTE
) MapVirtualKey (wParam
, 0),
3102 KEYEVENTF_EXTENDEDKEY
| 0, 0);
3103 keybd_event ((BYTE
) wParam
, (BYTE
) MapVirtualKey (wParam
, 0),
3104 KEYEVENTF_EXTENDEDKEY
| KEYEVENTF_KEYUP
, 0);
3105 /* Ensure indicator lights are updated promptly on Windows 9x
3106 (TranslateMessage apparently does this), after forwarding
3108 post_character_message (hwnd
, msg
, wParam
, lParam
,
3109 w32_get_key_modifiers (wParam
, lParam
));
3110 windows_translate
= 1;
3114 case VK_PROCESSKEY
: /* Generated by IME. */
3115 windows_translate
= 1;
3118 /* Windows maps Ctrl-Pause (aka Ctrl-Break) into VK_CANCEL,
3119 which is confusing for purposes of key binding; convert
3120 VK_CANCEL events into VK_PAUSE events. */
3124 /* Windows maps Ctrl-NumLock into VK_PAUSE, which is confusing
3125 for purposes of key binding; convert these back into
3126 VK_NUMLOCK events, at least when we want to see NumLock key
3127 presses. (Note that there is never any possibility that
3128 VK_PAUSE with Ctrl really is C-Pause as per above.) */
3129 if (NILP (Vw32_enable_num_lock
) && modifier_set (VK_CONTROL
))
3130 wParam
= VK_NUMLOCK
;
3133 /* If not defined as a function key, change it to a WM_CHAR message. */
3134 if (wParam
> 255 || !lispy_function_keys
[wParam
])
3136 DWORD modifiers
= construct_console_modifiers ();
3138 if (!NILP (Vw32_recognize_altgr
)
3139 && modifier_set (VK_LCONTROL
) && modifier_set (VK_RMENU
))
3141 /* Always let TranslateMessage handle AltGr key chords;
3142 for some reason, ToAscii doesn't always process AltGr
3143 chords correctly. */
3144 windows_translate
= 1;
3146 else if ((modifiers
& (~SHIFT_PRESSED
& ~CAPSLOCK_ON
)) != 0)
3148 /* Handle key chords including any modifiers other
3149 than shift directly, in order to preserve as much
3150 modifier information as possible. */
3151 if ('A' <= wParam
&& wParam
<= 'Z')
3153 /* Don't translate modified alphabetic keystrokes,
3154 so the user doesn't need to constantly switch
3155 layout to type control or meta keystrokes when
3156 the normal layout translates alphabetic
3157 characters to non-ascii characters. */
3158 if (!modifier_set (VK_SHIFT
))
3159 wParam
+= ('a' - 'A');
3164 /* Try to handle other keystrokes by determining the
3165 base character (ie. translating the base key plus
3169 KEY_EVENT_RECORD key
;
3171 key
.bKeyDown
= TRUE
;
3172 key
.wRepeatCount
= 1;
3173 key
.wVirtualKeyCode
= wParam
;
3174 key
.wVirtualScanCode
= (lParam
& 0xFF0000) >> 16;
3175 key
.uChar
.AsciiChar
= 0;
3176 key
.dwControlKeyState
= modifiers
;
3178 add
= w32_kbd_patch_key (&key
);
3179 /* 0 means an unrecognised keycode, negative means
3180 dead key. Ignore both. */
3183 /* Forward asciified character sequence. */
3184 post_character_message
3186 (unsigned char) key
.uChar
.AsciiChar
, lParam
,
3187 w32_get_key_modifiers (wParam
, lParam
));
3188 w32_kbd_patch_key (&key
);
3195 /* Let TranslateMessage handle everything else. */
3196 windows_translate
= 1;
3202 if (windows_translate
)
3204 MSG windows_msg
= { hwnd
, msg
, wParam
, lParam
, 0, {0,0} };
3205 windows_msg
.time
= GetMessageTime ();
3206 TranslateMessage (&windows_msg
);
3214 post_character_message (hwnd
, msg
, wParam
, lParam
,
3215 w32_get_key_modifiers (wParam
, lParam
));
3219 /* WM_UNICHAR looks promising from the docs, but the exact
3220 circumstances in which TranslateMessage sends it is one of those
3221 Microsoft secret API things that EU and US courts are supposed
3222 to have put a stop to already. Spy++ shows it being sent to Notepad
3223 and other MS apps, but never to Emacs.
3225 Some third party IMEs send it in accordance with the official
3226 documentation though, so handle it here.
3228 UNICODE_NOCHAR is used to test for support for this message.
3229 TRUE indicates that the message is supported. */
3230 if (wParam
== UNICODE_NOCHAR
)
3235 wmsg
.dwModifiers
= w32_get_key_modifiers (wParam
, lParam
);
3236 signal_user_input ();
3237 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3242 /* If we can't get the IME result as unicode, use default processing,
3243 which will at least allow characters decodable in the system locale
3245 if (!get_composition_string_fn
)
3248 else if (!ignore_ime_char
)
3253 HIMC context
= get_ime_context_fn (hwnd
);
3254 wmsg
.dwModifiers
= w32_get_key_modifiers (wParam
, lParam
);
3255 /* Get buffer size. */
3256 size
= get_composition_string_fn (context
, GCS_RESULTSTR
, buffer
, 0);
3257 buffer
= alloca(size
);
3258 size
= get_composition_string_fn (context
, GCS_RESULTSTR
,
3260 signal_user_input ();
3261 for (i
= 0; i
< size
/ sizeof (wchar_t); i
++)
3263 my_post_msg (&wmsg
, hwnd
, WM_UNICHAR
, (WPARAM
) buffer
[i
],
3266 /* We output the whole string above, so ignore following ones
3267 until we are notified of the end of composition. */
3268 ignore_ime_char
= 1;
3272 case WM_IME_ENDCOMPOSITION
:
3273 ignore_ime_char
= 0;
3276 /* Simulate middle mouse button events when left and right buttons
3277 are used together, but only if user has two button mouse. */
3278 case WM_LBUTTONDOWN
:
3279 case WM_RBUTTONDOWN
:
3280 if (w32_num_mouse_buttons
> 2)
3281 goto handle_plain_button
;
3284 int this = (msg
== WM_LBUTTONDOWN
) ? LMOUSE
: RMOUSE
;
3285 int other
= (msg
== WM_LBUTTONDOWN
) ? RMOUSE
: LMOUSE
;
3287 if (button_state
& this)
3290 if (button_state
== 0)
3293 button_state
|= this;
3295 if (button_state
& other
)
3297 if (mouse_button_timer
)
3299 KillTimer (hwnd
, mouse_button_timer
);
3300 mouse_button_timer
= 0;
3302 /* Generate middle mouse event instead. */
3303 msg
= WM_MBUTTONDOWN
;
3304 button_state
|= MMOUSE
;
3306 else if (button_state
& MMOUSE
)
3308 /* Ignore button event if we've already generated a
3309 middle mouse down event. This happens if the
3310 user releases and press one of the two buttons
3311 after we've faked a middle mouse event. */
3316 /* Flush out saved message. */
3317 post_msg (&saved_mouse_button_msg
);
3319 wmsg
.dwModifiers
= w32_get_modifiers ();
3320 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3321 signal_user_input ();
3323 /* Clear message buffer. */
3324 saved_mouse_button_msg
.msg
.hwnd
= 0;
3328 /* Hold onto message for now. */
3329 mouse_button_timer
=
3330 SetTimer (hwnd
, MOUSE_BUTTON_ID
,
3331 w32_mouse_button_tolerance
, NULL
);
3332 saved_mouse_button_msg
.msg
.hwnd
= hwnd
;
3333 saved_mouse_button_msg
.msg
.message
= msg
;
3334 saved_mouse_button_msg
.msg
.wParam
= wParam
;
3335 saved_mouse_button_msg
.msg
.lParam
= lParam
;
3336 saved_mouse_button_msg
.msg
.time
= GetMessageTime ();
3337 saved_mouse_button_msg
.dwModifiers
= w32_get_modifiers ();
3344 if (w32_num_mouse_buttons
> 2)
3345 goto handle_plain_button
;
3348 int this = (msg
== WM_LBUTTONUP
) ? LMOUSE
: RMOUSE
;
3349 int other
= (msg
== WM_LBUTTONUP
) ? RMOUSE
: LMOUSE
;
3351 if ((button_state
& this) == 0)
3354 button_state
&= ~this;
3356 if (button_state
& MMOUSE
)
3358 /* Only generate event when second button is released. */
3359 if ((button_state
& other
) == 0)
3362 button_state
&= ~MMOUSE
;
3364 if (button_state
) abort ();
3371 /* Flush out saved message if necessary. */
3372 if (saved_mouse_button_msg
.msg
.hwnd
)
3374 post_msg (&saved_mouse_button_msg
);
3377 wmsg
.dwModifiers
= w32_get_modifiers ();
3378 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3379 signal_user_input ();
3381 /* Always clear message buffer and cancel timer. */
3382 saved_mouse_button_msg
.msg
.hwnd
= 0;
3383 KillTimer (hwnd
, mouse_button_timer
);
3384 mouse_button_timer
= 0;
3386 if (button_state
== 0)
3391 case WM_XBUTTONDOWN
:
3393 if (w32_pass_extra_mouse_buttons_to_system
)
3395 /* else fall through and process them. */
3396 case WM_MBUTTONDOWN
:
3398 handle_plain_button
:
3403 /* Ignore middle and extra buttons as long as the menu is active. */
3404 f
= x_window_to_frame (dpyinfo
, hwnd
);
3405 if (f
&& f
->output_data
.w32
->menubar_active
)
3408 if (parse_button (msg
, HIWORD (wParam
), &button
, &up
))
3410 if (up
) ReleaseCapture ();
3411 else SetCapture (hwnd
);
3412 button
= (button
== 0) ? LMOUSE
:
3413 ((button
== 1) ? MMOUSE
: RMOUSE
);
3415 button_state
&= ~button
;
3417 button_state
|= button
;
3421 wmsg
.dwModifiers
= w32_get_modifiers ();
3422 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3423 signal_user_input ();
3425 /* Need to return true for XBUTTON messages, false for others,
3426 to indicate that we processed the message. */
3427 return (msg
== WM_XBUTTONDOWN
|| msg
== WM_XBUTTONUP
);
3430 /* Ignore mouse movements as long as the menu is active. These
3431 movements are processed by the window manager anyway, and
3432 it's wrong to handle them as if they happened on the
3433 underlying frame. */
3434 f
= x_window_to_frame (dpyinfo
, hwnd
);
3435 if (f
&& f
->output_data
.w32
->menubar_active
)
3438 /* If the mouse has just moved into the frame, start tracking
3439 it, so we will be notified when it leaves the frame. Mouse
3440 tracking only works under W98 and NT4 and later. On earlier
3441 versions, there is no way of telling when the mouse leaves the
3442 frame, so we just have to put up with help-echo and mouse
3443 highlighting remaining while the frame is not active. */
3444 if (track_mouse_event_fn
&& !track_mouse_window
)
3446 TRACKMOUSEEVENT tme
;
3447 tme
.cbSize
= sizeof (tme
);
3448 tme
.dwFlags
= TME_LEAVE
;
3449 tme
.hwndTrack
= hwnd
;
3451 track_mouse_event_fn (&tme
);
3452 track_mouse_window
= hwnd
;
3455 if (w32_mouse_move_interval
<= 0
3456 || (msg
== WM_MOUSEMOVE
&& button_state
== 0))
3458 wmsg
.dwModifiers
= w32_get_modifiers ();
3459 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3463 /* Hang onto mouse move and scroll messages for a bit, to avoid
3464 sending such events to Emacs faster than it can process them.
3465 If we get more events before the timer from the first message
3466 expires, we just replace the first message. */
3468 if (saved_mouse_move_msg
.msg
.hwnd
== 0)
3470 SetTimer (hwnd
, MOUSE_MOVE_ID
,
3471 w32_mouse_move_interval
, NULL
);
3473 /* Hold onto message for now. */
3474 saved_mouse_move_msg
.msg
.hwnd
= hwnd
;
3475 saved_mouse_move_msg
.msg
.message
= msg
;
3476 saved_mouse_move_msg
.msg
.wParam
= wParam
;
3477 saved_mouse_move_msg
.msg
.lParam
= lParam
;
3478 saved_mouse_move_msg
.msg
.time
= GetMessageTime ();
3479 saved_mouse_move_msg
.dwModifiers
= w32_get_modifiers ();
3485 wmsg
.dwModifiers
= w32_get_modifiers ();
3486 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3487 signal_user_input ();
3491 if (w32_pass_multimedia_buttons_to_system
)
3493 /* Otherwise, pass to lisp, the same way we do with mousehwheel. */
3494 case WM_MOUSEHWHEEL
:
3495 wmsg
.dwModifiers
= w32_get_modifiers ();
3496 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3497 signal_user_input ();
3498 /* Non-zero must be returned when WM_MOUSEHWHEEL messages are
3499 handled, to prevent the system trying to handle it by faking
3500 scroll bar events. */
3504 /* Flush out saved messages if necessary. */
3505 if (wParam
== mouse_button_timer
)
3507 if (saved_mouse_button_msg
.msg
.hwnd
)
3509 post_msg (&saved_mouse_button_msg
);
3510 signal_user_input ();
3511 saved_mouse_button_msg
.msg
.hwnd
= 0;
3513 KillTimer (hwnd
, mouse_button_timer
);
3514 mouse_button_timer
= 0;
3516 else if (wParam
== mouse_move_timer
)
3518 if (saved_mouse_move_msg
.msg
.hwnd
)
3520 post_msg (&saved_mouse_move_msg
);
3521 saved_mouse_move_msg
.msg
.hwnd
= 0;
3523 KillTimer (hwnd
, mouse_move_timer
);
3524 mouse_move_timer
= 0;
3526 else if (wParam
== menu_free_timer
)
3528 KillTimer (hwnd
, menu_free_timer
);
3529 menu_free_timer
= 0;
3530 f
= x_window_to_frame (dpyinfo
, hwnd
);
3531 /* If a popup menu is active, don't wipe its strings. */
3533 && current_popup_menu
== NULL
)
3535 /* Free memory used by owner-drawn and help-echo strings. */
3536 w32_free_menu_strings (hwnd
);
3537 f
->output_data
.w32
->menubar_active
= 0;
3541 else if (wParam
== hourglass_timer
)
3543 KillTimer (hwnd
, hourglass_timer
);
3544 hourglass_timer
= 0;
3545 show_hourglass (x_window_to_frame (dpyinfo
, hwnd
));
3550 /* Windows doesn't send us focus messages when putting up and
3551 taking down a system popup dialog as for Ctrl-Alt-Del on Windows 95.
3552 The only indication we get that something happened is receiving
3553 this message afterwards. So this is a good time to reset our
3554 keyboard modifiers' state. */
3561 /* We must ensure menu bar is fully constructed and up to date
3562 before allowing user interaction with it. To achieve this
3563 we send this message to the lisp thread and wait for a
3564 reply (whose value is not actually needed) to indicate that
3565 the menu bar is now ready for use, so we can now return.
3567 To remain responsive in the meantime, we enter a nested message
3568 loop that can process all other messages.
3570 However, we skip all this if the message results from calling
3571 TrackPopupMenu - in fact, we must NOT attempt to send the lisp
3572 thread a message because it is blocked on us at this point. We
3573 set menubar_active before calling TrackPopupMenu to indicate
3574 this (there is no possibility of confusion with real menubar
3577 f
= x_window_to_frame (dpyinfo
, hwnd
);
3579 && (f
->output_data
.w32
->menubar_active
3580 /* We can receive this message even in the absence of a
3581 menubar (ie. when the system menu is activated) - in this
3582 case we do NOT want to forward the message, otherwise it
3583 will cause the menubar to suddenly appear when the user
3584 had requested it to be turned off! */
3585 || f
->output_data
.w32
->menubar_widget
== NULL
))
3589 deferred_msg msg_buf
;
3591 /* Detect if message has already been deferred; in this case
3592 we cannot return any sensible value to ignore this. */
3593 if (find_deferred_msg (hwnd
, msg
) != NULL
)
3598 return send_deferred_msg (&msg_buf
, hwnd
, msg
, wParam
, lParam
);
3601 case WM_EXITMENULOOP
:
3602 f
= x_window_to_frame (dpyinfo
, hwnd
);
3604 /* If a menu is still active, check again after a short delay,
3605 since Windows often (always?) sends the WM_EXITMENULOOP
3606 before the corresponding WM_COMMAND message.
3607 Don't do this if a popup menu is active, since it is only
3608 menubar menus that require cleaning up in this way.
3610 if (f
&& menubar_in_use
&& current_popup_menu
== NULL
)
3611 menu_free_timer
= SetTimer (hwnd
, MENU_FREE_ID
, MENU_FREE_DELAY
, NULL
);
3613 /* If hourglass cursor should be displayed, display it now. */
3614 if (f
&& f
->output_data
.w32
->hourglass_p
)
3615 SetCursor (f
->output_data
.w32
->hourglass_cursor
);
3620 /* Direct handling of help_echo in menus. Should be safe now
3621 that we generate the help_echo by placing a help event in the
3624 HMENU menu
= (HMENU
) lParam
;
3625 UINT menu_item
= (UINT
) LOWORD (wParam
);
3626 UINT flags
= (UINT
) HIWORD (wParam
);
3628 w32_menu_display_help (hwnd
, menu
, menu_item
, flags
);
3632 case WM_MEASUREITEM
:
3633 f
= x_window_to_frame (dpyinfo
, hwnd
);
3636 MEASUREITEMSTRUCT
* pMis
= (MEASUREITEMSTRUCT
*) lParam
;
3638 if (pMis
->CtlType
== ODT_MENU
)
3640 /* Work out dimensions for popup menu titles. */
3641 char * title
= (char *) pMis
->itemData
;
3642 HDC hdc
= GetDC (hwnd
);
3643 HFONT menu_font
= GetCurrentObject (hdc
, OBJ_FONT
);
3644 LOGFONT menu_logfont
;
3648 GetObject (menu_font
, sizeof (menu_logfont
), &menu_logfont
);
3649 menu_logfont
.lfWeight
= FW_BOLD
;
3650 menu_font
= CreateFontIndirect (&menu_logfont
);
3651 old_font
= SelectObject (hdc
, menu_font
);
3653 pMis
->itemHeight
= GetSystemMetrics (SM_CYMENUSIZE
);
3656 if (unicode_append_menu
)
3657 GetTextExtentPoint32W (hdc
, (WCHAR
*) title
,
3658 wcslen ((WCHAR
*) title
),
3661 GetTextExtentPoint32 (hdc
, title
, strlen (title
), &size
);
3663 pMis
->itemWidth
= size
.cx
;
3664 if (pMis
->itemHeight
< size
.cy
)
3665 pMis
->itemHeight
= size
.cy
;
3668 pMis
->itemWidth
= 0;
3670 SelectObject (hdc
, old_font
);
3671 DeleteObject (menu_font
);
3672 ReleaseDC (hwnd
, hdc
);
3679 f
= x_window_to_frame (dpyinfo
, hwnd
);
3682 DRAWITEMSTRUCT
* pDis
= (DRAWITEMSTRUCT
*) lParam
;
3684 if (pDis
->CtlType
== ODT_MENU
)
3686 /* Draw popup menu title. */
3687 char * title
= (char *) pDis
->itemData
;
3690 HDC hdc
= pDis
->hDC
;
3691 HFONT menu_font
= GetCurrentObject (hdc
, OBJ_FONT
);
3692 LOGFONT menu_logfont
;
3695 GetObject (menu_font
, sizeof (menu_logfont
), &menu_logfont
);
3696 menu_logfont
.lfWeight
= FW_BOLD
;
3697 menu_font
= CreateFontIndirect (&menu_logfont
);
3698 old_font
= SelectObject (hdc
, menu_font
);
3700 /* Always draw title as if not selected. */
3701 if (unicode_append_menu
)
3704 + GetSystemMetrics (SM_CXMENUCHECK
),
3706 ETO_OPAQUE
, &pDis
->rcItem
,
3708 wcslen ((WCHAR
*) title
), NULL
);
3712 + GetSystemMetrics (SM_CXMENUCHECK
),
3714 ETO_OPAQUE
, &pDis
->rcItem
,
3715 title
, strlen (title
), NULL
);
3717 SelectObject (hdc
, old_font
);
3718 DeleteObject (menu_font
);
3726 /* Still not right - can't distinguish between clicks in the
3727 client area of the frame from clicks forwarded from the scroll
3728 bars - may have to hook WM_NCHITTEST to remember the mouse
3729 position and then check if it is in the client area ourselves. */
3730 case WM_MOUSEACTIVATE
:
3731 /* Discard the mouse click that activates a frame, allowing the
3732 user to click anywhere without changing point (or worse!).
3733 Don't eat mouse clicks on scrollbars though!! */
3734 if (LOWORD (lParam
) == HTCLIENT
)
3735 return MA_ACTIVATEANDEAT
;
3740 /* No longer tracking mouse. */
3741 track_mouse_window
= NULL
;
3743 case WM_ACTIVATEAPP
:
3745 case WM_WINDOWPOSCHANGED
:
3747 /* Inform lisp thread that a frame might have just been obscured
3748 or exposed, so should recheck visibility of all frames. */
3749 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3753 dpyinfo
->faked_key
= 0;
3755 register_hot_keys (hwnd
);
3758 unregister_hot_keys (hwnd
);
3761 /* Relinquish the system caret. */
3762 if (w32_system_caret_hwnd
)
3764 w32_visible_system_caret_hwnd
= NULL
;
3765 w32_system_caret_hwnd
= NULL
;
3771 f
= x_window_to_frame (dpyinfo
, hwnd
);
3772 if (f
&& HIWORD (wParam
) == 0)
3774 if (menu_free_timer
)
3776 KillTimer (hwnd
, menu_free_timer
);
3777 menu_free_timer
= 0;
3783 wmsg
.dwModifiers
= w32_get_modifiers ();
3784 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3792 wmsg
.dwModifiers
= w32_get_modifiers ();
3793 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3796 case WM_WINDOWPOSCHANGING
:
3797 /* Don't restrict the sizing of tip frames. */
3798 if (hwnd
== tip_window
)
3802 LPWINDOWPOS lppos
= (WINDOWPOS
*) lParam
;
3804 wp
.length
= sizeof (WINDOWPLACEMENT
);
3805 GetWindowPlacement (hwnd
, &wp
);
3807 if (wp
.showCmd
!= SW_SHOWMINIMIZED
&& (lppos
->flags
& SWP_NOSIZE
) == 0)
3814 DWORD internal_border
;
3815 DWORD scrollbar_extra
;
3818 wp
.length
= sizeof (wp
);
3819 GetWindowRect (hwnd
, &wr
);
3823 font_width
= GetWindowLong (hwnd
, WND_FONTWIDTH_INDEX
);
3824 line_height
= GetWindowLong (hwnd
, WND_LINEHEIGHT_INDEX
);
3825 internal_border
= GetWindowLong (hwnd
, WND_BORDER_INDEX
);
3826 scrollbar_extra
= GetWindowLong (hwnd
, WND_SCROLLBAR_INDEX
);
3830 memset (&rect
, 0, sizeof (rect
));
3831 AdjustWindowRect (&rect
, GetWindowLong (hwnd
, GWL_STYLE
),
3832 GetMenu (hwnd
) != NULL
);
3834 /* Force width and height of client area to be exact
3835 multiples of the character cell dimensions. */
3836 wdiff
= (lppos
->cx
- (rect
.right
- rect
.left
)
3837 - 2 * internal_border
- scrollbar_extra
)
3839 hdiff
= (lppos
->cy
- (rect
.bottom
- rect
.top
)
3840 - 2 * internal_border
)
3845 /* For right/bottom sizing we can just fix the sizes.
3846 However for top/left sizing we will need to fix the X
3847 and Y positions as well. */
3849 int cx_mintrack
= GetSystemMetrics (SM_CXMINTRACK
);
3850 int cy_mintrack
= GetSystemMetrics (SM_CYMINTRACK
);
3852 lppos
->cx
= max (lppos
->cx
- wdiff
, cx_mintrack
);
3853 lppos
->cy
= max (lppos
->cy
- hdiff
, cy_mintrack
);
3855 if (wp
.showCmd
!= SW_SHOWMAXIMIZED
3856 && (lppos
->flags
& SWP_NOMOVE
) == 0)
3858 if (lppos
->x
!= wr
.left
|| lppos
->y
!= wr
.top
)
3865 lppos
->flags
|= SWP_NOMOVE
;
3876 case WM_GETMINMAXINFO
:
3877 /* Hack to allow resizing the Emacs frame above the screen size.
3878 Note that Windows 9x limits coordinates to 16-bits. */
3879 ((LPMINMAXINFO
) lParam
)->ptMaxTrackSize
.x
= 32767;
3880 ((LPMINMAXINFO
) lParam
)->ptMaxTrackSize
.y
= 32767;
3884 if (LOWORD (lParam
) == HTCLIENT
)
3886 f
= x_window_to_frame (dpyinfo
, hwnd
);
3887 if (f
->output_data
.w32
->hourglass_p
&& !menubar_in_use
3888 && !current_popup_menu
)
3889 SetCursor (f
->output_data
.w32
->hourglass_cursor
);
3891 SetCursor (f
->output_data
.w32
->current_cursor
);
3896 case WM_EMACS_SETCURSOR
:
3898 Cursor cursor
= (Cursor
) wParam
;
3899 f
= x_window_to_frame (dpyinfo
, hwnd
);
3902 f
->output_data
.w32
->current_cursor
= cursor
;
3903 if (!f
->output_data
.w32
->hourglass_p
)
3909 case WM_EMACS_CREATESCROLLBAR
:
3910 return (LRESULT
) w32_createscrollbar ((struct frame
*) wParam
,
3911 (struct scroll_bar
*) lParam
);
3913 case WM_EMACS_SHOWWINDOW
:
3914 return ShowWindow ((HWND
) wParam
, (WPARAM
) lParam
);
3916 case WM_EMACS_SETFOREGROUND
:
3918 HWND foreground_window
;
3919 DWORD foreground_thread
, retval
;
3921 /* On NT 5.0, and apparently Windows 98, it is necessary to
3922 attach to the thread that currently has focus in order to
3923 pull the focus away from it. */
3924 foreground_window
= GetForegroundWindow ();
3925 foreground_thread
= GetWindowThreadProcessId (foreground_window
, NULL
);
3926 if (!foreground_window
3927 || foreground_thread
== GetCurrentThreadId ()
3928 || !AttachThreadInput (GetCurrentThreadId (),
3929 foreground_thread
, TRUE
))
3930 foreground_thread
= 0;
3932 retval
= SetForegroundWindow ((HWND
) wParam
);
3934 /* Detach from the previous foreground thread. */
3935 if (foreground_thread
)
3936 AttachThreadInput (GetCurrentThreadId (),
3937 foreground_thread
, FALSE
);
3942 case WM_EMACS_SETWINDOWPOS
:
3944 WINDOWPOS
* pos
= (WINDOWPOS
*) wParam
;
3945 return SetWindowPos (hwnd
, pos
->hwndInsertAfter
,
3946 pos
->x
, pos
->y
, pos
->cx
, pos
->cy
, pos
->flags
);
3949 case WM_EMACS_DESTROYWINDOW
:
3950 DragAcceptFiles ((HWND
) wParam
, FALSE
);
3951 return DestroyWindow ((HWND
) wParam
);
3953 case WM_EMACS_HIDE_CARET
:
3954 return HideCaret (hwnd
);
3956 case WM_EMACS_SHOW_CARET
:
3957 return ShowCaret (hwnd
);
3959 case WM_EMACS_DESTROY_CARET
:
3960 w32_system_caret_hwnd
= NULL
;
3961 w32_visible_system_caret_hwnd
= NULL
;
3962 return DestroyCaret ();
3964 case WM_EMACS_TRACK_CARET
:
3965 /* If there is currently no system caret, create one. */
3966 if (w32_system_caret_hwnd
== NULL
)
3968 /* Use the default caret width, and avoid changing it
3969 unneccesarily, as it confuses screen reader software. */
3970 w32_system_caret_hwnd
= hwnd
;
3971 CreateCaret (hwnd
, NULL
, 0,
3972 w32_system_caret_height
);
3975 if (!SetCaretPos (w32_system_caret_x
, w32_system_caret_y
))
3977 /* Ensure visible caret gets turned on when requested. */
3978 else if (w32_use_visible_system_caret
3979 && w32_visible_system_caret_hwnd
!= hwnd
)
3981 w32_visible_system_caret_hwnd
= hwnd
;
3982 return ShowCaret (hwnd
);
3984 /* Ensure visible caret gets turned off when requested. */
3985 else if (!w32_use_visible_system_caret
3986 && w32_visible_system_caret_hwnd
)
3988 w32_visible_system_caret_hwnd
= NULL
;
3989 return HideCaret (hwnd
);
3994 case WM_EMACS_TRACKPOPUPMENU
:
3999 pos
= (POINT
*)lParam
;
4000 flags
= TPM_CENTERALIGN
;
4001 if (button_state
& LMOUSE
)
4002 flags
|= TPM_LEFTBUTTON
;
4003 else if (button_state
& RMOUSE
)
4004 flags
|= TPM_RIGHTBUTTON
;
4006 /* Remember we did a SetCapture on the initial mouse down event,
4007 so for safety, we make sure the capture is cancelled now. */
4011 /* Use menubar_active to indicate that WM_INITMENU is from
4012 TrackPopupMenu below, and should be ignored. */
4013 f
= x_window_to_frame (dpyinfo
, hwnd
);
4015 f
->output_data
.w32
->menubar_active
= 1;
4017 if (TrackPopupMenu ((HMENU
)wParam
, flags
, pos
->x
, pos
->y
,
4021 /* Eat any mouse messages during popupmenu */
4022 while (PeekMessage (&amsg
, hwnd
, WM_MOUSEFIRST
, WM_MOUSELAST
,
4024 /* Get the menu selection, if any */
4025 if (PeekMessage (&amsg
, hwnd
, WM_COMMAND
, WM_COMMAND
, PM_REMOVE
))
4027 retval
= LOWORD (amsg
.wParam
);
4043 /* Check for messages registered at runtime. */
4044 if (msg
== msh_mousewheel
)
4046 wmsg
.dwModifiers
= w32_get_modifiers ();
4047 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4048 signal_user_input ();
4053 return DefWindowProc (hwnd
, msg
, wParam
, lParam
);
4057 /* The most common default return code for handled messages is 0. */
4062 my_create_window (f
)
4067 if (!PostThreadMessage (dwWindowsThreadId
, WM_EMACS_CREATEWINDOW
, (WPARAM
)f
, 0))
4069 GetMessage (&msg
, NULL
, WM_EMACS_DONE
, WM_EMACS_DONE
);
4073 /* Create a tooltip window. Unlike my_create_window, we do not do this
4074 indirectly via the Window thread, as we do not need to process Window
4075 messages for the tooltip. Creating tooltips indirectly also creates
4076 deadlocks when tooltips are created for menu items. */
4078 my_create_tip_window (f
)
4083 rect
.left
= rect
.top
= 0;
4084 rect
.right
= FRAME_PIXEL_WIDTH (f
);
4085 rect
.bottom
= FRAME_PIXEL_HEIGHT (f
);
4087 AdjustWindowRect (&rect
, f
->output_data
.w32
->dwStyle
,
4088 FRAME_EXTERNAL_MENU_BAR (f
));
4090 tip_window
= FRAME_W32_WINDOW (f
)
4091 = CreateWindow (EMACS_CLASS
,
4093 f
->output_data
.w32
->dwStyle
,
4096 rect
.right
- rect
.left
,
4097 rect
.bottom
- rect
.top
,
4098 FRAME_W32_WINDOW (SELECTED_FRAME ()), /* owner */
4105 SetWindowLong (tip_window
, WND_FONTWIDTH_INDEX
, FRAME_COLUMN_WIDTH (f
));
4106 SetWindowLong (tip_window
, WND_LINEHEIGHT_INDEX
, FRAME_LINE_HEIGHT (f
));
4107 SetWindowLong (tip_window
, WND_BORDER_INDEX
, FRAME_INTERNAL_BORDER_WIDTH (f
));
4108 SetWindowLong (tip_window
, WND_BACKGROUND_INDEX
, FRAME_BACKGROUND_PIXEL (f
));
4110 /* Tip frames have no scrollbars. */
4111 SetWindowLong (tip_window
, WND_SCROLLBAR_INDEX
, 0);
4113 /* Do this to discard the default setting specified by our parent. */
4114 ShowWindow (tip_window
, SW_HIDE
);
4119 /* Create and set up the w32 window for frame F. */
4122 w32_window (f
, window_prompting
, minibuffer_only
)
4124 long window_prompting
;
4125 int minibuffer_only
;
4129 /* Use the resource name as the top-level window name
4130 for looking up resources. Make a non-Lisp copy
4131 for the window manager, so GC relocation won't bother it.
4133 Elsewhere we specify the window name for the window manager. */
4136 char *str
= (char *) SDATA (Vx_resource_name
);
4137 f
->namebuf
= (char *) xmalloc (strlen (str
) + 1);
4138 strcpy (f
->namebuf
, str
);
4141 my_create_window (f
);
4143 validate_x_resource_name ();
4145 /* x_set_name normally ignores requests to set the name if the
4146 requested name is the same as the current name. This is the one
4147 place where that assumption isn't correct; f->name is set, but
4148 the server hasn't been told. */
4151 int explicit = f
->explicit_name
;
4153 f
->explicit_name
= 0;
4156 x_set_name (f
, name
, explicit);
4161 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
4162 initialize_frame_menubar (f
);
4164 if (FRAME_W32_WINDOW (f
) == 0)
4165 error ("Unable to create window");
4168 /* Handle the icon stuff for this window. Perhaps later we might
4169 want an x_set_icon_position which can be called interactively as
4177 Lisp_Object icon_x
, icon_y
;
4179 /* Set the position of the icon. Note that Windows 95 groups all
4180 icons in the tray. */
4181 icon_x
= w32_get_arg (parms
, Qicon_left
, 0, 0, RES_TYPE_NUMBER
);
4182 icon_y
= w32_get_arg (parms
, Qicon_top
, 0, 0, RES_TYPE_NUMBER
);
4183 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
4185 CHECK_NUMBER (icon_x
);
4186 CHECK_NUMBER (icon_y
);
4188 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
4189 error ("Both left and top icon corners of icon must be specified");
4193 if (! EQ (icon_x
, Qunbound
))
4194 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
4197 /* Start up iconic or window? */
4198 x_wm_set_window_state
4199 (f
, (EQ (w32_get_arg (parms
, Qvisibility
, 0, 0, RES_TYPE_SYMBOL
), Qicon
)
4203 x_text_icon (f
, (char *) SDATA ((!NILP (f
->icon_name
)
4216 XGCValues gc_values
;
4220 /* Create the GC's of this frame.
4221 Note that many default values are used. */
4224 gc_values
.font
= FRAME_FONT (f
);
4226 /* Cursor has cursor-color background, background-color foreground. */
4227 gc_values
.foreground
= FRAME_BACKGROUND_PIXEL (f
);
4228 gc_values
.background
= f
->output_data
.w32
->cursor_pixel
;
4229 f
->output_data
.w32
->cursor_gc
4230 = XCreateGC (NULL
, FRAME_W32_WINDOW (f
),
4231 (GCFont
| GCForeground
| GCBackground
),
4235 f
->output_data
.w32
->white_relief
.gc
= 0;
4236 f
->output_data
.w32
->black_relief
.gc
= 0;
4242 /* Handler for signals raised during x_create_frame and
4243 x_create_top_frame. FRAME is the frame which is partially
4247 unwind_create_frame (frame
)
4250 struct frame
*f
= XFRAME (frame
);
4252 /* If frame is ``official'', nothing to do. */
4253 if (!CONSP (Vframe_list
) || !EQ (XCAR (Vframe_list
), frame
))
4256 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
4259 x_free_frame_resources (f
);
4261 /* Check that reference counts are indeed correct. */
4262 xassert (dpyinfo
->reference_count
== dpyinfo_refcount
);
4263 xassert (dpyinfo
->image_cache
->refcount
== image_cache_refcount
);
4272 x_default_font_parameter (f
, parms
)
4276 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
4277 Lisp_Object font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font",
4280 if (!STRINGP (font
))
4283 static char *names
[]
4284 = { "Courier New-10",
4285 "-*-Courier-normal-r-*-*-13-*-*-*-c-*-iso8859-1",
4286 "-*-Fixedsys-normal-r-*-*-12-*-*-*-c-*-iso8859-1",
4290 for (i
= 0; names
[i
]; i
++)
4292 font
= font_open_by_name (f
, names
[i
]);
4297 error ("No suitable font was found");
4301 /* Remember the explicit font parameter, so we can re-apply it after
4302 we've applied the `default' face settings. */
4303 x_set_frame_parameters (f
, Fcons (Fcons (Qfont_param
, font
), Qnil
));
4305 x_default_parameter (f
, parms
, Qfont
, font
, "font", "Font", RES_TYPE_STRING
);
4308 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
4310 doc
: /* Make a new window, which is called a \"frame\" in Emacs terms.
4311 Return an Emacs frame object.
4312 PARAMETERS is an alist of frame parameters.
4313 If the parameters specify that the frame should not have a minibuffer,
4314 and do not specify a specific minibuffer window to use,
4315 then `default-minibuffer-frame' must be a frame whose minibuffer can
4316 be shared by the new frame.
4318 This function is an internal primitive--use `make-frame' instead. */)
4320 Lisp_Object parameters
;
4323 Lisp_Object frame
, tem
;
4325 int minibuffer_only
= 0;
4326 long window_prompting
= 0;
4328 int count
= SPECPDL_INDEX ();
4329 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
4330 Lisp_Object display
;
4331 struct w32_display_info
*dpyinfo
= NULL
;
4337 /* Make copy of frame parameters because the original is in pure
4339 parameters
= Fcopy_alist (parameters
);
4341 /* Use this general default value to start with
4342 until we know if this frame has a specified name. */
4343 Vx_resource_name
= Vinvocation_name
;
4345 display
= w32_get_arg (parameters
, Qdisplay
, 0, 0, RES_TYPE_STRING
);
4346 if (EQ (display
, Qunbound
))
4348 dpyinfo
= check_x_display_info (display
);
4350 kb
= dpyinfo
->terminal
->kboard
;
4352 kb
= &the_only_kboard
;
4355 name
= w32_get_arg (parameters
, Qname
, "name", "Name", RES_TYPE_STRING
);
4357 && ! EQ (name
, Qunbound
)
4359 error ("Invalid frame name--not a string or nil");
4362 Vx_resource_name
= name
;
4364 /* See if parent window is specified. */
4365 parent
= w32_get_arg (parameters
, Qparent_id
, NULL
, NULL
, RES_TYPE_NUMBER
);
4366 if (EQ (parent
, Qunbound
))
4368 if (! NILP (parent
))
4369 CHECK_NUMBER (parent
);
4371 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
4372 /* No need to protect DISPLAY because that's not used after passing
4373 it to make_frame_without_minibuffer. */
4375 GCPRO4 (parameters
, parent
, name
, frame
);
4376 tem
= w32_get_arg (parameters
, Qminibuffer
, "minibuffer", "Minibuffer",
4378 if (EQ (tem
, Qnone
) || NILP (tem
))
4379 f
= make_frame_without_minibuffer (Qnil
, kb
, display
);
4380 else if (EQ (tem
, Qonly
))
4382 f
= make_minibuffer_frame ();
4383 minibuffer_only
= 1;
4385 else if (WINDOWP (tem
))
4386 f
= make_frame_without_minibuffer (tem
, kb
, display
);
4390 XSETFRAME (frame
, f
);
4392 /* Note that Windows does support scroll bars. */
4393 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
4395 /* By default, make scrollbars the system standard width. */
4396 FRAME_CONFIG_SCROLL_BAR_WIDTH (f
) = GetSystemMetrics (SM_CXVSCROLL
);
4398 f
->terminal
= dpyinfo
->terminal
;
4399 f
->terminal
->reference_count
++;
4401 f
->output_method
= output_w32
;
4402 f
->output_data
.w32
=
4403 (struct w32_output
*) xmalloc (sizeof (struct w32_output
));
4404 bzero (f
->output_data
.w32
, sizeof (struct w32_output
));
4405 FRAME_FONTSET (f
) = -1;
4406 record_unwind_protect (unwind_create_frame
, frame
);
4409 = w32_get_arg (parameters
, Qicon_name
, "iconName", "Title", RES_TYPE_STRING
);
4410 if (! STRINGP (f
->icon_name
))
4411 f
->icon_name
= Qnil
;
4413 /* FRAME_W32_DISPLAY_INFO (f) = dpyinfo; */
4415 FRAME_KBOARD (f
) = kb
;
4418 /* Specify the parent under which to make this window. */
4422 f
->output_data
.w32
->parent_desc
= (Window
) XFASTINT (parent
);
4423 f
->output_data
.w32
->explicit_parent
= 1;
4427 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
4428 f
->output_data
.w32
->explicit_parent
= 0;
4431 /* Set the name; the functions to which we pass f expect the name to
4433 if (EQ (name
, Qunbound
) || NILP (name
))
4435 f
->name
= build_string (dpyinfo
->w32_id_name
);
4436 f
->explicit_name
= 0;
4441 f
->explicit_name
= 1;
4442 /* use the frame's title when getting resources for this frame. */
4443 specbind (Qx_resource_name
, name
);
4446 f
->resx
= dpyinfo
->resx
;
4447 f
->resy
= dpyinfo
->resy
;
4449 if (uniscribe_available
)
4450 register_font_driver (&uniscribe_font_driver
, f
);
4451 register_font_driver (&w32font_driver
, f
);
4453 x_default_parameter (f
, parameters
, Qfont_backend
, Qnil
,
4454 "fontBackend", "FontBackend", RES_TYPE_STRING
);
4455 /* Extract the window parameters from the supplied values
4456 that are needed to determine window geometry. */
4457 x_default_font_parameter (f
, parameters
);
4458 x_default_parameter (f
, parameters
, Qborder_width
, make_number (2),
4459 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
4460 /* This defaults to 2 in order to match xterm. We recognize either
4461 internalBorderWidth or internalBorder (which is what xterm calls
4463 if (NILP (Fassq (Qinternal_border_width
, parameters
)))
4467 value
= w32_get_arg (parameters
, Qinternal_border_width
,
4468 "internalBorder", "InternalBorder", RES_TYPE_NUMBER
);
4469 if (! EQ (value
, Qunbound
))
4470 parameters
= Fcons (Fcons (Qinternal_border_width
, value
),
4473 /* Default internalBorderWidth to 0 on Windows to match other programs. */
4474 x_default_parameter (f
, parameters
, Qinternal_border_width
, make_number (0),
4475 "internalBorderWidth", "InternalBorder", RES_TYPE_NUMBER
);
4476 x_default_parameter (f
, parameters
, Qvertical_scroll_bars
, Qright
,
4477 "verticalScrollBars", "ScrollBars", RES_TYPE_SYMBOL
);
4479 /* Also do the stuff which must be set before the window exists. */
4480 x_default_parameter (f
, parameters
, Qforeground_color
, build_string ("black"),
4481 "foreground", "Foreground", RES_TYPE_STRING
);
4482 x_default_parameter (f
, parameters
, Qbackground_color
, build_string ("white"),
4483 "background", "Background", RES_TYPE_STRING
);
4484 x_default_parameter (f
, parameters
, Qmouse_color
, build_string ("black"),
4485 "pointerColor", "Foreground", RES_TYPE_STRING
);
4486 x_default_parameter (f
, parameters
, Qcursor_color
, build_string ("black"),
4487 "cursorColor", "Foreground", RES_TYPE_STRING
);
4488 x_default_parameter (f
, parameters
, Qborder_color
, build_string ("black"),
4489 "borderColor", "BorderColor", RES_TYPE_STRING
);
4490 x_default_parameter (f
, parameters
, Qscreen_gamma
, Qnil
,
4491 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT
);
4492 x_default_parameter (f
, parameters
, Qline_spacing
, Qnil
,
4493 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER
);
4494 x_default_parameter (f
, parameters
, Qleft_fringe
, Qnil
,
4495 "leftFringe", "LeftFringe", RES_TYPE_NUMBER
);
4496 x_default_parameter (f
, parameters
, Qright_fringe
, Qnil
,
4497 "rightFringe", "RightFringe", RES_TYPE_NUMBER
);
4500 /* Init faces before x_default_parameter is called for scroll-bar
4501 parameters because that function calls x_set_scroll_bar_width,
4502 which calls change_frame_size, which calls Fset_window_buffer,
4503 which runs hooks, which call Fvertical_motion. At the end, we
4504 end up in init_iterator with a null face cache, which should not
4506 init_frame_faces (f
);
4508 x_default_parameter (f
, parameters
, Qmenu_bar_lines
, make_number (1),
4509 "menuBar", "MenuBar", RES_TYPE_NUMBER
);
4510 x_default_parameter (f
, parameters
, Qtool_bar_lines
, make_number (1),
4511 "toolBar", "ToolBar", RES_TYPE_NUMBER
);
4513 x_default_parameter (f
, parameters
, Qbuffer_predicate
, Qnil
,
4514 "bufferPredicate", "BufferPredicate", RES_TYPE_SYMBOL
);
4515 x_default_parameter (f
, parameters
, Qtitle
, Qnil
,
4516 "title", "Title", RES_TYPE_STRING
);
4517 x_default_parameter (f
, parameters
, Qfullscreen
, Qnil
,
4518 "fullscreen", "Fullscreen", RES_TYPE_SYMBOL
);
4520 f
->output_data
.w32
->dwStyle
= WS_OVERLAPPEDWINDOW
;
4521 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
4523 f
->output_data
.w32
->text_cursor
= w32_load_cursor (IDC_IBEAM
);
4524 f
->output_data
.w32
->nontext_cursor
= w32_load_cursor (IDC_ARROW
);
4525 f
->output_data
.w32
->modeline_cursor
= w32_load_cursor (IDC_ARROW
);
4526 f
->output_data
.w32
->hand_cursor
= w32_load_cursor (IDC_HAND
);
4527 f
->output_data
.w32
->hourglass_cursor
= w32_load_cursor (IDC_WAIT
);
4528 f
->output_data
.w32
->horizontal_drag_cursor
= w32_load_cursor (IDC_SIZEWE
);
4530 f
->output_data
.w32
->current_cursor
= f
->output_data
.w32
->nontext_cursor
;
4532 window_prompting
= x_figure_window_size (f
, parameters
, 1);
4534 tem
= w32_get_arg (parameters
, Qunsplittable
, 0, 0, RES_TYPE_BOOLEAN
);
4535 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
4537 w32_window (f
, window_prompting
, minibuffer_only
);
4538 x_icon (f
, parameters
);
4542 /* Now consider the frame official. */
4543 FRAME_W32_DISPLAY_INFO (f
)->reference_count
++;
4544 Vframe_list
= Fcons (frame
, Vframe_list
);
4546 /* We need to do this after creating the window, so that the
4547 icon-creation functions can say whose icon they're describing. */
4548 x_default_parameter (f
, parameters
, Qicon_type
, Qnil
,
4549 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL
);
4551 x_default_parameter (f
, parameters
, Qauto_raise
, Qnil
,
4552 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4553 x_default_parameter (f
, parameters
, Qauto_lower
, Qnil
,
4554 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4555 x_default_parameter (f
, parameters
, Qcursor_type
, Qbox
,
4556 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
4557 x_default_parameter (f
, parameters
, Qscroll_bar_width
, Qnil
,
4558 "scrollBarWidth", "ScrollBarWidth", RES_TYPE_NUMBER
);
4560 /* Dimensions, especially FRAME_LINES (f), must be done via change_frame_size.
4561 Change will not be effected unless different from the current
4563 width
= FRAME_COLS (f
);
4564 height
= FRAME_LINES (f
);
4566 FRAME_LINES (f
) = 0;
4567 SET_FRAME_COLS (f
, 0);
4568 change_frame_size (f
, height
, width
, 1, 0, 0);
4570 /* Tell the server what size and position, etc, we want, and how
4571 badly we want them. This should be done after we have the menu
4572 bar so that its size can be taken into account. */
4574 x_wm_set_size_hint (f
, window_prompting
, 0);
4577 /* Make the window appear on the frame and enable display, unless
4578 the caller says not to. However, with explicit parent, Emacs
4579 cannot control visibility, so don't try. */
4580 if (! f
->output_data
.w32
->explicit_parent
)
4582 Lisp_Object visibility
;
4584 visibility
= w32_get_arg (parameters
, Qvisibility
, 0, 0, RES_TYPE_SYMBOL
);
4585 if (EQ (visibility
, Qunbound
))
4588 if (EQ (visibility
, Qicon
))
4589 x_iconify_frame (f
);
4590 else if (! NILP (visibility
))
4591 x_make_frame_visible (f
);
4593 /* Must have been Qnil. */
4597 /* Initialize `default-minibuffer-frame' in case this is the first
4598 frame on this terminal. */
4599 if (FRAME_HAS_MINIBUF_P (f
)
4600 && (!FRAMEP (kb
->Vdefault_minibuffer_frame
)
4601 || !FRAME_LIVE_P (XFRAME (kb
->Vdefault_minibuffer_frame
))))
4602 kb
->Vdefault_minibuffer_frame
= frame
;
4604 /* All remaining specified parameters, which have not been "used"
4605 by x_get_arg and friends, now go in the misc. alist of the frame. */
4606 for (tem
= parameters
; CONSP (tem
); tem
= XCDR (tem
))
4607 if (CONSP (XCAR (tem
)) && !NILP (XCAR (XCAR (tem
))))
4608 f
->param_alist
= Fcons (XCAR (tem
), f
->param_alist
);
4612 /* Make sure windows on this frame appear in calls to next-window
4613 and similar functions. */
4614 Vwindow_list
= Qnil
;
4616 return unbind_to (count
, frame
);
4619 /* FRAME is used only to get a handle on the X display. We don't pass the
4620 display info directly because we're called from frame.c, which doesn't
4621 know about that structure. */
4623 x_get_focus_frame (frame
)
4624 struct frame
*frame
;
4626 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (frame
);
4628 if (! dpyinfo
->w32_focus_frame
)
4631 XSETFRAME (xfocus
, dpyinfo
->w32_focus_frame
);
4635 DEFUN ("x-focus-frame", Fx_focus_frame
, Sx_focus_frame
, 1, 1, 0,
4636 doc
: /* Give FRAME input focus, raising to foreground if necessary. */)
4640 x_focus_on_frame (check_x_frame (frame
));
4647 /* Return the charset portion of a font name. */
4649 xlfd_charset_of_font (char * fontname
)
4651 char *charset
, *encoding
;
4653 encoding
= strrchr (fontname
, '-');
4654 if (!encoding
|| encoding
== fontname
)
4657 for (charset
= encoding
- 1; charset
>= fontname
; charset
--)
4658 if (*charset
== '-')
4661 if (charset
== fontname
|| strcmp (charset
, "-*-*") == 0)
4667 struct font_info
*w32_load_bdf_font (struct frame
*f
, char *fontname
,
4668 int size
, char* filename
);
4669 static Lisp_Object
w32_list_bdf_fonts (Lisp_Object pattern
, int max_names
);
4670 static BOOL
w32_to_x_font (LOGFONT
* lplf
, char * lpxstr
, int len
,
4672 static BOOL
x_to_w32_font (char *lpxstr
, LOGFONT
*lplogfont
);
4674 static struct font_info
*
4675 w32_load_system_font (f
, fontname
, size
)
4680 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
4681 Lisp_Object font_names
;
4683 /* Get a list of all the fonts that match this name. Once we
4684 have a list of matching fonts, we compare them against the fonts
4685 we already have loaded by comparing names. */
4686 font_names
= w32_list_fonts (f
, build_string (fontname
), size
, 100);
4688 if (!NILP (font_names
))
4693 /* First check if any are already loaded, as that is cheaper
4694 than loading another one. */
4695 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
4696 for (tail
= font_names
; CONSP (tail
); tail
= XCDR (tail
))
4697 if (dpyinfo
->font_table
[i
].name
4698 && (!strcmp (dpyinfo
->font_table
[i
].name
,
4699 SDATA (XCAR (tail
)))
4700 || !strcmp (dpyinfo
->font_table
[i
].full_name
,
4701 SDATA (XCAR (tail
)))))
4702 return (dpyinfo
->font_table
+ i
);
4704 fontname
= (char *) SDATA (XCAR (font_names
));
4706 else if (w32_strict_fontnames
)
4708 /* If EnumFontFamiliesEx was available, we got a full list of
4709 fonts back so stop now to avoid the possibility of loading a
4710 random font. If we had to fall back to EnumFontFamilies, the
4711 list is incomplete, so continue whether the font we want was
4713 HMODULE gdi32
= GetModuleHandle ("gdi32.dll");
4714 FARPROC enum_font_families_ex
4715 = GetProcAddress (gdi32
, "EnumFontFamiliesExA");
4716 if (enum_font_families_ex
)
4720 /* Load the font and add it to the table. */
4722 char *full_name
, *encoding
, *charset
;
4724 struct font_info
*fontp
;
4730 if (!fontname
|| !x_to_w32_font (fontname
, &lf
))
4733 if (!*lf
.lfFaceName
)
4734 /* If no name was specified for the font, we get a random font
4735 from CreateFontIndirect - this is not particularly
4736 desirable, especially since CreateFontIndirect does not
4737 fill out the missing name in lf, so we never know what we
4741 lf
.lfQuality
= DEFAULT_QUALITY
;
4743 font
= (XFontStruct
*) xmalloc (sizeof (XFontStruct
));
4744 bzero (font
, sizeof (*font
));
4746 /* Set bdf to NULL to indicate that this is a Windows font. */
4751 font
->hfont
= CreateFontIndirect (&lf
);
4753 if (font
->hfont
== NULL
)
4762 codepage
= w32_codepage_for_font (fontname
);
4764 hdc
= GetDC (dpyinfo
->root_window
);
4765 oldobj
= SelectObject (hdc
, font
->hfont
);
4767 ok
= GetTextMetrics (hdc
, &font
->tm
);
4768 if (codepage
== CP_UNICODE
)
4769 font
->double_byte_p
= 1;
4772 /* Unfortunately, some fonts (eg. MingLiU, a big5 ttf font)
4773 don't report themselves as double byte fonts, when
4774 patently they are. So instead of trusting
4775 GetFontLanguageInfo, we check the properties of the
4776 codepage directly, since that is ultimately what we are
4777 working from anyway. */
4778 /* font->double_byte_p = GetFontLanguageInfo (hdc) & GCP_DBCS; */
4780 GetCPInfo (codepage
, &cpi
);
4781 font
->double_byte_p
= cpi
.MaxCharSize
> 1;
4784 SelectObject (hdc
, oldobj
);
4785 ReleaseDC (dpyinfo
->root_window
, hdc
);
4786 /* Fill out details in lf according to the font that was
4788 lf
.lfHeight
= font
->tm
.tmInternalLeading
- font
->tm
.tmHeight
;
4789 lf
.lfWidth
= font
->tm
.tmMaxCharWidth
;
4790 lf
.lfWeight
= font
->tm
.tmWeight
;
4791 lf
.lfItalic
= font
->tm
.tmItalic
;
4792 lf
.lfCharSet
= font
->tm
.tmCharSet
;
4793 lf
.lfPitchAndFamily
= ((font
->tm
.tmPitchAndFamily
& TMPF_FIXED_PITCH
)
4794 ? VARIABLE_PITCH
: FIXED_PITCH
);
4795 lf
.lfOutPrecision
= ((font
->tm
.tmPitchAndFamily
& TMPF_VECTOR
)
4796 ? OUT_STROKE_PRECIS
: OUT_STRING_PRECIS
);
4798 w32_cache_char_metrics (font
);
4805 w32_unload_font (dpyinfo
, font
);
4809 /* Find a free slot in the font table. */
4810 for (i
= 0; i
< dpyinfo
->n_fonts
; ++i
)
4811 if (dpyinfo
->font_table
[i
].name
== NULL
)
4814 /* If no free slot found, maybe enlarge the font table. */
4815 if (i
== dpyinfo
->n_fonts
4816 && dpyinfo
->n_fonts
== dpyinfo
->font_table_size
)
4819 dpyinfo
->font_table_size
= max (16, 2 * dpyinfo
->font_table_size
);
4820 sz
= dpyinfo
->font_table_size
* sizeof *dpyinfo
->font_table
;
4822 = (struct font_info
*) xrealloc (dpyinfo
->font_table
, sz
);
4825 fontp
= dpyinfo
->font_table
+ i
;
4826 if (i
== dpyinfo
->n_fonts
)
4829 /* Now fill in the slots of *FONTP. */
4831 bzero (fontp
, sizeof (*fontp
));
4833 fontp
->font_idx
= i
;
4834 fontp
->name
= (char *) xmalloc (strlen (fontname
) + 1);
4835 bcopy (fontname
, fontp
->name
, strlen (fontname
) + 1);
4837 if ((lf
.lfPitchAndFamily
& 0x03) == FIXED_PITCH
)
4839 /* Fixed width font. */
4840 fontp
->average_width
= fontp
->space_width
= FONT_AVG_WIDTH (font
);
4846 pcm
= w32_per_char_metric (font
, &space
, ANSI_FONT
);
4848 fontp
->space_width
= pcm
->width
;
4850 fontp
->space_width
= FONT_AVG_WIDTH (font
);
4852 fontp
->average_width
= font
->tm
.tmAveCharWidth
;
4855 fontp
->charset
= -1;
4856 charset
= xlfd_charset_of_font (fontname
);
4858 /* Cache the W32 codepage for a font. This makes w32_encode_char
4859 (called for every glyph during redisplay) much faster. */
4860 fontp
->codepage
= codepage
;
4862 /* Work out the font's full name. */
4863 full_name
= (char *)xmalloc (100);
4864 if (full_name
&& w32_to_x_font (&lf
, full_name
, 100, charset
))
4865 fontp
->full_name
= full_name
;
4868 /* If all else fails - just use the name we used to load it. */
4870 fontp
->full_name
= fontp
->name
;
4873 fontp
->size
= FONT_WIDTH (font
);
4874 fontp
->height
= FONT_HEIGHT (font
);
4876 /* The slot `encoding' specifies how to map a character
4877 code-points (0x20..0x7F or 0x2020..0x7F7F) of each charset to
4878 the font code-points (0:0x20..0x7F, 1:0xA0..0xFF), or
4879 (0:0x20..0x7F, 1:0xA0..0xFF,
4880 (0:0x2020..0x7F7F, 1:0xA0A0..0xFFFF, 3:0x20A0..0x7FFF,
4881 2:0xA020..0xFF7F). For the moment, we don't know which charset
4882 uses this font. So, we set information in fontp->encoding_type
4883 which is never used by any charset. If mapping can't be
4884 decided, set FONT_ENCODING_NOT_DECIDED. */
4886 /* SJIS fonts need to be set to type 4, all others seem to work as
4887 type FONT_ENCODING_NOT_DECIDED. */
4888 encoding
= strrchr (fontp
->name
, '-');
4889 if (encoding
&& strnicmp (encoding
+1, "sjis", 4) == 0)
4890 fontp
->encoding_type
= 4;
4892 fontp
->encoding_type
= FONT_ENCODING_NOT_DECIDED
;
4894 /* The following three values are set to 0 under W32, which is
4895 what they get set to if XGetFontProperty fails under X. */
4896 fontp
->baseline_offset
= 0;
4897 fontp
->relative_compose
= 0;
4898 fontp
->default_ascent
= 0;
4900 /* Set global flag fonts_changed_p to non-zero if the font loaded
4901 has a character with a smaller width than any other character
4902 before, or if the font loaded has a smaller height than any
4903 other font loaded before. If this happens, it will make a
4904 glyph matrix reallocation necessary. */
4905 fonts_changed_p
|= x_compute_min_glyph_bounds (f
);
4911 /* Load font named FONTNAME of size SIZE for frame F, and return a
4912 pointer to the structure font_info while allocating it dynamically.
4913 If loading fails, return NULL. */
4915 w32_load_font (f
, fontname
, size
)
4920 Lisp_Object bdf_fonts
;
4921 struct font_info
*retval
= NULL
;
4922 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
4924 bdf_fonts
= w32_list_bdf_fonts (build_string (fontname
), 1);
4926 while (!retval
&& CONSP (bdf_fonts
))
4928 char *bdf_name
, *bdf_file
;
4929 Lisp_Object bdf_pair
;
4932 bdf_name
= SDATA (XCAR (bdf_fonts
));
4933 bdf_pair
= Fassoc (XCAR (bdf_fonts
), Vw32_bdf_filename_alist
);
4934 bdf_file
= SDATA (XCDR (bdf_pair
));
4936 /* If the font is already loaded, do not load it again. */
4937 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
4939 if ((dpyinfo
->font_table
[i
].name
4940 && !strcmp (dpyinfo
->font_table
[i
].name
, bdf_name
))
4941 || (dpyinfo
->font_table
[i
].full_name
4942 && !strcmp (dpyinfo
->font_table
[i
].full_name
, bdf_name
)))
4943 return dpyinfo
->font_table
+ i
;
4946 retval
= w32_load_bdf_font (f
, bdf_name
, size
, bdf_file
);
4948 bdf_fonts
= XCDR (bdf_fonts
);
4954 return w32_load_system_font (f
, fontname
, size
);
4959 w32_unload_font (dpyinfo
, font
)
4960 struct w32_display_info
*dpyinfo
;
4965 xfree (font
->per_char
);
4966 if (font
->bdf
) w32_free_bdf_font (font
->bdf
);
4968 if (font
->hfont
) DeleteObject (font
->hfont
);
4972 #endif /* OLD_FONT */
4974 /* The font conversion stuff between x and w32 */
4976 /* X font string is as follows (from faces.el)
4980 * (weight "\\(bold\\|demibold\\|medium\\)") ; 1
4981 * (weight\? "\\([^-]*\\)") ; 1
4982 * (slant "\\([ior]\\)") ; 2
4983 * (slant\? "\\([^-]?\\)") ; 2
4984 * (swidth "\\([^-]*\\)") ; 3
4985 * (adstyle "[^-]*") ; 4
4986 * (pixelsize "[0-9]+")
4987 * (pointsize "[0-9][0-9]+")
4988 * (resx "[0-9][0-9]+")
4989 * (resy "[0-9][0-9]+")
4990 * (spacing "[cmp?*]")
4991 * (avgwidth "[0-9]+")
4992 * (registry "[^-]+")
4993 * (encoding "[^-]+")
4998 x_to_w32_weight (lpw
)
5001 if (!lpw
) return (FW_DONTCARE
);
5003 if (xstrcasecmp (lpw
, "heavy") == 0) return FW_HEAVY
;
5004 else if (xstrcasecmp (lpw
, "extrabold") == 0) return FW_EXTRABOLD
;
5005 else if (xstrcasecmp (lpw
, "bold") == 0) return FW_BOLD
;
5006 else if (xstrcasecmp (lpw
, "demibold") == 0) return FW_SEMIBOLD
;
5007 else if (xstrcasecmp (lpw
, "semibold") == 0) return FW_SEMIBOLD
;
5008 else if (xstrcasecmp (lpw
, "medium") == 0) return FW_MEDIUM
;
5009 else if (xstrcasecmp (lpw
, "normal") == 0) return FW_NORMAL
;
5010 else if (xstrcasecmp (lpw
, "light") == 0) return FW_LIGHT
;
5011 else if (xstrcasecmp (lpw
, "extralight") == 0) return FW_EXTRALIGHT
;
5012 else if (xstrcasecmp (lpw
, "thin") == 0) return FW_THIN
;
5019 w32_to_x_weight (fnweight
)
5022 if (fnweight
>= FW_HEAVY
) return "heavy";
5023 if (fnweight
>= FW_EXTRABOLD
) return "extrabold";
5024 if (fnweight
>= FW_BOLD
) return "bold";
5025 if (fnweight
>= FW_SEMIBOLD
) return "demibold";
5026 if (fnweight
>= FW_MEDIUM
) return "medium";
5027 if (fnweight
>= FW_NORMAL
) return "normal";
5028 if (fnweight
>= FW_LIGHT
) return "light";
5029 if (fnweight
>= FW_EXTRALIGHT
) return "extralight";
5030 if (fnweight
>= FW_THIN
) return "thin";
5036 x_to_w32_charset (lpcs
)
5039 Lisp_Object this_entry
, w32_charset
;
5041 int len
= strlen (lpcs
);
5043 /* Support "*-#nnn" format for unknown charsets. */
5044 if (strncmp (lpcs
, "*-#", 3) == 0)
5045 return atoi (lpcs
+ 3);
5047 /* All Windows fonts qualify as unicode. */
5048 if (!strncmp (lpcs
, "iso10646", 8))
5049 return DEFAULT_CHARSET
;
5051 /* Handle wildcards by ignoring them; eg. treat "big5*-*" as "big5". */
5052 charset
= alloca (len
+ 1);
5053 strcpy (charset
, lpcs
);
5054 lpcs
= strchr (charset
, '*');
5058 /* Look through w32-charset-info-alist for the character set.
5059 Format of each entry is
5060 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
5062 this_entry
= Fassoc (build_string (charset
), Vw32_charset_info_alist
);
5064 if (NILP (this_entry
))
5066 /* At startup, we want iso8859-1 fonts to come up properly. */
5067 if (xstrcasecmp (charset
, "iso8859-1") == 0)
5068 return ANSI_CHARSET
;
5070 return DEFAULT_CHARSET
;
5073 w32_charset
= Fcar (Fcdr (this_entry
));
5075 /* Translate Lisp symbol to number. */
5076 if (EQ (w32_charset
, Qw32_charset_ansi
))
5077 return ANSI_CHARSET
;
5078 if (EQ (w32_charset
, Qw32_charset_symbol
))
5079 return SYMBOL_CHARSET
;
5080 if (EQ (w32_charset
, Qw32_charset_shiftjis
))
5081 return SHIFTJIS_CHARSET
;
5082 if (EQ (w32_charset
, Qw32_charset_hangeul
))
5083 return HANGEUL_CHARSET
;
5084 if (EQ (w32_charset
, Qw32_charset_chinesebig5
))
5085 return CHINESEBIG5_CHARSET
;
5086 if (EQ (w32_charset
, Qw32_charset_gb2312
))
5087 return GB2312_CHARSET
;
5088 if (EQ (w32_charset
, Qw32_charset_oem
))
5090 #ifdef JOHAB_CHARSET
5091 if (EQ (w32_charset
, Qw32_charset_johab
))
5092 return JOHAB_CHARSET
;
5093 if (EQ (w32_charset
, Qw32_charset_easteurope
))
5094 return EASTEUROPE_CHARSET
;
5095 if (EQ (w32_charset
, Qw32_charset_turkish
))
5096 return TURKISH_CHARSET
;
5097 if (EQ (w32_charset
, Qw32_charset_baltic
))
5098 return BALTIC_CHARSET
;
5099 if (EQ (w32_charset
, Qw32_charset_russian
))
5100 return RUSSIAN_CHARSET
;
5101 if (EQ (w32_charset
, Qw32_charset_arabic
))
5102 return ARABIC_CHARSET
;
5103 if (EQ (w32_charset
, Qw32_charset_greek
))
5104 return GREEK_CHARSET
;
5105 if (EQ (w32_charset
, Qw32_charset_hebrew
))
5106 return HEBREW_CHARSET
;
5107 if (EQ (w32_charset
, Qw32_charset_vietnamese
))
5108 return VIETNAMESE_CHARSET
;
5109 if (EQ (w32_charset
, Qw32_charset_thai
))
5110 return THAI_CHARSET
;
5111 if (EQ (w32_charset
, Qw32_charset_mac
))
5113 #endif /* JOHAB_CHARSET */
5114 #ifdef UNICODE_CHARSET
5115 if (EQ (w32_charset
, Qw32_charset_unicode
))
5116 return UNICODE_CHARSET
;
5119 return DEFAULT_CHARSET
;
5124 w32_to_x_charset (fncharset
, matching
)
5128 static char buf
[32];
5129 Lisp_Object charset_type
;
5134 /* If fully specified, accept it as it is. Otherwise use a
5136 char *wildcard
= strchr (matching
, '*');
5139 else if (strchr (matching
, '-'))
5142 match_len
= strlen (matching
);
5148 /* Handle startup case of w32-charset-info-alist not
5149 being set up yet. */
5150 if (NILP (Vw32_charset_info_alist
))
5152 charset_type
= Qw32_charset_ansi
;
5154 case DEFAULT_CHARSET
:
5155 charset_type
= Qw32_charset_default
;
5157 case SYMBOL_CHARSET
:
5158 charset_type
= Qw32_charset_symbol
;
5160 case SHIFTJIS_CHARSET
:
5161 charset_type
= Qw32_charset_shiftjis
;
5163 case HANGEUL_CHARSET
:
5164 charset_type
= Qw32_charset_hangeul
;
5166 case GB2312_CHARSET
:
5167 charset_type
= Qw32_charset_gb2312
;
5169 case CHINESEBIG5_CHARSET
:
5170 charset_type
= Qw32_charset_chinesebig5
;
5173 charset_type
= Qw32_charset_oem
;
5176 /* More recent versions of Windows (95 and NT4.0) define more
5178 #ifdef EASTEUROPE_CHARSET
5179 case EASTEUROPE_CHARSET
:
5180 charset_type
= Qw32_charset_easteurope
;
5182 case TURKISH_CHARSET
:
5183 charset_type
= Qw32_charset_turkish
;
5185 case BALTIC_CHARSET
:
5186 charset_type
= Qw32_charset_baltic
;
5188 case RUSSIAN_CHARSET
:
5189 charset_type
= Qw32_charset_russian
;
5191 case ARABIC_CHARSET
:
5192 charset_type
= Qw32_charset_arabic
;
5195 charset_type
= Qw32_charset_greek
;
5197 case HEBREW_CHARSET
:
5198 charset_type
= Qw32_charset_hebrew
;
5200 case VIETNAMESE_CHARSET
:
5201 charset_type
= Qw32_charset_vietnamese
;
5204 charset_type
= Qw32_charset_thai
;
5207 charset_type
= Qw32_charset_mac
;
5210 charset_type
= Qw32_charset_johab
;
5214 #ifdef UNICODE_CHARSET
5215 case UNICODE_CHARSET
:
5216 charset_type
= Qw32_charset_unicode
;
5220 /* Encode numerical value of unknown charset. */
5221 sprintf (buf
, "*-#%u", fncharset
);
5227 char * best_match
= NULL
;
5228 int matching_found
= 0;
5230 /* Look through w32-charset-info-alist for the character set.
5231 Prefer ISO codepages, and prefer lower numbers in the ISO
5232 range. Only return charsets for codepages which are installed.
5234 Format of each entry is
5235 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
5237 for (rest
= Vw32_charset_info_alist
; CONSP (rest
); rest
= XCDR (rest
))
5240 Lisp_Object w32_charset
;
5241 Lisp_Object codepage
;
5243 Lisp_Object this_entry
= XCAR (rest
);
5245 /* Skip invalid entries in alist. */
5246 if (!CONSP (this_entry
) || !STRINGP (XCAR (this_entry
))
5247 || !CONSP (XCDR (this_entry
))
5248 || !SYMBOLP (XCAR (XCDR (this_entry
))))
5251 x_charset
= SDATA (XCAR (this_entry
));
5252 w32_charset
= XCAR (XCDR (this_entry
));
5253 codepage
= XCDR (XCDR (this_entry
));
5255 /* Look for Same charset and a valid codepage (or non-int
5256 which means ignore). */
5257 if (EQ (w32_charset
, charset_type
)
5258 && (!INTEGERP (codepage
) || XINT (codepage
) == CP_DEFAULT
5259 || IsValidCodePage (XINT (codepage
))))
5261 /* If we don't have a match already, then this is the
5265 best_match
= x_charset
;
5266 if (matching
&& !strnicmp (x_charset
, matching
, match_len
))
5269 /* If we already found a match for MATCHING, then
5270 only consider other matches. */
5271 else if (matching_found
5272 && strnicmp (x_charset
, matching
, match_len
))
5274 /* If this matches what we want, and the best so far doesn't,
5275 then this is better. */
5276 else if (!matching_found
&& matching
5277 && !strnicmp (x_charset
, matching
, match_len
))
5279 best_match
= x_charset
;
5282 /* If this is fully specified, and the best so far isn't,
5283 then this is better. */
5284 else if ((!strchr (best_match
, '-') && strchr (x_charset
, '-'))
5285 /* If this is an ISO codepage, and the best so far isn't,
5286 then this is better, but only if it fully specifies the
5288 || (strnicmp (best_match
, "iso", 3) != 0
5289 && strnicmp (x_charset
, "iso", 3) == 0
5290 && strchr (x_charset
, '-')))
5291 best_match
= x_charset
;
5292 /* If both are ISO8859 codepages, choose the one with the
5293 lowest number in the encoding field. */
5294 else if (strnicmp (best_match
, "iso8859-", 8) == 0
5295 && strnicmp (x_charset
, "iso8859-", 8) == 0)
5297 int best_enc
= atoi (best_match
+ 8);
5298 int this_enc
= atoi (x_charset
+ 8);
5299 if (this_enc
> 0 && this_enc
< best_enc
)
5300 best_match
= x_charset
;
5305 /* If no match, encode the numeric value. */
5308 sprintf (buf
, "*-#%u", fncharset
);
5312 strncpy (buf
, best_match
, 31);
5313 /* If the charset is not fully specified, put -0 on the end. */
5314 if (!strchr (best_match
, '-'))
5316 int pos
= strlen (best_match
);
5317 /* Charset specifiers shouldn't be very long. If it is a made
5318 up one, truncating it should not do any harm since it isn't
5319 recognized anyway. */
5322 strcpy (buf
+ pos
, "-0");
5330 /* Return all the X charsets that map to a font. */
5332 w32_to_all_x_charsets (fncharset
)
5335 static char buf
[32];
5336 Lisp_Object charset_type
;
5337 Lisp_Object retval
= Qnil
;
5342 /* Handle startup case of w32-charset-info-alist not
5343 being set up yet. */
5344 if (NILP (Vw32_charset_info_alist
))
5345 return Fcons (build_string ("iso8859-1"), Qnil
);
5347 charset_type
= Qw32_charset_ansi
;
5349 case DEFAULT_CHARSET
:
5350 charset_type
= Qw32_charset_default
;
5352 case SYMBOL_CHARSET
:
5353 charset_type
= Qw32_charset_symbol
;
5355 case SHIFTJIS_CHARSET
:
5356 charset_type
= Qw32_charset_shiftjis
;
5358 case HANGEUL_CHARSET
:
5359 charset_type
= Qw32_charset_hangeul
;
5361 case GB2312_CHARSET
:
5362 charset_type
= Qw32_charset_gb2312
;
5364 case CHINESEBIG5_CHARSET
:
5365 charset_type
= Qw32_charset_chinesebig5
;
5368 charset_type
= Qw32_charset_oem
;
5371 /* More recent versions of Windows (95 and NT4.0) define more
5373 #ifdef EASTEUROPE_CHARSET
5374 case EASTEUROPE_CHARSET
:
5375 charset_type
= Qw32_charset_easteurope
;
5377 case TURKISH_CHARSET
:
5378 charset_type
= Qw32_charset_turkish
;
5380 case BALTIC_CHARSET
:
5381 charset_type
= Qw32_charset_baltic
;
5383 case RUSSIAN_CHARSET
:
5384 charset_type
= Qw32_charset_russian
;
5386 case ARABIC_CHARSET
:
5387 charset_type
= Qw32_charset_arabic
;
5390 charset_type
= Qw32_charset_greek
;
5392 case HEBREW_CHARSET
:
5393 charset_type
= Qw32_charset_hebrew
;
5395 case VIETNAMESE_CHARSET
:
5396 charset_type
= Qw32_charset_vietnamese
;
5399 charset_type
= Qw32_charset_thai
;
5402 charset_type
= Qw32_charset_mac
;
5405 charset_type
= Qw32_charset_johab
;
5409 #ifdef UNICODE_CHARSET
5410 case UNICODE_CHARSET
:
5411 charset_type
= Qw32_charset_unicode
;
5415 /* Encode numerical value of unknown charset. */
5416 sprintf (buf
, "*-#%u", fncharset
);
5417 return Fcons (build_string (buf
), Qnil
);
5422 /* Look through w32-charset-info-alist for the character set.
5423 Only return fully specified charsets for codepages which are
5426 Format of each entry in Vw32_charset_info_alist is
5427 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
5429 for (rest
= Vw32_charset_info_alist
; CONSP (rest
); rest
= XCDR (rest
))
5431 Lisp_Object x_charset
;
5432 Lisp_Object w32_charset
;
5433 Lisp_Object codepage
;
5435 Lisp_Object this_entry
= XCAR (rest
);
5437 /* Skip invalid entries in alist. */
5438 if (!CONSP (this_entry
) || !STRINGP (XCAR (this_entry
))
5439 || !CONSP (XCDR (this_entry
))
5440 || !SYMBOLP (XCAR (XCDR (this_entry
))))
5443 x_charset
= XCAR (this_entry
);
5444 w32_charset
= XCAR (XCDR (this_entry
));
5445 codepage
= XCDR (XCDR (this_entry
));
5447 if (!strchr (SDATA (x_charset
), '-'))
5450 /* Look for Same charset and a valid codepage (or non-int
5451 which means ignore). */
5452 if (EQ (w32_charset
, charset_type
)
5453 && (!INTEGERP (codepage
) || XINT (codepage
) == CP_DEFAULT
5454 || IsValidCodePage (XINT (codepage
))))
5456 retval
= Fcons (x_charset
, retval
);
5460 /* If no match, encode the numeric value. */
5463 sprintf (buf
, "*-#%u", fncharset
);
5464 return Fcons (build_string (buf
), Qnil
);
5473 /* Get the Windows codepage corresponding to the specified font. The
5474 charset info in the font name is used to look up
5475 w32-charset-to-codepage-alist. */
5477 w32_codepage_for_font (char *fontname
)
5479 Lisp_Object codepage
, entry
;
5480 char *charset_str
, *charset
, *end
;
5482 /* Extract charset part of font string. */
5483 charset
= xlfd_charset_of_font (fontname
);
5488 charset_str
= (char *) alloca (strlen (charset
) + 1);
5489 strcpy (charset_str
, charset
);
5492 /* Remove leading "*-". */
5493 if (strncmp ("*-", charset_str
, 2) == 0)
5494 charset
= charset_str
+ 2;
5497 charset
= charset_str
;
5499 /* Stop match at wildcard (including preceding '-'). */
5500 if (end
= strchr (charset
, '*'))
5502 if (end
> charset
&& *(end
-1) == '-')
5507 if (!strcmp (charset
, "iso10646"))
5510 if (NILP (Vw32_charset_info_alist
))
5513 entry
= Fassoc (build_string(charset
), Vw32_charset_info_alist
);
5517 codepage
= Fcdr (Fcdr (entry
));
5519 if (NILP (codepage
))
5521 else if (XFASTINT (codepage
) == XFASTINT (Qt
))
5523 else if (INTEGERP (codepage
))
5524 return XINT (codepage
);
5528 #endif /* OLD_FONT */
5531 w32_to_x_font (lplogfont
, lpxstr
, len
, specific_charset
)
5532 LOGFONT
* lplogfont
;
5535 char * specific_charset
;
5539 char height_pixels
[8];
5541 char width_pixels
[8];
5542 char *fontname_dash
;
5543 int display_resy
= (int) one_w32_display_info
.resy
;
5544 int display_resx
= (int) one_w32_display_info
.resx
;
5545 struct coding_system coding
;
5547 if (!lpxstr
) abort ();
5552 if (lplogfont
->lfOutPrecision
== OUT_STRING_PRECIS
)
5553 fonttype
= "raster";
5554 else if (lplogfont
->lfOutPrecision
== OUT_STROKE_PRECIS
)
5555 fonttype
= "outline";
5557 fonttype
= "unknown";
5559 setup_coding_system (Fcheck_coding_system (Vlocale_coding_system
),
5561 coding
.src_multibyte
= 0;
5562 coding
.dst_multibyte
= 1;
5563 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5564 /* We explicitely disable composition handling because selection
5565 data should not contain any composition sequence. */
5566 coding
.common_flags
&= ~CODING_ANNOTATION_MASK
;
5568 coding
.dst_bytes
= LF_FACESIZE
* 2;
5569 coding
.destination
= (unsigned char *) xmalloc (coding
.dst_bytes
+ 1);
5570 decode_coding_c_string (&coding
, lplogfont
->lfFaceName
,
5571 strlen(lplogfont
->lfFaceName
), Qnil
);
5572 fontname
= coding
.destination
;
5574 *(fontname
+ coding
.produced
) = '\0';
5576 /* Replace dashes with underscores so the dashes are not
5578 fontname_dash
= fontname
;
5579 while (fontname_dash
= strchr (fontname_dash
, '-'))
5580 *fontname_dash
= '_';
5582 if (lplogfont
->lfHeight
)
5584 sprintf (height_pixels
, "%u", eabs (lplogfont
->lfHeight
));
5585 sprintf (height_dpi
, "%u",
5586 eabs (lplogfont
->lfHeight
) * 720 / display_resy
);
5590 strcpy (height_pixels
, "*");
5591 strcpy (height_dpi
, "*");
5594 #if 0 /* Never put the width in the xlfd. It fails on fonts with
5595 double-width characters. */
5596 if (lplogfont
->lfWidth
)
5597 sprintf (width_pixels
, "%u", lplogfont
->lfWidth
* 10);
5600 strcpy (width_pixels
, "*");
5602 _snprintf (lpxstr
, len
- 1,
5603 "-%s-%s-%s-%c-normal-normal-%s-%s-%d-%d-%c-%s-%s",
5604 fonttype
, /* foundry */
5605 fontname
, /* family */
5606 w32_to_x_weight (lplogfont
->lfWeight
), /* weight */
5607 lplogfont
->lfItalic
?'i':'r', /* slant */
5609 /* add style name */
5610 height_pixels
, /* pixel size */
5611 height_dpi
, /* point size */
5612 display_resx
, /* resx */
5613 display_resy
, /* resy */
5614 ((lplogfont
->lfPitchAndFamily
& 0x3) == VARIABLE_PITCH
)
5615 ? 'p' : 'c', /* spacing */
5616 width_pixels
, /* avg width */
5617 w32_to_x_charset (lplogfont
->lfCharSet
, specific_charset
)
5618 /* charset registry and encoding */
5621 lpxstr
[len
- 1] = 0; /* just to be sure */
5626 x_to_w32_font (lpxstr
, lplogfont
)
5628 LOGFONT
* lplogfont
;
5630 struct coding_system coding
;
5632 if (!lplogfont
) return (FALSE
);
5634 memset (lplogfont
, 0, sizeof (*lplogfont
));
5636 /* Set default value for each field. */
5638 lplogfont
->lfOutPrecision
= OUT_DEFAULT_PRECIS
;
5639 lplogfont
->lfClipPrecision
= CLIP_DEFAULT_PRECIS
;
5640 lplogfont
->lfQuality
= DEFAULT_QUALITY
;
5642 /* go for maximum quality */
5643 lplogfont
->lfOutPrecision
= OUT_STROKE_PRECIS
;
5644 lplogfont
->lfClipPrecision
= CLIP_STROKE_PRECIS
;
5645 lplogfont
->lfQuality
= PROOF_QUALITY
;
5648 lplogfont
->lfCharSet
= DEFAULT_CHARSET
;
5649 lplogfont
->lfWeight
= FW_DONTCARE
;
5650 lplogfont
->lfPitchAndFamily
= DEFAULT_PITCH
| FF_DONTCARE
;
5655 /* Provide a simple escape mechanism for specifying Windows font names
5656 * directly -- if font spec does not beginning with '-', assume this
5658 * "<font name>[:height in pixels[:width in pixels[:weight]]]"
5664 char name
[50], weight
[20], slant
, pitch
, pixels
[10], height
[10],
5665 width
[10], resy
[10], remainder
[50];
5667 int dpi
= (int) one_w32_display_info
.resy
;
5669 fields
= sscanf (lpxstr
,
5670 "-%*[^-]-%49[^-]-%19[^-]-%c-%*[^-]-%*[^-]-%9[^-]-%9[^-]-%*[^-]-%9[^-]-%c-%9[^-]-%49s",
5671 name
, weight
, &slant
, pixels
, height
, resy
, &pitch
, width
, remainder
);
5675 /* In the general case when wildcards cover more than one field,
5676 we don't know which field is which, so don't fill any in.
5677 However, we need to cope with this particular form, which is
5678 generated by font_list_1 (invoked by try_font_list):
5679 "-raster-6x10-*-gb2312*-*"
5680 and make sure to correctly parse the charset field. */
5683 fields
= sscanf (lpxstr
,
5684 "-%*[^-]-%49[^-]-*-%49s",
5687 else if (fields
< 9)
5693 if (fields
> 0 && name
[0] != '*')
5695 Lisp_Object string
= build_string (name
);
5697 (Fcheck_coding_system (Vlocale_coding_system
), &coding
);
5698 coding
.mode
|= (CODING_MODE_SAFE_ENCODING
| CODING_MODE_LAST_BLOCK
);
5699 /* Disable composition/charset annotation. */
5700 coding
.common_flags
&= ~CODING_ANNOTATION_MASK
;
5701 coding
.dst_bytes
= SCHARS (string
) * 2;
5703 coding
.destination
= (unsigned char *) xmalloc (coding
.dst_bytes
);
5704 encode_coding_object (&coding
, string
, 0, 0,
5705 SCHARS (string
), SBYTES (string
), Qnil
);
5706 if (coding
.produced
>= LF_FACESIZE
)
5707 coding
.produced
= LF_FACESIZE
- 1;
5709 coding
.destination
[coding
.produced
] = '\0';
5711 strcpy (lplogfont
->lfFaceName
, coding
.destination
);
5712 xfree (coding
.destination
);
5716 lplogfont
->lfFaceName
[0] = '\0';
5721 lplogfont
->lfWeight
= x_to_w32_weight ((fields
> 0 ? weight
: ""));
5725 lplogfont
->lfItalic
= (fields
> 0 && slant
== 'i');
5729 if (fields
> 0 && pixels
[0] != '*')
5730 lplogfont
->lfHeight
= atoi (pixels
);
5734 if (fields
> 0 && resy
[0] != '*')
5737 if (tem
> 0) dpi
= tem
;
5740 if (fields
> -1 && lplogfont
->lfHeight
== 0 && height
[0] != '*')
5741 lplogfont
->lfHeight
= atoi (height
) * dpi
/ 720;
5746 lplogfont
->lfPitchAndFamily
= VARIABLE_PITCH
| FF_DONTCARE
;
5747 else if (pitch
== 'c')
5748 lplogfont
->lfPitchAndFamily
= FIXED_PITCH
| FF_DONTCARE
;
5753 if (fields
> 0 && width
[0] != '*')
5754 lplogfont
->lfWidth
= atoi (width
) / 10;
5758 /* Strip the trailing '-' if present. (it shouldn't be, as it
5759 fails the test against xlfd-tight-regexp in fontset.el). */
5761 int len
= strlen (remainder
);
5762 if (len
> 0 && remainder
[len
-1] == '-')
5763 remainder
[len
-1] = 0;
5765 encoding
= remainder
;
5767 if (strncmp (encoding
, "*-", 2) == 0)
5770 lplogfont
->lfCharSet
= x_to_w32_charset (encoding
);
5775 char name
[100], height
[10], width
[10], weight
[20];
5777 fields
= sscanf (lpxstr
,
5778 "%99[^:]:%9[^:]:%9[^:]:%19s",
5779 name
, height
, width
, weight
);
5781 if (fields
== EOF
) return (FALSE
);
5785 strncpy (lplogfont
->lfFaceName
, name
, LF_FACESIZE
);
5786 lplogfont
->lfFaceName
[LF_FACESIZE
-1] = 0;
5790 lplogfont
->lfFaceName
[0] = 0;
5796 lplogfont
->lfHeight
= atoi (height
);
5801 lplogfont
->lfWidth
= atoi (width
);
5805 lplogfont
->lfWeight
= x_to_w32_weight ((fields
> 0 ? weight
: ""));
5808 /* This makes TrueType fonts work better. */
5809 lplogfont
->lfHeight
= - eabs (lplogfont
->lfHeight
);
5816 /* Strip the pixel height and point height from the given xlfd, and
5817 return the pixel height. If no pixel height is specified, calculate
5818 one from the point height, or if that isn't defined either, return
5819 0 (which usually signifies a scalable font).
5822 xlfd_strip_height (char *fontname
)
5824 int pixel_height
, field_number
;
5825 char *read_from
, *write_to
;
5829 pixel_height
= field_number
= 0;
5832 /* Look for height fields. */
5833 for (read_from
= fontname
; *read_from
; read_from
++)
5835 if (*read_from
== '-')
5838 if (field_number
== 7) /* Pixel height. */
5841 write_to
= read_from
;
5843 /* Find end of field. */
5844 for (;*read_from
&& *read_from
!= '-'; read_from
++)
5847 /* Split the fontname at end of field. */
5853 pixel_height
= atoi (write_to
);
5854 /* Blank out field. */
5855 if (read_from
> write_to
)
5860 /* If the pixel height field is at the end (partial xlfd),
5863 return pixel_height
;
5865 /* If we got a pixel height, the point height can be
5866 ignored. Just blank it out and break now. */
5869 /* Find end of point size field. */
5870 for (; *read_from
&& *read_from
!= '-'; read_from
++)
5876 /* Blank out the point size field. */
5877 if (read_from
> write_to
)
5883 return pixel_height
;
5887 /* If the point height is already blank, break now. */
5888 if (*read_from
== '-')
5894 else if (field_number
== 8)
5896 /* If we didn't get a pixel height, try to get the point
5897 height and convert that. */
5899 char *point_size_start
= read_from
++;
5901 /* Find end of field. */
5902 for (; *read_from
&& *read_from
!= '-'; read_from
++)
5911 point_size
= atoi (point_size_start
);
5913 /* Convert to pixel height. */
5914 pixel_height
= point_size
5915 * one_w32_display_info
.height_in
/ 720;
5917 /* Blank out this field and break. */
5925 /* Shift the rest of the font spec into place. */
5926 if (write_to
&& read_from
> write_to
)
5928 for (; *read_from
; read_from
++, write_to
++)
5929 *write_to
= *read_from
;
5933 return pixel_height
;
5936 /* Assume parameter 1 is fully qualified, no wildcards. */
5938 w32_font_match (fontname
, pattern
)
5943 char *font_name_copy
;
5944 char *regex
= alloca (strlen (pattern
) * 2 + 3);
5946 font_name_copy
= alloca (strlen (fontname
) + 1);
5947 strcpy (font_name_copy
, fontname
);
5952 /* Turn pattern into a regexp and do a regexp match. */
5953 for (; *pattern
; pattern
++)
5955 if (*pattern
== '?')
5957 else if (*pattern
== '*')
5968 /* Strip out font heights and compare them seperately, since
5969 rounding error can cause mismatches. This also allows a
5970 comparison between a font that declares only a pixel height and a
5971 pattern that declares the point height.
5974 int font_height
, pattern_height
;
5976 font_height
= xlfd_strip_height (font_name_copy
);
5977 pattern_height
= xlfd_strip_height (regex
);
5979 /* Compare now, and don't bother doing expensive regexp matching
5980 if the heights differ. */
5981 if (font_height
&& pattern_height
&& (font_height
!= pattern_height
))
5985 return (fast_string_match_ignore_case (build_string (regex
),
5986 build_string (font_name_copy
)) >= 0);
5989 /* Callback functions, and a structure holding info they need, for
5990 listing system fonts on W32. We need one set of functions to do the
5991 job properly, but these don't work on NT 3.51 and earlier, so we
5992 have a second set which don't handle character sets properly to
5995 In both cases, there are two passes made. The first pass gets one
5996 font from each family, the second pass lists all the fonts from
5999 typedef struct enumfont_t
6004 XFontStruct
*size_ref
;
6005 Lisp_Object pattern
;
6011 enum_font_maybe_add_to_list (enumfont_t
*, LOGFONT
*, char *, Lisp_Object
);
6015 enum_font_cb2 (lplf
, lptm
, FontType
, lpef
)
6017 NEWTEXTMETRIC
* lptm
;
6021 /* Ignore struck out and underlined versions of fonts. */
6022 if (lplf
->elfLogFont
.lfStrikeOut
|| lplf
->elfLogFont
.lfUnderline
)
6025 /* Only return fonts with names starting with @ if they were
6026 explicitly specified, since Microsoft uses an initial @ to
6027 denote fonts for vertical writing, without providing a more
6028 convenient way of identifying them. */
6029 if (lplf
->elfLogFont
.lfFaceName
[0] == '@'
6030 && lpef
->logfont
.lfFaceName
[0] != '@')
6033 /* Check that the character set matches if it was specified */
6034 if (lpef
->logfont
.lfCharSet
!= DEFAULT_CHARSET
&&
6035 lplf
->elfLogFont
.lfCharSet
!= lpef
->logfont
.lfCharSet
)
6038 if (FontType
== RASTER_FONTTYPE
)
6040 /* DBCS raster fonts have problems displaying, so skip them. */
6041 int charset
= lplf
->elfLogFont
.lfCharSet
;
6042 if (charset
== SHIFTJIS_CHARSET
6043 || charset
== HANGEUL_CHARSET
6044 || charset
== CHINESEBIG5_CHARSET
6045 || charset
== GB2312_CHARSET
6046 #ifdef JOHAB_CHARSET
6047 || charset
== JOHAB_CHARSET
6055 Lisp_Object width
= Qnil
;
6056 Lisp_Object charset_list
= Qnil
;
6057 char *charset
= NULL
;
6059 /* Truetype fonts do not report their true metrics until loaded */
6060 if (FontType
!= RASTER_FONTTYPE
)
6062 if (!NILP (lpef
->pattern
))
6064 /* Scalable fonts are as big as you want them to be. */
6065 lplf
->elfLogFont
.lfHeight
= lpef
->logfont
.lfHeight
;
6066 lplf
->elfLogFont
.lfWidth
= lpef
->logfont
.lfWidth
;
6067 width
= make_number (lpef
->logfont
.lfWidth
);
6071 lplf
->elfLogFont
.lfHeight
= 0;
6072 lplf
->elfLogFont
.lfWidth
= 0;
6076 /* Make sure the height used here is the same as everywhere
6077 else (ie character height, not cell height). */
6078 if (lplf
->elfLogFont
.lfHeight
> 0)
6080 /* lptm can be trusted for RASTER fonts, but not scalable ones. */
6081 if (FontType
== RASTER_FONTTYPE
)
6082 lplf
->elfLogFont
.lfHeight
= lptm
->tmInternalLeading
- lptm
->tmHeight
;
6084 lplf
->elfLogFont
.lfHeight
= -lplf
->elfLogFont
.lfHeight
;
6087 if (!NILP (lpef
->pattern
))
6089 charset
= xlfd_charset_of_font (SDATA (lpef
->pattern
));
6091 /* We already checked charsets above, but DEFAULT_CHARSET
6092 slipped through. So only allow exact matches for DEFAULT_CHARSET. */
6094 && strncmp (charset
, "*-*", 3) != 0
6095 && lpef
->logfont
.lfCharSet
== DEFAULT_CHARSET
6096 && strcmp (charset
, w32_to_x_charset (DEFAULT_CHARSET
, NULL
)) != 0)
6099 /* Reject raster fonts if we are looking for a unicode font. */
6101 && FontType
== RASTER_FONTTYPE
6102 && strncmp (charset
, "iso10646", 8) == 0)
6107 charset_list
= Fcons (build_string (charset
), Qnil
);
6109 /* Always prefer unicode. */
6111 = Fcons (build_string ("iso10646-1"),
6112 w32_to_all_x_charsets (lplf
->elfLogFont
.lfCharSet
));
6114 /* Loop through the charsets. */
6115 for ( ; CONSP (charset_list
); charset_list
= Fcdr (charset_list
))
6117 Lisp_Object this_charset
= Fcar (charset_list
);
6118 charset
= SDATA (this_charset
);
6120 /* Don't list raster fonts as unicode. */
6122 && FontType
== RASTER_FONTTYPE
6123 && strncmp (charset
, "iso10646", 8) == 0)
6126 enum_font_maybe_add_to_list (lpef
, &(lplf
->elfLogFont
),
6129 /* List bold and italic variations if w32-enable-synthesized-fonts
6130 is non-nil and this is a plain font. */
6131 if (w32_enable_synthesized_fonts
6132 && lplf
->elfLogFont
.lfWeight
== FW_NORMAL
6133 && lplf
->elfLogFont
.lfItalic
== FALSE
)
6136 lplf
->elfLogFont
.lfWeight
= FW_BOLD
;
6137 enum_font_maybe_add_to_list (lpef
, &(lplf
->elfLogFont
),
6140 lplf
->elfLogFont
.lfItalic
= TRUE
;
6141 enum_font_maybe_add_to_list (lpef
, &(lplf
->elfLogFont
),
6144 lplf
->elfLogFont
.lfWeight
= FW_NORMAL
;
6145 enum_font_maybe_add_to_list (lpef
, &(lplf
->elfLogFont
),
6155 enum_font_maybe_add_to_list (lpef
, logfont
, match_charset
, width
)
6158 char * match_charset
;
6163 if (!w32_to_x_font (logfont
, buf
, 100, match_charset
))
6166 if (NILP (lpef
->pattern
)
6167 || w32_font_match (buf
, SDATA (lpef
->pattern
)))
6169 /* Check if we already listed this font. This may happen if
6170 w32_enable_synthesized_fonts is non-nil, and there are real
6171 bold and italic versions of the font. */
6172 Lisp_Object font_name
= build_string (buf
);
6173 if (NILP (Fmember (font_name
, lpef
->list
)))
6175 Lisp_Object entry
= Fcons (font_name
, width
);
6176 lpef
->list
= Fcons (entry
, lpef
->list
);
6184 enum_font_cb1 (lplf
, lptm
, FontType
, lpef
)
6186 NEWTEXTMETRIC
* lptm
;
6190 return EnumFontFamilies (lpef
->hdc
,
6191 lplf
->elfLogFont
.lfFaceName
,
6192 (FONTENUMPROC
) enum_font_cb2
,
6198 enum_fontex_cb2 (lplf
, lptm
, font_type
, lpef
)
6199 ENUMLOGFONTEX
* lplf
;
6200 NEWTEXTMETRICEX
* lptm
;
6204 /* We are not interested in the extra info we get back from the 'Ex
6205 version - only the fact that we get character set variations
6206 enumerated seperately. */
6207 return enum_font_cb2 ((ENUMLOGFONT
*) lplf
, (NEWTEXTMETRIC
*) lptm
,
6212 enum_fontex_cb1 (lplf
, lptm
, font_type
, lpef
)
6213 ENUMLOGFONTEX
* lplf
;
6214 NEWTEXTMETRICEX
* lptm
;
6218 HMODULE gdi32
= GetModuleHandle ("gdi32.dll");
6219 FARPROC enum_font_families_ex
6220 = GetProcAddress ( gdi32
, "EnumFontFamiliesExA");
6221 /* We don't really expect EnumFontFamiliesEx to disappear once we
6222 get here, so don't bother handling it gracefully. */
6223 if (enum_font_families_ex
== NULL
)
6224 error ("gdi32.dll has disappeared!");
6225 return enum_font_families_ex (lpef
->hdc
,
6227 (FONTENUMPROC
) enum_fontex_cb2
,
6231 /* Interface to fontset handler. (adapted from mw32font.c in Meadow
6232 and xterm.c in Emacs 20.3) */
6235 w32_list_bdf_fonts (Lisp_Object pattern
, int max_names
)
6237 char *fontname
, *ptnstr
;
6238 Lisp_Object list
, tem
, newlist
= Qnil
;
6241 list
= Vw32_bdf_filename_alist
;
6242 ptnstr
= SDATA (pattern
);
6244 for ( ; CONSP (list
); list
= XCDR (list
))
6248 fontname
= SDATA (XCAR (tem
));
6249 else if (STRINGP (tem
))
6250 fontname
= SDATA (tem
);
6254 if (w32_font_match (fontname
, ptnstr
))
6256 newlist
= Fcons (XCAR (tem
), newlist
);
6258 if (max_names
>= 0 && n_fonts
>= max_names
)
6267 /* Return a list of names of available fonts matching PATTERN on frame
6268 F. If SIZE is not 0, it is the size (maximum bound width) of fonts
6269 to be listed. Frame F NULL means we have not yet created any
6270 frame, which means we can't get proper size info, as we don't have
6271 a device context to use for GetTextMetrics.
6272 MAXNAMES sets a limit on how many fonts to match. If MAXNAMES is
6273 negative, then all matching fonts are returned. */
6276 w32_list_fonts (f
, pattern
, size
, maxnames
)
6278 Lisp_Object pattern
;
6282 Lisp_Object patterns
, key
= Qnil
, tem
, tpat
;
6283 Lisp_Object list
= Qnil
, newlist
= Qnil
, second_best
= Qnil
;
6284 struct w32_display_info
*dpyinfo
= &one_w32_display_info
;
6287 patterns
= Fassoc (pattern
, Valternate_fontname_alist
);
6288 if (NILP (patterns
))
6289 patterns
= Fcons (pattern
, Qnil
);
6291 for (; CONSP (patterns
); patterns
= XCDR (patterns
))
6296 tpat
= XCAR (patterns
);
6298 if (!STRINGP (tpat
))
6301 /* Avoid expensive EnumFontFamilies functions if we are not
6302 going to be able to output one of these anyway. */
6303 codepage
= w32_codepage_for_font (SDATA (tpat
));
6304 if (codepage
!= CP_8BIT
&& codepage
!= CP_UNICODE
6305 && codepage
!= CP_DEFAULT
&& codepage
!= CP_UNKNOWN
6306 && !IsValidCodePage (codepage
))
6309 /* See if we cached the result for this particular query.
6310 The cache is an alist of the form:
6311 ((PATTERN (FONTNAME . WIDTH) ...) ...)
6313 if (tem
= XCDR (dpyinfo
->name_list_element
),
6314 !NILP (list
= Fassoc (tpat
, tem
)))
6316 list
= Fcdr_safe (list
);
6317 /* We have a cached list. Don't have to get the list again. */
6322 /* At first, put PATTERN in the cache. */
6327 /* Use EnumFontFamiliesEx where it is available, as it knows
6328 about character sets. Fall back to EnumFontFamilies for
6329 older versions of NT that don't support the 'Ex function. */
6330 x_to_w32_font (SDATA (tpat
), &ef
.logfont
);
6332 LOGFONT font_match_pattern
;
6333 HMODULE gdi32
= GetModuleHandle ("gdi32.dll");
6334 FARPROC enum_font_families_ex
6335 = GetProcAddress ( gdi32
, "EnumFontFamiliesExA");
6337 /* We do our own pattern matching so we can handle wildcards. */
6338 font_match_pattern
.lfFaceName
[0] = 0;
6339 font_match_pattern
.lfPitchAndFamily
= 0;
6340 /* We can use the charset, because if it is a wildcard it will
6341 be DEFAULT_CHARSET anyway. */
6342 font_match_pattern
.lfCharSet
= ef
.logfont
.lfCharSet
;
6344 ef
.hdc
= GetDC (dpyinfo
->root_window
);
6346 if (enum_font_families_ex
)
6347 enum_font_families_ex (ef
.hdc
,
6348 &font_match_pattern
,
6349 (FONTENUMPROC
) enum_fontex_cb1
,
6352 EnumFontFamilies (ef
.hdc
, NULL
, (FONTENUMPROC
) enum_font_cb1
,
6355 ReleaseDC (dpyinfo
->root_window
, ef
.hdc
);
6361 /* Make a list of the fonts we got back.
6362 Store that in the font cache for the display. */
6363 XSETCDR (dpyinfo
->name_list_element
,
6364 Fcons (Fcons (tpat
, list
),
6365 XCDR (dpyinfo
->name_list_element
)));
6368 if (NILP (list
)) continue; /* Try the remaining alternatives. */
6370 newlist
= second_best
= Qnil
;
6372 /* Make a list of the fonts that have the right width. */
6373 for (; CONSP (list
); list
= XCDR (list
))
6380 if (NILP (XCAR (tem
)))
6384 newlist
= Fcons (XCAR (tem
), newlist
);
6386 if (maxnames
>= 0 && n_fonts
>= maxnames
)
6391 if (!INTEGERP (XCDR (tem
)))
6393 /* Since we don't yet know the size of the font, we must
6394 load it and try GetTextMetrics. */
6395 W32FontStruct thisinfo
;
6400 if (!x_to_w32_font (SDATA (XCAR (tem
)), &lf
))
6404 thisinfo
.bdf
= NULL
;
6405 thisinfo
.hfont
= CreateFontIndirect (&lf
);
6406 if (thisinfo
.hfont
== NULL
)
6409 hdc
= GetDC (dpyinfo
->root_window
);
6410 oldobj
= SelectObject (hdc
, thisinfo
.hfont
);
6411 if (GetTextMetrics (hdc
, &thisinfo
.tm
))
6412 XSETCDR (tem
, make_number (FONT_AVG_WIDTH (&thisinfo
)));
6414 XSETCDR (tem
, make_number (0));
6415 SelectObject (hdc
, oldobj
);
6416 ReleaseDC (dpyinfo
->root_window
, hdc
);
6417 DeleteObject (thisinfo
.hfont
);
6420 found_size
= XINT (XCDR (tem
));
6421 if (found_size
== size
)
6423 newlist
= Fcons (XCAR (tem
), newlist
);
6425 if (maxnames
>= 0 && n_fonts
>= maxnames
)
6428 /* keep track of the closest matching size in case
6429 no exact match is found. */
6430 else if (found_size
> 0)
6432 if (NILP (second_best
))
6435 else if (found_size
< size
)
6437 if (XINT (XCDR (second_best
)) > size
6438 || XINT (XCDR (second_best
)) < found_size
)
6443 if (XINT (XCDR (second_best
)) > size
6444 && XINT (XCDR (second_best
)) >
6451 if (!NILP (newlist
))
6453 else if (!NILP (second_best
))
6455 newlist
= Fcons (XCAR (second_best
), Qnil
);
6460 /* Include any bdf fonts. */
6461 if (n_fonts
< maxnames
|| maxnames
< 0)
6463 Lisp_Object combined
[2];
6464 combined
[0] = w32_list_bdf_fonts (pattern
, maxnames
- n_fonts
);
6465 combined
[1] = newlist
;
6466 newlist
= Fnconc (2, combined
);
6473 /* Return a pointer to struct font_info of font FONT_IDX of frame F. */
6475 w32_get_font_info (f
, font_idx
)
6479 return (FRAME_W32_FONT_TABLE (f
) + font_idx
);
6484 w32_query_font (struct frame
*f
, char *fontname
)
6487 struct font_info
*pfi
;
6489 pfi
= FRAME_W32_FONT_TABLE (f
);
6491 for (i
= 0; i
< one_w32_display_info
.n_fonts
;i
++, pfi
++)
6493 if (xstrcasecmp (pfi
->name
, fontname
) == 0) return pfi
;
6499 /* Find a CCL program for a font specified by FONTP, and set the member
6500 `encoder' of the structure. */
6503 w32_find_ccl_program (fontp
)
6504 struct font_info
*fontp
;
6506 Lisp_Object list
, elt
;
6508 for (list
= Vfont_ccl_encoder_alist
; CONSP (list
); list
= XCDR (list
))
6512 && STRINGP (XCAR (elt
))
6513 && (fast_c_string_match_ignore_case (XCAR (elt
), fontp
->name
)
6519 struct ccl_program
*ccl
6520 = (struct ccl_program
*) xmalloc (sizeof (struct ccl_program
));
6522 if (setup_ccl_program (ccl
, XCDR (elt
)) < 0)
6525 fontp
->font_encoder
= ccl
;
6529 #endif /* OLD_FONT */
6531 /* directory-files from dired.c. */
6532 Lisp_Object Fdirectory_files
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
, Lisp_Object
));
6537 /* Find BDF files in a specified directory. (use GCPRO when calling,
6538 as this calls lisp to get a directory listing). */
6540 w32_find_bdf_fonts_in_dir (Lisp_Object directory
)
6542 Lisp_Object filelist
, list
= Qnil
;
6545 if (!STRINGP (directory
))
6548 filelist
= Fdirectory_files (directory
, Qt
,
6549 build_string (".*\\.[bB][dD][fF]"), Qt
);
6551 for ( ; CONSP (filelist
); filelist
= XCDR (filelist
))
6553 Lisp_Object filename
= XCAR (filelist
);
6554 if (w32_BDF_to_x_font (SDATA (filename
), fontname
, 100))
6555 store_in_alist (&list
, build_string (fontname
), filename
);
6560 DEFUN ("w32-find-bdf-fonts", Fw32_find_bdf_fonts
, Sw32_find_bdf_fonts
,
6562 doc
: /* Return a list of BDF fonts in DIRECTORY.
6563 The list is suitable for appending to `w32-bdf-filename-alist'.
6564 Fonts which do not contain an xlfd description will not be included
6565 in the list. DIRECTORY may be a list of directories. */)
6567 Lisp_Object directory
;
6569 Lisp_Object list
= Qnil
;
6570 struct gcpro gcpro1
, gcpro2
;
6572 if (!CONSP (directory
))
6573 return w32_find_bdf_fonts_in_dir (directory
);
6575 for ( ; CONSP (directory
); directory
= XCDR (directory
))
6577 Lisp_Object pair
[2];
6580 GCPRO2 (directory
, list
);
6581 pair
[1] = w32_find_bdf_fonts_in_dir ( XCAR (directory
) );
6582 list
= Fnconc ( 2, pair
);
6587 #endif /* OLD_FONT */
6590 DEFUN ("xw-color-defined-p", Fxw_color_defined_p
, Sxw_color_defined_p
, 1, 2, 0,
6591 doc
: /* Internal function called by `color-defined-p', which see. */)
6593 Lisp_Object color
, frame
;
6596 FRAME_PTR f
= check_x_frame (frame
);
6598 CHECK_STRING (color
);
6600 if (w32_defined_color (f
, SDATA (color
), &foo
, 0))
6606 DEFUN ("xw-color-values", Fxw_color_values
, Sxw_color_values
, 1, 2, 0,
6607 doc
: /* Internal function called by `color-values', which see. */)
6609 Lisp_Object color
, frame
;
6612 FRAME_PTR f
= check_x_frame (frame
);
6614 CHECK_STRING (color
);
6616 if (w32_defined_color (f
, SDATA (color
), &foo
, 0))
6617 return list3 (make_number ((GetRValue (foo
.pixel
) << 8)
6618 | GetRValue (foo
.pixel
)),
6619 make_number ((GetGValue (foo
.pixel
) << 8)
6620 | GetGValue (foo
.pixel
)),
6621 make_number ((GetBValue (foo
.pixel
) << 8)
6622 | GetBValue (foo
.pixel
)));
6627 DEFUN ("xw-display-color-p", Fxw_display_color_p
, Sxw_display_color_p
, 0, 1, 0,
6628 doc
: /* Internal function called by `display-color-p', which see. */)
6630 Lisp_Object display
;
6632 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6634 if ((dpyinfo
->n_planes
* dpyinfo
->n_cbits
) <= 2)
6640 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
,
6641 Sx_display_grayscale_p
, 0, 1, 0,
6642 doc
: /* Return t if DISPLAY supports shades of gray.
6643 Note that color displays do support shades of gray.
6644 The optional argument DISPLAY specifies which display to ask about.
6645 DISPLAY should be either a frame or a display name (a string).
6646 If omitted or nil, that stands for the selected frame's display. */)
6648 Lisp_Object display
;
6650 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6652 if ((dpyinfo
->n_planes
* dpyinfo
->n_cbits
) <= 1)
6658 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
,
6659 Sx_display_pixel_width
, 0, 1, 0,
6660 doc
: /* Return the width in pixels of DISPLAY.
6661 The optional argument DISPLAY specifies which display to ask about.
6662 DISPLAY should be either a frame or a display name (a string).
6663 If omitted or nil, that stands for the selected frame's display. */)
6665 Lisp_Object display
;
6667 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6669 return make_number (dpyinfo
->width
);
6672 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
6673 Sx_display_pixel_height
, 0, 1, 0,
6674 doc
: /* Return the height in pixels of DISPLAY.
6675 The optional argument DISPLAY specifies which display to ask about.
6676 DISPLAY should be either a frame or a display name (a string).
6677 If omitted or nil, that stands for the selected frame's display. */)
6679 Lisp_Object display
;
6681 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6683 return make_number (dpyinfo
->height
);
6686 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
6688 doc
: /* Return the number of bitplanes of DISPLAY.
6689 The optional argument DISPLAY specifies which display to ask about.
6690 DISPLAY should be either a frame or a display name (a string).
6691 If omitted or nil, that stands for the selected frame's display. */)
6693 Lisp_Object display
;
6695 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6697 return make_number (dpyinfo
->n_planes
* dpyinfo
->n_cbits
);
6700 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
6702 doc
: /* Return the number of color cells of DISPLAY.
6703 The optional argument DISPLAY specifies which display to ask about.
6704 DISPLAY should be either a frame or a display name (a string).
6705 If omitted or nil, that stands for the selected frame's display. */)
6707 Lisp_Object display
;
6709 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6713 hdc
= GetDC (dpyinfo
->root_window
);
6714 if (dpyinfo
->has_palette
)
6715 cap
= GetDeviceCaps (hdc
, SIZEPALETTE
);
6717 cap
= GetDeviceCaps (hdc
, NUMCOLORS
);
6719 /* We force 24+ bit depths to 24-bit, both to prevent an overflow
6720 and because probably is more meaningful on Windows anyway */
6722 cap
= 1 << min (dpyinfo
->n_planes
* dpyinfo
->n_cbits
, 24);
6724 ReleaseDC (dpyinfo
->root_window
, hdc
);
6726 return make_number (cap
);
6729 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
6730 Sx_server_max_request_size
,
6732 doc
: /* Return the maximum request size of the server of DISPLAY.
6733 The optional argument DISPLAY specifies which display to ask about.
6734 DISPLAY should be either a frame or a display name (a string).
6735 If omitted or nil, that stands for the selected frame's display. */)
6737 Lisp_Object display
;
6739 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6741 return make_number (1);
6744 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
6745 doc
: /* Return the "vendor ID" string of the W32 system (Microsoft).
6746 The optional argument DISPLAY specifies which display to ask about.
6747 DISPLAY should be either a frame or a display name (a string).
6748 If omitted or nil, that stands for the selected frame's display. */)
6750 Lisp_Object display
;
6752 return build_string ("Microsoft Corp.");
6755 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
6756 doc
: /* Return the version numbers of the server of DISPLAY.
6757 The value is a list of three integers: the major and minor
6758 version numbers of the X Protocol in use, and the distributor-specific
6759 release number. See also the function `x-server-vendor'.
6761 The optional argument DISPLAY specifies which display to ask about.
6762 DISPLAY should be either a frame or a display name (a string).
6763 If omitted or nil, that stands for the selected frame's display. */)
6765 Lisp_Object display
;
6767 return Fcons (make_number (w32_major_version
),
6768 Fcons (make_number (w32_minor_version
),
6769 Fcons (make_number (w32_build_number
), Qnil
)));
6772 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
6773 doc
: /* Return the number of screens on the server of DISPLAY.
6774 The optional argument DISPLAY specifies which display to ask about.
6775 DISPLAY should be either a frame or a display name (a string).
6776 If omitted or nil, that stands for the selected frame's display. */)
6778 Lisp_Object display
;
6780 return make_number (1);
6783 DEFUN ("x-display-mm-height", Fx_display_mm_height
,
6784 Sx_display_mm_height
, 0, 1, 0,
6785 doc
: /* Return the height in millimeters of DISPLAY.
6786 The optional argument DISPLAY specifies which display to ask about.
6787 DISPLAY should be either a frame or a display name (a string).
6788 If omitted or nil, that stands for the selected frame's display. */)
6790 Lisp_Object display
;
6792 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6796 hdc
= GetDC (dpyinfo
->root_window
);
6798 cap
= GetDeviceCaps (hdc
, VERTSIZE
);
6800 ReleaseDC (dpyinfo
->root_window
, hdc
);
6802 return make_number (cap
);
6805 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
6806 doc
: /* Return the width in millimeters of DISPLAY.
6807 The optional argument DISPLAY specifies which display to ask about.
6808 DISPLAY should be either a frame or a display name (a string).
6809 If omitted or nil, that stands for the selected frame's display. */)
6811 Lisp_Object display
;
6813 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6818 hdc
= GetDC (dpyinfo
->root_window
);
6820 cap
= GetDeviceCaps (hdc
, HORZSIZE
);
6822 ReleaseDC (dpyinfo
->root_window
, hdc
);
6824 return make_number (cap
);
6827 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
6828 Sx_display_backing_store
, 0, 1, 0,
6829 doc
: /* Return an indication of whether DISPLAY does backing store.
6830 The value may be `always', `when-mapped', or `not-useful'.
6831 The optional argument DISPLAY specifies which display to ask about.
6832 DISPLAY should be either a frame or a display name (a string).
6833 If omitted or nil, that stands for the selected frame's display. */)
6835 Lisp_Object display
;
6837 return intern ("not-useful");
6840 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
6841 Sx_display_visual_class
, 0, 1, 0,
6842 doc
: /* Return the visual class of DISPLAY.
6843 The value is one of the symbols `static-gray', `gray-scale',
6844 `static-color', `pseudo-color', `true-color', or `direct-color'.
6846 The optional argument DISPLAY specifies which display to ask about.
6847 DISPLAY should be either a frame or a display name (a string).
6848 If omitted or nil, that stands for the selected frame's display. */)
6850 Lisp_Object display
;
6852 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6853 Lisp_Object result
= Qnil
;
6855 if (dpyinfo
->has_palette
)
6856 result
= intern ("pseudo-color");
6857 else if (dpyinfo
->n_planes
* dpyinfo
->n_cbits
== 1)
6858 result
= intern ("static-grey");
6859 else if (dpyinfo
->n_planes
* dpyinfo
->n_cbits
== 4)
6860 result
= intern ("static-color");
6861 else if (dpyinfo
->n_planes
* dpyinfo
->n_cbits
> 8)
6862 result
= intern ("true-color");
6867 DEFUN ("x-display-save-under", Fx_display_save_under
,
6868 Sx_display_save_under
, 0, 1, 0,
6869 doc
: /* Return t if DISPLAY supports the save-under feature.
6870 The optional argument DISPLAY specifies which display to ask about.
6871 DISPLAY should be either a frame or a display name (a string).
6872 If omitted or nil, that stands for the selected frame's display. */)
6874 Lisp_Object display
;
6881 register struct frame
*f
;
6883 return FRAME_PIXEL_WIDTH (f
);
6888 register struct frame
*f
;
6890 return FRAME_PIXEL_HEIGHT (f
);
6895 register struct frame
*f
;
6897 return FRAME_COLUMN_WIDTH (f
);
6902 register struct frame
*f
;
6904 return FRAME_LINE_HEIGHT (f
);
6909 register struct frame
*f
;
6911 return FRAME_W32_DISPLAY_INFO (f
)->n_planes
;
6914 /* Return the display structure for the display named NAME.
6915 Open a new connection if necessary. */
6917 struct w32_display_info
*
6918 x_display_info_for_name (name
)
6922 struct w32_display_info
*dpyinfo
;
6924 CHECK_STRING (name
);
6926 for (dpyinfo
= &one_w32_display_info
, names
= w32_display_name_list
;
6928 dpyinfo
= dpyinfo
->next
, names
= XCDR (names
))
6931 tem
= Fstring_equal (XCAR (XCAR (names
)), name
);
6936 /* Use this general default value to start with. */
6937 Vx_resource_name
= Vinvocation_name
;
6939 validate_x_resource_name ();
6941 dpyinfo
= w32_term_init (name
, (unsigned char *)0,
6942 (char *) SDATA (Vx_resource_name
));
6945 error ("Cannot connect to server %s", SDATA (name
));
6948 XSETFASTINT (Vwindow_system_version
, 3);
6953 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
6954 1, 3, 0, doc
: /* Open a connection to a server.
6955 DISPLAY is the name of the display to connect to.
6956 Optional second arg XRM-STRING is a string of resources in xrdb format.
6957 If the optional third arg MUST-SUCCEED is non-nil,
6958 terminate Emacs if we can't open the connection. */)
6959 (display
, xrm_string
, must_succeed
)
6960 Lisp_Object display
, xrm_string
, must_succeed
;
6962 unsigned char *xrm_option
;
6963 struct w32_display_info
*dpyinfo
;
6965 /* If initialization has already been done, return now to avoid
6966 overwriting critical parts of one_w32_display_info. */
6970 CHECK_STRING (display
);
6971 if (! NILP (xrm_string
))
6972 CHECK_STRING (xrm_string
);
6975 if (! EQ (Vwindow_system
, intern ("w32")))
6976 error ("Not using Microsoft Windows");
6979 /* Allow color mapping to be defined externally; first look in user's
6980 HOME directory, then in Emacs etc dir for a file called rgb.txt. */
6982 Lisp_Object color_file
;
6983 struct gcpro gcpro1
;
6985 color_file
= build_string ("~/rgb.txt");
6987 GCPRO1 (color_file
);
6989 if (NILP (Ffile_readable_p (color_file
)))
6991 Fexpand_file_name (build_string ("rgb.txt"),
6992 Fsymbol_value (intern ("data-directory")));
6994 Vw32_color_map
= Fw32_load_color_file (color_file
);
6998 if (NILP (Vw32_color_map
))
6999 Vw32_color_map
= Fw32_default_color_map ();
7001 /* Merge in system logical colors. */
7002 add_system_logical_colors_to_map (&Vw32_color_map
);
7004 if (! NILP (xrm_string
))
7005 xrm_option
= (unsigned char *) SDATA (xrm_string
);
7007 xrm_option
= (unsigned char *) 0;
7009 /* Use this general default value to start with. */
7010 /* First remove .exe suffix from invocation-name - it looks ugly. */
7012 char basename
[ MAX_PATH
], *str
;
7014 strcpy (basename
, SDATA (Vinvocation_name
));
7015 str
= strrchr (basename
, '.');
7017 Vinvocation_name
= build_string (basename
);
7019 Vx_resource_name
= Vinvocation_name
;
7021 validate_x_resource_name ();
7023 /* This is what opens the connection and sets x_current_display.
7024 This also initializes many symbols, such as those used for input. */
7025 dpyinfo
= w32_term_init (display
, xrm_option
,
7026 (char *) SDATA (Vx_resource_name
));
7030 if (!NILP (must_succeed
))
7031 fatal ("Cannot connect to server %s.\n",
7034 error ("Cannot connect to server %s", SDATA (display
));
7039 XSETFASTINT (Vwindow_system_version
, 3);
7043 DEFUN ("x-close-connection", Fx_close_connection
,
7044 Sx_close_connection
, 1, 1, 0,
7045 doc
: /* Close the connection to DISPLAY's server.
7046 For DISPLAY, specify either a frame or a display name (a string).
7047 If DISPLAY is nil, that stands for the selected frame's display. */)
7049 Lisp_Object display
;
7051 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
7054 if (dpyinfo
->reference_count
> 0)
7055 error ("Display still has frames on it");
7059 /* Free the fonts in the font table. */
7060 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
7061 if (dpyinfo
->font_table
[i
].name
)
7063 if (dpyinfo
->font_table
[i
].name
!= dpyinfo
->font_table
[i
].full_name
)
7064 xfree (dpyinfo
->font_table
[i
].full_name
);
7065 xfree (dpyinfo
->font_table
[i
].name
);
7066 w32_unload_font (dpyinfo
, dpyinfo
->font_table
[i
].font
);
7069 x_destroy_all_bitmaps (dpyinfo
);
7071 x_delete_display (dpyinfo
);
7077 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
7078 doc
: /* Return the list of display names that Emacs has connections to. */)
7081 Lisp_Object tail
, result
;
7084 for (tail
= w32_display_name_list
; CONSP (tail
); tail
= XCDR (tail
))
7085 result
= Fcons (XCAR (XCAR (tail
)), result
);
7090 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
7091 doc
: /* This is a noop on W32 systems. */)
7093 Lisp_Object display
, on
;
7100 /***********************************************************************
7102 ***********************************************************************/
7104 DEFUN ("x-change-window-property", Fx_change_window_property
,
7105 Sx_change_window_property
, 2, 6, 0,
7106 doc
: /* Change window property PROP to VALUE on the X window of FRAME.
7107 VALUE may be a string or a list of conses, numbers and/or strings.
7108 If an element in the list is a string, it is converted to
7109 an Atom and the value of the Atom is used. If an element is a cons,
7110 it is converted to a 32 bit number where the car is the 16 top bits and the
7111 cdr is the lower 16 bits.
7112 FRAME nil or omitted means use the selected frame.
7113 If TYPE is given and non-nil, it is the name of the type of VALUE.
7114 If TYPE is not given or nil, the type is STRING.
7115 FORMAT gives the size in bits of each element if VALUE is a list.
7116 It must be one of 8, 16 or 32.
7117 If VALUE is a string or FORMAT is nil or not given, FORMAT defaults to 8.
7118 If OUTER_P is non-nil, the property is changed for the outer X window of
7119 FRAME. Default is to change on the edit X window.
7122 (prop
, value
, frame
, type
, format
, outer_p
)
7123 Lisp_Object prop
, value
, frame
, type
, format
, outer_p
;
7125 #if 0 /* TODO : port window properties to W32 */
7126 struct frame
*f
= check_x_frame (frame
);
7129 CHECK_STRING (prop
);
7130 CHECK_STRING (value
);
7133 prop_atom
= XInternAtom (FRAME_W32_DISPLAY (f
), SDATA (prop
), False
);
7134 XChangeProperty (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
7135 prop_atom
, XA_STRING
, 8, PropModeReplace
,
7136 SDATA (value
), SCHARS (value
));
7138 /* Make sure the property is set when we return. */
7139 XFlush (FRAME_W32_DISPLAY (f
));
7148 DEFUN ("x-delete-window-property", Fx_delete_window_property
,
7149 Sx_delete_window_property
, 1, 2, 0,
7150 doc
: /* Remove window property PROP from X window of FRAME.
7151 FRAME nil or omitted means use the selected frame. Value is PROP. */)
7153 Lisp_Object prop
, frame
;
7155 #if 0 /* TODO : port window properties to W32 */
7157 struct frame
*f
= check_x_frame (frame
);
7160 CHECK_STRING (prop
);
7162 prop_atom
= XInternAtom (FRAME_W32_DISPLAY (f
), SDATA (prop
), False
);
7163 XDeleteProperty (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
), prop_atom
);
7165 /* Make sure the property is removed when we return. */
7166 XFlush (FRAME_W32_DISPLAY (f
));
7174 DEFUN ("x-window-property", Fx_window_property
, Sx_window_property
,
7176 doc
: /* Value is the value of window property PROP on FRAME.
7177 If FRAME is nil or omitted, use the selected frame. Value is nil
7178 if FRAME hasn't a property with name PROP or if PROP has no string
7181 Lisp_Object prop
, frame
;
7183 #if 0 /* TODO : port window properties to W32 */
7185 struct frame
*f
= check_x_frame (frame
);
7188 Lisp_Object prop_value
= Qnil
;
7189 char *tmp_data
= NULL
;
7192 unsigned long actual_size
, bytes_remaining
;
7194 CHECK_STRING (prop
);
7196 prop_atom
= XInternAtom (FRAME_W32_DISPLAY (f
), SDATA (prop
), False
);
7197 rc
= XGetWindowProperty (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
7198 prop_atom
, 0, 0, False
, XA_STRING
,
7199 &actual_type
, &actual_format
, &actual_size
,
7200 &bytes_remaining
, (unsigned char **) &tmp_data
);
7203 int size
= bytes_remaining
;
7208 rc
= XGetWindowProperty (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
7209 prop_atom
, 0, bytes_remaining
,
7211 &actual_type
, &actual_format
,
7212 &actual_size
, &bytes_remaining
,
7213 (unsigned char **) &tmp_data
);
7215 prop_value
= make_string (tmp_data
, size
);
7230 /***********************************************************************
7232 ***********************************************************************/
7234 /* Non-zero means an hourglass cursor is currently shown. */
7236 static int hourglass_shown_p
;
7238 /* Number of seconds to wait before displaying an hourglass cursor. */
7240 static Lisp_Object Vhourglass_delay
;
7242 /* Default number of seconds to wait before displaying an hourglass
7245 #define DEFAULT_HOURGLASS_DELAY 1
7247 /* Return non-zero if houglass timer has been started or hourglass is shown. */
7250 hourglass_started ()
7252 return hourglass_shown_p
|| hourglass_timer
;
7255 /* Cancel a currently active hourglass timer, and start a new one. */
7261 int secs
, msecs
= 0;
7262 struct frame
* f
= SELECTED_FRAME ();
7264 /* No cursors on non GUI frames. */
7265 if (!FRAME_W32_P (f
))
7268 cancel_hourglass ();
7270 if (INTEGERP (Vhourglass_delay
)
7271 && XINT (Vhourglass_delay
) > 0)
7272 secs
= XFASTINT (Vhourglass_delay
);
7273 else if (FLOATP (Vhourglass_delay
)
7274 && XFLOAT_DATA (Vhourglass_delay
) > 0)
7277 tem
= Ftruncate (Vhourglass_delay
, Qnil
);
7278 secs
= XFASTINT (tem
);
7279 msecs
= (XFLOAT_DATA (Vhourglass_delay
) - secs
) * 1000;
7282 secs
= DEFAULT_HOURGLASS_DELAY
;
7284 delay
= secs
* 1000 + msecs
;
7285 hourglass_hwnd
= FRAME_W32_WINDOW (f
);
7286 hourglass_timer
= SetTimer (hourglass_hwnd
, HOURGLASS_ID
, delay
, NULL
);
7290 /* Cancel the hourglass cursor timer if active, hide an hourglass
7296 if (hourglass_timer
)
7298 KillTimer (hourglass_hwnd
, hourglass_timer
);
7299 hourglass_timer
= 0;
7302 if (hourglass_shown_p
)
7307 /* Timer function of hourglass_timer.
7309 Display an hourglass cursor. Set the hourglass_p flag in display info
7310 to indicate that an hourglass cursor is shown. */
7316 if (!hourglass_shown_p
)
7318 f
->output_data
.w32
->hourglass_p
= 1;
7319 if (!menubar_in_use
&& !current_popup_menu
)
7320 SetCursor (f
->output_data
.w32
->hourglass_cursor
);
7321 hourglass_shown_p
= 1;
7326 /* Hide the hourglass cursor on all frames, if it is currently shown. */
7331 if (hourglass_shown_p
)
7333 struct frame
*f
= x_window_to_frame (&one_w32_display_info
,
7336 f
->output_data
.w32
->hourglass_p
= 0;
7337 SetCursor (f
->output_data
.w32
->current_cursor
);
7338 hourglass_shown_p
= 0;
7344 /***********************************************************************
7346 ***********************************************************************/
7348 static Lisp_Object x_create_tip_frame
P_ ((struct w32_display_info
*,
7349 Lisp_Object
, Lisp_Object
));
7350 static void compute_tip_xy
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
7351 Lisp_Object
, int, int, int *, int *));
7353 /* The frame of a currently visible tooltip. */
7355 Lisp_Object tip_frame
;
7357 /* If non-nil, a timer started that hides the last tooltip when it
7360 Lisp_Object tip_timer
;
7363 /* If non-nil, a vector of 3 elements containing the last args
7364 with which x-show-tip was called. See there. */
7366 Lisp_Object last_show_tip_args
;
7368 /* Maximum size for tooltips; a cons (COLUMNS . ROWS). */
7370 Lisp_Object Vx_max_tooltip_size
;
7374 unwind_create_tip_frame (frame
)
7377 Lisp_Object deleted
;
7379 deleted
= unwind_create_frame (frame
);
7380 if (EQ (deleted
, Qt
))
7390 /* Create a frame for a tooltip on the display described by DPYINFO.
7391 PARMS is a list of frame parameters. TEXT is the string to
7392 display in the tip frame. Value is the frame.
7394 Note that functions called here, esp. x_default_parameter can
7395 signal errors, for instance when a specified color name is
7396 undefined. We have to make sure that we're in a consistent state
7397 when this happens. */
7400 x_create_tip_frame (dpyinfo
, parms
, text
)
7401 struct w32_display_info
*dpyinfo
;
7402 Lisp_Object parms
, text
;
7405 Lisp_Object frame
, tem
;
7407 long window_prompting
= 0;
7409 int count
= SPECPDL_INDEX ();
7410 struct gcpro gcpro1
, gcpro2
, gcpro3
;
7412 int face_change_count_before
= face_change_count
;
7414 struct buffer
*old_buffer
;
7418 /* Use this general default value to start with until we know if
7419 this frame has a specified name. */
7420 Vx_resource_name
= Vinvocation_name
;
7423 kb
= dpyinfo
->terminal
->kboard
;
7425 kb
= &the_only_kboard
;
7428 /* Get the name of the frame to use for resource lookup. */
7429 name
= w32_get_arg (parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
7431 && !EQ (name
, Qunbound
)
7433 error ("Invalid frame name--not a string or nil");
7434 Vx_resource_name
= name
;
7437 GCPRO3 (parms
, name
, frame
);
7438 /* Make a frame without minibuffer nor mode-line. */
7440 f
->wants_modeline
= 0;
7441 XSETFRAME (frame
, f
);
7443 buffer
= Fget_buffer_create (build_string (" *tip*"));
7444 Fset_window_buffer (FRAME_ROOT_WINDOW (f
), buffer
, Qnil
);
7445 old_buffer
= current_buffer
;
7446 set_buffer_internal_1 (XBUFFER (buffer
));
7447 current_buffer
->truncate_lines
= Qnil
;
7448 specbind (Qinhibit_read_only
, Qt
);
7449 specbind (Qinhibit_modification_hooks
, Qt
);
7452 set_buffer_internal_1 (old_buffer
);
7454 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 0;
7455 record_unwind_protect (unwind_create_tip_frame
, frame
);
7457 /* By setting the output method, we're essentially saying that
7458 the frame is live, as per FRAME_LIVE_P. If we get a signal
7459 from this point on, x_destroy_window might screw up reference
7461 f
->terminal
= dpyinfo
->terminal
;
7462 f
->terminal
->reference_count
++;
7463 f
->output_method
= output_w32
;
7464 f
->output_data
.w32
=
7465 (struct w32_output
*) xmalloc (sizeof (struct w32_output
));
7466 bzero (f
->output_data
.w32
, sizeof (struct w32_output
));
7468 FRAME_FONTSET (f
) = -1;
7469 f
->icon_name
= Qnil
;
7471 #if 0 /* GLYPH_DEBUG TODO: image support. */
7472 image_cache_refcount
= FRAME_IMAGE_CACHE (f
)->refcount
;
7473 dpyinfo_refcount
= dpyinfo
->reference_count
;
7474 #endif /* GLYPH_DEBUG */
7476 FRAME_KBOARD (f
) = kb
;
7478 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
7479 f
->output_data
.w32
->explicit_parent
= 0;
7481 /* Set the name; the functions to which we pass f expect the name to
7483 if (EQ (name
, Qunbound
) || NILP (name
))
7485 f
->name
= build_string (dpyinfo
->w32_id_name
);
7486 f
->explicit_name
= 0;
7491 f
->explicit_name
= 1;
7492 /* use the frame's title when getting resources for this frame. */
7493 specbind (Qx_resource_name
, name
);
7496 f
->resx
= dpyinfo
->resx
;
7497 f
->resy
= dpyinfo
->resy
;
7499 /* Perhaps, we must allow frame parameter, say `font-backend',
7500 to specify which font backends to use. */
7501 register_font_driver (&w32font_driver
, f
);
7503 x_default_parameter (f
, parms
, Qfont_backend
, Qnil
,
7504 "fontBackend", "FontBackend", RES_TYPE_STRING
);
7506 /* Extract the window parameters from the supplied values
7507 that are needed to determine window geometry. */
7508 x_default_font_parameter (f
, parms
);
7510 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
7511 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
7512 /* This defaults to 2 in order to match xterm. We recognize either
7513 internalBorderWidth or internalBorder (which is what xterm calls
7515 if (NILP (Fassq (Qinternal_border_width
, parms
)))
7519 value
= w32_get_arg (parms
, Qinternal_border_width
,
7520 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
7521 if (! EQ (value
, Qunbound
))
7522 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
7525 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
7526 "internalBorderWidth", "internalBorderWidth",
7529 /* Also do the stuff which must be set before the window exists. */
7530 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
7531 "foreground", "Foreground", RES_TYPE_STRING
);
7532 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
7533 "background", "Background", RES_TYPE_STRING
);
7534 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
7535 "pointerColor", "Foreground", RES_TYPE_STRING
);
7536 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
7537 "cursorColor", "Foreground", RES_TYPE_STRING
);
7538 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
7539 "borderColor", "BorderColor", RES_TYPE_STRING
);
7541 /* Init faces before x_default_parameter is called for scroll-bar
7542 parameters because that function calls x_set_scroll_bar_width,
7543 which calls change_frame_size, which calls Fset_window_buffer,
7544 which runs hooks, which call Fvertical_motion. At the end, we
7545 end up in init_iterator with a null face cache, which should not
7547 init_frame_faces (f
);
7549 f
->output_data
.w32
->dwStyle
= WS_BORDER
| WS_POPUP
| WS_DISABLED
;
7550 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
7552 window_prompting
= x_figure_window_size (f
, parms
, 0);
7554 /* No fringes on tip frame. */
7556 f
->left_fringe_width
= 0;
7557 f
->right_fringe_width
= 0;
7560 my_create_tip_window (f
);
7565 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
7566 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
7567 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
7568 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
7569 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
7570 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
7572 /* Dimensions, especially FRAME_LINES (f), must be done via change_frame_size.
7573 Change will not be effected unless different from the current
7575 width
= FRAME_COLS (f
);
7576 height
= FRAME_LINES (f
);
7577 FRAME_LINES (f
) = 0;
7578 SET_FRAME_COLS (f
, 0);
7579 change_frame_size (f
, height
, width
, 1, 0, 0);
7581 /* Add `tooltip' frame parameter's default value. */
7582 if (NILP (Fframe_parameter (frame
, intern ("tooltip"))))
7583 Fmodify_frame_parameters (frame
, Fcons (Fcons (intern ("tooltip"), Qt
),
7586 /* Set up faces after all frame parameters are known. This call
7587 also merges in face attributes specified for new frames.
7589 Frame parameters may be changed if .Xdefaults contains
7590 specifications for the default font. For example, if there is an
7591 `Emacs.default.attributeBackground: pink', the `background-color'
7592 attribute of the frame get's set, which let's the internal border
7593 of the tooltip frame appear in pink. Prevent this. */
7595 Lisp_Object bg
= Fframe_parameter (frame
, Qbackground_color
);
7597 /* Set tip_frame here, so that */
7599 call1 (Qface_set_after_frame_default
, frame
);
7601 if (!EQ (bg
, Fframe_parameter (frame
, Qbackground_color
)))
7602 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qbackground_color
, bg
),
7610 /* It is now ok to make the frame official even if we get an error
7611 below. And the frame needs to be on Vframe_list or making it
7612 visible won't work. */
7613 Vframe_list
= Fcons (frame
, Vframe_list
);
7615 /* Now that the frame is official, it counts as a reference to
7617 FRAME_W32_DISPLAY_INFO (f
)->reference_count
++;
7619 /* Setting attributes of faces of the tooltip frame from resources
7620 and similar will increment face_change_count, which leads to the
7621 clearing of all current matrices. Since this isn't necessary
7622 here, avoid it by resetting face_change_count to the value it
7623 had before we created the tip frame. */
7624 face_change_count
= face_change_count_before
;
7626 /* Discard the unwind_protect. */
7627 return unbind_to (count
, frame
);
7631 /* Compute where to display tip frame F. PARMS is the list of frame
7632 parameters for F. DX and DY are specified offsets from the current
7633 location of the mouse. WIDTH and HEIGHT are the width and height
7634 of the tooltip. Return coordinates relative to the root window of
7635 the display in *ROOT_X, and *ROOT_Y. */
7638 compute_tip_xy (f
, parms
, dx
, dy
, width
, height
, root_x
, root_y
)
7640 Lisp_Object parms
, dx
, dy
;
7642 int *root_x
, *root_y
;
7644 Lisp_Object left
, top
;
7645 int min_x
, min_y
, max_x
, max_y
;
7647 /* User-specified position? */
7648 left
= Fcdr (Fassq (Qleft
, parms
));
7649 top
= Fcdr (Fassq (Qtop
, parms
));
7651 /* Move the tooltip window where the mouse pointer is. Resize and
7653 if (!INTEGERP (left
) || !INTEGERP (top
))
7657 /* Default min and max values. */
7660 max_x
= FRAME_W32_DISPLAY_INFO (f
)->width
;
7661 max_y
= FRAME_W32_DISPLAY_INFO (f
)->height
;
7669 /* If multiple monitor support is available, constrain the tip onto
7670 the current monitor. This improves the above by allowing negative
7671 co-ordinates if monitor positions are such that they are valid, and
7672 snaps a tooltip onto a single monitor if we are close to the edge
7673 where it would otherwise flow onto the other monitor (or into
7674 nothingness if there is a gap in the overlap). */
7675 if (monitor_from_point_fn
&& get_monitor_info_fn
)
7677 struct MONITOR_INFO info
;
7679 = monitor_from_point_fn (pt
, MONITOR_DEFAULT_TO_NEAREST
);
7680 info
.cbSize
= sizeof (info
);
7682 if (get_monitor_info_fn (monitor
, &info
))
7684 min_x
= info
.rcWork
.left
;
7685 min_y
= info
.rcWork
.top
;
7686 max_x
= info
.rcWork
.right
;
7687 max_y
= info
.rcWork
.bottom
;
7693 *root_y
= XINT (top
);
7694 else if (*root_y
+ XINT (dy
) <= min_y
)
7695 *root_y
= min_y
; /* Can happen for negative dy */
7696 else if (*root_y
+ XINT (dy
) + height
<= max_y
)
7697 /* It fits below the pointer */
7698 *root_y
+= XINT (dy
);
7699 else if (height
+ XINT (dy
) + min_y
<= *root_y
)
7700 /* It fits above the pointer. */
7701 *root_y
-= height
+ XINT (dy
);
7703 /* Put it on the top. */
7706 if (INTEGERP (left
))
7707 *root_x
= XINT (left
);
7708 else if (*root_x
+ XINT (dx
) <= min_x
)
7709 *root_x
= 0; /* Can happen for negative dx */
7710 else if (*root_x
+ XINT (dx
) + width
<= max_x
)
7711 /* It fits to the right of the pointer. */
7712 *root_x
+= XINT (dx
);
7713 else if (width
+ XINT (dx
) + min_x
<= *root_x
)
7714 /* It fits to the left of the pointer. */
7715 *root_x
-= width
+ XINT (dx
);
7717 /* Put it left justified on the screen -- it ought to fit that way. */
7722 DEFUN ("x-show-tip", Fx_show_tip
, Sx_show_tip
, 1, 6, 0,
7723 doc
: /* Show STRING in a \"tooltip\" window on frame FRAME.
7724 A tooltip window is a small window displaying a string.
7726 This is an internal function; Lisp code should call `tooltip-show'.
7728 FRAME nil or omitted means use the selected frame.
7730 PARMS is an optional list of frame parameters which can be
7731 used to change the tooltip's appearance.
7733 Automatically hide the tooltip after TIMEOUT seconds. TIMEOUT nil
7734 means use the default timeout of 5 seconds.
7736 If the list of frame parameters PARMS contains a `left' parameter,
7737 the tooltip is displayed at that x-position. Otherwise it is
7738 displayed at the mouse position, with offset DX added (default is 5 if
7739 DX isn't specified). Likewise for the y-position; if a `top' frame
7740 parameter is specified, it determines the y-position of the tooltip
7741 window, otherwise it is displayed at the mouse position, with offset
7742 DY added (default is -10).
7744 A tooltip's maximum size is specified by `x-max-tooltip-size'.
7745 Text larger than the specified size is clipped. */)
7746 (string
, frame
, parms
, timeout
, dx
, dy
)
7747 Lisp_Object string
, frame
, parms
, timeout
, dx
, dy
;
7752 struct buffer
*old_buffer
;
7753 struct text_pos pos
;
7754 int i
, width
, height
;
7755 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
7756 int old_windows_or_buffers_changed
= windows_or_buffers_changed
;
7757 int count
= SPECPDL_INDEX ();
7759 specbind (Qinhibit_redisplay
, Qt
);
7761 GCPRO4 (string
, parms
, frame
, timeout
);
7763 CHECK_STRING (string
);
7764 f
= check_x_frame (frame
);
7766 timeout
= make_number (5);
7768 CHECK_NATNUM (timeout
);
7771 dx
= make_number (5);
7776 dy
= make_number (-10);
7780 if (NILP (last_show_tip_args
))
7781 last_show_tip_args
= Fmake_vector (make_number (3), Qnil
);
7783 if (!NILP (tip_frame
))
7785 Lisp_Object last_string
= AREF (last_show_tip_args
, 0);
7786 Lisp_Object last_frame
= AREF (last_show_tip_args
, 1);
7787 Lisp_Object last_parms
= AREF (last_show_tip_args
, 2);
7789 if (EQ (frame
, last_frame
)
7790 && !NILP (Fequal (last_string
, string
))
7791 && !NILP (Fequal (last_parms
, parms
)))
7793 struct frame
*f
= XFRAME (tip_frame
);
7795 /* Only DX and DY have changed. */
7796 if (!NILP (tip_timer
))
7798 Lisp_Object timer
= tip_timer
;
7800 call1 (Qcancel_timer
, timer
);
7804 compute_tip_xy (f
, parms
, dx
, dy
, FRAME_PIXEL_WIDTH (f
),
7805 FRAME_PIXEL_HEIGHT (f
), &root_x
, &root_y
);
7807 /* Put tooltip in topmost group and in position. */
7808 SetWindowPos (FRAME_W32_WINDOW (f
), HWND_TOPMOST
,
7809 root_x
, root_y
, 0, 0,
7810 SWP_NOSIZE
| SWP_NOACTIVATE
);
7812 /* Ensure tooltip is on top of other topmost windows (eg menus). */
7813 SetWindowPos (FRAME_W32_WINDOW (f
), HWND_TOP
,
7815 SWP_NOMOVE
| SWP_NOSIZE
| SWP_NOACTIVATE
);
7822 /* Hide a previous tip, if any. */
7825 ASET (last_show_tip_args
, 0, string
);
7826 ASET (last_show_tip_args
, 1, frame
);
7827 ASET (last_show_tip_args
, 2, parms
);
7829 /* Add default values to frame parameters. */
7830 if (NILP (Fassq (Qname
, parms
)))
7831 parms
= Fcons (Fcons (Qname
, build_string ("tooltip")), parms
);
7832 if (NILP (Fassq (Qinternal_border_width
, parms
)))
7833 parms
= Fcons (Fcons (Qinternal_border_width
, make_number (3)), parms
);
7834 if (NILP (Fassq (Qborder_width
, parms
)))
7835 parms
= Fcons (Fcons (Qborder_width
, make_number (1)), parms
);
7836 if (NILP (Fassq (Qborder_color
, parms
)))
7837 parms
= Fcons (Fcons (Qborder_color
, build_string ("lightyellow")), parms
);
7838 if (NILP (Fassq (Qbackground_color
, parms
)))
7839 parms
= Fcons (Fcons (Qbackground_color
, build_string ("lightyellow")),
7842 /* Block input until the tip has been fully drawn, to avoid crashes
7843 when drawing tips in menus. */
7846 /* Create a frame for the tooltip, and record it in the global
7847 variable tip_frame. */
7848 frame
= x_create_tip_frame (FRAME_W32_DISPLAY_INFO (f
), parms
, string
);
7851 /* Set up the frame's root window. */
7852 w
= XWINDOW (FRAME_ROOT_WINDOW (f
));
7853 w
->left_col
= w
->top_line
= make_number (0);
7855 if (CONSP (Vx_max_tooltip_size
)
7856 && INTEGERP (XCAR (Vx_max_tooltip_size
))
7857 && XINT (XCAR (Vx_max_tooltip_size
)) > 0
7858 && INTEGERP (XCDR (Vx_max_tooltip_size
))
7859 && XINT (XCDR (Vx_max_tooltip_size
)) > 0)
7861 w
->total_cols
= XCAR (Vx_max_tooltip_size
);
7862 w
->total_lines
= XCDR (Vx_max_tooltip_size
);
7866 w
->total_cols
= make_number (80);
7867 w
->total_lines
= make_number (40);
7870 FRAME_TOTAL_COLS (f
) = XINT (w
->total_cols
);
7872 w
->pseudo_window_p
= 1;
7874 /* Display the tooltip text in a temporary buffer. */
7875 old_buffer
= current_buffer
;
7876 set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f
))->buffer
));
7877 current_buffer
->truncate_lines
= Qnil
;
7878 clear_glyph_matrix (w
->desired_matrix
);
7879 clear_glyph_matrix (w
->current_matrix
);
7880 SET_TEXT_POS (pos
, BEGV
, BEGV_BYTE
);
7881 try_window (FRAME_ROOT_WINDOW (f
), pos
, 0);
7883 /* Compute width and height of the tooltip. */
7885 for (i
= 0; i
< w
->desired_matrix
->nrows
; ++i
)
7887 struct glyph_row
*row
= &w
->desired_matrix
->rows
[i
];
7891 /* Stop at the first empty row at the end. */
7892 if (!row
->enabled_p
|| !row
->displays_text_p
)
7895 /* Let the row go over the full width of the frame. */
7896 row
->full_width_p
= 1;
7898 #ifdef TODO /* Investigate why some fonts need more width than is
7899 calculated for some tooltips. */
7900 /* There's a glyph at the end of rows that is use to place
7901 the cursor there. Don't include the width of this glyph. */
7902 if (row
->used
[TEXT_AREA
])
7904 last
= &row
->glyphs
[TEXT_AREA
][row
->used
[TEXT_AREA
] - 1];
7905 row_width
= row
->pixel_width
- last
->pixel_width
;
7909 row_width
= row
->pixel_width
;
7911 /* TODO: find why tips do not draw along baseline as instructed. */
7912 height
+= row
->height
;
7913 width
= max (width
, row_width
);
7916 /* Add the frame's internal border to the width and height the X
7917 window should have. */
7918 height
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
7919 width
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
7921 /* Move the tooltip window where the mouse pointer is. Resize and
7923 compute_tip_xy (f
, parms
, dx
, dy
, width
, height
, &root_x
, &root_y
);
7926 /* Adjust Window size to take border into account. */
7928 rect
.left
= rect
.top
= 0;
7930 rect
.bottom
= height
;
7931 AdjustWindowRect (&rect
, f
->output_data
.w32
->dwStyle
,
7932 FRAME_EXTERNAL_MENU_BAR (f
));
7934 /* Position and size tooltip, and put it in the topmost group.
7935 The add-on of 3 to the 5th argument is a kludge: without it,
7936 some fonts cause the last character of the tip to be truncated,
7937 for some obscure reason. */
7938 SetWindowPos (FRAME_W32_WINDOW (f
), HWND_TOPMOST
,
7939 root_x
, root_y
, rect
.right
- rect
.left
+ 3,
7940 rect
.bottom
- rect
.top
, SWP_NOACTIVATE
);
7942 /* Ensure tooltip is on top of other topmost windows (eg menus). */
7943 SetWindowPos (FRAME_W32_WINDOW (f
), HWND_TOP
,
7945 SWP_NOMOVE
| SWP_NOSIZE
| SWP_NOACTIVATE
);
7947 /* Let redisplay know that we have made the frame visible already. */
7948 f
->async_visible
= 1;
7950 ShowWindow (FRAME_W32_WINDOW (f
), SW_SHOWNOACTIVATE
);
7953 /* Draw into the window. */
7954 w
->must_be_updated_p
= 1;
7955 update_single_window (w
, 1);
7959 /* Restore original current buffer. */
7960 set_buffer_internal_1 (old_buffer
);
7961 windows_or_buffers_changed
= old_windows_or_buffers_changed
;
7964 /* Let the tip disappear after timeout seconds. */
7965 tip_timer
= call3 (intern ("run-at-time"), timeout
, Qnil
,
7966 intern ("x-hide-tip"));
7969 return unbind_to (count
, Qnil
);
7973 DEFUN ("x-hide-tip", Fx_hide_tip
, Sx_hide_tip
, 0, 0, 0,
7974 doc
: /* Hide the current tooltip window, if there is any.
7975 Value is t if tooltip was open, nil otherwise. */)
7979 Lisp_Object deleted
, frame
, timer
;
7980 struct gcpro gcpro1
, gcpro2
;
7982 /* Return quickly if nothing to do. */
7983 if (NILP (tip_timer
) && NILP (tip_frame
))
7988 GCPRO2 (frame
, timer
);
7989 tip_frame
= tip_timer
= deleted
= Qnil
;
7991 count
= SPECPDL_INDEX ();
7992 specbind (Qinhibit_redisplay
, Qt
);
7993 specbind (Qinhibit_quit
, Qt
);
7996 call1 (Qcancel_timer
, timer
);
8000 Fdelete_frame (frame
, Qnil
);
8005 return unbind_to (count
, deleted
);
8010 /***********************************************************************
8011 File selection dialog
8012 ***********************************************************************/
8013 extern Lisp_Object Qfile_name_history
;
8015 /* Callback for altering the behaviour of the Open File dialog.
8016 Makes the Filename text field contain "Current Directory" and be
8017 read-only when "Directories" is selected in the filter. This
8018 allows us to work around the fact that the standard Open File
8019 dialog does not support directories. */
8021 file_dialog_callback (hwnd
, msg
, wParam
, lParam
)
8027 if (msg
== WM_NOTIFY
)
8029 OFNOTIFY
* notify
= (OFNOTIFY
*)lParam
;
8030 /* Detect when the Filter dropdown is changed. */
8031 if (notify
->hdr
.code
== CDN_TYPECHANGE
8032 || notify
->hdr
.code
== CDN_INITDONE
)
8034 HWND dialog
= GetParent (hwnd
);
8035 HWND edit_control
= GetDlgItem (dialog
, FILE_NAME_TEXT_FIELD
);
8037 /* Directories is in index 2. */
8038 if (notify
->lpOFN
->nFilterIndex
== 2)
8040 CommDlg_OpenSave_SetControlText (dialog
, FILE_NAME_TEXT_FIELD
,
8041 "Current Directory");
8042 EnableWindow (edit_control
, FALSE
);
8046 /* Don't override default filename on init done. */
8047 if (notify
->hdr
.code
== CDN_TYPECHANGE
)
8048 CommDlg_OpenSave_SetControlText (dialog
,
8049 FILE_NAME_TEXT_FIELD
, "");
8050 EnableWindow (edit_control
, TRUE
);
8057 /* Since we compile with _WIN32_WINNT set to 0x0400 (for NT4 compatibility)
8058 we end up with the old file dialogs. Define a big enough struct for the
8059 new dialog to trick GetOpenFileName into giving us the new dialogs on
8060 Windows 2000 and XP. */
8063 OPENFILENAME real_details
;
8070 DEFUN ("x-file-dialog", Fx_file_dialog
, Sx_file_dialog
, 2, 5, 0,
8071 doc
: /* Read file name, prompting with PROMPT in directory DIR.
8072 Use a file selection dialog.
8073 Select DEFAULT-FILENAME in the dialog's file selection box, if
8074 specified. Ensure that file exists if MUSTMATCH is non-nil.
8075 If ONLY-DIR-P is non-nil, the user can only select directories. */)
8076 (prompt
, dir
, default_filename
, mustmatch
, only_dir_p
)
8077 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, only_dir_p
;
8079 struct frame
*f
= SELECTED_FRAME ();
8080 Lisp_Object file
= Qnil
;
8081 int count
= SPECPDL_INDEX ();
8082 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
8083 char filename
[MAX_PATH
+ 1];
8084 char init_dir
[MAX_PATH
+ 1];
8085 int default_filter_index
= 1; /* 1: All Files, 2: Directories only */
8087 GCPRO6 (prompt
, dir
, default_filename
, mustmatch
, only_dir_p
, file
);
8088 CHECK_STRING (prompt
);
8091 /* Create the dialog with PROMPT as title, using DIR as initial
8092 directory and using "*" as pattern. */
8093 dir
= Fexpand_file_name (dir
, Qnil
);
8094 strncpy (init_dir
, SDATA (ENCODE_FILE (dir
)), MAX_PATH
);
8095 init_dir
[MAX_PATH
] = '\0';
8096 unixtodos_filename (init_dir
);
8098 if (STRINGP (default_filename
))
8100 char *file_name_only
;
8101 char *full_path_name
= SDATA (ENCODE_FILE (default_filename
));
8103 unixtodos_filename (full_path_name
);
8105 file_name_only
= strrchr (full_path_name
, '\\');
8106 if (!file_name_only
)
8107 file_name_only
= full_path_name
;
8111 strncpy (filename
, file_name_only
, MAX_PATH
);
8112 filename
[MAX_PATH
] = '\0';
8118 NEWOPENFILENAME new_file_details
;
8119 BOOL file_opened
= FALSE
;
8120 OPENFILENAME
* file_details
= &new_file_details
.real_details
;
8122 /* Prevent redisplay. */
8123 specbind (Qinhibit_redisplay
, Qt
);
8126 bzero (&new_file_details
, sizeof (new_file_details
));
8127 /* Apparently NT4 crashes if you give it an unexpected size.
8128 I'm not sure about Windows 9x, so play it safe. */
8129 if (w32_major_version
> 4 && w32_major_version
< 95)
8130 file_details
->lStructSize
= sizeof (NEWOPENFILENAME
);
8132 file_details
->lStructSize
= sizeof (OPENFILENAME
);
8134 file_details
->hwndOwner
= FRAME_W32_WINDOW (f
);
8135 /* Undocumented Bug in Common File Dialog:
8136 If a filter is not specified, shell links are not resolved. */
8137 file_details
->lpstrFilter
= "All Files (*.*)\0*.*\0Directories\0*|*\0\0";
8138 file_details
->lpstrFile
= filename
;
8139 file_details
->nMaxFile
= sizeof (filename
);
8140 file_details
->lpstrInitialDir
= init_dir
;
8141 file_details
->lpstrTitle
= SDATA (prompt
);
8143 if (! NILP (only_dir_p
))
8144 default_filter_index
= 2;
8146 file_details
->nFilterIndex
= default_filter_index
;
8148 file_details
->Flags
= (OFN_HIDEREADONLY
| OFN_NOCHANGEDIR
8149 | OFN_EXPLORER
| OFN_ENABLEHOOK
);
8150 if (!NILP (mustmatch
))
8152 /* Require that the path to the parent directory exists. */
8153 file_details
->Flags
|= OFN_PATHMUSTEXIST
;
8154 /* If we are looking for a file, require that it exists. */
8155 if (NILP (only_dir_p
))
8156 file_details
->Flags
|= OFN_FILEMUSTEXIST
;
8159 file_details
->lpfnHook
= (LPOFNHOOKPROC
) file_dialog_callback
;
8161 file_opened
= GetOpenFileName (file_details
);
8167 dostounix_filename (filename
);
8169 if (file_details
->nFilterIndex
== 2)
8171 /* "Directories" selected - strip dummy file name. */
8172 char * last
= strrchr (filename
, '/');
8176 file
= DECODE_FILE (build_string (filename
));
8178 /* User cancelled the dialog without making a selection. */
8179 else if (!CommDlgExtendedError ())
8181 /* An error occurred, fallback on reading from the mini-buffer. */
8183 file
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
8184 dir
, mustmatch
, dir
, Qfile_name_history
,
8185 default_filename
, Qnil
);
8187 file
= unbind_to (count
, file
);
8192 /* Make "Cancel" equivalent to C-g. */
8194 Fsignal (Qquit
, Qnil
);
8196 return unbind_to (count
, file
);
8201 /***********************************************************************
8202 w32 specialized functions
8203 ***********************************************************************/
8205 DEFUN ("w32-send-sys-command", Fw32_send_sys_command
,
8206 Sw32_send_sys_command
, 1, 2, 0,
8207 doc
: /* Send frame a Windows WM_SYSCOMMAND message of type COMMAND.
8208 Some useful values for COMMAND are #xf030 to maximize frame (#xf020
8209 to minimize), #xf120 to restore frame to original size, and #xf100
8210 to activate the menubar for keyboard access. #xf140 activates the
8211 screen saver if defined.
8213 If optional parameter FRAME is not specified, use selected frame. */)
8215 Lisp_Object command
, frame
;
8217 FRAME_PTR f
= check_x_frame (frame
);
8219 CHECK_NUMBER (command
);
8221 PostMessage (FRAME_W32_WINDOW (f
), WM_SYSCOMMAND
, XINT (command
), 0);
8226 DEFUN ("w32-shell-execute", Fw32_shell_execute
, Sw32_shell_execute
, 2, 4, 0,
8227 doc
: /* Get Windows to perform OPERATION on DOCUMENT.
8228 This is a wrapper around the ShellExecute system function, which
8229 invokes the application registered to handle OPERATION for DOCUMENT.
8231 OPERATION is either nil or a string that names a supported operation.
8232 What operations can be used depends on the particular DOCUMENT and its
8233 handler application, but typically it is one of the following common
8236 \"open\" - open DOCUMENT, which could be a file, a directory, or an
8237 executable program. If it is an application, that
8238 application is launched in the current buffer's default
8239 directory. Otherwise, the application associated with
8240 DOCUMENT is launched in the buffer's default directory.
8241 \"print\" - print DOCUMENT, which must be a file
8242 \"explore\" - start the Windows Explorer on DOCUMENT
8243 \"edit\" - launch an editor and open DOCUMENT for editing; which
8244 editor is launched depends on the association for the
8246 \"find\" - initiate search starting from DOCUMENT which must specify
8248 nil - invoke the default OPERATION, or \"open\" if default is
8249 not defined or unavailable
8251 DOCUMENT is typically the name of a document file or a URL, but can
8252 also be a program executable to run, or a directory to open in the
8255 If DOCUMENT is a program executable, the optional third arg PARAMETERS
8256 can be a string containing command line parameters that will be passed
8257 to the program; otherwise, PARAMETERS should be nil or unspecified.
8259 Optional fourth argument SHOW-FLAG can be used to control how the
8260 application will be displayed when it is invoked. If SHOW-FLAG is nil
8261 or unspecified, the application is displayed normally, otherwise it is
8262 an integer representing a ShowWindow flag:
8267 6 - start minimized */)
8268 (operation
, document
, parameters
, show_flag
)
8269 Lisp_Object operation
, document
, parameters
, show_flag
;
8271 Lisp_Object current_dir
;
8273 CHECK_STRING (document
);
8275 /* Encode filename, current directory and parameters. */
8276 current_dir
= ENCODE_FILE (current_buffer
->directory
);
8277 document
= ENCODE_FILE (document
);
8278 if (STRINGP (parameters
))
8279 parameters
= ENCODE_SYSTEM (parameters
);
8281 if ((int) ShellExecute (NULL
,
8282 (STRINGP (operation
) ?
8283 SDATA (operation
) : NULL
),
8285 (STRINGP (parameters
) ?
8286 SDATA (parameters
) : NULL
),
8287 SDATA (current_dir
),
8288 (INTEGERP (show_flag
) ?
8289 XINT (show_flag
) : SW_SHOWDEFAULT
))
8292 error ("ShellExecute failed: %s", w32_strerror (0));
8295 /* Lookup virtual keycode from string representing the name of a
8296 non-ascii keystroke into the corresponding virtual key, using
8297 lispy_function_keys. */
8299 lookup_vk_code (char *key
)
8303 for (i
= 0; i
< 256; i
++)
8304 if (lispy_function_keys
[i
]
8305 && strcmp (lispy_function_keys
[i
], key
) == 0)
8311 /* Convert a one-element vector style key sequence to a hot key
8314 w32_parse_hot_key (key
)
8317 /* Copied from Fdefine_key and store_in_keymap. */
8318 register Lisp_Object c
;
8322 struct gcpro gcpro1
;
8326 if (XFASTINT (Flength (key
)) != 1)
8331 c
= Faref (key
, make_number (0));
8333 if (CONSP (c
) && lucid_event_type_list_p (c
))
8334 c
= Fevent_convert_list (c
);
8338 if (! INTEGERP (c
) && ! SYMBOLP (c
))
8339 error ("Key definition is invalid");
8341 /* Work out the base key and the modifiers. */
8344 c
= parse_modifiers (c
);
8345 lisp_modifiers
= XINT (Fcar (Fcdr (c
)));
8349 vk_code
= lookup_vk_code (SDATA (SYMBOL_NAME (c
)));
8351 else if (INTEGERP (c
))
8353 lisp_modifiers
= XINT (c
) & ~CHARACTERBITS
;
8354 /* Many ascii characters are their own virtual key code. */
8355 vk_code
= XINT (c
) & CHARACTERBITS
;
8358 if (vk_code
< 0 || vk_code
> 255)
8361 if ((lisp_modifiers
& meta_modifier
) != 0
8362 && !NILP (Vw32_alt_is_meta
))
8363 lisp_modifiers
|= alt_modifier
;
8365 /* Supply defs missing from mingw32. */
8367 #define MOD_ALT 0x0001
8368 #define MOD_CONTROL 0x0002
8369 #define MOD_SHIFT 0x0004
8370 #define MOD_WIN 0x0008
8373 /* Convert lisp modifiers to Windows hot-key form. */
8374 w32_modifiers
= (lisp_modifiers
& hyper_modifier
) ? MOD_WIN
: 0;
8375 w32_modifiers
|= (lisp_modifiers
& alt_modifier
) ? MOD_ALT
: 0;
8376 w32_modifiers
|= (lisp_modifiers
& ctrl_modifier
) ? MOD_CONTROL
: 0;
8377 w32_modifiers
|= (lisp_modifiers
& shift_modifier
) ? MOD_SHIFT
: 0;
8379 return HOTKEY (vk_code
, w32_modifiers
);
8382 DEFUN ("w32-register-hot-key", Fw32_register_hot_key
,
8383 Sw32_register_hot_key
, 1, 1, 0,
8384 doc
: /* Register KEY as a hot-key combination.
8385 Certain key combinations like Alt-Tab are reserved for system use on
8386 Windows, and therefore are normally intercepted by the system. However,
8387 most of these key combinations can be received by registering them as
8388 hot-keys, overriding their special meaning.
8390 KEY must be a one element key definition in vector form that would be
8391 acceptable to `define-key' (e.g. [A-tab] for Alt-Tab). The meta
8392 modifier is interpreted as Alt if `w32-alt-is-meta' is t, and hyper
8393 is always interpreted as the Windows modifier keys.
8395 The return value is the hotkey-id if registered, otherwise nil. */)
8399 key
= w32_parse_hot_key (key
);
8401 if (!NILP (key
) && NILP (Fmemq (key
, w32_grabbed_keys
)))
8403 /* Reuse an empty slot if possible. */
8404 Lisp_Object item
= Fmemq (Qnil
, w32_grabbed_keys
);
8406 /* Safe to add new key to list, even if we have focus. */
8408 w32_grabbed_keys
= Fcons (key
, w32_grabbed_keys
);
8410 XSETCAR (item
, key
);
8412 /* Notify input thread about new hot-key definition, so that it
8413 takes effect without needing to switch focus. */
8414 #ifdef USE_LISP_UNION_TYPE
8415 PostThreadMessage (dwWindowsThreadId
, WM_EMACS_REGISTER_HOT_KEY
,
8418 PostThreadMessage (dwWindowsThreadId
, WM_EMACS_REGISTER_HOT_KEY
,
8426 DEFUN ("w32-unregister-hot-key", Fw32_unregister_hot_key
,
8427 Sw32_unregister_hot_key
, 1, 1, 0,
8428 doc
: /* Unregister KEY as a hot-key combination. */)
8434 if (!INTEGERP (key
))
8435 key
= w32_parse_hot_key (key
);
8437 item
= Fmemq (key
, w32_grabbed_keys
);
8441 /* Notify input thread about hot-key definition being removed, so
8442 that it takes effect without needing focus switch. */
8443 #ifdef USE_LISP_UNION_TYPE
8444 if (PostThreadMessage (dwWindowsThreadId
, WM_EMACS_UNREGISTER_HOT_KEY
,
8445 (WPARAM
) XINT (XCAR (item
)), (LPARAM
) item
.i
))
8447 if (PostThreadMessage (dwWindowsThreadId
, WM_EMACS_UNREGISTER_HOT_KEY
,
8448 (WPARAM
) XINT (XCAR (item
)), (LPARAM
) item
))
8452 GetMessage (&msg
, NULL
, WM_EMACS_DONE
, WM_EMACS_DONE
);
8459 DEFUN ("w32-registered-hot-keys", Fw32_registered_hot_keys
,
8460 Sw32_registered_hot_keys
, 0, 0, 0,
8461 doc
: /* Return list of registered hot-key IDs. */)
8464 return Fdelq (Qnil
, Fcopy_sequence (w32_grabbed_keys
));
8467 DEFUN ("w32-reconstruct-hot-key", Fw32_reconstruct_hot_key
,
8468 Sw32_reconstruct_hot_key
, 1, 1, 0,
8469 doc
: /* Convert hot-key ID to a lisp key combination.
8470 usage: (w32-reconstruct-hot-key ID) */)
8472 Lisp_Object hotkeyid
;
8474 int vk_code
, w32_modifiers
;
8477 CHECK_NUMBER (hotkeyid
);
8479 vk_code
= HOTKEY_VK_CODE (hotkeyid
);
8480 w32_modifiers
= HOTKEY_MODIFIERS (hotkeyid
);
8482 if (vk_code
< 256 && lispy_function_keys
[vk_code
])
8483 key
= intern (lispy_function_keys
[vk_code
]);
8485 key
= make_number (vk_code
);
8487 key
= Fcons (key
, Qnil
);
8488 if (w32_modifiers
& MOD_SHIFT
)
8489 key
= Fcons (Qshift
, key
);
8490 if (w32_modifiers
& MOD_CONTROL
)
8491 key
= Fcons (Qctrl
, key
);
8492 if (w32_modifiers
& MOD_ALT
)
8493 key
= Fcons (NILP (Vw32_alt_is_meta
) ? Qalt
: Qmeta
, key
);
8494 if (w32_modifiers
& MOD_WIN
)
8495 key
= Fcons (Qhyper
, key
);
8500 DEFUN ("w32-toggle-lock-key", Fw32_toggle_lock_key
,
8501 Sw32_toggle_lock_key
, 1, 2, 0,
8502 doc
: /* Toggle the state of the lock key KEY.
8503 KEY can be `capslock', `kp-numlock', or `scroll'.
8504 If the optional parameter NEW-STATE is a number, then the state of KEY
8505 is set to off if the low bit of NEW-STATE is zero, otherwise on. */)
8507 Lisp_Object key
, new_state
;
8511 if (EQ (key
, intern ("capslock")))
8512 vk_code
= VK_CAPITAL
;
8513 else if (EQ (key
, intern ("kp-numlock")))
8514 vk_code
= VK_NUMLOCK
;
8515 else if (EQ (key
, intern ("scroll")))
8516 vk_code
= VK_SCROLL
;
8520 if (!dwWindowsThreadId
)
8521 return make_number (w32_console_toggle_lock_key (vk_code
, new_state
));
8523 #ifdef USE_LISP_UNION_TYPE
8524 if (PostThreadMessage (dwWindowsThreadId
, WM_EMACS_TOGGLE_LOCK_KEY
,
8525 (WPARAM
) vk_code
, (LPARAM
) new_state
.i
))
8527 if (PostThreadMessage (dwWindowsThreadId
, WM_EMACS_TOGGLE_LOCK_KEY
,
8528 (WPARAM
) vk_code
, (LPARAM
) new_state
))
8532 GetMessage (&msg
, NULL
, WM_EMACS_DONE
, WM_EMACS_DONE
);
8533 return make_number (msg
.wParam
);
8538 DEFUN ("w32-window-exists-p", Fw32_window_exists_p
, Sw32_window_exists_p
,
8540 doc
: /* Return non-nil if a window exists with the specified CLASS and NAME.
8542 This is a direct interface to the Windows API FindWindow function. */)
8544 Lisp_Object
class, name
;
8549 CHECK_STRING (class);
8551 CHECK_STRING (name
);
8553 hnd
= FindWindow (STRINGP (class) ? ((LPCTSTR
) SDATA (class)) : NULL
,
8554 STRINGP (name
) ? ((LPCTSTR
) SDATA (name
)) : NULL
);
8560 DEFUN ("w32-battery-status", Fw32_battery_status
, Sw32_battery_status
, 0, 0, 0,
8561 doc
: /* Get power status information from Windows system.
8563 The following %-sequences are provided:
8564 %L AC line status (verbose)
8565 %B Battery status (verbose)
8566 %b Battery status, empty means high, `-' means low,
8567 `!' means critical, and `+' means charging
8568 %p Battery load percentage
8569 %s Remaining time (to charge or discharge) in seconds
8570 %m Remaining time (to charge or discharge) in minutes
8571 %h Remaining time (to charge or discharge) in hours
8572 %t Remaining time (to charge or discharge) in the form `h:min' */)
8575 Lisp_Object status
= Qnil
;
8577 SYSTEM_POWER_STATUS system_status
;
8578 if (GetSystemPowerStatus (&system_status
))
8580 Lisp_Object line_status
, battery_status
, battery_status_symbol
;
8581 Lisp_Object load_percentage
, seconds
, minutes
, hours
, remain
;
8582 Lisp_Object sequences
[8];
8584 long seconds_left
= (long) system_status
.BatteryLifeTime
;
8586 if (system_status
.ACLineStatus
== 0)
8587 line_status
= build_string ("off-line");
8588 else if (system_status
.ACLineStatus
== 1)
8589 line_status
= build_string ("on-line");
8591 line_status
= build_string ("N/A");
8593 if (system_status
.BatteryFlag
& 128)
8595 battery_status
= build_string ("N/A");
8596 battery_status_symbol
= build_string ("");
8598 else if (system_status
.BatteryFlag
& 8)
8600 battery_status
= build_string ("charging");
8601 battery_status_symbol
= build_string ("+");
8602 if (system_status
.BatteryFullLifeTime
!= -1L)
8603 seconds_left
= system_status
.BatteryFullLifeTime
- seconds_left
;
8605 else if (system_status
.BatteryFlag
& 4)
8607 battery_status
= build_string ("critical");
8608 battery_status_symbol
= build_string ("!");
8610 else if (system_status
.BatteryFlag
& 2)
8612 battery_status
= build_string ("low");
8613 battery_status_symbol
= build_string ("-");
8615 else if (system_status
.BatteryFlag
& 1)
8617 battery_status
= build_string ("high");
8618 battery_status_symbol
= build_string ("");
8622 battery_status
= build_string ("medium");
8623 battery_status_symbol
= build_string ("");
8626 if (system_status
.BatteryLifePercent
> 100)
8627 load_percentage
= build_string ("N/A");
8631 _snprintf (buffer
, 16, "%d", system_status
.BatteryLifePercent
);
8632 load_percentage
= build_string (buffer
);
8635 if (seconds_left
< 0)
8636 seconds
= minutes
= hours
= remain
= build_string ("N/A");
8642 _snprintf (buffer
, 16, "%ld", seconds_left
);
8643 seconds
= build_string (buffer
);
8645 m
= seconds_left
/ 60;
8646 _snprintf (buffer
, 16, "%ld", m
);
8647 minutes
= build_string (buffer
);
8649 h
= seconds_left
/ 3600.0;
8650 _snprintf (buffer
, 16, "%3.1f", h
);
8651 hours
= build_string (buffer
);
8653 _snprintf (buffer
, 16, "%ld:%02ld", m
/ 60, m
% 60);
8654 remain
= build_string (buffer
);
8656 sequences
[0] = Fcons (make_number ('L'), line_status
);
8657 sequences
[1] = Fcons (make_number ('B'), battery_status
);
8658 sequences
[2] = Fcons (make_number ('b'), battery_status_symbol
);
8659 sequences
[3] = Fcons (make_number ('p'), load_percentage
);
8660 sequences
[4] = Fcons (make_number ('s'), seconds
);
8661 sequences
[5] = Fcons (make_number ('m'), minutes
);
8662 sequences
[6] = Fcons (make_number ('h'), hours
);
8663 sequences
[7] = Fcons (make_number ('t'), remain
);
8665 status
= Flist (8, sequences
);
8671 DEFUN ("file-system-info", Ffile_system_info
, Sfile_system_info
, 1, 1, 0,
8672 doc
: /* Return storage information about the file system FILENAME is on.
8673 Value is a list of floats (TOTAL FREE AVAIL), where TOTAL is the total
8674 storage of the file system, FREE is the free storage, and AVAIL is the
8675 storage available to a non-superuser. All 3 numbers are in bytes.
8676 If the underlying system call fails, value is nil. */)
8678 Lisp_Object filename
;
8680 Lisp_Object encoded
, value
;
8682 CHECK_STRING (filename
);
8683 filename
= Fexpand_file_name (filename
, Qnil
);
8684 encoded
= ENCODE_FILE (filename
);
8688 /* Determining the required information on Windows turns out, sadly,
8689 to be more involved than one would hope. The original Win32 api
8690 call for this will return bogus information on some systems, but we
8691 must dynamically probe for the replacement api, since that was
8692 added rather late on. */
8694 HMODULE hKernel
= GetModuleHandle ("kernel32");
8695 BOOL (*pfn_GetDiskFreeSpaceEx
)
8696 (char *, PULARGE_INTEGER
, PULARGE_INTEGER
, PULARGE_INTEGER
)
8697 = (void *) GetProcAddress (hKernel
, "GetDiskFreeSpaceEx");
8699 /* On Windows, we may need to specify the root directory of the
8700 volume holding FILENAME. */
8701 char rootname
[MAX_PATH
];
8702 char *name
= SDATA (encoded
);
8704 /* find the root name of the volume if given */
8705 if (isalpha (name
[0]) && name
[1] == ':')
8707 rootname
[0] = name
[0];
8708 rootname
[1] = name
[1];
8712 else if (IS_DIRECTORY_SEP (name
[0]) && IS_DIRECTORY_SEP (name
[1]))
8714 char *str
= rootname
;
8718 if (IS_DIRECTORY_SEP (*name
) && --slashes
== 0)
8728 if (pfn_GetDiskFreeSpaceEx
)
8730 /* Unsigned large integers cannot be cast to double, so
8731 use signed ones instead. */
8732 LARGE_INTEGER availbytes
;
8733 LARGE_INTEGER freebytes
;
8734 LARGE_INTEGER totalbytes
;
8736 if (pfn_GetDiskFreeSpaceEx (rootname
,
8737 (ULARGE_INTEGER
*)&availbytes
,
8738 (ULARGE_INTEGER
*)&totalbytes
,
8739 (ULARGE_INTEGER
*)&freebytes
))
8740 value
= list3 (make_float ((double) totalbytes
.QuadPart
),
8741 make_float ((double) freebytes
.QuadPart
),
8742 make_float ((double) availbytes
.QuadPart
));
8746 DWORD sectors_per_cluster
;
8747 DWORD bytes_per_sector
;
8748 DWORD free_clusters
;
8749 DWORD total_clusters
;
8751 if (GetDiskFreeSpace (rootname
,
8752 §ors_per_cluster
,
8756 value
= list3 (make_float ((double) total_clusters
8757 * sectors_per_cluster
* bytes_per_sector
),
8758 make_float ((double) free_clusters
8759 * sectors_per_cluster
* bytes_per_sector
),
8760 make_float ((double) free_clusters
8761 * sectors_per_cluster
* bytes_per_sector
));
8768 DEFUN ("default-printer-name", Fdefault_printer_name
, Sdefault_printer_name
,
8769 0, 0, 0, doc
: /* Return the name of Windows default printer device. */)
8772 static char pname_buf
[256];
8775 PRINTER_INFO_2
*ppi2
= NULL
;
8776 DWORD dwNeeded
= 0, dwReturned
= 0;
8778 /* Retrieve the default string from Win.ini (the registry).
8779 * String will be in form "printername,drivername,portname".
8780 * This is the most portable way to get the default printer. */
8781 if (GetProfileString ("windows", "device", ",,", pname_buf
, sizeof (pname_buf
)) <= 0)
8783 /* printername precedes first "," character */
8784 strtok (pname_buf
, ",");
8785 /* We want to know more than the printer name */
8786 if (!OpenPrinter (pname_buf
, &hPrn
, NULL
))
8788 GetPrinter (hPrn
, 2, NULL
, 0, &dwNeeded
);
8791 ClosePrinter (hPrn
);
8794 /* Allocate memory for the PRINTER_INFO_2 struct */
8795 ppi2
= (PRINTER_INFO_2
*) xmalloc (dwNeeded
);
8798 ClosePrinter (hPrn
);
8801 /* Call GetPrinter again with big enouth memory block */
8802 err
= GetPrinter (hPrn
, 2, (LPBYTE
)ppi2
, dwNeeded
, &dwReturned
);
8803 ClosePrinter (hPrn
);
8812 if (ppi2
->Attributes
& PRINTER_ATTRIBUTE_SHARED
&& ppi2
->pServerName
)
8814 /* a remote printer */
8815 if (*ppi2
->pServerName
== '\\')
8816 _snprintf (pname_buf
, sizeof (pname_buf
), "%s\\%s", ppi2
->pServerName
,
8819 _snprintf (pname_buf
, sizeof (pname_buf
), "\\\\%s\\%s", ppi2
->pServerName
,
8821 pname_buf
[sizeof (pname_buf
) - 1] = '\0';
8825 /* a local printer */
8826 strncpy (pname_buf
, ppi2
->pPortName
, sizeof (pname_buf
));
8827 pname_buf
[sizeof (pname_buf
) - 1] = '\0';
8828 /* `pPortName' can include several ports, delimited by ','.
8829 * we only use the first one. */
8830 strtok (pname_buf
, ",");
8835 return build_string (pname_buf
);
8838 /***********************************************************************
8840 ***********************************************************************/
8842 /* Keep this list in the same order as frame_parms in frame.c.
8843 Use 0 for unsupported frame parameters. */
8845 frame_parm_handler w32_frame_parm_handlers
[] =
8849 x_set_background_color
,
8855 x_set_foreground_color
,
8858 x_set_internal_border_width
,
8859 x_set_menu_bar_lines
,
8861 x_explicitly_set_name
,
8862 x_set_scroll_bar_width
,
8865 x_set_vertical_scroll_bars
,
8867 x_set_tool_bar_lines
,
8868 0, /* x_set_scroll_bar_foreground, */
8869 0, /* x_set_scroll_bar_background, */
8874 0, /* x_set_wait_for_wm, */
8877 0 /* x_set_alpha, */
8883 globals_of_w32fns ();
8884 /* This is zero if not using MS-Windows. */
8886 track_mouse_window
= NULL
;
8888 w32_visible_system_caret_hwnd
= NULL
;
8890 DEFSYM (Qnone
, "none");
8891 DEFSYM (Qsuppress_icon
, "suppress-icon");
8892 DEFSYM (Qundefined_color
, "undefined-color");
8893 DEFSYM (Qcancel_timer
, "cancel-timer");
8894 DEFSYM (Qhyper
, "hyper");
8895 DEFSYM (Qsuper
, "super");
8896 DEFSYM (Qmeta
, "meta");
8897 DEFSYM (Qalt
, "alt");
8898 DEFSYM (Qctrl
, "ctrl");
8899 DEFSYM (Qcontrol
, "control");
8900 DEFSYM (Qshift
, "shift");
8901 DEFSYM (Qfont_param
, "font-parameter");
8902 /* This is the end of symbol initialization. */
8904 /* Text property `display' should be nonsticky by default. */
8905 Vtext_property_default_nonsticky
8906 = Fcons (Fcons (Qdisplay
, Qt
), Vtext_property_default_nonsticky
);
8909 Fput (Qundefined_color
, Qerror_conditions
,
8910 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
8911 Fput (Qundefined_color
, Qerror_message
,
8912 build_string ("Undefined color"));
8914 staticpro (&w32_grabbed_keys
);
8915 w32_grabbed_keys
= Qnil
;
8917 DEFVAR_LISP ("w32-color-map", &Vw32_color_map
,
8918 doc
: /* An array of color name mappings for Windows. */);
8919 Vw32_color_map
= Qnil
;
8921 DEFVAR_LISP ("w32-pass-alt-to-system", &Vw32_pass_alt_to_system
,
8922 doc
: /* Non-nil if Alt key presses are passed on to Windows.
8923 When non-nil, for example, Alt pressed and released and then space will
8924 open the System menu. When nil, Emacs processes the Alt key events, and
8925 then silently swallows them. */);
8926 Vw32_pass_alt_to_system
= Qnil
;
8928 DEFVAR_LISP ("w32-alt-is-meta", &Vw32_alt_is_meta
,
8929 doc
: /* Non-nil if the Alt key is to be considered the same as the META key.
8930 When nil, Emacs will translate the Alt key to the ALT modifier, not to META. */);
8931 Vw32_alt_is_meta
= Qt
;
8933 DEFVAR_INT ("w32-quit-key", &w32_quit_key
,
8934 doc
: /* If non-zero, the virtual key code for an alternative quit key. */);
8937 DEFVAR_LISP ("w32-pass-lwindow-to-system",
8938 &Vw32_pass_lwindow_to_system
,
8939 doc
: /* If non-nil, the left \"Windows\" key is passed on to Windows.
8941 When non-nil, the Start menu is opened by tapping the key.
8942 If you set this to nil, the left \"Windows\" key is processed by Emacs
8943 according to the value of `w32-lwindow-modifier', which see.
8945 Note that some combinations of the left \"Windows\" key with other keys are
8946 caught by Windows at low level, and so binding them in Emacs will have no
8947 effect. For example, <lwindow>-r always pops up the Windows Run dialog,
8948 <lwindow>-<Pause> pops up the "System Properties" dialog, etc. However, see
8949 the doc string of `w32-phantom-key-code'. */);
8950 Vw32_pass_lwindow_to_system
= Qt
;
8952 DEFVAR_LISP ("w32-pass-rwindow-to-system",
8953 &Vw32_pass_rwindow_to_system
,
8954 doc
: /* If non-nil, the right \"Windows\" key is passed on to Windows.
8956 When non-nil, the Start menu is opened by tapping the key.
8957 If you set this to nil, the right \"Windows\" key is processed by Emacs
8958 according to the value of `w32-rwindow-modifier', which see.
8960 Note that some combinations of the right \"Windows\" key with other keys are
8961 caught by Windows at low level, and so binding them in Emacs will have no
8962 effect. For example, <rwindow>-r always pops up the Windows Run dialog,
8963 <rwindow>-<Pause> pops up the "System Properties" dialog, etc. However, see
8964 the doc string of `w32-phantom-key-code'. */);
8965 Vw32_pass_rwindow_to_system
= Qt
;
8967 DEFVAR_LISP ("w32-phantom-key-code",
8968 &Vw32_phantom_key_code
,
8969 doc
: /* Virtual key code used to generate \"phantom\" key presses.
8970 Value is a number between 0 and 255.
8972 Phantom key presses are generated in order to stop the system from
8973 acting on \"Windows\" key events when `w32-pass-lwindow-to-system' or
8974 `w32-pass-rwindow-to-system' is nil. */);
8975 /* Although 255 is technically not a valid key code, it works and
8976 means that this hack won't interfere with any real key code. */
8977 XSETINT (Vw32_phantom_key_code
, 255);
8979 DEFVAR_LISP ("w32-enable-num-lock",
8980 &Vw32_enable_num_lock
,
8981 doc
: /* If non-nil, the Num Lock key acts normally.
8982 Set to nil to handle Num Lock as the `kp-numlock' key. */);
8983 Vw32_enable_num_lock
= Qt
;
8985 DEFVAR_LISP ("w32-enable-caps-lock",
8986 &Vw32_enable_caps_lock
,
8987 doc
: /* If non-nil, the Caps Lock key acts normally.
8988 Set to nil to handle Caps Lock as the `capslock' key. */);
8989 Vw32_enable_caps_lock
= Qt
;
8991 DEFVAR_LISP ("w32-scroll-lock-modifier",
8992 &Vw32_scroll_lock_modifier
,
8993 doc
: /* Modifier to use for the Scroll Lock ON state.
8994 The value can be hyper, super, meta, alt, control or shift for the
8995 respective modifier, or nil to handle Scroll Lock as the `scroll' key.
8996 Any other value will cause the Scroll Lock key to be ignored. */);
8997 Vw32_scroll_lock_modifier
= Qt
;
8999 DEFVAR_LISP ("w32-lwindow-modifier",
9000 &Vw32_lwindow_modifier
,
9001 doc
: /* Modifier to use for the left \"Windows\" key.
9002 The value can be hyper, super, meta, alt, control or shift for the
9003 respective modifier, or nil to appear as the `lwindow' key.
9004 Any other value will cause the key to be ignored. */);
9005 Vw32_lwindow_modifier
= Qnil
;
9007 DEFVAR_LISP ("w32-rwindow-modifier",
9008 &Vw32_rwindow_modifier
,
9009 doc
: /* Modifier to use for the right \"Windows\" key.
9010 The value can be hyper, super, meta, alt, control or shift for the
9011 respective modifier, or nil to appear as the `rwindow' key.
9012 Any other value will cause the key to be ignored. */);
9013 Vw32_rwindow_modifier
= Qnil
;
9015 DEFVAR_LISP ("w32-apps-modifier",
9016 &Vw32_apps_modifier
,
9017 doc
: /* Modifier to use for the \"Apps\" key.
9018 The value can be hyper, super, meta, alt, control or shift for the
9019 respective modifier, or nil to appear as the `apps' key.
9020 Any other value will cause the key to be ignored. */);
9021 Vw32_apps_modifier
= Qnil
;
9023 DEFVAR_BOOL ("w32-enable-synthesized-fonts", &w32_enable_synthesized_fonts
,
9024 doc
: /* Non-nil enables selection of artificially italicized and bold fonts. */);
9025 w32_enable_synthesized_fonts
= 0;
9027 DEFVAR_LISP ("w32-enable-palette", &Vw32_enable_palette
,
9028 doc
: /* Non-nil enables Windows palette management to map colors exactly. */);
9029 Vw32_enable_palette
= Qt
;
9031 DEFVAR_INT ("w32-mouse-button-tolerance",
9032 &w32_mouse_button_tolerance
,
9033 doc
: /* Analogue of double click interval for faking middle mouse events.
9034 The value is the minimum time in milliseconds that must elapse between
9035 left and right button down events before they are considered distinct events.
9036 If both mouse buttons are depressed within this interval, a middle mouse
9037 button down event is generated instead. */);
9038 w32_mouse_button_tolerance
= GetDoubleClickTime () / 2;
9040 DEFVAR_INT ("w32-mouse-move-interval",
9041 &w32_mouse_move_interval
,
9042 doc
: /* Minimum interval between mouse move events.
9043 The value is the minimum time in milliseconds that must elapse between
9044 successive mouse move (or scroll bar drag) events before they are
9045 reported as lisp events. */);
9046 w32_mouse_move_interval
= 0;
9048 DEFVAR_BOOL ("w32-pass-extra-mouse-buttons-to-system",
9049 &w32_pass_extra_mouse_buttons_to_system
,
9050 doc
: /* If non-nil, the fourth and fifth mouse buttons are passed to Windows.
9051 Recent versions of Windows support mice with up to five buttons.
9052 Since most applications don't support these extra buttons, most mouse
9053 drivers will allow you to map them to functions at the system level.
9054 If this variable is non-nil, Emacs will pass them on, allowing the
9055 system to handle them. */);
9056 w32_pass_extra_mouse_buttons_to_system
= 0;
9058 DEFVAR_BOOL ("w32-pass-multimedia-buttons-to-system",
9059 &w32_pass_multimedia_buttons_to_system
,
9060 doc
: /* If non-nil, media buttons are passed to Windows.
9061 Some modern keyboards contain buttons for controlling media players, web
9062 browsers and other applications. Generally these buttons are handled on a
9063 system wide basis, but by setting this to nil they are made available
9064 to Emacs for binding. Depending on your keyboard, additional keys that
9065 may be available are:
9067 browser-back, browser-forward, browser-refresh, browser-stop,
9068 browser-search, browser-favorites, browser-home,
9069 mail, mail-reply, mail-forward, mail-send,
9071 help, find, new, open, close, save, print, undo, redo, copy, cut, paste,
9072 spell-check, correction-list, toggle-dictate-command,
9073 media-next, media-previous, media-stop, media-play-pause, media-select,
9074 media-play, media-pause, media-record, media-fast-forward, media-rewind,
9075 media-channel-up, media-channel-down,
9076 volume-mute, volume-up, volume-down,
9077 mic-volume-mute, mic-volume-down, mic-volume-up, mic-toggle,
9078 bass-down, bass-boost, bass-up, treble-down, treble-up */);
9079 w32_pass_multimedia_buttons_to_system
= 1;
9081 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
9082 doc
: /* The shape of the pointer when over text.
9083 Changing the value does not affect existing frames
9084 unless you set the mouse color. */);
9085 Vx_pointer_shape
= Qnil
;
9087 Vx_nontext_pointer_shape
= Qnil
;
9089 Vx_mode_pointer_shape
= Qnil
;
9091 DEFVAR_LISP ("x-hourglass-pointer-shape", &Vx_hourglass_pointer_shape
,
9092 doc
: /* The shape of the pointer when Emacs is busy.
9093 This variable takes effect when you create a new frame
9094 or when you set the mouse color. */);
9095 Vx_hourglass_pointer_shape
= Qnil
;
9097 DEFVAR_BOOL ("display-hourglass", &display_hourglass_p
,
9098 doc
: /* Non-zero means Emacs displays an hourglass pointer on window systems. */);
9099 display_hourglass_p
= 1;
9101 DEFVAR_LISP ("hourglass-delay", &Vhourglass_delay
,
9102 doc
: /* *Seconds to wait before displaying an hourglass pointer.
9103 Value must be an integer or float. */);
9104 Vhourglass_delay
= make_number (DEFAULT_HOURGLASS_DELAY
);
9106 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
9107 &Vx_sensitive_text_pointer_shape
,
9108 doc
: /* The shape of the pointer when over mouse-sensitive text.
9109 This variable takes effect when you create a new frame
9110 or when you set the mouse color. */);
9111 Vx_sensitive_text_pointer_shape
= Qnil
;
9113 DEFVAR_LISP ("x-window-horizontal-drag-cursor",
9114 &Vx_window_horizontal_drag_shape
,
9115 doc
: /* Pointer shape to use for indicating a window can be dragged horizontally.
9116 This variable takes effect when you create a new frame
9117 or when you set the mouse color. */);
9118 Vx_window_horizontal_drag_shape
= Qnil
;
9120 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
9121 doc
: /* A string indicating the foreground color of the cursor box. */);
9122 Vx_cursor_fore_pixel
= Qnil
;
9124 DEFVAR_LISP ("x-max-tooltip-size", &Vx_max_tooltip_size
,
9125 doc
: /* Maximum size for tooltips.
9126 Value is a pair (COLUMNS . ROWS). Text larger than this is clipped. */);
9127 Vx_max_tooltip_size
= Fcons (make_number (80), make_number (40));
9129 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
9130 doc
: /* Non-nil if no window manager is in use.
9131 Emacs doesn't try to figure this out; this is always nil
9132 unless you set it to something else. */);
9133 /* We don't have any way to find this out, so set it to nil
9134 and maybe the user would like to set it to t. */
9135 Vx_no_window_manager
= Qnil
;
9137 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
9138 &Vx_pixel_size_width_font_regexp
,
9139 doc
: /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'.
9141 Since Emacs gets width of a font matching with this regexp from
9142 PIXEL_SIZE field of the name, font finding mechanism gets faster for
9143 such a font. This is especially effective for such large fonts as
9144 Chinese, Japanese, and Korean. */);
9145 Vx_pixel_size_width_font_regexp
= Qnil
;
9147 DEFVAR_LISP ("w32-bdf-filename-alist",
9148 &Vw32_bdf_filename_alist
,
9149 doc
: /* List of bdf fonts and their corresponding filenames. */);
9150 Vw32_bdf_filename_alist
= Qnil
;
9152 DEFVAR_BOOL ("w32-strict-fontnames",
9153 &w32_strict_fontnames
,
9154 doc
: /* Non-nil means only use fonts that are exact matches for those requested.
9155 Default is nil, which allows old fontnames that are not XLFD compliant,
9156 and allows third-party CJK display to work by specifying false charset
9157 fields to trick Emacs into translating to Big5, SJIS etc.
9158 Setting this to t will prevent wrong fonts being selected when
9159 fontsets are automatically created. */);
9160 w32_strict_fontnames
= 0;
9162 DEFVAR_BOOL ("w32-strict-painting",
9163 &w32_strict_painting
,
9164 doc
: /* Non-nil means use strict rules for repainting frames.
9165 Set this to nil to get the old behavior for repainting; this should
9166 only be necessary if the default setting causes problems. */);
9167 w32_strict_painting
= 1;
9169 DEFVAR_LISP ("w32-charset-info-alist",
9170 &Vw32_charset_info_alist
,
9171 doc
: /* Alist linking Emacs character sets to Windows fonts and codepages.
9172 Each entry should be of the form:
9174 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE))
9176 where CHARSET_NAME is a string used in font names to identify the charset,
9177 WINDOWS_CHARSET is a symbol that can be one of:
9178 w32-charset-ansi, w32-charset-default, w32-charset-symbol,
9179 w32-charset-shiftjis, w32-charset-hangeul, w32-charset-gb2312,
9180 w32-charset-chinesebig5,
9181 w32-charset-johab, w32-charset-hebrew,
9182 w32-charset-arabic, w32-charset-greek, w32-charset-turkish,
9183 w32-charset-vietnamese, w32-charset-thai, w32-charset-easteurope,
9184 w32-charset-russian, w32-charset-mac, w32-charset-baltic,
9185 w32-charset-unicode,
9187 CODEPAGE should be an integer specifying the codepage that should be used
9188 to display the character set, t to do no translation and output as Unicode,
9189 or nil to do no translation and output as 8 bit (or multibyte on far-east
9190 versions of Windows) characters. */);
9191 Vw32_charset_info_alist
= Qnil
;
9193 DEFSYM (Qw32_charset_ansi
, "w32-charset-ansi");
9194 DEFSYM (Qw32_charset_symbol
, "w32-charset-symbol");
9195 DEFSYM (Qw32_charset_default
, "w32-charset-default");
9196 DEFSYM (Qw32_charset_shiftjis
, "w32-charset-shiftjis");
9197 DEFSYM (Qw32_charset_hangeul
, "w32-charset-hangeul");
9198 DEFSYM (Qw32_charset_chinesebig5
, "w32-charset-chinesebig5");
9199 DEFSYM (Qw32_charset_gb2312
, "w32-charset-gb2312");
9200 DEFSYM (Qw32_charset_oem
, "w32-charset-oem");
9202 #ifdef JOHAB_CHARSET
9204 static int w32_extra_charsets_defined
= 1;
9205 DEFVAR_BOOL ("w32-extra-charsets-defined", &w32_extra_charsets_defined
,
9206 doc
: /* Internal variable. */);
9208 DEFSYM (Qw32_charset_johab
, "w32-charset-johab");
9209 DEFSYM (Qw32_charset_easteurope
, "w32-charset-easteurope");
9210 DEFSYM (Qw32_charset_turkish
, "w32-charset-turkish");
9211 DEFSYM (Qw32_charset_baltic
, "w32-charset-baltic");
9212 DEFSYM (Qw32_charset_russian
, "w32-charset-russian");
9213 DEFSYM (Qw32_charset_arabic
, "w32-charset-arabic");
9214 DEFSYM (Qw32_charset_greek
, "w32-charset-greek");
9215 DEFSYM (Qw32_charset_hebrew
, "w32-charset-hebrew");
9216 DEFSYM (Qw32_charset_vietnamese
, "w32-charset-vietnamese");
9217 DEFSYM (Qw32_charset_thai
, "w32-charset-thai");
9218 DEFSYM (Qw32_charset_mac
, "w32-charset-mac");
9222 #ifdef UNICODE_CHARSET
9224 static int w32_unicode_charset_defined
= 1;
9225 DEFVAR_BOOL ("w32-unicode-charset-defined",
9226 &w32_unicode_charset_defined
,
9227 doc
: /* Internal variable. */);
9228 DEFSYM (Qw32_charset_unicode
, "w32-charset-unicode");
9232 #if 0 /* TODO: Port to W32 */
9233 defsubr (&Sx_change_window_property
);
9234 defsubr (&Sx_delete_window_property
);
9235 defsubr (&Sx_window_property
);
9237 defsubr (&Sxw_display_color_p
);
9238 defsubr (&Sx_display_grayscale_p
);
9239 defsubr (&Sxw_color_defined_p
);
9240 defsubr (&Sxw_color_values
);
9241 defsubr (&Sx_server_max_request_size
);
9242 defsubr (&Sx_server_vendor
);
9243 defsubr (&Sx_server_version
);
9244 defsubr (&Sx_display_pixel_width
);
9245 defsubr (&Sx_display_pixel_height
);
9246 defsubr (&Sx_display_mm_width
);
9247 defsubr (&Sx_display_mm_height
);
9248 defsubr (&Sx_display_screens
);
9249 defsubr (&Sx_display_planes
);
9250 defsubr (&Sx_display_color_cells
);
9251 defsubr (&Sx_display_visual_class
);
9252 defsubr (&Sx_display_backing_store
);
9253 defsubr (&Sx_display_save_under
);
9254 defsubr (&Sx_create_frame
);
9255 defsubr (&Sx_open_connection
);
9256 defsubr (&Sx_close_connection
);
9257 defsubr (&Sx_display_list
);
9258 defsubr (&Sx_synchronize
);
9259 defsubr (&Sx_focus_frame
);
9261 /* W32 specific functions */
9263 defsubr (&Sw32_define_rgb_color
);
9264 defsubr (&Sw32_default_color_map
);
9265 defsubr (&Sw32_load_color_file
);
9266 defsubr (&Sw32_send_sys_command
);
9267 defsubr (&Sw32_shell_execute
);
9268 defsubr (&Sw32_register_hot_key
);
9269 defsubr (&Sw32_unregister_hot_key
);
9270 defsubr (&Sw32_registered_hot_keys
);
9271 defsubr (&Sw32_reconstruct_hot_key
);
9272 defsubr (&Sw32_toggle_lock_key
);
9273 defsubr (&Sw32_window_exists_p
);
9275 defsubr (&Sw32_find_bdf_fonts
);
9277 defsubr (&Sw32_battery_status
);
9279 defsubr (&Sfile_system_info
);
9280 defsubr (&Sdefault_printer_name
);
9283 /* Setting callback functions for fontset handler. */
9284 get_font_info_func
= w32_get_font_info
;
9286 #if 0 /* This function pointer doesn't seem to be used anywhere.
9287 And the pointer assigned has the wrong type, anyway. */
9288 list_fonts_func
= w32_list_fonts
;
9291 load_font_func
= w32_load_font
;
9292 find_ccl_program_func
= w32_find_ccl_program
;
9293 query_font_func
= w32_query_font
;
9294 set_frame_fontset_func
= x_set_font
;
9295 get_font_repertory_func
= x_get_font_repertory
;
9297 check_window_system_func
= check_w32
;
9300 hourglass_timer
= 0;
9301 hourglass_hwnd
= NULL
;
9302 hourglass_shown_p
= 0;
9303 defsubr (&Sx_show_tip
);
9304 defsubr (&Sx_hide_tip
);
9306 staticpro (&tip_timer
);
9308 staticpro (&tip_frame
);
9310 last_show_tip_args
= Qnil
;
9311 staticpro (&last_show_tip_args
);
9313 defsubr (&Sx_file_dialog
);
9318 globals_of_w32fns is used to initialize those global variables that
9319 must always be initialized on startup even when the global variable
9320 initialized is non zero (see the function main in emacs.c).
9321 globals_of_w32fns is called from syms_of_w32fns when the global
9322 variable initialized is 0 and directly from main when initialized
9326 globals_of_w32fns ()
9328 HMODULE user32_lib
= GetModuleHandle ("user32.dll");
9330 TrackMouseEvent not available in all versions of Windows, so must load
9331 it dynamically. Do it once, here, instead of every time it is used.
9333 track_mouse_event_fn
= (TrackMouseEvent_Proc
)
9334 GetProcAddress (user32_lib
, "TrackMouseEvent");
9335 /* ditto for GetClipboardSequenceNumber. */
9336 clipboard_sequence_fn
= (ClipboardSequence_Proc
)
9337 GetProcAddress (user32_lib
, "GetClipboardSequenceNumber");
9339 monitor_from_point_fn
= (MonitorFromPoint_Proc
)
9340 GetProcAddress (user32_lib
, "MonitorFromPoint");
9341 get_monitor_info_fn
= (GetMonitorInfo_Proc
)
9342 GetProcAddress (user32_lib
, "GetMonitorInfoA");
9345 HMODULE imm32_lib
= GetModuleHandle ("imm32.dll");
9346 get_composition_string_fn
= (ImmGetCompositionString_Proc
)
9347 GetProcAddress (imm32_lib
, "ImmGetCompositionStringW");
9348 get_ime_context_fn
= (ImmGetContext_Proc
)
9349 GetProcAddress (imm32_lib
, "ImmGetContext");
9351 DEFVAR_INT ("w32-ansi-code-page",
9352 &w32_ansi_code_page
,
9353 doc
: /* The ANSI code page used by the system. */);
9354 w32_ansi_code_page
= GetACP ();
9356 /* MessageBox does not work without this when linked to comctl32.dll 6.0. */
9357 InitCommonControls ();
9359 syms_of_w32uniscribe ();
9368 button
= MessageBox (NULL
,
9369 "A fatal error has occurred!\n\n"
9370 "Would you like to attach a debugger?\n\n"
9371 "Select YES to debug, NO to abort Emacs"
9373 "\n\n(type \"gdb -p <emacs-PID>\" and\n"
9374 "\"continue\" inside GDB before clicking YES.)"
9376 , "Emacs Abort Dialog",
9377 MB_ICONEXCLAMATION
| MB_TASKMODAL
9378 | MB_SETFOREGROUND
| MB_YESNO
);
9383 exit (2); /* tell the compiler we will never return */
9391 /* For convenience when debugging. */
9395 return GetLastError ();
9398 /* arch-tag: 707589ab-b9be-4638-8cdd-74629cc9b446
9399 (do not change this comment) */