1 /* Graphical user interface functions for the Microsoft W32 API.
2 Copyright (C) 1989, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
3 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 3, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
20 Boston, MA 02110-1301, USA. */
22 /* Added by Kevin Gallo */
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"
60 #define FILE_NAME_TEXT_FIELD edt1
62 #ifdef USE_FONT_BACKEND
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
));
74 extern XCharStruct
*w32_per_char_metric
P_ ((XFontStruct
*, wchar_t *, int));
78 extern char *lispy_function_keys
[];
80 /* The gray bitmap `bitmaps/gray'. This is done because w32term.c uses
81 it, and including `bitmaps/gray' more than once is a problem when
82 config.h defines `static' as an empty replacement string. */
84 int gray_bitmap_width
= gray_width
;
85 int gray_bitmap_height
= gray_height
;
86 unsigned char *gray_bitmap_bits
= gray_bits
;
88 /* The colormap for converting color names to RGB values */
89 Lisp_Object Vw32_color_map
;
91 /* Non nil if alt key presses are passed on to Windows. */
92 Lisp_Object Vw32_pass_alt_to_system
;
94 /* Non nil if alt key is translated to meta_modifier, nil if it is translated
96 Lisp_Object Vw32_alt_is_meta
;
98 /* If non-zero, the windows virtual key code for an alternative quit key. */
101 /* Non nil if left window key events are passed on to Windows (this only
102 affects whether "tapping" the key opens the Start menu). */
103 Lisp_Object Vw32_pass_lwindow_to_system
;
105 /* Non nil if right window key events are passed on to Windows (this
106 only affects whether "tapping" the key opens the Start menu). */
107 Lisp_Object Vw32_pass_rwindow_to_system
;
109 /* Virtual key code used to generate "phantom" key presses in order
110 to stop system from acting on Windows key events. */
111 Lisp_Object Vw32_phantom_key_code
;
113 /* Modifier associated with the left "Windows" key, or nil to act as a
115 Lisp_Object Vw32_lwindow_modifier
;
117 /* Modifier associated with the right "Windows" key, or nil to act as a
119 Lisp_Object Vw32_rwindow_modifier
;
121 /* Modifier associated with the "Apps" key, or nil to act as a normal
123 Lisp_Object Vw32_apps_modifier
;
125 /* Value is nil if Num Lock acts as a function key. */
126 Lisp_Object Vw32_enable_num_lock
;
128 /* Value is nil if Caps Lock acts as a function key. */
129 Lisp_Object Vw32_enable_caps_lock
;
131 /* Modifier associated with Scroll Lock, or nil to act as a normal key. */
132 Lisp_Object Vw32_scroll_lock_modifier
;
134 /* Switch to control whether we inhibit requests for synthesized bold
135 and italic versions of fonts. */
136 int w32_enable_synthesized_fonts
;
138 /* Enable palette management. */
139 Lisp_Object Vw32_enable_palette
;
141 /* Control how close left/right button down events must be to
142 be converted to a middle button down event. */
143 int w32_mouse_button_tolerance
;
145 /* Minimum interval between mouse movement (and scroll bar drag)
146 events that are passed on to the event loop. */
147 int w32_mouse_move_interval
;
149 /* Flag to indicate if XBUTTON events should be passed on to Windows. */
150 int w32_pass_extra_mouse_buttons_to_system
;
152 /* Non nil if no window manager is in use. */
153 Lisp_Object Vx_no_window_manager
;
155 /* Non-zero means we're allowed to display a hourglass pointer. */
157 int display_hourglass_p
;
159 /* The background and shape of the mouse pointer, and shape when not
160 over text or in the modeline. */
162 Lisp_Object Vx_pointer_shape
, Vx_nontext_pointer_shape
, Vx_mode_pointer_shape
;
163 Lisp_Object Vx_hourglass_pointer_shape
, Vx_window_horizontal_drag_shape
;
165 /* The shape when over mouse-sensitive text. */
167 Lisp_Object Vx_sensitive_text_pointer_shape
;
170 #define IDC_HAND MAKEINTRESOURCE(32649)
173 /* Color of chars displayed in cursor box. */
175 Lisp_Object Vx_cursor_fore_pixel
;
177 /* Nonzero if using Windows. */
179 static int w32_in_use
;
181 /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
183 Lisp_Object Vx_pixel_size_width_font_regexp
;
185 /* Alist of bdf fonts and the files that define them. */
186 Lisp_Object Vw32_bdf_filename_alist
;
188 /* A flag to control whether fonts are matched strictly or not. */
189 int w32_strict_fontnames
;
191 /* A flag to control whether we should only repaint if GetUpdateRect
192 indicates there is an update region. */
193 int w32_strict_painting
;
195 /* Associative list linking character set strings to Windows codepages. */
196 Lisp_Object Vw32_charset_info_alist
;
198 /* VIETNAMESE_CHARSET is not defined in some versions of MSVC. */
199 #ifndef VIETNAMESE_CHARSET
200 #define VIETNAMESE_CHARSET 163
204 Lisp_Object Qsuppress_icon
;
205 Lisp_Object Qundefined_color
;
206 Lisp_Object Qcancel_timer
;
212 Lisp_Object Qcontrol
;
215 Lisp_Object Qw32_charset_ansi
;
216 Lisp_Object Qw32_charset_default
;
217 Lisp_Object Qw32_charset_symbol
;
218 Lisp_Object Qw32_charset_shiftjis
;
219 Lisp_Object Qw32_charset_hangeul
;
220 Lisp_Object Qw32_charset_gb2312
;
221 Lisp_Object Qw32_charset_chinesebig5
;
222 Lisp_Object Qw32_charset_oem
;
224 #ifndef JOHAB_CHARSET
225 #define JOHAB_CHARSET 130
228 Lisp_Object Qw32_charset_easteurope
;
229 Lisp_Object Qw32_charset_turkish
;
230 Lisp_Object Qw32_charset_baltic
;
231 Lisp_Object Qw32_charset_russian
;
232 Lisp_Object Qw32_charset_arabic
;
233 Lisp_Object Qw32_charset_greek
;
234 Lisp_Object Qw32_charset_hebrew
;
235 Lisp_Object Qw32_charset_vietnamese
;
236 Lisp_Object Qw32_charset_thai
;
237 Lisp_Object Qw32_charset_johab
;
238 Lisp_Object Qw32_charset_mac
;
241 #ifdef UNICODE_CHARSET
242 Lisp_Object Qw32_charset_unicode
;
245 /* The ANSI codepage. */
246 int w32_ansi_code_page
;
248 /* Prefix for system colors. */
249 #define SYSTEM_COLOR_PREFIX "System"
250 #define SYSTEM_COLOR_PREFIX_LEN (sizeof (SYSTEM_COLOR_PREFIX) - 1)
252 /* State variables for emulating a three button mouse. */
257 static int button_state
= 0;
258 static W32Msg saved_mouse_button_msg
;
259 static unsigned mouse_button_timer
= 0; /* non-zero when timer is active */
260 static W32Msg saved_mouse_move_msg
;
261 static unsigned mouse_move_timer
= 0;
263 /* Window that is tracking the mouse. */
264 static HWND track_mouse_window
;
266 typedef BOOL (WINAPI
* TrackMouseEvent_Proc
)
267 (IN OUT LPTRACKMOUSEEVENT lpEventTrack
);
269 TrackMouseEvent_Proc track_mouse_event_fn
= NULL
;
270 ClipboardSequence_Proc clipboard_sequence_fn
= NULL
;
271 extern AppendMenuW_Proc unicode_append_menu
;
273 /* W95 mousewheel handler */
274 unsigned int msh_mousewheel
= 0;
277 #define MOUSE_BUTTON_ID 1
278 #define MOUSE_MOVE_ID 2
279 #define MENU_FREE_ID 3
280 /* The delay (milliseconds) before a menu is freed after WM_EXITMENULOOP
282 #define MENU_FREE_DELAY 1000
283 static unsigned menu_free_timer
= 0;
285 /* The below are defined in frame.c. */
287 extern Lisp_Object Vwindow_system_version
;
290 int image_cache_refcount
, dpyinfo_refcount
;
294 /* From w32term.c. */
295 extern int w32_num_mouse_buttons
;
296 extern Lisp_Object Vw32_recognize_altgr
;
298 extern HWND w32_system_caret_hwnd
;
300 extern int w32_system_caret_height
;
301 extern int w32_system_caret_x
;
302 extern int w32_system_caret_y
;
303 extern int w32_use_visible_system_caret
;
305 static HWND w32_visible_system_caret_hwnd
;
308 extern HMENU current_popup_menu
;
309 static int menubar_in_use
= 0;
312 /* Error if we are not connected to MS-Windows. */
317 error ("MS-Windows not in use or not initialized");
320 /* Nonzero if we can use mouse menus.
321 You should not call this unless HAVE_MENUS is defined. */
329 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
330 and checking validity for W32. */
333 check_x_frame (frame
)
339 frame
= selected_frame
;
340 CHECK_LIVE_FRAME (frame
);
342 if (! FRAME_W32_P (f
))
343 error ("Non-W32 frame used");
347 /* Let the user specify a display with a frame.
348 nil stands for the selected frame--or, if that is not a w32 frame,
349 the first display on the list. */
351 struct w32_display_info
*
352 check_x_display_info (frame
)
357 struct frame
*sf
= XFRAME (selected_frame
);
359 if (FRAME_W32_P (sf
) && FRAME_LIVE_P (sf
))
360 return FRAME_W32_DISPLAY_INFO (sf
);
362 return &one_w32_display_info
;
364 else if (STRINGP (frame
))
365 return x_display_info_for_name (frame
);
370 CHECK_LIVE_FRAME (frame
);
372 if (! FRAME_W32_P (f
))
373 error ("Non-W32 frame used");
374 return FRAME_W32_DISPLAY_INFO (f
);
378 /* Return the Emacs frame-object corresponding to an w32 window.
379 It could be the frame's main window or an icon window. */
381 /* This function can be called during GC, so use GC_xxx type test macros. */
384 x_window_to_frame (dpyinfo
, wdesc
)
385 struct w32_display_info
*dpyinfo
;
388 Lisp_Object tail
, frame
;
391 for (tail
= Vframe_list
; CONSP (tail
); tail
= XCDR (tail
))
397 if (!FRAME_W32_P (f
) || FRAME_W32_DISPLAY_INFO (f
) != dpyinfo
)
399 if (f
->output_data
.w32
->hourglass_window
== wdesc
)
402 if (FRAME_W32_WINDOW (f
) == wdesc
)
409 static Lisp_Object unwind_create_frame
P_ ((Lisp_Object
));
410 static Lisp_Object unwind_create_tip_frame
P_ ((Lisp_Object
));
411 static void my_create_window
P_ ((struct frame
*));
412 static void my_create_tip_window
P_ ((struct frame
*));
414 /* TODO: Native Input Method support; see x_create_im. */
415 void x_set_foreground_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
416 void x_set_background_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
417 void x_set_mouse_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
418 void x_set_cursor_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
419 void x_set_border_color
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
420 void x_set_cursor_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
421 void x_set_icon_type
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
422 void x_set_icon_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
423 void x_explicitly_set_name
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
424 void x_set_menu_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
425 void x_set_title
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
426 void x_set_tool_bar_lines
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
));
427 static void x_edge_detection
P_ ((struct frame
*, struct image
*, Lisp_Object
,
433 /* Store the screen positions of frame F into XPTR and YPTR.
434 These are the positions of the containing window manager window,
435 not Emacs's own window. */
438 x_real_positions (f
, xptr
, yptr
)
445 /* Get the bounds of the WM window. */
446 GetWindowRect (FRAME_W32_WINDOW (f
), &rect
);
451 /* Convert (0, 0) in the client area to screen co-ordinates. */
452 ClientToScreen (FRAME_W32_WINDOW (f
), &pt
);
454 /* Remember x_pixels_diff and y_pixels_diff. */
455 f
->x_pixels_diff
= pt
.x
- rect
.left
;
456 f
->y_pixels_diff
= pt
.y
- rect
.top
;
464 DEFUN ("w32-define-rgb-color", Fw32_define_rgb_color
,
465 Sw32_define_rgb_color
, 4, 4, 0,
466 doc
: /* Convert RGB numbers to a windows color reference and associate with NAME.
467 This adds or updates a named color to w32-color-map, making it
468 available for use. The original entry's RGB ref is returned, or nil
469 if the entry is new. */)
470 (red
, green
, blue
, name
)
471 Lisp_Object red
, green
, blue
, name
;
474 Lisp_Object oldrgb
= Qnil
;
478 CHECK_NUMBER (green
);
482 XSETINT (rgb
, RGB(XUINT (red
), XUINT (green
), XUINT (blue
)));
486 /* replace existing entry in w32-color-map or add new entry. */
487 entry
= Fassoc (name
, Vw32_color_map
);
490 entry
= Fcons (name
, rgb
);
491 Vw32_color_map
= Fcons (entry
, Vw32_color_map
);
495 oldrgb
= Fcdr (entry
);
496 Fsetcdr (entry
, rgb
);
504 DEFUN ("w32-load-color-file", Fw32_load_color_file
,
505 Sw32_load_color_file
, 1, 1, 0,
506 doc
: /* Create an alist of color entries from an external file.
507 Assign this value to w32-color-map to replace the existing color map.
509 The file should define one named RGB color per line like so:
511 where R,G,B are numbers between 0 and 255 and name is an arbitrary string. */)
513 Lisp_Object filename
;
516 Lisp_Object cmap
= Qnil
;
519 CHECK_STRING (filename
);
520 abspath
= Fexpand_file_name (filename
, Qnil
);
522 fp
= fopen (SDATA (filename
), "rt");
526 int red
, green
, blue
;
531 while (fgets (buf
, sizeof (buf
), fp
) != NULL
) {
532 if (sscanf (buf
, "%u %u %u %n", &red
, &green
, &blue
, &num
) == 3)
534 char *name
= buf
+ num
;
535 num
= strlen (name
) - 1;
536 if (name
[num
] == '\n')
538 cmap
= Fcons (Fcons (build_string (name
),
539 make_number (RGB (red
, green
, blue
))),
551 /* The default colors for the w32 color map */
552 typedef struct colormap_t
558 colormap_t w32_color_map
[] =
560 {"snow" , PALETTERGB (255,250,250)},
561 {"ghost white" , PALETTERGB (248,248,255)},
562 {"GhostWhite" , PALETTERGB (248,248,255)},
563 {"white smoke" , PALETTERGB (245,245,245)},
564 {"WhiteSmoke" , PALETTERGB (245,245,245)},
565 {"gainsboro" , PALETTERGB (220,220,220)},
566 {"floral white" , PALETTERGB (255,250,240)},
567 {"FloralWhite" , PALETTERGB (255,250,240)},
568 {"old lace" , PALETTERGB (253,245,230)},
569 {"OldLace" , PALETTERGB (253,245,230)},
570 {"linen" , PALETTERGB (250,240,230)},
571 {"antique white" , PALETTERGB (250,235,215)},
572 {"AntiqueWhite" , PALETTERGB (250,235,215)},
573 {"papaya whip" , PALETTERGB (255,239,213)},
574 {"PapayaWhip" , PALETTERGB (255,239,213)},
575 {"blanched almond" , PALETTERGB (255,235,205)},
576 {"BlanchedAlmond" , PALETTERGB (255,235,205)},
577 {"bisque" , PALETTERGB (255,228,196)},
578 {"peach puff" , PALETTERGB (255,218,185)},
579 {"PeachPuff" , PALETTERGB (255,218,185)},
580 {"navajo white" , PALETTERGB (255,222,173)},
581 {"NavajoWhite" , PALETTERGB (255,222,173)},
582 {"moccasin" , PALETTERGB (255,228,181)},
583 {"cornsilk" , PALETTERGB (255,248,220)},
584 {"ivory" , PALETTERGB (255,255,240)},
585 {"lemon chiffon" , PALETTERGB (255,250,205)},
586 {"LemonChiffon" , PALETTERGB (255,250,205)},
587 {"seashell" , PALETTERGB (255,245,238)},
588 {"honeydew" , PALETTERGB (240,255,240)},
589 {"mint cream" , PALETTERGB (245,255,250)},
590 {"MintCream" , PALETTERGB (245,255,250)},
591 {"azure" , PALETTERGB (240,255,255)},
592 {"alice blue" , PALETTERGB (240,248,255)},
593 {"AliceBlue" , PALETTERGB (240,248,255)},
594 {"lavender" , PALETTERGB (230,230,250)},
595 {"lavender blush" , PALETTERGB (255,240,245)},
596 {"LavenderBlush" , PALETTERGB (255,240,245)},
597 {"misty rose" , PALETTERGB (255,228,225)},
598 {"MistyRose" , PALETTERGB (255,228,225)},
599 {"white" , PALETTERGB (255,255,255)},
600 {"black" , PALETTERGB ( 0, 0, 0)},
601 {"dark slate gray" , PALETTERGB ( 47, 79, 79)},
602 {"DarkSlateGray" , PALETTERGB ( 47, 79, 79)},
603 {"dark slate grey" , PALETTERGB ( 47, 79, 79)},
604 {"DarkSlateGrey" , PALETTERGB ( 47, 79, 79)},
605 {"dim gray" , PALETTERGB (105,105,105)},
606 {"DimGray" , PALETTERGB (105,105,105)},
607 {"dim grey" , PALETTERGB (105,105,105)},
608 {"DimGrey" , PALETTERGB (105,105,105)},
609 {"slate gray" , PALETTERGB (112,128,144)},
610 {"SlateGray" , PALETTERGB (112,128,144)},
611 {"slate grey" , PALETTERGB (112,128,144)},
612 {"SlateGrey" , PALETTERGB (112,128,144)},
613 {"light slate gray" , PALETTERGB (119,136,153)},
614 {"LightSlateGray" , PALETTERGB (119,136,153)},
615 {"light slate grey" , PALETTERGB (119,136,153)},
616 {"LightSlateGrey" , PALETTERGB (119,136,153)},
617 {"gray" , PALETTERGB (190,190,190)},
618 {"grey" , PALETTERGB (190,190,190)},
619 {"light grey" , PALETTERGB (211,211,211)},
620 {"LightGrey" , PALETTERGB (211,211,211)},
621 {"light gray" , PALETTERGB (211,211,211)},
622 {"LightGray" , PALETTERGB (211,211,211)},
623 {"midnight blue" , PALETTERGB ( 25, 25,112)},
624 {"MidnightBlue" , PALETTERGB ( 25, 25,112)},
625 {"navy" , PALETTERGB ( 0, 0,128)},
626 {"navy blue" , PALETTERGB ( 0, 0,128)},
627 {"NavyBlue" , PALETTERGB ( 0, 0,128)},
628 {"cornflower blue" , PALETTERGB (100,149,237)},
629 {"CornflowerBlue" , PALETTERGB (100,149,237)},
630 {"dark slate blue" , PALETTERGB ( 72, 61,139)},
631 {"DarkSlateBlue" , PALETTERGB ( 72, 61,139)},
632 {"slate blue" , PALETTERGB (106, 90,205)},
633 {"SlateBlue" , PALETTERGB (106, 90,205)},
634 {"medium slate blue" , PALETTERGB (123,104,238)},
635 {"MediumSlateBlue" , PALETTERGB (123,104,238)},
636 {"light slate blue" , PALETTERGB (132,112,255)},
637 {"LightSlateBlue" , PALETTERGB (132,112,255)},
638 {"medium blue" , PALETTERGB ( 0, 0,205)},
639 {"MediumBlue" , PALETTERGB ( 0, 0,205)},
640 {"royal blue" , PALETTERGB ( 65,105,225)},
641 {"RoyalBlue" , PALETTERGB ( 65,105,225)},
642 {"blue" , PALETTERGB ( 0, 0,255)},
643 {"dodger blue" , PALETTERGB ( 30,144,255)},
644 {"DodgerBlue" , PALETTERGB ( 30,144,255)},
645 {"deep sky blue" , PALETTERGB ( 0,191,255)},
646 {"DeepSkyBlue" , PALETTERGB ( 0,191,255)},
647 {"sky blue" , PALETTERGB (135,206,235)},
648 {"SkyBlue" , PALETTERGB (135,206,235)},
649 {"light sky blue" , PALETTERGB (135,206,250)},
650 {"LightSkyBlue" , PALETTERGB (135,206,250)},
651 {"steel blue" , PALETTERGB ( 70,130,180)},
652 {"SteelBlue" , PALETTERGB ( 70,130,180)},
653 {"light steel blue" , PALETTERGB (176,196,222)},
654 {"LightSteelBlue" , PALETTERGB (176,196,222)},
655 {"light blue" , PALETTERGB (173,216,230)},
656 {"LightBlue" , PALETTERGB (173,216,230)},
657 {"powder blue" , PALETTERGB (176,224,230)},
658 {"PowderBlue" , PALETTERGB (176,224,230)},
659 {"pale turquoise" , PALETTERGB (175,238,238)},
660 {"PaleTurquoise" , PALETTERGB (175,238,238)},
661 {"dark turquoise" , PALETTERGB ( 0,206,209)},
662 {"DarkTurquoise" , PALETTERGB ( 0,206,209)},
663 {"medium turquoise" , PALETTERGB ( 72,209,204)},
664 {"MediumTurquoise" , PALETTERGB ( 72,209,204)},
665 {"turquoise" , PALETTERGB ( 64,224,208)},
666 {"cyan" , PALETTERGB ( 0,255,255)},
667 {"light cyan" , PALETTERGB (224,255,255)},
668 {"LightCyan" , PALETTERGB (224,255,255)},
669 {"cadet blue" , PALETTERGB ( 95,158,160)},
670 {"CadetBlue" , PALETTERGB ( 95,158,160)},
671 {"medium aquamarine" , PALETTERGB (102,205,170)},
672 {"MediumAquamarine" , PALETTERGB (102,205,170)},
673 {"aquamarine" , PALETTERGB (127,255,212)},
674 {"dark green" , PALETTERGB ( 0,100, 0)},
675 {"DarkGreen" , PALETTERGB ( 0,100, 0)},
676 {"dark olive green" , PALETTERGB ( 85,107, 47)},
677 {"DarkOliveGreen" , PALETTERGB ( 85,107, 47)},
678 {"dark sea green" , PALETTERGB (143,188,143)},
679 {"DarkSeaGreen" , PALETTERGB (143,188,143)},
680 {"sea green" , PALETTERGB ( 46,139, 87)},
681 {"SeaGreen" , PALETTERGB ( 46,139, 87)},
682 {"medium sea green" , PALETTERGB ( 60,179,113)},
683 {"MediumSeaGreen" , PALETTERGB ( 60,179,113)},
684 {"light sea green" , PALETTERGB ( 32,178,170)},
685 {"LightSeaGreen" , PALETTERGB ( 32,178,170)},
686 {"pale green" , PALETTERGB (152,251,152)},
687 {"PaleGreen" , PALETTERGB (152,251,152)},
688 {"spring green" , PALETTERGB ( 0,255,127)},
689 {"SpringGreen" , PALETTERGB ( 0,255,127)},
690 {"lawn green" , PALETTERGB (124,252, 0)},
691 {"LawnGreen" , PALETTERGB (124,252, 0)},
692 {"green" , PALETTERGB ( 0,255, 0)},
693 {"chartreuse" , PALETTERGB (127,255, 0)},
694 {"medium spring green" , PALETTERGB ( 0,250,154)},
695 {"MediumSpringGreen" , PALETTERGB ( 0,250,154)},
696 {"green yellow" , PALETTERGB (173,255, 47)},
697 {"GreenYellow" , PALETTERGB (173,255, 47)},
698 {"lime green" , PALETTERGB ( 50,205, 50)},
699 {"LimeGreen" , PALETTERGB ( 50,205, 50)},
700 {"yellow green" , PALETTERGB (154,205, 50)},
701 {"YellowGreen" , PALETTERGB (154,205, 50)},
702 {"forest green" , PALETTERGB ( 34,139, 34)},
703 {"ForestGreen" , PALETTERGB ( 34,139, 34)},
704 {"olive drab" , PALETTERGB (107,142, 35)},
705 {"OliveDrab" , PALETTERGB (107,142, 35)},
706 {"dark khaki" , PALETTERGB (189,183,107)},
707 {"DarkKhaki" , PALETTERGB (189,183,107)},
708 {"khaki" , PALETTERGB (240,230,140)},
709 {"pale goldenrod" , PALETTERGB (238,232,170)},
710 {"PaleGoldenrod" , PALETTERGB (238,232,170)},
711 {"light goldenrod yellow" , PALETTERGB (250,250,210)},
712 {"LightGoldenrodYellow" , PALETTERGB (250,250,210)},
713 {"light yellow" , PALETTERGB (255,255,224)},
714 {"LightYellow" , PALETTERGB (255,255,224)},
715 {"yellow" , PALETTERGB (255,255, 0)},
716 {"gold" , PALETTERGB (255,215, 0)},
717 {"light goldenrod" , PALETTERGB (238,221,130)},
718 {"LightGoldenrod" , PALETTERGB (238,221,130)},
719 {"goldenrod" , PALETTERGB (218,165, 32)},
720 {"dark goldenrod" , PALETTERGB (184,134, 11)},
721 {"DarkGoldenrod" , PALETTERGB (184,134, 11)},
722 {"rosy brown" , PALETTERGB (188,143,143)},
723 {"RosyBrown" , PALETTERGB (188,143,143)},
724 {"indian red" , PALETTERGB (205, 92, 92)},
725 {"IndianRed" , PALETTERGB (205, 92, 92)},
726 {"saddle brown" , PALETTERGB (139, 69, 19)},
727 {"SaddleBrown" , PALETTERGB (139, 69, 19)},
728 {"sienna" , PALETTERGB (160, 82, 45)},
729 {"peru" , PALETTERGB (205,133, 63)},
730 {"burlywood" , PALETTERGB (222,184,135)},
731 {"beige" , PALETTERGB (245,245,220)},
732 {"wheat" , PALETTERGB (245,222,179)},
733 {"sandy brown" , PALETTERGB (244,164, 96)},
734 {"SandyBrown" , PALETTERGB (244,164, 96)},
735 {"tan" , PALETTERGB (210,180,140)},
736 {"chocolate" , PALETTERGB (210,105, 30)},
737 {"firebrick" , PALETTERGB (178,34, 34)},
738 {"brown" , PALETTERGB (165,42, 42)},
739 {"dark salmon" , PALETTERGB (233,150,122)},
740 {"DarkSalmon" , PALETTERGB (233,150,122)},
741 {"salmon" , PALETTERGB (250,128,114)},
742 {"light salmon" , PALETTERGB (255,160,122)},
743 {"LightSalmon" , PALETTERGB (255,160,122)},
744 {"orange" , PALETTERGB (255,165, 0)},
745 {"dark orange" , PALETTERGB (255,140, 0)},
746 {"DarkOrange" , PALETTERGB (255,140, 0)},
747 {"coral" , PALETTERGB (255,127, 80)},
748 {"light coral" , PALETTERGB (240,128,128)},
749 {"LightCoral" , PALETTERGB (240,128,128)},
750 {"tomato" , PALETTERGB (255, 99, 71)},
751 {"orange red" , PALETTERGB (255, 69, 0)},
752 {"OrangeRed" , PALETTERGB (255, 69, 0)},
753 {"red" , PALETTERGB (255, 0, 0)},
754 {"hot pink" , PALETTERGB (255,105,180)},
755 {"HotPink" , PALETTERGB (255,105,180)},
756 {"deep pink" , PALETTERGB (255, 20,147)},
757 {"DeepPink" , PALETTERGB (255, 20,147)},
758 {"pink" , PALETTERGB (255,192,203)},
759 {"light pink" , PALETTERGB (255,182,193)},
760 {"LightPink" , PALETTERGB (255,182,193)},
761 {"pale violet red" , PALETTERGB (219,112,147)},
762 {"PaleVioletRed" , PALETTERGB (219,112,147)},
763 {"maroon" , PALETTERGB (176, 48, 96)},
764 {"medium violet red" , PALETTERGB (199, 21,133)},
765 {"MediumVioletRed" , PALETTERGB (199, 21,133)},
766 {"violet red" , PALETTERGB (208, 32,144)},
767 {"VioletRed" , PALETTERGB (208, 32,144)},
768 {"magenta" , PALETTERGB (255, 0,255)},
769 {"violet" , PALETTERGB (238,130,238)},
770 {"plum" , PALETTERGB (221,160,221)},
771 {"orchid" , PALETTERGB (218,112,214)},
772 {"medium orchid" , PALETTERGB (186, 85,211)},
773 {"MediumOrchid" , PALETTERGB (186, 85,211)},
774 {"dark orchid" , PALETTERGB (153, 50,204)},
775 {"DarkOrchid" , PALETTERGB (153, 50,204)},
776 {"dark violet" , PALETTERGB (148, 0,211)},
777 {"DarkViolet" , PALETTERGB (148, 0,211)},
778 {"blue violet" , PALETTERGB (138, 43,226)},
779 {"BlueViolet" , PALETTERGB (138, 43,226)},
780 {"purple" , PALETTERGB (160, 32,240)},
781 {"medium purple" , PALETTERGB (147,112,219)},
782 {"MediumPurple" , PALETTERGB (147,112,219)},
783 {"thistle" , PALETTERGB (216,191,216)},
784 {"gray0" , PALETTERGB ( 0, 0, 0)},
785 {"grey0" , PALETTERGB ( 0, 0, 0)},
786 {"dark grey" , PALETTERGB (169,169,169)},
787 {"DarkGrey" , PALETTERGB (169,169,169)},
788 {"dark gray" , PALETTERGB (169,169,169)},
789 {"DarkGray" , PALETTERGB (169,169,169)},
790 {"dark blue" , PALETTERGB ( 0, 0,139)},
791 {"DarkBlue" , PALETTERGB ( 0, 0,139)},
792 {"dark cyan" , PALETTERGB ( 0,139,139)},
793 {"DarkCyan" , PALETTERGB ( 0,139,139)},
794 {"dark magenta" , PALETTERGB (139, 0,139)},
795 {"DarkMagenta" , PALETTERGB (139, 0,139)},
796 {"dark red" , PALETTERGB (139, 0, 0)},
797 {"DarkRed" , PALETTERGB (139, 0, 0)},
798 {"light green" , PALETTERGB (144,238,144)},
799 {"LightGreen" , PALETTERGB (144,238,144)},
802 DEFUN ("w32-default-color-map", Fw32_default_color_map
, Sw32_default_color_map
,
803 0, 0, 0, doc
: /* Return the default color map. */)
807 colormap_t
*pc
= w32_color_map
;
814 for (i
= 0; i
< sizeof (w32_color_map
) / sizeof (w32_color_map
[0]);
816 cmap
= Fcons (Fcons (build_string (pc
->name
),
817 make_number (pc
->colorref
)),
835 color
= Frassq (rgb
, Vw32_color_map
);
840 return (Fcar (color
));
846 w32_color_map_lookup (colorname
)
849 Lisp_Object tail
, ret
= Qnil
;
853 for (tail
= Vw32_color_map
; !NILP (tail
); tail
= Fcdr (tail
))
855 register Lisp_Object elt
, tem
;
858 if (!CONSP (elt
)) continue;
862 if (lstrcmpi (SDATA (tem
), colorname
) == 0)
879 add_system_logical_colors_to_map (system_colors
)
880 Lisp_Object
*system_colors
;
884 /* Other registry operations are done with input blocked. */
887 /* Look for "Control Panel/Colors" under User and Machine registry
889 if (RegOpenKeyEx (HKEY_CURRENT_USER
, "Control Panel\\Colors", 0,
890 KEY_READ
, &colors_key
) == ERROR_SUCCESS
891 || RegOpenKeyEx (HKEY_LOCAL_MACHINE
, "Control Panel\\Colors", 0,
892 KEY_READ
, &colors_key
) == ERROR_SUCCESS
)
895 char color_buffer
[64];
896 char full_name_buffer
[MAX_PATH
+ SYSTEM_COLOR_PREFIX_LEN
];
898 DWORD name_size
, color_size
;
899 char *name_buffer
= full_name_buffer
+ SYSTEM_COLOR_PREFIX_LEN
;
901 name_size
= sizeof (full_name_buffer
) - SYSTEM_COLOR_PREFIX_LEN
;
902 color_size
= sizeof (color_buffer
);
904 strcpy (full_name_buffer
, SYSTEM_COLOR_PREFIX
);
906 while (RegEnumValueA (colors_key
, index
, name_buffer
, &name_size
,
907 NULL
, NULL
, color_buffer
, &color_size
)
911 if (sscanf (color_buffer
, " %u %u %u", &r
, &g
, &b
) == 3)
912 *system_colors
= Fcons (Fcons (build_string (full_name_buffer
),
913 make_number (RGB (r
, g
, b
))),
916 name_size
= sizeof (full_name_buffer
) - SYSTEM_COLOR_PREFIX_LEN
;
917 color_size
= sizeof (color_buffer
);
920 RegCloseKey (colors_key
);
928 x_to_w32_color (colorname
)
931 register Lisp_Object ret
= Qnil
;
935 if (colorname
[0] == '#')
937 /* Could be an old-style RGB Device specification. */
940 color
= colorname
+ 1;
942 size
= strlen(color
);
943 if (size
== 3 || size
== 6 || size
== 9 || size
== 12)
951 for (i
= 0; i
< 3; i
++)
957 /* The check for 'x' in the following conditional takes into
958 account the fact that strtol allows a "0x" in front of
959 our numbers, and we don't. */
960 if (!isxdigit(color
[0]) || color
[1] == 'x')
964 value
= strtoul(color
, &end
, 16);
966 if (errno
== ERANGE
|| end
- color
!= size
)
971 value
= value
* 0x10;
982 colorval
|= (value
<< pos
);
987 XSETINT (ret
, colorval
);
994 else if (strnicmp(colorname
, "rgb:", 4) == 0)
1002 color
= colorname
+ 4;
1003 for (i
= 0; i
< 3; i
++)
1006 unsigned long value
;
1008 /* The check for 'x' in the following conditional takes into
1009 account the fact that strtol allows a "0x" in front of
1010 our numbers, and we don't. */
1011 if (!isxdigit(color
[0]) || color
[1] == 'x')
1013 value
= strtoul(color
, &end
, 16);
1014 if (errno
== ERANGE
)
1016 switch (end
- color
)
1019 value
= value
* 0x10 + value
;
1032 if (value
== ULONG_MAX
)
1034 colorval
|= (value
<< pos
);
1041 XSETINT (ret
, colorval
);
1049 else if (strnicmp(colorname
, "rgbi:", 5) == 0)
1051 /* This is an RGB Intensity specification. */
1058 color
= colorname
+ 5;
1059 for (i
= 0; i
< 3; i
++)
1065 value
= strtod(color
, &end
);
1066 if (errno
== ERANGE
)
1068 if (value
< 0.0 || value
> 1.0)
1070 val
= (UINT
)(0x100 * value
);
1071 /* We used 0x100 instead of 0xFF to give a continuous
1072 range between 0.0 and 1.0 inclusive. The next statement
1073 fixes the 1.0 case. */
1076 colorval
|= (val
<< pos
);
1083 XSETINT (ret
, colorval
);
1091 /* I am not going to attempt to handle any of the CIE color schemes
1092 or TekHVC, since I don't know the algorithms for conversion to
1095 /* If we fail to lookup the color name in w32_color_map, then check the
1096 colorname to see if it can be crudely approximated: If the X color
1097 ends in a number (e.g., "darkseagreen2"), strip the number and
1098 return the result of looking up the base color name. */
1099 ret
= w32_color_map_lookup (colorname
);
1102 int len
= strlen (colorname
);
1104 if (isdigit (colorname
[len
- 1]))
1106 char *ptr
, *approx
= alloca (len
+ 1);
1108 strcpy (approx
, colorname
);
1109 ptr
= &approx
[len
- 1];
1110 while (ptr
> approx
&& isdigit (*ptr
))
1113 ret
= w32_color_map_lookup (approx
);
1122 w32_regenerate_palette (FRAME_PTR f
)
1124 struct w32_palette_entry
* list
;
1125 LOGPALETTE
* log_palette
;
1126 HPALETTE new_palette
;
1129 /* don't bother trying to create palette if not supported */
1130 if (! FRAME_W32_DISPLAY_INFO (f
)->has_palette
)
1133 log_palette
= (LOGPALETTE
*)
1134 alloca (sizeof (LOGPALETTE
) +
1135 FRAME_W32_DISPLAY_INFO (f
)->num_colors
* sizeof (PALETTEENTRY
));
1136 log_palette
->palVersion
= 0x300;
1137 log_palette
->palNumEntries
= FRAME_W32_DISPLAY_INFO (f
)->num_colors
;
1139 list
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1141 i
< FRAME_W32_DISPLAY_INFO (f
)->num_colors
;
1142 i
++, list
= list
->next
)
1143 log_palette
->palPalEntry
[i
] = list
->entry
;
1145 new_palette
= CreatePalette (log_palette
);
1149 if (FRAME_W32_DISPLAY_INFO (f
)->palette
)
1150 DeleteObject (FRAME_W32_DISPLAY_INFO (f
)->palette
);
1151 FRAME_W32_DISPLAY_INFO (f
)->palette
= new_palette
;
1153 /* Realize display palette and garbage all frames. */
1154 release_frame_dc (f
, get_frame_dc (f
));
1159 #define W32_COLOR(pe) RGB (pe.peRed, pe.peGreen, pe.peBlue)
1160 #define SET_W32_COLOR(pe, color) \
1163 pe.peRed = GetRValue (color); \
1164 pe.peGreen = GetGValue (color); \
1165 pe.peBlue = GetBValue (color); \
1170 /* Keep these around in case we ever want to track color usage. */
1172 w32_map_color (FRAME_PTR f
, COLORREF color
)
1174 struct w32_palette_entry
* list
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1176 if (NILP (Vw32_enable_palette
))
1179 /* check if color is already mapped */
1182 if (W32_COLOR (list
->entry
) == color
)
1190 /* not already mapped, so add to list and recreate Windows palette */
1191 list
= (struct w32_palette_entry
*)
1192 xmalloc (sizeof (struct w32_palette_entry
));
1193 SET_W32_COLOR (list
->entry
, color
);
1195 list
->next
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1196 FRAME_W32_DISPLAY_INFO (f
)->color_list
= list
;
1197 FRAME_W32_DISPLAY_INFO (f
)->num_colors
++;
1199 /* set flag that palette must be regenerated */
1200 FRAME_W32_DISPLAY_INFO (f
)->regen_palette
= TRUE
;
1204 w32_unmap_color (FRAME_PTR f
, COLORREF color
)
1206 struct w32_palette_entry
* list
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1207 struct w32_palette_entry
**prev
= &FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1209 if (NILP (Vw32_enable_palette
))
1212 /* check if color is already mapped */
1215 if (W32_COLOR (list
->entry
) == color
)
1217 if (--list
->refcount
== 0)
1221 FRAME_W32_DISPLAY_INFO (f
)->num_colors
--;
1231 /* set flag that palette must be regenerated */
1232 FRAME_W32_DISPLAY_INFO (f
)->regen_palette
= TRUE
;
1237 /* Gamma-correct COLOR on frame F. */
1240 gamma_correct (f
, color
)
1246 *color
= PALETTERGB (
1247 pow (GetRValue (*color
) / 255.0, f
->gamma
) * 255.0 + 0.5,
1248 pow (GetGValue (*color
) / 255.0, f
->gamma
) * 255.0 + 0.5,
1249 pow (GetBValue (*color
) / 255.0, f
->gamma
) * 255.0 + 0.5);
1254 /* Decide if color named COLOR is valid for the display associated with
1255 the selected frame; if so, return the rgb values in COLOR_DEF.
1256 If ALLOC is nonzero, allocate a new colormap cell. */
1259 w32_defined_color (f
, color
, color_def
, alloc
)
1265 register Lisp_Object tem
;
1266 COLORREF w32_color_ref
;
1268 tem
= x_to_w32_color (color
);
1274 /* Apply gamma correction. */
1275 w32_color_ref
= XUINT (tem
);
1276 gamma_correct (f
, &w32_color_ref
);
1277 XSETINT (tem
, w32_color_ref
);
1280 /* Map this color to the palette if it is enabled. */
1281 if (!NILP (Vw32_enable_palette
))
1283 struct w32_palette_entry
* entry
=
1284 one_w32_display_info
.color_list
;
1285 struct w32_palette_entry
** prev
=
1286 &one_w32_display_info
.color_list
;
1288 /* check if color is already mapped */
1291 if (W32_COLOR (entry
->entry
) == XUINT (tem
))
1293 prev
= &entry
->next
;
1294 entry
= entry
->next
;
1297 if (entry
== NULL
&& alloc
)
1299 /* not already mapped, so add to list */
1300 entry
= (struct w32_palette_entry
*)
1301 xmalloc (sizeof (struct w32_palette_entry
));
1302 SET_W32_COLOR (entry
->entry
, XUINT (tem
));
1305 one_w32_display_info
.num_colors
++;
1307 /* set flag that palette must be regenerated */
1308 one_w32_display_info
.regen_palette
= TRUE
;
1311 /* Ensure COLORREF value is snapped to nearest color in (default)
1312 palette by simulating the PALETTERGB macro. This works whether
1313 or not the display device has a palette. */
1314 w32_color_ref
= XUINT (tem
) | 0x2000000;
1316 color_def
->pixel
= w32_color_ref
;
1317 color_def
->red
= GetRValue (w32_color_ref
) * 256;
1318 color_def
->green
= GetGValue (w32_color_ref
) * 256;
1319 color_def
->blue
= GetBValue (w32_color_ref
) * 256;
1329 /* Given a string ARG naming a color, compute a pixel value from it
1330 suitable for screen F.
1331 If F is not a color screen, return DEF (default) regardless of what
1335 x_decode_color (f
, arg
, def
)
1344 if (strcmp (SDATA (arg
), "black") == 0)
1345 return BLACK_PIX_DEFAULT (f
);
1346 else if (strcmp (SDATA (arg
), "white") == 0)
1347 return WHITE_PIX_DEFAULT (f
);
1349 if ((FRAME_W32_DISPLAY_INFO (f
)->n_planes
* FRAME_W32_DISPLAY_INFO (f
)->n_cbits
) == 1)
1352 /* w32_defined_color is responsible for coping with failures
1353 by looking for a near-miss. */
1354 if (w32_defined_color (f
, SDATA (arg
), &cdef
, 1))
1357 /* defined_color failed; return an ultimate default. */
1363 /* Functions called only from `x_set_frame_param'
1364 to set individual parameters.
1366 If FRAME_W32_WINDOW (f) is 0,
1367 the frame is being created and its window does not exist yet.
1368 In that case, just record the parameter's new value
1369 in the standard place; do not attempt to change the window. */
1372 x_set_foreground_color (f
, arg
, oldval
)
1374 Lisp_Object arg
, oldval
;
1376 struct w32_output
*x
= f
->output_data
.w32
;
1377 PIX_TYPE fg
, old_fg
;
1379 fg
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1380 old_fg
= FRAME_FOREGROUND_PIXEL (f
);
1381 FRAME_FOREGROUND_PIXEL (f
) = fg
;
1383 if (FRAME_W32_WINDOW (f
) != 0)
1385 if (x
->cursor_pixel
== old_fg
)
1386 x
->cursor_pixel
= fg
;
1388 update_face_from_frame_parameter (f
, Qforeground_color
, arg
);
1389 if (FRAME_VISIBLE_P (f
))
1395 x_set_background_color (f
, arg
, oldval
)
1397 Lisp_Object arg
, oldval
;
1399 FRAME_BACKGROUND_PIXEL (f
)
1400 = x_decode_color (f
, arg
, WHITE_PIX_DEFAULT (f
));
1402 if (FRAME_W32_WINDOW (f
) != 0)
1404 SetWindowLong (FRAME_W32_WINDOW (f
), WND_BACKGROUND_INDEX
,
1405 FRAME_BACKGROUND_PIXEL (f
));
1407 update_face_from_frame_parameter (f
, Qbackground_color
, arg
);
1409 if (FRAME_VISIBLE_P (f
))
1415 x_set_mouse_color (f
, arg
, oldval
)
1417 Lisp_Object arg
, oldval
;
1419 Cursor cursor
, nontext_cursor
, mode_cursor
, hand_cursor
;
1423 if (!EQ (Qnil
, arg
))
1424 f
->output_data
.w32
->mouse_pixel
1425 = x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1426 mask_color
= FRAME_BACKGROUND_PIXEL (f
);
1428 /* Don't let pointers be invisible. */
1429 if (mask_color
== f
->output_data
.w32
->mouse_pixel
1430 && mask_color
== FRAME_BACKGROUND_PIXEL (f
))
1431 f
->output_data
.w32
->mouse_pixel
= FRAME_FOREGROUND_PIXEL (f
);
1433 #if 0 /* TODO : cursor changes */
1436 /* It's not okay to crash if the user selects a screwy cursor. */
1437 count
= x_catch_errors (FRAME_W32_DISPLAY (f
));
1439 if (!EQ (Qnil
, Vx_pointer_shape
))
1441 CHECK_NUMBER (Vx_pointer_shape
);
1442 cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XINT (Vx_pointer_shape
));
1445 cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_xterm
);
1446 x_check_errors (FRAME_W32_DISPLAY (f
), "bad text pointer cursor: %s");
1448 if (!EQ (Qnil
, Vx_nontext_pointer_shape
))
1450 CHECK_NUMBER (Vx_nontext_pointer_shape
);
1451 nontext_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
),
1452 XINT (Vx_nontext_pointer_shape
));
1455 nontext_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_left_ptr
);
1456 x_check_errors (FRAME_W32_DISPLAY (f
), "bad nontext pointer cursor: %s");
1458 if (!EQ (Qnil
, Vx_hourglass_pointer_shape
))
1460 CHECK_NUMBER (Vx_hourglass_pointer_shape
);
1461 hourglass_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
),
1462 XINT (Vx_hourglass_pointer_shape
));
1465 hourglass_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_watch
);
1466 x_check_errors (FRAME_W32_DISPLAY (f
), "bad busy pointer cursor: %s");
1468 x_check_errors (FRAME_W32_DISPLAY (f
), "bad nontext pointer cursor: %s");
1469 if (!EQ (Qnil
, Vx_mode_pointer_shape
))
1471 CHECK_NUMBER (Vx_mode_pointer_shape
);
1472 mode_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
),
1473 XINT (Vx_mode_pointer_shape
));
1476 mode_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_xterm
);
1477 x_check_errors (FRAME_W32_DISPLAY (f
), "bad modeline pointer cursor: %s");
1479 if (!EQ (Qnil
, Vx_sensitive_text_pointer_shape
))
1481 CHECK_NUMBER (Vx_sensitive_text_pointer_shape
);
1483 = XCreateFontCursor (FRAME_W32_DISPLAY (f
),
1484 XINT (Vx_sensitive_text_pointer_shape
));
1487 hand_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_crosshair
);
1489 if (!NILP (Vx_window_horizontal_drag_shape
))
1491 CHECK_NUMBER (Vx_window_horizontal_drag_shape
);
1492 horizontal_drag_cursor
1493 = XCreateFontCursor (FRAME_X_DISPLAY (f
),
1494 XINT (Vx_window_horizontal_drag_shape
));
1497 horizontal_drag_cursor
1498 = XCreateFontCursor (FRAME_X_DISPLAY (f
), XC_sb_h_double_arrow
);
1500 /* Check and report errors with the above calls. */
1501 x_check_errors (FRAME_W32_DISPLAY (f
), "can't set cursor shape: %s");
1502 x_uncatch_errors (FRAME_W32_DISPLAY (f
), count
);
1505 XColor fore_color
, back_color
;
1507 fore_color
.pixel
= f
->output_data
.w32
->mouse_pixel
;
1508 back_color
.pixel
= mask_color
;
1509 XQueryColor (FRAME_W32_DISPLAY (f
),
1510 DefaultColormap (FRAME_W32_DISPLAY (f
),
1511 DefaultScreen (FRAME_W32_DISPLAY (f
))),
1513 XQueryColor (FRAME_W32_DISPLAY (f
),
1514 DefaultColormap (FRAME_W32_DISPLAY (f
),
1515 DefaultScreen (FRAME_W32_DISPLAY (f
))),
1517 XRecolorCursor (FRAME_W32_DISPLAY (f
), cursor
,
1518 &fore_color
, &back_color
);
1519 XRecolorCursor (FRAME_W32_DISPLAY (f
), nontext_cursor
,
1520 &fore_color
, &back_color
);
1521 XRecolorCursor (FRAME_W32_DISPLAY (f
), mode_cursor
,
1522 &fore_color
, &back_color
);
1523 XRecolorCursor (FRAME_W32_DISPLAY (f
), hand_cursor
,
1524 &fore_color
, &back_color
);
1525 XRecolorCursor (FRAME_W32_DISPLAY (f
), hourglass_cursor
,
1526 &fore_color
, &back_color
);
1529 if (FRAME_W32_WINDOW (f
) != 0)
1530 XDefineCursor (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
), cursor
);
1532 if (cursor
!= f
->output_data
.w32
->text_cursor
&& f
->output_data
.w32
->text_cursor
!= 0)
1533 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->text_cursor
);
1534 f
->output_data
.w32
->text_cursor
= cursor
;
1536 if (nontext_cursor
!= f
->output_data
.w32
->nontext_cursor
1537 && f
->output_data
.w32
->nontext_cursor
!= 0)
1538 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->nontext_cursor
);
1539 f
->output_data
.w32
->nontext_cursor
= nontext_cursor
;
1541 if (hourglass_cursor
!= f
->output_data
.w32
->hourglass_cursor
1542 && f
->output_data
.w32
->hourglass_cursor
!= 0)
1543 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->hourglass_cursor
);
1544 f
->output_data
.w32
->hourglass_cursor
= hourglass_cursor
;
1546 if (mode_cursor
!= f
->output_data
.w32
->modeline_cursor
1547 && f
->output_data
.w32
->modeline_cursor
!= 0)
1548 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->modeline_cursor
);
1549 f
->output_data
.w32
->modeline_cursor
= mode_cursor
;
1551 if (hand_cursor
!= f
->output_data
.w32
->hand_cursor
1552 && f
->output_data
.w32
->hand_cursor
!= 0)
1553 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->hand_cursor
);
1554 f
->output_data
.w32
->hand_cursor
= hand_cursor
;
1556 XFlush (FRAME_W32_DISPLAY (f
));
1559 update_face_from_frame_parameter (f
, Qmouse_color
, arg
);
1563 /* Defined in w32term.c. */
1565 x_set_cursor_color (f
, arg
, oldval
)
1567 Lisp_Object arg
, oldval
;
1569 unsigned long fore_pixel
, pixel
;
1571 if (!NILP (Vx_cursor_fore_pixel
))
1572 fore_pixel
= x_decode_color (f
, Vx_cursor_fore_pixel
,
1573 WHITE_PIX_DEFAULT (f
));
1575 fore_pixel
= FRAME_BACKGROUND_PIXEL (f
);
1577 pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1579 /* Make sure that the cursor color differs from the background color. */
1580 if (pixel
== FRAME_BACKGROUND_PIXEL (f
))
1582 pixel
= f
->output_data
.w32
->mouse_pixel
;
1583 if (pixel
== fore_pixel
)
1584 fore_pixel
= FRAME_BACKGROUND_PIXEL (f
);
1587 f
->output_data
.w32
->cursor_foreground_pixel
= fore_pixel
;
1588 f
->output_data
.w32
->cursor_pixel
= pixel
;
1590 if (FRAME_W32_WINDOW (f
) != 0)
1593 /* Update frame's cursor_gc. */
1594 f
->output_data
.w32
->cursor_gc
->foreground
= fore_pixel
;
1595 f
->output_data
.w32
->cursor_gc
->background
= pixel
;
1599 if (FRAME_VISIBLE_P (f
))
1601 x_update_cursor (f
, 0);
1602 x_update_cursor (f
, 1);
1606 update_face_from_frame_parameter (f
, Qcursor_color
, arg
);
1609 /* Set the border-color of frame F to pixel value PIX.
1610 Note that this does not fully take effect if done before
1614 x_set_border_pixel (f
, pix
)
1619 f
->output_data
.w32
->border_pixel
= pix
;
1621 if (FRAME_W32_WINDOW (f
) != 0 && f
->border_width
> 0)
1623 if (FRAME_VISIBLE_P (f
))
1628 /* Set the border-color of frame F to value described by ARG.
1629 ARG can be a string naming a color.
1630 The border-color is used for the border that is drawn by the server.
1631 Note that this does not fully take effect if done before
1632 F has a window; it must be redone when the window is created. */
1635 x_set_border_color (f
, arg
, oldval
)
1637 Lisp_Object arg
, oldval
;
1642 pix
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1643 x_set_border_pixel (f
, pix
);
1644 update_face_from_frame_parameter (f
, Qborder_color
, arg
);
1649 x_set_cursor_type (f
, arg
, oldval
)
1651 Lisp_Object arg
, oldval
;
1653 set_frame_cursor_types (f
, arg
);
1655 /* Make sure the cursor gets redrawn. */
1656 cursor_type_changed
= 1;
1660 x_set_icon_type (f
, arg
, oldval
)
1662 Lisp_Object arg
, oldval
;
1666 if (NILP (arg
) && NILP (oldval
))
1669 if (STRINGP (arg
) && STRINGP (oldval
)
1670 && EQ (Fstring_equal (oldval
, arg
), Qt
))
1673 if (SYMBOLP (arg
) && SYMBOLP (oldval
) && EQ (arg
, oldval
))
1678 result
= x_bitmap_icon (f
, arg
);
1682 error ("No icon window available");
1689 x_set_icon_name (f
, arg
, oldval
)
1691 Lisp_Object arg
, oldval
;
1695 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1698 else if (!NILP (arg
) || NILP (oldval
))
1704 if (f
->output_data
.w32
->icon_bitmap
!= 0)
1709 result
= x_text_icon (f
,
1710 (char *) SDATA ((!NILP (f
->icon_name
)
1719 error ("No icon window available");
1722 /* If the window was unmapped (and its icon was mapped),
1723 the new icon is not mapped, so map the window in its stead. */
1724 if (FRAME_VISIBLE_P (f
))
1726 #ifdef USE_X_TOOLKIT
1727 XtPopup (f
->output_data
.w32
->widget
, XtGrabNone
);
1729 XMapWindow (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
));
1732 XFlush (FRAME_W32_DISPLAY (f
));
1739 x_set_menu_bar_lines (f
, value
, oldval
)
1741 Lisp_Object value
, oldval
;
1744 int olines
= FRAME_MENU_BAR_LINES (f
);
1746 /* Right now, menu bars don't work properly in minibuf-only frames;
1747 most of the commands try to apply themselves to the minibuffer
1748 frame itself, and get an error because you can't switch buffers
1749 in or split the minibuffer window. */
1750 if (FRAME_MINIBUF_ONLY_P (f
))
1753 if (INTEGERP (value
))
1754 nlines
= XINT (value
);
1758 FRAME_MENU_BAR_LINES (f
) = 0;
1760 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
1763 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
1764 free_frame_menubar (f
);
1765 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
1767 /* Adjust the frame size so that the client (text) dimensions
1768 remain the same. This depends on FRAME_EXTERNAL_MENU_BAR being
1770 x_set_window_size (f
, 0, FRAME_COLS (f
), FRAME_LINES (f
));
1771 do_pending_window_change (0);
1777 /* Set the number of lines used for the tool bar of frame F to VALUE.
1778 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
1779 is the old number of tool bar lines. This function changes the
1780 height of all windows on frame F to match the new tool bar height.
1781 The frame's height doesn't change. */
1784 x_set_tool_bar_lines (f
, value
, oldval
)
1786 Lisp_Object value
, oldval
;
1788 int delta
, nlines
, root_height
;
1789 Lisp_Object root_window
;
1791 /* Treat tool bars like menu bars. */
1792 if (FRAME_MINIBUF_ONLY_P (f
))
1795 /* Use VALUE only if an integer >= 0. */
1796 if (INTEGERP (value
) && XINT (value
) >= 0)
1797 nlines
= XFASTINT (value
);
1801 /* Make sure we redisplay all windows in this frame. */
1802 ++windows_or_buffers_changed
;
1804 delta
= nlines
- FRAME_TOOL_BAR_LINES (f
);
1806 /* Don't resize the tool-bar to more than we have room for. */
1807 root_window
= FRAME_ROOT_WINDOW (f
);
1808 root_height
= WINDOW_TOTAL_LINES (XWINDOW (root_window
));
1809 if (root_height
- delta
< 1)
1811 delta
= root_height
- 1;
1812 nlines
= FRAME_TOOL_BAR_LINES (f
) + delta
;
1815 FRAME_TOOL_BAR_LINES (f
) = nlines
;
1816 change_window_heights (root_window
, delta
);
1819 /* We also have to make sure that the internal border at the top of
1820 the frame, below the menu bar or tool bar, is redrawn when the
1821 tool bar disappears. This is so because the internal border is
1822 below the tool bar if one is displayed, but is below the menu bar
1823 if there isn't a tool bar. The tool bar draws into the area
1824 below the menu bar. */
1825 if (FRAME_W32_WINDOW (f
) && FRAME_TOOL_BAR_LINES (f
) == 0)
1828 clear_current_matrices (f
);
1831 /* If the tool bar gets smaller, the internal border below it
1832 has to be cleared. It was formerly part of the display
1833 of the larger tool bar, and updating windows won't clear it. */
1836 int height
= FRAME_INTERNAL_BORDER_WIDTH (f
);
1837 int width
= FRAME_PIXEL_WIDTH (f
);
1838 int y
= nlines
* FRAME_LINE_HEIGHT (f
);
1842 HDC hdc
= get_frame_dc (f
);
1843 w32_clear_area (f
, hdc
, 0, y
, width
, height
);
1844 release_frame_dc (f
, hdc
);
1848 if (WINDOWP (f
->tool_bar_window
))
1849 clear_glyph_matrix (XWINDOW (f
->tool_bar_window
)->current_matrix
);
1854 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
1857 If EXPLICIT is non-zero, that indicates that lisp code is setting the
1858 name; if NAME is a string, set F's name to NAME and set
1859 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
1861 If EXPLICIT is zero, that indicates that Emacs redisplay code is
1862 suggesting a new name, which lisp code should override; if
1863 F->explicit_name is set, ignore the new name; otherwise, set it. */
1866 x_set_name (f
, name
, explicit)
1871 /* Make sure that requests from lisp code override requests from
1872 Emacs redisplay code. */
1875 /* If we're switching from explicit to implicit, we had better
1876 update the mode lines and thereby update the title. */
1877 if (f
->explicit_name
&& NILP (name
))
1878 update_mode_lines
= 1;
1880 f
->explicit_name
= ! NILP (name
);
1882 else if (f
->explicit_name
)
1885 /* If NAME is nil, set the name to the w32_id_name. */
1888 /* Check for no change needed in this very common case
1889 before we do any consing. */
1890 if (!strcmp (FRAME_W32_DISPLAY_INFO (f
)->w32_id_name
,
1893 name
= build_string (FRAME_W32_DISPLAY_INFO (f
)->w32_id_name
);
1896 CHECK_STRING (name
);
1898 /* Don't change the name if it's already NAME. */
1899 if (! NILP (Fstring_equal (name
, f
->name
)))
1904 /* For setting the frame title, the title parameter should override
1905 the name parameter. */
1906 if (! NILP (f
->title
))
1909 if (FRAME_W32_WINDOW (f
))
1911 if (STRING_MULTIBYTE (name
))
1912 name
= ENCODE_SYSTEM (name
);
1915 SetWindowText(FRAME_W32_WINDOW (f
), SDATA (name
));
1920 /* This function should be called when the user's lisp code has
1921 specified a name for the frame; the name will override any set by the
1924 x_explicitly_set_name (f
, arg
, oldval
)
1926 Lisp_Object arg
, oldval
;
1928 x_set_name (f
, arg
, 1);
1931 /* This function should be called by Emacs redisplay code to set the
1932 name; names set this way will never override names set by the user's
1935 x_implicitly_set_name (f
, arg
, oldval
)
1937 Lisp_Object arg
, oldval
;
1939 x_set_name (f
, arg
, 0);
1942 /* Change the title of frame F to NAME.
1943 If NAME is nil, use the frame name as the title. */
1946 x_set_title (f
, name
, old_name
)
1948 Lisp_Object name
, old_name
;
1950 /* Don't change the title if it's already NAME. */
1951 if (EQ (name
, f
->title
))
1954 update_mode_lines
= 1;
1961 if (FRAME_W32_WINDOW (f
))
1963 if (STRING_MULTIBYTE (name
))
1964 name
= ENCODE_SYSTEM (name
);
1967 SetWindowText(FRAME_W32_WINDOW (f
), SDATA (name
));
1973 void x_set_scroll_bar_default_width (f
)
1976 int wid
= FRAME_COLUMN_WIDTH (f
);
1978 FRAME_CONFIG_SCROLL_BAR_WIDTH (f
) = GetSystemMetrics (SM_CXVSCROLL
);
1979 FRAME_CONFIG_SCROLL_BAR_COLS (f
) = (FRAME_CONFIG_SCROLL_BAR_WIDTH (f
) +
1984 /* Subroutines of creating a frame. */
1987 /* Return the value of parameter PARAM.
1989 First search ALIST, then Vdefault_frame_alist, then the X defaults
1990 database, using ATTRIBUTE as the attribute name and CLASS as its class.
1992 Convert the resource to the type specified by desired_type.
1994 If no default is specified, return Qunbound. If you call
1995 w32_get_arg, make sure you deal with Qunbound in a reasonable way,
1996 and don't let it get stored in any Lisp-visible variables! */
1999 w32_get_arg (alist
, param
, attribute
, class, type
)
2000 Lisp_Object alist
, param
;
2003 enum resource_types type
;
2005 return x_get_arg (check_x_display_info (Qnil
),
2006 alist
, param
, attribute
, class, type
);
2011 w32_load_cursor (LPCTSTR name
)
2013 /* Try first to load cursor from application resource. */
2014 Cursor cursor
= LoadImage ((HINSTANCE
) GetModuleHandle(NULL
),
2015 name
, IMAGE_CURSOR
, 0, 0,
2016 LR_DEFAULTCOLOR
| LR_DEFAULTSIZE
| LR_SHARED
);
2019 /* Then try to load a shared predefined cursor. */
2020 cursor
= LoadImage (NULL
, name
, IMAGE_CURSOR
, 0, 0,
2021 LR_DEFAULTCOLOR
| LR_DEFAULTSIZE
| LR_SHARED
);
2026 extern LRESULT CALLBACK
w32_wnd_proc ();
2029 w32_init_class (hinst
)
2034 wc
.style
= CS_HREDRAW
| CS_VREDRAW
;
2035 wc
.lpfnWndProc
= (WNDPROC
) w32_wnd_proc
;
2037 wc
.cbWndExtra
= WND_EXTRA_BYTES
;
2038 wc
.hInstance
= hinst
;
2039 wc
.hIcon
= LoadIcon (hinst
, EMACS_CLASS
);
2040 wc
.hCursor
= w32_load_cursor (IDC_ARROW
);
2041 wc
.hbrBackground
= NULL
; /* GetStockObject (WHITE_BRUSH); */
2042 wc
.lpszMenuName
= NULL
;
2043 wc
.lpszClassName
= EMACS_CLASS
;
2045 return (RegisterClass (&wc
));
2049 w32_createscrollbar (f
, bar
)
2051 struct scroll_bar
* bar
;
2053 return (CreateWindow ("SCROLLBAR", "", SBS_VERT
| WS_CHILD
| WS_VISIBLE
,
2054 /* Position and size of scroll bar. */
2055 XINT(bar
->left
) + VERTICAL_SCROLL_BAR_WIDTH_TRIM
,
2057 XINT(bar
->width
) - VERTICAL_SCROLL_BAR_WIDTH_TRIM
* 2,
2059 FRAME_W32_WINDOW (f
),
2066 w32_createwindow (f
)
2071 Lisp_Object top
= Qunbound
;
2072 Lisp_Object left
= Qunbound
;
2074 rect
.left
= rect
.top
= 0;
2075 rect
.right
= FRAME_PIXEL_WIDTH (f
);
2076 rect
.bottom
= FRAME_PIXEL_HEIGHT (f
);
2078 AdjustWindowRect (&rect
, f
->output_data
.w32
->dwStyle
,
2079 FRAME_EXTERNAL_MENU_BAR (f
));
2081 /* Do first time app init */
2085 w32_init_class (hinst
);
2088 if (f
->size_hint_flags
& USPosition
|| f
->size_hint_flags
& PPosition
)
2090 XSETINT (left
, f
->left_pos
);
2091 XSETINT (top
, f
->top_pos
);
2093 else if (EQ (left
, Qunbound
) && EQ (top
, Qunbound
))
2095 /* When called with RES_TYPE_NUMBER, w32_get_arg will return zero
2096 for anything that is not a number and is not Qunbound. */
2097 left
= w32_get_arg (Qnil
, Qleft
, "left", "Left", RES_TYPE_NUMBER
);
2098 top
= w32_get_arg (Qnil
, Qtop
, "top", "Top", RES_TYPE_NUMBER
);
2101 FRAME_W32_WINDOW (f
) = hwnd
2102 = CreateWindow (EMACS_CLASS
,
2104 f
->output_data
.w32
->dwStyle
| WS_CLIPCHILDREN
,
2105 EQ (left
, Qunbound
) ? CW_USEDEFAULT
: XINT (left
),
2106 EQ (top
, Qunbound
) ? CW_USEDEFAULT
: XINT (top
),
2107 rect
.right
- rect
.left
,
2108 rect
.bottom
- rect
.top
,
2116 SetWindowLong (hwnd
, WND_FONTWIDTH_INDEX
, FRAME_COLUMN_WIDTH (f
));
2117 SetWindowLong (hwnd
, WND_LINEHEIGHT_INDEX
, FRAME_LINE_HEIGHT (f
));
2118 SetWindowLong (hwnd
, WND_BORDER_INDEX
, FRAME_INTERNAL_BORDER_WIDTH (f
));
2119 SetWindowLong (hwnd
, WND_SCROLLBAR_INDEX
, f
->scroll_bar_actual_width
);
2120 SetWindowLong (hwnd
, WND_BACKGROUND_INDEX
, FRAME_BACKGROUND_PIXEL (f
));
2122 /* Enable drag-n-drop. */
2123 DragAcceptFiles (hwnd
, TRUE
);
2125 /* Do this to discard the default setting specified by our parent. */
2126 ShowWindow (hwnd
, SW_HIDE
);
2128 /* Update frame positions. */
2129 GetWindowRect (hwnd
, &rect
);
2130 f
->left_pos
= rect
.left
;
2131 f
->top_pos
= rect
.top
;
2136 my_post_msg (wmsg
, hwnd
, msg
, wParam
, lParam
)
2143 wmsg
->msg
.hwnd
= hwnd
;
2144 wmsg
->msg
.message
= msg
;
2145 wmsg
->msg
.wParam
= wParam
;
2146 wmsg
->msg
.lParam
= lParam
;
2147 wmsg
->msg
.time
= GetMessageTime ();
2152 /* GetKeyState and MapVirtualKey on Windows 95 do not actually distinguish
2153 between left and right keys as advertised. We test for this
2154 support dynamically, and set a flag when the support is absent. If
2155 absent, we keep track of the left and right control and alt keys
2156 ourselves. This is particularly necessary on keyboards that rely
2157 upon the AltGr key, which is represented as having the left control
2158 and right alt keys pressed. For these keyboards, we need to know
2159 when the left alt key has been pressed in addition to the AltGr key
2160 so that we can properly support M-AltGr-key sequences (such as M-@
2161 on Swedish keyboards). */
2163 #define EMACS_LCONTROL 0
2164 #define EMACS_RCONTROL 1
2165 #define EMACS_LMENU 2
2166 #define EMACS_RMENU 3
2168 static int modifiers
[4];
2169 static int modifiers_recorded
;
2170 static int modifier_key_support_tested
;
2173 test_modifier_support (unsigned int wparam
)
2177 if (wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
)
2179 if (wparam
== VK_CONTROL
)
2189 if (!(GetKeyState (l
) & 0x8000) && !(GetKeyState (r
) & 0x8000))
2190 modifiers_recorded
= 1;
2192 modifiers_recorded
= 0;
2193 modifier_key_support_tested
= 1;
2197 record_keydown (unsigned int wparam
, unsigned int lparam
)
2201 if (!modifier_key_support_tested
)
2202 test_modifier_support (wparam
);
2204 if ((wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
) || !modifiers_recorded
)
2207 if (wparam
== VK_CONTROL
)
2208 i
= (lparam
& 0x1000000) ? EMACS_RCONTROL
: EMACS_LCONTROL
;
2210 i
= (lparam
& 0x1000000) ? EMACS_RMENU
: EMACS_LMENU
;
2216 record_keyup (unsigned int wparam
, unsigned int lparam
)
2220 if ((wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
) || !modifiers_recorded
)
2223 if (wparam
== VK_CONTROL
)
2224 i
= (lparam
& 0x1000000) ? EMACS_RCONTROL
: EMACS_LCONTROL
;
2226 i
= (lparam
& 0x1000000) ? EMACS_RMENU
: EMACS_LMENU
;
2231 /* Emacs can lose focus while a modifier key has been pressed. When
2232 it regains focus, be conservative and clear all modifiers since
2233 we cannot reconstruct the left and right modifier state. */
2239 if (GetFocus () == NULL
)
2240 /* Emacs doesn't have keyboard focus. Do nothing. */
2243 ctrl
= GetAsyncKeyState (VK_CONTROL
);
2244 alt
= GetAsyncKeyState (VK_MENU
);
2246 if (!(ctrl
& 0x08000))
2247 /* Clear any recorded control modifier state. */
2248 modifiers
[EMACS_RCONTROL
] = modifiers
[EMACS_LCONTROL
] = 0;
2250 if (!(alt
& 0x08000))
2251 /* Clear any recorded alt modifier state. */
2252 modifiers
[EMACS_RMENU
] = modifiers
[EMACS_LMENU
] = 0;
2254 /* Update the state of all modifier keys, because modifiers used in
2255 hot-key combinations can get stuck on if Emacs loses focus as a
2256 result of a hot-key being pressed. */
2260 #define CURRENT_STATE(key) ((GetAsyncKeyState (key) & 0x8000) >> 8)
2262 GetKeyboardState (keystate
);
2263 keystate
[VK_SHIFT
] = CURRENT_STATE (VK_SHIFT
);
2264 keystate
[VK_CONTROL
] = CURRENT_STATE (VK_CONTROL
);
2265 keystate
[VK_LCONTROL
] = CURRENT_STATE (VK_LCONTROL
);
2266 keystate
[VK_RCONTROL
] = CURRENT_STATE (VK_RCONTROL
);
2267 keystate
[VK_MENU
] = CURRENT_STATE (VK_MENU
);
2268 keystate
[VK_LMENU
] = CURRENT_STATE (VK_LMENU
);
2269 keystate
[VK_RMENU
] = CURRENT_STATE (VK_RMENU
);
2270 keystate
[VK_LWIN
] = CURRENT_STATE (VK_LWIN
);
2271 keystate
[VK_RWIN
] = CURRENT_STATE (VK_RWIN
);
2272 keystate
[VK_APPS
] = CURRENT_STATE (VK_APPS
);
2273 SetKeyboardState (keystate
);
2277 /* Synchronize modifier state with what is reported with the current
2278 keystroke. Even if we cannot distinguish between left and right
2279 modifier keys, we know that, if no modifiers are set, then neither
2280 the left or right modifier should be set. */
2284 if (!modifiers_recorded
)
2287 if (!(GetKeyState (VK_CONTROL
) & 0x8000))
2288 modifiers
[EMACS_RCONTROL
] = modifiers
[EMACS_LCONTROL
] = 0;
2290 if (!(GetKeyState (VK_MENU
) & 0x8000))
2291 modifiers
[EMACS_RMENU
] = modifiers
[EMACS_LMENU
] = 0;
2295 modifier_set (int vkey
)
2297 if (vkey
== VK_CAPITAL
|| vkey
== VK_SCROLL
)
2298 return (GetKeyState (vkey
) & 0x1);
2299 if (!modifiers_recorded
)
2300 return (GetKeyState (vkey
) & 0x8000);
2305 return modifiers
[EMACS_LCONTROL
];
2307 return modifiers
[EMACS_RCONTROL
];
2309 return modifiers
[EMACS_LMENU
];
2311 return modifiers
[EMACS_RMENU
];
2313 return (GetKeyState (vkey
) & 0x8000);
2316 /* Convert between the modifier bits W32 uses and the modifier bits
2320 w32_key_to_modifier (int key
)
2322 Lisp_Object key_mapping
;
2327 key_mapping
= Vw32_lwindow_modifier
;
2330 key_mapping
= Vw32_rwindow_modifier
;
2333 key_mapping
= Vw32_apps_modifier
;
2336 key_mapping
= Vw32_scroll_lock_modifier
;
2342 /* NB. This code runs in the input thread, asychronously to the lisp
2343 thread, so we must be careful to ensure access to lisp data is
2344 thread-safe. The following code is safe because the modifier
2345 variable values are updated atomically from lisp and symbols are
2346 not relocated by GC. Also, we don't have to worry about seeing GC
2348 if (EQ (key_mapping
, Qhyper
))
2349 return hyper_modifier
;
2350 if (EQ (key_mapping
, Qsuper
))
2351 return super_modifier
;
2352 if (EQ (key_mapping
, Qmeta
))
2353 return meta_modifier
;
2354 if (EQ (key_mapping
, Qalt
))
2355 return alt_modifier
;
2356 if (EQ (key_mapping
, Qctrl
))
2357 return ctrl_modifier
;
2358 if (EQ (key_mapping
, Qcontrol
)) /* synonym for ctrl */
2359 return ctrl_modifier
;
2360 if (EQ (key_mapping
, Qshift
))
2361 return shift_modifier
;
2363 /* Don't generate any modifier if not explicitly requested. */
2368 w32_get_modifiers ()
2370 return ((modifier_set (VK_SHIFT
) ? shift_modifier
: 0) |
2371 (modifier_set (VK_CONTROL
) ? ctrl_modifier
: 0) |
2372 (modifier_set (VK_LWIN
) ? w32_key_to_modifier (VK_LWIN
) : 0) |
2373 (modifier_set (VK_RWIN
) ? w32_key_to_modifier (VK_RWIN
) : 0) |
2374 (modifier_set (VK_APPS
) ? w32_key_to_modifier (VK_APPS
) : 0) |
2375 (modifier_set (VK_SCROLL
) ? w32_key_to_modifier (VK_SCROLL
) : 0) |
2376 (modifier_set (VK_MENU
) ?
2377 ((NILP (Vw32_alt_is_meta
)) ? alt_modifier
: meta_modifier
) : 0));
2380 /* We map the VK_* modifiers into console modifier constants
2381 so that we can use the same routines to handle both console
2382 and window input. */
2385 construct_console_modifiers ()
2390 mods
|= (modifier_set (VK_SHIFT
)) ? SHIFT_PRESSED
: 0;
2391 mods
|= (modifier_set (VK_CAPITAL
)) ? CAPSLOCK_ON
: 0;
2392 mods
|= (modifier_set (VK_SCROLL
)) ? SCROLLLOCK_ON
: 0;
2393 mods
|= (modifier_set (VK_NUMLOCK
)) ? NUMLOCK_ON
: 0;
2394 mods
|= (modifier_set (VK_LCONTROL
)) ? LEFT_CTRL_PRESSED
: 0;
2395 mods
|= (modifier_set (VK_RCONTROL
)) ? RIGHT_CTRL_PRESSED
: 0;
2396 mods
|= (modifier_set (VK_LMENU
)) ? LEFT_ALT_PRESSED
: 0;
2397 mods
|= (modifier_set (VK_RMENU
)) ? RIGHT_ALT_PRESSED
: 0;
2398 mods
|= (modifier_set (VK_LWIN
)) ? LEFT_WIN_PRESSED
: 0;
2399 mods
|= (modifier_set (VK_RWIN
)) ? RIGHT_WIN_PRESSED
: 0;
2400 mods
|= (modifier_set (VK_APPS
)) ? APPS_PRESSED
: 0;
2406 w32_get_key_modifiers (unsigned int wparam
, unsigned int lparam
)
2410 /* Convert to emacs modifiers. */
2411 mods
= w32_kbd_mods_to_emacs (construct_console_modifiers (), wparam
);
2417 map_keypad_keys (unsigned int virt_key
, unsigned int extended
)
2419 if (virt_key
< VK_CLEAR
|| virt_key
> VK_DELETE
)
2422 if (virt_key
== VK_RETURN
)
2423 return (extended
? VK_NUMPAD_ENTER
: VK_RETURN
);
2425 if (virt_key
>= VK_PRIOR
&& virt_key
<= VK_DOWN
)
2426 return (!extended
? (VK_NUMPAD_PRIOR
+ (virt_key
- VK_PRIOR
)) : virt_key
);
2428 if (virt_key
== VK_INSERT
|| virt_key
== VK_DELETE
)
2429 return (!extended
? (VK_NUMPAD_INSERT
+ (virt_key
- VK_INSERT
)) : virt_key
);
2431 if (virt_key
== VK_CLEAR
)
2432 return (!extended
? VK_NUMPAD_CLEAR
: virt_key
);
2437 /* List of special key combinations which w32 would normally capture,
2438 but emacs should grab instead. Not directly visible to lisp, to
2439 simplify synchronization. Each item is an integer encoding a virtual
2440 key code and modifier combination to capture. */
2441 Lisp_Object w32_grabbed_keys
;
2443 #define HOTKEY(vk,mods) make_number (((vk) & 255) | ((mods) << 8))
2444 #define HOTKEY_ID(k) (XFASTINT (k) & 0xbfff)
2445 #define HOTKEY_VK_CODE(k) (XFASTINT (k) & 255)
2446 #define HOTKEY_MODIFIERS(k) (XFASTINT (k) >> 8)
2448 #define RAW_HOTKEY_ID(k) ((k) & 0xbfff)
2449 #define RAW_HOTKEY_VK_CODE(k) ((k) & 255)
2450 #define RAW_HOTKEY_MODIFIERS(k) ((k) >> 8)
2452 /* Register hot-keys for reserved key combinations when Emacs has
2453 keyboard focus, since this is the only way Emacs can receive key
2454 combinations like Alt-Tab which are used by the system. */
2457 register_hot_keys (hwnd
)
2460 Lisp_Object keylist
;
2462 /* Use CONSP, since we are called asynchronously. */
2463 for (keylist
= w32_grabbed_keys
; CONSP (keylist
); keylist
= XCDR (keylist
))
2465 Lisp_Object key
= XCAR (keylist
);
2467 /* Deleted entries get set to nil. */
2468 if (!INTEGERP (key
))
2471 RegisterHotKey (hwnd
, HOTKEY_ID (key
),
2472 HOTKEY_MODIFIERS (key
), HOTKEY_VK_CODE (key
));
2477 unregister_hot_keys (hwnd
)
2480 Lisp_Object keylist
;
2482 for (keylist
= w32_grabbed_keys
; CONSP (keylist
); keylist
= XCDR (keylist
))
2484 Lisp_Object key
= XCAR (keylist
);
2486 if (!INTEGERP (key
))
2489 UnregisterHotKey (hwnd
, HOTKEY_ID (key
));
2493 /* Main message dispatch loop. */
2496 w32_msg_pump (deferred_msg
* msg_buf
)
2502 msh_mousewheel
= RegisterWindowMessage (MSH_MOUSEWHEEL
);
2504 while (GetMessage (&msg
, NULL
, 0, 0))
2506 if (msg
.hwnd
== NULL
)
2508 switch (msg
.message
)
2511 /* Produced by complete_deferred_msg; just ignore. */
2513 case WM_EMACS_CREATEWINDOW
:
2514 /* Initialize COM for this window. Even though we don't use it,
2515 some third party shell extensions can cause it to be used in
2516 system dialogs, which causes a crash if it is not initialized.
2517 This is a known bug in Windows, which was fixed long ago, but
2518 the patch for XP is not publically available until XP SP3,
2519 and older versions will never be patched. */
2520 CoInitialize (NULL
);
2521 w32_createwindow ((struct frame
*) msg
.wParam
);
2522 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
, 0, 0))
2525 case WM_EMACS_SETLOCALE
:
2526 SetThreadLocale (msg
.wParam
);
2527 /* Reply is not expected. */
2529 case WM_EMACS_SETKEYBOARDLAYOUT
:
2530 result
= (int) ActivateKeyboardLayout ((HKL
) msg
.wParam
, 0);
2531 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
,
2535 case WM_EMACS_REGISTER_HOT_KEY
:
2536 focus_window
= GetFocus ();
2537 if (focus_window
!= NULL
)
2538 RegisterHotKey (focus_window
,
2539 RAW_HOTKEY_ID (msg
.wParam
),
2540 RAW_HOTKEY_MODIFIERS (msg
.wParam
),
2541 RAW_HOTKEY_VK_CODE (msg
.wParam
));
2542 /* Reply is not expected. */
2544 case WM_EMACS_UNREGISTER_HOT_KEY
:
2545 focus_window
= GetFocus ();
2546 if (focus_window
!= NULL
)
2547 UnregisterHotKey (focus_window
, RAW_HOTKEY_ID (msg
.wParam
));
2548 /* Mark item as erased. NB: this code must be
2549 thread-safe. The next line is okay because the cons
2550 cell is never made into garbage and is not relocated by
2552 XSETCAR ((Lisp_Object
) ((EMACS_INT
) msg
.lParam
), Qnil
);
2553 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
, 0, 0))
2556 case WM_EMACS_TOGGLE_LOCK_KEY
:
2558 int vk_code
= (int) msg
.wParam
;
2559 int cur_state
= (GetKeyState (vk_code
) & 1);
2560 Lisp_Object new_state
= (Lisp_Object
) ((EMACS_INT
) msg
.lParam
);
2562 /* NB: This code must be thread-safe. It is safe to
2563 call NILP because symbols are not relocated by GC,
2564 and pointer here is not touched by GC (so the markbit
2565 can't be set). Numbers are safe because they are
2566 immediate values. */
2567 if (NILP (new_state
)
2568 || (NUMBERP (new_state
)
2569 && ((XUINT (new_state
)) & 1) != cur_state
))
2571 one_w32_display_info
.faked_key
= vk_code
;
2573 keybd_event ((BYTE
) vk_code
,
2574 (BYTE
) MapVirtualKey (vk_code
, 0),
2575 KEYEVENTF_EXTENDEDKEY
| KEYEVENTF_KEYUP
, 0);
2576 keybd_event ((BYTE
) vk_code
,
2577 (BYTE
) MapVirtualKey (vk_code
, 0),
2578 KEYEVENTF_EXTENDEDKEY
| 0, 0);
2579 keybd_event ((BYTE
) vk_code
,
2580 (BYTE
) MapVirtualKey (vk_code
, 0),
2581 KEYEVENTF_EXTENDEDKEY
| KEYEVENTF_KEYUP
, 0);
2582 cur_state
= !cur_state
;
2584 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
,
2590 DebPrint (("msg %x not expected by w32_msg_pump\n", msg
.message
));
2595 DispatchMessage (&msg
);
2598 /* Exit nested loop when our deferred message has completed. */
2599 if (msg_buf
->completed
)
2604 deferred_msg
* deferred_msg_head
;
2606 static deferred_msg
*
2607 find_deferred_msg (HWND hwnd
, UINT msg
)
2609 deferred_msg
* item
;
2611 /* Don't actually need synchronization for read access, since
2612 modification of single pointer is always atomic. */
2613 /* enter_crit (); */
2615 for (item
= deferred_msg_head
; item
!= NULL
; item
= item
->next
)
2616 if (item
->w32msg
.msg
.hwnd
== hwnd
2617 && item
->w32msg
.msg
.message
== msg
)
2620 /* leave_crit (); */
2626 send_deferred_msg (deferred_msg
* msg_buf
,
2632 /* Only input thread can send deferred messages. */
2633 if (GetCurrentThreadId () != dwWindowsThreadId
)
2636 /* It is an error to send a message that is already deferred. */
2637 if (find_deferred_msg (hwnd
, msg
) != NULL
)
2640 /* Enforced synchronization is not needed because this is the only
2641 function that alters deferred_msg_head, and the following critical
2642 section is guaranteed to only be serially reentered (since only the
2643 input thread can call us). */
2645 /* enter_crit (); */
2647 msg_buf
->completed
= 0;
2648 msg_buf
->next
= deferred_msg_head
;
2649 deferred_msg_head
= msg_buf
;
2650 my_post_msg (&msg_buf
->w32msg
, hwnd
, msg
, wParam
, lParam
);
2652 /* leave_crit (); */
2654 /* Start a new nested message loop to process other messages until
2655 this one is completed. */
2656 w32_msg_pump (msg_buf
);
2658 deferred_msg_head
= msg_buf
->next
;
2660 return msg_buf
->result
;
2664 complete_deferred_msg (HWND hwnd
, UINT msg
, LRESULT result
)
2666 deferred_msg
* msg_buf
= find_deferred_msg (hwnd
, msg
);
2668 if (msg_buf
== NULL
)
2669 /* Message may have been cancelled, so don't abort(). */
2672 msg_buf
->result
= result
;
2673 msg_buf
->completed
= 1;
2675 /* Ensure input thread is woken so it notices the completion. */
2676 PostThreadMessage (dwWindowsThreadId
, WM_NULL
, 0, 0);
2680 cancel_all_deferred_msgs ()
2682 deferred_msg
* item
;
2684 /* Don't actually need synchronization for read access, since
2685 modification of single pointer is always atomic. */
2686 /* enter_crit (); */
2688 for (item
= deferred_msg_head
; item
!= NULL
; item
= item
->next
)
2691 item
->completed
= 1;
2694 /* leave_crit (); */
2696 /* Ensure input thread is woken so it notices the completion. */
2697 PostThreadMessage (dwWindowsThreadId
, WM_NULL
, 0, 0);
2701 w32_msg_worker (void *arg
)
2704 deferred_msg dummy_buf
;
2706 /* Ensure our message queue is created */
2708 PeekMessage (&msg
, NULL
, 0, 0, PM_NOREMOVE
);
2710 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
, 0, 0))
2713 memset (&dummy_buf
, 0, sizeof (dummy_buf
));
2714 dummy_buf
.w32msg
.msg
.hwnd
= NULL
;
2715 dummy_buf
.w32msg
.msg
.message
= WM_NULL
;
2717 /* This is the inital message loop which should only exit when the
2718 application quits. */
2719 w32_msg_pump (&dummy_buf
);
2725 signal_user_input ()
2727 /* Interrupt any lisp that wants to be interrupted by input. */
2728 if (!NILP (Vthrow_on_input
))
2730 Vquit_flag
= Vthrow_on_input
;
2731 /* If we're inside a function that wants immediate quits,
2733 if (immediate_quit
&& NILP (Vinhibit_quit
))
2743 post_character_message (hwnd
, msg
, wParam
, lParam
, modifiers
)
2753 wmsg
.dwModifiers
= modifiers
;
2755 /* Detect quit_char and set quit-flag directly. Note that we
2756 still need to post a message to ensure the main thread will be
2757 woken up if blocked in sys_select(), but we do NOT want to post
2758 the quit_char message itself (because it will usually be as if
2759 the user had typed quit_char twice). Instead, we post a dummy
2760 message that has no particular effect. */
2763 if (isalpha (c
) && wmsg
.dwModifiers
== ctrl_modifier
)
2764 c
= make_ctrl_char (c
) & 0377;
2766 || (wmsg
.dwModifiers
== 0 &&
2767 w32_quit_key
&& wParam
== w32_quit_key
))
2771 /* The choice of message is somewhat arbitrary, as long as
2772 the main thread handler just ignores it. */
2775 /* Interrupt any blocking system calls. */
2778 /* As a safety precaution, forcibly complete any deferred
2779 messages. This is a kludge, but I don't see any particularly
2780 clean way to handle the situation where a deferred message is
2781 "dropped" in the lisp thread, and will thus never be
2782 completed, eg. by the user trying to activate the menubar
2783 when the lisp thread is busy, and then typing C-g when the
2784 menubar doesn't open promptly (with the result that the
2785 menubar never responds at all because the deferred
2786 WM_INITMENU message is never completed). Another problem
2787 situation is when the lisp thread calls SendMessage (to send
2788 a window manager command) when a message has been deferred;
2789 the lisp thread gets blocked indefinitely waiting for the
2790 deferred message to be completed, which itself is waiting for
2791 the lisp thread to respond.
2793 Note that we don't want to block the input thread waiting for
2794 a reponse from the lisp thread (although that would at least
2795 solve the deadlock problem above), because we want to be able
2796 to receive C-g to interrupt the lisp thread. */
2797 cancel_all_deferred_msgs ();
2800 signal_user_input ();
2803 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
2806 /* Main window procedure */
2809 w32_wnd_proc (hwnd
, msg
, wParam
, lParam
)
2816 struct w32_display_info
*dpyinfo
= &one_w32_display_info
;
2818 int windows_translate
;
2821 /* Note that it is okay to call x_window_to_frame, even though we are
2822 not running in the main lisp thread, because frame deletion
2823 requires the lisp thread to synchronize with this thread. Thus, if
2824 a frame struct is returned, it can be used without concern that the
2825 lisp thread might make it disappear while we are using it.
2827 NB. Walking the frame list in this thread is safe (as long as
2828 writes of Lisp_Object slots are atomic, which they are on Windows).
2829 Although delete-frame can destructively modify the frame list while
2830 we are walking it, a garbage collection cannot occur until after
2831 delete-frame has synchronized with this thread.
2833 It is also safe to use functions that make GDI calls, such as
2834 w32_clear_rect, because these functions must obtain a DC handle
2835 from the frame struct using get_frame_dc which is thread-aware. */
2840 f
= x_window_to_frame (dpyinfo
, hwnd
);
2843 HDC hdc
= get_frame_dc (f
);
2844 GetUpdateRect (hwnd
, &wmsg
.rect
, FALSE
);
2845 w32_clear_rect (f
, hdc
, &wmsg
.rect
);
2846 release_frame_dc (f
, hdc
);
2848 #if defined (W32_DEBUG_DISPLAY)
2849 DebPrint (("WM_ERASEBKGND (frame %p): erasing %d,%d-%d,%d\n",
2851 wmsg
.rect
.left
, wmsg
.rect
.top
,
2852 wmsg
.rect
.right
, wmsg
.rect
.bottom
));
2853 #endif /* W32_DEBUG_DISPLAY */
2856 case WM_PALETTECHANGED
:
2857 /* ignore our own changes */
2858 if ((HWND
)wParam
!= hwnd
)
2860 f
= x_window_to_frame (dpyinfo
, hwnd
);
2862 /* get_frame_dc will realize our palette and force all
2863 frames to be redrawn if needed. */
2864 release_frame_dc (f
, get_frame_dc (f
));
2869 PAINTSTRUCT paintStruct
;
2871 bzero (&update_rect
, sizeof (update_rect
));
2873 f
= x_window_to_frame (dpyinfo
, hwnd
);
2876 DebPrint (("WM_PAINT received for unknown window %p\n", hwnd
));
2880 /* MSDN Docs say not to call BeginPaint if GetUpdateRect
2881 fails. Apparently this can happen under some
2883 if (GetUpdateRect (hwnd
, &update_rect
, FALSE
) || !w32_strict_painting
)
2886 BeginPaint (hwnd
, &paintStruct
);
2888 /* The rectangles returned by GetUpdateRect and BeginPaint
2889 do not always match. Play it safe by assuming both areas
2891 UnionRect (&(wmsg
.rect
), &update_rect
, &(paintStruct
.rcPaint
));
2893 #if defined (W32_DEBUG_DISPLAY)
2894 DebPrint (("WM_PAINT (frame %p): painting %d,%d-%d,%d\n",
2896 wmsg
.rect
.left
, wmsg
.rect
.top
,
2897 wmsg
.rect
.right
, wmsg
.rect
.bottom
));
2898 DebPrint ((" [update region is %d,%d-%d,%d]\n",
2899 update_rect
.left
, update_rect
.top
,
2900 update_rect
.right
, update_rect
.bottom
));
2902 EndPaint (hwnd
, &paintStruct
);
2905 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
2910 /* If GetUpdateRect returns 0 (meaning there is no update
2911 region), assume the whole window needs to be repainted. */
2912 GetClientRect(hwnd
, &wmsg
.rect
);
2913 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
2917 case WM_INPUTLANGCHANGE
:
2918 /* Inform lisp thread of keyboard layout changes. */
2919 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
2921 /* Clear dead keys in the keyboard state; for simplicity only
2922 preserve modifier key states. */
2927 GetKeyboardState (keystate
);
2928 for (i
= 0; i
< 256; i
++)
2945 SetKeyboardState (keystate
);
2950 /* Synchronize hot keys with normal input. */
2951 PostMessage (hwnd
, WM_KEYDOWN
, HIWORD (lParam
), 0);
2956 record_keyup (wParam
, lParam
);
2961 /* Ignore keystrokes we fake ourself; see below. */
2962 if (dpyinfo
->faked_key
== wParam
)
2964 dpyinfo
->faked_key
= 0;
2965 /* Make sure TranslateMessage sees them though (as long as
2966 they don't produce WM_CHAR messages). This ensures that
2967 indicator lights are toggled promptly on Windows 9x, for
2969 if (lispy_function_keys
[wParam
] != 0)
2971 windows_translate
= 1;
2977 /* Synchronize modifiers with current keystroke. */
2979 record_keydown (wParam
, lParam
);
2980 wParam
= map_keypad_keys (wParam
, (lParam
& 0x1000000L
) != 0);
2982 windows_translate
= 0;
2987 if (NILP (Vw32_pass_lwindow_to_system
))
2989 /* Prevent system from acting on keyup (which opens the
2990 Start menu if no other key was pressed) by simulating a
2991 press of Space which we will ignore. */
2992 if (GetAsyncKeyState (wParam
) & 1)
2994 if (NUMBERP (Vw32_phantom_key_code
))
2995 key
= XUINT (Vw32_phantom_key_code
) & 255;
2998 dpyinfo
->faked_key
= key
;
2999 keybd_event (key
, (BYTE
) MapVirtualKey (key
, 0), 0, 0);
3002 if (!NILP (Vw32_lwindow_modifier
))
3006 if (NILP (Vw32_pass_rwindow_to_system
))
3008 if (GetAsyncKeyState (wParam
) & 1)
3010 if (NUMBERP (Vw32_phantom_key_code
))
3011 key
= XUINT (Vw32_phantom_key_code
) & 255;
3014 dpyinfo
->faked_key
= key
;
3015 keybd_event (key
, (BYTE
) MapVirtualKey (key
, 0), 0, 0);
3018 if (!NILP (Vw32_rwindow_modifier
))
3022 if (!NILP (Vw32_apps_modifier
))
3026 if (NILP (Vw32_pass_alt_to_system
))
3027 /* Prevent DefWindowProc from activating the menu bar if an
3028 Alt key is pressed and released by itself. */
3030 windows_translate
= 1;
3033 /* Decide whether to treat as modifier or function key. */
3034 if (NILP (Vw32_enable_caps_lock
))
3035 goto disable_lock_key
;
3036 windows_translate
= 1;
3039 /* Decide whether to treat as modifier or function key. */
3040 if (NILP (Vw32_enable_num_lock
))
3041 goto disable_lock_key
;
3042 windows_translate
= 1;
3045 /* Decide whether to treat as modifier or function key. */
3046 if (NILP (Vw32_scroll_lock_modifier
))
3047 goto disable_lock_key
;
3048 windows_translate
= 1;
3051 /* Ensure the appropriate lock key state (and indicator light)
3052 remains in the same state. We do this by faking another
3053 press of the relevant key. Apparently, this really is the
3054 only way to toggle the state of the indicator lights. */
3055 dpyinfo
->faked_key
= wParam
;
3056 keybd_event ((BYTE
) wParam
, (BYTE
) MapVirtualKey (wParam
, 0),
3057 KEYEVENTF_EXTENDEDKEY
| KEYEVENTF_KEYUP
, 0);
3058 keybd_event ((BYTE
) wParam
, (BYTE
) MapVirtualKey (wParam
, 0),
3059 KEYEVENTF_EXTENDEDKEY
| 0, 0);
3060 keybd_event ((BYTE
) wParam
, (BYTE
) MapVirtualKey (wParam
, 0),
3061 KEYEVENTF_EXTENDEDKEY
| KEYEVENTF_KEYUP
, 0);
3062 /* Ensure indicator lights are updated promptly on Windows 9x
3063 (TranslateMessage apparently does this), after forwarding
3065 post_character_message (hwnd
, msg
, wParam
, lParam
,
3066 w32_get_key_modifiers (wParam
, lParam
));
3067 windows_translate
= 1;
3071 case VK_PROCESSKEY
: /* Generated by IME. */
3072 windows_translate
= 1;
3075 /* Windows maps Ctrl-Pause (aka Ctrl-Break) into VK_CANCEL,
3076 which is confusing for purposes of key binding; convert
3077 VK_CANCEL events into VK_PAUSE events. */
3081 /* Windows maps Ctrl-NumLock into VK_PAUSE, which is confusing
3082 for purposes of key binding; convert these back into
3083 VK_NUMLOCK events, at least when we want to see NumLock key
3084 presses. (Note that there is never any possibility that
3085 VK_PAUSE with Ctrl really is C-Pause as per above.) */
3086 if (NILP (Vw32_enable_num_lock
) && modifier_set (VK_CONTROL
))
3087 wParam
= VK_NUMLOCK
;
3090 /* If not defined as a function key, change it to a WM_CHAR message. */
3091 if (lispy_function_keys
[wParam
] == 0)
3093 DWORD modifiers
= construct_console_modifiers ();
3095 if (!NILP (Vw32_recognize_altgr
)
3096 && modifier_set (VK_LCONTROL
) && modifier_set (VK_RMENU
))
3098 /* Always let TranslateMessage handle AltGr key chords;
3099 for some reason, ToAscii doesn't always process AltGr
3100 chords correctly. */
3101 windows_translate
= 1;
3103 else if ((modifiers
& (~SHIFT_PRESSED
& ~CAPSLOCK_ON
)) != 0)
3105 /* Handle key chords including any modifiers other
3106 than shift directly, in order to preserve as much
3107 modifier information as possible. */
3108 if ('A' <= wParam
&& wParam
<= 'Z')
3110 /* Don't translate modified alphabetic keystrokes,
3111 so the user doesn't need to constantly switch
3112 layout to type control or meta keystrokes when
3113 the normal layout translates alphabetic
3114 characters to non-ascii characters. */
3115 if (!modifier_set (VK_SHIFT
))
3116 wParam
+= ('a' - 'A');
3121 /* Try to handle other keystrokes by determining the
3122 base character (ie. translating the base key plus
3126 KEY_EVENT_RECORD key
;
3128 key
.bKeyDown
= TRUE
;
3129 key
.wRepeatCount
= 1;
3130 key
.wVirtualKeyCode
= wParam
;
3131 key
.wVirtualScanCode
= (lParam
& 0xFF0000) >> 16;
3132 key
.uChar
.AsciiChar
= 0;
3133 key
.dwControlKeyState
= modifiers
;
3135 add
= w32_kbd_patch_key (&key
);
3136 /* 0 means an unrecognised keycode, negative means
3137 dead key. Ignore both. */
3140 /* Forward asciified character sequence. */
3141 post_character_message
3142 (hwnd
, WM_CHAR
, key
.uChar
.AsciiChar
, lParam
,
3143 w32_get_key_modifiers (wParam
, lParam
));
3144 w32_kbd_patch_key (&key
);
3151 /* Let TranslateMessage handle everything else. */
3152 windows_translate
= 1;
3158 if (windows_translate
)
3160 MSG windows_msg
= { hwnd
, msg
, wParam
, lParam
, 0, {0,0} };
3162 windows_msg
.time
= GetMessageTime ();
3163 TranslateMessage (&windows_msg
);
3171 post_character_message (hwnd
, msg
, wParam
, lParam
,
3172 w32_get_key_modifiers (wParam
, lParam
));
3175 /* Simulate middle mouse button events when left and right buttons
3176 are used together, but only if user has two button mouse. */
3177 case WM_LBUTTONDOWN
:
3178 case WM_RBUTTONDOWN
:
3179 if (w32_num_mouse_buttons
> 2)
3180 goto handle_plain_button
;
3183 int this = (msg
== WM_LBUTTONDOWN
) ? LMOUSE
: RMOUSE
;
3184 int other
= (msg
== WM_LBUTTONDOWN
) ? RMOUSE
: LMOUSE
;
3186 if (button_state
& this)
3189 if (button_state
== 0)
3192 button_state
|= this;
3194 if (button_state
& other
)
3196 if (mouse_button_timer
)
3198 KillTimer (hwnd
, mouse_button_timer
);
3199 mouse_button_timer
= 0;
3201 /* Generate middle mouse event instead. */
3202 msg
= WM_MBUTTONDOWN
;
3203 button_state
|= MMOUSE
;
3205 else if (button_state
& MMOUSE
)
3207 /* Ignore button event if we've already generated a
3208 middle mouse down event. This happens if the
3209 user releases and press one of the two buttons
3210 after we've faked a middle mouse event. */
3215 /* Flush out saved message. */
3216 post_msg (&saved_mouse_button_msg
);
3218 wmsg
.dwModifiers
= w32_get_modifiers ();
3219 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3220 signal_user_input ();
3222 /* Clear message buffer. */
3223 saved_mouse_button_msg
.msg
.hwnd
= 0;
3227 /* Hold onto message for now. */
3228 mouse_button_timer
=
3229 SetTimer (hwnd
, MOUSE_BUTTON_ID
,
3230 w32_mouse_button_tolerance
, NULL
);
3231 saved_mouse_button_msg
.msg
.hwnd
= hwnd
;
3232 saved_mouse_button_msg
.msg
.message
= msg
;
3233 saved_mouse_button_msg
.msg
.wParam
= wParam
;
3234 saved_mouse_button_msg
.msg
.lParam
= lParam
;
3235 saved_mouse_button_msg
.msg
.time
= GetMessageTime ();
3236 saved_mouse_button_msg
.dwModifiers
= w32_get_modifiers ();
3243 if (w32_num_mouse_buttons
> 2)
3244 goto handle_plain_button
;
3247 int this = (msg
== WM_LBUTTONUP
) ? LMOUSE
: RMOUSE
;
3248 int other
= (msg
== WM_LBUTTONUP
) ? RMOUSE
: LMOUSE
;
3250 if ((button_state
& this) == 0)
3253 button_state
&= ~this;
3255 if (button_state
& MMOUSE
)
3257 /* Only generate event when second button is released. */
3258 if ((button_state
& other
) == 0)
3261 button_state
&= ~MMOUSE
;
3263 if (button_state
) abort ();
3270 /* Flush out saved message if necessary. */
3271 if (saved_mouse_button_msg
.msg
.hwnd
)
3273 post_msg (&saved_mouse_button_msg
);
3276 wmsg
.dwModifiers
= w32_get_modifiers ();
3277 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3278 signal_user_input ();
3280 /* Always clear message buffer and cancel timer. */
3281 saved_mouse_button_msg
.msg
.hwnd
= 0;
3282 KillTimer (hwnd
, mouse_button_timer
);
3283 mouse_button_timer
= 0;
3285 if (button_state
== 0)
3290 case WM_XBUTTONDOWN
:
3292 if (w32_pass_extra_mouse_buttons_to_system
)
3294 /* else fall through and process them. */
3295 case WM_MBUTTONDOWN
:
3297 handle_plain_button
:
3302 /* Ignore middle and extra buttons as long as the menu is active. */
3303 f
= x_window_to_frame (dpyinfo
, hwnd
);
3304 if (f
&& f
->output_data
.w32
->menubar_active
)
3307 if (parse_button (msg
, HIWORD (wParam
), &button
, &up
))
3309 if (up
) ReleaseCapture ();
3310 else SetCapture (hwnd
);
3311 button
= (button
== 0) ? LMOUSE
:
3312 ((button
== 1) ? MMOUSE
: RMOUSE
);
3314 button_state
&= ~button
;
3316 button_state
|= button
;
3320 wmsg
.dwModifiers
= w32_get_modifiers ();
3321 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3322 signal_user_input ();
3324 /* Need to return true for XBUTTON messages, false for others,
3325 to indicate that we processed the message. */
3326 return (msg
== WM_XBUTTONDOWN
|| msg
== WM_XBUTTONUP
);
3329 /* Ignore mouse movements as long as the menu is active. These
3330 movements are processed by the window manager anyway, and
3331 it's wrong to handle them as if they happened on the
3332 underlying frame. */
3333 f
= x_window_to_frame (dpyinfo
, hwnd
);
3334 if (f
&& f
->output_data
.w32
->menubar_active
)
3337 /* If the mouse has just moved into the frame, start tracking
3338 it, so we will be notified when it leaves the frame. Mouse
3339 tracking only works under W98 and NT4 and later. On earlier
3340 versions, there is no way of telling when the mouse leaves the
3341 frame, so we just have to put up with help-echo and mouse
3342 highlighting remaining while the frame is not active. */
3343 if (track_mouse_event_fn
&& !track_mouse_window
)
3345 TRACKMOUSEEVENT tme
;
3346 tme
.cbSize
= sizeof (tme
);
3347 tme
.dwFlags
= TME_LEAVE
;
3348 tme
.hwndTrack
= hwnd
;
3350 track_mouse_event_fn (&tme
);
3351 track_mouse_window
= hwnd
;
3354 if (w32_mouse_move_interval
<= 0
3355 || (msg
== WM_MOUSEMOVE
&& button_state
== 0))
3357 wmsg
.dwModifiers
= w32_get_modifiers ();
3358 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3362 /* Hang onto mouse move and scroll messages for a bit, to avoid
3363 sending such events to Emacs faster than it can process them.
3364 If we get more events before the timer from the first message
3365 expires, we just replace the first message. */
3367 if (saved_mouse_move_msg
.msg
.hwnd
== 0)
3369 SetTimer (hwnd
, MOUSE_MOVE_ID
,
3370 w32_mouse_move_interval
, NULL
);
3372 /* Hold onto message for now. */
3373 saved_mouse_move_msg
.msg
.hwnd
= hwnd
;
3374 saved_mouse_move_msg
.msg
.message
= msg
;
3375 saved_mouse_move_msg
.msg
.wParam
= wParam
;
3376 saved_mouse_move_msg
.msg
.lParam
= lParam
;
3377 saved_mouse_move_msg
.msg
.time
= GetMessageTime ();
3378 saved_mouse_move_msg
.dwModifiers
= w32_get_modifiers ();
3384 wmsg
.dwModifiers
= w32_get_modifiers ();
3385 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3386 signal_user_input ();
3389 case WM_MOUSEHWHEEL
:
3390 wmsg
.dwModifiers
= w32_get_modifiers ();
3391 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3392 signal_user_input ();
3393 /* Non-zero must be returned when WM_MOUSEHWHEEL messages are
3394 handled, to prevent the system trying to handle it by faking
3395 scroll bar events. */
3399 /* Flush out saved messages if necessary. */
3400 if (wParam
== mouse_button_timer
)
3402 if (saved_mouse_button_msg
.msg
.hwnd
)
3404 post_msg (&saved_mouse_button_msg
);
3405 signal_user_input ();
3406 saved_mouse_button_msg
.msg
.hwnd
= 0;
3408 KillTimer (hwnd
, mouse_button_timer
);
3409 mouse_button_timer
= 0;
3411 else if (wParam
== mouse_move_timer
)
3413 if (saved_mouse_move_msg
.msg
.hwnd
)
3415 post_msg (&saved_mouse_move_msg
);
3416 saved_mouse_move_msg
.msg
.hwnd
= 0;
3418 KillTimer (hwnd
, mouse_move_timer
);
3419 mouse_move_timer
= 0;
3421 else if (wParam
== menu_free_timer
)
3423 KillTimer (hwnd
, menu_free_timer
);
3424 menu_free_timer
= 0;
3425 f
= x_window_to_frame (dpyinfo
, hwnd
);
3426 /* If a popup menu is active, don't wipe its strings. */
3428 && current_popup_menu
== NULL
)
3430 /* Free memory used by owner-drawn and help-echo strings. */
3431 w32_free_menu_strings (hwnd
);
3432 f
->output_data
.w32
->menubar_active
= 0;
3439 /* Windows doesn't send us focus messages when putting up and
3440 taking down a system popup dialog as for Ctrl-Alt-Del on Windows 95.
3441 The only indication we get that something happened is receiving
3442 this message afterwards. So this is a good time to reset our
3443 keyboard modifiers' state. */
3450 /* We must ensure menu bar is fully constructed and up to date
3451 before allowing user interaction with it. To achieve this
3452 we send this message to the lisp thread and wait for a
3453 reply (whose value is not actually needed) to indicate that
3454 the menu bar is now ready for use, so we can now return.
3456 To remain responsive in the meantime, we enter a nested message
3457 loop that can process all other messages.
3459 However, we skip all this if the message results from calling
3460 TrackPopupMenu - in fact, we must NOT attempt to send the lisp
3461 thread a message because it is blocked on us at this point. We
3462 set menubar_active before calling TrackPopupMenu to indicate
3463 this (there is no possibility of confusion with real menubar
3466 f
= x_window_to_frame (dpyinfo
, hwnd
);
3468 && (f
->output_data
.w32
->menubar_active
3469 /* We can receive this message even in the absence of a
3470 menubar (ie. when the system menu is activated) - in this
3471 case we do NOT want to forward the message, otherwise it
3472 will cause the menubar to suddenly appear when the user
3473 had requested it to be turned off! */
3474 || f
->output_data
.w32
->menubar_widget
== NULL
))
3478 deferred_msg msg_buf
;
3480 /* Detect if message has already been deferred; in this case
3481 we cannot return any sensible value to ignore this. */
3482 if (find_deferred_msg (hwnd
, msg
) != NULL
)
3487 return send_deferred_msg (&msg_buf
, hwnd
, msg
, wParam
, lParam
);
3490 case WM_EXITMENULOOP
:
3491 f
= x_window_to_frame (dpyinfo
, hwnd
);
3493 /* If a menu is still active, check again after a short delay,
3494 since Windows often (always?) sends the WM_EXITMENULOOP
3495 before the corresponding WM_COMMAND message.
3496 Don't do this if a popup menu is active, since it is only
3497 menubar menus that require cleaning up in this way.
3499 if (f
&& menubar_in_use
&& current_popup_menu
== NULL
)
3500 menu_free_timer
= SetTimer (hwnd
, MENU_FREE_ID
, MENU_FREE_DELAY
, NULL
);
3504 /* Direct handling of help_echo in menus. Should be safe now
3505 that we generate the help_echo by placing a help event in the
3508 HMENU menu
= (HMENU
) lParam
;
3509 UINT menu_item
= (UINT
) LOWORD (wParam
);
3510 UINT flags
= (UINT
) HIWORD (wParam
);
3512 w32_menu_display_help (hwnd
, menu
, menu_item
, flags
);
3516 case WM_MEASUREITEM
:
3517 f
= x_window_to_frame (dpyinfo
, hwnd
);
3520 MEASUREITEMSTRUCT
* pMis
= (MEASUREITEMSTRUCT
*) lParam
;
3522 if (pMis
->CtlType
== ODT_MENU
)
3524 /* Work out dimensions for popup menu titles. */
3525 char * title
= (char *) pMis
->itemData
;
3526 HDC hdc
= GetDC (hwnd
);
3527 HFONT menu_font
= GetCurrentObject (hdc
, OBJ_FONT
);
3528 LOGFONT menu_logfont
;
3532 GetObject (menu_font
, sizeof (menu_logfont
), &menu_logfont
);
3533 menu_logfont
.lfWeight
= FW_BOLD
;
3534 menu_font
= CreateFontIndirect (&menu_logfont
);
3535 old_font
= SelectObject (hdc
, menu_font
);
3537 pMis
->itemHeight
= GetSystemMetrics (SM_CYMENUSIZE
);
3540 if (unicode_append_menu
)
3541 GetTextExtentPoint32W (hdc
, (WCHAR
*) title
,
3542 wcslen ((WCHAR
*) title
),
3545 GetTextExtentPoint32 (hdc
, title
, strlen (title
), &size
);
3547 pMis
->itemWidth
= size
.cx
;
3548 if (pMis
->itemHeight
< size
.cy
)
3549 pMis
->itemHeight
= size
.cy
;
3552 pMis
->itemWidth
= 0;
3554 SelectObject (hdc
, old_font
);
3555 DeleteObject (menu_font
);
3556 ReleaseDC (hwnd
, hdc
);
3563 f
= x_window_to_frame (dpyinfo
, hwnd
);
3566 DRAWITEMSTRUCT
* pDis
= (DRAWITEMSTRUCT
*) lParam
;
3568 if (pDis
->CtlType
== ODT_MENU
)
3570 /* Draw popup menu title. */
3571 char * title
= (char *) pDis
->itemData
;
3574 HDC hdc
= pDis
->hDC
;
3575 HFONT menu_font
= GetCurrentObject (hdc
, OBJ_FONT
);
3576 LOGFONT menu_logfont
;
3579 GetObject (menu_font
, sizeof (menu_logfont
), &menu_logfont
);
3580 menu_logfont
.lfWeight
= FW_BOLD
;
3581 menu_font
= CreateFontIndirect (&menu_logfont
);
3582 old_font
= SelectObject (hdc
, menu_font
);
3584 /* Always draw title as if not selected. */
3585 if (unicode_append_menu
)
3588 + GetSystemMetrics (SM_CXMENUCHECK
),
3590 ETO_OPAQUE
, &pDis
->rcItem
,
3592 wcslen ((WCHAR
*) title
), NULL
);
3596 + GetSystemMetrics (SM_CXMENUCHECK
),
3598 ETO_OPAQUE
, &pDis
->rcItem
,
3599 title
, strlen (title
), NULL
);
3601 SelectObject (hdc
, old_font
);
3602 DeleteObject (menu_font
);
3610 /* Still not right - can't distinguish between clicks in the
3611 client area of the frame from clicks forwarded from the scroll
3612 bars - may have to hook WM_NCHITTEST to remember the mouse
3613 position and then check if it is in the client area ourselves. */
3614 case WM_MOUSEACTIVATE
:
3615 /* Discard the mouse click that activates a frame, allowing the
3616 user to click anywhere without changing point (or worse!).
3617 Don't eat mouse clicks on scrollbars though!! */
3618 if (LOWORD (lParam
) == HTCLIENT
)
3619 return MA_ACTIVATEANDEAT
;
3624 /* No longer tracking mouse. */
3625 track_mouse_window
= NULL
;
3627 case WM_ACTIVATEAPP
:
3629 case WM_WINDOWPOSCHANGED
:
3631 /* Inform lisp thread that a frame might have just been obscured
3632 or exposed, so should recheck visibility of all frames. */
3633 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3637 dpyinfo
->faked_key
= 0;
3639 register_hot_keys (hwnd
);
3642 unregister_hot_keys (hwnd
);
3645 /* Relinquish the system caret. */
3646 if (w32_system_caret_hwnd
)
3648 w32_visible_system_caret_hwnd
= NULL
;
3649 w32_system_caret_hwnd
= NULL
;
3655 f
= x_window_to_frame (dpyinfo
, hwnd
);
3656 if (f
&& HIWORD (wParam
) == 0)
3658 if (menu_free_timer
)
3660 KillTimer (hwnd
, menu_free_timer
);
3661 menu_free_timer
= 0;
3667 wmsg
.dwModifiers
= w32_get_modifiers ();
3668 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3676 wmsg
.dwModifiers
= w32_get_modifiers ();
3677 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3680 case WM_WINDOWPOSCHANGING
:
3681 /* Don't restrict the sizing of tip frames. */
3682 if (hwnd
== tip_window
)
3686 LPWINDOWPOS lppos
= (WINDOWPOS
*) lParam
;
3688 wp
.length
= sizeof (WINDOWPLACEMENT
);
3689 GetWindowPlacement (hwnd
, &wp
);
3691 if (wp
.showCmd
!= SW_SHOWMINIMIZED
&& (lppos
->flags
& SWP_NOSIZE
) == 0)
3698 DWORD internal_border
;
3699 DWORD scrollbar_extra
;
3702 wp
.length
= sizeof(wp
);
3703 GetWindowRect (hwnd
, &wr
);
3707 font_width
= GetWindowLong (hwnd
, WND_FONTWIDTH_INDEX
);
3708 line_height
= GetWindowLong (hwnd
, WND_LINEHEIGHT_INDEX
);
3709 internal_border
= GetWindowLong (hwnd
, WND_BORDER_INDEX
);
3710 scrollbar_extra
= GetWindowLong (hwnd
, WND_SCROLLBAR_INDEX
);
3714 memset (&rect
, 0, sizeof (rect
));
3715 AdjustWindowRect (&rect
, GetWindowLong (hwnd
, GWL_STYLE
),
3716 GetMenu (hwnd
) != NULL
);
3718 /* Force width and height of client area to be exact
3719 multiples of the character cell dimensions. */
3720 wdiff
= (lppos
->cx
- (rect
.right
- rect
.left
)
3721 - 2 * internal_border
- scrollbar_extra
)
3723 hdiff
= (lppos
->cy
- (rect
.bottom
- rect
.top
)
3724 - 2 * internal_border
)
3729 /* For right/bottom sizing we can just fix the sizes.
3730 However for top/left sizing we will need to fix the X
3731 and Y positions as well. */
3733 int cx_mintrack
= GetSystemMetrics (SM_CXMINTRACK
);
3734 int cy_mintrack
= GetSystemMetrics (SM_CYMINTRACK
);
3736 lppos
->cx
= max (lppos
->cx
- wdiff
, cx_mintrack
);
3737 lppos
->cy
= max (lppos
->cy
- hdiff
, cy_mintrack
);
3739 if (wp
.showCmd
!= SW_SHOWMAXIMIZED
3740 && (lppos
->flags
& SWP_NOMOVE
) == 0)
3742 if (lppos
->x
!= wr
.left
|| lppos
->y
!= wr
.top
)
3749 lppos
->flags
|= SWP_NOMOVE
;
3760 case WM_GETMINMAXINFO
:
3761 /* Hack to allow resizing the Emacs frame above the screen size.
3762 Note that Windows 9x limits coordinates to 16-bits. */
3763 ((LPMINMAXINFO
) lParam
)->ptMaxTrackSize
.x
= 32767;
3764 ((LPMINMAXINFO
) lParam
)->ptMaxTrackSize
.y
= 32767;
3768 if (LOWORD (lParam
) == HTCLIENT
)
3773 case WM_EMACS_SETCURSOR
:
3775 Cursor cursor
= (Cursor
) wParam
;
3781 case WM_EMACS_CREATESCROLLBAR
:
3782 return (LRESULT
) w32_createscrollbar ((struct frame
*) wParam
,
3783 (struct scroll_bar
*) lParam
);
3785 case WM_EMACS_SHOWWINDOW
:
3786 return ShowWindow ((HWND
) wParam
, (WPARAM
) lParam
);
3788 case WM_EMACS_SETFOREGROUND
:
3790 HWND foreground_window
;
3791 DWORD foreground_thread
, retval
;
3793 /* On NT 5.0, and apparently Windows 98, it is necessary to
3794 attach to the thread that currently has focus in order to
3795 pull the focus away from it. */
3796 foreground_window
= GetForegroundWindow ();
3797 foreground_thread
= GetWindowThreadProcessId (foreground_window
, NULL
);
3798 if (!foreground_window
3799 || foreground_thread
== GetCurrentThreadId ()
3800 || !AttachThreadInput (GetCurrentThreadId (),
3801 foreground_thread
, TRUE
))
3802 foreground_thread
= 0;
3804 retval
= SetForegroundWindow ((HWND
) wParam
);
3806 /* Detach from the previous foreground thread. */
3807 if (foreground_thread
)
3808 AttachThreadInput (GetCurrentThreadId (),
3809 foreground_thread
, FALSE
);
3814 case WM_EMACS_SETWINDOWPOS
:
3816 WINDOWPOS
* pos
= (WINDOWPOS
*) wParam
;
3817 return SetWindowPos (hwnd
, pos
->hwndInsertAfter
,
3818 pos
->x
, pos
->y
, pos
->cx
, pos
->cy
, pos
->flags
);
3821 case WM_EMACS_DESTROYWINDOW
:
3822 DragAcceptFiles ((HWND
) wParam
, FALSE
);
3823 return DestroyWindow ((HWND
) wParam
);
3825 case WM_EMACS_HIDE_CARET
:
3826 return HideCaret (hwnd
);
3828 case WM_EMACS_SHOW_CARET
:
3829 return ShowCaret (hwnd
);
3831 case WM_EMACS_DESTROY_CARET
:
3832 w32_system_caret_hwnd
= NULL
;
3833 w32_visible_system_caret_hwnd
= NULL
;
3834 return DestroyCaret ();
3836 case WM_EMACS_TRACK_CARET
:
3837 /* If there is currently no system caret, create one. */
3838 if (w32_system_caret_hwnd
== NULL
)
3840 /* Use the default caret width, and avoid changing it
3841 unneccesarily, as it confuses screen reader software. */
3842 w32_system_caret_hwnd
= hwnd
;
3843 CreateCaret (hwnd
, NULL
, 0,
3844 w32_system_caret_height
);
3847 if (!SetCaretPos (w32_system_caret_x
, w32_system_caret_y
))
3849 /* Ensure visible caret gets turned on when requested. */
3850 else if (w32_use_visible_system_caret
3851 && w32_visible_system_caret_hwnd
!= hwnd
)
3853 w32_visible_system_caret_hwnd
= hwnd
;
3854 return ShowCaret (hwnd
);
3856 /* Ensure visible caret gets turned off when requested. */
3857 else if (!w32_use_visible_system_caret
3858 && w32_visible_system_caret_hwnd
)
3860 w32_visible_system_caret_hwnd
= NULL
;
3861 return HideCaret (hwnd
);
3866 case WM_EMACS_TRACKPOPUPMENU
:
3871 pos
= (POINT
*)lParam
;
3872 flags
= TPM_CENTERALIGN
;
3873 if (button_state
& LMOUSE
)
3874 flags
|= TPM_LEFTBUTTON
;
3875 else if (button_state
& RMOUSE
)
3876 flags
|= TPM_RIGHTBUTTON
;
3878 /* Remember we did a SetCapture on the initial mouse down event,
3879 so for safety, we make sure the capture is cancelled now. */
3883 /* Use menubar_active to indicate that WM_INITMENU is from
3884 TrackPopupMenu below, and should be ignored. */
3885 f
= x_window_to_frame (dpyinfo
, hwnd
);
3887 f
->output_data
.w32
->menubar_active
= 1;
3889 if (TrackPopupMenu ((HMENU
)wParam
, flags
, pos
->x
, pos
->y
,
3893 /* Eat any mouse messages during popupmenu */
3894 while (PeekMessage (&amsg
, hwnd
, WM_MOUSEFIRST
, WM_MOUSELAST
,
3896 /* Get the menu selection, if any */
3897 if (PeekMessage (&amsg
, hwnd
, WM_COMMAND
, WM_COMMAND
, PM_REMOVE
))
3899 retval
= LOWORD (amsg
.wParam
);
3915 /* Check for messages registered at runtime. */
3916 if (msg
== msh_mousewheel
)
3918 wmsg
.dwModifiers
= w32_get_modifiers ();
3919 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3920 signal_user_input ();
3925 return DefWindowProc (hwnd
, msg
, wParam
, lParam
);
3929 /* The most common default return code for handled messages is 0. */
3934 my_create_window (f
)
3939 if (!PostThreadMessage (dwWindowsThreadId
, WM_EMACS_CREATEWINDOW
, (WPARAM
)f
, 0))
3941 GetMessage (&msg
, NULL
, WM_EMACS_DONE
, WM_EMACS_DONE
);
3945 /* Create a tooltip window. Unlike my_create_window, we do not do this
3946 indirectly via the Window thread, as we do not need to process Window
3947 messages for the tooltip. Creating tooltips indirectly also creates
3948 deadlocks when tooltips are created for menu items. */
3950 my_create_tip_window (f
)
3955 rect
.left
= rect
.top
= 0;
3956 rect
.right
= FRAME_PIXEL_WIDTH (f
);
3957 rect
.bottom
= FRAME_PIXEL_HEIGHT (f
);
3959 AdjustWindowRect (&rect
, f
->output_data
.w32
->dwStyle
,
3960 FRAME_EXTERNAL_MENU_BAR (f
));
3962 tip_window
= FRAME_W32_WINDOW (f
)
3963 = CreateWindow (EMACS_CLASS
,
3965 f
->output_data
.w32
->dwStyle
,
3968 rect
.right
- rect
.left
,
3969 rect
.bottom
- rect
.top
,
3970 FRAME_W32_WINDOW (SELECTED_FRAME ()), /* owner */
3977 SetWindowLong (tip_window
, WND_FONTWIDTH_INDEX
, FRAME_COLUMN_WIDTH (f
));
3978 SetWindowLong (tip_window
, WND_LINEHEIGHT_INDEX
, FRAME_LINE_HEIGHT (f
));
3979 SetWindowLong (tip_window
, WND_BORDER_INDEX
, FRAME_INTERNAL_BORDER_WIDTH (f
));
3980 SetWindowLong (tip_window
, WND_BACKGROUND_INDEX
, FRAME_BACKGROUND_PIXEL (f
));
3982 /* Tip frames have no scrollbars. */
3983 SetWindowLong (tip_window
, WND_SCROLLBAR_INDEX
, 0);
3985 /* Do this to discard the default setting specified by our parent. */
3986 ShowWindow (tip_window
, SW_HIDE
);
3991 /* Create and set up the w32 window for frame F. */
3994 w32_window (f
, window_prompting
, minibuffer_only
)
3996 long window_prompting
;
3997 int minibuffer_only
;
4001 /* Use the resource name as the top-level window name
4002 for looking up resources. Make a non-Lisp copy
4003 for the window manager, so GC relocation won't bother it.
4005 Elsewhere we specify the window name for the window manager. */
4008 char *str
= (char *) SDATA (Vx_resource_name
);
4009 f
->namebuf
= (char *) xmalloc (strlen (str
) + 1);
4010 strcpy (f
->namebuf
, str
);
4013 my_create_window (f
);
4015 validate_x_resource_name ();
4017 /* x_set_name normally ignores requests to set the name if the
4018 requested name is the same as the current name. This is the one
4019 place where that assumption isn't correct; f->name is set, but
4020 the server hasn't been told. */
4023 int explicit = f
->explicit_name
;
4025 f
->explicit_name
= 0;
4028 x_set_name (f
, name
, explicit);
4033 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
4034 initialize_frame_menubar (f
);
4036 if (FRAME_W32_WINDOW (f
) == 0)
4037 error ("Unable to create window");
4040 /* Handle the icon stuff for this window. Perhaps later we might
4041 want an x_set_icon_position which can be called interactively as
4049 Lisp_Object icon_x
, icon_y
;
4051 /* Set the position of the icon. Note that Windows 95 groups all
4052 icons in the tray. */
4053 icon_x
= w32_get_arg (parms
, Qicon_left
, 0, 0, RES_TYPE_NUMBER
);
4054 icon_y
= w32_get_arg (parms
, Qicon_top
, 0, 0, RES_TYPE_NUMBER
);
4055 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
4057 CHECK_NUMBER (icon_x
);
4058 CHECK_NUMBER (icon_y
);
4060 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
4061 error ("Both left and top icon corners of icon must be specified");
4065 if (! EQ (icon_x
, Qunbound
))
4066 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
4069 /* Start up iconic or window? */
4070 x_wm_set_window_state
4071 (f
, (EQ (w32_get_arg (parms
, Qvisibility
, 0, 0, RES_TYPE_SYMBOL
), Qicon
)
4075 x_text_icon (f
, (char *) SDATA ((!NILP (f
->icon_name
)
4088 XGCValues gc_values
;
4092 /* Create the GC's of this frame.
4093 Note that many default values are used. */
4096 gc_values
.font
= FRAME_FONT (f
);
4098 /* Cursor has cursor-color background, background-color foreground. */
4099 gc_values
.foreground
= FRAME_BACKGROUND_PIXEL (f
);
4100 gc_values
.background
= f
->output_data
.w32
->cursor_pixel
;
4101 f
->output_data
.w32
->cursor_gc
4102 = XCreateGC (NULL
, FRAME_W32_WINDOW (f
),
4103 (GCFont
| GCForeground
| GCBackground
),
4107 f
->output_data
.w32
->white_relief
.gc
= 0;
4108 f
->output_data
.w32
->black_relief
.gc
= 0;
4114 /* Handler for signals raised during x_create_frame and
4115 x_create_top_frame. FRAME is the frame which is partially
4119 unwind_create_frame (frame
)
4122 struct frame
*f
= XFRAME (frame
);
4124 /* If frame is ``official'', nothing to do. */
4125 if (!CONSP (Vframe_list
) || !EQ (XCAR (Vframe_list
), frame
))
4128 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
4131 x_free_frame_resources (f
);
4133 /* Check that reference counts are indeed correct. */
4134 xassert (dpyinfo
->reference_count
== dpyinfo_refcount
);
4135 xassert (dpyinfo
->image_cache
->refcount
== image_cache_refcount
);
4143 #ifdef USE_FONT_BACKEND
4145 x_default_font_parameter (f
, parms
)
4149 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
4150 Lisp_Object font
= x_get_arg (dpyinfo
, parms
, Qfont
, "font", "Font",
4153 if (!STRINGP (font
))
4156 static char *names
[]
4157 = { "Courier New-10",
4158 "-*-Courier-normal-r-*-*-13-*-*-*-c-*-iso8859-1",
4159 "-*-Fixedsys-normal-r-*-*-12-*-*-*-c-*-iso8859-1",
4163 for (i
= 0; names
[i
]; i
++)
4165 font
= font_open_by_name (f
, names
[i
]);
4170 error ("No suitable font was found");
4172 x_default_parameter (f
, parms
, Qfont
, font
, "font", "Font", RES_TYPE_STRING
);
4176 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
4178 doc
: /* Make a new window, which is called a \"frame\" in Emacs terms.
4179 Returns an Emacs frame object.
4180 PARAMETERS is an alist of frame parameters.
4181 If the parameters specify that the frame should not have a minibuffer,
4182 and do not specify a specific minibuffer window to use,
4183 then `default-minibuffer-frame' must be a frame whose minibuffer can
4184 be shared by the new frame.
4186 This function is an internal primitive--use `make-frame' instead. */)
4188 Lisp_Object parameters
;
4191 Lisp_Object frame
, tem
;
4193 int minibuffer_only
= 0;
4194 long window_prompting
= 0;
4196 int count
= SPECPDL_INDEX ();
4197 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
4198 Lisp_Object display
;
4199 struct w32_display_info
*dpyinfo
= NULL
;
4205 /* Use this general default value to start with
4206 until we know if this frame has a specified name. */
4207 Vx_resource_name
= Vinvocation_name
;
4209 display
= w32_get_arg (parameters
, Qdisplay
, 0, 0, RES_TYPE_STRING
);
4210 if (EQ (display
, Qunbound
))
4212 dpyinfo
= check_x_display_info (display
);
4214 kb
= dpyinfo
->terminal
->kboard
;
4216 kb
= &the_only_kboard
;
4219 name
= w32_get_arg (parameters
, Qname
, "name", "Name", RES_TYPE_STRING
);
4221 && ! EQ (name
, Qunbound
)
4223 error ("Invalid frame name--not a string or nil");
4226 Vx_resource_name
= name
;
4228 /* See if parent window is specified. */
4229 parent
= w32_get_arg (parameters
, Qparent_id
, NULL
, NULL
, RES_TYPE_NUMBER
);
4230 if (EQ (parent
, Qunbound
))
4232 if (! NILP (parent
))
4233 CHECK_NUMBER (parent
);
4235 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
4236 /* No need to protect DISPLAY because that's not used after passing
4237 it to make_frame_without_minibuffer. */
4239 GCPRO4 (parameters
, parent
, name
, frame
);
4240 tem
= w32_get_arg (parameters
, Qminibuffer
, "minibuffer", "Minibuffer",
4242 if (EQ (tem
, Qnone
) || NILP (tem
))
4243 f
= make_frame_without_minibuffer (Qnil
, kb
, display
);
4244 else if (EQ (tem
, Qonly
))
4246 f
= make_minibuffer_frame ();
4247 minibuffer_only
= 1;
4249 else if (WINDOWP (tem
))
4250 f
= make_frame_without_minibuffer (tem
, kb
, display
);
4254 XSETFRAME (frame
, f
);
4256 /* Note that Windows does support scroll bars. */
4257 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
4259 /* By default, make scrollbars the system standard width. */
4260 FRAME_CONFIG_SCROLL_BAR_WIDTH (f
) = GetSystemMetrics (SM_CXVSCROLL
);
4262 f
->terminal
= dpyinfo
->terminal
;
4263 f
->terminal
->reference_count
++;
4265 f
->output_method
= output_w32
;
4266 f
->output_data
.w32
=
4267 (struct w32_output
*) xmalloc (sizeof (struct w32_output
));
4268 bzero (f
->output_data
.w32
, sizeof (struct w32_output
));
4269 FRAME_FONTSET (f
) = -1;
4270 record_unwind_protect (unwind_create_frame
, frame
);
4273 = w32_get_arg (parameters
, Qicon_name
, "iconName", "Title", RES_TYPE_STRING
);
4274 if (! STRINGP (f
->icon_name
))
4275 f
->icon_name
= Qnil
;
4277 /* FRAME_W32_DISPLAY_INFO (f) = dpyinfo; */
4279 FRAME_KBOARD (f
) = kb
;
4282 /* Specify the parent under which to make this window. */
4286 f
->output_data
.w32
->parent_desc
= (Window
) XFASTINT (parent
);
4287 f
->output_data
.w32
->explicit_parent
= 1;
4291 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
4292 f
->output_data
.w32
->explicit_parent
= 0;
4295 /* Set the name; the functions to which we pass f expect the name to
4297 if (EQ (name
, Qunbound
) || NILP (name
))
4299 f
->name
= build_string (dpyinfo
->w32_id_name
);
4300 f
->explicit_name
= 0;
4305 f
->explicit_name
= 1;
4306 /* use the frame's title when getting resources for this frame. */
4307 specbind (Qx_resource_name
, name
);
4310 f
->resx
= dpyinfo
->resx
;
4311 f
->resy
= dpyinfo
->resy
;
4313 #ifdef USE_FONT_BACKEND
4314 if (enable_font_backend
)
4316 /* Perhaps, we must allow frame parameter, say `font-backend',
4317 to specify which font backends to use. */
4318 register_font_driver (&w32font_driver
, f
);
4320 x_default_parameter (f
, parameters
, Qfont_backend
, Qnil
,
4321 "fontBackend", "FontBackend", RES_TYPE_STRING
);
4323 #endif /* USE_FONT_BACKEND */
4325 /* Extract the window parameters from the supplied values
4326 that are needed to determine window geometry. */
4327 #ifdef USE_FONT_BACKEND
4328 if (enable_font_backend
)
4329 x_default_font_parameter (f
, parameters
);
4335 font
= w32_get_arg (parameters
, Qfont
, "font", "Font", RES_TYPE_STRING
);
4338 /* First, try whatever font the caller has specified. */
4341 tem
= Fquery_fontset (font
, Qnil
);
4343 font
= x_new_fontset (f
, tem
);
4345 font
= x_new_font (f
, SDATA (font
));
4347 /* Try out a font which we hope has bold and italic variations. */
4348 if (!STRINGP (font
))
4349 font
= x_new_font (f
, "-*-Courier New-normal-r-*-*-*-100-*-*-c-*-iso8859-1");
4350 if (! STRINGP (font
))
4351 font
= x_new_font (f
, "-*-Courier-normal-r-*-*-13-*-*-*-c-*-iso8859-1");
4352 /* If those didn't work, look for something which will at least work. */
4353 if (! STRINGP (font
))
4354 font
= x_new_font (f
, "-*-Fixedsys-normal-r-*-*-12-*-*-*-c-*-iso8859-1");
4356 if (! STRINGP (font
))
4357 font
= build_string ("Fixedsys");
4359 x_default_parameter (f
, parameters
, Qfont
, font
,
4360 "font", "Font", RES_TYPE_STRING
);
4363 x_default_parameter (f
, parameters
, Qborder_width
, make_number (2),
4364 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
4365 /* This defaults to 2 in order to match xterm. We recognize either
4366 internalBorderWidth or internalBorder (which is what xterm calls
4368 if (NILP (Fassq (Qinternal_border_width
, parameters
)))
4372 value
= w32_get_arg (parameters
, Qinternal_border_width
,
4373 "internalBorder", "InternalBorder", RES_TYPE_NUMBER
);
4374 if (! EQ (value
, Qunbound
))
4375 parameters
= Fcons (Fcons (Qinternal_border_width
, value
),
4378 /* Default internalBorderWidth to 0 on Windows to match other programs. */
4379 x_default_parameter (f
, parameters
, Qinternal_border_width
, make_number (0),
4380 "internalBorderWidth", "InternalBorder", RES_TYPE_NUMBER
);
4381 x_default_parameter (f
, parameters
, Qvertical_scroll_bars
, Qright
,
4382 "verticalScrollBars", "ScrollBars", RES_TYPE_SYMBOL
);
4384 /* Also do the stuff which must be set before the window exists. */
4385 x_default_parameter (f
, parameters
, Qforeground_color
, build_string ("black"),
4386 "foreground", "Foreground", RES_TYPE_STRING
);
4387 x_default_parameter (f
, parameters
, Qbackground_color
, build_string ("white"),
4388 "background", "Background", RES_TYPE_STRING
);
4389 x_default_parameter (f
, parameters
, Qmouse_color
, build_string ("black"),
4390 "pointerColor", "Foreground", RES_TYPE_STRING
);
4391 x_default_parameter (f
, parameters
, Qcursor_color
, build_string ("black"),
4392 "cursorColor", "Foreground", RES_TYPE_STRING
);
4393 x_default_parameter (f
, parameters
, Qborder_color
, build_string ("black"),
4394 "borderColor", "BorderColor", RES_TYPE_STRING
);
4395 x_default_parameter (f
, parameters
, Qscreen_gamma
, Qnil
,
4396 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT
);
4397 x_default_parameter (f
, parameters
, Qline_spacing
, Qnil
,
4398 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER
);
4399 x_default_parameter (f
, parameters
, Qleft_fringe
, Qnil
,
4400 "leftFringe", "LeftFringe", RES_TYPE_NUMBER
);
4401 x_default_parameter (f
, parameters
, Qright_fringe
, Qnil
,
4402 "rightFringe", "RightFringe", RES_TYPE_NUMBER
);
4405 /* Init faces before x_default_parameter is called for scroll-bar
4406 parameters because that function calls x_set_scroll_bar_width,
4407 which calls change_frame_size, which calls Fset_window_buffer,
4408 which runs hooks, which call Fvertical_motion. At the end, we
4409 end up in init_iterator with a null face cache, which should not
4411 init_frame_faces (f
);
4413 x_default_parameter (f
, parameters
, Qmenu_bar_lines
, make_number (1),
4414 "menuBar", "MenuBar", RES_TYPE_NUMBER
);
4415 x_default_parameter (f
, parameters
, Qtool_bar_lines
, make_number (1),
4416 "toolBar", "ToolBar", RES_TYPE_NUMBER
);
4418 x_default_parameter (f
, parameters
, Qbuffer_predicate
, Qnil
,
4419 "bufferPredicate", "BufferPredicate", RES_TYPE_SYMBOL
);
4420 x_default_parameter (f
, parameters
, Qtitle
, Qnil
,
4421 "title", "Title", RES_TYPE_STRING
);
4422 x_default_parameter (f
, parameters
, Qfullscreen
, Qnil
,
4423 "fullscreen", "Fullscreen", RES_TYPE_SYMBOL
);
4425 f
->output_data
.w32
->dwStyle
= WS_OVERLAPPEDWINDOW
;
4426 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
4428 f
->output_data
.w32
->text_cursor
= w32_load_cursor (IDC_IBEAM
);
4429 f
->output_data
.w32
->nontext_cursor
= w32_load_cursor (IDC_ARROW
);
4430 f
->output_data
.w32
->modeline_cursor
= w32_load_cursor (IDC_ARROW
);
4431 f
->output_data
.w32
->hand_cursor
= w32_load_cursor (IDC_HAND
);
4432 f
->output_data
.w32
->hourglass_cursor
= w32_load_cursor (IDC_WAIT
);
4433 f
->output_data
.w32
->horizontal_drag_cursor
= w32_load_cursor (IDC_SIZEWE
);
4435 window_prompting
= x_figure_window_size (f
, parameters
, 1);
4437 tem
= w32_get_arg (parameters
, Qunsplittable
, 0, 0, RES_TYPE_BOOLEAN
);
4438 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
4440 w32_window (f
, window_prompting
, minibuffer_only
);
4441 x_icon (f
, parameters
);
4445 /* Now consider the frame official. */
4446 FRAME_W32_DISPLAY_INFO (f
)->reference_count
++;
4447 Vframe_list
= Fcons (frame
, Vframe_list
);
4449 /* We need to do this after creating the window, so that the
4450 icon-creation functions can say whose icon they're describing. */
4451 x_default_parameter (f
, parameters
, Qicon_type
, Qnil
,
4452 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL
);
4454 x_default_parameter (f
, parameters
, Qauto_raise
, Qnil
,
4455 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4456 x_default_parameter (f
, parameters
, Qauto_lower
, Qnil
,
4457 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
4458 x_default_parameter (f
, parameters
, Qcursor_type
, Qbox
,
4459 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
4460 x_default_parameter (f
, parameters
, Qscroll_bar_width
, Qnil
,
4461 "scrollBarWidth", "ScrollBarWidth", RES_TYPE_NUMBER
);
4463 /* Dimensions, especially FRAME_LINES (f), must be done via change_frame_size.
4464 Change will not be effected unless different from the current
4466 width
= FRAME_COLS (f
);
4467 height
= FRAME_LINES (f
);
4469 FRAME_LINES (f
) = 0;
4470 SET_FRAME_COLS (f
, 0);
4471 change_frame_size (f
, height
, width
, 1, 0, 0);
4473 /* Tell the server what size and position, etc, we want, and how
4474 badly we want them. This should be done after we have the menu
4475 bar so that its size can be taken into account. */
4477 x_wm_set_size_hint (f
, window_prompting
, 0);
4480 /* Make the window appear on the frame and enable display, unless
4481 the caller says not to. However, with explicit parent, Emacs
4482 cannot control visibility, so don't try. */
4483 if (! f
->output_data
.w32
->explicit_parent
)
4485 Lisp_Object visibility
;
4487 visibility
= w32_get_arg (parameters
, Qvisibility
, 0, 0, RES_TYPE_SYMBOL
);
4488 if (EQ (visibility
, Qunbound
))
4491 if (EQ (visibility
, Qicon
))
4492 x_iconify_frame (f
);
4493 else if (! NILP (visibility
))
4494 x_make_frame_visible (f
);
4496 /* Must have been Qnil. */
4500 /* Initialize `default-minibuffer-frame' in case this is the first
4501 frame on this terminal. */
4502 if (FRAME_HAS_MINIBUF_P (f
)
4503 && (!FRAMEP (kb
->Vdefault_minibuffer_frame
)
4504 || !FRAME_LIVE_P (XFRAME (kb
->Vdefault_minibuffer_frame
))))
4505 kb
->Vdefault_minibuffer_frame
= frame
;
4507 /* All remaining specified parameters, which have not been "used"
4508 by x_get_arg and friends, now go in the misc. alist of the frame. */
4509 for (tem
= parameters
; !NILP (tem
); tem
= XCDR (tem
))
4510 if (CONSP (XCAR (tem
)) && !NILP (XCAR (XCAR (tem
))))
4511 f
->param_alist
= Fcons (XCAR (tem
), f
->param_alist
);
4513 store_frame_param (f
, Qwindow_system
, Qw32
);
4517 /* Make sure windows on this frame appear in calls to next-window
4518 and similar functions. */
4519 Vwindow_list
= Qnil
;
4521 return unbind_to (count
, frame
);
4524 /* FRAME is used only to get a handle on the X display. We don't pass the
4525 display info directly because we're called from frame.c, which doesn't
4526 know about that structure. */
4528 x_get_focus_frame (frame
)
4529 struct frame
*frame
;
4531 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (frame
);
4533 if (! dpyinfo
->w32_focus_frame
)
4536 XSETFRAME (xfocus
, dpyinfo
->w32_focus_frame
);
4540 DEFUN ("x-focus-frame", Fx_focus_frame
, Sx_focus_frame
, 1, 1, 0,
4541 doc
: /* Give FRAME input focus, raising to foreground if necessary. */)
4545 x_focus_on_frame (check_x_frame (frame
));
4550 /* Return the charset portion of a font name. */
4551 char * xlfd_charset_of_font (char * fontname
)
4553 char *charset
, *encoding
;
4555 encoding
= strrchr(fontname
, '-');
4556 if (!encoding
|| encoding
== fontname
)
4559 for (charset
= encoding
- 1; charset
>= fontname
; charset
--)
4560 if (*charset
== '-')
4563 if (charset
== fontname
|| strcmp(charset
, "-*-*") == 0)
4569 struct font_info
*w32_load_bdf_font (struct frame
*f
, char *fontname
,
4570 int size
, char* filename
);
4571 static Lisp_Object
w32_list_bdf_fonts (Lisp_Object pattern
, int max_names
);
4572 static BOOL
w32_to_x_font (LOGFONT
* lplf
, char * lpxstr
, int len
,
4574 static BOOL
x_to_w32_font (char *lpxstr
, LOGFONT
*lplogfont
);
4576 static struct font_info
*
4577 w32_load_system_font (f
,fontname
,size
)
4582 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
4583 Lisp_Object font_names
;
4585 /* Get a list of all the fonts that match this name. Once we
4586 have a list of matching fonts, we compare them against the fonts
4587 we already have loaded by comparing names. */
4588 font_names
= w32_list_fonts (f
, build_string (fontname
), size
, 100);
4590 if (!NILP (font_names
))
4595 /* First check if any are already loaded, as that is cheaper
4596 than loading another one. */
4597 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
4598 for (tail
= font_names
; CONSP (tail
); tail
= XCDR (tail
))
4599 if (dpyinfo
->font_table
[i
].name
4600 && (!strcmp (dpyinfo
->font_table
[i
].name
,
4601 SDATA (XCAR (tail
)))
4602 || !strcmp (dpyinfo
->font_table
[i
].full_name
,
4603 SDATA (XCAR (tail
)))))
4604 return (dpyinfo
->font_table
+ i
);
4606 fontname
= (char *) SDATA (XCAR (font_names
));
4608 else if (w32_strict_fontnames
)
4610 /* If EnumFontFamiliesEx was available, we got a full list of
4611 fonts back so stop now to avoid the possibility of loading a
4612 random font. If we had to fall back to EnumFontFamilies, the
4613 list is incomplete, so continue whether the font we want was
4615 HMODULE gdi32
= GetModuleHandle ("gdi32.dll");
4616 FARPROC enum_font_families_ex
4617 = GetProcAddress (gdi32
, "EnumFontFamiliesExA");
4618 if (enum_font_families_ex
)
4622 /* Load the font and add it to the table. */
4624 char *full_name
, *encoding
, *charset
;
4626 struct font_info
*fontp
;
4632 if (!fontname
|| !x_to_w32_font (fontname
, &lf
))
4635 if (!*lf
.lfFaceName
)
4636 /* If no name was specified for the font, we get a random font
4637 from CreateFontIndirect - this is not particularly
4638 desirable, especially since CreateFontIndirect does not
4639 fill out the missing name in lf, so we never know what we
4643 lf
.lfQuality
= DEFAULT_QUALITY
;
4645 font
= (XFontStruct
*) xmalloc (sizeof (XFontStruct
));
4646 bzero (font
, sizeof (*font
));
4648 /* Set bdf to NULL to indicate that this is a Windows font. */
4653 font
->hfont
= CreateFontIndirect (&lf
);
4655 if (font
->hfont
== NULL
)
4664 codepage
= w32_codepage_for_font (fontname
);
4666 hdc
= GetDC (dpyinfo
->root_window
);
4667 oldobj
= SelectObject (hdc
, font
->hfont
);
4669 ok
= GetTextMetrics (hdc
, &font
->tm
);
4670 if (codepage
== CP_UNICODE
)
4671 font
->double_byte_p
= 1;
4674 /* Unfortunately, some fonts (eg. MingLiU, a big5 ttf font)
4675 don't report themselves as double byte fonts, when
4676 patently they are. So instead of trusting
4677 GetFontLanguageInfo, we check the properties of the
4678 codepage directly, since that is ultimately what we are
4679 working from anyway. */
4680 /* font->double_byte_p = GetFontLanguageInfo(hdc) & GCP_DBCS; */
4682 GetCPInfo (codepage
, &cpi
);
4683 font
->double_byte_p
= cpi
.MaxCharSize
> 1;
4686 SelectObject (hdc
, oldobj
);
4687 ReleaseDC (dpyinfo
->root_window
, hdc
);
4688 /* Fill out details in lf according to the font that was
4690 lf
.lfHeight
= font
->tm
.tmInternalLeading
- font
->tm
.tmHeight
;
4691 lf
.lfWidth
= font
->tm
.tmMaxCharWidth
;
4692 lf
.lfWeight
= font
->tm
.tmWeight
;
4693 lf
.lfItalic
= font
->tm
.tmItalic
;
4694 lf
.lfCharSet
= font
->tm
.tmCharSet
;
4695 lf
.lfPitchAndFamily
= ((font
->tm
.tmPitchAndFamily
& TMPF_FIXED_PITCH
)
4696 ? VARIABLE_PITCH
: FIXED_PITCH
);
4697 lf
.lfOutPrecision
= ((font
->tm
.tmPitchAndFamily
& TMPF_VECTOR
)
4698 ? OUT_STROKE_PRECIS
: OUT_STRING_PRECIS
);
4700 w32_cache_char_metrics (font
);
4707 w32_unload_font (dpyinfo
, font
);
4711 /* Find a free slot in the font table. */
4712 for (i
= 0; i
< dpyinfo
->n_fonts
; ++i
)
4713 if (dpyinfo
->font_table
[i
].name
== NULL
)
4716 /* If no free slot found, maybe enlarge the font table. */
4717 if (i
== dpyinfo
->n_fonts
4718 && dpyinfo
->n_fonts
== dpyinfo
->font_table_size
)
4721 dpyinfo
->font_table_size
= max (16, 2 * dpyinfo
->font_table_size
);
4722 sz
= dpyinfo
->font_table_size
* sizeof *dpyinfo
->font_table
;
4724 = (struct font_info
*) xrealloc (dpyinfo
->font_table
, sz
);
4727 fontp
= dpyinfo
->font_table
+ i
;
4728 if (i
== dpyinfo
->n_fonts
)
4731 /* Now fill in the slots of *FONTP. */
4733 bzero (fontp
, sizeof (*fontp
));
4735 fontp
->font_idx
= i
;
4736 fontp
->name
= (char *) xmalloc (strlen (fontname
) + 1);
4737 bcopy (fontname
, fontp
->name
, strlen (fontname
) + 1);
4739 if ((lf
.lfPitchAndFamily
& 0x03) == FIXED_PITCH
)
4741 /* Fixed width font. */
4742 fontp
->average_width
= fontp
->space_width
= FONT_AVG_WIDTH (font
);
4748 pcm
= w32_per_char_metric (font
, &space
, ANSI_FONT
);
4750 fontp
->space_width
= pcm
->width
;
4752 fontp
->space_width
= FONT_AVG_WIDTH (font
);
4754 fontp
->average_width
= font
->tm
.tmAveCharWidth
;
4757 fontp
->charset
= -1;
4758 charset
= xlfd_charset_of_font (fontname
);
4760 /* Cache the W32 codepage for a font. This makes w32_encode_char
4761 (called for every glyph during redisplay) much faster. */
4762 fontp
->codepage
= codepage
;
4764 /* Work out the font's full name. */
4765 full_name
= (char *)xmalloc (100);
4766 if (full_name
&& w32_to_x_font (&lf
, full_name
, 100, charset
))
4767 fontp
->full_name
= full_name
;
4770 /* If all else fails - just use the name we used to load it. */
4772 fontp
->full_name
= fontp
->name
;
4775 fontp
->size
= FONT_WIDTH (font
);
4776 fontp
->height
= FONT_HEIGHT (font
);
4778 /* The slot `encoding' specifies how to map a character
4779 code-points (0x20..0x7F or 0x2020..0x7F7F) of each charset to
4780 the font code-points (0:0x20..0x7F, 1:0xA0..0xFF), or
4781 (0:0x20..0x7F, 1:0xA0..0xFF,
4782 (0:0x2020..0x7F7F, 1:0xA0A0..0xFFFF, 3:0x20A0..0x7FFF,
4783 2:0xA020..0xFF7F). For the moment, we don't know which charset
4784 uses this font. So, we set information in fontp->encoding_type
4785 which is never used by any charset. If mapping can't be
4786 decided, set FONT_ENCODING_NOT_DECIDED. */
4788 /* SJIS fonts need to be set to type 4, all others seem to work as
4789 type FONT_ENCODING_NOT_DECIDED. */
4790 encoding
= strrchr (fontp
->name
, '-');
4791 if (encoding
&& strnicmp (encoding
+1, "sjis", 4) == 0)
4792 fontp
->encoding_type
= 4;
4794 fontp
->encoding_type
= FONT_ENCODING_NOT_DECIDED
;
4796 /* The following three values are set to 0 under W32, which is
4797 what they get set to if XGetFontProperty fails under X. */
4798 fontp
->baseline_offset
= 0;
4799 fontp
->relative_compose
= 0;
4800 fontp
->default_ascent
= 0;
4802 /* Set global flag fonts_changed_p to non-zero if the font loaded
4803 has a character with a smaller width than any other character
4804 before, or if the font loaded has a smaller height than any
4805 other font loaded before. If this happens, it will make a
4806 glyph matrix reallocation necessary. */
4807 fonts_changed_p
|= x_compute_min_glyph_bounds (f
);
4813 /* Load font named FONTNAME of size SIZE for frame F, and return a
4814 pointer to the structure font_info while allocating it dynamically.
4815 If loading fails, return NULL. */
4817 w32_load_font (f
,fontname
,size
)
4822 Lisp_Object bdf_fonts
;
4823 struct font_info
*retval
= NULL
;
4824 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
4826 bdf_fonts
= w32_list_bdf_fonts (build_string (fontname
), 1);
4828 while (!retval
&& CONSP (bdf_fonts
))
4830 char *bdf_name
, *bdf_file
;
4831 Lisp_Object bdf_pair
;
4834 bdf_name
= SDATA (XCAR (bdf_fonts
));
4835 bdf_pair
= Fassoc (XCAR (bdf_fonts
), Vw32_bdf_filename_alist
);
4836 bdf_file
= SDATA (XCDR (bdf_pair
));
4838 // If the font is already loaded, do not load it again.
4839 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
4841 if ((dpyinfo
->font_table
[i
].name
4842 && !strcmp (dpyinfo
->font_table
[i
].name
, bdf_name
))
4843 || (dpyinfo
->font_table
[i
].full_name
4844 && !strcmp (dpyinfo
->font_table
[i
].full_name
, bdf_name
)))
4845 return dpyinfo
->font_table
+ i
;
4848 retval
= w32_load_bdf_font (f
, bdf_name
, size
, bdf_file
);
4850 bdf_fonts
= XCDR (bdf_fonts
);
4856 return w32_load_system_font(f
, fontname
, size
);
4861 w32_unload_font (dpyinfo
, font
)
4862 struct w32_display_info
*dpyinfo
;
4867 if (font
->per_char
) xfree (font
->per_char
);
4868 if (font
->bdf
) w32_free_bdf_font (font
->bdf
);
4870 if (font
->hfont
) DeleteObject(font
->hfont
);
4875 /* The font conversion stuff between x and w32 */
4877 /* X font string is as follows (from faces.el)
4881 * (weight "\\(bold\\|demibold\\|medium\\)") ; 1
4882 * (weight\? "\\([^-]*\\)") ; 1
4883 * (slant "\\([ior]\\)") ; 2
4884 * (slant\? "\\([^-]?\\)") ; 2
4885 * (swidth "\\([^-]*\\)") ; 3
4886 * (adstyle "[^-]*") ; 4
4887 * (pixelsize "[0-9]+")
4888 * (pointsize "[0-9][0-9]+")
4889 * (resx "[0-9][0-9]+")
4890 * (resy "[0-9][0-9]+")
4891 * (spacing "[cmp?*]")
4892 * (avgwidth "[0-9]+")
4893 * (registry "[^-]+")
4894 * (encoding "[^-]+")
4899 x_to_w32_weight (lpw
)
4902 if (!lpw
) return (FW_DONTCARE
);
4904 if (stricmp (lpw
,"heavy") == 0) return FW_HEAVY
;
4905 else if (stricmp (lpw
,"extrabold") == 0) return FW_EXTRABOLD
;
4906 else if (stricmp (lpw
,"bold") == 0) return FW_BOLD
;
4907 else if (stricmp (lpw
,"demibold") == 0) return FW_SEMIBOLD
;
4908 else if (stricmp (lpw
,"semibold") == 0) return FW_SEMIBOLD
;
4909 else if (stricmp (lpw
,"medium") == 0) return FW_MEDIUM
;
4910 else if (stricmp (lpw
,"normal") == 0) return FW_NORMAL
;
4911 else if (stricmp (lpw
,"light") == 0) return FW_LIGHT
;
4912 else if (stricmp (lpw
,"extralight") == 0) return FW_EXTRALIGHT
;
4913 else if (stricmp (lpw
,"thin") == 0) return FW_THIN
;
4920 w32_to_x_weight (fnweight
)
4923 if (fnweight
>= FW_HEAVY
) return "heavy";
4924 if (fnweight
>= FW_EXTRABOLD
) return "extrabold";
4925 if (fnweight
>= FW_BOLD
) return "bold";
4926 if (fnweight
>= FW_SEMIBOLD
) return "demibold";
4927 if (fnweight
>= FW_MEDIUM
) return "medium";
4928 if (fnweight
>= FW_NORMAL
) return "normal";
4929 if (fnweight
>= FW_LIGHT
) return "light";
4930 if (fnweight
>= FW_EXTRALIGHT
) return "extralight";
4931 if (fnweight
>= FW_THIN
) return "thin";
4937 x_to_w32_charset (lpcs
)
4940 Lisp_Object this_entry
, w32_charset
;
4942 int len
= strlen (lpcs
);
4944 /* Support "*-#nnn" format for unknown charsets. */
4945 if (strncmp (lpcs
, "*-#", 3) == 0)
4946 return atoi (lpcs
+ 3);
4948 /* All Windows fonts qualify as unicode. */
4949 if (!strncmp (lpcs
, "iso10646", 8))
4950 return DEFAULT_CHARSET
;
4952 /* Handle wildcards by ignoring them; eg. treat "big5*-*" as "big5". */
4953 charset
= alloca (len
+ 1);
4954 strcpy (charset
, lpcs
);
4955 lpcs
= strchr (charset
, '*');
4959 /* Look through w32-charset-info-alist for the character set.
4960 Format of each entry is
4961 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
4963 this_entry
= Fassoc (build_string(charset
), Vw32_charset_info_alist
);
4965 if (NILP(this_entry
))
4967 /* At startup, we want iso8859-1 fonts to come up properly. */
4968 if (stricmp(charset
, "iso8859-1") == 0)
4969 return ANSI_CHARSET
;
4971 return DEFAULT_CHARSET
;
4974 w32_charset
= Fcar (Fcdr (this_entry
));
4976 /* Translate Lisp symbol to number. */
4977 if (EQ (w32_charset
, Qw32_charset_ansi
))
4978 return ANSI_CHARSET
;
4979 if (EQ (w32_charset
, Qw32_charset_symbol
))
4980 return SYMBOL_CHARSET
;
4981 if (EQ (w32_charset
, Qw32_charset_shiftjis
))
4982 return SHIFTJIS_CHARSET
;
4983 if (EQ (w32_charset
, Qw32_charset_hangeul
))
4984 return HANGEUL_CHARSET
;
4985 if (EQ (w32_charset
, Qw32_charset_chinesebig5
))
4986 return CHINESEBIG5_CHARSET
;
4987 if (EQ (w32_charset
, Qw32_charset_gb2312
))
4988 return GB2312_CHARSET
;
4989 if (EQ (w32_charset
, Qw32_charset_oem
))
4991 #ifdef JOHAB_CHARSET
4992 if (EQ (w32_charset
, Qw32_charset_johab
))
4993 return JOHAB_CHARSET
;
4994 if (EQ (w32_charset
, Qw32_charset_easteurope
))
4995 return EASTEUROPE_CHARSET
;
4996 if (EQ (w32_charset
, Qw32_charset_turkish
))
4997 return TURKISH_CHARSET
;
4998 if (EQ (w32_charset
, Qw32_charset_baltic
))
4999 return BALTIC_CHARSET
;
5000 if (EQ (w32_charset
, Qw32_charset_russian
))
5001 return RUSSIAN_CHARSET
;
5002 if (EQ (w32_charset
, Qw32_charset_arabic
))
5003 return ARABIC_CHARSET
;
5004 if (EQ (w32_charset
, Qw32_charset_greek
))
5005 return GREEK_CHARSET
;
5006 if (EQ (w32_charset
, Qw32_charset_hebrew
))
5007 return HEBREW_CHARSET
;
5008 if (EQ (w32_charset
, Qw32_charset_vietnamese
))
5009 return VIETNAMESE_CHARSET
;
5010 if (EQ (w32_charset
, Qw32_charset_thai
))
5011 return THAI_CHARSET
;
5012 if (EQ (w32_charset
, Qw32_charset_mac
))
5014 #endif /* JOHAB_CHARSET */
5015 #ifdef UNICODE_CHARSET
5016 if (EQ (w32_charset
, Qw32_charset_unicode
))
5017 return UNICODE_CHARSET
;
5020 return DEFAULT_CHARSET
;
5025 w32_to_x_charset (fncharset
, matching
)
5029 static char buf
[32];
5030 Lisp_Object charset_type
;
5035 /* If fully specified, accept it as it is. Otherwise use a
5037 char *wildcard
= strchr (matching
, '*');
5040 else if (strchr (matching
, '-'))
5043 match_len
= strlen (matching
);
5049 /* Handle startup case of w32-charset-info-alist not
5050 being set up yet. */
5051 if (NILP(Vw32_charset_info_alist
))
5053 charset_type
= Qw32_charset_ansi
;
5055 case DEFAULT_CHARSET
:
5056 charset_type
= Qw32_charset_default
;
5058 case SYMBOL_CHARSET
:
5059 charset_type
= Qw32_charset_symbol
;
5061 case SHIFTJIS_CHARSET
:
5062 charset_type
= Qw32_charset_shiftjis
;
5064 case HANGEUL_CHARSET
:
5065 charset_type
= Qw32_charset_hangeul
;
5067 case GB2312_CHARSET
:
5068 charset_type
= Qw32_charset_gb2312
;
5070 case CHINESEBIG5_CHARSET
:
5071 charset_type
= Qw32_charset_chinesebig5
;
5074 charset_type
= Qw32_charset_oem
;
5077 /* More recent versions of Windows (95 and NT4.0) define more
5079 #ifdef EASTEUROPE_CHARSET
5080 case EASTEUROPE_CHARSET
:
5081 charset_type
= Qw32_charset_easteurope
;
5083 case TURKISH_CHARSET
:
5084 charset_type
= Qw32_charset_turkish
;
5086 case BALTIC_CHARSET
:
5087 charset_type
= Qw32_charset_baltic
;
5089 case RUSSIAN_CHARSET
:
5090 charset_type
= Qw32_charset_russian
;
5092 case ARABIC_CHARSET
:
5093 charset_type
= Qw32_charset_arabic
;
5096 charset_type
= Qw32_charset_greek
;
5098 case HEBREW_CHARSET
:
5099 charset_type
= Qw32_charset_hebrew
;
5101 case VIETNAMESE_CHARSET
:
5102 charset_type
= Qw32_charset_vietnamese
;
5105 charset_type
= Qw32_charset_thai
;
5108 charset_type
= Qw32_charset_mac
;
5111 charset_type
= Qw32_charset_johab
;
5115 #ifdef UNICODE_CHARSET
5116 case UNICODE_CHARSET
:
5117 charset_type
= Qw32_charset_unicode
;
5121 /* Encode numerical value of unknown charset. */
5122 sprintf (buf
, "*-#%u", fncharset
);
5128 char * best_match
= NULL
;
5129 int matching_found
= 0;
5131 /* Look through w32-charset-info-alist for the character set.
5132 Prefer ISO codepages, and prefer lower numbers in the ISO
5133 range. Only return charsets for codepages which are installed.
5135 Format of each entry is
5136 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
5138 for (rest
= Vw32_charset_info_alist
; CONSP (rest
); rest
= XCDR (rest
))
5141 Lisp_Object w32_charset
;
5142 Lisp_Object codepage
;
5144 Lisp_Object this_entry
= XCAR (rest
);
5146 /* Skip invalid entries in alist. */
5147 if (!CONSP (this_entry
) || !STRINGP (XCAR (this_entry
))
5148 || !CONSP (XCDR (this_entry
))
5149 || !SYMBOLP (XCAR (XCDR (this_entry
))))
5152 x_charset
= SDATA (XCAR (this_entry
));
5153 w32_charset
= XCAR (XCDR (this_entry
));
5154 codepage
= XCDR (XCDR (this_entry
));
5156 /* Look for Same charset and a valid codepage (or non-int
5157 which means ignore). */
5158 if (EQ (w32_charset
, charset_type
)
5159 && (!INTEGERP (codepage
) || XINT (codepage
) == CP_DEFAULT
5160 || IsValidCodePage (XINT (codepage
))))
5162 /* If we don't have a match already, then this is the
5166 best_match
= x_charset
;
5167 if (matching
&& !strnicmp (x_charset
, matching
, match_len
))
5170 /* If we already found a match for MATCHING, then
5171 only consider other matches. */
5172 else if (matching_found
5173 && strnicmp (x_charset
, matching
, match_len
))
5175 /* If this matches what we want, and the best so far doesn't,
5176 then this is better. */
5177 else if (!matching_found
&& matching
5178 && !strnicmp (x_charset
, matching
, match_len
))
5180 best_match
= x_charset
;
5183 /* If this is fully specified, and the best so far isn't,
5184 then this is better. */
5185 else if ((!strchr (best_match
, '-') && strchr (x_charset
, '-'))
5186 /* If this is an ISO codepage, and the best so far isn't,
5187 then this is better, but only if it fully specifies the
5189 || (strnicmp (best_match
, "iso", 3) != 0
5190 && strnicmp (x_charset
, "iso", 3) == 0
5191 && strchr (x_charset
, '-')))
5192 best_match
= x_charset
;
5193 /* If both are ISO8859 codepages, choose the one with the
5194 lowest number in the encoding field. */
5195 else if (strnicmp (best_match
, "iso8859-", 8) == 0
5196 && strnicmp (x_charset
, "iso8859-", 8) == 0)
5198 int best_enc
= atoi (best_match
+ 8);
5199 int this_enc
= atoi (x_charset
+ 8);
5200 if (this_enc
> 0 && this_enc
< best_enc
)
5201 best_match
= x_charset
;
5206 /* If no match, encode the numeric value. */
5209 sprintf (buf
, "*-#%u", fncharset
);
5213 strncpy (buf
, best_match
, 31);
5214 /* If the charset is not fully specified, put -0 on the end. */
5215 if (!strchr (best_match
, '-'))
5217 int pos
= strlen (best_match
);
5218 /* Charset specifiers shouldn't be very long. If it is a made
5219 up one, truncating it should not do any harm since it isn't
5220 recognized anyway. */
5223 strcpy (buf
+ pos
, "-0");
5231 /* Return all the X charsets that map to a font. */
5233 w32_to_all_x_charsets (fncharset
)
5236 static char buf
[32];
5237 Lisp_Object charset_type
;
5238 Lisp_Object retval
= Qnil
;
5243 /* Handle startup case of w32-charset-info-alist not
5244 being set up yet. */
5245 if (NILP(Vw32_charset_info_alist
))
5246 return Fcons (build_string ("iso8859-1"), Qnil
);
5248 charset_type
= Qw32_charset_ansi
;
5250 case DEFAULT_CHARSET
:
5251 charset_type
= Qw32_charset_default
;
5253 case SYMBOL_CHARSET
:
5254 charset_type
= Qw32_charset_symbol
;
5256 case SHIFTJIS_CHARSET
:
5257 charset_type
= Qw32_charset_shiftjis
;
5259 case HANGEUL_CHARSET
:
5260 charset_type
= Qw32_charset_hangeul
;
5262 case GB2312_CHARSET
:
5263 charset_type
= Qw32_charset_gb2312
;
5265 case CHINESEBIG5_CHARSET
:
5266 charset_type
= Qw32_charset_chinesebig5
;
5269 charset_type
= Qw32_charset_oem
;
5272 /* More recent versions of Windows (95 and NT4.0) define more
5274 #ifdef EASTEUROPE_CHARSET
5275 case EASTEUROPE_CHARSET
:
5276 charset_type
= Qw32_charset_easteurope
;
5278 case TURKISH_CHARSET
:
5279 charset_type
= Qw32_charset_turkish
;
5281 case BALTIC_CHARSET
:
5282 charset_type
= Qw32_charset_baltic
;
5284 case RUSSIAN_CHARSET
:
5285 charset_type
= Qw32_charset_russian
;
5287 case ARABIC_CHARSET
:
5288 charset_type
= Qw32_charset_arabic
;
5291 charset_type
= Qw32_charset_greek
;
5293 case HEBREW_CHARSET
:
5294 charset_type
= Qw32_charset_hebrew
;
5296 case VIETNAMESE_CHARSET
:
5297 charset_type
= Qw32_charset_vietnamese
;
5300 charset_type
= Qw32_charset_thai
;
5303 charset_type
= Qw32_charset_mac
;
5306 charset_type
= Qw32_charset_johab
;
5310 #ifdef UNICODE_CHARSET
5311 case UNICODE_CHARSET
:
5312 charset_type
= Qw32_charset_unicode
;
5316 /* Encode numerical value of unknown charset. */
5317 sprintf (buf
, "*-#%u", fncharset
);
5318 return Fcons (build_string (buf
), Qnil
);
5323 /* Look through w32-charset-info-alist for the character set.
5324 Only return fully specified charsets for codepages which are
5327 Format of each entry in Vw32_charset_info_alist is
5328 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
5330 for (rest
= Vw32_charset_info_alist
; CONSP (rest
); rest
= XCDR (rest
))
5332 Lisp_Object x_charset
;
5333 Lisp_Object w32_charset
;
5334 Lisp_Object codepage
;
5336 Lisp_Object this_entry
= XCAR (rest
);
5338 /* Skip invalid entries in alist. */
5339 if (!CONSP (this_entry
) || !STRINGP (XCAR (this_entry
))
5340 || !CONSP (XCDR (this_entry
))
5341 || !SYMBOLP (XCAR (XCDR (this_entry
))))
5344 x_charset
= XCAR (this_entry
);
5345 w32_charset
= XCAR (XCDR (this_entry
));
5346 codepage
= XCDR (XCDR (this_entry
));
5348 if (!strchr (SDATA (x_charset
), '-'))
5351 /* Look for Same charset and a valid codepage (or non-int
5352 which means ignore). */
5353 if (EQ (w32_charset
, charset_type
)
5354 && (!INTEGERP (codepage
) || XINT (codepage
) == CP_DEFAULT
5355 || IsValidCodePage (XINT (codepage
))))
5357 retval
= Fcons (x_charset
, retval
);
5361 /* If no match, encode the numeric value. */
5364 sprintf (buf
, "*-#%u", fncharset
);
5365 return Fcons (build_string (buf
), Qnil
);
5372 /* Get the Windows codepage corresponding to the specified font. The
5373 charset info in the font name is used to look up
5374 w32-charset-to-codepage-alist. */
5376 w32_codepage_for_font (char *fontname
)
5378 Lisp_Object codepage
, entry
;
5379 char *charset_str
, *charset
, *end
;
5381 /* Extract charset part of font string. */
5382 charset
= xlfd_charset_of_font (fontname
);
5387 charset_str
= (char *) alloca (strlen (charset
) + 1);
5388 strcpy (charset_str
, charset
);
5391 /* Remove leading "*-". */
5392 if (strncmp ("*-", charset_str
, 2) == 0)
5393 charset
= charset_str
+ 2;
5396 charset
= charset_str
;
5398 /* Stop match at wildcard (including preceding '-'). */
5399 if (end
= strchr (charset
, '*'))
5401 if (end
> charset
&& *(end
-1) == '-')
5406 if (!strcmp (charset
, "iso10646"))
5409 if (NILP (Vw32_charset_info_alist
))
5412 entry
= Fassoc (build_string(charset
), Vw32_charset_info_alist
);
5416 codepage
= Fcdr (Fcdr (entry
));
5418 if (NILP (codepage
))
5420 else if (XFASTINT (codepage
) == XFASTINT (Qt
))
5422 else if (INTEGERP (codepage
))
5423 return XINT (codepage
);
5430 w32_to_x_font (lplogfont
, lpxstr
, len
, specific_charset
)
5431 LOGFONT
* lplogfont
;
5434 char * specific_charset
;
5438 char height_pixels
[8];
5440 char width_pixels
[8];
5441 char *fontname_dash
;
5442 int display_resy
= (int) one_w32_display_info
.resy
;
5443 int display_resx
= (int) one_w32_display_info
.resx
;
5444 struct coding_system coding
;
5446 if (!lpxstr
) abort ();
5451 if (lplogfont
->lfOutPrecision
== OUT_STRING_PRECIS
)
5452 fonttype
= "raster";
5453 else if (lplogfont
->lfOutPrecision
== OUT_STROKE_PRECIS
)
5454 fonttype
= "outline";
5456 fonttype
= "unknown";
5458 setup_coding_system (Fcheck_coding_system (Vlocale_coding_system
),
5460 coding
.src_multibyte
= 0;
5461 coding
.dst_multibyte
= 1;
5462 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5463 /* We explicitely disable composition handling because selection
5464 data should not contain any composition sequence. */
5465 coding
.common_flags
&= ~CODING_ANNOTATION_MASK
;
5467 coding
.dst_bytes
= LF_FACESIZE
* 2;
5468 coding
.destination
= (unsigned char *) xmalloc (coding
.dst_bytes
+ 1);
5469 decode_coding_c_string (&coding
, lplogfont
->lfFaceName
,
5470 strlen(lplogfont
->lfFaceName
), Qnil
);
5471 fontname
= coding
.destination
;
5473 *(fontname
+ coding
.produced
) = '\0';
5475 /* Replace dashes with underscores so the dashes are not
5477 fontname_dash
= fontname
;
5478 while (fontname_dash
= strchr (fontname_dash
, '-'))
5479 *fontname_dash
= '_';
5481 if (lplogfont
->lfHeight
)
5483 sprintf (height_pixels
, "%u", eabs (lplogfont
->lfHeight
));
5484 sprintf (height_dpi
, "%u",
5485 eabs (lplogfont
->lfHeight
) * 720 / display_resy
);
5489 strcpy (height_pixels
, "*");
5490 strcpy (height_dpi
, "*");
5493 #if 0 /* Never put the width in the xfld. It fails on fonts with
5494 double-width characters. */
5495 if (lplogfont
->lfWidth
)
5496 sprintf (width_pixels
, "%u", lplogfont
->lfWidth
* 10);
5499 strcpy (width_pixels
, "*");
5501 _snprintf (lpxstr
, len
- 1,
5502 "-%s-%s-%s-%c-normal-normal-%s-%s-%d-%d-%c-%s-%s",
5503 fonttype
, /* foundry */
5504 fontname
, /* family */
5505 w32_to_x_weight (lplogfont
->lfWeight
), /* weight */
5506 lplogfont
->lfItalic
?'i':'r', /* slant */
5508 /* add style name */
5509 height_pixels
, /* pixel size */
5510 height_dpi
, /* point size */
5511 display_resx
, /* resx */
5512 display_resy
, /* resy */
5513 ((lplogfont
->lfPitchAndFamily
& 0x3) == VARIABLE_PITCH
)
5514 ? 'p' : 'c', /* spacing */
5515 width_pixels
, /* avg width */
5516 w32_to_x_charset (lplogfont
->lfCharSet
, specific_charset
)
5517 /* charset registry and encoding */
5520 lpxstr
[len
- 1] = 0; /* just to be sure */
5525 x_to_w32_font (lpxstr
, lplogfont
)
5527 LOGFONT
* lplogfont
;
5529 struct coding_system coding
;
5531 if (!lplogfont
) return (FALSE
);
5533 memset (lplogfont
, 0, sizeof (*lplogfont
));
5535 /* Set default value for each field. */
5537 lplogfont
->lfOutPrecision
= OUT_DEFAULT_PRECIS
;
5538 lplogfont
->lfClipPrecision
= CLIP_DEFAULT_PRECIS
;
5539 lplogfont
->lfQuality
= DEFAULT_QUALITY
;
5541 /* go for maximum quality */
5542 lplogfont
->lfOutPrecision
= OUT_STROKE_PRECIS
;
5543 lplogfont
->lfClipPrecision
= CLIP_STROKE_PRECIS
;
5544 lplogfont
->lfQuality
= PROOF_QUALITY
;
5547 lplogfont
->lfCharSet
= DEFAULT_CHARSET
;
5548 lplogfont
->lfWeight
= FW_DONTCARE
;
5549 lplogfont
->lfPitchAndFamily
= DEFAULT_PITCH
| FF_DONTCARE
;
5554 /* Provide a simple escape mechanism for specifying Windows font names
5555 * directly -- if font spec does not beginning with '-', assume this
5557 * "<font name>[:height in pixels[:width in pixels[:weight]]]"
5563 char name
[50], weight
[20], slant
, pitch
, pixels
[10], height
[10],
5564 width
[10], resy
[10], remainder
[50];
5566 int dpi
= (int) one_w32_display_info
.resy
;
5568 fields
= sscanf (lpxstr
,
5569 "-%*[^-]-%49[^-]-%19[^-]-%c-%*[^-]-%*[^-]-%9[^-]-%9[^-]-%*[^-]-%9[^-]-%c-%9[^-]-%49s",
5570 name
, weight
, &slant
, pixels
, height
, resy
, &pitch
, width
, remainder
);
5574 /* In the general case when wildcards cover more than one field,
5575 we don't know which field is which, so don't fill any in.
5576 However, we need to cope with this particular form, which is
5577 generated by font_list_1 (invoked by try_font_list):
5578 "-raster-6x10-*-gb2312*-*"
5579 and make sure to correctly parse the charset field. */
5582 fields
= sscanf (lpxstr
,
5583 "-%*[^-]-%49[^-]-*-%49s",
5586 else if (fields
< 9)
5592 if (fields
> 0 && name
[0] != '*')
5594 Lisp_Object string
= build_string (name
);
5596 (Fcheck_coding_system (Vlocale_coding_system
), &coding
);
5597 coding
.mode
|= (CODING_MODE_SAFE_ENCODING
| CODING_MODE_LAST_BLOCK
);
5598 /* Disable composition/charset annotation. */
5599 coding
.common_flags
&= ~CODING_ANNOTATION_MASK
;
5600 coding
.dst_bytes
= SCHARS (string
) * 2;
5602 coding
.destination
= (unsigned char *) xmalloc (coding
.dst_bytes
);
5603 encode_coding_object (&coding
, string
, 0, 0,
5604 SCHARS (string
), SBYTES (string
), Qnil
);
5605 if (coding
.produced
>= LF_FACESIZE
)
5606 coding
.produced
= LF_FACESIZE
- 1;
5608 coding
.destination
[coding
.produced
] = '\0';
5610 strcpy (lplogfont
->lfFaceName
, coding
.destination
);
5611 xfree (coding
.destination
);
5615 lplogfont
->lfFaceName
[0] = '\0';
5620 lplogfont
->lfWeight
= x_to_w32_weight ((fields
> 0 ? weight
: ""));
5624 lplogfont
->lfItalic
= (fields
> 0 && slant
== 'i');
5628 if (fields
> 0 && pixels
[0] != '*')
5629 lplogfont
->lfHeight
= atoi (pixels
);
5633 if (fields
> 0 && resy
[0] != '*')
5636 if (tem
> 0) dpi
= tem
;
5639 if (fields
> -1 && lplogfont
->lfHeight
== 0 && height
[0] != '*')
5640 lplogfont
->lfHeight
= atoi (height
) * dpi
/ 720;
5645 lplogfont
->lfPitchAndFamily
= VARIABLE_PITCH
| FF_DONTCARE
;
5646 else if (pitch
== 'c')
5647 lplogfont
->lfPitchAndFamily
= FIXED_PITCH
| FF_DONTCARE
;
5652 if (fields
> 0 && width
[0] != '*')
5653 lplogfont
->lfWidth
= atoi (width
) / 10;
5657 /* Strip the trailing '-' if present. (it shouldn't be, as it
5658 fails the test against xlfd-tight-regexp in fontset.el). */
5660 int len
= strlen (remainder
);
5661 if (len
> 0 && remainder
[len
-1] == '-')
5662 remainder
[len
-1] = 0;
5664 encoding
= remainder
;
5666 if (strncmp (encoding
, "*-", 2) == 0)
5669 lplogfont
->lfCharSet
= x_to_w32_charset (encoding
);
5674 char name
[100], height
[10], width
[10], weight
[20];
5676 fields
= sscanf (lpxstr
,
5677 "%99[^:]:%9[^:]:%9[^:]:%19s",
5678 name
, height
, width
, weight
);
5680 if (fields
== EOF
) return (FALSE
);
5684 strncpy (lplogfont
->lfFaceName
,name
, LF_FACESIZE
);
5685 lplogfont
->lfFaceName
[LF_FACESIZE
-1] = 0;
5689 lplogfont
->lfFaceName
[0] = 0;
5695 lplogfont
->lfHeight
= atoi (height
);
5700 lplogfont
->lfWidth
= atoi (width
);
5704 lplogfont
->lfWeight
= x_to_w32_weight ((fields
> 0 ? weight
: ""));
5707 /* This makes TrueType fonts work better. */
5708 lplogfont
->lfHeight
= - eabs (lplogfont
->lfHeight
);
5713 /* Strip the pixel height and point height from the given xlfd, and
5714 return the pixel height. If no pixel height is specified, calculate
5715 one from the point height, or if that isn't defined either, return
5716 0 (which usually signifies a scalable font).
5719 xlfd_strip_height (char *fontname
)
5721 int pixel_height
, field_number
;
5722 char *read_from
, *write_to
;
5726 pixel_height
= field_number
= 0;
5729 /* Look for height fields. */
5730 for (read_from
= fontname
; *read_from
; read_from
++)
5732 if (*read_from
== '-')
5735 if (field_number
== 7) /* Pixel height. */
5738 write_to
= read_from
;
5740 /* Find end of field. */
5741 for (;*read_from
&& *read_from
!= '-'; read_from
++)
5744 /* Split the fontname at end of field. */
5750 pixel_height
= atoi (write_to
);
5751 /* Blank out field. */
5752 if (read_from
> write_to
)
5757 /* If the pixel height field is at the end (partial xlfd),
5760 return pixel_height
;
5762 /* If we got a pixel height, the point height can be
5763 ignored. Just blank it out and break now. */
5766 /* Find end of point size field. */
5767 for (; *read_from
&& *read_from
!= '-'; read_from
++)
5773 /* Blank out the point size field. */
5774 if (read_from
> write_to
)
5780 return pixel_height
;
5784 /* If the point height is already blank, break now. */
5785 if (*read_from
== '-')
5791 else if (field_number
== 8)
5793 /* If we didn't get a pixel height, try to get the point
5794 height and convert that. */
5796 char *point_size_start
= read_from
++;
5798 /* Find end of field. */
5799 for (; *read_from
&& *read_from
!= '-'; read_from
++)
5808 point_size
= atoi (point_size_start
);
5810 /* Convert to pixel height. */
5811 pixel_height
= point_size
5812 * one_w32_display_info
.height_in
/ 720;
5814 /* Blank out this field and break. */
5822 /* Shift the rest of the font spec into place. */
5823 if (write_to
&& read_from
> write_to
)
5825 for (; *read_from
; read_from
++, write_to
++)
5826 *write_to
= *read_from
;
5830 return pixel_height
;
5833 /* Assume parameter 1 is fully qualified, no wildcards. */
5835 w32_font_match (fontname
, pattern
)
5840 char *font_name_copy
;
5841 char *regex
= alloca (strlen (pattern
) * 2 + 3);
5843 font_name_copy
= alloca (strlen (fontname
) + 1);
5844 strcpy (font_name_copy
, fontname
);
5849 /* Turn pattern into a regexp and do a regexp match. */
5850 for (; *pattern
; pattern
++)
5852 if (*pattern
== '?')
5854 else if (*pattern
== '*')
5865 /* Strip out font heights and compare them seperately, since
5866 rounding error can cause mismatches. This also allows a
5867 comparison between a font that declares only a pixel height and a
5868 pattern that declares the point height.
5871 int font_height
, pattern_height
;
5873 font_height
= xlfd_strip_height (font_name_copy
);
5874 pattern_height
= xlfd_strip_height (regex
);
5876 /* Compare now, and don't bother doing expensive regexp matching
5877 if the heights differ. */
5878 if (font_height
&& pattern_height
&& (font_height
!= pattern_height
))
5882 return (fast_string_match_ignore_case (build_string (regex
),
5883 build_string(font_name_copy
)) >= 0);
5886 /* Callback functions, and a structure holding info they need, for
5887 listing system fonts on W32. We need one set of functions to do the
5888 job properly, but these don't work on NT 3.51 and earlier, so we
5889 have a second set which don't handle character sets properly to
5892 In both cases, there are two passes made. The first pass gets one
5893 font from each family, the second pass lists all the fonts from
5896 typedef struct enumfont_t
5901 XFontStruct
*size_ref
;
5902 Lisp_Object pattern
;
5908 enum_font_maybe_add_to_list (enumfont_t
*, LOGFONT
*, char *, Lisp_Object
);
5912 enum_font_cb2 (lplf
, lptm
, FontType
, lpef
)
5914 NEWTEXTMETRIC
* lptm
;
5918 /* Ignore struck out and underlined versions of fonts. */
5919 if (lplf
->elfLogFont
.lfStrikeOut
|| lplf
->elfLogFont
.lfUnderline
)
5922 /* Only return fonts with names starting with @ if they were
5923 explicitly specified, since Microsoft uses an initial @ to
5924 denote fonts for vertical writing, without providing a more
5925 convenient way of identifying them. */
5926 if (lplf
->elfLogFont
.lfFaceName
[0] == '@'
5927 && lpef
->logfont
.lfFaceName
[0] != '@')
5930 /* Check that the character set matches if it was specified */
5931 if (lpef
->logfont
.lfCharSet
!= DEFAULT_CHARSET
&&
5932 lplf
->elfLogFont
.lfCharSet
!= lpef
->logfont
.lfCharSet
)
5935 if (FontType
== RASTER_FONTTYPE
)
5937 /* DBCS raster fonts have problems displaying, so skip them. */
5938 int charset
= lplf
->elfLogFont
.lfCharSet
;
5939 if (charset
== SHIFTJIS_CHARSET
5940 || charset
== HANGEUL_CHARSET
5941 || charset
== CHINESEBIG5_CHARSET
5942 || charset
== GB2312_CHARSET
5943 #ifdef JOHAB_CHARSET
5944 || charset
== JOHAB_CHARSET
5952 Lisp_Object width
= Qnil
;
5953 Lisp_Object charset_list
= Qnil
;
5954 char *charset
= NULL
;
5956 /* Truetype fonts do not report their true metrics until loaded */
5957 if (FontType
!= RASTER_FONTTYPE
)
5959 if (!NILP (lpef
->pattern
))
5961 /* Scalable fonts are as big as you want them to be. */
5962 lplf
->elfLogFont
.lfHeight
= lpef
->logfont
.lfHeight
;
5963 lplf
->elfLogFont
.lfWidth
= lpef
->logfont
.lfWidth
;
5964 width
= make_number (lpef
->logfont
.lfWidth
);
5968 lplf
->elfLogFont
.lfHeight
= 0;
5969 lplf
->elfLogFont
.lfWidth
= 0;
5973 /* Make sure the height used here is the same as everywhere
5974 else (ie character height, not cell height). */
5975 if (lplf
->elfLogFont
.lfHeight
> 0)
5977 /* lptm can be trusted for RASTER fonts, but not scalable ones. */
5978 if (FontType
== RASTER_FONTTYPE
)
5979 lplf
->elfLogFont
.lfHeight
= lptm
->tmInternalLeading
- lptm
->tmHeight
;
5981 lplf
->elfLogFont
.lfHeight
= -lplf
->elfLogFont
.lfHeight
;
5984 if (!NILP (lpef
->pattern
))
5986 charset
= xlfd_charset_of_font (SDATA (lpef
->pattern
));
5988 /* We already checked charsets above, but DEFAULT_CHARSET
5989 slipped through. So only allow exact matches for DEFAULT_CHARSET. */
5991 && strncmp (charset
, "*-*", 3) != 0
5992 && lpef
->logfont
.lfCharSet
== DEFAULT_CHARSET
5993 && strcmp (charset
, w32_to_x_charset (DEFAULT_CHARSET
, NULL
)) != 0)
5998 charset_list
= Fcons (build_string (charset
), Qnil
);
6000 /* Always prefer unicode. */
6002 = Fcons (build_string ("iso10646-1"),
6003 w32_to_all_x_charsets (lplf
->elfLogFont
.lfCharSet
));
6005 /* Loop through the charsets. */
6006 for ( ; CONSP (charset_list
); charset_list
= Fcdr (charset_list
))
6008 Lisp_Object this_charset
= Fcar (charset_list
);
6009 charset
= SDATA (this_charset
);
6011 enum_font_maybe_add_to_list (lpef
, &(lplf
->elfLogFont
),
6014 /* List bold and italic variations if w32-enable-synthesized-fonts
6015 is non-nil and this is a plain font. */
6016 if (w32_enable_synthesized_fonts
6017 && lplf
->elfLogFont
.lfWeight
== FW_NORMAL
6018 && lplf
->elfLogFont
.lfItalic
== FALSE
)
6021 lplf
->elfLogFont
.lfWeight
= FW_BOLD
;
6022 enum_font_maybe_add_to_list (lpef
, &(lplf
->elfLogFont
),
6025 lplf
->elfLogFont
.lfItalic
= TRUE
;
6026 enum_font_maybe_add_to_list (lpef
, &(lplf
->elfLogFont
),
6029 lplf
->elfLogFont
.lfWeight
= FW_NORMAL
;
6030 enum_font_maybe_add_to_list (lpef
, &(lplf
->elfLogFont
),
6040 enum_font_maybe_add_to_list (lpef
, logfont
, match_charset
, width
)
6043 char * match_charset
;
6048 if (!w32_to_x_font (logfont
, buf
, 100, match_charset
))
6051 if (NILP (lpef
->pattern
)
6052 || w32_font_match (buf
, SDATA (lpef
->pattern
)))
6054 /* Check if we already listed this font. This may happen if
6055 w32_enable_synthesized_fonts is non-nil, and there are real
6056 bold and italic versions of the font. */
6057 Lisp_Object font_name
= build_string (buf
);
6058 if (NILP (Fmember (font_name
, lpef
->list
)))
6060 Lisp_Object entry
= Fcons (font_name
, width
);
6061 lpef
->list
= Fcons (entry
, lpef
->list
);
6069 enum_font_cb1 (lplf
, lptm
, FontType
, lpef
)
6071 NEWTEXTMETRIC
* lptm
;
6075 return EnumFontFamilies (lpef
->hdc
,
6076 lplf
->elfLogFont
.lfFaceName
,
6077 (FONTENUMPROC
) enum_font_cb2
,
6083 enum_fontex_cb2 (lplf
, lptm
, font_type
, lpef
)
6084 ENUMLOGFONTEX
* lplf
;
6085 NEWTEXTMETRICEX
* lptm
;
6089 /* We are not interested in the extra info we get back from the 'Ex
6090 version - only the fact that we get character set variations
6091 enumerated seperately. */
6092 return enum_font_cb2 ((ENUMLOGFONT
*) lplf
, (NEWTEXTMETRIC
*) lptm
,
6097 enum_fontex_cb1 (lplf
, lptm
, font_type
, lpef
)
6098 ENUMLOGFONTEX
* lplf
;
6099 NEWTEXTMETRICEX
* lptm
;
6103 HMODULE gdi32
= GetModuleHandle ("gdi32.dll");
6104 FARPROC enum_font_families_ex
6105 = GetProcAddress ( gdi32
, "EnumFontFamiliesExA");
6106 /* We don't really expect EnumFontFamiliesEx to disappear once we
6107 get here, so don't bother handling it gracefully. */
6108 if (enum_font_families_ex
== NULL
)
6109 error ("gdi32.dll has disappeared!");
6110 return enum_font_families_ex (lpef
->hdc
,
6112 (FONTENUMPROC
) enum_fontex_cb2
,
6116 /* Interface to fontset handler. (adapted from mw32font.c in Meadow
6117 and xterm.c in Emacs 20.3) */
6119 static Lisp_Object
w32_list_bdf_fonts (Lisp_Object pattern
, int max_names
)
6121 char *fontname
, *ptnstr
;
6122 Lisp_Object list
, tem
, newlist
= Qnil
;
6125 list
= Vw32_bdf_filename_alist
;
6126 ptnstr
= SDATA (pattern
);
6128 for ( ; CONSP (list
); list
= XCDR (list
))
6132 fontname
= SDATA (XCAR (tem
));
6133 else if (STRINGP (tem
))
6134 fontname
= SDATA (tem
);
6138 if (w32_font_match (fontname
, ptnstr
))
6140 newlist
= Fcons (XCAR (tem
), newlist
);
6142 if (max_names
>= 0 && n_fonts
>= max_names
)
6151 /* Return a list of names of available fonts matching PATTERN on frame
6152 F. If SIZE is not 0, it is the size (maximum bound width) of fonts
6153 to be listed. Frame F NULL means we have not yet created any
6154 frame, which means we can't get proper size info, as we don't have
6155 a device context to use for GetTextMetrics.
6156 MAXNAMES sets a limit on how many fonts to match. If MAXNAMES is
6157 negative, then all matching fonts are returned. */
6160 w32_list_fonts (f
, pattern
, size
, maxnames
)
6162 Lisp_Object pattern
;
6166 Lisp_Object patterns
, key
= Qnil
, tem
, tpat
;
6167 Lisp_Object list
= Qnil
, newlist
= Qnil
, second_best
= Qnil
;
6168 struct w32_display_info
*dpyinfo
= &one_w32_display_info
;
6171 patterns
= Fassoc (pattern
, Valternate_fontname_alist
);
6172 if (NILP (patterns
))
6173 patterns
= Fcons (pattern
, Qnil
);
6175 for (; CONSP (patterns
); patterns
= XCDR (patterns
))
6180 tpat
= XCAR (patterns
);
6182 if (!STRINGP (tpat
))
6185 /* Avoid expensive EnumFontFamilies functions if we are not
6186 going to be able to output one of these anyway. */
6187 codepage
= w32_codepage_for_font (SDATA (tpat
));
6188 if (codepage
!= CP_8BIT
&& codepage
!= CP_UNICODE
6189 && codepage
!= CP_DEFAULT
&& codepage
!= CP_UNKNOWN
6190 && !IsValidCodePage(codepage
))
6193 /* See if we cached the result for this particular query.
6194 The cache is an alist of the form:
6195 ((PATTERN (FONTNAME . WIDTH) ...) ...)
6197 if (tem
= XCDR (dpyinfo
->name_list_element
),
6198 !NILP (list
= Fassoc (tpat
, tem
)))
6200 list
= Fcdr_safe (list
);
6201 /* We have a cached list. Don't have to get the list again. */
6206 /* At first, put PATTERN in the cache. */
6211 /* Use EnumFontFamiliesEx where it is available, as it knows
6212 about character sets. Fall back to EnumFontFamilies for
6213 older versions of NT that don't support the 'Ex function. */
6214 x_to_w32_font (SDATA (tpat
), &ef
.logfont
);
6216 LOGFONT font_match_pattern
;
6217 HMODULE gdi32
= GetModuleHandle ("gdi32.dll");
6218 FARPROC enum_font_families_ex
6219 = GetProcAddress ( gdi32
, "EnumFontFamiliesExA");
6221 /* We do our own pattern matching so we can handle wildcards. */
6222 font_match_pattern
.lfFaceName
[0] = 0;
6223 font_match_pattern
.lfPitchAndFamily
= 0;
6224 /* We can use the charset, because if it is a wildcard it will
6225 be DEFAULT_CHARSET anyway. */
6226 font_match_pattern
.lfCharSet
= ef
.logfont
.lfCharSet
;
6228 ef
.hdc
= GetDC (dpyinfo
->root_window
);
6230 if (enum_font_families_ex
)
6231 enum_font_families_ex (ef
.hdc
,
6232 &font_match_pattern
,
6233 (FONTENUMPROC
) enum_fontex_cb1
,
6236 EnumFontFamilies (ef
.hdc
, NULL
, (FONTENUMPROC
) enum_font_cb1
,
6239 ReleaseDC (dpyinfo
->root_window
, ef
.hdc
);
6245 /* Make a list of the fonts we got back.
6246 Store that in the font cache for the display. */
6247 XSETCDR (dpyinfo
->name_list_element
,
6248 Fcons (Fcons (tpat
, list
),
6249 XCDR (dpyinfo
->name_list_element
)));
6252 if (NILP (list
)) continue; /* Try the remaining alternatives. */
6254 newlist
= second_best
= Qnil
;
6256 /* Make a list of the fonts that have the right width. */
6257 for (; CONSP (list
); list
= XCDR (list
))
6264 if (NILP (XCAR (tem
)))
6268 newlist
= Fcons (XCAR (tem
), newlist
);
6270 if (maxnames
>= 0 && n_fonts
>= maxnames
)
6275 if (!INTEGERP (XCDR (tem
)))
6277 /* Since we don't yet know the size of the font, we must
6278 load it and try GetTextMetrics. */
6279 W32FontStruct thisinfo
;
6284 if (!x_to_w32_font (SDATA (XCAR (tem
)), &lf
))
6288 thisinfo
.bdf
= NULL
;
6289 thisinfo
.hfont
= CreateFontIndirect (&lf
);
6290 if (thisinfo
.hfont
== NULL
)
6293 hdc
= GetDC (dpyinfo
->root_window
);
6294 oldobj
= SelectObject (hdc
, thisinfo
.hfont
);
6295 if (GetTextMetrics (hdc
, &thisinfo
.tm
))
6296 XSETCDR (tem
, make_number (FONT_AVG_WIDTH (&thisinfo
)));
6298 XSETCDR (tem
, make_number (0));
6299 SelectObject (hdc
, oldobj
);
6300 ReleaseDC (dpyinfo
->root_window
, hdc
);
6301 DeleteObject(thisinfo
.hfont
);
6304 found_size
= XINT (XCDR (tem
));
6305 if (found_size
== size
)
6307 newlist
= Fcons (XCAR (tem
), newlist
);
6309 if (maxnames
>= 0 && n_fonts
>= maxnames
)
6312 /* keep track of the closest matching size in case
6313 no exact match is found. */
6314 else if (found_size
> 0)
6316 if (NILP (second_best
))
6319 else if (found_size
< size
)
6321 if (XINT (XCDR (second_best
)) > size
6322 || XINT (XCDR (second_best
)) < found_size
)
6327 if (XINT (XCDR (second_best
)) > size
6328 && XINT (XCDR (second_best
)) >
6335 if (!NILP (newlist
))
6337 else if (!NILP (second_best
))
6339 newlist
= Fcons (XCAR (second_best
), Qnil
);
6344 /* Include any bdf fonts. */
6345 if (n_fonts
< maxnames
|| maxnames
< 0)
6347 Lisp_Object combined
[2];
6348 combined
[0] = w32_list_bdf_fonts (pattern
, maxnames
- n_fonts
);
6349 combined
[1] = newlist
;
6350 newlist
= Fnconc(2, combined
);
6357 /* Return a pointer to struct font_info of font FONT_IDX of frame F. */
6359 w32_get_font_info (f
, font_idx
)
6363 return (FRAME_W32_FONT_TABLE (f
) + font_idx
);
6368 w32_query_font (struct frame
*f
, char *fontname
)
6371 struct font_info
*pfi
;
6373 pfi
= FRAME_W32_FONT_TABLE (f
);
6375 for (i
= 0; i
< one_w32_display_info
.n_fonts
;i
++, pfi
++)
6377 if (stricmp(pfi
->name
, fontname
) == 0) return pfi
;
6383 /* Find a CCL program for a font specified by FONTP, and set the member
6384 `encoder' of the structure. */
6387 w32_find_ccl_program (fontp
)
6388 struct font_info
*fontp
;
6390 Lisp_Object list
, elt
;
6392 for (list
= Vfont_ccl_encoder_alist
; CONSP (list
); list
= XCDR (list
))
6396 && STRINGP (XCAR (elt
))
6397 && (fast_c_string_match_ignore_case (XCAR (elt
), fontp
->name
)
6403 struct ccl_program
*ccl
6404 = (struct ccl_program
*) xmalloc (sizeof (struct ccl_program
));
6406 if (setup_ccl_program (ccl
, XCDR (elt
)) < 0)
6409 fontp
->font_encoder
= ccl
;
6413 /* directory-files from dired.c. */
6414 Lisp_Object Fdirectory_files
P_((Lisp_Object
, Lisp_Object
, Lisp_Object
, Lisp_Object
));
6417 /* Find BDF files in a specified directory. (use GCPRO when calling,
6418 as this calls lisp to get a directory listing). */
6420 w32_find_bdf_fonts_in_dir (Lisp_Object directory
)
6422 Lisp_Object filelist
, list
= Qnil
;
6425 if (!STRINGP(directory
))
6428 filelist
= Fdirectory_files (directory
, Qt
,
6429 build_string (".*\\.[bB][dD][fF]"), Qt
);
6431 for ( ; CONSP(filelist
); filelist
= XCDR (filelist
))
6433 Lisp_Object filename
= XCAR (filelist
);
6434 if (w32_BDF_to_x_font (SDATA (filename
), fontname
, 100))
6435 store_in_alist (&list
, build_string (fontname
), filename
);
6440 DEFUN ("w32-find-bdf-fonts", Fw32_find_bdf_fonts
, Sw32_find_bdf_fonts
,
6442 doc
: /* Return a list of BDF fonts in DIRECTORY.
6443 The list is suitable for appending to `w32-bdf-filename-alist'.
6444 Fonts which do not contain an xlfd description will not be included
6445 in the list. DIRECTORY may be a list of directories. */)
6447 Lisp_Object directory
;
6449 Lisp_Object list
= Qnil
;
6450 struct gcpro gcpro1
, gcpro2
;
6452 if (!CONSP (directory
))
6453 return w32_find_bdf_fonts_in_dir (directory
);
6455 for ( ; CONSP (directory
); directory
= XCDR (directory
))
6457 Lisp_Object pair
[2];
6460 GCPRO2 (directory
, list
);
6461 pair
[1] = w32_find_bdf_fonts_in_dir( XCAR (directory
) );
6462 list
= Fnconc( 2, pair
);
6469 DEFUN ("xw-color-defined-p", Fxw_color_defined_p
, Sxw_color_defined_p
, 1, 2, 0,
6470 doc
: /* Internal function called by `color-defined-p', which see. */)
6472 Lisp_Object color
, frame
;
6475 FRAME_PTR f
= check_x_frame (frame
);
6477 CHECK_STRING (color
);
6479 if (w32_defined_color (f
, SDATA (color
), &foo
, 0))
6485 DEFUN ("xw-color-values", Fxw_color_values
, Sxw_color_values
, 1, 2, 0,
6486 doc
: /* Internal function called by `color-values', which see. */)
6488 Lisp_Object color
, frame
;
6491 FRAME_PTR f
= check_x_frame (frame
);
6493 CHECK_STRING (color
);
6495 if (w32_defined_color (f
, SDATA (color
), &foo
, 0))
6496 return list3 (make_number ((GetRValue (foo
.pixel
) << 8)
6497 | GetRValue (foo
.pixel
)),
6498 make_number ((GetGValue (foo
.pixel
) << 8)
6499 | GetGValue (foo
.pixel
)),
6500 make_number ((GetBValue (foo
.pixel
) << 8)
6501 | GetBValue (foo
.pixel
)));
6506 DEFUN ("xw-display-color-p", Fxw_display_color_p
, Sxw_display_color_p
, 0, 1, 0,
6507 doc
: /* Internal function called by `display-color-p', which see. */)
6509 Lisp_Object display
;
6511 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6513 if ((dpyinfo
->n_planes
* dpyinfo
->n_cbits
) <= 2)
6519 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
,
6520 Sx_display_grayscale_p
, 0, 1, 0,
6521 doc
: /* Return t if DISPLAY supports shades of gray.
6522 Note that color displays do support shades of gray.
6523 The optional argument DISPLAY specifies which display to ask about.
6524 DISPLAY should be either a frame or a display name (a string).
6525 If omitted or nil, that stands for the selected frame's display. */)
6527 Lisp_Object display
;
6529 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6531 if ((dpyinfo
->n_planes
* dpyinfo
->n_cbits
) <= 1)
6537 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
,
6538 Sx_display_pixel_width
, 0, 1, 0,
6539 doc
: /* Returns the width in pixels of DISPLAY.
6540 The optional argument DISPLAY specifies which display to ask about.
6541 DISPLAY should be either a frame or a display name (a string).
6542 If omitted or nil, that stands for the selected frame's display. */)
6544 Lisp_Object display
;
6546 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6548 return make_number (dpyinfo
->width
);
6551 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
6552 Sx_display_pixel_height
, 0, 1, 0,
6553 doc
: /* Returns the height in pixels of DISPLAY.
6554 The optional argument DISPLAY specifies which display to ask about.
6555 DISPLAY should be either a frame or a display name (a string).
6556 If omitted or nil, that stands for the selected frame's display. */)
6558 Lisp_Object display
;
6560 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6562 return make_number (dpyinfo
->height
);
6565 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
6567 doc
: /* Returns the number of bitplanes of DISPLAY.
6568 The optional argument DISPLAY specifies which display to ask about.
6569 DISPLAY should be either a frame or a display name (a string).
6570 If omitted or nil, that stands for the selected frame's display. */)
6572 Lisp_Object display
;
6574 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6576 return make_number (dpyinfo
->n_planes
* dpyinfo
->n_cbits
);
6579 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
6581 doc
: /* Returns the number of color cells of DISPLAY.
6582 The optional argument DISPLAY specifies which display to ask about.
6583 DISPLAY should be either a frame or a display name (a string).
6584 If omitted or nil, that stands for the selected frame's display. */)
6586 Lisp_Object display
;
6588 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6592 hdc
= GetDC (dpyinfo
->root_window
);
6593 if (dpyinfo
->has_palette
)
6594 cap
= GetDeviceCaps (hdc
, SIZEPALETTE
);
6596 cap
= GetDeviceCaps (hdc
, NUMCOLORS
);
6598 /* We force 24+ bit depths to 24-bit, both to prevent an overflow
6599 and because probably is more meaningful on Windows anyway */
6601 cap
= 1 << min(dpyinfo
->n_planes
* dpyinfo
->n_cbits
, 24);
6603 ReleaseDC (dpyinfo
->root_window
, hdc
);
6605 return make_number (cap
);
6608 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
6609 Sx_server_max_request_size
,
6611 doc
: /* Returns the maximum request size of the server of DISPLAY.
6612 The optional argument DISPLAY specifies which display to ask about.
6613 DISPLAY should be either a frame or a display name (a string).
6614 If omitted or nil, that stands for the selected frame's display. */)
6616 Lisp_Object display
;
6618 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6620 return make_number (1);
6623 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
6624 doc
: /* Returns the "vendor ID" string of the W32 system (Microsoft).
6625 The optional argument DISPLAY specifies which display to ask about.
6626 DISPLAY should be either a frame or a display name (a string).
6627 If omitted or nil, that stands for the selected frame's display. */)
6629 Lisp_Object display
;
6631 return build_string ("Microsoft Corp.");
6634 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
6635 doc
: /* Returns the version numbers of the server of DISPLAY.
6636 The value is a list of three integers: the major and minor
6637 version numbers of the X Protocol in use, and the distributor-specific release
6638 number. See also the function `x-server-vendor'.
6640 The optional argument DISPLAY specifies which display to ask about.
6641 DISPLAY should be either a frame or a display name (a string).
6642 If omitted or nil, that stands for the selected frame's display. */)
6644 Lisp_Object display
;
6646 return Fcons (make_number (w32_major_version
),
6647 Fcons (make_number (w32_minor_version
),
6648 Fcons (make_number (w32_build_number
), Qnil
)));
6651 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
6652 doc
: /* Returns the number of screens on the server of DISPLAY.
6653 The optional argument DISPLAY specifies which display to ask about.
6654 DISPLAY should be either a frame or a display name (a string).
6655 If omitted or nil, that stands for the selected frame's display. */)
6657 Lisp_Object display
;
6659 return make_number (1);
6662 DEFUN ("x-display-mm-height", Fx_display_mm_height
,
6663 Sx_display_mm_height
, 0, 1, 0,
6664 doc
: /* Returns the height in millimeters of DISPLAY.
6665 The optional argument DISPLAY specifies which display to ask about.
6666 DISPLAY should be either a frame or a display name (a string).
6667 If omitted or nil, that stands for the selected frame's display. */)
6669 Lisp_Object display
;
6671 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6675 hdc
= GetDC (dpyinfo
->root_window
);
6677 cap
= GetDeviceCaps (hdc
, VERTSIZE
);
6679 ReleaseDC (dpyinfo
->root_window
, hdc
);
6681 return make_number (cap
);
6684 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
6685 doc
: /* Returns the width in millimeters of DISPLAY.
6686 The optional argument DISPLAY specifies which display to ask about.
6687 DISPLAY should be either a frame or a display name (a string).
6688 If omitted or nil, that stands for the selected frame's display. */)
6690 Lisp_Object display
;
6692 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6697 hdc
= GetDC (dpyinfo
->root_window
);
6699 cap
= GetDeviceCaps (hdc
, HORZSIZE
);
6701 ReleaseDC (dpyinfo
->root_window
, hdc
);
6703 return make_number (cap
);
6706 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
6707 Sx_display_backing_store
, 0, 1, 0,
6708 doc
: /* Returns an indication of whether DISPLAY does backing store.
6709 The value may be `always', `when-mapped', or `not-useful'.
6710 The optional argument DISPLAY specifies which display to ask about.
6711 DISPLAY should be either a frame or a display name (a string).
6712 If omitted or nil, that stands for the selected frame's display. */)
6714 Lisp_Object display
;
6716 return intern ("not-useful");
6719 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
6720 Sx_display_visual_class
, 0, 1, 0,
6721 doc
: /* Returns the visual class of DISPLAY.
6722 The value is one of the symbols `static-gray', `gray-scale',
6723 `static-color', `pseudo-color', `true-color', or `direct-color'.
6725 The optional argument DISPLAY specifies which display to ask about.
6726 DISPLAY should be either a frame or a display name (a string).
6727 If omitted or nil, that stands for the selected frame's display. */)
6729 Lisp_Object display
;
6731 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6732 Lisp_Object result
= Qnil
;
6734 if (dpyinfo
->has_palette
)
6735 result
= intern ("pseudo-color");
6736 else if (dpyinfo
->n_planes
* dpyinfo
->n_cbits
== 1)
6737 result
= intern ("static-grey");
6738 else if (dpyinfo
->n_planes
* dpyinfo
->n_cbits
== 4)
6739 result
= intern ("static-color");
6740 else if (dpyinfo
->n_planes
* dpyinfo
->n_cbits
> 8)
6741 result
= intern ("true-color");
6746 DEFUN ("x-display-save-under", Fx_display_save_under
,
6747 Sx_display_save_under
, 0, 1, 0,
6748 doc
: /* Returns t if DISPLAY supports the save-under feature.
6749 The optional argument DISPLAY specifies which display to ask about.
6750 DISPLAY should be either a frame or a display name (a string).
6751 If omitted or nil, that stands for the selected frame's display. */)
6753 Lisp_Object display
;
6760 register struct frame
*f
;
6762 return FRAME_PIXEL_WIDTH (f
);
6767 register struct frame
*f
;
6769 return FRAME_PIXEL_HEIGHT (f
);
6774 register struct frame
*f
;
6776 return FRAME_COLUMN_WIDTH (f
);
6781 register struct frame
*f
;
6783 return FRAME_LINE_HEIGHT (f
);
6788 register struct frame
*f
;
6790 return FRAME_W32_DISPLAY_INFO (f
)->n_planes
;
6793 /* Return the display structure for the display named NAME.
6794 Open a new connection if necessary. */
6796 struct w32_display_info
*
6797 x_display_info_for_name (name
)
6801 struct w32_display_info
*dpyinfo
;
6803 CHECK_STRING (name
);
6805 for (dpyinfo
= &one_w32_display_info
, names
= w32_display_name_list
;
6807 dpyinfo
= dpyinfo
->next
, names
= XCDR (names
))
6810 tem
= Fstring_equal (XCAR (XCAR (names
)), name
);
6815 /* Use this general default value to start with. */
6816 Vx_resource_name
= Vinvocation_name
;
6818 validate_x_resource_name ();
6820 dpyinfo
= w32_term_init (name
, (unsigned char *)0,
6821 (char *) SDATA (Vx_resource_name
));
6824 error ("Cannot connect to server %s", SDATA (name
));
6827 XSETFASTINT (Vwindow_system_version
, 3);
6832 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
6833 1, 3, 0, doc
: /* Open a connection to a server.
6834 DISPLAY is the name of the display to connect to.
6835 Optional second arg XRM-STRING is a string of resources in xrdb format.
6836 If the optional third arg MUST-SUCCEED is non-nil,
6837 terminate Emacs if we can't open the connection. */)
6838 (display
, xrm_string
, must_succeed
)
6839 Lisp_Object display
, xrm_string
, must_succeed
;
6841 unsigned char *xrm_option
;
6842 struct w32_display_info
*dpyinfo
;
6844 /* If initialization has already been done, return now to avoid
6845 overwriting critical parts of one_w32_display_info. */
6849 CHECK_STRING (display
);
6850 if (! NILP (xrm_string
))
6851 CHECK_STRING (xrm_string
);
6854 if (! EQ (Vwindow_system
, intern ("w32")))
6855 error ("Not using Microsoft Windows");
6858 /* Allow color mapping to be defined externally; first look in user's
6859 HOME directory, then in Emacs etc dir for a file called rgb.txt. */
6861 Lisp_Object color_file
;
6862 struct gcpro gcpro1
;
6864 color_file
= build_string("~/rgb.txt");
6866 GCPRO1 (color_file
);
6868 if (NILP (Ffile_readable_p (color_file
)))
6870 Fexpand_file_name (build_string ("rgb.txt"),
6871 Fsymbol_value (intern ("data-directory")));
6873 Vw32_color_map
= Fw32_load_color_file (color_file
);
6877 if (NILP (Vw32_color_map
))
6878 Vw32_color_map
= Fw32_default_color_map ();
6880 /* Merge in system logical colors. */
6881 add_system_logical_colors_to_map (&Vw32_color_map
);
6883 if (! NILP (xrm_string
))
6884 xrm_option
= (unsigned char *) SDATA (xrm_string
);
6886 xrm_option
= (unsigned char *) 0;
6888 /* Use this general default value to start with. */
6889 /* First remove .exe suffix from invocation-name - it looks ugly. */
6891 char basename
[ MAX_PATH
], *str
;
6893 strcpy (basename
, SDATA (Vinvocation_name
));
6894 str
= strrchr (basename
, '.');
6896 Vinvocation_name
= build_string (basename
);
6898 Vx_resource_name
= Vinvocation_name
;
6900 validate_x_resource_name ();
6902 /* This is what opens the connection and sets x_current_display.
6903 This also initializes many symbols, such as those used for input. */
6904 dpyinfo
= w32_term_init (display
, xrm_option
,
6905 (char *) SDATA (Vx_resource_name
));
6909 if (!NILP (must_succeed
))
6910 fatal ("Cannot connect to server %s.\n",
6913 error ("Cannot connect to server %s", SDATA (display
));
6918 XSETFASTINT (Vwindow_system_version
, 3);
6922 DEFUN ("x-close-connection", Fx_close_connection
,
6923 Sx_close_connection
, 1, 1, 0,
6924 doc
: /* Close the connection to DISPLAY's server.
6925 For DISPLAY, specify either a frame or a display name (a string).
6926 If DISPLAY is nil, that stands for the selected frame's display. */)
6928 Lisp_Object display
;
6930 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6933 if (dpyinfo
->reference_count
> 0)
6934 error ("Display still has frames on it");
6937 /* Free the fonts in the font table. */
6938 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
6939 if (dpyinfo
->font_table
[i
].name
)
6941 if (dpyinfo
->font_table
[i
].name
!= dpyinfo
->font_table
[i
].full_name
)
6942 xfree (dpyinfo
->font_table
[i
].full_name
);
6943 xfree (dpyinfo
->font_table
[i
].name
);
6944 w32_unload_font (dpyinfo
, dpyinfo
->font_table
[i
].font
);
6946 x_destroy_all_bitmaps (dpyinfo
);
6948 x_delete_display (dpyinfo
);
6954 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
6955 doc
: /* Return the list of display names that Emacs has connections to. */)
6958 Lisp_Object tail
, result
;
6961 for (tail
= w32_display_name_list
; ! NILP (tail
); tail
= XCDR (tail
))
6962 result
= Fcons (XCAR (XCAR (tail
)), result
);
6967 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
6968 doc
: /* This is a noop on W32 systems. */)
6970 Lisp_Object display
, on
;
6977 /***********************************************************************
6979 ***********************************************************************/
6981 DEFUN ("x-change-window-property", Fx_change_window_property
,
6982 Sx_change_window_property
, 2, 6, 0,
6983 doc
: /* Change window property PROP to VALUE on the X window of FRAME.
6984 VALUE may be a string or a list of conses, numbers and/or strings.
6985 If an element in the list is a string, it is converted to
6986 an Atom and the value of the Atom is used. If an element is a cons,
6987 it is converted to a 32 bit number where the car is the 16 top bits and the
6988 cdr is the lower 16 bits.
6989 FRAME nil or omitted means use the selected frame.
6990 If TYPE is given and non-nil, it is the name of the type of VALUE.
6991 If TYPE is not given or nil, the type is STRING.
6992 FORMAT gives the size in bits of each element if VALUE is a list.
6993 It must be one of 8, 16 or 32.
6994 If VALUE is a string or FORMAT is nil or not given, FORMAT defaults to 8.
6995 If OUTER_P is non-nil, the property is changed for the outer X window of
6996 FRAME. Default is to change on the edit X window.
6999 (prop
, value
, frame
, type
, format
, outer_p
)
7000 Lisp_Object prop
, value
, frame
, type
, format
, outer_p
;
7002 #if 0 /* TODO : port window properties to W32 */
7003 struct frame
*f
= check_x_frame (frame
);
7006 CHECK_STRING (prop
);
7007 CHECK_STRING (value
);
7010 prop_atom
= XInternAtom (FRAME_W32_DISPLAY (f
), SDATA (prop
), False
);
7011 XChangeProperty (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
7012 prop_atom
, XA_STRING
, 8, PropModeReplace
,
7013 SDATA (value
), SCHARS (value
));
7015 /* Make sure the property is set when we return. */
7016 XFlush (FRAME_W32_DISPLAY (f
));
7025 DEFUN ("x-delete-window-property", Fx_delete_window_property
,
7026 Sx_delete_window_property
, 1, 2, 0,
7027 doc
: /* Remove window property PROP from X window of FRAME.
7028 FRAME nil or omitted means use the selected frame. Value is PROP. */)
7030 Lisp_Object prop
, frame
;
7032 #if 0 /* TODO : port window properties to W32 */
7034 struct frame
*f
= check_x_frame (frame
);
7037 CHECK_STRING (prop
);
7039 prop_atom
= XInternAtom (FRAME_W32_DISPLAY (f
), SDATA (prop
), False
);
7040 XDeleteProperty (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
), prop_atom
);
7042 /* Make sure the property is removed when we return. */
7043 XFlush (FRAME_W32_DISPLAY (f
));
7051 DEFUN ("x-window-property", Fx_window_property
, Sx_window_property
,
7053 doc
: /* Value is the value of window property PROP on FRAME.
7054 If FRAME is nil or omitted, use the selected frame. Value is nil
7055 if FRAME hasn't a property with name PROP or if PROP has no string
7058 Lisp_Object prop
, frame
;
7060 #if 0 /* TODO : port window properties to W32 */
7062 struct frame
*f
= check_x_frame (frame
);
7065 Lisp_Object prop_value
= Qnil
;
7066 char *tmp_data
= NULL
;
7069 unsigned long actual_size
, bytes_remaining
;
7071 CHECK_STRING (prop
);
7073 prop_atom
= XInternAtom (FRAME_W32_DISPLAY (f
), SDATA (prop
), False
);
7074 rc
= XGetWindowProperty (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
7075 prop_atom
, 0, 0, False
, XA_STRING
,
7076 &actual_type
, &actual_format
, &actual_size
,
7077 &bytes_remaining
, (unsigned char **) &tmp_data
);
7080 int size
= bytes_remaining
;
7085 rc
= XGetWindowProperty (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
7086 prop_atom
, 0, bytes_remaining
,
7088 &actual_type
, &actual_format
,
7089 &actual_size
, &bytes_remaining
,
7090 (unsigned char **) &tmp_data
);
7092 prop_value
= make_string (tmp_data
, size
);
7107 /***********************************************************************
7109 ***********************************************************************/
7111 /* If non-null, an asynchronous timer that, when it expires, displays
7112 an hourglass cursor on all frames. */
7114 static struct atimer
*hourglass_atimer
;
7116 /* Non-zero means an hourglass cursor is currently shown. */
7118 static int hourglass_shown_p
;
7120 /* Number of seconds to wait before displaying an hourglass cursor. */
7122 static Lisp_Object Vhourglass_delay
;
7124 /* Default number of seconds to wait before displaying an hourglass
7127 #define DEFAULT_HOURGLASS_DELAY 1
7129 /* Function prototypes. */
7131 static void show_hourglass
P_ ((struct atimer
*));
7132 static void hide_hourglass
P_ ((void));
7135 /* Cancel a currently active hourglass timer, and start a new one. */
7140 #if 0 /* TODO: cursor shape changes. */
7142 int secs
, usecs
= 0;
7144 cancel_hourglass ();
7146 if (INTEGERP (Vhourglass_delay
)
7147 && XINT (Vhourglass_delay
) > 0)
7148 secs
= XFASTINT (Vhourglass_delay
);
7149 else if (FLOATP (Vhourglass_delay
)
7150 && XFLOAT_DATA (Vhourglass_delay
) > 0)
7153 tem
= Ftruncate (Vhourglass_delay
, Qnil
);
7154 secs
= XFASTINT (tem
);
7155 usecs
= (XFLOAT_DATA (Vhourglass_delay
) - secs
) * 1000000;
7158 secs
= DEFAULT_HOURGLASS_DELAY
;
7160 EMACS_SET_SECS_USECS (delay
, secs
, usecs
);
7161 hourglass_atimer
= start_atimer (ATIMER_RELATIVE
, delay
,
7162 show_hourglass
, NULL
);
7167 /* Cancel the hourglass cursor timer if active, hide an hourglass
7173 if (hourglass_atimer
)
7175 cancel_atimer (hourglass_atimer
);
7176 hourglass_atimer
= NULL
;
7179 if (hourglass_shown_p
)
7184 /* Timer function of hourglass_atimer. TIMER is equal to
7187 Display an hourglass cursor on all frames by mapping the frames'
7188 hourglass_window. Set the hourglass_p flag in the frames'
7189 output_data.x structure to indicate that an hourglass cursor is
7190 shown on the frames. */
7193 show_hourglass (timer
)
7194 struct atimer
*timer
;
7196 #if 0 /* TODO: cursor shape changes. */
7197 /* The timer implementation will cancel this timer automatically
7198 after this function has run. Set hourglass_atimer to null
7199 so that we know the timer doesn't have to be canceled. */
7200 hourglass_atimer
= NULL
;
7202 if (!hourglass_shown_p
)
7204 Lisp_Object rest
, frame
;
7208 FOR_EACH_FRAME (rest
, frame
)
7209 if (FRAME_W32_P (XFRAME (frame
)))
7211 struct frame
*f
= XFRAME (frame
);
7213 f
->output_data
.w32
->hourglass_p
= 1;
7215 if (!f
->output_data
.w32
->hourglass_window
)
7217 unsigned long mask
= CWCursor
;
7218 XSetWindowAttributes attrs
;
7220 attrs
.cursor
= f
->output_data
.w32
->hourglass_cursor
;
7222 f
->output_data
.w32
->hourglass_window
7223 = XCreateWindow (FRAME_X_DISPLAY (f
),
7224 FRAME_OUTER_WINDOW (f
),
7225 0, 0, 32000, 32000, 0, 0,
7231 XMapRaised (FRAME_X_DISPLAY (f
),
7232 f
->output_data
.w32
->hourglass_window
);
7233 XFlush (FRAME_X_DISPLAY (f
));
7236 hourglass_shown_p
= 1;
7243 /* Hide the hourglass cursor on all frames, if it is currently shown. */
7248 #if 0 /* TODO: cursor shape changes. */
7249 if (hourglass_shown_p
)
7251 Lisp_Object rest
, frame
;
7254 FOR_EACH_FRAME (rest
, frame
)
7256 struct frame
*f
= XFRAME (frame
);
7259 /* Watch out for newly created frames. */
7260 && f
->output_data
.x
->hourglass_window
)
7262 XUnmapWindow (FRAME_X_DISPLAY (f
),
7263 f
->output_data
.x
->hourglass_window
);
7264 /* Sync here because XTread_socket looks at the
7265 hourglass_p flag that is reset to zero below. */
7266 XSync (FRAME_X_DISPLAY (f
), False
);
7267 f
->output_data
.x
->hourglass_p
= 0;
7271 hourglass_shown_p
= 0;
7279 /***********************************************************************
7281 ***********************************************************************/
7283 static Lisp_Object x_create_tip_frame
P_ ((struct w32_display_info
*,
7284 Lisp_Object
, Lisp_Object
));
7285 static void compute_tip_xy
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
7286 Lisp_Object
, int, int, int *, int *));
7288 /* The frame of a currently visible tooltip. */
7290 Lisp_Object tip_frame
;
7292 /* If non-nil, a timer started that hides the last tooltip when it
7295 Lisp_Object tip_timer
;
7298 /* If non-nil, a vector of 3 elements containing the last args
7299 with which x-show-tip was called. See there. */
7301 Lisp_Object last_show_tip_args
;
7303 /* Maximum size for tooltips; a cons (COLUMNS . ROWS). */
7305 Lisp_Object Vx_max_tooltip_size
;
7309 unwind_create_tip_frame (frame
)
7312 Lisp_Object deleted
;
7314 deleted
= unwind_create_frame (frame
);
7315 if (EQ (deleted
, Qt
))
7325 /* Create a frame for a tooltip on the display described by DPYINFO.
7326 PARMS is a list of frame parameters. TEXT is the string to
7327 display in the tip frame. Value is the frame.
7329 Note that functions called here, esp. x_default_parameter can
7330 signal errors, for instance when a specified color name is
7331 undefined. We have to make sure that we're in a consistent state
7332 when this happens. */
7335 x_create_tip_frame (dpyinfo
, parms
, text
)
7336 struct w32_display_info
*dpyinfo
;
7337 Lisp_Object parms
, text
;
7340 Lisp_Object frame
, tem
;
7342 long window_prompting
= 0;
7344 int count
= SPECPDL_INDEX ();
7345 struct gcpro gcpro1
, gcpro2
, gcpro3
;
7347 int face_change_count_before
= face_change_count
;
7349 struct buffer
*old_buffer
;
7353 /* Use this general default value to start with until we know if
7354 this frame has a specified name. */
7355 Vx_resource_name
= Vinvocation_name
;
7358 kb
= dpyinfo
->terminal
->kboard
;
7360 kb
= &the_only_kboard
;
7363 /* Get the name of the frame to use for resource lookup. */
7364 name
= w32_get_arg (parms
, Qname
, "name", "Name", RES_TYPE_STRING
);
7366 && !EQ (name
, Qunbound
)
7368 error ("Invalid frame name--not a string or nil");
7369 Vx_resource_name
= name
;
7372 GCPRO3 (parms
, name
, frame
);
7373 /* Make a frame without minibuffer nor mode-line. */
7375 f
->wants_modeline
= 0;
7376 XSETFRAME (frame
, f
);
7378 buffer
= Fget_buffer_create (build_string (" *tip*"));
7379 Fset_window_buffer (FRAME_ROOT_WINDOW (f
), buffer
, Qnil
);
7380 old_buffer
= current_buffer
;
7381 set_buffer_internal_1 (XBUFFER (buffer
));
7382 current_buffer
->truncate_lines
= Qnil
;
7383 specbind (Qinhibit_read_only
, Qt
);
7384 specbind (Qinhibit_modification_hooks
, Qt
);
7387 set_buffer_internal_1 (old_buffer
);
7389 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 0;
7390 record_unwind_protect (unwind_create_tip_frame
, frame
);
7392 /* By setting the output method, we're essentially saying that
7393 the frame is live, as per FRAME_LIVE_P. If we get a signal
7394 from this point on, x_destroy_window might screw up reference
7396 f
->terminal
= dpyinfo
->terminal
;
7397 f
->terminal
->reference_count
++;
7398 f
->output_method
= output_w32
;
7399 f
->output_data
.w32
=
7400 (struct w32_output
*) xmalloc (sizeof (struct w32_output
));
7401 bzero (f
->output_data
.w32
, sizeof (struct w32_output
));
7403 FRAME_FONTSET (f
) = -1;
7404 f
->icon_name
= Qnil
;
7406 #if 0 /* GLYPH_DEBUG TODO: image support. */
7407 image_cache_refcount
= FRAME_X_IMAGE_CACHE (f
)->refcount
;
7408 dpyinfo_refcount
= dpyinfo
->reference_count
;
7409 #endif /* GLYPH_DEBUG */
7411 FRAME_KBOARD (f
) = kb
;
7413 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
7414 f
->output_data
.w32
->explicit_parent
= 0;
7416 /* Set the name; the functions to which we pass f expect the name to
7418 if (EQ (name
, Qunbound
) || NILP (name
))
7420 f
->name
= build_string (dpyinfo
->w32_id_name
);
7421 f
->explicit_name
= 0;
7426 f
->explicit_name
= 1;
7427 /* use the frame's title when getting resources for this frame. */
7428 specbind (Qx_resource_name
, name
);
7431 f
->resx
= dpyinfo
->resx
;
7432 f
->resy
= dpyinfo
->resy
;
7434 #ifdef USE_FONT_BACKEND
7435 if (enable_font_backend
)
7437 /* Perhaps, we must allow frame parameter, say `font-backend',
7438 to specify which font backends to use. */
7439 register_font_driver (&w32font_driver
, f
);
7441 x_default_parameter (f
, parms
, Qfont_backend
, Qnil
,
7442 "fontBackend", "FontBackend", RES_TYPE_STRING
);
7444 #endif /* USE_FONT_BACKEND */
7446 /* Extract the window parameters from the supplied values
7447 that are needed to determine window geometry. */
7448 #ifdef USE_FONT_BACKEND
7449 if (enable_font_backend
)
7450 x_default_font_parameter (f
, parms
);
7452 #endif /* USE_FONT_BACKEND */
7456 font
= w32_get_arg (parms
, Qfont
, "font", "Font", RES_TYPE_STRING
);
7459 /* First, try whatever font the caller has specified. */
7462 tem
= Fquery_fontset (font
, Qnil
);
7464 font
= x_new_fontset (f
, tem
);
7466 font
= x_new_font (f
, SDATA (font
));
7469 /* Try out a font which we hope has bold and italic variations. */
7470 if (!STRINGP (font
))
7471 font
= x_new_font (f
, "-*-Courier New-normal-r-*-*-*-100-*-*-c-*-iso8859-1");
7472 if (! STRINGP (font
))
7473 font
= x_new_font (f
, "-*-Courier-normal-r-*-*-13-*-*-*-c-*-iso8859-1");
7474 /* If those didn't work, look for something which will at least work. */
7475 if (! STRINGP (font
))
7476 font
= x_new_font (f
, "-*-Fixedsys-normal-r-*-*-12-*-*-*-c-*-iso8859-1");
7478 if (! STRINGP (font
))
7479 font
= build_string ("Fixedsys");
7481 x_default_parameter (f
, parms
, Qfont
, font
,
7482 "font", "Font", RES_TYPE_STRING
);
7485 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
7486 "borderWidth", "BorderWidth", RES_TYPE_NUMBER
);
7487 /* This defaults to 2 in order to match xterm. We recognize either
7488 internalBorderWidth or internalBorder (which is what xterm calls
7490 if (NILP (Fassq (Qinternal_border_width
, parms
)))
7494 value
= w32_get_arg (parms
, Qinternal_border_width
,
7495 "internalBorder", "internalBorder", RES_TYPE_NUMBER
);
7496 if (! EQ (value
, Qunbound
))
7497 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
7500 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (1),
7501 "internalBorderWidth", "internalBorderWidth",
7504 /* Also do the stuff which must be set before the window exists. */
7505 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
7506 "foreground", "Foreground", RES_TYPE_STRING
);
7507 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
7508 "background", "Background", RES_TYPE_STRING
);
7509 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
7510 "pointerColor", "Foreground", RES_TYPE_STRING
);
7511 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
7512 "cursorColor", "Foreground", RES_TYPE_STRING
);
7513 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
7514 "borderColor", "BorderColor", RES_TYPE_STRING
);
7516 /* Init faces before x_default_parameter is called for scroll-bar
7517 parameters because that function calls x_set_scroll_bar_width,
7518 which calls change_frame_size, which calls Fset_window_buffer,
7519 which runs hooks, which call Fvertical_motion. At the end, we
7520 end up in init_iterator with a null face cache, which should not
7522 init_frame_faces (f
);
7524 f
->output_data
.w32
->dwStyle
= WS_BORDER
| WS_POPUP
| WS_DISABLED
;
7525 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
7527 window_prompting
= x_figure_window_size (f
, parms
, 0);
7529 /* No fringes on tip frame. */
7531 f
->left_fringe_width
= 0;
7532 f
->right_fringe_width
= 0;
7535 my_create_tip_window (f
);
7540 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
7541 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
7542 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
7543 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN
);
7544 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
7545 "cursorType", "CursorType", RES_TYPE_SYMBOL
);
7547 /* Dimensions, especially FRAME_LINES (f), must be done via change_frame_size.
7548 Change will not be effected unless different from the current
7550 width
= FRAME_COLS (f
);
7551 height
= FRAME_LINES (f
);
7552 FRAME_LINES (f
) = 0;
7553 SET_FRAME_COLS (f
, 0);
7554 change_frame_size (f
, height
, width
, 1, 0, 0);
7556 /* Add `tooltip' frame parameter's default value. */
7557 if (NILP (Fframe_parameter (frame
, intern ("tooltip"))))
7558 Fmodify_frame_parameters (frame
, Fcons (Fcons (intern ("tooltip"), Qt
),
7561 /* Set up faces after all frame parameters are known. This call
7562 also merges in face attributes specified for new frames.
7564 Frame parameters may be changed if .Xdefaults contains
7565 specifications for the default font. For example, if there is an
7566 `Emacs.default.attributeBackground: pink', the `background-color'
7567 attribute of the frame get's set, which let's the internal border
7568 of the tooltip frame appear in pink. Prevent this. */
7570 Lisp_Object bg
= Fframe_parameter (frame
, Qbackground_color
);
7572 /* Set tip_frame here, so that */
7574 call1 (Qface_set_after_frame_default
, frame
);
7576 if (!EQ (bg
, Fframe_parameter (frame
, Qbackground_color
)))
7577 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qbackground_color
, bg
),
7581 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qwindow_system
, Qw32
), Qnil
));
7587 /* It is now ok to make the frame official even if we get an error
7588 below. And the frame needs to be on Vframe_list or making it
7589 visible won't work. */
7590 Vframe_list
= Fcons (frame
, Vframe_list
);
7592 /* Now that the frame is official, it counts as a reference to
7594 FRAME_W32_DISPLAY_INFO (f
)->reference_count
++;
7596 /* Setting attributes of faces of the tooltip frame from resources
7597 and similar will increment face_change_count, which leads to the
7598 clearing of all current matrices. Since this isn't necessary
7599 here, avoid it by resetting face_change_count to the value it
7600 had before we created the tip frame. */
7601 face_change_count
= face_change_count_before
;
7603 /* Discard the unwind_protect. */
7604 return unbind_to (count
, frame
);
7608 /* Compute where to display tip frame F. PARMS is the list of frame
7609 parameters for F. DX and DY are specified offsets from the current
7610 location of the mouse. WIDTH and HEIGHT are the width and height
7611 of the tooltip. Return coordinates relative to the root window of
7612 the display in *ROOT_X, and *ROOT_Y. */
7615 compute_tip_xy (f
, parms
, dx
, dy
, width
, height
, root_x
, root_y
)
7617 Lisp_Object parms
, dx
, dy
;
7619 int *root_x
, *root_y
;
7621 Lisp_Object left
, top
;
7623 /* User-specified position? */
7624 left
= Fcdr (Fassq (Qleft
, parms
));
7625 top
= Fcdr (Fassq (Qtop
, parms
));
7627 /* Move the tooltip window where the mouse pointer is. Resize and
7629 if (!INTEGERP (left
) || !INTEGERP (top
))
7641 *root_y
= XINT (top
);
7642 else if (*root_y
+ XINT (dy
) <= 0)
7643 *root_y
= 0; /* Can happen for negative dy */
7644 else if (*root_y
+ XINT (dy
) + height
<= FRAME_W32_DISPLAY_INFO (f
)->height
)
7645 /* It fits below the pointer */
7646 *root_y
+= XINT (dy
);
7647 else if (height
+ XINT (dy
) <= *root_y
)
7648 /* It fits above the pointer. */
7649 *root_y
-= height
+ XINT (dy
);
7651 /* Put it on the top. */
7654 if (INTEGERP (left
))
7655 *root_x
= XINT (left
);
7656 else if (*root_x
+ XINT (dx
) <= 0)
7657 *root_x
= 0; /* Can happen for negative dx */
7658 else if (*root_x
+ XINT (dx
) + width
<= FRAME_W32_DISPLAY_INFO (f
)->width
)
7659 /* It fits to the right of the pointer. */
7660 *root_x
+= XINT (dx
);
7661 else if (width
+ XINT (dx
) <= *root_x
)
7662 /* It fits to the left of the pointer. */
7663 *root_x
-= width
+ XINT (dx
);
7665 /* Put it left justified on the screen -- it ought to fit that way. */
7670 DEFUN ("x-show-tip", Fx_show_tip
, Sx_show_tip
, 1, 6, 0,
7671 doc
: /* Show STRING in a \"tooltip\" window on frame FRAME.
7672 A tooltip window is a small window displaying a string.
7674 This is an internal function; Lisp code should call `tooltip-show'.
7676 FRAME nil or omitted means use the selected frame.
7678 PARMS is an optional list of frame parameters which can be
7679 used to change the tooltip's appearance.
7681 Automatically hide the tooltip after TIMEOUT seconds. TIMEOUT nil
7682 means use the default timeout of 5 seconds.
7684 If the list of frame parameters PARMS contains a `left' parameter,
7685 the tooltip is displayed at that x-position. Otherwise it is
7686 displayed at the mouse position, with offset DX added (default is 5 if
7687 DX isn't specified). Likewise for the y-position; if a `top' frame
7688 parameter is specified, it determines the y-position of the tooltip
7689 window, otherwise it is displayed at the mouse position, with offset
7690 DY added (default is -10).
7692 A tooltip's maximum size is specified by `x-max-tooltip-size'.
7693 Text larger than the specified size is clipped. */)
7694 (string
, frame
, parms
, timeout
, dx
, dy
)
7695 Lisp_Object string
, frame
, parms
, timeout
, dx
, dy
;
7700 struct buffer
*old_buffer
;
7701 struct text_pos pos
;
7702 int i
, width
, height
;
7703 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
7704 int old_windows_or_buffers_changed
= windows_or_buffers_changed
;
7705 int count
= SPECPDL_INDEX ();
7707 specbind (Qinhibit_redisplay
, Qt
);
7709 GCPRO4 (string
, parms
, frame
, timeout
);
7711 CHECK_STRING (string
);
7712 f
= check_x_frame (frame
);
7714 timeout
= make_number (5);
7716 CHECK_NATNUM (timeout
);
7719 dx
= make_number (5);
7724 dy
= make_number (-10);
7728 if (NILP (last_show_tip_args
))
7729 last_show_tip_args
= Fmake_vector (make_number (3), Qnil
);
7731 if (!NILP (tip_frame
))
7733 Lisp_Object last_string
= AREF (last_show_tip_args
, 0);
7734 Lisp_Object last_frame
= AREF (last_show_tip_args
, 1);
7735 Lisp_Object last_parms
= AREF (last_show_tip_args
, 2);
7737 if (EQ (frame
, last_frame
)
7738 && !NILP (Fequal (last_string
, string
))
7739 && !NILP (Fequal (last_parms
, parms
)))
7741 struct frame
*f
= XFRAME (tip_frame
);
7743 /* Only DX and DY have changed. */
7744 if (!NILP (tip_timer
))
7746 Lisp_Object timer
= tip_timer
;
7748 call1 (Qcancel_timer
, timer
);
7752 compute_tip_xy (f
, parms
, dx
, dy
, FRAME_PIXEL_WIDTH (f
),
7753 FRAME_PIXEL_HEIGHT (f
), &root_x
, &root_y
);
7755 /* Put tooltip in topmost group and in position. */
7756 SetWindowPos (FRAME_W32_WINDOW (f
), HWND_TOPMOST
,
7757 root_x
, root_y
, 0, 0,
7758 SWP_NOSIZE
| SWP_NOACTIVATE
);
7760 /* Ensure tooltip is on top of other topmost windows (eg menus). */
7761 SetWindowPos (FRAME_W32_WINDOW (f
), HWND_TOP
,
7763 SWP_NOMOVE
| SWP_NOSIZE
| SWP_NOACTIVATE
);
7770 /* Hide a previous tip, if any. */
7773 ASET (last_show_tip_args
, 0, string
);
7774 ASET (last_show_tip_args
, 1, frame
);
7775 ASET (last_show_tip_args
, 2, parms
);
7777 /* Add default values to frame parameters. */
7778 if (NILP (Fassq (Qname
, parms
)))
7779 parms
= Fcons (Fcons (Qname
, build_string ("tooltip")), parms
);
7780 if (NILP (Fassq (Qinternal_border_width
, parms
)))
7781 parms
= Fcons (Fcons (Qinternal_border_width
, make_number (3)), parms
);
7782 if (NILP (Fassq (Qborder_width
, parms
)))
7783 parms
= Fcons (Fcons (Qborder_width
, make_number (1)), parms
);
7784 if (NILP (Fassq (Qborder_color
, parms
)))
7785 parms
= Fcons (Fcons (Qborder_color
, build_string ("lightyellow")), parms
);
7786 if (NILP (Fassq (Qbackground_color
, parms
)))
7787 parms
= Fcons (Fcons (Qbackground_color
, build_string ("lightyellow")),
7790 /* Block input until the tip has been fully drawn, to avoid crashes
7791 when drawing tips in menus. */
7794 /* Create a frame for the tooltip, and record it in the global
7795 variable tip_frame. */
7796 frame
= x_create_tip_frame (FRAME_W32_DISPLAY_INFO (f
), parms
, string
);
7799 /* Set up the frame's root window. */
7800 w
= XWINDOW (FRAME_ROOT_WINDOW (f
));
7801 w
->left_col
= w
->top_line
= make_number (0);
7803 if (CONSP (Vx_max_tooltip_size
)
7804 && INTEGERP (XCAR (Vx_max_tooltip_size
))
7805 && XINT (XCAR (Vx_max_tooltip_size
)) > 0
7806 && INTEGERP (XCDR (Vx_max_tooltip_size
))
7807 && XINT (XCDR (Vx_max_tooltip_size
)) > 0)
7809 w
->total_cols
= XCAR (Vx_max_tooltip_size
);
7810 w
->total_lines
= XCDR (Vx_max_tooltip_size
);
7814 w
->total_cols
= make_number (80);
7815 w
->total_lines
= make_number (40);
7818 FRAME_TOTAL_COLS (f
) = XINT (w
->total_cols
);
7820 w
->pseudo_window_p
= 1;
7822 /* Display the tooltip text in a temporary buffer. */
7823 old_buffer
= current_buffer
;
7824 set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f
))->buffer
));
7825 current_buffer
->truncate_lines
= Qnil
;
7826 clear_glyph_matrix (w
->desired_matrix
);
7827 clear_glyph_matrix (w
->current_matrix
);
7828 SET_TEXT_POS (pos
, BEGV
, BEGV_BYTE
);
7829 try_window (FRAME_ROOT_WINDOW (f
), pos
, 0);
7831 /* Compute width and height of the tooltip. */
7833 for (i
= 0; i
< w
->desired_matrix
->nrows
; ++i
)
7835 struct glyph_row
*row
= &w
->desired_matrix
->rows
[i
];
7839 /* Stop at the first empty row at the end. */
7840 if (!row
->enabled_p
|| !row
->displays_text_p
)
7843 /* Let the row go over the full width of the frame. */
7844 row
->full_width_p
= 1;
7846 #ifdef TODO /* Investigate why some fonts need more width than is
7847 calculated for some tooltips. */
7848 /* There's a glyph at the end of rows that is use to place
7849 the cursor there. Don't include the width of this glyph. */
7850 if (row
->used
[TEXT_AREA
])
7852 last
= &row
->glyphs
[TEXT_AREA
][row
->used
[TEXT_AREA
] - 1];
7853 row_width
= row
->pixel_width
- last
->pixel_width
;
7857 row_width
= row
->pixel_width
;
7859 /* TODO: find why tips do not draw along baseline as instructed. */
7860 height
+= row
->height
;
7861 width
= max (width
, row_width
);
7864 /* Add the frame's internal border to the width and height the X
7865 window should have. */
7866 height
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
7867 width
+= 2 * FRAME_INTERNAL_BORDER_WIDTH (f
);
7869 /* Move the tooltip window where the mouse pointer is. Resize and
7871 compute_tip_xy (f
, parms
, dx
, dy
, width
, height
, &root_x
, &root_y
);
7874 /* Adjust Window size to take border into account. */
7876 rect
.left
= rect
.top
= 0;
7878 rect
.bottom
= height
;
7879 AdjustWindowRect (&rect
, f
->output_data
.w32
->dwStyle
,
7880 FRAME_EXTERNAL_MENU_BAR (f
));
7882 /* Position and size tooltip, and put it in the topmost group.
7883 The add-on of 3 to the 5th argument is a kludge: without it,
7884 some fonts cause the last character of the tip to be truncated,
7885 for some obscure reason. */
7886 SetWindowPos (FRAME_W32_WINDOW (f
), HWND_TOPMOST
,
7887 root_x
, root_y
, rect
.right
- rect
.left
+ 3,
7888 rect
.bottom
- rect
.top
, SWP_NOACTIVATE
);
7890 /* Ensure tooltip is on top of other topmost windows (eg menus). */
7891 SetWindowPos (FRAME_W32_WINDOW (f
), HWND_TOP
,
7893 SWP_NOMOVE
| SWP_NOSIZE
| SWP_NOACTIVATE
);
7895 /* Let redisplay know that we have made the frame visible already. */
7896 f
->async_visible
= 1;
7898 ShowWindow (FRAME_W32_WINDOW (f
), SW_SHOWNOACTIVATE
);
7901 /* Draw into the window. */
7902 w
->must_be_updated_p
= 1;
7903 update_single_window (w
, 1);
7907 /* Restore original current buffer. */
7908 set_buffer_internal_1 (old_buffer
);
7909 windows_or_buffers_changed
= old_windows_or_buffers_changed
;
7912 /* Let the tip disappear after timeout seconds. */
7913 tip_timer
= call3 (intern ("run-at-time"), timeout
, Qnil
,
7914 intern ("x-hide-tip"));
7917 return unbind_to (count
, Qnil
);
7921 DEFUN ("x-hide-tip", Fx_hide_tip
, Sx_hide_tip
, 0, 0, 0,
7922 doc
: /* Hide the current tooltip window, if there is any.
7923 Value is t if tooltip was open, nil otherwise. */)
7927 Lisp_Object deleted
, frame
, timer
;
7928 struct gcpro gcpro1
, gcpro2
;
7930 /* Return quickly if nothing to do. */
7931 if (NILP (tip_timer
) && NILP (tip_frame
))
7936 GCPRO2 (frame
, timer
);
7937 tip_frame
= tip_timer
= deleted
= Qnil
;
7939 count
= SPECPDL_INDEX ();
7940 specbind (Qinhibit_redisplay
, Qt
);
7941 specbind (Qinhibit_quit
, Qt
);
7944 call1 (Qcancel_timer
, timer
);
7948 Fdelete_frame (frame
, Qnil
);
7953 return unbind_to (count
, deleted
);
7958 /***********************************************************************
7959 File selection dialog
7960 ***********************************************************************/
7961 extern Lisp_Object Qfile_name_history
;
7963 /* Callback for altering the behaviour of the Open File dialog.
7964 Makes the Filename text field contain "Current Directory" and be
7965 read-only when "Directories" is selected in the filter. This
7966 allows us to work around the fact that the standard Open File
7967 dialog does not support directories. */
7969 file_dialog_callback (hwnd
, msg
, wParam
, lParam
)
7975 if (msg
== WM_NOTIFY
)
7977 OFNOTIFY
* notify
= (OFNOTIFY
*)lParam
;
7978 /* Detect when the Filter dropdown is changed. */
7979 if (notify
->hdr
.code
== CDN_TYPECHANGE
7980 || notify
->hdr
.code
== CDN_INITDONE
)
7982 HWND dialog
= GetParent (hwnd
);
7983 HWND edit_control
= GetDlgItem (dialog
, FILE_NAME_TEXT_FIELD
);
7985 /* Directories is in index 2. */
7986 if (notify
->lpOFN
->nFilterIndex
== 2)
7988 CommDlg_OpenSave_SetControlText (dialog
, FILE_NAME_TEXT_FIELD
,
7989 "Current Directory");
7990 EnableWindow (edit_control
, FALSE
);
7994 /* Don't override default filename on init done. */
7995 if (notify
->hdr
.code
== CDN_TYPECHANGE
)
7996 CommDlg_OpenSave_SetControlText (dialog
,
7997 FILE_NAME_TEXT_FIELD
, "");
7998 EnableWindow (edit_control
, TRUE
);
8005 /* Since we compile with _WIN32_WINNT set to 0x0400 (for NT4 compatibility)
8006 we end up with the old file dialogs. Define a big enough struct for the
8007 new dialog to trick GetOpenFileName into giving us the new dialogs on
8008 Windows 2000 and XP. */
8011 OPENFILENAME real_details
;
8018 DEFUN ("x-file-dialog", Fx_file_dialog
, Sx_file_dialog
, 2, 5, 0,
8019 doc
: /* Read file name, prompting with PROMPT in directory DIR.
8020 Use a file selection dialog.
8021 Select DEFAULT-FILENAME in the dialog's file selection box, if
8022 specified. Ensure that file exists if MUSTMATCH is non-nil.
8023 If ONLY-DIR-P is non-nil, the user can only select directories. */)
8024 (prompt
, dir
, default_filename
, mustmatch
, only_dir_p
)
8025 Lisp_Object prompt
, dir
, default_filename
, mustmatch
, only_dir_p
;
8027 struct frame
*f
= SELECTED_FRAME ();
8028 Lisp_Object file
= Qnil
;
8029 int count
= SPECPDL_INDEX ();
8030 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
, gcpro6
;
8031 char filename
[MAX_PATH
+ 1];
8032 char init_dir
[MAX_PATH
+ 1];
8033 int default_filter_index
= 1; /* 1: All Files, 2: Directories only */
8035 GCPRO6 (prompt
, dir
, default_filename
, mustmatch
, only_dir_p
, file
);
8036 CHECK_STRING (prompt
);
8039 /* Create the dialog with PROMPT as title, using DIR as initial
8040 directory and using "*" as pattern. */
8041 dir
= Fexpand_file_name (dir
, Qnil
);
8042 strncpy (init_dir
, SDATA (ENCODE_FILE (dir
)), MAX_PATH
);
8043 init_dir
[MAX_PATH
] = '\0';
8044 unixtodos_filename (init_dir
);
8046 if (STRINGP (default_filename
))
8048 char *file_name_only
;
8049 char *full_path_name
= SDATA (ENCODE_FILE (default_filename
));
8051 unixtodos_filename (full_path_name
);
8053 file_name_only
= strrchr (full_path_name
, '\\');
8054 if (!file_name_only
)
8055 file_name_only
= full_path_name
;
8059 strncpy (filename
, file_name_only
, MAX_PATH
);
8060 filename
[MAX_PATH
] = '\0';
8066 NEWOPENFILENAME new_file_details
;
8067 BOOL file_opened
= FALSE
;
8068 OPENFILENAME
* file_details
= &new_file_details
.real_details
;
8070 /* Prevent redisplay. */
8071 specbind (Qinhibit_redisplay
, Qt
);
8074 bzero (&new_file_details
, sizeof (new_file_details
));
8075 /* Apparently NT4 crashes if you give it an unexpected size.
8076 I'm not sure about Windows 9x, so play it safe. */
8077 if (w32_major_version
> 4 && w32_major_version
< 95)
8078 file_details
->lStructSize
= sizeof (NEWOPENFILENAME
);
8080 file_details
->lStructSize
= sizeof (OPENFILENAME
);
8082 file_details
->hwndOwner
= FRAME_W32_WINDOW (f
);
8083 /* Undocumented Bug in Common File Dialog:
8084 If a filter is not specified, shell links are not resolved. */
8085 file_details
->lpstrFilter
= "All Files (*.*)\0*.*\0Directories\0*|*\0\0";
8086 file_details
->lpstrFile
= filename
;
8087 file_details
->nMaxFile
= sizeof (filename
);
8088 file_details
->lpstrInitialDir
= init_dir
;
8089 file_details
->lpstrTitle
= SDATA (prompt
);
8091 if (! NILP (only_dir_p
))
8092 default_filter_index
= 2;
8094 file_details
->nFilterIndex
= default_filter_index
;
8096 file_details
->Flags
= (OFN_HIDEREADONLY
| OFN_NOCHANGEDIR
8097 | OFN_EXPLORER
| OFN_ENABLEHOOK
);
8098 if (!NILP (mustmatch
))
8100 /* Require that the path to the parent directory exists. */
8101 file_details
->Flags
|= OFN_PATHMUSTEXIST
;
8102 /* If we are looking for a file, require that it exists. */
8103 if (NILP (only_dir_p
))
8104 file_details
->Flags
|= OFN_FILEMUSTEXIST
;
8107 file_details
->lpfnHook
= (LPOFNHOOKPROC
) file_dialog_callback
;
8109 file_opened
= GetOpenFileName (file_details
);
8115 dostounix_filename (filename
);
8117 if (file_details
->nFilterIndex
== 2)
8119 /* "Directories" selected - strip dummy file name. */
8120 char * last
= strrchr (filename
, '/');
8124 file
= DECODE_FILE(build_string (filename
));
8126 /* User cancelled the dialog without making a selection. */
8127 else if (!CommDlgExtendedError ())
8129 /* An error occurred, fallback on reading from the mini-buffer. */
8131 file
= Fcompleting_read (prompt
, intern ("read-file-name-internal"),
8132 dir
, mustmatch
, dir
, Qfile_name_history
,
8133 default_filename
, Qnil
);
8135 file
= unbind_to (count
, file
);
8140 /* Make "Cancel" equivalent to C-g. */
8142 Fsignal (Qquit
, Qnil
);
8144 return unbind_to (count
, file
);
8149 /***********************************************************************
8150 w32 specialized functions
8151 ***********************************************************************/
8153 DEFUN ("w32-select-font", Fw32_select_font
, Sw32_select_font
, 0, 2, 0,
8154 doc
: /* Select a font for the named FRAME using the W32 font dialog.
8155 Returns an X-style font string corresponding to the selection.
8157 If FRAME is omitted or nil, it defaults to the selected frame.
8158 If INCLUDE-PROPORTIONAL is non-nil, include proportional fonts
8159 in the font selection dialog. */)
8160 (frame
, include_proportional
)
8161 Lisp_Object frame
, include_proportional
;
8163 FRAME_PTR f
= check_x_frame (frame
);
8171 bzero (&cf
, sizeof (cf
));
8172 bzero (&lf
, sizeof (lf
));
8174 cf
.lStructSize
= sizeof (cf
);
8175 cf
.hwndOwner
= FRAME_W32_WINDOW (f
);
8176 cf
.Flags
= CF_FORCEFONTEXIST
| CF_SCREENFONTS
| CF_NOVERTFONTS
;
8178 /* Unless include_proportional is non-nil, limit the selection to
8179 monospaced fonts. */
8180 if (NILP (include_proportional
))
8181 cf
.Flags
|= CF_FIXEDPITCHONLY
;
8185 /* Initialize as much of the font details as we can from the current
8187 hdc
= GetDC (FRAME_W32_WINDOW (f
));
8188 oldobj
= SelectObject (hdc
, FRAME_FONT (f
)->hfont
);
8189 GetTextFace (hdc
, LF_FACESIZE
, lf
.lfFaceName
);
8190 if (GetTextMetrics (hdc
, &tm
))
8192 lf
.lfHeight
= tm
.tmInternalLeading
- tm
.tmHeight
;
8193 lf
.lfWeight
= tm
.tmWeight
;
8194 lf
.lfItalic
= tm
.tmItalic
;
8195 lf
.lfUnderline
= tm
.tmUnderlined
;
8196 lf
.lfStrikeOut
= tm
.tmStruckOut
;
8197 lf
.lfCharSet
= tm
.tmCharSet
;
8198 cf
.Flags
|= CF_INITTOLOGFONTSTRUCT
;
8200 SelectObject (hdc
, oldobj
);
8201 ReleaseDC (FRAME_W32_WINDOW (f
), hdc
);
8203 if (!ChooseFont (&cf
) || !w32_to_x_font (&lf
, buf
, 100, NULL
))
8206 return build_string (buf
);
8209 DEFUN ("w32-send-sys-command", Fw32_send_sys_command
,
8210 Sw32_send_sys_command
, 1, 2, 0,
8211 doc
: /* Send frame a Windows WM_SYSCOMMAND message of type COMMAND.
8212 Some useful values for COMMAND are #xf030 to maximize frame (#xf020
8213 to minimize), #xf120 to restore frame to original size, and #xf100
8214 to activate the menubar for keyboard access. #xf140 activates the
8215 screen saver if defined.
8217 If optional parameter FRAME is not specified, use selected frame. */)
8219 Lisp_Object command
, frame
;
8221 FRAME_PTR f
= check_x_frame (frame
);
8223 CHECK_NUMBER (command
);
8225 PostMessage (FRAME_W32_WINDOW (f
), WM_SYSCOMMAND
, XINT (command
), 0);
8230 DEFUN ("w32-shell-execute", Fw32_shell_execute
, Sw32_shell_execute
, 2, 4, 0,
8231 doc
: /* Get Windows to perform OPERATION on DOCUMENT.
8232 This is a wrapper around the ShellExecute system function, which
8233 invokes the application registered to handle OPERATION for DOCUMENT.
8235 OPERATION is either nil or a string that names a supported operation.
8236 What operations can be used depends on the particular DOCUMENT and its
8237 handler application, but typically it is one of the following common
8240 \"open\" - open DOCUMENT, which could be a file, a directory, or an
8241 executable program. If it is an application, that
8242 application is launched in the current buffer's default
8243 directory. Otherwise, the application associated with
8244 DOCUMENT is launched in the buffer's default directory.
8245 \"print\" - print DOCUMENT, which must be a file
8246 \"explore\" - start the Windows Explorer on DOCUMENT
8247 \"edit\" - launch an editor and open DOCUMENT for editing; which
8248 editor is launched depends on the association for the
8250 \"find\" - initiate search starting from DOCUMENT which must specify
8252 nil - invoke the default OPERATION, or \"open\" if default is
8253 not defined or unavailable
8255 DOCUMENT is typically the name of a document file or a URL, but can
8256 also be a program executable to run, or a directory to open in the
8259 If DOCUMENT is a program executable, the optional arg PARAMETERS can
8260 be a string containing command line parameters that will be passed to
8261 the program; otherwise, PARAMETERS should be nil or unspecified.
8263 Second optional argument SHOW-FLAG can be used to control how the
8264 application will be displayed when it is invoked. If SHOW-FLAG is nil
8265 or unspceified, the application is displayed normally, otherwise it is
8266 an integer representing a ShowWindow flag:
8271 6 - start minimized */)
8272 (operation
, document
, parameters
, show_flag
)
8273 Lisp_Object operation
, document
, parameters
, show_flag
;
8275 Lisp_Object current_dir
;
8277 CHECK_STRING (document
);
8279 /* Encode filename and current directory. */
8280 current_dir
= ENCODE_FILE (current_buffer
->directory
);
8281 document
= ENCODE_FILE (document
);
8282 if ((int) ShellExecute (NULL
,
8283 (STRINGP (operation
) ?
8284 SDATA (operation
) : NULL
),
8286 (STRINGP (parameters
) ?
8287 SDATA (parameters
) : NULL
),
8288 SDATA (current_dir
),
8289 (INTEGERP (show_flag
) ?
8290 XINT (show_flag
) : SW_SHOWDEFAULT
))
8293 error ("ShellExecute failed: %s", w32_strerror (0));
8296 /* Lookup virtual keycode from string representing the name of a
8297 non-ascii keystroke into the corresponding virtual key, using
8298 lispy_function_keys. */
8300 lookup_vk_code (char *key
)
8304 for (i
= 0; i
< 256; i
++)
8305 if (lispy_function_keys
[i
] != 0
8306 && strcmp (lispy_function_keys
[i
], key
) == 0)
8312 /* Convert a one-element vector style key sequence to a hot key
8315 w32_parse_hot_key (key
)
8318 /* Copied from Fdefine_key and store_in_keymap. */
8319 register Lisp_Object c
;
8323 struct gcpro gcpro1
;
8327 if (XFASTINT (Flength (key
)) != 1)
8332 c
= Faref (key
, make_number (0));
8334 if (CONSP (c
) && lucid_event_type_list_p (c
))
8335 c
= Fevent_convert_list (c
);
8339 if (! INTEGERP (c
) && ! SYMBOLP (c
))
8340 error ("Key definition is invalid");
8342 /* Work out the base key and the modifiers. */
8345 c
= parse_modifiers (c
);
8346 lisp_modifiers
= XINT (Fcar (Fcdr (c
)));
8350 vk_code
= lookup_vk_code (SDATA (SYMBOL_NAME (c
)));
8352 else if (INTEGERP (c
))
8354 lisp_modifiers
= XINT (c
) & ~CHARACTERBITS
;
8355 /* Many ascii characters are their own virtual key code. */
8356 vk_code
= XINT (c
) & CHARACTERBITS
;
8359 if (vk_code
< 0 || vk_code
> 255)
8362 if ((lisp_modifiers
& meta_modifier
) != 0
8363 && !NILP (Vw32_alt_is_meta
))
8364 lisp_modifiers
|= alt_modifier
;
8366 /* Supply defs missing from mingw32. */
8368 #define MOD_ALT 0x0001
8369 #define MOD_CONTROL 0x0002
8370 #define MOD_SHIFT 0x0004
8371 #define MOD_WIN 0x0008
8374 /* Convert lisp modifiers to Windows hot-key form. */
8375 w32_modifiers
= (lisp_modifiers
& hyper_modifier
) ? MOD_WIN
: 0;
8376 w32_modifiers
|= (lisp_modifiers
& alt_modifier
) ? MOD_ALT
: 0;
8377 w32_modifiers
|= (lisp_modifiers
& ctrl_modifier
) ? MOD_CONTROL
: 0;
8378 w32_modifiers
|= (lisp_modifiers
& shift_modifier
) ? MOD_SHIFT
: 0;
8380 return HOTKEY (vk_code
, w32_modifiers
);
8383 DEFUN ("w32-register-hot-key", Fw32_register_hot_key
,
8384 Sw32_register_hot_key
, 1, 1, 0,
8385 doc
: /* Register KEY as a hot-key combination.
8386 Certain key combinations like Alt-Tab are reserved for system use on
8387 Windows, and therefore are normally intercepted by the system. However,
8388 most of these key combinations can be received by registering them as
8389 hot-keys, overriding their special meaning.
8391 KEY must be a one element key definition in vector form that would be
8392 acceptable to `define-key' (e.g. [A-tab] for Alt-Tab). The meta
8393 modifier is interpreted as Alt if `w32-alt-is-meta' is t, and hyper
8394 is always interpreted as the Windows modifier keys.
8396 The return value is the hotkey-id if registered, otherwise nil. */)
8400 key
= w32_parse_hot_key (key
);
8402 if (NILP (Fmemq (key
, w32_grabbed_keys
)))
8404 /* Reuse an empty slot if possible. */
8405 Lisp_Object item
= Fmemq (Qnil
, w32_grabbed_keys
);
8407 /* Safe to add new key to list, even if we have focus. */
8409 w32_grabbed_keys
= Fcons (key
, w32_grabbed_keys
);
8411 XSETCAR (item
, key
);
8413 /* Notify input thread about new hot-key definition, so that it
8414 takes effect without needing to switch focus. */
8415 #ifdef USE_LISP_UNION_TYPE
8416 PostThreadMessage (dwWindowsThreadId
, WM_EMACS_REGISTER_HOT_KEY
,
8419 PostThreadMessage (dwWindowsThreadId
, WM_EMACS_REGISTER_HOT_KEY
,
8427 DEFUN ("w32-unregister-hot-key", Fw32_unregister_hot_key
,
8428 Sw32_unregister_hot_key
, 1, 1, 0,
8429 doc
: /* Unregister KEY as a hot-key combination. */)
8435 if (!INTEGERP (key
))
8436 key
= w32_parse_hot_key (key
);
8438 item
= Fmemq (key
, w32_grabbed_keys
);
8442 /* Notify input thread about hot-key definition being removed, so
8443 that it takes effect without needing focus switch. */
8444 #ifdef USE_LISP_UNION_TYPE
8445 if (PostThreadMessage (dwWindowsThreadId
, WM_EMACS_UNREGISTER_HOT_KEY
,
8446 (WPARAM
) XINT (XCAR (item
)), (LPARAM
) item
.i
))
8448 if (PostThreadMessage (dwWindowsThreadId
, WM_EMACS_UNREGISTER_HOT_KEY
,
8449 (WPARAM
) XINT (XCAR (item
)), (LPARAM
) item
))
8454 GetMessage (&msg
, NULL
, WM_EMACS_DONE
, WM_EMACS_DONE
);
8461 DEFUN ("w32-registered-hot-keys", Fw32_registered_hot_keys
,
8462 Sw32_registered_hot_keys
, 0, 0, 0,
8463 doc
: /* Return list of registered hot-key IDs. */)
8466 return Fcopy_sequence (w32_grabbed_keys
);
8469 DEFUN ("w32-reconstruct-hot-key", Fw32_reconstruct_hot_key
,
8470 Sw32_reconstruct_hot_key
, 1, 1, 0,
8471 doc
: /* Convert hot-key ID to a lisp key combination.
8472 usage: (w32-reconstruct-hot-key ID) */)
8474 Lisp_Object hotkeyid
;
8476 int vk_code
, w32_modifiers
;
8479 CHECK_NUMBER (hotkeyid
);
8481 vk_code
= HOTKEY_VK_CODE (hotkeyid
);
8482 w32_modifiers
= HOTKEY_MODIFIERS (hotkeyid
);
8484 if (lispy_function_keys
[vk_code
])
8485 key
= intern (lispy_function_keys
[vk_code
]);
8487 key
= make_number (vk_code
);
8489 key
= Fcons (key
, Qnil
);
8490 if (w32_modifiers
& MOD_SHIFT
)
8491 key
= Fcons (Qshift
, key
);
8492 if (w32_modifiers
& MOD_CONTROL
)
8493 key
= Fcons (Qctrl
, key
);
8494 if (w32_modifiers
& MOD_ALT
)
8495 key
= Fcons (NILP (Vw32_alt_is_meta
) ? Qalt
: Qmeta
, key
);
8496 if (w32_modifiers
& MOD_WIN
)
8497 key
= Fcons (Qhyper
, key
);
8502 DEFUN ("w32-toggle-lock-key", Fw32_toggle_lock_key
,
8503 Sw32_toggle_lock_key
, 1, 2, 0,
8504 doc
: /* Toggle the state of the lock key KEY.
8505 KEY can be `capslock', `kp-numlock', or `scroll'.
8506 If the optional parameter NEW-STATE is a number, then the state of KEY
8507 is set to off if the low bit of NEW-STATE is zero, otherwise on. */)
8509 Lisp_Object key
, new_state
;
8513 if (EQ (key
, intern ("capslock")))
8514 vk_code
= VK_CAPITAL
;
8515 else if (EQ (key
, intern ("kp-numlock")))
8516 vk_code
= VK_NUMLOCK
;
8517 else if (EQ (key
, intern ("scroll")))
8518 vk_code
= VK_SCROLL
;
8522 if (!dwWindowsThreadId
)
8523 return make_number (w32_console_toggle_lock_key (vk_code
, new_state
));
8525 #ifdef USE_LISP_UNION_TYPE
8526 if (PostThreadMessage (dwWindowsThreadId
, WM_EMACS_TOGGLE_LOCK_KEY
,
8527 (WPARAM
) vk_code
, (LPARAM
) new_state
.i
))
8529 if (PostThreadMessage (dwWindowsThreadId
, WM_EMACS_TOGGLE_LOCK_KEY
,
8530 (WPARAM
) vk_code
, (LPARAM
) new_state
))
8534 GetMessage (&msg
, NULL
, WM_EMACS_DONE
, WM_EMACS_DONE
);
8535 return make_number (msg
.wParam
);
8540 DEFUN ("w32-window-exists-p", Fw32_window_exists_p
, Sw32_window_exists_p
,
8542 doc
: /* Return non-nil if a window exists with the specified CLASS and NAME.
8544 This is a direct interface to the Windows API FindWindow function. */)
8546 Lisp_Object
class, name
;
8551 CHECK_STRING (class);
8553 CHECK_STRING (name
);
8555 hnd
= FindWindow (STRINGP (class) ? ((LPCTSTR
) SDATA (class)) : NULL
,
8556 STRINGP (name
) ? ((LPCTSTR
) SDATA (name
)) : NULL
);
8564 DEFUN ("file-system-info", Ffile_system_info
, Sfile_system_info
, 1, 1, 0,
8565 doc
: /* Return storage information about the file system FILENAME is on.
8566 Value is a list of floats (TOTAL FREE AVAIL), where TOTAL is the total
8567 storage of the file system, FREE is the free storage, and AVAIL is the
8568 storage available to a non-superuser. All 3 numbers are in bytes.
8569 If the underlying system call fails, value is nil. */)
8571 Lisp_Object filename
;
8573 Lisp_Object encoded
, value
;
8575 CHECK_STRING (filename
);
8576 filename
= Fexpand_file_name (filename
, Qnil
);
8577 encoded
= ENCODE_FILE (filename
);
8581 /* Determining the required information on Windows turns out, sadly,
8582 to be more involved than one would hope. The original Win32 api
8583 call for this will return bogus information on some systems, but we
8584 must dynamically probe for the replacement api, since that was
8585 added rather late on. */
8587 HMODULE hKernel
= GetModuleHandle ("kernel32");
8588 BOOL (*pfn_GetDiskFreeSpaceEx
)
8589 (char *, PULARGE_INTEGER
, PULARGE_INTEGER
, PULARGE_INTEGER
)
8590 = (void *) GetProcAddress (hKernel
, "GetDiskFreeSpaceEx");
8592 /* On Windows, we may need to specify the root directory of the
8593 volume holding FILENAME. */
8594 char rootname
[MAX_PATH
];
8595 char *name
= SDATA (encoded
);
8597 /* find the root name of the volume if given */
8598 if (isalpha (name
[0]) && name
[1] == ':')
8600 rootname
[0] = name
[0];
8601 rootname
[1] = name
[1];
8605 else if (IS_DIRECTORY_SEP (name
[0]) && IS_DIRECTORY_SEP (name
[1]))
8607 char *str
= rootname
;
8611 if (IS_DIRECTORY_SEP (*name
) && --slashes
== 0)
8621 if (pfn_GetDiskFreeSpaceEx
)
8623 /* Unsigned large integers cannot be cast to double, so
8624 use signed ones instead. */
8625 LARGE_INTEGER availbytes
;
8626 LARGE_INTEGER freebytes
;
8627 LARGE_INTEGER totalbytes
;
8629 if (pfn_GetDiskFreeSpaceEx(rootname
,
8630 (ULARGE_INTEGER
*)&availbytes
,
8631 (ULARGE_INTEGER
*)&totalbytes
,
8632 (ULARGE_INTEGER
*)&freebytes
))
8633 value
= list3 (make_float ((double) totalbytes
.QuadPart
),
8634 make_float ((double) freebytes
.QuadPart
),
8635 make_float ((double) availbytes
.QuadPart
));
8639 DWORD sectors_per_cluster
;
8640 DWORD bytes_per_sector
;
8641 DWORD free_clusters
;
8642 DWORD total_clusters
;
8644 if (GetDiskFreeSpace(rootname
,
8645 §ors_per_cluster
,
8649 value
= list3 (make_float ((double) total_clusters
8650 * sectors_per_cluster
* bytes_per_sector
),
8651 make_float ((double) free_clusters
8652 * sectors_per_cluster
* bytes_per_sector
),
8653 make_float ((double) free_clusters
8654 * sectors_per_cluster
* bytes_per_sector
));
8661 DEFUN ("default-printer-name", Fdefault_printer_name
, Sdefault_printer_name
,
8662 0, 0, 0, doc
: /* Return the name of Windows default printer device. */)
8665 static char pname_buf
[256];
8668 PRINTER_INFO_2
*ppi2
= NULL
;
8669 DWORD dwNeeded
= 0, dwReturned
= 0;
8671 /* Retrieve the default string from Win.ini (the registry).
8672 * String will be in form "printername,drivername,portname".
8673 * This is the most portable way to get the default printer. */
8674 if (GetProfileString ("windows", "device", ",,", pname_buf
, sizeof (pname_buf
)) <= 0)
8676 /* printername precedes first "," character */
8677 strtok (pname_buf
, ",");
8678 /* We want to know more than the printer name */
8679 if (!OpenPrinter (pname_buf
, &hPrn
, NULL
))
8681 GetPrinter (hPrn
, 2, NULL
, 0, &dwNeeded
);
8684 ClosePrinter (hPrn
);
8687 /* Allocate memory for the PRINTER_INFO_2 struct */
8688 ppi2
= (PRINTER_INFO_2
*) xmalloc (dwNeeded
);
8691 ClosePrinter (hPrn
);
8694 /* Call GetPrinter() again with big enouth memory block */
8695 err
= GetPrinter (hPrn
, 2, (LPBYTE
)ppi2
, dwNeeded
, &dwReturned
);
8696 ClosePrinter (hPrn
);
8705 if (ppi2
->Attributes
& PRINTER_ATTRIBUTE_SHARED
&& ppi2
->pServerName
)
8707 /* a remote printer */
8708 if (*ppi2
->pServerName
== '\\')
8709 _snprintf(pname_buf
, sizeof (pname_buf
), "%s\\%s", ppi2
->pServerName
,
8712 _snprintf(pname_buf
, sizeof (pname_buf
), "\\\\%s\\%s", ppi2
->pServerName
,
8714 pname_buf
[sizeof (pname_buf
) - 1] = '\0';
8718 /* a local printer */
8719 strncpy(pname_buf
, ppi2
->pPortName
, sizeof (pname_buf
));
8720 pname_buf
[sizeof (pname_buf
) - 1] = '\0';
8721 /* `pPortName' can include several ports, delimited by ','.
8722 * we only use the first one. */
8723 strtok(pname_buf
, ",");
8728 return build_string (pname_buf
);
8731 /***********************************************************************
8733 ***********************************************************************/
8735 /* Keep this list in the same order as frame_parms in frame.c.
8736 Use 0 for unsupported frame parameters. */
8738 frame_parm_handler w32_frame_parm_handlers
[] =
8742 x_set_background_color
,
8748 x_set_foreground_color
,
8751 x_set_internal_border_width
,
8752 x_set_menu_bar_lines
,
8754 x_explicitly_set_name
,
8755 x_set_scroll_bar_width
,
8758 x_set_vertical_scroll_bars
,
8760 x_set_tool_bar_lines
,
8761 0, /* x_set_scroll_bar_foreground, */
8762 0, /* x_set_scroll_bar_background, */
8767 0, /* x_set_wait_for_wm, */
8769 #ifdef USE_FONT_BACKEND
8777 globals_of_w32fns ();
8778 /* This is zero if not using MS-Windows. */
8780 track_mouse_window
= NULL
;
8782 w32_visible_system_caret_hwnd
= NULL
;
8784 DEFSYM (Qnone
, "none");
8785 DEFSYM (Qsuppress_icon
, "suppress-icon");
8786 DEFSYM (Qundefined_color
, "undefined-color");
8787 DEFSYM (Qcancel_timer
, "cancel-timer");
8788 DEFSYM (Qhyper
, "hyper");
8789 DEFSYM (Qsuper
, "super");
8790 DEFSYM (Qmeta
, "meta");
8791 DEFSYM (Qalt
, "alt");
8792 DEFSYM (Qctrl
, "ctrl");
8793 DEFSYM (Qcontrol
, "control");
8794 DEFSYM (Qshift
, "shift");
8795 /* This is the end of symbol initialization. */
8797 /* Text property `display' should be nonsticky by default. */
8798 Vtext_property_default_nonsticky
8799 = Fcons (Fcons (Qdisplay
, Qt
), Vtext_property_default_nonsticky
);
8802 Fput (Qundefined_color
, Qerror_conditions
,
8803 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
8804 Fput (Qundefined_color
, Qerror_message
,
8805 build_string ("Undefined color"));
8807 staticpro (&w32_grabbed_keys
);
8808 w32_grabbed_keys
= Qnil
;
8810 DEFVAR_LISP ("w32-color-map", &Vw32_color_map
,
8811 doc
: /* An array of color name mappings for Windows. */);
8812 Vw32_color_map
= Qnil
;
8814 DEFVAR_LISP ("w32-pass-alt-to-system", &Vw32_pass_alt_to_system
,
8815 doc
: /* Non-nil if Alt key presses are passed on to Windows.
8816 When non-nil, for example, Alt pressed and released and then space will
8817 open the System menu. When nil, Emacs processes the Alt key events, and
8818 then silently swallows them. */);
8819 Vw32_pass_alt_to_system
= Qnil
;
8821 DEFVAR_LISP ("w32-alt-is-meta", &Vw32_alt_is_meta
,
8822 doc
: /* Non-nil if the Alt key is to be considered the same as the META key.
8823 When nil, Emacs will translate the Alt key to the ALT modifier, not to META. */);
8824 Vw32_alt_is_meta
= Qt
;
8826 DEFVAR_INT ("w32-quit-key", &w32_quit_key
,
8827 doc
: /* If non-zero, the virtual key code for an alternative quit key. */);
8830 DEFVAR_LISP ("w32-pass-lwindow-to-system",
8831 &Vw32_pass_lwindow_to_system
,
8832 doc
: /* If non-nil, the left \"Windows\" key is passed on to Windows.
8834 When non-nil, the Start menu is opened by tapping the key.
8835 If you set this to nil, the left \"Windows\" key is processed by Emacs
8836 according to the value of `w32-lwindow-modifier', which see.
8838 Note that some combinations of the left \"Windows\" key with other keys are
8839 caught by Windows at low level, and so binding them in Emacs will have no
8840 effect. For example, <lwindow>-r always pops up the Windows Run dialog,
8841 <lwindow>-<Pause> pops up the "System Properties" dialog, etc. However, see
8842 the doc string of `w32-phantom-key-code'. */);
8843 Vw32_pass_lwindow_to_system
= Qt
;
8845 DEFVAR_LISP ("w32-pass-rwindow-to-system",
8846 &Vw32_pass_rwindow_to_system
,
8847 doc
: /* If non-nil, the right \"Windows\" key is passed on to Windows.
8849 When non-nil, the Start menu is opened by tapping the key.
8850 If you set this to nil, the right \"Windows\" key is processed by Emacs
8851 according to the value of `w32-rwindow-modifier', which see.
8853 Note that some combinations of the right \"Windows\" key with other keys are
8854 caught by Windows at low level, and so binding them in Emacs will have no
8855 effect. For example, <rwindow>-r always pops up the Windows Run dialog,
8856 <rwindow>-<Pause> pops up the "System Properties" dialog, etc. However, see
8857 the doc string of `w32-phantom-key-code'. */);
8858 Vw32_pass_rwindow_to_system
= Qt
;
8860 DEFVAR_LISP ("w32-phantom-key-code",
8861 &Vw32_phantom_key_code
,
8862 doc
: /* Virtual key code used to generate \"phantom\" key presses.
8863 Value is a number between 0 and 255.
8865 Phantom key presses are generated in order to stop the system from
8866 acting on \"Windows\" key events when `w32-pass-lwindow-to-system' or
8867 `w32-pass-rwindow-to-system' is nil. */);
8868 /* Although 255 is technically not a valid key code, it works and
8869 means that this hack won't interfere with any real key code. */
8870 XSETINT (Vw32_phantom_key_code
, 255);
8872 DEFVAR_LISP ("w32-enable-num-lock",
8873 &Vw32_enable_num_lock
,
8874 doc
: /* If non-nil, the Num Lock key acts normally.
8875 Set to nil to handle Num Lock as the `kp-numlock' key. */);
8876 Vw32_enable_num_lock
= Qt
;
8878 DEFVAR_LISP ("w32-enable-caps-lock",
8879 &Vw32_enable_caps_lock
,
8880 doc
: /* If non-nil, the Caps Lock key acts normally.
8881 Set to nil to handle Caps Lock as the `capslock' key. */);
8882 Vw32_enable_caps_lock
= Qt
;
8884 DEFVAR_LISP ("w32-scroll-lock-modifier",
8885 &Vw32_scroll_lock_modifier
,
8886 doc
: /* Modifier to use for the Scroll Lock ON state.
8887 The value can be hyper, super, meta, alt, control or shift for the
8888 respective modifier, or nil to handle Scroll Lock as the `scroll' key.
8889 Any other value will cause the Scroll Lock key to be ignored. */);
8890 Vw32_scroll_lock_modifier
= Qt
;
8892 DEFVAR_LISP ("w32-lwindow-modifier",
8893 &Vw32_lwindow_modifier
,
8894 doc
: /* Modifier to use for the left \"Windows\" key.
8895 The value can be hyper, super, meta, alt, control or shift for the
8896 respective modifier, or nil to appear as the `lwindow' key.
8897 Any other value will cause the key to be ignored. */);
8898 Vw32_lwindow_modifier
= Qnil
;
8900 DEFVAR_LISP ("w32-rwindow-modifier",
8901 &Vw32_rwindow_modifier
,
8902 doc
: /* Modifier to use for the right \"Windows\" key.
8903 The value can be hyper, super, meta, alt, control or shift for the
8904 respective modifier, or nil to appear as the `rwindow' key.
8905 Any other value will cause the key to be ignored. */);
8906 Vw32_rwindow_modifier
= Qnil
;
8908 DEFVAR_LISP ("w32-apps-modifier",
8909 &Vw32_apps_modifier
,
8910 doc
: /* Modifier to use for the \"Apps\" key.
8911 The value can be hyper, super, meta, alt, control or shift for the
8912 respective modifier, or nil to appear as the `apps' key.
8913 Any other value will cause the key to be ignored. */);
8914 Vw32_apps_modifier
= Qnil
;
8916 DEFVAR_BOOL ("w32-enable-synthesized-fonts", &w32_enable_synthesized_fonts
,
8917 doc
: /* Non-nil enables selection of artificially italicized and bold fonts. */);
8918 w32_enable_synthesized_fonts
= 0;
8920 DEFVAR_LISP ("w32-enable-palette", &Vw32_enable_palette
,
8921 doc
: /* Non-nil enables Windows palette management to map colors exactly. */);
8922 Vw32_enable_palette
= Qt
;
8924 DEFVAR_INT ("w32-mouse-button-tolerance",
8925 &w32_mouse_button_tolerance
,
8926 doc
: /* Analogue of double click interval for faking middle mouse events.
8927 The value is the minimum time in milliseconds that must elapse between
8928 left and right button down events before they are considered distinct events.
8929 If both mouse buttons are depressed within this interval, a middle mouse
8930 button down event is generated instead. */);
8931 w32_mouse_button_tolerance
= GetDoubleClickTime () / 2;
8933 DEFVAR_INT ("w32-mouse-move-interval",
8934 &w32_mouse_move_interval
,
8935 doc
: /* Minimum interval between mouse move events.
8936 The value is the minimum time in milliseconds that must elapse between
8937 successive mouse move (or scroll bar drag) events before they are
8938 reported as lisp events. */);
8939 w32_mouse_move_interval
= 0;
8941 DEFVAR_BOOL ("w32-pass-extra-mouse-buttons-to-system",
8942 &w32_pass_extra_mouse_buttons_to_system
,
8943 doc
: /* If non-nil, the fourth and fifth mouse buttons are passed to Windows.
8944 Recent versions of Windows support mice with up to five buttons.
8945 Since most applications don't support these extra buttons, most mouse
8946 drivers will allow you to map them to functions at the system level.
8947 If this variable is non-nil, Emacs will pass them on, allowing the
8948 system to handle them. */);
8949 w32_pass_extra_mouse_buttons_to_system
= 0;
8951 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
8952 doc
: /* The shape of the pointer when over text.
8953 Changing the value does not affect existing frames
8954 unless you set the mouse color. */);
8955 Vx_pointer_shape
= Qnil
;
8957 Vx_nontext_pointer_shape
= Qnil
;
8959 Vx_mode_pointer_shape
= Qnil
;
8961 DEFVAR_LISP ("x-hourglass-pointer-shape", &Vx_hourglass_pointer_shape
,
8962 doc
: /* The shape of the pointer when Emacs is busy.
8963 This variable takes effect when you create a new frame
8964 or when you set the mouse color. */);
8965 Vx_hourglass_pointer_shape
= Qnil
;
8967 DEFVAR_BOOL ("display-hourglass", &display_hourglass_p
,
8968 doc
: /* Non-zero means Emacs displays an hourglass pointer on window systems. */);
8969 display_hourglass_p
= 1;
8971 DEFVAR_LISP ("hourglass-delay", &Vhourglass_delay
,
8972 doc
: /* *Seconds to wait before displaying an hourglass pointer.
8973 Value must be an integer or float. */);
8974 Vhourglass_delay
= make_number (DEFAULT_HOURGLASS_DELAY
);
8976 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
8977 &Vx_sensitive_text_pointer_shape
,
8978 doc
: /* The shape of the pointer when over mouse-sensitive text.
8979 This variable takes effect when you create a new frame
8980 or when you set the mouse color. */);
8981 Vx_sensitive_text_pointer_shape
= Qnil
;
8983 DEFVAR_LISP ("x-window-horizontal-drag-cursor",
8984 &Vx_window_horizontal_drag_shape
,
8985 doc
: /* Pointer shape to use for indicating a window can be dragged horizontally.
8986 This variable takes effect when you create a new frame
8987 or when you set the mouse color. */);
8988 Vx_window_horizontal_drag_shape
= Qnil
;
8990 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
8991 doc
: /* A string indicating the foreground color of the cursor box. */);
8992 Vx_cursor_fore_pixel
= Qnil
;
8994 DEFVAR_LISP ("x-max-tooltip-size", &Vx_max_tooltip_size
,
8995 doc
: /* Maximum size for tooltips.
8996 Value is a pair (COLUMNS . ROWS). Text larger than this is clipped. */);
8997 Vx_max_tooltip_size
= Fcons (make_number (80), make_number (40));
8999 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
9000 doc
: /* Non-nil if no window manager is in use.
9001 Emacs doesn't try to figure this out; this is always nil
9002 unless you set it to something else. */);
9003 /* We don't have any way to find this out, so set it to nil
9004 and maybe the user would like to set it to t. */
9005 Vx_no_window_manager
= Qnil
;
9007 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
9008 &Vx_pixel_size_width_font_regexp
,
9009 doc
: /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'.
9011 Since Emacs gets width of a font matching with this regexp from
9012 PIXEL_SIZE field of the name, font finding mechanism gets faster for
9013 such a font. This is especially effective for such large fonts as
9014 Chinese, Japanese, and Korean. */);
9015 Vx_pixel_size_width_font_regexp
= Qnil
;
9017 DEFVAR_LISP ("w32-bdf-filename-alist",
9018 &Vw32_bdf_filename_alist
,
9019 doc
: /* List of bdf fonts and their corresponding filenames. */);
9020 Vw32_bdf_filename_alist
= Qnil
;
9022 DEFVAR_BOOL ("w32-strict-fontnames",
9023 &w32_strict_fontnames
,
9024 doc
: /* Non-nil means only use fonts that are exact matches for those requested.
9025 Default is nil, which allows old fontnames that are not XLFD compliant,
9026 and allows third-party CJK display to work by specifying false charset
9027 fields to trick Emacs into translating to Big5, SJIS etc.
9028 Setting this to t will prevent wrong fonts being selected when
9029 fontsets are automatically created. */);
9030 w32_strict_fontnames
= 0;
9032 DEFVAR_BOOL ("w32-strict-painting",
9033 &w32_strict_painting
,
9034 doc
: /* Non-nil means use strict rules for repainting frames.
9035 Set this to nil to get the old behavior for repainting; this should
9036 only be necessary if the default setting causes problems. */);
9037 w32_strict_painting
= 1;
9039 DEFVAR_LISP ("w32-charset-info-alist",
9040 &Vw32_charset_info_alist
,
9041 doc
: /* Alist linking Emacs character sets to Windows fonts and codepages.
9042 Each entry should be of the form:
9044 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE))
9046 where CHARSET_NAME is a string used in font names to identify the charset,
9047 WINDOWS_CHARSET is a symbol that can be one of:
9048 w32-charset-ansi, w32-charset-default, w32-charset-symbol,
9049 w32-charset-shiftjis, w32-charset-hangeul, w32-charset-gb2312,
9050 w32-charset-chinesebig5,
9051 w32-charset-johab, w32-charset-hebrew,
9052 w32-charset-arabic, w32-charset-greek, w32-charset-turkish,
9053 w32-charset-vietnamese, w32-charset-thai, w32-charset-easteurope,
9054 w32-charset-russian, w32-charset-mac, w32-charset-baltic,
9055 w32-charset-unicode,
9057 CODEPAGE should be an integer specifying the codepage that should be used
9058 to display the character set, t to do no translation and output as Unicode,
9059 or nil to do no translation and output as 8 bit (or multibyte on far-east
9060 versions of Windows) characters. */);
9061 Vw32_charset_info_alist
= Qnil
;
9063 DEFSYM (Qw32_charset_ansi
, "w32-charset-ansi");
9064 DEFSYM (Qw32_charset_symbol
, "w32-charset-symbol");
9065 DEFSYM (Qw32_charset_default
, "w32-charset-default");
9066 DEFSYM (Qw32_charset_shiftjis
, "w32-charset-shiftjis");
9067 DEFSYM (Qw32_charset_hangeul
, "w32-charset-hangeul");
9068 DEFSYM (Qw32_charset_chinesebig5
, "w32-charset-chinesebig5");
9069 DEFSYM (Qw32_charset_gb2312
, "w32-charset-gb2312");
9070 DEFSYM (Qw32_charset_oem
, "w32-charset-oem");
9072 #ifdef JOHAB_CHARSET
9074 static int w32_extra_charsets_defined
= 1;
9075 DEFVAR_BOOL ("w32-extra-charsets-defined", &w32_extra_charsets_defined
,
9076 doc
: /* Internal variable. */);
9078 DEFSYM (Qw32_charset_johab
, "w32-charset-johab");
9079 DEFSYM (Qw32_charset_easteurope
, "w32-charset-easteurope");
9080 DEFSYM (Qw32_charset_turkish
, "w32-charset-turkish");
9081 DEFSYM (Qw32_charset_baltic
, "w32-charset-baltic");
9082 DEFSYM (Qw32_charset_russian
, "w32-charset-russian");
9083 DEFSYM (Qw32_charset_arabic
, "w32-charset-arabic");
9084 DEFSYM (Qw32_charset_greek
, "w32-charset-greek");
9085 DEFSYM (Qw32_charset_hebrew
, "w32-charset-hebrew");
9086 DEFSYM (Qw32_charset_vietnamese
, "w32-charset-vietnamese");
9087 DEFSYM (Qw32_charset_thai
, "w32-charset-thai");
9088 DEFSYM (Qw32_charset_mac
, "w32-charset-mac");
9092 #ifdef UNICODE_CHARSET
9094 static int w32_unicode_charset_defined
= 1;
9095 DEFVAR_BOOL ("w32-unicode-charset-defined",
9096 &w32_unicode_charset_defined
,
9097 doc
: /* Internal variable. */);
9098 DEFSYM (Qw32_charset_unicode
, "w32-charset-unicode");
9102 #if 0 /* TODO: Port to W32 */
9103 defsubr (&Sx_change_window_property
);
9104 defsubr (&Sx_delete_window_property
);
9105 defsubr (&Sx_window_property
);
9107 defsubr (&Sxw_display_color_p
);
9108 defsubr (&Sx_display_grayscale_p
);
9109 defsubr (&Sxw_color_defined_p
);
9110 defsubr (&Sxw_color_values
);
9111 defsubr (&Sx_server_max_request_size
);
9112 defsubr (&Sx_server_vendor
);
9113 defsubr (&Sx_server_version
);
9114 defsubr (&Sx_display_pixel_width
);
9115 defsubr (&Sx_display_pixel_height
);
9116 defsubr (&Sx_display_mm_width
);
9117 defsubr (&Sx_display_mm_height
);
9118 defsubr (&Sx_display_screens
);
9119 defsubr (&Sx_display_planes
);
9120 defsubr (&Sx_display_color_cells
);
9121 defsubr (&Sx_display_visual_class
);
9122 defsubr (&Sx_display_backing_store
);
9123 defsubr (&Sx_display_save_under
);
9124 defsubr (&Sx_create_frame
);
9125 defsubr (&Sx_open_connection
);
9126 defsubr (&Sx_close_connection
);
9127 defsubr (&Sx_display_list
);
9128 defsubr (&Sx_synchronize
);
9129 defsubr (&Sx_focus_frame
);
9131 /* W32 specific functions */
9133 defsubr (&Sw32_select_font
);
9134 defsubr (&Sw32_define_rgb_color
);
9135 defsubr (&Sw32_default_color_map
);
9136 defsubr (&Sw32_load_color_file
);
9137 defsubr (&Sw32_send_sys_command
);
9138 defsubr (&Sw32_shell_execute
);
9139 defsubr (&Sw32_register_hot_key
);
9140 defsubr (&Sw32_unregister_hot_key
);
9141 defsubr (&Sw32_registered_hot_keys
);
9142 defsubr (&Sw32_reconstruct_hot_key
);
9143 defsubr (&Sw32_toggle_lock_key
);
9144 defsubr (&Sw32_window_exists_p
);
9145 defsubr (&Sw32_find_bdf_fonts
);
9147 defsubr (&Sfile_system_info
);
9148 defsubr (&Sdefault_printer_name
);
9150 /* Setting callback functions for fontset handler. */
9151 get_font_info_func
= w32_get_font_info
;
9153 #if 0 /* This function pointer doesn't seem to be used anywhere.
9154 And the pointer assigned has the wrong type, anyway. */
9155 list_fonts_func
= w32_list_fonts
;
9158 load_font_func
= w32_load_font
;
9159 find_ccl_program_func
= w32_find_ccl_program
;
9160 query_font_func
= w32_query_font
;
9161 set_frame_fontset_func
= x_set_font
;
9162 get_font_repertory_func
= x_get_font_repertory
;
9163 check_window_system_func
= check_w32
;
9166 hourglass_atimer
= NULL
;
9167 hourglass_shown_p
= 0;
9168 defsubr (&Sx_show_tip
);
9169 defsubr (&Sx_hide_tip
);
9171 staticpro (&tip_timer
);
9173 staticpro (&tip_frame
);
9175 last_show_tip_args
= Qnil
;
9176 staticpro (&last_show_tip_args
);
9178 defsubr (&Sx_file_dialog
);
9183 globals_of_w32fns is used to initialize those global variables that
9184 must always be initialized on startup even when the global variable
9185 initialized is non zero (see the function main in emacs.c).
9186 globals_of_w32fns is called from syms_of_w32fns when the global
9187 variable initialized is 0 and directly from main when initialized
9190 void globals_of_w32fns ()
9192 HMODULE user32_lib
= GetModuleHandle ("user32.dll");
9194 TrackMouseEvent not available in all versions of Windows, so must load
9195 it dynamically. Do it once, here, instead of every time it is used.
9197 track_mouse_event_fn
= (TrackMouseEvent_Proc
)
9198 GetProcAddress (user32_lib
, "TrackMouseEvent");
9199 /* ditto for GetClipboardSequenceNumber. */
9200 clipboard_sequence_fn
= (ClipboardSequence_Proc
)
9201 GetProcAddress (user32_lib
, "GetClipboardSequenceNumber");
9203 DEFVAR_INT ("w32-ansi-code-page",
9204 &w32_ansi_code_page
,
9205 doc
: /* The ANSI code page used by the system. */);
9206 w32_ansi_code_page
= GetACP ();
9208 /* MessageBox does not work without this when linked to comctl32.dll 6.0. */
9209 InitCommonControls ();
9214 void w32_abort (void) NO_RETURN
;
9220 button
= MessageBox (NULL
,
9221 "A fatal error has occurred!\n\n"
9222 "Would you like to attach a debugger?\n\n"
9223 "Select YES to debug, NO to abort Emacs"
9225 "\n\n(type \"gdb -p <emacs-PID>\" and\n"
9226 "\"continue\" inside GDB before clicking YES.)"
9228 , "Emacs Abort Dialog",
9229 MB_ICONEXCLAMATION
| MB_TASKMODAL
9230 | MB_SETFOREGROUND
| MB_YESNO
);
9235 exit (2); /* tell the compiler we will never return */
9243 /* For convenience when debugging. */
9247 return GetLastError ();
9250 /* arch-tag: 707589ab-b9be-4638-8cdd-74629cc9b446
9251 (do not change this comment) */