1 /* Graphical user interface functions for the Microsoft W32 API.
2 Copyright (C) 1989, 92, 93, 94, 95, 1996 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
21 /* Added by Kevin Gallo */
37 #include "dispextern.h"
39 #include "blockinput.h"
42 #include "termhooks.h"
49 extern void free_frame_menubar ();
50 extern struct scroll_bar
*x_window_to_scroll_bar ();
51 extern int w32_console_toggle_lock_key (int vk_code
, Lisp_Object new_state
);
54 extern char *lispy_function_keys
[];
56 /* The colormap for converting color names to RGB values */
57 Lisp_Object Vw32_color_map
;
59 /* Non nil if alt key presses are passed on to Windows. */
60 Lisp_Object Vw32_pass_alt_to_system
;
62 /* Non nil if alt key is translated to meta_modifier, nil if it is translated
64 Lisp_Object Vw32_alt_is_meta
;
66 /* If non-zero, the windows virtual key code for an alternative quit key. */
67 Lisp_Object Vw32_quit_key
;
69 /* Non nil if left window key events are passed on to Windows (this only
70 affects whether "tapping" the key opens the Start menu). */
71 Lisp_Object Vw32_pass_lwindow_to_system
;
73 /* Non nil if right window key events are passed on to Windows (this
74 only affects whether "tapping" the key opens the Start menu). */
75 Lisp_Object Vw32_pass_rwindow_to_system
;
77 /* Virtual key code used to generate "phantom" key presses in order
78 to stop system from acting on Windows key events. */
79 Lisp_Object Vw32_phantom_key_code
;
81 /* Modifier associated with the left "Windows" key, or nil to act as a
83 Lisp_Object Vw32_lwindow_modifier
;
85 /* Modifier associated with the right "Windows" key, or nil to act as a
87 Lisp_Object Vw32_rwindow_modifier
;
89 /* Modifier associated with the "Apps" key, or nil to act as a normal
91 Lisp_Object Vw32_apps_modifier
;
93 /* Value is nil if Num Lock acts as a function key. */
94 Lisp_Object Vw32_enable_num_lock
;
96 /* Value is nil if Caps Lock acts as a function key. */
97 Lisp_Object Vw32_enable_caps_lock
;
99 /* Modifier associated with Scroll Lock, or nil to act as a normal key. */
100 Lisp_Object Vw32_scroll_lock_modifier
;
102 /* Switch to control whether we inhibit requests for italicised fonts (which
103 are synthesized, look ugly, and are trashed by cursor movement under NT). */
104 Lisp_Object Vw32_enable_italics
;
106 /* Enable palette management. */
107 Lisp_Object Vw32_enable_palette
;
109 /* Control how close left/right button down events must be to
110 be converted to a middle button down event. */
111 Lisp_Object Vw32_mouse_button_tolerance
;
113 /* Minimum interval between mouse movement (and scroll bar drag)
114 events that are passed on to the event loop. */
115 Lisp_Object Vw32_mouse_move_interval
;
117 /* The name we're using in resource queries. */
118 Lisp_Object Vx_resource_name
;
120 /* Non nil if no window manager is in use. */
121 Lisp_Object Vx_no_window_manager
;
123 /* The background and shape of the mouse pointer, and shape when not
124 over text or in the modeline. */
125 Lisp_Object Vx_pointer_shape
, Vx_nontext_pointer_shape
, Vx_mode_pointer_shape
;
126 /* The shape when over mouse-sensitive text. */
127 Lisp_Object Vx_sensitive_text_pointer_shape
;
129 /* Color of chars displayed in cursor box. */
130 Lisp_Object Vx_cursor_fore_pixel
;
132 /* Nonzero if using Windows. */
133 static int w32_in_use
;
135 /* Search path for bitmap files. */
136 Lisp_Object Vx_bitmap_file_path
;
138 /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
139 Lisp_Object Vx_pixel_size_width_font_regexp
;
141 /* Alist of bdf fonts and the files that define them. */
142 Lisp_Object Vw32_bdf_filename_alist
;
144 Lisp_Object Vw32_system_coding_system
;
146 /* A flag to control whether fonts are matched strictly or not. */
147 int w32_strict_fontnames
;
149 /* Evaluate this expression to rebuild the section of syms_of_w32fns
150 that initializes and staticpros the symbols declared below. Note
151 that Emacs 18 has a bug that keeps C-x C-e from being able to
152 evaluate this expression.
155 ;; Accumulate a list of the symbols we want to initialize from the
156 ;; declarations at the top of the file.
157 (goto-char (point-min))
158 (search-forward "/\*&&& symbols declared here &&&*\/\n")
160 (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)")
162 (cons (buffer-substring (match-beginning 1) (match-end 1))
165 (setq symbol-list (nreverse symbol-list))
166 ;; Delete the section of syms_of_... where we initialize the symbols.
167 (search-forward "\n /\*&&& init symbols here &&&*\/\n")
168 (let ((start (point)))
169 (while (looking-at "^ Q")
171 (kill-region start (point)))
172 ;; Write a new symbol initialization section.
174 (insert (format " %s = intern (\"" (car symbol-list)))
175 (let ((start (point)))
176 (insert (substring (car symbol-list) 1))
177 (subst-char-in-region start (point) ?_ ?-))
178 (insert (format "\");\n staticpro (&%s);\n" (car symbol-list)))
179 (setq symbol-list (cdr symbol-list)))))
183 /*&&& symbols declared here &&&*/
184 Lisp_Object Qauto_raise
;
185 Lisp_Object Qauto_lower
;
186 Lisp_Object Qbackground_color
;
188 Lisp_Object Qborder_color
;
189 Lisp_Object Qborder_width
;
191 Lisp_Object Qcursor_color
;
192 Lisp_Object Qcursor_type
;
193 Lisp_Object Qforeground_color
;
194 Lisp_Object Qgeometry
;
195 Lisp_Object Qicon_left
;
196 Lisp_Object Qicon_top
;
197 Lisp_Object Qicon_type
;
198 Lisp_Object Qicon_name
;
199 Lisp_Object Qinternal_border_width
;
202 Lisp_Object Qmouse_color
;
204 Lisp_Object Qparent_id
;
205 Lisp_Object Qscroll_bar_width
;
206 Lisp_Object Qsuppress_icon
;
208 Lisp_Object Qundefined_color
;
209 Lisp_Object Qvertical_scroll_bars
;
210 Lisp_Object Qvisibility
;
211 Lisp_Object Qwindow_id
;
212 Lisp_Object Qx_frame_parameter
;
213 Lisp_Object Qx_resource_name
;
214 Lisp_Object Quser_position
;
215 Lisp_Object Quser_size
;
216 Lisp_Object Qdisplay
;
223 Lisp_Object Qcontrol
;
226 /* State variables for emulating a three button mouse. */
231 static int button_state
= 0;
232 static W32Msg saved_mouse_button_msg
;
233 static unsigned mouse_button_timer
; /* non-zero when timer is active */
234 static W32Msg saved_mouse_move_msg
;
235 static unsigned mouse_move_timer
;
237 /* W95 mousewheel handler */
238 unsigned int msh_mousewheel
= 0;
240 #define MOUSE_BUTTON_ID 1
241 #define MOUSE_MOVE_ID 2
243 /* The below are defined in frame.c. */
244 extern Lisp_Object Qheight
, Qminibuffer
, Qname
, Qonly
, Qwidth
;
245 extern Lisp_Object Qunsplittable
, Qmenu_bar_lines
, Qbuffer_predicate
, Qtitle
;
247 extern Lisp_Object Vwindow_system_version
;
249 Lisp_Object Qface_set_after_frame_default
;
251 extern Lisp_Object last_mouse_scroll_bar
;
252 extern int last_mouse_scroll_bar_pos
;
254 /* From w32term.c. */
255 extern Lisp_Object Vw32_num_mouse_buttons
;
256 extern Lisp_Object Vw32_recognize_altgr
;
259 /* Error if we are not connected to MS-Windows. */
264 error ("MS-Windows not in use or not initialized");
267 /* Nonzero if we can use mouse menus.
268 You should not call this unless HAVE_MENUS is defined. */
276 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
277 and checking validity for W32. */
280 check_x_frame (frame
)
289 CHECK_LIVE_FRAME (frame
, 0);
292 if (! FRAME_W32_P (f
))
293 error ("non-w32 frame used");
297 /* Let the user specify an display with a frame.
298 nil stands for the selected frame--or, if that is not a w32 frame,
299 the first display on the list. */
301 static struct w32_display_info
*
302 check_x_display_info (frame
)
307 if (FRAME_W32_P (selected_frame
))
308 return FRAME_W32_DISPLAY_INFO (selected_frame
);
310 return &one_w32_display_info
;
312 else if (STRINGP (frame
))
313 return x_display_info_for_name (frame
);
318 CHECK_LIVE_FRAME (frame
, 0);
320 if (! FRAME_W32_P (f
))
321 error ("non-w32 frame used");
322 return FRAME_W32_DISPLAY_INFO (f
);
326 /* Return the Emacs frame-object corresponding to an w32 window.
327 It could be the frame's main window or an icon window. */
329 /* This function can be called during GC, so use GC_xxx type test macros. */
332 x_window_to_frame (dpyinfo
, wdesc
)
333 struct w32_display_info
*dpyinfo
;
336 Lisp_Object tail
, frame
;
339 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
341 frame
= XCONS (tail
)->car
;
342 if (!GC_FRAMEP (frame
))
345 if (f
->output_data
.nothing
== 1
346 || FRAME_W32_DISPLAY_INFO (f
) != dpyinfo
)
348 if (FRAME_W32_WINDOW (f
) == wdesc
)
356 /* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
357 id, which is just an int that this section returns. Bitmaps are
358 reference counted so they can be shared among frames.
360 Bitmap indices are guaranteed to be > 0, so a negative number can
361 be used to indicate no bitmap.
363 If you use x_create_bitmap_from_data, then you must keep track of
364 the bitmaps yourself. That is, creating a bitmap from the same
365 data more than once will not be caught. */
368 /* Functions to access the contents of a bitmap, given an id. */
371 x_bitmap_height (f
, id
)
375 return FRAME_W32_DISPLAY_INFO (f
)->bitmaps
[id
- 1].height
;
379 x_bitmap_width (f
, id
)
383 return FRAME_W32_DISPLAY_INFO (f
)->bitmaps
[id
- 1].width
;
387 x_bitmap_pixmap (f
, id
)
391 return (int) FRAME_W32_DISPLAY_INFO (f
)->bitmaps
[id
- 1].pixmap
;
395 /* Allocate a new bitmap record. Returns index of new record. */
398 x_allocate_bitmap_record (f
)
401 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
404 if (dpyinfo
->bitmaps
== NULL
)
406 dpyinfo
->bitmaps_size
= 10;
408 = (struct w32_bitmap_record
*) xmalloc (dpyinfo
->bitmaps_size
* sizeof (struct w32_bitmap_record
));
409 dpyinfo
->bitmaps_last
= 1;
413 if (dpyinfo
->bitmaps_last
< dpyinfo
->bitmaps_size
)
414 return ++dpyinfo
->bitmaps_last
;
416 for (i
= 0; i
< dpyinfo
->bitmaps_size
; ++i
)
417 if (dpyinfo
->bitmaps
[i
].refcount
== 0)
420 dpyinfo
->bitmaps_size
*= 2;
422 = (struct w32_bitmap_record
*) xrealloc (dpyinfo
->bitmaps
,
423 dpyinfo
->bitmaps_size
* sizeof (struct w32_bitmap_record
));
424 return ++dpyinfo
->bitmaps_last
;
427 /* Add one reference to the reference count of the bitmap with id ID. */
430 x_reference_bitmap (f
, id
)
434 ++FRAME_W32_DISPLAY_INFO (f
)->bitmaps
[id
- 1].refcount
;
437 /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
440 x_create_bitmap_from_data (f
, bits
, width
, height
)
443 unsigned int width
, height
;
445 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
449 bitmap
= CreateBitmap (width
, height
,
450 FRAME_W32_DISPLAY_INFO (XFRAME (frame
))->n_planes
,
451 FRAME_W32_DISPLAY_INFO (XFRAME (frame
))->n_cbits
,
457 id
= x_allocate_bitmap_record (f
);
458 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
459 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
460 dpyinfo
->bitmaps
[id
- 1].hinst
= NULL
;
461 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
462 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
463 dpyinfo
->bitmaps
[id
- 1].height
= height
;
464 dpyinfo
->bitmaps
[id
- 1].width
= width
;
469 /* Create bitmap from file FILE for frame F. */
472 x_create_bitmap_from_file (f
, file
)
478 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
479 unsigned int width
, height
;
481 int xhot
, yhot
, result
, id
;
487 /* Look for an existing bitmap with the same name. */
488 for (id
= 0; id
< dpyinfo
->bitmaps_last
; ++id
)
490 if (dpyinfo
->bitmaps
[id
].refcount
491 && dpyinfo
->bitmaps
[id
].file
492 && !strcmp (dpyinfo
->bitmaps
[id
].file
, (char *) XSTRING (file
)->data
))
494 ++dpyinfo
->bitmaps
[id
].refcount
;
499 /* Search bitmap-file-path for the file, if appropriate. */
500 fd
= openp (Vx_bitmap_file_path
, file
, "", &found
, 0);
503 /* LoadLibraryEx won't handle special files handled by Emacs handler. */
508 filename
= (char *) XSTRING (found
)->data
;
510 hinst
= LoadLibraryEx (filename
, NULL
, LOAD_LIBRARY_AS_DATAFILE
);
516 result
= XReadBitmapFile (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
517 filename
, &width
, &height
, &bitmap
, &xhot
, &yhot
);
518 if (result
!= BitmapSuccess
)
521 id
= x_allocate_bitmap_record (f
);
522 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
523 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
524 dpyinfo
->bitmaps
[id
- 1].file
= (char *) xmalloc (XSTRING (file
)->size
+ 1);
525 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
526 dpyinfo
->bitmaps
[id
- 1].height
= height
;
527 dpyinfo
->bitmaps
[id
- 1].width
= width
;
528 strcpy (dpyinfo
->bitmaps
[id
- 1].file
, XSTRING (file
)->data
);
534 /* Remove reference to bitmap with id number ID. */
537 x_destroy_bitmap (f
, id
)
541 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
545 --dpyinfo
->bitmaps
[id
- 1].refcount
;
546 if (dpyinfo
->bitmaps
[id
- 1].refcount
== 0)
549 DeleteObject (dpyinfo
->bitmaps
[id
- 1].pixmap
);
550 if (dpyinfo
->bitmaps
[id
- 1].file
)
552 free (dpyinfo
->bitmaps
[id
- 1].file
);
553 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
560 /* Free all the bitmaps for the display specified by DPYINFO. */
563 x_destroy_all_bitmaps (dpyinfo
)
564 struct w32_display_info
*dpyinfo
;
567 for (i
= 0; i
< dpyinfo
->bitmaps_last
; i
++)
568 if (dpyinfo
->bitmaps
[i
].refcount
> 0)
570 DeleteObject (dpyinfo
->bitmaps
[i
].pixmap
);
571 if (dpyinfo
->bitmaps
[i
].file
)
572 free (dpyinfo
->bitmaps
[i
].file
);
574 dpyinfo
->bitmaps_last
= 0;
577 /* Connect the frame-parameter names for W32 frames
578 to the ways of passing the parameter values to the window system.
580 The name of a parameter, as a Lisp symbol,
581 has an `x-frame-parameter' property which is an integer in Lisp
582 but can be interpreted as an `enum x_frame_parm' in C. */
586 X_PARM_FOREGROUND_COLOR
,
587 X_PARM_BACKGROUND_COLOR
,
594 X_PARM_INTERNAL_BORDER_WIDTH
,
598 X_PARM_VERT_SCROLL_BAR
,
600 X_PARM_MENU_BAR_LINES
604 struct x_frame_parm_table
607 void (*setter
)( /* struct frame *frame, Lisp_Object val, oldval */ );
610 void x_set_foreground_color ();
611 void x_set_background_color ();
612 void x_set_mouse_color ();
613 void x_set_cursor_color ();
614 void x_set_border_color ();
615 void x_set_cursor_type ();
616 void x_set_icon_type ();
617 void x_set_icon_name ();
619 void x_set_border_width ();
620 void x_set_internal_border_width ();
621 void x_explicitly_set_name ();
622 void x_set_autoraise ();
623 void x_set_autolower ();
624 void x_set_vertical_scroll_bars ();
625 void x_set_visibility ();
626 void x_set_menu_bar_lines ();
627 void x_set_scroll_bar_width ();
629 void x_set_unsplittable ();
631 static struct x_frame_parm_table x_frame_parms
[] =
633 "auto-raise", x_set_autoraise
,
634 "auto-lower", x_set_autolower
,
635 "background-color", x_set_background_color
,
636 "border-color", x_set_border_color
,
637 "border-width", x_set_border_width
,
638 "cursor-color", x_set_cursor_color
,
639 "cursor-type", x_set_cursor_type
,
641 "foreground-color", x_set_foreground_color
,
642 "icon-name", x_set_icon_name
,
643 "icon-type", x_set_icon_type
,
644 "internal-border-width", x_set_internal_border_width
,
645 "menu-bar-lines", x_set_menu_bar_lines
,
646 "mouse-color", x_set_mouse_color
,
647 "name", x_explicitly_set_name
,
648 "scroll-bar-width", x_set_scroll_bar_width
,
649 "title", x_set_title
,
650 "unsplittable", x_set_unsplittable
,
651 "vertical-scroll-bars", x_set_vertical_scroll_bars
,
652 "visibility", x_set_visibility
,
655 /* Attach the `x-frame-parameter' properties to
656 the Lisp symbol names of parameters relevant to W32. */
658 init_x_parm_symbols ()
662 for (i
= 0; i
< sizeof (x_frame_parms
) / sizeof (x_frame_parms
[0]); i
++)
663 Fput (intern (x_frame_parms
[i
].name
), Qx_frame_parameter
,
667 /* Change the parameters of FRAME as specified by ALIST.
668 If a parameter is not specially recognized, do nothing;
669 otherwise call the `x_set_...' function for that parameter. */
672 x_set_frame_parameters (f
, alist
)
678 /* If both of these parameters are present, it's more efficient to
679 set them both at once. So we wait until we've looked at the
680 entire list before we set them. */
684 Lisp_Object left
, top
;
686 /* Same with these. */
687 Lisp_Object icon_left
, icon_top
;
689 /* Record in these vectors all the parms specified. */
693 int left_no_change
= 0, top_no_change
= 0;
694 int icon_left_no_change
= 0, icon_top_no_change
= 0;
696 struct gcpro gcpro1
, gcpro2
;
699 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
702 parms
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
703 values
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
705 /* Extract parm names and values into those vectors. */
708 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
710 Lisp_Object elt
, prop
, val
;
713 parms
[i
] = Fcar (elt
);
714 values
[i
] = Fcdr (elt
);
718 /* TAIL and ALIST are not used again below here. */
721 GCPRO2 (*parms
, *values
);
725 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
726 because their values appear in VALUES and strings are not valid. */
727 top
= left
= Qunbound
;
728 icon_left
= icon_top
= Qunbound
;
730 /* Provide default values for HEIGHT and WIDTH. */
731 width
= FRAME_WIDTH (f
);
732 height
= FRAME_HEIGHT (f
);
734 /* Now process them in reverse of specified order. */
735 for (i
--; i
>= 0; i
--)
737 Lisp_Object prop
, val
;
742 if (EQ (prop
, Qwidth
) && NUMBERP (val
))
743 width
= XFASTINT (val
);
744 else if (EQ (prop
, Qheight
) && NUMBERP (val
))
745 height
= XFASTINT (val
);
746 else if (EQ (prop
, Qtop
))
748 else if (EQ (prop
, Qleft
))
750 else if (EQ (prop
, Qicon_top
))
752 else if (EQ (prop
, Qicon_left
))
756 register Lisp_Object param_index
, old_value
;
758 param_index
= Fget (prop
, Qx_frame_parameter
);
759 old_value
= get_frame_param (f
, prop
);
760 store_frame_param (f
, prop
, val
);
761 if (NATNUMP (param_index
)
762 && (XFASTINT (param_index
)
763 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
764 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
768 /* Don't die if just one of these was set. */
769 if (EQ (left
, Qunbound
))
772 if (f
->output_data
.w32
->left_pos
< 0)
773 left
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.w32
->left_pos
), Qnil
));
775 XSETINT (left
, f
->output_data
.w32
->left_pos
);
777 if (EQ (top
, Qunbound
))
780 if (f
->output_data
.w32
->top_pos
< 0)
781 top
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.w32
->top_pos
), Qnil
));
783 XSETINT (top
, f
->output_data
.w32
->top_pos
);
786 /* If one of the icon positions was not set, preserve or default it. */
787 if (EQ (icon_left
, Qunbound
) || ! INTEGERP (icon_left
))
789 icon_left_no_change
= 1;
790 icon_left
= Fcdr (Fassq (Qicon_left
, f
->param_alist
));
791 if (NILP (icon_left
))
792 XSETINT (icon_left
, 0);
794 if (EQ (icon_top
, Qunbound
) || ! INTEGERP (icon_top
))
796 icon_top_no_change
= 1;
797 icon_top
= Fcdr (Fassq (Qicon_top
, f
->param_alist
));
799 XSETINT (icon_top
, 0);
802 /* Don't set these parameters unless they've been explicitly
803 specified. The window might be mapped or resized while we're in
804 this function, and we don't want to override that unless the lisp
805 code has asked for it.
807 Don't set these parameters unless they actually differ from the
808 window's current parameters; the window may not actually exist
813 check_frame_size (f
, &height
, &width
);
815 XSETFRAME (frame
, f
);
817 if (XINT (width
) != FRAME_WIDTH (f
)
818 || XINT (height
) != FRAME_HEIGHT (f
))
819 Fset_frame_size (frame
, make_number (width
), make_number (height
));
821 if ((!NILP (left
) || !NILP (top
))
822 && ! (left_no_change
&& top_no_change
)
823 && ! (NUMBERP (left
) && XINT (left
) == f
->output_data
.w32
->left_pos
824 && NUMBERP (top
) && XINT (top
) == f
->output_data
.w32
->top_pos
))
829 /* Record the signs. */
830 f
->output_data
.w32
->size_hint_flags
&= ~ (XNegative
| YNegative
);
831 if (EQ (left
, Qminus
))
832 f
->output_data
.w32
->size_hint_flags
|= XNegative
;
833 else if (INTEGERP (left
))
835 leftpos
= XINT (left
);
837 f
->output_data
.w32
->size_hint_flags
|= XNegative
;
839 else if (CONSP (left
) && EQ (XCONS (left
)->car
, Qminus
)
840 && CONSP (XCONS (left
)->cdr
)
841 && INTEGERP (XCONS (XCONS (left
)->cdr
)->car
))
843 leftpos
= - XINT (XCONS (XCONS (left
)->cdr
)->car
);
844 f
->output_data
.w32
->size_hint_flags
|= XNegative
;
846 else if (CONSP (left
) && EQ (XCONS (left
)->car
, Qplus
)
847 && CONSP (XCONS (left
)->cdr
)
848 && INTEGERP (XCONS (XCONS (left
)->cdr
)->car
))
850 leftpos
= XINT (XCONS (XCONS (left
)->cdr
)->car
);
853 if (EQ (top
, Qminus
))
854 f
->output_data
.w32
->size_hint_flags
|= YNegative
;
855 else if (INTEGERP (top
))
859 f
->output_data
.w32
->size_hint_flags
|= YNegative
;
861 else if (CONSP (top
) && EQ (XCONS (top
)->car
, Qminus
)
862 && CONSP (XCONS (top
)->cdr
)
863 && INTEGERP (XCONS (XCONS (top
)->cdr
)->car
))
865 toppos
= - XINT (XCONS (XCONS (top
)->cdr
)->car
);
866 f
->output_data
.w32
->size_hint_flags
|= YNegative
;
868 else if (CONSP (top
) && EQ (XCONS (top
)->car
, Qplus
)
869 && CONSP (XCONS (top
)->cdr
)
870 && INTEGERP (XCONS (XCONS (top
)->cdr
)->car
))
872 toppos
= XINT (XCONS (XCONS (top
)->cdr
)->car
);
876 /* Store the numeric value of the position. */
877 f
->output_data
.w32
->top_pos
= toppos
;
878 f
->output_data
.w32
->left_pos
= leftpos
;
880 f
->output_data
.w32
->win_gravity
= NorthWestGravity
;
882 /* Actually set that position, and convert to absolute. */
883 x_set_offset (f
, leftpos
, toppos
, -1);
886 if ((!NILP (icon_left
) || !NILP (icon_top
))
887 && ! (icon_left_no_change
&& icon_top_no_change
))
888 x_wm_set_icon_position (f
, XINT (icon_left
), XINT (icon_top
));
894 /* Store the screen positions of frame F into XPTR and YPTR.
895 These are the positions of the containing window manager window,
896 not Emacs's own window. */
899 x_real_positions (f
, xptr
, yptr
)
908 GetClientRect(FRAME_W32_WINDOW(f
), &rect
);
909 AdjustWindowRect(&rect
, f
->output_data
.w32
->dwStyle
, FRAME_EXTERNAL_MENU_BAR(f
));
915 ClientToScreen (FRAME_W32_WINDOW(f
), &pt
);
921 /* Insert a description of internally-recorded parameters of frame X
922 into the parameter alist *ALISTPTR that is to be given to the user.
923 Only parameters that are specific to W32
924 and whose values are not correctly recorded in the frame's
925 param_alist need to be considered here. */
927 x_report_frame_params (f
, alistptr
)
929 Lisp_Object
*alistptr
;
934 /* Represent negative positions (off the top or left screen edge)
935 in a way that Fmodify_frame_parameters will understand correctly. */
936 XSETINT (tem
, f
->output_data
.w32
->left_pos
);
937 if (f
->output_data
.w32
->left_pos
>= 0)
938 store_in_alist (alistptr
, Qleft
, tem
);
940 store_in_alist (alistptr
, Qleft
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
942 XSETINT (tem
, f
->output_data
.w32
->top_pos
);
943 if (f
->output_data
.w32
->top_pos
>= 0)
944 store_in_alist (alistptr
, Qtop
, tem
);
946 store_in_alist (alistptr
, Qtop
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
948 store_in_alist (alistptr
, Qborder_width
,
949 make_number (f
->output_data
.w32
->border_width
));
950 store_in_alist (alistptr
, Qinternal_border_width
,
951 make_number (f
->output_data
.w32
->internal_border_width
));
952 sprintf (buf
, "%ld", (long) FRAME_W32_WINDOW (f
));
953 store_in_alist (alistptr
, Qwindow_id
,
955 store_in_alist (alistptr
, Qicon_name
, f
->icon_name
);
956 FRAME_SAMPLE_VISIBILITY (f
);
957 store_in_alist (alistptr
, Qvisibility
,
958 (FRAME_VISIBLE_P (f
) ? Qt
959 : FRAME_ICONIFIED_P (f
) ? Qicon
: Qnil
));
960 store_in_alist (alistptr
, Qdisplay
,
961 XCONS (FRAME_W32_DISPLAY_INFO (f
)->name_list_element
)->car
);
965 DEFUN ("w32-define-rgb-color", Fw32_define_rgb_color
, Sw32_define_rgb_color
, 4, 4, 0,
966 "Convert RGB numbers to a windows color reference and associate with NAME (a string).\n\
967 This adds or updates a named color to w32-color-map, making it available for use.\n\
968 The original entry's RGB ref is returned, or nil if the entry is new.")
969 (red
, green
, blue
, name
)
970 Lisp_Object red
, green
, blue
, name
;
973 Lisp_Object oldrgb
= Qnil
;
976 CHECK_NUMBER (red
, 0);
977 CHECK_NUMBER (green
, 0);
978 CHECK_NUMBER (blue
, 0);
979 CHECK_STRING (name
, 0);
981 XSET (rgb
, Lisp_Int
, RGB(XUINT (red
), XUINT (green
), XUINT (blue
)));
985 /* replace existing entry in w32-color-map or add new entry. */
986 entry
= Fassoc (name
, Vw32_color_map
);
989 entry
= Fcons (name
, rgb
);
990 Vw32_color_map
= Fcons (entry
, Vw32_color_map
);
994 oldrgb
= Fcdr (entry
);
995 Fsetcdr (entry
, rgb
);
1003 DEFUN ("w32-load-color-file", Fw32_load_color_file
, Sw32_load_color_file
, 1, 1, 0,
1004 "Create an alist of color entries from an external file (ie. rgb.txt).\n\
1005 Assign this value to w32-color-map to replace the existing color map.\n\
1007 The file should define one named RGB color per line like so:\
1009 where R,G,B are numbers between 0 and 255 and name is an arbitrary string.")
1011 Lisp_Object filename
;
1014 Lisp_Object cmap
= Qnil
;
1015 Lisp_Object abspath
;
1017 CHECK_STRING (filename
, 0);
1018 abspath
= Fexpand_file_name (filename
, Qnil
);
1020 fp
= fopen (XSTRING (filename
)->data
, "rt");
1024 int red
, green
, blue
;
1029 while (fgets (buf
, sizeof (buf
), fp
) != NULL
) {
1030 if (sscanf (buf
, "%u %u %u %n", &red
, &green
, &blue
, &num
) == 3)
1032 char *name
= buf
+ num
;
1033 num
= strlen (name
) - 1;
1034 if (name
[num
] == '\n')
1036 cmap
= Fcons (Fcons (build_string (name
),
1037 make_number (RGB (red
, green
, blue
))),
1049 /* The default colors for the w32 color map */
1050 typedef struct colormap_t
1056 colormap_t w32_color_map
[] =
1058 {"snow" , PALETTERGB (255,250,250)},
1059 {"ghost white" , PALETTERGB (248,248,255)},
1060 {"GhostWhite" , PALETTERGB (248,248,255)},
1061 {"white smoke" , PALETTERGB (245,245,245)},
1062 {"WhiteSmoke" , PALETTERGB (245,245,245)},
1063 {"gainsboro" , PALETTERGB (220,220,220)},
1064 {"floral white" , PALETTERGB (255,250,240)},
1065 {"FloralWhite" , PALETTERGB (255,250,240)},
1066 {"old lace" , PALETTERGB (253,245,230)},
1067 {"OldLace" , PALETTERGB (253,245,230)},
1068 {"linen" , PALETTERGB (250,240,230)},
1069 {"antique white" , PALETTERGB (250,235,215)},
1070 {"AntiqueWhite" , PALETTERGB (250,235,215)},
1071 {"papaya whip" , PALETTERGB (255,239,213)},
1072 {"PapayaWhip" , PALETTERGB (255,239,213)},
1073 {"blanched almond" , PALETTERGB (255,235,205)},
1074 {"BlanchedAlmond" , PALETTERGB (255,235,205)},
1075 {"bisque" , PALETTERGB (255,228,196)},
1076 {"peach puff" , PALETTERGB (255,218,185)},
1077 {"PeachPuff" , PALETTERGB (255,218,185)},
1078 {"navajo white" , PALETTERGB (255,222,173)},
1079 {"NavajoWhite" , PALETTERGB (255,222,173)},
1080 {"moccasin" , PALETTERGB (255,228,181)},
1081 {"cornsilk" , PALETTERGB (255,248,220)},
1082 {"ivory" , PALETTERGB (255,255,240)},
1083 {"lemon chiffon" , PALETTERGB (255,250,205)},
1084 {"LemonChiffon" , PALETTERGB (255,250,205)},
1085 {"seashell" , PALETTERGB (255,245,238)},
1086 {"honeydew" , PALETTERGB (240,255,240)},
1087 {"mint cream" , PALETTERGB (245,255,250)},
1088 {"MintCream" , PALETTERGB (245,255,250)},
1089 {"azure" , PALETTERGB (240,255,255)},
1090 {"alice blue" , PALETTERGB (240,248,255)},
1091 {"AliceBlue" , PALETTERGB (240,248,255)},
1092 {"lavender" , PALETTERGB (230,230,250)},
1093 {"lavender blush" , PALETTERGB (255,240,245)},
1094 {"LavenderBlush" , PALETTERGB (255,240,245)},
1095 {"misty rose" , PALETTERGB (255,228,225)},
1096 {"MistyRose" , PALETTERGB (255,228,225)},
1097 {"white" , PALETTERGB (255,255,255)},
1098 {"black" , PALETTERGB ( 0, 0, 0)},
1099 {"dark slate gray" , PALETTERGB ( 47, 79, 79)},
1100 {"DarkSlateGray" , PALETTERGB ( 47, 79, 79)},
1101 {"dark slate grey" , PALETTERGB ( 47, 79, 79)},
1102 {"DarkSlateGrey" , PALETTERGB ( 47, 79, 79)},
1103 {"dim gray" , PALETTERGB (105,105,105)},
1104 {"DimGray" , PALETTERGB (105,105,105)},
1105 {"dim grey" , PALETTERGB (105,105,105)},
1106 {"DimGrey" , PALETTERGB (105,105,105)},
1107 {"slate gray" , PALETTERGB (112,128,144)},
1108 {"SlateGray" , PALETTERGB (112,128,144)},
1109 {"slate grey" , PALETTERGB (112,128,144)},
1110 {"SlateGrey" , PALETTERGB (112,128,144)},
1111 {"light slate gray" , PALETTERGB (119,136,153)},
1112 {"LightSlateGray" , PALETTERGB (119,136,153)},
1113 {"light slate grey" , PALETTERGB (119,136,153)},
1114 {"LightSlateGrey" , PALETTERGB (119,136,153)},
1115 {"gray" , PALETTERGB (190,190,190)},
1116 {"grey" , PALETTERGB (190,190,190)},
1117 {"light grey" , PALETTERGB (211,211,211)},
1118 {"LightGrey" , PALETTERGB (211,211,211)},
1119 {"light gray" , PALETTERGB (211,211,211)},
1120 {"LightGray" , PALETTERGB (211,211,211)},
1121 {"midnight blue" , PALETTERGB ( 25, 25,112)},
1122 {"MidnightBlue" , PALETTERGB ( 25, 25,112)},
1123 {"navy" , PALETTERGB ( 0, 0,128)},
1124 {"navy blue" , PALETTERGB ( 0, 0,128)},
1125 {"NavyBlue" , PALETTERGB ( 0, 0,128)},
1126 {"cornflower blue" , PALETTERGB (100,149,237)},
1127 {"CornflowerBlue" , PALETTERGB (100,149,237)},
1128 {"dark slate blue" , PALETTERGB ( 72, 61,139)},
1129 {"DarkSlateBlue" , PALETTERGB ( 72, 61,139)},
1130 {"slate blue" , PALETTERGB (106, 90,205)},
1131 {"SlateBlue" , PALETTERGB (106, 90,205)},
1132 {"medium slate blue" , PALETTERGB (123,104,238)},
1133 {"MediumSlateBlue" , PALETTERGB (123,104,238)},
1134 {"light slate blue" , PALETTERGB (132,112,255)},
1135 {"LightSlateBlue" , PALETTERGB (132,112,255)},
1136 {"medium blue" , PALETTERGB ( 0, 0,205)},
1137 {"MediumBlue" , PALETTERGB ( 0, 0,205)},
1138 {"royal blue" , PALETTERGB ( 65,105,225)},
1139 {"RoyalBlue" , PALETTERGB ( 65,105,225)},
1140 {"blue" , PALETTERGB ( 0, 0,255)},
1141 {"dodger blue" , PALETTERGB ( 30,144,255)},
1142 {"DodgerBlue" , PALETTERGB ( 30,144,255)},
1143 {"deep sky blue" , PALETTERGB ( 0,191,255)},
1144 {"DeepSkyBlue" , PALETTERGB ( 0,191,255)},
1145 {"sky blue" , PALETTERGB (135,206,235)},
1146 {"SkyBlue" , PALETTERGB (135,206,235)},
1147 {"light sky blue" , PALETTERGB (135,206,250)},
1148 {"LightSkyBlue" , PALETTERGB (135,206,250)},
1149 {"steel blue" , PALETTERGB ( 70,130,180)},
1150 {"SteelBlue" , PALETTERGB ( 70,130,180)},
1151 {"light steel blue" , PALETTERGB (176,196,222)},
1152 {"LightSteelBlue" , PALETTERGB (176,196,222)},
1153 {"light blue" , PALETTERGB (173,216,230)},
1154 {"LightBlue" , PALETTERGB (173,216,230)},
1155 {"powder blue" , PALETTERGB (176,224,230)},
1156 {"PowderBlue" , PALETTERGB (176,224,230)},
1157 {"pale turquoise" , PALETTERGB (175,238,238)},
1158 {"PaleTurquoise" , PALETTERGB (175,238,238)},
1159 {"dark turquoise" , PALETTERGB ( 0,206,209)},
1160 {"DarkTurquoise" , PALETTERGB ( 0,206,209)},
1161 {"medium turquoise" , PALETTERGB ( 72,209,204)},
1162 {"MediumTurquoise" , PALETTERGB ( 72,209,204)},
1163 {"turquoise" , PALETTERGB ( 64,224,208)},
1164 {"cyan" , PALETTERGB ( 0,255,255)},
1165 {"light cyan" , PALETTERGB (224,255,255)},
1166 {"LightCyan" , PALETTERGB (224,255,255)},
1167 {"cadet blue" , PALETTERGB ( 95,158,160)},
1168 {"CadetBlue" , PALETTERGB ( 95,158,160)},
1169 {"medium aquamarine" , PALETTERGB (102,205,170)},
1170 {"MediumAquamarine" , PALETTERGB (102,205,170)},
1171 {"aquamarine" , PALETTERGB (127,255,212)},
1172 {"dark green" , PALETTERGB ( 0,100, 0)},
1173 {"DarkGreen" , PALETTERGB ( 0,100, 0)},
1174 {"dark olive green" , PALETTERGB ( 85,107, 47)},
1175 {"DarkOliveGreen" , PALETTERGB ( 85,107, 47)},
1176 {"dark sea green" , PALETTERGB (143,188,143)},
1177 {"DarkSeaGreen" , PALETTERGB (143,188,143)},
1178 {"sea green" , PALETTERGB ( 46,139, 87)},
1179 {"SeaGreen" , PALETTERGB ( 46,139, 87)},
1180 {"medium sea green" , PALETTERGB ( 60,179,113)},
1181 {"MediumSeaGreen" , PALETTERGB ( 60,179,113)},
1182 {"light sea green" , PALETTERGB ( 32,178,170)},
1183 {"LightSeaGreen" , PALETTERGB ( 32,178,170)},
1184 {"pale green" , PALETTERGB (152,251,152)},
1185 {"PaleGreen" , PALETTERGB (152,251,152)},
1186 {"spring green" , PALETTERGB ( 0,255,127)},
1187 {"SpringGreen" , PALETTERGB ( 0,255,127)},
1188 {"lawn green" , PALETTERGB (124,252, 0)},
1189 {"LawnGreen" , PALETTERGB (124,252, 0)},
1190 {"green" , PALETTERGB ( 0,255, 0)},
1191 {"chartreuse" , PALETTERGB (127,255, 0)},
1192 {"medium spring green" , PALETTERGB ( 0,250,154)},
1193 {"MediumSpringGreen" , PALETTERGB ( 0,250,154)},
1194 {"green yellow" , PALETTERGB (173,255, 47)},
1195 {"GreenYellow" , PALETTERGB (173,255, 47)},
1196 {"lime green" , PALETTERGB ( 50,205, 50)},
1197 {"LimeGreen" , PALETTERGB ( 50,205, 50)},
1198 {"yellow green" , PALETTERGB (154,205, 50)},
1199 {"YellowGreen" , PALETTERGB (154,205, 50)},
1200 {"forest green" , PALETTERGB ( 34,139, 34)},
1201 {"ForestGreen" , PALETTERGB ( 34,139, 34)},
1202 {"olive drab" , PALETTERGB (107,142, 35)},
1203 {"OliveDrab" , PALETTERGB (107,142, 35)},
1204 {"dark khaki" , PALETTERGB (189,183,107)},
1205 {"DarkKhaki" , PALETTERGB (189,183,107)},
1206 {"khaki" , PALETTERGB (240,230,140)},
1207 {"pale goldenrod" , PALETTERGB (238,232,170)},
1208 {"PaleGoldenrod" , PALETTERGB (238,232,170)},
1209 {"light goldenrod yellow" , PALETTERGB (250,250,210)},
1210 {"LightGoldenrodYellow" , PALETTERGB (250,250,210)},
1211 {"light yellow" , PALETTERGB (255,255,224)},
1212 {"LightYellow" , PALETTERGB (255,255,224)},
1213 {"yellow" , PALETTERGB (255,255, 0)},
1214 {"gold" , PALETTERGB (255,215, 0)},
1215 {"light goldenrod" , PALETTERGB (238,221,130)},
1216 {"LightGoldenrod" , PALETTERGB (238,221,130)},
1217 {"goldenrod" , PALETTERGB (218,165, 32)},
1218 {"dark goldenrod" , PALETTERGB (184,134, 11)},
1219 {"DarkGoldenrod" , PALETTERGB (184,134, 11)},
1220 {"rosy brown" , PALETTERGB (188,143,143)},
1221 {"RosyBrown" , PALETTERGB (188,143,143)},
1222 {"indian red" , PALETTERGB (205, 92, 92)},
1223 {"IndianRed" , PALETTERGB (205, 92, 92)},
1224 {"saddle brown" , PALETTERGB (139, 69, 19)},
1225 {"SaddleBrown" , PALETTERGB (139, 69, 19)},
1226 {"sienna" , PALETTERGB (160, 82, 45)},
1227 {"peru" , PALETTERGB (205,133, 63)},
1228 {"burlywood" , PALETTERGB (222,184,135)},
1229 {"beige" , PALETTERGB (245,245,220)},
1230 {"wheat" , PALETTERGB (245,222,179)},
1231 {"sandy brown" , PALETTERGB (244,164, 96)},
1232 {"SandyBrown" , PALETTERGB (244,164, 96)},
1233 {"tan" , PALETTERGB (210,180,140)},
1234 {"chocolate" , PALETTERGB (210,105, 30)},
1235 {"firebrick" , PALETTERGB (178,34, 34)},
1236 {"brown" , PALETTERGB (165,42, 42)},
1237 {"dark salmon" , PALETTERGB (233,150,122)},
1238 {"DarkSalmon" , PALETTERGB (233,150,122)},
1239 {"salmon" , PALETTERGB (250,128,114)},
1240 {"light salmon" , PALETTERGB (255,160,122)},
1241 {"LightSalmon" , PALETTERGB (255,160,122)},
1242 {"orange" , PALETTERGB (255,165, 0)},
1243 {"dark orange" , PALETTERGB (255,140, 0)},
1244 {"DarkOrange" , PALETTERGB (255,140, 0)},
1245 {"coral" , PALETTERGB (255,127, 80)},
1246 {"light coral" , PALETTERGB (240,128,128)},
1247 {"LightCoral" , PALETTERGB (240,128,128)},
1248 {"tomato" , PALETTERGB (255, 99, 71)},
1249 {"orange red" , PALETTERGB (255, 69, 0)},
1250 {"OrangeRed" , PALETTERGB (255, 69, 0)},
1251 {"red" , PALETTERGB (255, 0, 0)},
1252 {"hot pink" , PALETTERGB (255,105,180)},
1253 {"HotPink" , PALETTERGB (255,105,180)},
1254 {"deep pink" , PALETTERGB (255, 20,147)},
1255 {"DeepPink" , PALETTERGB (255, 20,147)},
1256 {"pink" , PALETTERGB (255,192,203)},
1257 {"light pink" , PALETTERGB (255,182,193)},
1258 {"LightPink" , PALETTERGB (255,182,193)},
1259 {"pale violet red" , PALETTERGB (219,112,147)},
1260 {"PaleVioletRed" , PALETTERGB (219,112,147)},
1261 {"maroon" , PALETTERGB (176, 48, 96)},
1262 {"medium violet red" , PALETTERGB (199, 21,133)},
1263 {"MediumVioletRed" , PALETTERGB (199, 21,133)},
1264 {"violet red" , PALETTERGB (208, 32,144)},
1265 {"VioletRed" , PALETTERGB (208, 32,144)},
1266 {"magenta" , PALETTERGB (255, 0,255)},
1267 {"violet" , PALETTERGB (238,130,238)},
1268 {"plum" , PALETTERGB (221,160,221)},
1269 {"orchid" , PALETTERGB (218,112,214)},
1270 {"medium orchid" , PALETTERGB (186, 85,211)},
1271 {"MediumOrchid" , PALETTERGB (186, 85,211)},
1272 {"dark orchid" , PALETTERGB (153, 50,204)},
1273 {"DarkOrchid" , PALETTERGB (153, 50,204)},
1274 {"dark violet" , PALETTERGB (148, 0,211)},
1275 {"DarkViolet" , PALETTERGB (148, 0,211)},
1276 {"blue violet" , PALETTERGB (138, 43,226)},
1277 {"BlueViolet" , PALETTERGB (138, 43,226)},
1278 {"purple" , PALETTERGB (160, 32,240)},
1279 {"medium purple" , PALETTERGB (147,112,219)},
1280 {"MediumPurple" , PALETTERGB (147,112,219)},
1281 {"thistle" , PALETTERGB (216,191,216)},
1282 {"gray0" , PALETTERGB ( 0, 0, 0)},
1283 {"grey0" , PALETTERGB ( 0, 0, 0)},
1284 {"dark grey" , PALETTERGB (169,169,169)},
1285 {"DarkGrey" , PALETTERGB (169,169,169)},
1286 {"dark gray" , PALETTERGB (169,169,169)},
1287 {"DarkGray" , PALETTERGB (169,169,169)},
1288 {"dark blue" , PALETTERGB ( 0, 0,139)},
1289 {"DarkBlue" , PALETTERGB ( 0, 0,139)},
1290 {"dark cyan" , PALETTERGB ( 0,139,139)},
1291 {"DarkCyan" , PALETTERGB ( 0,139,139)},
1292 {"dark magenta" , PALETTERGB (139, 0,139)},
1293 {"DarkMagenta" , PALETTERGB (139, 0,139)},
1294 {"dark red" , PALETTERGB (139, 0, 0)},
1295 {"DarkRed" , PALETTERGB (139, 0, 0)},
1296 {"light green" , PALETTERGB (144,238,144)},
1297 {"LightGreen" , PALETTERGB (144,238,144)},
1300 DEFUN ("w32-default-color-map", Fw32_default_color_map
, Sw32_default_color_map
,
1301 0, 0, 0, "Return the default color map.")
1305 colormap_t
*pc
= w32_color_map
;
1312 for (i
= 0; i
< sizeof (w32_color_map
) / sizeof (w32_color_map
[0]);
1314 cmap
= Fcons (Fcons (build_string (pc
->name
),
1315 make_number (pc
->colorref
)),
1324 w32_to_x_color (rgb
)
1329 CHECK_NUMBER (rgb
, 0);
1333 color
= Frassq (rgb
, Vw32_color_map
);
1338 return (Fcar (color
));
1344 w32_color_map_lookup (colorname
)
1347 Lisp_Object tail
, ret
= Qnil
;
1351 for (tail
= Vw32_color_map
; !NILP (tail
); tail
= Fcdr (tail
))
1353 register Lisp_Object elt
, tem
;
1356 if (!CONSP (elt
)) continue;
1360 if (lstrcmpi (XSTRING (tem
)->data
, colorname
) == 0)
1362 ret
= XUINT (Fcdr (elt
));
1376 x_to_w32_color (colorname
)
1379 register Lisp_Object tail
, ret
= Qnil
;
1383 if (colorname
[0] == '#')
1385 /* Could be an old-style RGB Device specification. */
1388 color
= colorname
+ 1;
1390 size
= strlen(color
);
1391 if (size
== 3 || size
== 6 || size
== 9 || size
== 12)
1399 for (i
= 0; i
< 3; i
++)
1403 unsigned long value
;
1405 /* The check for 'x' in the following conditional takes into
1406 account the fact that strtol allows a "0x" in front of
1407 our numbers, and we don't. */
1408 if (!isxdigit(color
[0]) || color
[1] == 'x')
1412 value
= strtoul(color
, &end
, 16);
1414 if (errno
== ERANGE
|| end
- color
!= size
)
1419 value
= value
* 0x10;
1430 colorval
|= (value
<< pos
);
1441 else if (strnicmp(colorname
, "rgb:", 4) == 0)
1449 color
= colorname
+ 4;
1450 for (i
= 0; i
< 3; i
++)
1453 unsigned long value
;
1455 /* The check for 'x' in the following conditional takes into
1456 account the fact that strtol allows a "0x" in front of
1457 our numbers, and we don't. */
1458 if (!isxdigit(color
[0]) || color
[1] == 'x')
1460 value
= strtoul(color
, &end
, 16);
1461 if (errno
== ERANGE
)
1463 switch (end
- color
)
1466 value
= value
* 0x10 + value
;
1479 if (value
== ULONG_MAX
)
1481 colorval
|= (value
<< pos
);
1495 else if (strnicmp(colorname
, "rgbi:", 5) == 0)
1497 /* This is an RGB Intensity specification. */
1504 color
= colorname
+ 5;
1505 for (i
= 0; i
< 3; i
++)
1511 value
= strtod(color
, &end
);
1512 if (errno
== ERANGE
)
1514 if (value
< 0.0 || value
> 1.0)
1516 val
= (UINT
)(0x100 * value
);
1517 /* We used 0x100 instead of 0xFF to give an continuous
1518 range between 0.0 and 1.0 inclusive. The next statement
1519 fixes the 1.0 case. */
1522 colorval
|= (val
<< pos
);
1536 /* I am not going to attempt to handle any of the CIE color schemes
1537 or TekHVC, since I don't know the algorithms for conversion to
1540 /* If we fail to lookup the color name in w32_color_map, then check the
1541 colorname to see if it can be crudely approximated: If the X color
1542 ends in a number (e.g., "darkseagreen2"), strip the number and
1543 return the result of looking up the base color name. */
1544 ret
= w32_color_map_lookup (colorname
);
1547 int len
= strlen (colorname
);
1549 if (isdigit (colorname
[len
- 1]))
1551 char *ptr
, *approx
= alloca (len
);
1553 strcpy (approx
, colorname
);
1554 ptr
= &approx
[len
- 1];
1555 while (ptr
> approx
&& isdigit (*ptr
))
1558 ret
= w32_color_map_lookup (approx
);
1568 w32_regenerate_palette (FRAME_PTR f
)
1570 struct w32_palette_entry
* list
;
1571 LOGPALETTE
* log_palette
;
1572 HPALETTE new_palette
;
1575 /* don't bother trying to create palette if not supported */
1576 if (! FRAME_W32_DISPLAY_INFO (f
)->has_palette
)
1579 log_palette
= (LOGPALETTE
*)
1580 alloca (sizeof (LOGPALETTE
) +
1581 FRAME_W32_DISPLAY_INFO (f
)->num_colors
* sizeof (PALETTEENTRY
));
1582 log_palette
->palVersion
= 0x300;
1583 log_palette
->palNumEntries
= FRAME_W32_DISPLAY_INFO (f
)->num_colors
;
1585 list
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1587 i
< FRAME_W32_DISPLAY_INFO (f
)->num_colors
;
1588 i
++, list
= list
->next
)
1589 log_palette
->palPalEntry
[i
] = list
->entry
;
1591 new_palette
= CreatePalette (log_palette
);
1595 if (FRAME_W32_DISPLAY_INFO (f
)->palette
)
1596 DeleteObject (FRAME_W32_DISPLAY_INFO (f
)->palette
);
1597 FRAME_W32_DISPLAY_INFO (f
)->palette
= new_palette
;
1599 /* Realize display palette and garbage all frames. */
1600 release_frame_dc (f
, get_frame_dc (f
));
1605 #define W32_COLOR(pe) RGB (pe.peRed, pe.peGreen, pe.peBlue)
1606 #define SET_W32_COLOR(pe, color) \
1609 pe.peRed = GetRValue (color); \
1610 pe.peGreen = GetGValue (color); \
1611 pe.peBlue = GetBValue (color); \
1616 /* Keep these around in case we ever want to track color usage. */
1618 w32_map_color (FRAME_PTR f
, COLORREF color
)
1620 struct w32_palette_entry
* list
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1622 if (NILP (Vw32_enable_palette
))
1625 /* check if color is already mapped */
1628 if (W32_COLOR (list
->entry
) == color
)
1636 /* not already mapped, so add to list and recreate Windows palette */
1637 list
= (struct w32_palette_entry
*)
1638 xmalloc (sizeof (struct w32_palette_entry
));
1639 SET_W32_COLOR (list
->entry
, color
);
1641 list
->next
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1642 FRAME_W32_DISPLAY_INFO (f
)->color_list
= list
;
1643 FRAME_W32_DISPLAY_INFO (f
)->num_colors
++;
1645 /* set flag that palette must be regenerated */
1646 FRAME_W32_DISPLAY_INFO (f
)->regen_palette
= TRUE
;
1650 w32_unmap_color (FRAME_PTR f
, COLORREF color
)
1652 struct w32_palette_entry
* list
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1653 struct w32_palette_entry
**prev
= &FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1655 if (NILP (Vw32_enable_palette
))
1658 /* check if color is already mapped */
1661 if (W32_COLOR (list
->entry
) == color
)
1663 if (--list
->refcount
== 0)
1667 FRAME_W32_DISPLAY_INFO (f
)->num_colors
--;
1677 /* set flag that palette must be regenerated */
1678 FRAME_W32_DISPLAY_INFO (f
)->regen_palette
= TRUE
;
1682 /* Decide if color named COLOR is valid for the display associated with
1683 the selected frame; if so, return the rgb values in COLOR_DEF.
1684 If ALLOC is nonzero, allocate a new colormap cell. */
1687 defined_color (f
, color
, color_def
, alloc
)
1690 COLORREF
*color_def
;
1693 register Lisp_Object tem
;
1695 tem
= x_to_w32_color (color
);
1699 if (!NILP (Vw32_enable_palette
))
1701 struct w32_palette_entry
* entry
=
1702 FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1703 struct w32_palette_entry
** prev
=
1704 &FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1706 /* check if color is already mapped */
1709 if (W32_COLOR (entry
->entry
) == XUINT (tem
))
1711 prev
= &entry
->next
;
1712 entry
= entry
->next
;
1715 if (entry
== NULL
&& alloc
)
1717 /* not already mapped, so add to list */
1718 entry
= (struct w32_palette_entry
*)
1719 xmalloc (sizeof (struct w32_palette_entry
));
1720 SET_W32_COLOR (entry
->entry
, XUINT (tem
));
1723 FRAME_W32_DISPLAY_INFO (f
)->num_colors
++;
1725 /* set flag that palette must be regenerated */
1726 FRAME_W32_DISPLAY_INFO (f
)->regen_palette
= TRUE
;
1729 /* Ensure COLORREF value is snapped to nearest color in (default)
1730 palette by simulating the PALETTERGB macro. This works whether
1731 or not the display device has a palette. */
1732 *color_def
= XUINT (tem
) | 0x2000000;
1741 /* Given a string ARG naming a color, compute a pixel value from it
1742 suitable for screen F.
1743 If F is not a color screen, return DEF (default) regardless of what
1747 x_decode_color (f
, arg
, def
)
1754 CHECK_STRING (arg
, 0);
1756 if (strcmp (XSTRING (arg
)->data
, "black") == 0)
1757 return BLACK_PIX_DEFAULT (f
);
1758 else if (strcmp (XSTRING (arg
)->data
, "white") == 0)
1759 return WHITE_PIX_DEFAULT (f
);
1761 if ((FRAME_W32_DISPLAY_INFO (f
)->n_planes
* FRAME_W32_DISPLAY_INFO (f
)->n_cbits
) == 1)
1764 /* defined_color is responsible for coping with failures
1765 by looking for a near-miss. */
1766 if (defined_color (f
, XSTRING (arg
)->data
, &cdef
, 1))
1769 /* defined_color failed; return an ultimate default. */
1773 /* Functions called only from `x_set_frame_param'
1774 to set individual parameters.
1776 If FRAME_W32_WINDOW (f) is 0,
1777 the frame is being created and its window does not exist yet.
1778 In that case, just record the parameter's new value
1779 in the standard place; do not attempt to change the window. */
1782 x_set_foreground_color (f
, arg
, oldval
)
1784 Lisp_Object arg
, oldval
;
1786 f
->output_data
.w32
->foreground_pixel
1787 = x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1789 if (FRAME_W32_WINDOW (f
) != 0)
1791 recompute_basic_faces (f
);
1792 if (FRAME_VISIBLE_P (f
))
1798 x_set_background_color (f
, arg
, oldval
)
1800 Lisp_Object arg
, oldval
;
1805 f
->output_data
.w32
->background_pixel
1806 = x_decode_color (f
, arg
, WHITE_PIX_DEFAULT (f
));
1808 if (FRAME_W32_WINDOW (f
) != 0)
1810 SetWindowLong (FRAME_W32_WINDOW (f
), WND_BACKGROUND_INDEX
, f
->output_data
.w32
->background_pixel
);
1812 recompute_basic_faces (f
);
1814 if (FRAME_VISIBLE_P (f
))
1820 x_set_mouse_color (f
, arg
, oldval
)
1822 Lisp_Object arg
, oldval
;
1825 Cursor cursor
, nontext_cursor
, mode_cursor
, cross_cursor
;
1830 if (!EQ (Qnil
, arg
))
1831 f
->output_data
.w32
->mouse_pixel
1832 = x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1833 mask_color
= f
->output_data
.w32
->background_pixel
;
1834 /* No invisible pointers. */
1835 if (mask_color
== f
->output_data
.w32
->mouse_pixel
1836 && mask_color
== f
->output_data
.w32
->background_pixel
)
1837 f
->output_data
.w32
->mouse_pixel
= f
->output_data
.w32
->foreground_pixel
;
1842 /* It's not okay to crash if the user selects a screwy cursor. */
1843 count
= x_catch_errors (FRAME_W32_DISPLAY (f
));
1845 if (!EQ (Qnil
, Vx_pointer_shape
))
1847 CHECK_NUMBER (Vx_pointer_shape
, 0);
1848 cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XINT (Vx_pointer_shape
));
1851 cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_xterm
);
1852 x_check_errors (FRAME_W32_DISPLAY (f
), "bad text pointer cursor: %s");
1854 if (!EQ (Qnil
, Vx_nontext_pointer_shape
))
1856 CHECK_NUMBER (Vx_nontext_pointer_shape
, 0);
1857 nontext_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
),
1858 XINT (Vx_nontext_pointer_shape
));
1861 nontext_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_left_ptr
);
1862 x_check_errors (FRAME_W32_DISPLAY (f
), "bad nontext pointer cursor: %s");
1864 if (!EQ (Qnil
, Vx_mode_pointer_shape
))
1866 CHECK_NUMBER (Vx_mode_pointer_shape
, 0);
1867 mode_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
),
1868 XINT (Vx_mode_pointer_shape
));
1871 mode_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_xterm
);
1872 x_check_errors (FRAME_W32_DISPLAY (f
), "bad modeline pointer cursor: %s");
1874 if (!EQ (Qnil
, Vx_sensitive_text_pointer_shape
))
1876 CHECK_NUMBER (Vx_sensitive_text_pointer_shape
, 0);
1878 = XCreateFontCursor (FRAME_W32_DISPLAY (f
),
1879 XINT (Vx_sensitive_text_pointer_shape
));
1882 cross_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_crosshair
);
1884 /* Check and report errors with the above calls. */
1885 x_check_errors (FRAME_W32_DISPLAY (f
), "can't set cursor shape: %s");
1886 x_uncatch_errors (FRAME_W32_DISPLAY (f
), count
);
1889 XColor fore_color
, back_color
;
1891 fore_color
.pixel
= f
->output_data
.w32
->mouse_pixel
;
1892 back_color
.pixel
= mask_color
;
1893 XQueryColor (FRAME_W32_DISPLAY (f
),
1894 DefaultColormap (FRAME_W32_DISPLAY (f
),
1895 DefaultScreen (FRAME_W32_DISPLAY (f
))),
1897 XQueryColor (FRAME_W32_DISPLAY (f
),
1898 DefaultColormap (FRAME_W32_DISPLAY (f
),
1899 DefaultScreen (FRAME_W32_DISPLAY (f
))),
1901 XRecolorCursor (FRAME_W32_DISPLAY (f
), cursor
,
1902 &fore_color
, &back_color
);
1903 XRecolorCursor (FRAME_W32_DISPLAY (f
), nontext_cursor
,
1904 &fore_color
, &back_color
);
1905 XRecolorCursor (FRAME_W32_DISPLAY (f
), mode_cursor
,
1906 &fore_color
, &back_color
);
1907 XRecolorCursor (FRAME_W32_DISPLAY (f
), cross_cursor
,
1908 &fore_color
, &back_color
);
1911 if (FRAME_W32_WINDOW (f
) != 0)
1913 XDefineCursor (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
), cursor
);
1916 if (cursor
!= f
->output_data
.w32
->text_cursor
&& f
->output_data
.w32
->text_cursor
!= 0)
1917 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->text_cursor
);
1918 f
->output_data
.w32
->text_cursor
= cursor
;
1920 if (nontext_cursor
!= f
->output_data
.w32
->nontext_cursor
1921 && f
->output_data
.w32
->nontext_cursor
!= 0)
1922 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->nontext_cursor
);
1923 f
->output_data
.w32
->nontext_cursor
= nontext_cursor
;
1925 if (mode_cursor
!= f
->output_data
.w32
->modeline_cursor
1926 && f
->output_data
.w32
->modeline_cursor
!= 0)
1927 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->modeline_cursor
);
1928 f
->output_data
.w32
->modeline_cursor
= mode_cursor
;
1929 if (cross_cursor
!= f
->output_data
.w32
->cross_cursor
1930 && f
->output_data
.w32
->cross_cursor
!= 0)
1931 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->cross_cursor
);
1932 f
->output_data
.w32
->cross_cursor
= cross_cursor
;
1934 XFlush (FRAME_W32_DISPLAY (f
));
1940 x_set_cursor_color (f
, arg
, oldval
)
1942 Lisp_Object arg
, oldval
;
1944 unsigned long fore_pixel
;
1946 if (!EQ (Vx_cursor_fore_pixel
, Qnil
))
1947 fore_pixel
= x_decode_color (f
, Vx_cursor_fore_pixel
,
1948 WHITE_PIX_DEFAULT (f
));
1950 fore_pixel
= f
->output_data
.w32
->background_pixel
;
1951 f
->output_data
.w32
->cursor_pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1953 /* Make sure that the cursor color differs from the background color. */
1954 if (f
->output_data
.w32
->cursor_pixel
== f
->output_data
.w32
->background_pixel
)
1956 f
->output_data
.w32
->cursor_pixel
= f
->output_data
.w32
->mouse_pixel
;
1957 if (f
->output_data
.w32
->cursor_pixel
== fore_pixel
)
1958 fore_pixel
= f
->output_data
.w32
->background_pixel
;
1960 f
->output_data
.w32
->cursor_foreground_pixel
= fore_pixel
;
1962 if (FRAME_W32_WINDOW (f
) != 0)
1964 if (FRAME_VISIBLE_P (f
))
1966 x_display_cursor (f
, 0);
1967 x_display_cursor (f
, 1);
1972 /* Set the border-color of frame F to pixel value PIX.
1973 Note that this does not fully take effect if done before
1976 x_set_border_pixel (f
, pix
)
1980 f
->output_data
.w32
->border_pixel
= pix
;
1982 if (FRAME_W32_WINDOW (f
) != 0 && f
->output_data
.w32
->border_width
> 0)
1984 if (FRAME_VISIBLE_P (f
))
1989 /* Set the border-color of frame F to value described by ARG.
1990 ARG can be a string naming a color.
1991 The border-color is used for the border that is drawn by the server.
1992 Note that this does not fully take effect if done before
1993 F has a window; it must be redone when the window is created. */
1996 x_set_border_color (f
, arg
, oldval
)
1998 Lisp_Object arg
, oldval
;
2003 CHECK_STRING (arg
, 0);
2004 str
= XSTRING (arg
)->data
;
2006 pix
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
2008 x_set_border_pixel (f
, pix
);
2012 x_set_cursor_type (f
, arg
, oldval
)
2014 Lisp_Object arg
, oldval
;
2018 FRAME_DESIRED_CURSOR (f
) = bar_cursor
;
2019 f
->output_data
.w32
->cursor_width
= 2;
2021 else if (CONSP (arg
) && EQ (XCONS (arg
)->car
, Qbar
)
2022 && INTEGERP (XCONS (arg
)->cdr
))
2024 FRAME_DESIRED_CURSOR (f
) = bar_cursor
;
2025 f
->output_data
.w32
->cursor_width
= XINT (XCONS (arg
)->cdr
);
2028 /* Treat anything unknown as "box cursor".
2029 It was bad to signal an error; people have trouble fixing
2030 .Xdefaults with Emacs, when it has something bad in it. */
2031 FRAME_DESIRED_CURSOR (f
) = filled_box_cursor
;
2033 /* Make sure the cursor gets redrawn. This is overkill, but how
2034 often do people change cursor types? */
2035 update_mode_lines
++;
2039 x_set_icon_type (f
, arg
, oldval
)
2041 Lisp_Object arg
, oldval
;
2049 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
2052 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
2057 result
= x_text_icon (f
,
2058 (char *) XSTRING ((!NILP (f
->icon_name
)
2062 result
= x_bitmap_icon (f
, arg
);
2067 error ("No icon window available");
2070 /* If the window was unmapped (and its icon was mapped),
2071 the new icon is not mapped, so map the window in its stead. */
2072 if (FRAME_VISIBLE_P (f
))
2074 #ifdef USE_X_TOOLKIT
2075 XtPopup (f
->output_data
.w32
->widget
, XtGrabNone
);
2077 XMapWindow (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
));
2080 XFlush (FRAME_W32_DISPLAY (f
));
2085 /* Return non-nil if frame F wants a bitmap icon. */
2093 tem
= assq_no_quit (Qicon_type
, f
->param_alist
);
2095 return XCONS (tem
)->cdr
;
2101 x_set_icon_name (f
, arg
, oldval
)
2103 Lisp_Object arg
, oldval
;
2110 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
2113 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
2119 if (f
->output_data
.w32
->icon_bitmap
!= 0)
2124 result
= x_text_icon (f
,
2125 (char *) XSTRING ((!NILP (f
->icon_name
)
2134 error ("No icon window available");
2137 /* If the window was unmapped (and its icon was mapped),
2138 the new icon is not mapped, so map the window in its stead. */
2139 if (FRAME_VISIBLE_P (f
))
2141 #ifdef USE_X_TOOLKIT
2142 XtPopup (f
->output_data
.w32
->widget
, XtGrabNone
);
2144 XMapWindow (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
));
2147 XFlush (FRAME_W32_DISPLAY (f
));
2152 extern Lisp_Object
x_new_font ();
2153 extern Lisp_Object
x_new_fontset();
2156 x_set_font (f
, arg
, oldval
)
2158 Lisp_Object arg
, oldval
;
2161 Lisp_Object fontset_name
;
2164 CHECK_STRING (arg
, 1);
2166 fontset_name
= Fquery_fontset (arg
, Qnil
);
2169 result
= (STRINGP (fontset_name
)
2170 ? x_new_fontset (f
, XSTRING (fontset_name
)->data
)
2171 : x_new_font (f
, XSTRING (arg
)->data
));
2174 if (EQ (result
, Qnil
))
2175 error ("Font \"%s\" is not defined", XSTRING (arg
)->data
);
2176 else if (EQ (result
, Qt
))
2177 error ("the characters of the given font have varying widths");
2178 else if (STRINGP (result
))
2180 recompute_basic_faces (f
);
2181 store_frame_param (f
, Qfont
, result
);
2186 XSETFRAME (frame
, f
);
2187 call1 (Qface_set_after_frame_default
, frame
);
2191 x_set_border_width (f
, arg
, oldval
)
2193 Lisp_Object arg
, oldval
;
2195 CHECK_NUMBER (arg
, 0);
2197 if (XINT (arg
) == f
->output_data
.w32
->border_width
)
2200 if (FRAME_W32_WINDOW (f
) != 0)
2201 error ("Cannot change the border width of a window");
2203 f
->output_data
.w32
->border_width
= XINT (arg
);
2207 x_set_internal_border_width (f
, arg
, oldval
)
2209 Lisp_Object arg
, oldval
;
2212 int old
= f
->output_data
.w32
->internal_border_width
;
2214 CHECK_NUMBER (arg
, 0);
2215 f
->output_data
.w32
->internal_border_width
= XINT (arg
);
2216 if (f
->output_data
.w32
->internal_border_width
< 0)
2217 f
->output_data
.w32
->internal_border_width
= 0;
2219 if (f
->output_data
.w32
->internal_border_width
== old
)
2222 if (FRAME_W32_WINDOW (f
) != 0)
2225 x_set_window_size (f
, 0, f
->width
, f
->height
);
2227 SET_FRAME_GARBAGED (f
);
2232 x_set_visibility (f
, value
, oldval
)
2234 Lisp_Object value
, oldval
;
2237 XSETFRAME (frame
, f
);
2240 Fmake_frame_invisible (frame
, Qt
);
2241 else if (EQ (value
, Qicon
))
2242 Ficonify_frame (frame
);
2244 Fmake_frame_visible (frame
);
2248 x_set_menu_bar_lines (f
, value
, oldval
)
2250 Lisp_Object value
, oldval
;
2253 int olines
= FRAME_MENU_BAR_LINES (f
);
2255 /* Right now, menu bars don't work properly in minibuf-only frames;
2256 most of the commands try to apply themselves to the minibuffer
2257 frame itslef, and get an error because you can't switch buffers
2258 in or split the minibuffer window. */
2259 if (FRAME_MINIBUF_ONLY_P (f
))
2262 if (INTEGERP (value
))
2263 nlines
= XINT (value
);
2267 FRAME_MENU_BAR_LINES (f
) = 0;
2269 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
2272 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
2273 free_frame_menubar (f
);
2274 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
2276 /* Adjust the frame size so that the client (text) dimensions
2277 remain the same. This depends on FRAME_EXTERNAL_MENU_BAR being
2279 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2283 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
2286 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2287 name; if NAME is a string, set F's name to NAME and set
2288 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2290 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2291 suggesting a new name, which lisp code should override; if
2292 F->explicit_name is set, ignore the new name; otherwise, set it. */
2295 x_set_name (f
, name
, explicit)
2300 /* Make sure that requests from lisp code override requests from
2301 Emacs redisplay code. */
2304 /* If we're switching from explicit to implicit, we had better
2305 update the mode lines and thereby update the title. */
2306 if (f
->explicit_name
&& NILP (name
))
2307 update_mode_lines
= 1;
2309 f
->explicit_name
= ! NILP (name
);
2311 else if (f
->explicit_name
)
2314 /* If NAME is nil, set the name to the w32_id_name. */
2317 /* Check for no change needed in this very common case
2318 before we do any consing. */
2319 if (!strcmp (FRAME_W32_DISPLAY_INFO (f
)->w32_id_name
,
2320 XSTRING (f
->name
)->data
))
2322 name
= build_string (FRAME_W32_DISPLAY_INFO (f
)->w32_id_name
);
2325 CHECK_STRING (name
, 0);
2327 /* Don't change the name if it's already NAME. */
2328 if (! NILP (Fstring_equal (name
, f
->name
)))
2333 /* For setting the frame title, the title parameter should override
2334 the name parameter. */
2335 if (! NILP (f
->title
))
2338 if (FRAME_W32_WINDOW (f
))
2341 SetWindowText(FRAME_W32_WINDOW (f
), XSTRING (name
)->data
);
2346 /* This function should be called when the user's lisp code has
2347 specified a name for the frame; the name will override any set by the
2350 x_explicitly_set_name (f
, arg
, oldval
)
2352 Lisp_Object arg
, oldval
;
2354 x_set_name (f
, arg
, 1);
2357 /* This function should be called by Emacs redisplay code to set the
2358 name; names set this way will never override names set by the user's
2361 x_implicitly_set_name (f
, arg
, oldval
)
2363 Lisp_Object arg
, oldval
;
2365 x_set_name (f
, arg
, 0);
2368 /* Change the title of frame F to NAME.
2369 If NAME is nil, use the frame name as the title.
2371 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2372 name; if NAME is a string, set F's name to NAME and set
2373 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2375 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2376 suggesting a new name, which lisp code should override; if
2377 F->explicit_name is set, ignore the new name; otherwise, set it. */
2380 x_set_title (f
, name
)
2384 /* Don't change the title if it's already NAME. */
2385 if (EQ (name
, f
->title
))
2388 update_mode_lines
= 1;
2395 if (FRAME_W32_WINDOW (f
))
2398 SetWindowText(FRAME_W32_WINDOW (f
), XSTRING (name
)->data
);
2404 x_set_autoraise (f
, arg
, oldval
)
2406 Lisp_Object arg
, oldval
;
2408 f
->auto_raise
= !EQ (Qnil
, arg
);
2412 x_set_autolower (f
, arg
, oldval
)
2414 Lisp_Object arg
, oldval
;
2416 f
->auto_lower
= !EQ (Qnil
, arg
);
2420 x_set_unsplittable (f
, arg
, oldval
)
2422 Lisp_Object arg
, oldval
;
2424 f
->no_split
= !NILP (arg
);
2428 x_set_vertical_scroll_bars (f
, arg
, oldval
)
2430 Lisp_Object arg
, oldval
;
2432 if ((EQ (arg
, Qleft
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f
))
2433 || (EQ (arg
, Qright
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f
))
2434 || (NILP (arg
) && FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
2435 || (!NILP (arg
) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
)))
2437 FRAME_VERTICAL_SCROLL_BAR_TYPE (f
) = NILP (arg
) ?
2438 vertical_scroll_bar_none
:
2439 /* Put scroll bars on the right by default, as is conventional
2442 ? vertical_scroll_bar_left
2443 : vertical_scroll_bar_right
;
2445 /* We set this parameter before creating the window for the
2446 frame, so we can get the geometry right from the start.
2447 However, if the window hasn't been created yet, we shouldn't
2448 call x_set_window_size. */
2449 if (FRAME_W32_WINDOW (f
))
2450 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2455 x_set_scroll_bar_width (f
, arg
, oldval
)
2457 Lisp_Object arg
, oldval
;
2461 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = 0;
2462 FRAME_SCROLL_BAR_COLS (f
) = 2;
2464 else if (INTEGERP (arg
) && XINT (arg
) > 0
2465 && XFASTINT (arg
) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f
))
2467 int wid
= FONT_WIDTH (f
->output_data
.w32
->font
);
2468 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = XFASTINT (arg
);
2469 FRAME_SCROLL_BAR_COLS (f
) = (XFASTINT (arg
) + wid
-1) / wid
;
2470 if (FRAME_W32_WINDOW (f
))
2471 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2475 /* Subroutines of creating an frame. */
2477 /* Make sure that Vx_resource_name is set to a reasonable value.
2478 Fix it up, or set it to `emacs' if it is too hopeless. */
2481 validate_x_resource_name ()
2484 /* Number of valid characters in the resource name. */
2486 /* Number of invalid characters in the resource name. */
2491 if (STRINGP (Vx_resource_name
))
2493 unsigned char *p
= XSTRING (Vx_resource_name
)->data
;
2496 len
= XSTRING (Vx_resource_name
)->size
;
2498 /* Only letters, digits, - and _ are valid in resource names.
2499 Count the valid characters and count the invalid ones. */
2500 for (i
= 0; i
< len
; i
++)
2503 if (! ((c
>= 'a' && c
<= 'z')
2504 || (c
>= 'A' && c
<= 'Z')
2505 || (c
>= '0' && c
<= '9')
2506 || c
== '-' || c
== '_'))
2513 /* Not a string => completely invalid. */
2514 bad_count
= 5, good_count
= 0;
2516 /* If name is valid already, return. */
2520 /* If name is entirely invalid, or nearly so, use `emacs'. */
2522 || (good_count
== 1 && bad_count
> 0))
2524 Vx_resource_name
= build_string ("emacs");
2528 /* Name is partly valid. Copy it and replace the invalid characters
2529 with underscores. */
2531 Vx_resource_name
= new = Fcopy_sequence (Vx_resource_name
);
2533 for (i
= 0; i
< len
; i
++)
2535 int c
= XSTRING (new)->data
[i
];
2536 if (! ((c
>= 'a' && c
<= 'z')
2537 || (c
>= 'A' && c
<= 'Z')
2538 || (c
>= '0' && c
<= '9')
2539 || c
== '-' || c
== '_'))
2540 XSTRING (new)->data
[i
] = '_';
2545 extern char *x_get_string_resource ();
2547 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
2548 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
2549 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
2550 class, where INSTANCE is the name under which Emacs was invoked, or\n\
2551 the name specified by the `-name' or `-rn' command-line arguments.\n\
2553 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
2554 class, respectively. You must specify both of them or neither.\n\
2555 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
2556 and the class is `Emacs.CLASS.SUBCLASS'.")
2557 (attribute
, class, component
, subclass
)
2558 Lisp_Object attribute
, class, component
, subclass
;
2560 register char *value
;
2564 CHECK_STRING (attribute
, 0);
2565 CHECK_STRING (class, 0);
2567 if (!NILP (component
))
2568 CHECK_STRING (component
, 1);
2569 if (!NILP (subclass
))
2570 CHECK_STRING (subclass
, 2);
2571 if (NILP (component
) != NILP (subclass
))
2572 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2574 validate_x_resource_name ();
2576 /* Allocate space for the components, the dots which separate them,
2577 and the final '\0'. Make them big enough for the worst case. */
2578 name_key
= (char *) alloca (XSTRING (Vx_resource_name
)->size
2579 + (STRINGP (component
)
2580 ? XSTRING (component
)->size
: 0)
2581 + XSTRING (attribute
)->size
2584 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
2585 + XSTRING (class)->size
2586 + (STRINGP (subclass
)
2587 ? XSTRING (subclass
)->size
: 0)
2590 /* Start with emacs.FRAMENAME for the name (the specific one)
2591 and with `Emacs' for the class key (the general one). */
2592 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2593 strcpy (class_key
, EMACS_CLASS
);
2595 strcat (class_key
, ".");
2596 strcat (class_key
, XSTRING (class)->data
);
2598 if (!NILP (component
))
2600 strcat (class_key
, ".");
2601 strcat (class_key
, XSTRING (subclass
)->data
);
2603 strcat (name_key
, ".");
2604 strcat (name_key
, XSTRING (component
)->data
);
2607 strcat (name_key
, ".");
2608 strcat (name_key
, XSTRING (attribute
)->data
);
2610 value
= x_get_string_resource (Qnil
,
2611 name_key
, class_key
);
2613 if (value
!= (char *) 0)
2614 return build_string (value
);
2619 /* Used when C code wants a resource value. */
2622 x_get_resource_string (attribute
, class)
2623 char *attribute
, *class;
2625 register char *value
;
2629 /* Allocate space for the components, the dots which separate them,
2630 and the final '\0'. */
2631 name_key
= (char *) alloca (XSTRING (Vinvocation_name
)->size
2632 + strlen (attribute
) + 2);
2633 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
2634 + strlen (class) + 2);
2636 sprintf (name_key
, "%s.%s",
2637 XSTRING (Vinvocation_name
)->data
,
2639 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
2641 return x_get_string_resource (selected_frame
,
2642 name_key
, class_key
);
2645 /* Types we might convert a resource string into. */
2648 number
, boolean
, string
, symbol
2651 /* Return the value of parameter PARAM.
2653 First search ALIST, then Vdefault_frame_alist, then the X defaults
2654 database, using ATTRIBUTE as the attribute name and CLASS as its class.
2656 Convert the resource to the type specified by desired_type.
2658 If no default is specified, return Qunbound. If you call
2659 x_get_arg, make sure you deal with Qunbound in a reasonable way,
2660 and don't let it get stored in any Lisp-visible variables! */
2663 x_get_arg (alist
, param
, attribute
, class, type
)
2664 Lisp_Object alist
, param
;
2667 enum resource_types type
;
2669 register Lisp_Object tem
;
2671 tem
= Fassq (param
, alist
);
2673 tem
= Fassq (param
, Vdefault_frame_alist
);
2679 tem
= Fx_get_resource (build_string (attribute
),
2680 build_string (class),
2689 return make_number (atoi (XSTRING (tem
)->data
));
2692 tem
= Fdowncase (tem
);
2693 if (!strcmp (XSTRING (tem
)->data
, "on")
2694 || !strcmp (XSTRING (tem
)->data
, "true"))
2703 /* As a special case, we map the values `true' and `on'
2704 to Qt, and `false' and `off' to Qnil. */
2707 lower
= Fdowncase (tem
);
2708 if (!strcmp (XSTRING (lower
)->data
, "on")
2709 || !strcmp (XSTRING (lower
)->data
, "true"))
2711 else if (!strcmp (XSTRING (lower
)->data
, "off")
2712 || !strcmp (XSTRING (lower
)->data
, "false"))
2715 return Fintern (tem
, Qnil
);
2728 /* Record in frame F the specified or default value according to ALIST
2729 of the parameter named PARAM (a Lisp symbol).
2730 If no value is specified for PARAM, look for an X default for XPROP
2731 on the frame named NAME.
2732 If that is not found either, use the value DEFLT. */
2735 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
2742 enum resource_types type
;
2746 tem
= x_get_arg (alist
, prop
, xprop
, xclass
, type
);
2747 if (EQ (tem
, Qunbound
))
2749 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2753 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
2754 "Parse an X-style geometry string STRING.\n\
2755 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
2756 The properties returned may include `top', `left', `height', and `width'.\n\
2757 The value of `left' or `top' may be an integer,\n\
2758 or a list (+ N) meaning N pixels relative to top/left corner,\n\
2759 or a list (- N) meaning -N pixels relative to bottom/right corner.")
2764 unsigned int width
, height
;
2767 CHECK_STRING (string
, 0);
2769 geometry
= XParseGeometry ((char *) XSTRING (string
)->data
,
2770 &x
, &y
, &width
, &height
);
2773 if (geometry
& XValue
)
2775 Lisp_Object element
;
2777 if (x
>= 0 && (geometry
& XNegative
))
2778 element
= Fcons (Qleft
, Fcons (Qminus
, Fcons (make_number (-x
), Qnil
)));
2779 else if (x
< 0 && ! (geometry
& XNegative
))
2780 element
= Fcons (Qleft
, Fcons (Qplus
, Fcons (make_number (x
), Qnil
)));
2782 element
= Fcons (Qleft
, make_number (x
));
2783 result
= Fcons (element
, result
);
2786 if (geometry
& YValue
)
2788 Lisp_Object element
;
2790 if (y
>= 0 && (geometry
& YNegative
))
2791 element
= Fcons (Qtop
, Fcons (Qminus
, Fcons (make_number (-y
), Qnil
)));
2792 else if (y
< 0 && ! (geometry
& YNegative
))
2793 element
= Fcons (Qtop
, Fcons (Qplus
, Fcons (make_number (y
), Qnil
)));
2795 element
= Fcons (Qtop
, make_number (y
));
2796 result
= Fcons (element
, result
);
2799 if (geometry
& WidthValue
)
2800 result
= Fcons (Fcons (Qwidth
, make_number (width
)), result
);
2801 if (geometry
& HeightValue
)
2802 result
= Fcons (Fcons (Qheight
, make_number (height
)), result
);
2807 /* Calculate the desired size and position of this window,
2808 and return the flags saying which aspects were specified.
2810 This function does not make the coordinates positive. */
2812 #define DEFAULT_ROWS 40
2813 #define DEFAULT_COLS 80
2816 x_figure_window_size (f
, parms
)
2820 register Lisp_Object tem0
, tem1
, tem2
;
2821 int height
, width
, left
, top
;
2822 register int geometry
;
2823 long window_prompting
= 0;
2825 /* Default values if we fall through.
2826 Actually, if that happens we should get
2827 window manager prompting. */
2828 SET_FRAME_WIDTH (f
, DEFAULT_COLS
);
2829 f
->height
= DEFAULT_ROWS
;
2830 /* Window managers expect that if program-specified
2831 positions are not (0,0), they're intentional, not defaults. */
2832 f
->output_data
.w32
->top_pos
= 0;
2833 f
->output_data
.w32
->left_pos
= 0;
2835 tem0
= x_get_arg (parms
, Qheight
, 0, 0, number
);
2836 tem1
= x_get_arg (parms
, Qwidth
, 0, 0, number
);
2837 tem2
= x_get_arg (parms
, Quser_size
, 0, 0, number
);
2838 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
2840 if (!EQ (tem0
, Qunbound
))
2842 CHECK_NUMBER (tem0
, 0);
2843 f
->height
= XINT (tem0
);
2845 if (!EQ (tem1
, Qunbound
))
2847 CHECK_NUMBER (tem1
, 0);
2848 SET_FRAME_WIDTH (f
, XINT (tem1
));
2850 if (!NILP (tem2
) && !EQ (tem2
, Qunbound
))
2851 window_prompting
|= USSize
;
2853 window_prompting
|= PSize
;
2856 f
->output_data
.w32
->vertical_scroll_bar_extra
2857 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
2859 : FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) > 0
2860 ? FRAME_SCROLL_BAR_PIXEL_WIDTH (f
)
2861 : (FRAME_SCROLL_BAR_COLS (f
) * FONT_WIDTH (f
->output_data
.w32
->font
)));
2862 f
->output_data
.w32
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
2863 f
->output_data
.w32
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
2865 tem0
= x_get_arg (parms
, Qtop
, 0, 0, number
);
2866 tem1
= x_get_arg (parms
, Qleft
, 0, 0, number
);
2867 tem2
= x_get_arg (parms
, Quser_position
, 0, 0, number
);
2868 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
2870 if (EQ (tem0
, Qminus
))
2872 f
->output_data
.w32
->top_pos
= 0;
2873 window_prompting
|= YNegative
;
2875 else if (CONSP (tem0
) && EQ (XCONS (tem0
)->car
, Qminus
)
2876 && CONSP (XCONS (tem0
)->cdr
)
2877 && INTEGERP (XCONS (XCONS (tem0
)->cdr
)->car
))
2879 f
->output_data
.w32
->top_pos
= - XINT (XCONS (XCONS (tem0
)->cdr
)->car
);
2880 window_prompting
|= YNegative
;
2882 else if (CONSP (tem0
) && EQ (XCONS (tem0
)->car
, Qplus
)
2883 && CONSP (XCONS (tem0
)->cdr
)
2884 && INTEGERP (XCONS (XCONS (tem0
)->cdr
)->car
))
2886 f
->output_data
.w32
->top_pos
= XINT (XCONS (XCONS (tem0
)->cdr
)->car
);
2888 else if (EQ (tem0
, Qunbound
))
2889 f
->output_data
.w32
->top_pos
= 0;
2892 CHECK_NUMBER (tem0
, 0);
2893 f
->output_data
.w32
->top_pos
= XINT (tem0
);
2894 if (f
->output_data
.w32
->top_pos
< 0)
2895 window_prompting
|= YNegative
;
2898 if (EQ (tem1
, Qminus
))
2900 f
->output_data
.w32
->left_pos
= 0;
2901 window_prompting
|= XNegative
;
2903 else if (CONSP (tem1
) && EQ (XCONS (tem1
)->car
, Qminus
)
2904 && CONSP (XCONS (tem1
)->cdr
)
2905 && INTEGERP (XCONS (XCONS (tem1
)->cdr
)->car
))
2907 f
->output_data
.w32
->left_pos
= - XINT (XCONS (XCONS (tem1
)->cdr
)->car
);
2908 window_prompting
|= XNegative
;
2910 else if (CONSP (tem1
) && EQ (XCONS (tem1
)->car
, Qplus
)
2911 && CONSP (XCONS (tem1
)->cdr
)
2912 && INTEGERP (XCONS (XCONS (tem1
)->cdr
)->car
))
2914 f
->output_data
.w32
->left_pos
= XINT (XCONS (XCONS (tem1
)->cdr
)->car
);
2916 else if (EQ (tem1
, Qunbound
))
2917 f
->output_data
.w32
->left_pos
= 0;
2920 CHECK_NUMBER (tem1
, 0);
2921 f
->output_data
.w32
->left_pos
= XINT (tem1
);
2922 if (f
->output_data
.w32
->left_pos
< 0)
2923 window_prompting
|= XNegative
;
2926 if (!NILP (tem2
) && ! EQ (tem2
, Qunbound
))
2927 window_prompting
|= USPosition
;
2929 window_prompting
|= PPosition
;
2932 return window_prompting
;
2937 extern LRESULT CALLBACK
w32_wnd_proc ();
2940 w32_init_class (hinst
)
2945 wc
.style
= CS_HREDRAW
| CS_VREDRAW
;
2946 wc
.lpfnWndProc
= (WNDPROC
) w32_wnd_proc
;
2948 wc
.cbWndExtra
= WND_EXTRA_BYTES
;
2949 wc
.hInstance
= hinst
;
2950 wc
.hIcon
= LoadIcon (hinst
, EMACS_CLASS
);
2951 wc
.hCursor
= LoadCursor (NULL
, IDC_ARROW
);
2952 wc
.hbrBackground
= NULL
; /* GetStockObject (WHITE_BRUSH); */
2953 wc
.lpszMenuName
= NULL
;
2954 wc
.lpszClassName
= EMACS_CLASS
;
2956 return (RegisterClass (&wc
));
2960 w32_createscrollbar (f
, bar
)
2962 struct scroll_bar
* bar
;
2964 return (CreateWindow ("SCROLLBAR", "", SBS_VERT
| WS_CHILD
| WS_VISIBLE
,
2965 /* Position and size of scroll bar. */
2966 XINT(bar
->left
), XINT(bar
->top
),
2967 XINT(bar
->width
), XINT(bar
->height
),
2968 FRAME_W32_WINDOW (f
),
2975 w32_createwindow (f
)
2981 rect
.left
= rect
.top
= 0;
2982 rect
.right
= PIXEL_WIDTH (f
);
2983 rect
.bottom
= PIXEL_HEIGHT (f
);
2985 AdjustWindowRect (&rect
, f
->output_data
.w32
->dwStyle
,
2986 FRAME_EXTERNAL_MENU_BAR (f
));
2988 /* Do first time app init */
2992 w32_init_class (hinst
);
2995 FRAME_W32_WINDOW (f
) = hwnd
2996 = CreateWindow (EMACS_CLASS
,
2998 f
->output_data
.w32
->dwStyle
| WS_CLIPCHILDREN
,
2999 f
->output_data
.w32
->left_pos
,
3000 f
->output_data
.w32
->top_pos
,
3001 rect
.right
- rect
.left
,
3002 rect
.bottom
- rect
.top
,
3010 SetWindowLong (hwnd
, WND_FONTWIDTH_INDEX
, FONT_WIDTH (f
->output_data
.w32
->font
));
3011 SetWindowLong (hwnd
, WND_LINEHEIGHT_INDEX
, f
->output_data
.w32
->line_height
);
3012 SetWindowLong (hwnd
, WND_BORDER_INDEX
, f
->output_data
.w32
->internal_border_width
);
3013 SetWindowLong (hwnd
, WND_SCROLLBAR_INDEX
, f
->output_data
.w32
->vertical_scroll_bar_extra
);
3014 SetWindowLong (hwnd
, WND_BACKGROUND_INDEX
, f
->output_data
.w32
->background_pixel
);
3016 /* Enable drag-n-drop. */
3017 DragAcceptFiles (hwnd
, TRUE
);
3019 /* Do this to discard the default setting specified by our parent. */
3020 ShowWindow (hwnd
, SW_HIDE
);
3025 my_post_msg (wmsg
, hwnd
, msg
, wParam
, lParam
)
3032 wmsg
->msg
.hwnd
= hwnd
;
3033 wmsg
->msg
.message
= msg
;
3034 wmsg
->msg
.wParam
= wParam
;
3035 wmsg
->msg
.lParam
= lParam
;
3036 wmsg
->msg
.time
= GetMessageTime ();
3041 /* GetKeyState and MapVirtualKey on Windows 95 do not actually distinguish
3042 between left and right keys as advertised. We test for this
3043 support dynamically, and set a flag when the support is absent. If
3044 absent, we keep track of the left and right control and alt keys
3045 ourselves. This is particularly necessary on keyboards that rely
3046 upon the AltGr key, which is represented as having the left control
3047 and right alt keys pressed. For these keyboards, we need to know
3048 when the left alt key has been pressed in addition to the AltGr key
3049 so that we can properly support M-AltGr-key sequences (such as M-@
3050 on Swedish keyboards). */
3052 #define EMACS_LCONTROL 0
3053 #define EMACS_RCONTROL 1
3054 #define EMACS_LMENU 2
3055 #define EMACS_RMENU 3
3057 static int modifiers
[4];
3058 static int modifiers_recorded
;
3059 static int modifier_key_support_tested
;
3062 test_modifier_support (unsigned int wparam
)
3066 if (wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
)
3068 if (wparam
== VK_CONTROL
)
3078 if (!(GetKeyState (l
) & 0x8000) && !(GetKeyState (r
) & 0x8000))
3079 modifiers_recorded
= 1;
3081 modifiers_recorded
= 0;
3082 modifier_key_support_tested
= 1;
3086 record_keydown (unsigned int wparam
, unsigned int lparam
)
3090 if (!modifier_key_support_tested
)
3091 test_modifier_support (wparam
);
3093 if ((wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
) || !modifiers_recorded
)
3096 if (wparam
== VK_CONTROL
)
3097 i
= (lparam
& 0x1000000) ? EMACS_RCONTROL
: EMACS_LCONTROL
;
3099 i
= (lparam
& 0x1000000) ? EMACS_RMENU
: EMACS_LMENU
;
3105 record_keyup (unsigned int wparam
, unsigned int lparam
)
3109 if ((wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
) || !modifiers_recorded
)
3112 if (wparam
== VK_CONTROL
)
3113 i
= (lparam
& 0x1000000) ? EMACS_RCONTROL
: EMACS_LCONTROL
;
3115 i
= (lparam
& 0x1000000) ? EMACS_RMENU
: EMACS_LMENU
;
3120 /* Emacs can lose focus while a modifier key has been pressed. When
3121 it regains focus, be conservative and clear all modifiers since
3122 we cannot reconstruct the left and right modifier state. */
3128 if (GetFocus () == NULL
)
3129 /* Emacs doesn't have keyboard focus. Do nothing. */
3132 ctrl
= GetAsyncKeyState (VK_CONTROL
);
3133 alt
= GetAsyncKeyState (VK_MENU
);
3135 if (!(ctrl
& 0x08000))
3136 /* Clear any recorded control modifier state. */
3137 modifiers
[EMACS_RCONTROL
] = modifiers
[EMACS_LCONTROL
] = 0;
3139 if (!(alt
& 0x08000))
3140 /* Clear any recorded alt modifier state. */
3141 modifiers
[EMACS_RMENU
] = modifiers
[EMACS_LMENU
] = 0;
3143 /* Update the state of all modifier keys, because modifiers used in
3144 hot-key combinations can get stuck on if Emacs loses focus as a
3145 result of a hot-key being pressed. */
3149 #define CURRENT_STATE(key) ((GetAsyncKeyState (key) & 0x8000) >> 8)
3151 GetKeyboardState (keystate
);
3152 keystate
[VK_SHIFT
] = CURRENT_STATE (VK_SHIFT
);
3153 keystate
[VK_CONTROL
] = CURRENT_STATE (VK_CONTROL
);
3154 keystate
[VK_LCONTROL
] = CURRENT_STATE (VK_LCONTROL
);
3155 keystate
[VK_RCONTROL
] = CURRENT_STATE (VK_RCONTROL
);
3156 keystate
[VK_MENU
] = CURRENT_STATE (VK_MENU
);
3157 keystate
[VK_LMENU
] = CURRENT_STATE (VK_LMENU
);
3158 keystate
[VK_RMENU
] = CURRENT_STATE (VK_RMENU
);
3159 keystate
[VK_LWIN
] = CURRENT_STATE (VK_LWIN
);
3160 keystate
[VK_RWIN
] = CURRENT_STATE (VK_RWIN
);
3161 keystate
[VK_APPS
] = CURRENT_STATE (VK_APPS
);
3162 SetKeyboardState (keystate
);
3166 /* Synchronize modifier state with what is reported with the current
3167 keystroke. Even if we cannot distinguish between left and right
3168 modifier keys, we know that, if no modifiers are set, then neither
3169 the left or right modifier should be set. */
3173 if (!modifiers_recorded
)
3176 if (!(GetKeyState (VK_CONTROL
) & 0x8000))
3177 modifiers
[EMACS_RCONTROL
] = modifiers
[EMACS_LCONTROL
] = 0;
3179 if (!(GetKeyState (VK_MENU
) & 0x8000))
3180 modifiers
[EMACS_RMENU
] = modifiers
[EMACS_LMENU
] = 0;
3184 modifier_set (int vkey
)
3186 if (vkey
== VK_CAPITAL
|| vkey
== VK_SCROLL
)
3187 return (GetKeyState (vkey
) & 0x1);
3188 if (!modifiers_recorded
)
3189 return (GetKeyState (vkey
) & 0x8000);
3194 return modifiers
[EMACS_LCONTROL
];
3196 return modifiers
[EMACS_RCONTROL
];
3198 return modifiers
[EMACS_LMENU
];
3200 return modifiers
[EMACS_RMENU
];
3202 return (GetKeyState (vkey
) & 0x8000);
3205 /* Convert between the modifier bits W32 uses and the modifier bits
3209 w32_key_to_modifier (int key
)
3211 Lisp_Object key_mapping
;
3216 key_mapping
= Vw32_lwindow_modifier
;
3219 key_mapping
= Vw32_rwindow_modifier
;
3222 key_mapping
= Vw32_apps_modifier
;
3225 key_mapping
= Vw32_scroll_lock_modifier
;
3231 /* NB. This code runs in the input thread, asychronously to the lisp
3232 thread, so we must be careful to ensure access to lisp data is
3233 thread-safe. The following code is safe because the modifier
3234 variable values are updated atomically from lisp and symbols are
3235 not relocated by GC. Also, we don't have to worry about seeing GC
3237 if (EQ (key_mapping
, Qhyper
))
3238 return hyper_modifier
;
3239 if (EQ (key_mapping
, Qsuper
))
3240 return super_modifier
;
3241 if (EQ (key_mapping
, Qmeta
))
3242 return meta_modifier
;
3243 if (EQ (key_mapping
, Qalt
))
3244 return alt_modifier
;
3245 if (EQ (key_mapping
, Qctrl
))
3246 return ctrl_modifier
;
3247 if (EQ (key_mapping
, Qcontrol
)) /* synonym for ctrl */
3248 return ctrl_modifier
;
3249 if (EQ (key_mapping
, Qshift
))
3250 return shift_modifier
;
3252 /* Don't generate any modifier if not explicitly requested. */
3257 w32_get_modifiers ()
3259 return ((modifier_set (VK_SHIFT
) ? shift_modifier
: 0) |
3260 (modifier_set (VK_CONTROL
) ? ctrl_modifier
: 0) |
3261 (modifier_set (VK_LWIN
) ? w32_key_to_modifier (VK_LWIN
) : 0) |
3262 (modifier_set (VK_RWIN
) ? w32_key_to_modifier (VK_RWIN
) : 0) |
3263 (modifier_set (VK_APPS
) ? w32_key_to_modifier (VK_APPS
) : 0) |
3264 (modifier_set (VK_SCROLL
) ? w32_key_to_modifier (VK_SCROLL
) : 0) |
3265 (modifier_set (VK_MENU
) ?
3266 ((NILP (Vw32_alt_is_meta
)) ? alt_modifier
: meta_modifier
) : 0));
3269 /* We map the VK_* modifiers into console modifier constants
3270 so that we can use the same routines to handle both console
3271 and window input. */
3274 construct_console_modifiers ()
3279 mods
|= (modifier_set (VK_SHIFT
)) ? SHIFT_PRESSED
: 0;
3280 mods
|= (modifier_set (VK_CAPITAL
)) ? CAPSLOCK_ON
: 0;
3281 mods
|= (modifier_set (VK_SCROLL
)) ? SCROLLLOCK_ON
: 0;
3282 mods
|= (modifier_set (VK_NUMLOCK
)) ? NUMLOCK_ON
: 0;
3283 mods
|= (modifier_set (VK_LCONTROL
)) ? LEFT_CTRL_PRESSED
: 0;
3284 mods
|= (modifier_set (VK_RCONTROL
)) ? RIGHT_CTRL_PRESSED
: 0;
3285 mods
|= (modifier_set (VK_LMENU
)) ? LEFT_ALT_PRESSED
: 0;
3286 mods
|= (modifier_set (VK_RMENU
)) ? RIGHT_ALT_PRESSED
: 0;
3287 mods
|= (modifier_set (VK_LWIN
)) ? LEFT_WIN_PRESSED
: 0;
3288 mods
|= (modifier_set (VK_RWIN
)) ? RIGHT_WIN_PRESSED
: 0;
3289 mods
|= (modifier_set (VK_APPS
)) ? APPS_PRESSED
: 0;
3295 w32_get_key_modifiers (unsigned int wparam
, unsigned int lparam
)
3299 /* Convert to emacs modifiers. */
3300 mods
= w32_kbd_mods_to_emacs (construct_console_modifiers (), wparam
);
3306 map_keypad_keys (unsigned int virt_key
, unsigned int extended
)
3308 if (virt_key
< VK_CLEAR
|| virt_key
> VK_DELETE
)
3311 if (virt_key
== VK_RETURN
)
3312 return (extended
? VK_NUMPAD_ENTER
: VK_RETURN
);
3314 if (virt_key
>= VK_PRIOR
&& virt_key
<= VK_DOWN
)
3315 return (!extended
? (VK_NUMPAD_PRIOR
+ (virt_key
- VK_PRIOR
)) : virt_key
);
3317 if (virt_key
== VK_INSERT
|| virt_key
== VK_DELETE
)
3318 return (!extended
? (VK_NUMPAD_INSERT
+ (virt_key
- VK_INSERT
)) : virt_key
);
3320 if (virt_key
== VK_CLEAR
)
3321 return (!extended
? VK_NUMPAD_CLEAR
: virt_key
);
3326 /* List of special key combinations which w32 would normally capture,
3327 but emacs should grab instead. Not directly visible to lisp, to
3328 simplify synchronization. Each item is an integer encoding a virtual
3329 key code and modifier combination to capture. */
3330 Lisp_Object w32_grabbed_keys
;
3332 #define HOTKEY(vk,mods) make_number (((vk) & 255) | ((mods) << 8))
3333 #define HOTKEY_ID(k) (XFASTINT (k) & 0xbfff)
3334 #define HOTKEY_VK_CODE(k) (XFASTINT (k) & 255)
3335 #define HOTKEY_MODIFIERS(k) (XFASTINT (k) >> 8)
3337 /* Register hot-keys for reserved key combinations when Emacs has
3338 keyboard focus, since this is the only way Emacs can receive key
3339 combinations like Alt-Tab which are used by the system. */
3342 register_hot_keys (hwnd
)
3345 Lisp_Object keylist
;
3347 /* Use GC_CONSP, since we are called asynchronously. */
3348 for (keylist
= w32_grabbed_keys
; GC_CONSP (keylist
); keylist
= XCDR (keylist
))
3350 Lisp_Object key
= XCAR (keylist
);
3352 /* Deleted entries get set to nil. */
3353 if (!INTEGERP (key
))
3356 RegisterHotKey (hwnd
, HOTKEY_ID (key
),
3357 HOTKEY_MODIFIERS (key
), HOTKEY_VK_CODE (key
));
3362 unregister_hot_keys (hwnd
)
3365 Lisp_Object keylist
;
3367 /* Use GC_CONSP, since we are called asynchronously. */
3368 for (keylist
= w32_grabbed_keys
; GC_CONSP (keylist
); keylist
= XCDR (keylist
))
3370 Lisp_Object key
= XCAR (keylist
);
3372 if (!INTEGERP (key
))
3375 UnregisterHotKey (hwnd
, HOTKEY_ID (key
));
3379 /* Main message dispatch loop. */
3382 w32_msg_pump (deferred_msg
* msg_buf
)
3388 msh_mousewheel
= RegisterWindowMessage (MSH_MOUSEWHEEL
);
3390 while (GetMessage (&msg
, NULL
, 0, 0))
3392 if (msg
.hwnd
== NULL
)
3394 switch (msg
.message
)
3397 /* Produced by complete_deferred_msg; just ignore. */
3399 case WM_EMACS_CREATEWINDOW
:
3400 w32_createwindow ((struct frame
*) msg
.wParam
);
3401 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
, 0, 0))
3404 case WM_EMACS_SETLOCALE
:
3405 SetThreadLocale (msg
.wParam
);
3406 /* Reply is not expected. */
3408 case WM_EMACS_SETKEYBOARDLAYOUT
:
3409 result
= (int) ActivateKeyboardLayout ((HKL
) msg
.wParam
, 0);
3410 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
,
3414 case WM_EMACS_REGISTER_HOT_KEY
:
3415 focus_window
= GetFocus ();
3416 if (focus_window
!= NULL
)
3417 RegisterHotKey (focus_window
,
3418 HOTKEY_ID (msg
.wParam
),
3419 HOTKEY_MODIFIERS (msg
.wParam
),
3420 HOTKEY_VK_CODE (msg
.wParam
));
3421 /* Reply is not expected. */
3423 case WM_EMACS_UNREGISTER_HOT_KEY
:
3424 focus_window
= GetFocus ();
3425 if (focus_window
!= NULL
)
3426 UnregisterHotKey (focus_window
, HOTKEY_ID (msg
.wParam
));
3427 /* Mark item as erased. NB: this code must be
3428 thread-safe. The next line is okay because the cons
3429 cell is never made into garbage and is not relocated by
3431 XCAR ((Lisp_Object
) msg
.lParam
) = Qnil
;
3432 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
, 0, 0))
3435 case WM_EMACS_TOGGLE_LOCK_KEY
:
3437 int vk_code
= (int) msg
.wParam
;
3438 int cur_state
= (GetKeyState (vk_code
) & 1);
3439 Lisp_Object new_state
= (Lisp_Object
) msg
.lParam
;
3441 /* NB: This code must be thread-safe. It is safe to
3442 call NILP because symbols are not relocated by GC,
3443 and pointer here is not touched by GC (so the markbit
3444 can't be set). Numbers are safe because they are
3445 immediate values. */
3446 if (NILP (new_state
)
3447 || (NUMBERP (new_state
)
3448 && (XUINT (new_state
)) & 1 != cur_state
))
3450 one_w32_display_info
.faked_key
= vk_code
;
3452 keybd_event ((BYTE
) vk_code
,
3453 (BYTE
) MapVirtualKey (vk_code
, 0),
3454 KEYEVENTF_EXTENDEDKEY
| KEYEVENTF_KEYUP
, 0);
3455 keybd_event ((BYTE
) vk_code
,
3456 (BYTE
) MapVirtualKey (vk_code
, 0),
3457 KEYEVENTF_EXTENDEDKEY
| 0, 0);
3458 keybd_event ((BYTE
) vk_code
,
3459 (BYTE
) MapVirtualKey (vk_code
, 0),
3460 KEYEVENTF_EXTENDEDKEY
| KEYEVENTF_KEYUP
, 0);
3461 cur_state
= !cur_state
;
3463 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
,
3469 DebPrint (("msg %x not expected by w32_msg_pump\n", msg
.message
));
3474 DispatchMessage (&msg
);
3477 /* Exit nested loop when our deferred message has completed. */
3478 if (msg_buf
->completed
)
3483 deferred_msg
* deferred_msg_head
;
3485 static deferred_msg
*
3486 find_deferred_msg (HWND hwnd
, UINT msg
)
3488 deferred_msg
* item
;
3490 /* Don't actually need synchronization for read access, since
3491 modification of single pointer is always atomic. */
3492 /* enter_crit (); */
3494 for (item
= deferred_msg_head
; item
!= NULL
; item
= item
->next
)
3495 if (item
->w32msg
.msg
.hwnd
== hwnd
3496 && item
->w32msg
.msg
.message
== msg
)
3499 /* leave_crit (); */
3505 send_deferred_msg (deferred_msg
* msg_buf
,
3511 /* Only input thread can send deferred messages. */
3512 if (GetCurrentThreadId () != dwWindowsThreadId
)
3515 /* It is an error to send a message that is already deferred. */
3516 if (find_deferred_msg (hwnd
, msg
) != NULL
)
3519 /* Enforced synchronization is not needed because this is the only
3520 function that alters deferred_msg_head, and the following critical
3521 section is guaranteed to only be serially reentered (since only the
3522 input thread can call us). */
3524 /* enter_crit (); */
3526 msg_buf
->completed
= 0;
3527 msg_buf
->next
= deferred_msg_head
;
3528 deferred_msg_head
= msg_buf
;
3529 my_post_msg (&msg_buf
->w32msg
, hwnd
, msg
, wParam
, lParam
);
3531 /* leave_crit (); */
3533 /* Start a new nested message loop to process other messages until
3534 this one is completed. */
3535 w32_msg_pump (msg_buf
);
3537 deferred_msg_head
= msg_buf
->next
;
3539 return msg_buf
->result
;
3543 complete_deferred_msg (HWND hwnd
, UINT msg
, LRESULT result
)
3545 deferred_msg
* msg_buf
= find_deferred_msg (hwnd
, msg
);
3547 if (msg_buf
== NULL
)
3548 /* Message may have been cancelled, so don't abort(). */
3551 msg_buf
->result
= result
;
3552 msg_buf
->completed
= 1;
3554 /* Ensure input thread is woken so it notices the completion. */
3555 PostThreadMessage (dwWindowsThreadId
, WM_NULL
, 0, 0);
3559 cancel_all_deferred_msgs ()
3561 deferred_msg
* item
;
3563 /* Don't actually need synchronization for read access, since
3564 modification of single pointer is always atomic. */
3565 /* enter_crit (); */
3567 for (item
= deferred_msg_head
; item
!= NULL
; item
= item
->next
)
3570 item
->completed
= 1;
3573 /* leave_crit (); */
3575 /* Ensure input thread is woken so it notices the completion. */
3576 PostThreadMessage (dwWindowsThreadId
, WM_NULL
, 0, 0);
3584 deferred_msg dummy_buf
;
3586 /* Ensure our message queue is created */
3588 PeekMessage (&msg
, NULL
, 0, 0, PM_NOREMOVE
);
3590 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
, 0, 0))
3593 memset (&dummy_buf
, 0, sizeof (dummy_buf
));
3594 dummy_buf
.w32msg
.msg
.hwnd
= NULL
;
3595 dummy_buf
.w32msg
.msg
.message
= WM_NULL
;
3597 /* This is the inital message loop which should only exit when the
3598 application quits. */
3599 w32_msg_pump (&dummy_buf
);
3605 post_character_message (hwnd
, msg
, wParam
, lParam
, modifiers
)
3615 wmsg
.dwModifiers
= modifiers
;
3617 /* Detect quit_char and set quit-flag directly. Note that we
3618 still need to post a message to ensure the main thread will be
3619 woken up if blocked in sys_select(), but we do NOT want to post
3620 the quit_char message itself (because it will usually be as if
3621 the user had typed quit_char twice). Instead, we post a dummy
3622 message that has no particular effect. */
3625 if (isalpha (c
) && wmsg
.dwModifiers
== ctrl_modifier
)
3626 c
= make_ctrl_char (c
) & 0377;
3628 || (wmsg
.dwModifiers
== 0 &&
3629 XFASTINT (Vw32_quit_key
) && wParam
== XFASTINT (Vw32_quit_key
)))
3633 /* The choice of message is somewhat arbitrary, as long as
3634 the main thread handler just ignores it. */
3637 /* Interrupt any blocking system calls. */
3640 /* As a safety precaution, forcibly complete any deferred
3641 messages. This is a kludge, but I don't see any particularly
3642 clean way to handle the situation where a deferred message is
3643 "dropped" in the lisp thread, and will thus never be
3644 completed, eg. by the user trying to activate the menubar
3645 when the lisp thread is busy, and then typing C-g when the
3646 menubar doesn't open promptly (with the result that the
3647 menubar never responds at all because the deferred
3648 WM_INITMENU message is never completed). Another problem
3649 situation is when the lisp thread calls SendMessage (to send
3650 a window manager command) when a message has been deferred;
3651 the lisp thread gets blocked indefinitely waiting for the
3652 deferred message to be completed, which itself is waiting for
3653 the lisp thread to respond.
3655 Note that we don't want to block the input thread waiting for
3656 a reponse from the lisp thread (although that would at least
3657 solve the deadlock problem above), because we want to be able
3658 to receive C-g to interrupt the lisp thread. */
3659 cancel_all_deferred_msgs ();
3663 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3666 /* Main window procedure */
3669 w32_wnd_proc (hwnd
, msg
, wParam
, lParam
)
3676 struct w32_display_info
*dpyinfo
= &one_w32_display_info
;
3678 int windows_translate
;
3681 /* Note that it is okay to call x_window_to_frame, even though we are
3682 not running in the main lisp thread, because frame deletion
3683 requires the lisp thread to synchronize with this thread. Thus, if
3684 a frame struct is returned, it can be used without concern that the
3685 lisp thread might make it disappear while we are using it.
3687 NB. Walking the frame list in this thread is safe (as long as
3688 writes of Lisp_Object slots are atomic, which they are on Windows).
3689 Although delete-frame can destructively modify the frame list while
3690 we are walking it, a garbage collection cannot occur until after
3691 delete-frame has synchronized with this thread.
3693 It is also safe to use functions that make GDI calls, such as
3694 w32_clear_rect, because these functions must obtain a DC handle
3695 from the frame struct using get_frame_dc which is thread-aware. */
3700 f
= x_window_to_frame (dpyinfo
, hwnd
);
3703 GetUpdateRect (hwnd
, &wmsg
.rect
, FALSE
);
3704 w32_clear_rect (f
, NULL
, &wmsg
.rect
);
3707 case WM_PALETTECHANGED
:
3708 /* ignore our own changes */
3709 if ((HWND
)wParam
!= hwnd
)
3711 f
= x_window_to_frame (dpyinfo
, hwnd
);
3713 /* get_frame_dc will realize our palette and force all
3714 frames to be redrawn if needed. */
3715 release_frame_dc (f
, get_frame_dc (f
));
3720 PAINTSTRUCT paintStruct
;
3723 /* MSDN Docs say not to call BeginPaint if GetUpdateRect
3724 fails. Apparently this can happen under some
3726 if (GetUpdateRect (hwnd
, &update_rect
, FALSE
))
3729 BeginPaint (hwnd
, &paintStruct
);
3731 /* The rectangles returned by GetUpdateRect and BeginPaint
3732 do not always match. GetUpdateRect seems to be the
3733 more reliable of the two. */
3734 wmsg
.rect
= update_rect
;
3736 #if defined (W32_DEBUG_DISPLAY)
3737 DebPrint (("WM_PAINT: painting %d,%d-%d,%d\n", wmsg
.rect
.left
,
3738 wmsg
.rect
.top
, wmsg
.rect
.right
, wmsg
.rect
.bottom
));
3739 DebPrint (("WM_PAINT: update region is %d,%d-%d,%d\n",
3740 update_rect
.left
, update_rect
.top
,
3741 update_rect
.right
, update_rect
.bottom
));
3743 EndPaint (hwnd
, &paintStruct
);
3746 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3753 case WM_INPUTLANGCHANGE
:
3754 /* Inform lisp thread of keyboard layout changes. */
3755 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3757 /* Clear dead keys in the keyboard state; for simplicity only
3758 preserve modifier key states. */
3763 GetKeyboardState (keystate
);
3764 for (i
= 0; i
< 256; i
++)
3781 SetKeyboardState (keystate
);
3786 /* Synchronize hot keys with normal input. */
3787 PostMessage (hwnd
, WM_KEYDOWN
, HIWORD (lParam
), 0);
3792 record_keyup (wParam
, lParam
);
3797 /* Ignore keystrokes we fake ourself; see below. */
3798 if (dpyinfo
->faked_key
== wParam
)
3800 dpyinfo
->faked_key
= 0;
3801 /* Make sure TranslateMessage sees them though (as long as
3802 they don't produce WM_CHAR messages). This ensures that
3803 indicator lights are toggled promptly on Windows 9x, for
3805 if (lispy_function_keys
[wParam
] != 0)
3807 windows_translate
= 1;
3813 /* Synchronize modifiers with current keystroke. */
3815 record_keydown (wParam
, lParam
);
3816 wParam
= map_keypad_keys (wParam
, (lParam
& 0x1000000L
) != 0);
3818 windows_translate
= 0;
3823 if (NILP (Vw32_pass_lwindow_to_system
))
3825 /* Prevent system from acting on keyup (which opens the
3826 Start menu if no other key was pressed) by simulating a
3827 press of Space which we will ignore. */
3828 if (GetAsyncKeyState (wParam
) & 1)
3830 if (NUMBERP (Vw32_phantom_key_code
))
3831 key
= XUINT (Vw32_phantom_key_code
) & 255;
3834 dpyinfo
->faked_key
= key
;
3835 keybd_event (key
, (BYTE
) MapVirtualKey (key
, 0), 0, 0);
3838 if (!NILP (Vw32_lwindow_modifier
))
3842 if (NILP (Vw32_pass_rwindow_to_system
))
3844 if (GetAsyncKeyState (wParam
) & 1)
3846 if (NUMBERP (Vw32_phantom_key_code
))
3847 key
= XUINT (Vw32_phantom_key_code
) & 255;
3850 dpyinfo
->faked_key
= key
;
3851 keybd_event (key
, (BYTE
) MapVirtualKey (key
, 0), 0, 0);
3854 if (!NILP (Vw32_rwindow_modifier
))
3858 if (!NILP (Vw32_apps_modifier
))
3862 if (NILP (Vw32_pass_alt_to_system
))
3863 /* Prevent DefWindowProc from activating the menu bar if an
3864 Alt key is pressed and released by itself. */
3866 windows_translate
= 1;
3869 /* Decide whether to treat as modifier or function key. */
3870 if (NILP (Vw32_enable_caps_lock
))
3871 goto disable_lock_key
;
3872 windows_translate
= 1;
3875 /* Decide whether to treat as modifier or function key. */
3876 if (NILP (Vw32_enable_num_lock
))
3877 goto disable_lock_key
;
3878 windows_translate
= 1;
3881 /* Decide whether to treat as modifier or function key. */
3882 if (NILP (Vw32_scroll_lock_modifier
))
3883 goto disable_lock_key
;
3884 windows_translate
= 1;
3887 /* Ensure the appropriate lock key state (and indicator light)
3888 remains in the same state. We do this by faking another
3889 press of the relevant key. Apparently, this really is the
3890 only way to toggle the state of the indicator lights. */
3891 dpyinfo
->faked_key
= wParam
;
3892 keybd_event ((BYTE
) wParam
, (BYTE
) MapVirtualKey (wParam
, 0),
3893 KEYEVENTF_EXTENDEDKEY
| KEYEVENTF_KEYUP
, 0);
3894 keybd_event ((BYTE
) wParam
, (BYTE
) MapVirtualKey (wParam
, 0),
3895 KEYEVENTF_EXTENDEDKEY
| 0, 0);
3896 keybd_event ((BYTE
) wParam
, (BYTE
) MapVirtualKey (wParam
, 0),
3897 KEYEVENTF_EXTENDEDKEY
| KEYEVENTF_KEYUP
, 0);
3898 /* Ensure indicator lights are updated promptly on Windows 9x
3899 (TranslateMessage apparently does this), after forwarding
3901 post_character_message (hwnd
, msg
, wParam
, lParam
,
3902 w32_get_key_modifiers (wParam
, lParam
));
3903 windows_translate
= 1;
3907 case VK_PROCESSKEY
: /* Generated by IME. */
3908 windows_translate
= 1;
3911 /* Windows maps Ctrl-Pause (aka Ctrl-Break) into VK_CANCEL,
3912 which is confusing for purposes of key binding; convert
3913 VK_CANCEL events into VK_PAUSE events. */
3917 /* Windows maps Ctrl-NumLock into VK_PAUSE, which is confusing
3918 for purposes of key binding; convert these back into
3919 VK_NUMLOCK events, at least when we want to see NumLock key
3920 presses. (Note that there is never any possibility that
3921 VK_PAUSE with Ctrl really is C-Pause as per above.) */
3922 if (NILP (Vw32_enable_num_lock
) && modifier_set (VK_CONTROL
))
3923 wParam
= VK_NUMLOCK
;
3926 /* If not defined as a function key, change it to a WM_CHAR message. */
3927 if (lispy_function_keys
[wParam
] == 0)
3929 DWORD modifiers
= construct_console_modifiers ();
3931 if (!NILP (Vw32_recognize_altgr
)
3932 && modifier_set (VK_LCONTROL
) && modifier_set (VK_RMENU
))
3934 /* Always let TranslateMessage handle AltGr key chords;
3935 for some reason, ToAscii doesn't always process AltGr
3936 chords correctly. */
3937 windows_translate
= 1;
3939 else if ((modifiers
& (~SHIFT_PRESSED
& ~CAPSLOCK_ON
)) != 0)
3941 /* Handle key chords including any modifiers other
3942 than shift directly, in order to preserve as much
3943 modifier information as possible. */
3944 if ('A' <= wParam
&& wParam
<= 'Z')
3946 /* Don't translate modified alphabetic keystrokes,
3947 so the user doesn't need to constantly switch
3948 layout to type control or meta keystrokes when
3949 the normal layout translates alphabetic
3950 characters to non-ascii characters. */
3951 if (!modifier_set (VK_SHIFT
))
3952 wParam
+= ('a' - 'A');
3957 /* Try to handle other keystrokes by determining the
3958 base character (ie. translating the base key plus
3962 KEY_EVENT_RECORD key
;
3964 key
.bKeyDown
= TRUE
;
3965 key
.wRepeatCount
= 1;
3966 key
.wVirtualKeyCode
= wParam
;
3967 key
.wVirtualScanCode
= (lParam
& 0xFF0000) >> 16;
3968 key
.uChar
.AsciiChar
= 0;
3969 key
.dwControlKeyState
= modifiers
;
3971 add
= w32_kbd_patch_key (&key
);
3972 /* 0 means an unrecognised keycode, negative means
3973 dead key. Ignore both. */
3976 /* Forward asciified character sequence. */
3977 post_character_message
3978 (hwnd
, WM_CHAR
, key
.uChar
.AsciiChar
, lParam
,
3979 w32_get_key_modifiers (wParam
, lParam
));
3980 w32_kbd_patch_key (&key
);
3987 /* Let TranslateMessage handle everything else. */
3988 windows_translate
= 1;
3994 if (windows_translate
)
3996 MSG windows_msg
= { hwnd
, msg
, wParam
, lParam
, 0, {0,0} };
3998 windows_msg
.time
= GetMessageTime ();
3999 TranslateMessage (&windows_msg
);
4007 post_character_message (hwnd
, msg
, wParam
, lParam
,
4008 w32_get_key_modifiers (wParam
, lParam
));
4011 /* Simulate middle mouse button events when left and right buttons
4012 are used together, but only if user has two button mouse. */
4013 case WM_LBUTTONDOWN
:
4014 case WM_RBUTTONDOWN
:
4015 if (XINT (Vw32_num_mouse_buttons
) == 3)
4016 goto handle_plain_button
;
4019 int this = (msg
== WM_LBUTTONDOWN
) ? LMOUSE
: RMOUSE
;
4020 int other
= (msg
== WM_LBUTTONDOWN
) ? RMOUSE
: LMOUSE
;
4022 if (button_state
& this)
4025 if (button_state
== 0)
4028 button_state
|= this;
4030 if (button_state
& other
)
4032 if (mouse_button_timer
)
4034 KillTimer (hwnd
, mouse_button_timer
);
4035 mouse_button_timer
= 0;
4037 /* Generate middle mouse event instead. */
4038 msg
= WM_MBUTTONDOWN
;
4039 button_state
|= MMOUSE
;
4041 else if (button_state
& MMOUSE
)
4043 /* Ignore button event if we've already generated a
4044 middle mouse down event. This happens if the
4045 user releases and press one of the two buttons
4046 after we've faked a middle mouse event. */
4051 /* Flush out saved message. */
4052 post_msg (&saved_mouse_button_msg
);
4054 wmsg
.dwModifiers
= w32_get_modifiers ();
4055 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4057 /* Clear message buffer. */
4058 saved_mouse_button_msg
.msg
.hwnd
= 0;
4062 /* Hold onto message for now. */
4063 mouse_button_timer
=
4064 SetTimer (hwnd
, MOUSE_BUTTON_ID
,
4065 XINT (Vw32_mouse_button_tolerance
), NULL
);
4066 saved_mouse_button_msg
.msg
.hwnd
= hwnd
;
4067 saved_mouse_button_msg
.msg
.message
= msg
;
4068 saved_mouse_button_msg
.msg
.wParam
= wParam
;
4069 saved_mouse_button_msg
.msg
.lParam
= lParam
;
4070 saved_mouse_button_msg
.msg
.time
= GetMessageTime ();
4071 saved_mouse_button_msg
.dwModifiers
= w32_get_modifiers ();
4078 if (XINT (Vw32_num_mouse_buttons
) == 3)
4079 goto handle_plain_button
;
4082 int this = (msg
== WM_LBUTTONUP
) ? LMOUSE
: RMOUSE
;
4083 int other
= (msg
== WM_LBUTTONUP
) ? RMOUSE
: LMOUSE
;
4085 if ((button_state
& this) == 0)
4088 button_state
&= ~this;
4090 if (button_state
& MMOUSE
)
4092 /* Only generate event when second button is released. */
4093 if ((button_state
& other
) == 0)
4096 button_state
&= ~MMOUSE
;
4098 if (button_state
) abort ();
4105 /* Flush out saved message if necessary. */
4106 if (saved_mouse_button_msg
.msg
.hwnd
)
4108 post_msg (&saved_mouse_button_msg
);
4111 wmsg
.dwModifiers
= w32_get_modifiers ();
4112 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4114 /* Always clear message buffer and cancel timer. */
4115 saved_mouse_button_msg
.msg
.hwnd
= 0;
4116 KillTimer (hwnd
, mouse_button_timer
);
4117 mouse_button_timer
= 0;
4119 if (button_state
== 0)
4124 case WM_MBUTTONDOWN
:
4126 handle_plain_button
:
4131 if (parse_button (msg
, &button
, &up
))
4133 if (up
) ReleaseCapture ();
4134 else SetCapture (hwnd
);
4135 button
= (button
== 0) ? LMOUSE
:
4136 ((button
== 1) ? MMOUSE
: RMOUSE
);
4138 button_state
&= ~button
;
4140 button_state
|= button
;
4144 wmsg
.dwModifiers
= w32_get_modifiers ();
4145 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4150 if (XINT (Vw32_mouse_move_interval
) <= 0
4151 || (msg
== WM_MOUSEMOVE
&& button_state
== 0))
4153 wmsg
.dwModifiers
= w32_get_modifiers ();
4154 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4158 /* Hang onto mouse move and scroll messages for a bit, to avoid
4159 sending such events to Emacs faster than it can process them.
4160 If we get more events before the timer from the first message
4161 expires, we just replace the first message. */
4163 if (saved_mouse_move_msg
.msg
.hwnd
== 0)
4165 SetTimer (hwnd
, MOUSE_MOVE_ID
,
4166 XINT (Vw32_mouse_move_interval
), NULL
);
4168 /* Hold onto message for now. */
4169 saved_mouse_move_msg
.msg
.hwnd
= hwnd
;
4170 saved_mouse_move_msg
.msg
.message
= msg
;
4171 saved_mouse_move_msg
.msg
.wParam
= wParam
;
4172 saved_mouse_move_msg
.msg
.lParam
= lParam
;
4173 saved_mouse_move_msg
.msg
.time
= GetMessageTime ();
4174 saved_mouse_move_msg
.dwModifiers
= w32_get_modifiers ();
4179 wmsg
.dwModifiers
= w32_get_modifiers ();
4180 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4184 wmsg
.dwModifiers
= w32_get_modifiers ();
4185 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4189 /* Flush out saved messages if necessary. */
4190 if (wParam
== mouse_button_timer
)
4192 if (saved_mouse_button_msg
.msg
.hwnd
)
4194 post_msg (&saved_mouse_button_msg
);
4195 saved_mouse_button_msg
.msg
.hwnd
= 0;
4197 KillTimer (hwnd
, mouse_button_timer
);
4198 mouse_button_timer
= 0;
4200 else if (wParam
== mouse_move_timer
)
4202 if (saved_mouse_move_msg
.msg
.hwnd
)
4204 post_msg (&saved_mouse_move_msg
);
4205 saved_mouse_move_msg
.msg
.hwnd
= 0;
4207 KillTimer (hwnd
, mouse_move_timer
);
4208 mouse_move_timer
= 0;
4213 /* Windows doesn't send us focus messages when putting up and
4214 taking down a system popup dialog as for Ctrl-Alt-Del on Windows 95.
4215 The only indication we get that something happened is receiving
4216 this message afterwards. So this is a good time to reset our
4217 keyboard modifiers' state. */
4222 /* We must ensure menu bar is fully constructed and up to date
4223 before allowing user interaction with it. To achieve this
4224 we send this message to the lisp thread and wait for a
4225 reply (whose value is not actually needed) to indicate that
4226 the menu bar is now ready for use, so we can now return.
4228 To remain responsive in the meantime, we enter a nested message
4229 loop that can process all other messages.
4231 However, we skip all this if the message results from calling
4232 TrackPopupMenu - in fact, we must NOT attempt to send the lisp
4233 thread a message because it is blocked on us at this point. We
4234 set menubar_active before calling TrackPopupMenu to indicate
4235 this (there is no possibility of confusion with real menubar
4238 f
= x_window_to_frame (dpyinfo
, hwnd
);
4240 && (f
->output_data
.w32
->menubar_active
4241 /* We can receive this message even in the absence of a
4242 menubar (ie. when the system menu is activated) - in this
4243 case we do NOT want to forward the message, otherwise it
4244 will cause the menubar to suddenly appear when the user
4245 had requested it to be turned off! */
4246 || f
->output_data
.w32
->menubar_widget
== NULL
))
4250 deferred_msg msg_buf
;
4252 /* Detect if message has already been deferred; in this case
4253 we cannot return any sensible value to ignore this. */
4254 if (find_deferred_msg (hwnd
, msg
) != NULL
)
4257 return send_deferred_msg (&msg_buf
, hwnd
, msg
, wParam
, lParam
);
4260 case WM_EXITMENULOOP
:
4261 f
= x_window_to_frame (dpyinfo
, hwnd
);
4263 /* Indicate that menubar can be modified again. */
4265 f
->output_data
.w32
->menubar_active
= 0;
4268 case WM_MEASUREITEM
:
4269 f
= x_window_to_frame (dpyinfo
, hwnd
);
4272 MEASUREITEMSTRUCT
* pMis
= (MEASUREITEMSTRUCT
*) lParam
;
4274 if (pMis
->CtlType
== ODT_MENU
)
4276 /* Work out dimensions for popup menu titles. */
4277 char * title
= (char *) pMis
->itemData
;
4278 HDC hdc
= GetDC (hwnd
);
4279 HFONT menu_font
= GetCurrentObject (hdc
, OBJ_FONT
);
4280 LOGFONT menu_logfont
;
4284 GetObject (menu_font
, sizeof (menu_logfont
), &menu_logfont
);
4285 menu_logfont
.lfWeight
= FW_BOLD
;
4286 menu_font
= CreateFontIndirect (&menu_logfont
);
4287 old_font
= SelectObject (hdc
, menu_font
);
4289 GetTextExtentPoint32 (hdc
, title
, strlen (title
), &size
);
4290 pMis
->itemWidth
= size
.cx
;
4291 pMis
->itemHeight
= GetSystemMetrics (SM_CYMENUSIZE
);
4292 if (pMis
->itemHeight
< size
.cy
)
4293 pMis
->itemHeight
= size
.cy
;
4295 SelectObject (hdc
, old_font
);
4296 DeleteObject (menu_font
);
4297 ReleaseDC (hwnd
, hdc
);
4304 f
= x_window_to_frame (dpyinfo
, hwnd
);
4307 DRAWITEMSTRUCT
* pDis
= (DRAWITEMSTRUCT
*) lParam
;
4309 if (pDis
->CtlType
== ODT_MENU
)
4311 /* Draw popup menu title. */
4312 char * title
= (char *) pDis
->itemData
;
4313 HDC hdc
= pDis
->hDC
;
4314 HFONT menu_font
= GetCurrentObject (hdc
, OBJ_FONT
);
4315 LOGFONT menu_logfont
;
4318 GetObject (menu_font
, sizeof (menu_logfont
), &menu_logfont
);
4319 menu_logfont
.lfWeight
= FW_BOLD
;
4320 menu_font
= CreateFontIndirect (&menu_logfont
);
4321 old_font
= SelectObject (hdc
, menu_font
);
4323 /* Always draw title as if not selected. */
4325 pDis
->rcItem
.left
+ GetSystemMetrics (SM_CXMENUCHECK
),
4327 ETO_OPAQUE
, &pDis
->rcItem
,
4328 title
, strlen (title
), NULL
);
4330 SelectObject (hdc
, old_font
);
4331 DeleteObject (menu_font
);
4338 /* Still not right - can't distinguish between clicks in the
4339 client area of the frame from clicks forwarded from the scroll
4340 bars - may have to hook WM_NCHITTEST to remember the mouse
4341 position and then check if it is in the client area ourselves. */
4342 case WM_MOUSEACTIVATE
:
4343 /* Discard the mouse click that activates a frame, allowing the
4344 user to click anywhere without changing point (or worse!).
4345 Don't eat mouse clicks on scrollbars though!! */
4346 if (LOWORD (lParam
) == HTCLIENT
)
4347 return MA_ACTIVATEANDEAT
;
4351 case WM_ACTIVATEAPP
:
4353 case WM_WINDOWPOSCHANGED
:
4355 /* Inform lisp thread that a frame might have just been obscured
4356 or exposed, so should recheck visibility of all frames. */
4357 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4361 dpyinfo
->faked_key
= 0;
4363 register_hot_keys (hwnd
);
4366 unregister_hot_keys (hwnd
);
4371 wmsg
.dwModifiers
= w32_get_modifiers ();
4372 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4376 wmsg
.dwModifiers
= w32_get_modifiers ();
4377 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4380 case WM_WINDOWPOSCHANGING
:
4383 LPWINDOWPOS lppos
= (WINDOWPOS
*) lParam
;
4385 wp
.length
= sizeof (WINDOWPLACEMENT
);
4386 GetWindowPlacement (hwnd
, &wp
);
4388 if (wp
.showCmd
!= SW_SHOWMINIMIZED
&& (lppos
->flags
& SWP_NOSIZE
) == 0)
4395 DWORD internal_border
;
4396 DWORD scrollbar_extra
;
4399 wp
.length
= sizeof(wp
);
4400 GetWindowRect (hwnd
, &wr
);
4404 font_width
= GetWindowLong (hwnd
, WND_FONTWIDTH_INDEX
);
4405 line_height
= GetWindowLong (hwnd
, WND_LINEHEIGHT_INDEX
);
4406 internal_border
= GetWindowLong (hwnd
, WND_BORDER_INDEX
);
4407 scrollbar_extra
= GetWindowLong (hwnd
, WND_SCROLLBAR_INDEX
);
4411 memset (&rect
, 0, sizeof (rect
));
4412 AdjustWindowRect (&rect
, GetWindowLong (hwnd
, GWL_STYLE
),
4413 GetMenu (hwnd
) != NULL
);
4415 /* Force width and height of client area to be exact
4416 multiples of the character cell dimensions. */
4417 wdiff
= (lppos
->cx
- (rect
.right
- rect
.left
)
4418 - 2 * internal_border
- scrollbar_extra
)
4420 hdiff
= (lppos
->cy
- (rect
.bottom
- rect
.top
)
4421 - 2 * internal_border
)
4426 /* For right/bottom sizing we can just fix the sizes.
4427 However for top/left sizing we will need to fix the X
4428 and Y positions as well. */
4433 if (wp
.showCmd
!= SW_SHOWMAXIMIZED
4434 && (lppos
->flags
& SWP_NOMOVE
) == 0)
4436 if (lppos
->x
!= wr
.left
|| lppos
->y
!= wr
.top
)
4443 lppos
->flags
|= SWP_NOMOVE
;
4454 case WM_GETMINMAXINFO
:
4455 /* Hack to correct bug that allows Emacs frames to be resized
4456 below the Minimum Tracking Size. */
4457 ((LPMINMAXINFO
) lParam
)->ptMinTrackSize
.y
++;
4460 case WM_EMACS_CREATESCROLLBAR
:
4461 return (LRESULT
) w32_createscrollbar ((struct frame
*) wParam
,
4462 (struct scroll_bar
*) lParam
);
4464 case WM_EMACS_SHOWWINDOW
:
4465 return ShowWindow ((HWND
) wParam
, (WPARAM
) lParam
);
4467 case WM_EMACS_SETFOREGROUND
:
4468 return SetForegroundWindow ((HWND
) wParam
);
4470 case WM_EMACS_SETWINDOWPOS
:
4472 WINDOWPOS
* pos
= (WINDOWPOS
*) wParam
;
4473 return SetWindowPos (hwnd
, pos
->hwndInsertAfter
,
4474 pos
->x
, pos
->y
, pos
->cx
, pos
->cy
, pos
->flags
);
4477 case WM_EMACS_DESTROYWINDOW
:
4478 DragAcceptFiles ((HWND
) wParam
, FALSE
);
4479 return DestroyWindow ((HWND
) wParam
);
4481 case WM_EMACS_TRACKPOPUPMENU
:
4486 pos
= (POINT
*)lParam
;
4487 flags
= TPM_CENTERALIGN
;
4488 if (button_state
& LMOUSE
)
4489 flags
|= TPM_LEFTBUTTON
;
4490 else if (button_state
& RMOUSE
)
4491 flags
|= TPM_RIGHTBUTTON
;
4493 /* Remember we did a SetCapture on the initial mouse down event,
4494 so for safety, we make sure the capture is cancelled now. */
4498 /* Use menubar_active to indicate that WM_INITMENU is from
4499 TrackPopupMenu below, and should be ignored. */
4500 f
= x_window_to_frame (dpyinfo
, hwnd
);
4502 f
->output_data
.w32
->menubar_active
= 1;
4504 if (TrackPopupMenu ((HMENU
)wParam
, flags
, pos
->x
, pos
->y
,
4508 /* Eat any mouse messages during popupmenu */
4509 while (PeekMessage (&amsg
, hwnd
, WM_MOUSEFIRST
, WM_MOUSELAST
,
4511 /* Get the menu selection, if any */
4512 if (PeekMessage (&amsg
, hwnd
, WM_COMMAND
, WM_COMMAND
, PM_REMOVE
))
4514 retval
= LOWORD (amsg
.wParam
);
4530 /* Check for messages registered at runtime. */
4531 if (msg
== msh_mousewheel
)
4533 wmsg
.dwModifiers
= w32_get_modifiers ();
4534 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4539 return DefWindowProc (hwnd
, msg
, wParam
, lParam
);
4543 /* The most common default return code for handled messages is 0. */
4548 my_create_window (f
)
4553 if (!PostThreadMessage (dwWindowsThreadId
, WM_EMACS_CREATEWINDOW
, (WPARAM
)f
, 0))
4555 GetMessage (&msg
, NULL
, WM_EMACS_DONE
, WM_EMACS_DONE
);
4558 /* Create and set up the w32 window for frame F. */
4561 w32_window (f
, window_prompting
, minibuffer_only
)
4563 long window_prompting
;
4564 int minibuffer_only
;
4568 /* Use the resource name as the top-level window name
4569 for looking up resources. Make a non-Lisp copy
4570 for the window manager, so GC relocation won't bother it.
4572 Elsewhere we specify the window name for the window manager. */
4575 char *str
= (char *) XSTRING (Vx_resource_name
)->data
;
4576 f
->namebuf
= (char *) xmalloc (strlen (str
) + 1);
4577 strcpy (f
->namebuf
, str
);
4580 my_create_window (f
);
4582 validate_x_resource_name ();
4584 /* x_set_name normally ignores requests to set the name if the
4585 requested name is the same as the current name. This is the one
4586 place where that assumption isn't correct; f->name is set, but
4587 the server hasn't been told. */
4590 int explicit = f
->explicit_name
;
4592 f
->explicit_name
= 0;
4595 x_set_name (f
, name
, explicit);
4600 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
4601 initialize_frame_menubar (f
);
4603 if (FRAME_W32_WINDOW (f
) == 0)
4604 error ("Unable to create window");
4607 /* Handle the icon stuff for this window. Perhaps later we might
4608 want an x_set_icon_position which can be called interactively as
4616 Lisp_Object icon_x
, icon_y
;
4618 /* Set the position of the icon. Note that Windows 95 groups all
4619 icons in the tray. */
4620 icon_x
= x_get_arg (parms
, Qicon_left
, 0, 0, number
);
4621 icon_y
= x_get_arg (parms
, Qicon_top
, 0, 0, number
);
4622 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
4624 CHECK_NUMBER (icon_x
, 0);
4625 CHECK_NUMBER (icon_y
, 0);
4627 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
4628 error ("Both left and top icon corners of icon must be specified");
4632 if (! EQ (icon_x
, Qunbound
))
4633 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
4636 /* Start up iconic or window? */
4637 x_wm_set_window_state
4638 (f
, (EQ (x_get_arg (parms
, Qvisibility
, 0, 0, symbol
), Qicon
)
4642 x_text_icon (f
, (char *) XSTRING ((!NILP (f
->icon_name
)
4650 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
4652 "Make a new window, which is called a \"frame\" in Emacs terms.\n\
4653 Returns an Emacs frame object.\n\
4654 ALIST is an alist of frame parameters.\n\
4655 If the parameters specify that the frame should not have a minibuffer,\n\
4656 and do not specify a specific minibuffer window to use,\n\
4657 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
4658 be shared by the new frame.\n\
4660 This function is an internal primitive--use `make-frame' instead.")
4665 Lisp_Object frame
, tem
;
4667 int minibuffer_only
= 0;
4668 long window_prompting
= 0;
4670 int count
= specpdl_ptr
- specpdl
;
4671 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
4672 Lisp_Object display
;
4673 struct w32_display_info
*dpyinfo
;
4679 /* Use this general default value to start with
4680 until we know if this frame has a specified name. */
4681 Vx_resource_name
= Vinvocation_name
;
4683 display
= x_get_arg (parms
, Qdisplay
, 0, 0, string
);
4684 if (EQ (display
, Qunbound
))
4686 dpyinfo
= check_x_display_info (display
);
4688 kb
= dpyinfo
->kboard
;
4690 kb
= &the_only_kboard
;
4693 name
= x_get_arg (parms
, Qname
, "name", "Name", string
);
4695 && ! EQ (name
, Qunbound
)
4697 error ("Invalid frame name--not a string or nil");
4700 Vx_resource_name
= name
;
4702 /* See if parent window is specified. */
4703 parent
= x_get_arg (parms
, Qparent_id
, NULL
, NULL
, number
);
4704 if (EQ (parent
, Qunbound
))
4706 if (! NILP (parent
))
4707 CHECK_NUMBER (parent
, 0);
4709 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
4710 /* No need to protect DISPLAY because that's not used after passing
4711 it to make_frame_without_minibuffer. */
4713 GCPRO4 (parms
, parent
, name
, frame
);
4714 tem
= x_get_arg (parms
, Qminibuffer
, 0, 0, symbol
);
4715 if (EQ (tem
, Qnone
) || NILP (tem
))
4716 f
= make_frame_without_minibuffer (Qnil
, kb
, display
);
4717 else if (EQ (tem
, Qonly
))
4719 f
= make_minibuffer_frame ();
4720 minibuffer_only
= 1;
4722 else if (WINDOWP (tem
))
4723 f
= make_frame_without_minibuffer (tem
, kb
, display
);
4727 XSETFRAME (frame
, f
);
4729 /* Note that Windows does support scroll bars. */
4730 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
4731 /* By default, make scrollbars the system standard width. */
4732 f
->scroll_bar_pixel_width
= GetSystemMetrics (SM_CXVSCROLL
);
4734 f
->output_method
= output_w32
;
4735 f
->output_data
.w32
= (struct w32_output
*) xmalloc (sizeof (struct w32_output
));
4736 bzero (f
->output_data
.w32
, sizeof (struct w32_output
));
4738 FRAME_FONTSET (f
) = -1;
4741 = x_get_arg (parms
, Qicon_name
, "iconName", "Title", string
);
4742 if (! STRINGP (f
->icon_name
))
4743 f
->icon_name
= Qnil
;
4745 /* FRAME_W32_DISPLAY_INFO (f) = dpyinfo; */
4747 FRAME_KBOARD (f
) = kb
;
4750 /* Specify the parent under which to make this window. */
4754 f
->output_data
.w32
->parent_desc
= (Window
) parent
;
4755 f
->output_data
.w32
->explicit_parent
= 1;
4759 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
4760 f
->output_data
.w32
->explicit_parent
= 0;
4763 /* Note that the frame has no physical cursor right now. */
4764 f
->phys_cursor_x
= -1;
4766 /* Set the name; the functions to which we pass f expect the name to
4768 if (EQ (name
, Qunbound
) || NILP (name
))
4770 f
->name
= build_string (dpyinfo
->w32_id_name
);
4771 f
->explicit_name
= 0;
4776 f
->explicit_name
= 1;
4777 /* use the frame's title when getting resources for this frame. */
4778 specbind (Qx_resource_name
, name
);
4781 /* Create fontsets from `global_fontset_alist' before handling fonts. */
4782 for (tem
= Vglobal_fontset_alist
; CONSP (tem
); tem
= XCONS (tem
)->cdr
)
4783 fs_register_fontset (f
, XCONS (tem
)->car
);
4785 /* Extract the window parameters from the supplied values
4786 that are needed to determine window geometry. */
4790 font
= x_get_arg (parms
, Qfont
, "font", "Font", string
);
4792 /* First, try whatever font the caller has specified. */
4795 tem
= Fquery_fontset (font
, Qnil
);
4797 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
4799 font
= x_new_font (f
, XSTRING (font
)->data
);
4801 /* Try out a font which we hope has bold and italic variations. */
4802 if (!STRINGP (font
))
4803 font
= x_new_font (f
, "-*-Courier New-normal-r-*-*-13-*-*-*-c-*-iso8859-1");
4804 if (! STRINGP (font
))
4805 font
= x_new_font (f
, "-*-Courier-normal-r-*-*-*-97-*-*-c-*-iso8859-1");
4806 /* If those didn't work, look for something which will at least work. */
4807 if (! STRINGP (font
))
4808 font
= x_new_font (f
, "-*-Fixedsys-normal-r-*-*-*-*-90-*-c-*-iso8859-1");
4810 if (! STRINGP (font
))
4811 font
= build_string ("Fixedsys");
4813 x_default_parameter (f
, parms
, Qfont
, font
,
4814 "font", "Font", string
);
4817 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
4818 "borderwidth", "BorderWidth", number
);
4819 /* This defaults to 2 in order to match xterm. We recognize either
4820 internalBorderWidth or internalBorder (which is what xterm calls
4822 if (NILP (Fassq (Qinternal_border_width
, parms
)))
4826 value
= x_get_arg (parms
, Qinternal_border_width
,
4827 "internalBorder", "BorderWidth", number
);
4828 if (! EQ (value
, Qunbound
))
4829 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
4832 /* Default internalBorderWidth to 0 on Windows to match other programs. */
4833 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (0),
4834 "internalBorderWidth", "BorderWidth", number
);
4835 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qt
,
4836 "verticalScrollBars", "ScrollBars", boolean
);
4838 /* Also do the stuff which must be set before the window exists. */
4839 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
4840 "foreground", "Foreground", string
);
4841 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
4842 "background", "Background", string
);
4843 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
4844 "pointerColor", "Foreground", string
);
4845 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
4846 "cursorColor", "Foreground", string
);
4847 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
4848 "borderColor", "BorderColor", string
);
4850 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (1),
4851 "menuBar", "MenuBar", number
);
4852 x_default_parameter (f
, parms
, Qscroll_bar_width
, Qnil
,
4853 "scrollBarWidth", "ScrollBarWidth", number
);
4854 x_default_parameter (f
, parms
, Qbuffer_predicate
, Qnil
,
4855 "bufferPredicate", "BufferPredicate", symbol
);
4856 x_default_parameter (f
, parms
, Qtitle
, Qnil
,
4857 "title", "Title", string
);
4859 f
->output_data
.w32
->dwStyle
= WS_OVERLAPPEDWINDOW
;
4860 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
4861 window_prompting
= x_figure_window_size (f
, parms
);
4863 if (window_prompting
& XNegative
)
4865 if (window_prompting
& YNegative
)
4866 f
->output_data
.w32
->win_gravity
= SouthEastGravity
;
4868 f
->output_data
.w32
->win_gravity
= NorthEastGravity
;
4872 if (window_prompting
& YNegative
)
4873 f
->output_data
.w32
->win_gravity
= SouthWestGravity
;
4875 f
->output_data
.w32
->win_gravity
= NorthWestGravity
;
4878 f
->output_data
.w32
->size_hint_flags
= window_prompting
;
4880 w32_window (f
, window_prompting
, minibuffer_only
);
4882 init_frame_faces (f
);
4884 /* We need to do this after creating the window, so that the
4885 icon-creation functions can say whose icon they're describing. */
4886 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
4887 "bitmapIcon", "BitmapIcon", symbol
);
4889 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
4890 "autoRaise", "AutoRaiseLower", boolean
);
4891 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
4892 "autoLower", "AutoRaiseLower", boolean
);
4893 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
4894 "cursorType", "CursorType", symbol
);
4896 /* Dimensions, especially f->height, must be done via change_frame_size.
4897 Change will not be effected unless different from the current
4902 SET_FRAME_WIDTH (f
, 0);
4903 change_frame_size (f
, height
, width
, 1, 0);
4905 /* Tell the server what size and position, etc, we want,
4906 and how badly we want them. */
4908 x_wm_set_size_hint (f
, window_prompting
, 0);
4911 tem
= x_get_arg (parms
, Qunsplittable
, 0, 0, boolean
);
4912 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
4916 /* It is now ok to make the frame official
4917 even if we get an error below.
4918 And the frame needs to be on Vframe_list
4919 or making it visible won't work. */
4920 Vframe_list
= Fcons (frame
, Vframe_list
);
4922 /* Now that the frame is official, it counts as a reference to
4924 FRAME_W32_DISPLAY_INFO (f
)->reference_count
++;
4926 /* Make the window appear on the frame and enable display,
4927 unless the caller says not to. However, with explicit parent,
4928 Emacs cannot control visibility, so don't try. */
4929 if (! f
->output_data
.w32
->explicit_parent
)
4931 Lisp_Object visibility
;
4933 visibility
= x_get_arg (parms
, Qvisibility
, 0, 0, symbol
);
4934 if (EQ (visibility
, Qunbound
))
4937 if (EQ (visibility
, Qicon
))
4938 x_iconify_frame (f
);
4939 else if (! NILP (visibility
))
4940 x_make_frame_visible (f
);
4942 /* Must have been Qnil. */
4946 return unbind_to (count
, frame
);
4949 /* FRAME is used only to get a handle on the X display. We don't pass the
4950 display info directly because we're called from frame.c, which doesn't
4951 know about that structure. */
4953 x_get_focus_frame (frame
)
4954 struct frame
*frame
;
4956 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (frame
);
4958 if (! dpyinfo
->w32_focus_frame
)
4961 XSETFRAME (xfocus
, dpyinfo
->w32_focus_frame
);
4965 DEFUN ("w32-focus-frame", Fw32_focus_frame
, Sw32_focus_frame
, 1, 1, 0,
4966 "Give FRAME input focus, raising to foreground if necessary.")
4970 x_focus_on_frame (check_x_frame (frame
));
4975 struct font_info
*w32_load_bdf_font (struct frame
*f
, char *fontname
,
4976 int size
, char* filename
);
4979 w32_load_system_font (f
,fontname
,size
)
4984 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
4985 Lisp_Object font_names
;
4987 /* Get a list of all the fonts that match this name. Once we
4988 have a list of matching fonts, we compare them against the fonts
4989 we already have loaded by comparing names. */
4990 font_names
= w32_list_fonts (f
, build_string (fontname
), size
, 100);
4992 if (!NILP (font_names
))
4996 #if 0 /* This code has nasty side effects that cause Emacs to crash. */
4998 /* First check if any are already loaded, as that is cheaper
4999 than loading another one. */
5000 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
5001 for (tail
= font_names
; CONSP (tail
); tail
= XCONS (tail
)->cdr
)
5002 if (!strcmp (dpyinfo
->font_table
[i
].name
,
5003 XSTRING (XCONS (tail
)->car
)->data
)
5004 || !strcmp (dpyinfo
->font_table
[i
].full_name
,
5005 XSTRING (XCONS (tail
)->car
)->data
))
5006 return (dpyinfo
->font_table
+ i
);
5008 fontname
= (char *) XSTRING (XCONS (font_names
)->car
)->data
;
5010 else if (w32_strict_fontnames
)
5012 /* If EnumFontFamiliesEx was available, we got a full list of
5013 fonts back so stop now to avoid the possibility of loading a
5014 random font. If we had to fall back to EnumFontFamilies, the
5015 list is incomplete, so continue whether the font we want was
5017 HMODULE gdi32
= GetModuleHandle ("gdi32.dll");
5018 FARPROC enum_font_families_ex
5019 = GetProcAddress (gdi32
, "EnumFontFamiliesExA");
5020 if (enum_font_families_ex
)
5024 /* Load the font and add it to the table. */
5026 char *full_name
, *encoding
;
5028 struct font_info
*fontp
;
5032 if (!fontname
|| !x_to_w32_font (fontname
, &lf
))
5035 if (!*lf
.lfFaceName
)
5036 /* If no name was specified for the font, we get a random font
5037 from CreateFontIndirect - this is not particularly
5038 desirable, especially since CreateFontIndirect does not
5039 fill out the missing name in lf, so we never know what we
5043 font
= (XFontStruct
*) xmalloc (sizeof (XFontStruct
));
5045 /* Set bdf to NULL to indicate that this is a Windows font. */
5050 font
->hfont
= CreateFontIndirect (&lf
);
5052 if (font
->hfont
== NULL
)
5061 hdc
= GetDC (dpyinfo
->root_window
);
5062 oldobj
= SelectObject (hdc
, font
->hfont
);
5063 ok
= GetTextMetrics (hdc
, &font
->tm
);
5064 SelectObject (hdc
, oldobj
);
5065 ReleaseDC (dpyinfo
->root_window
, hdc
);
5067 /* [andrewi, 25-Apr-99] A number of fixed pitch fonts,
5068 eg. Courier New and perhaps others, report a max width which
5069 is larger than the average character width, at least on some
5070 NT systems (I don't understand why - my best guess is that it
5071 results from installing the CJK language packs for NT4).
5072 Unfortunately, this forces the redisplay code in dumpglyphs
5073 to draw text character by character.
5075 I don't like this hack, but it seems better to force the max
5076 width to match the average width if the font is marked as
5077 fixed pitch, for the sake of redisplay performance. */
5079 if ((font
->tm
.tmPitchAndFamily
& TMPF_FIXED_PITCH
) == 0)
5080 font
->tm
.tmMaxCharWidth
= font
->tm
.tmAveCharWidth
;
5087 w32_unload_font (dpyinfo
, font
);
5091 /* Do we need to create the table? */
5092 if (dpyinfo
->font_table_size
== 0)
5094 dpyinfo
->font_table_size
= 16;
5096 = (struct font_info
*) xmalloc (dpyinfo
->font_table_size
5097 * sizeof (struct font_info
));
5099 /* Do we need to grow the table? */
5100 else if (dpyinfo
->n_fonts
5101 >= dpyinfo
->font_table_size
)
5103 dpyinfo
->font_table_size
*= 2;
5105 = (struct font_info
*) xrealloc (dpyinfo
->font_table
,
5106 (dpyinfo
->font_table_size
5107 * sizeof (struct font_info
)));
5110 fontp
= dpyinfo
->font_table
+ dpyinfo
->n_fonts
;
5112 /* Now fill in the slots of *FONTP. */
5115 fontp
->font_idx
= dpyinfo
->n_fonts
;
5116 fontp
->name
= (char *) xmalloc (strlen (fontname
) + 1);
5117 bcopy (fontname
, fontp
->name
, strlen (fontname
) + 1);
5119 /* Work out the font's full name. */
5120 full_name
= (char *)xmalloc (100);
5121 if (full_name
&& w32_to_x_font (&lf
, full_name
, 100))
5122 fontp
->full_name
= full_name
;
5125 /* If all else fails - just use the name we used to load it. */
5127 fontp
->full_name
= fontp
->name
;
5130 fontp
->size
= FONT_WIDTH (font
);
5131 fontp
->height
= FONT_HEIGHT (font
);
5133 /* The slot `encoding' specifies how to map a character
5134 code-points (0x20..0x7F or 0x2020..0x7F7F) of each charset to
5135 the font code-points (0:0x20..0x7F, 1:0xA0..0xFF, 0:0x2020..0x7F7F,
5136 the font code-points (0:0x20..0x7F, 1:0xA0..0xFF,
5137 0:0x2020..0x7F7F, 1:0xA0A0..0xFFFF, 3:0x20A0..0x7FFF, or
5138 2:0xA020..0xFF7F). For the moment, we don't know which charset
5139 uses this font. So, we set informatoin in fontp->encoding[1]
5140 which is never used by any charset. If mapping can't be
5141 decided, set FONT_ENCODING_NOT_DECIDED. */
5143 /* SJIS fonts need to be set to type 4, all others seem to work as
5144 type FONT_ENCODING_NOT_DECIDED. */
5145 encoding
= strrchr (fontp
->name
, '-');
5146 if (encoding
&& stricmp (encoding
+1, "sjis") == 0)
5147 fontp
->encoding
[1] = 4;
5149 fontp
->encoding
[1] = FONT_ENCODING_NOT_DECIDED
;
5151 /* The following three values are set to 0 under W32, which is
5152 what they get set to if XGetFontProperty fails under X. */
5153 fontp
->baseline_offset
= 0;
5154 fontp
->relative_compose
= 0;
5155 fontp
->default_ascent
= 0;
5164 /* Load font named FONTNAME of size SIZE for frame F, and return a
5165 pointer to the structure font_info while allocating it dynamically.
5166 If loading fails, return NULL. */
5168 w32_load_font (f
,fontname
,size
)
5173 Lisp_Object bdf_fonts
;
5174 struct font_info
*retval
= NULL
;
5176 bdf_fonts
= w32_list_bdf_fonts (build_string (fontname
));
5178 while (!retval
&& CONSP (bdf_fonts
))
5180 char *bdf_name
, *bdf_file
;
5181 Lisp_Object bdf_pair
;
5183 bdf_name
= XSTRING (XCONS (bdf_fonts
)->car
)->data
;
5184 bdf_pair
= Fassoc (XCONS (bdf_fonts
)->car
, Vw32_bdf_filename_alist
);
5185 bdf_file
= XSTRING (XCONS (bdf_pair
)->cdr
)->data
;
5187 retval
= w32_load_bdf_font (f
, bdf_name
, size
, bdf_file
);
5189 bdf_fonts
= XCONS (bdf_fonts
)->cdr
;
5195 return w32_load_system_font(f
, fontname
, size
);
5200 w32_unload_font (dpyinfo
, font
)
5201 struct w32_display_info
*dpyinfo
;
5206 if (font
->bdf
) w32_free_bdf_font (font
->bdf
);
5208 if (font
->hfont
) DeleteObject(font
->hfont
);
5213 /* The font conversion stuff between x and w32 */
5215 /* X font string is as follows (from faces.el)
5219 * (weight "\\(bold\\|demibold\\|medium\\)") ; 1
5220 * (weight\? "\\([^-]*\\)") ; 1
5221 * (slant "\\([ior]\\)") ; 2
5222 * (slant\? "\\([^-]?\\)") ; 2
5223 * (swidth "\\([^-]*\\)") ; 3
5224 * (adstyle "[^-]*") ; 4
5225 * (pixelsize "[0-9]+")
5226 * (pointsize "[0-9][0-9]+")
5227 * (resx "[0-9][0-9]+")
5228 * (resy "[0-9][0-9]+")
5229 * (spacing "[cmp?*]")
5230 * (avgwidth "[0-9]+")
5231 * (registry "[^-]+")
5232 * (encoding "[^-]+")
5234 * (setq x-font-regexp
5235 * (concat "\\`\\*?[-?*]"
5236 * foundry - family - weight\? - slant\? - swidth - adstyle -
5237 * pixelsize - pointsize - resx - resy - spacing - registry -
5238 * encoding "[-?*]\\*?\\'"
5240 * (setq x-font-regexp-head
5241 * (concat "\\`[-?*]" foundry - family - weight\? - slant\?
5242 * "\\([-*?]\\|\\'\\)"))
5243 * (setq x-font-regexp-slant (concat - slant -))
5244 * (setq x-font-regexp-weight (concat - weight -))
5248 #define FONT_START "[-?]"
5249 #define FONT_FOUNDRY "[^-]+"
5250 #define FONT_FAMILY "\\([^-]+\\)" /* 1 */
5251 #define FONT_WEIGHT "\\(bold\\|demibold\\|medium\\)" /* 2 */
5252 #define FONT_WEIGHT_Q "\\([^-]*\\)" /* 2 */
5253 #define FONT_SLANT "\\([ior]\\)" /* 3 */
5254 #define FONT_SLANT_Q "\\([^-]?\\)" /* 3 */
5255 #define FONT_SWIDTH "\\([^-]*\\)" /* 4 */
5256 #define FONT_ADSTYLE "[^-]*"
5257 #define FONT_PIXELSIZE "[^-]*"
5258 #define FONT_POINTSIZE "\\([0-9][0-9]+\\|\\*\\)" /* 5 */
5259 #define FONT_RESX "[0-9][0-9]+"
5260 #define FONT_RESY "[0-9][0-9]+"
5261 #define FONT_SPACING "[cmp?*]"
5262 #define FONT_AVGWIDTH "[0-9]+"
5263 #define FONT_REGISTRY "[^-]+"
5264 #define FONT_ENCODING "[^-]+"
5266 #define FONT_REGEXP ("\\`\\*?[-?*]" \
5273 FONT_PIXELSIZE "-" \
5274 FONT_POINTSIZE "-" \
5277 #define FONT_REGEXP_HEAD ("\\`[-?*]" \
5282 "\\([-*?]\\|\\'\\)")
5284 #define FONT_REGEXP_SLANT "-" FONT_SLANT "-"
5285 #define FONT_REGEXP_WEIGHT "-" FONT_WEIGHT "-"
5288 x_to_w32_weight (lpw
)
5291 if (!lpw
) return (FW_DONTCARE
);
5293 if (stricmp (lpw
,"heavy") == 0) return FW_HEAVY
;
5294 else if (stricmp (lpw
,"extrabold") == 0) return FW_EXTRABOLD
;
5295 else if (stricmp (lpw
,"bold") == 0) return FW_BOLD
;
5296 else if (stricmp (lpw
,"demibold") == 0) return FW_SEMIBOLD
;
5297 else if (stricmp (lpw
,"semibold") == 0) return FW_SEMIBOLD
;
5298 else if (stricmp (lpw
,"medium") == 0) return FW_MEDIUM
;
5299 else if (stricmp (lpw
,"normal") == 0) return FW_NORMAL
;
5300 else if (stricmp (lpw
,"light") == 0) return FW_LIGHT
;
5301 else if (stricmp (lpw
,"extralight") == 0) return FW_EXTRALIGHT
;
5302 else if (stricmp (lpw
,"thin") == 0) return FW_THIN
;
5309 w32_to_x_weight (fnweight
)
5312 if (fnweight
>= FW_HEAVY
) return "heavy";
5313 if (fnweight
>= FW_EXTRABOLD
) return "extrabold";
5314 if (fnweight
>= FW_BOLD
) return "bold";
5315 if (fnweight
>= FW_SEMIBOLD
) return "semibold";
5316 if (fnweight
>= FW_MEDIUM
) return "medium";
5317 if (fnweight
>= FW_NORMAL
) return "normal";
5318 if (fnweight
>= FW_LIGHT
) return "light";
5319 if (fnweight
>= FW_EXTRALIGHT
) return "extralight";
5320 if (fnweight
>= FW_THIN
) return "thin";
5326 x_to_w32_charset (lpcs
)
5329 if (!lpcs
) return (0);
5331 if (stricmp (lpcs
,"ansi") == 0) return ANSI_CHARSET
;
5332 else if (stricmp (lpcs
,"iso8859-1") == 0) return ANSI_CHARSET
;
5333 else if (stricmp (lpcs
, "ms-symbol") == 0) return SYMBOL_CHARSET
;
5334 else if (stricmp (lpcs
, "jis") == 0) return SHIFTJIS_CHARSET
;
5335 else if (stricmp (lpcs
, "ksc5601.1987") == 0) return HANGEUL_CHARSET
;
5336 else if (stricmp (lpcs
, "gb2312") == 0) return GB2312_CHARSET
;
5337 else if (stricmp (lpcs
, "big5") == 0) return CHINESEBIG5_CHARSET
;
5338 else if (stricmp (lpcs
, "ms-oem") == 0) return OEM_CHARSET
;
5340 #ifdef EASTEUROPE_CHARSET
5341 else if (stricmp (lpcs
, "iso8859-2") == 0) return EASTEUROPE_CHARSET
;
5342 else if (stricmp (lpcs
, "iso8859-3") == 0) return TURKISH_CHARSET
;
5343 else if (stricmp (lpcs
, "iso8859-4") == 0) return BALTIC_CHARSET
;
5344 else if (stricmp (lpcs
, "iso8859-5") == 0) return RUSSIAN_CHARSET
;
5345 else if (stricmp (lpcs
, "koi8") == 0) return RUSSIAN_CHARSET
;
5346 else if (stricmp (lpcs
, "iso8859-6") == 0) return ARABIC_CHARSET
;
5347 else if (stricmp (lpcs
, "iso8859-7") == 0) return GREEK_CHARSET
;
5348 else if (stricmp (lpcs
, "iso8859-8") == 0) return HEBREW_CHARSET
;
5349 else if (stricmp (lpcs
, "iso8859-9") == 0) return TURKISH_CHARSET
;
5350 else if (stricmp (lpcs
, "viscii") == 0) return VIETNAMESE_CHARSET
;
5351 else if (stricmp (lpcs
, "vscii") == 0) return VIETNAMESE_CHARSET
;
5352 else if (stricmp (lpcs
, "tis620") == 0) return THAI_CHARSET
;
5353 else if (stricmp (lpcs
, "mac") == 0) return MAC_CHARSET
;
5354 else if (stricmp (lpcs
, "ksc5601.1992") == 0) return JOHAB_CHARSET
;
5355 /* For backwards compatibility with previous 20.4 pretests. */
5356 else if (stricmp (lpcs
, "ksc5601") == 0) return HANGEUL_CHARSET
;
5357 else if (stricmp (lpcs
, "johab") == 0) return JOHAB_CHARSET
;
5360 #ifdef UNICODE_CHARSET
5361 else if (stricmp (lpcs
,"iso10646") == 0) return UNICODE_CHARSET
;
5362 else if (stricmp (lpcs
, "unicode") == 0) return UNICODE_CHARSET
;
5364 else if (lpcs
[0] == '#') return atoi (lpcs
+ 1);
5366 return DEFAULT_CHARSET
;
5370 w32_to_x_charset (fncharset
)
5373 static char buf
[16];
5377 /* ansi is considered iso8859-1, as most modern ansi fonts are. */
5378 case ANSI_CHARSET
: return "iso8859-1";
5379 case DEFAULT_CHARSET
: return "ascii-*";
5380 case SYMBOL_CHARSET
: return "ms-symbol";
5381 case SHIFTJIS_CHARSET
: return "jisx0208-sjis";
5382 case HANGEUL_CHARSET
: return "ksc5601.1987-*";
5383 case GB2312_CHARSET
: return "gb2312-*";
5384 case CHINESEBIG5_CHARSET
: return "big5-*";
5385 case OEM_CHARSET
: return "ms-oem";
5387 /* More recent versions of Windows (95 and NT4.0) define more
5389 #ifdef EASTEUROPE_CHARSET
5390 case EASTEUROPE_CHARSET
: return "iso8859-2";
5391 case TURKISH_CHARSET
: return "iso8859-9";
5392 case BALTIC_CHARSET
: return "iso8859-4";
5394 /* W95 with international support but not IE4 often has the
5395 KOI8-R codepage but not ISO8859-5. */
5396 case RUSSIAN_CHARSET
:
5397 if (!IsValidCodePage(28595) && IsValidCodePage(20886))
5401 case ARABIC_CHARSET
: return "iso8859-6";
5402 case GREEK_CHARSET
: return "iso8859-7";
5403 case HEBREW_CHARSET
: return "iso8859-8";
5404 case VIETNAMESE_CHARSET
: return "viscii1.1-*";
5405 case THAI_CHARSET
: return "tis620-*";
5406 case MAC_CHARSET
: return "mac-*";
5407 case JOHAB_CHARSET
: return "ksc5601.1992-*";
5411 #ifdef UNICODE_CHARSET
5412 case UNICODE_CHARSET
: return "iso10646-unicode";
5415 /* Encode numerical value of unknown charset. */
5416 sprintf (buf
, "*-#%u", fncharset
);
5421 w32_to_x_font (lplogfont
, lpxstr
, len
)
5422 LOGFONT
* lplogfont
;
5427 char height_pixels
[8];
5429 char width_pixels
[8];
5430 char *fontname_dash
;
5431 int display_resy
= one_w32_display_info
.height_in
;
5432 int display_resx
= one_w32_display_info
.width_in
;
5434 struct coding_system coding
;
5436 if (!lpxstr
) abort ();
5441 setup_coding_system (Fcheck_coding_system (Vw32_system_coding_system
),
5443 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5444 bufsz
= decoding_buffer_size (&coding
, LF_FACESIZE
);
5446 fontname
= alloca(sizeof(*fontname
) * bufsz
);
5447 decode_coding (&coding
, lplogfont
->lfFaceName
, fontname
,
5448 strlen(lplogfont
->lfFaceName
), bufsz
- 1);
5449 *(fontname
+ coding
.produced
) = '\0';
5451 /* Replace dashes with underscores so the dashes are not
5453 fontname_dash
= fontname
;
5454 while (fontname_dash
= strchr (fontname_dash
, '-'))
5455 *fontname_dash
= '_';
5457 if (lplogfont
->lfHeight
)
5459 sprintf (height_pixels
, "%u", abs (lplogfont
->lfHeight
));
5460 sprintf (height_dpi
, "%u",
5461 abs (lplogfont
->lfHeight
) * 720 / display_resy
);
5465 strcpy (height_pixels
, "*");
5466 strcpy (height_dpi
, "*");
5468 if (lplogfont
->lfWidth
)
5469 sprintf (width_pixels
, "%u", lplogfont
->lfWidth
* 10);
5471 strcpy (width_pixels
, "*");
5473 _snprintf (lpxstr
, len
- 1,
5474 "-*-%s-%s-%c-*-*-%s-%s-%d-%d-%c-%s-%s",
5476 fontname
, /* family */
5477 w32_to_x_weight (lplogfont
->lfWeight
), /* weight */
5478 lplogfont
->lfItalic
?'i':'r', /* slant */
5480 /* add style name */
5481 height_pixels
, /* pixel size */
5482 height_dpi
, /* point size */
5483 display_resx
, /* resx */
5484 display_resy
, /* resy */
5485 ((lplogfont
->lfPitchAndFamily
& 0x3) == VARIABLE_PITCH
)
5486 ? 'p' : 'c', /* spacing */
5487 width_pixels
, /* avg width */
5488 w32_to_x_charset (lplogfont
->lfCharSet
) /* charset registry
5492 lpxstr
[len
- 1] = 0; /* just to be sure */
5497 x_to_w32_font (lpxstr
, lplogfont
)
5499 LOGFONT
* lplogfont
;
5501 struct coding_system coding
;
5503 if (!lplogfont
) return (FALSE
);
5505 memset (lplogfont
, 0, sizeof (*lplogfont
));
5507 /* Set default value for each field. */
5509 lplogfont
->lfOutPrecision
= OUT_DEFAULT_PRECIS
;
5510 lplogfont
->lfClipPrecision
= CLIP_DEFAULT_PRECIS
;
5511 lplogfont
->lfQuality
= DEFAULT_QUALITY
;
5513 /* go for maximum quality */
5514 lplogfont
->lfOutPrecision
= OUT_STROKE_PRECIS
;
5515 lplogfont
->lfClipPrecision
= CLIP_STROKE_PRECIS
;
5516 lplogfont
->lfQuality
= PROOF_QUALITY
;
5519 lplogfont
->lfCharSet
= DEFAULT_CHARSET
;
5520 lplogfont
->lfWeight
= FW_DONTCARE
;
5521 lplogfont
->lfPitchAndFamily
= DEFAULT_PITCH
| FF_DONTCARE
;
5526 /* Provide a simple escape mechanism for specifying Windows font names
5527 * directly -- if font spec does not beginning with '-', assume this
5529 * "<font name>[:height in pixels[:width in pixels[:weight]]]"
5535 char name
[50], weight
[20], slant
, pitch
, pixels
[10], height
[10],
5536 width
[10], resy
[10], remainder
[20];
5538 int dpi
= one_w32_display_info
.height_in
;
5540 fields
= sscanf (lpxstr
,
5541 "-%*[^-]-%49[^-]-%19[^-]-%c-%*[^-]-%*[^-]-%9[^-]-%9[^-]-%*[^-]-%9[^-]-%c-%9[^-]-%19s",
5542 name
, weight
, &slant
, pixels
, height
, resy
, &pitch
, width
, remainder
);
5543 if (fields
== EOF
) return (FALSE
);
5545 if (fields
> 0 && name
[0] != '*')
5551 (Fcheck_coding_system (Vw32_system_coding_system
), &coding
);
5552 bufsize
= encoding_buffer_size (&coding
, strlen (name
));
5553 buf
= (unsigned char *) alloca (bufsize
);
5554 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5555 encode_coding (&coding
, name
, buf
, strlen (name
), bufsize
);
5556 if (coding
.produced
>= LF_FACESIZE
)
5557 coding
.produced
= LF_FACESIZE
- 1;
5558 buf
[coding
.produced
] = 0;
5559 strcpy (lplogfont
->lfFaceName
, buf
);
5563 lplogfont
->lfFaceName
[0] = 0;
5568 lplogfont
->lfWeight
= x_to_w32_weight ((fields
> 0 ? weight
: ""));
5572 if (!NILP (Vw32_enable_italics
))
5573 lplogfont
->lfItalic
= (fields
> 0 && slant
== 'i');
5577 if (fields
> 0 && pixels
[0] != '*')
5578 lplogfont
->lfHeight
= atoi (pixels
);
5582 if (fields
> 0 && resy
[0] != '*')
5584 tem
= atoi (pixels
);
5585 if (tem
> 0) dpi
= tem
;
5588 if (fields
> -1 && lplogfont
->lfHeight
== 0 && height
[0] != '*')
5589 lplogfont
->lfHeight
= atoi (height
) * dpi
/ 720;
5592 lplogfont
->lfPitchAndFamily
=
5593 (fields
> 0 && pitch
== 'p') ? VARIABLE_PITCH
: FIXED_PITCH
;
5597 if (fields
> 0 && width
[0] != '*')
5598 lplogfont
->lfWidth
= atoi (width
) / 10;
5602 /* Strip the trailing '-' if present. (it shouldn't be, as it
5603 fails the test against xlfn-tight-regexp in fontset.el). */
5605 int len
= strlen (remainder
);
5606 if (len
> 0 && remainder
[len
-1] == '-')
5607 remainder
[len
-1] = 0;
5609 encoding
= remainder
;
5610 if (strncmp (encoding
, "*-", 2) == 0)
5612 lplogfont
->lfCharSet
= x_to_w32_charset (fields
> 0 ? encoding
: "");
5617 char name
[100], height
[10], width
[10], weight
[20];
5619 fields
= sscanf (lpxstr
,
5620 "%99[^:]:%9[^:]:%9[^:]:%19s",
5621 name
, height
, width
, weight
);
5623 if (fields
== EOF
) return (FALSE
);
5627 strncpy (lplogfont
->lfFaceName
,name
, LF_FACESIZE
);
5628 lplogfont
->lfFaceName
[LF_FACESIZE
-1] = 0;
5632 lplogfont
->lfFaceName
[0] = 0;
5638 lplogfont
->lfHeight
= atoi (height
);
5643 lplogfont
->lfWidth
= atoi (width
);
5647 lplogfont
->lfWeight
= x_to_w32_weight ((fields
> 0 ? weight
: ""));
5650 /* This makes TrueType fonts work better. */
5651 lplogfont
->lfHeight
= - abs (lplogfont
->lfHeight
);
5657 w32_font_match (lpszfont1
, lpszfont2
)
5661 char * s1
= lpszfont1
, *e1
, *w1
;
5662 char * s2
= lpszfont2
, *e2
, *w2
;
5664 if (s1
== NULL
|| s2
== NULL
) return (FALSE
);
5666 if (*s1
== '-') s1
++;
5667 if (*s2
== '-') s2
++;
5671 int len1
, len2
, len3
=0;
5673 e1
= strchr (s1
, '-');
5674 e2
= strchr (s2
, '-');
5675 w1
= strchr (s1
, '*');
5676 w2
= strchr (s2
, '*');
5689 if (w2
&& w2
< e2
&& ( len3
== 0 || (w2
- s2
) < len3
))
5692 /* Whole field is not a wildcard, and ...*/
5693 if (*s1
!= '*' && *s2
!= '*' && *s1
!= '-' && *s2
!= '-'
5694 /* Lengths are different and there are no wildcards, or ... */
5695 && ((len1
!= len2
&& len3
== 0) ||
5696 /* strings don't match up until first wildcard or end. */
5697 strnicmp (s1
, s2
, len3
> 0 ? len3
: len1
) != 0))
5700 if (e1
== NULL
|| e2
== NULL
)
5708 /* Callback functions, and a structure holding info they need, for
5709 listing system fonts on W32. We need one set of functions to do the
5710 job properly, but these don't work on NT 3.51 and earlier, so we
5711 have a second set which don't handle character sets properly to
5714 In both cases, there are two passes made. The first pass gets one
5715 font from each family, the second pass lists all the fonts from
5718 typedef struct enumfont_t
5723 XFontStruct
*size_ref
;
5724 Lisp_Object
*pattern
;
5729 enum_font_cb2 (lplf
, lptm
, FontType
, lpef
)
5731 NEWTEXTMETRIC
* lptm
;
5735 if (lplf
->elfLogFont
.lfStrikeOut
|| lplf
->elfLogFont
.lfUnderline
)
5738 /* Check that the character set matches if it was specified */
5739 if (lpef
->logfont
.lfCharSet
!= DEFAULT_CHARSET
&&
5740 lplf
->elfLogFont
.lfCharSet
!= lpef
->logfont
.lfCharSet
)
5743 /* We want all fonts cached, so don't compare sizes just yet */
5744 /* if (!lpef->size_ref || lptm->tmMaxCharWidth == FONT_WIDTH (lpef->size_ref)) */
5747 Lisp_Object width
= Qnil
;
5749 if (!NILP (*(lpef
->pattern
)) && FontType
!= RASTER_FONTTYPE
)
5751 /* Scalable fonts are as big as you want them to be. */
5752 lplf
->elfLogFont
.lfHeight
= lpef
->logfont
.lfHeight
;
5753 lplf
->elfLogFont
.lfWidth
= lpef
->logfont
.lfWidth
;
5755 /* Make sure the height used here is the same as everywhere
5756 else (ie character height, not cell height). */
5757 else if (lplf
->elfLogFont
.lfHeight
> 0)
5758 lplf
->elfLogFont
.lfHeight
= lptm
->tmInternalLeading
- lptm
->tmHeight
;
5760 /* The MaxCharWidth is not valid at this stage for scalable fonts. */
5761 if (FontType
== RASTER_FONTTYPE
)
5762 width
= make_number (lptm
->tmMaxCharWidth
);
5764 if (!w32_to_x_font (&(lplf
->elfLogFont
), buf
, 100))
5767 if (NILP (*(lpef
->pattern
))
5768 || w32_font_match (buf
, XSTRING (*(lpef
->pattern
))->data
))
5770 *lpef
->tail
= Fcons (Fcons (build_string (buf
), width
), Qnil
);
5771 lpef
->tail
= &(XCONS (*lpef
->tail
)->cdr
);
5780 enum_font_cb1 (lplf
, lptm
, FontType
, lpef
)
5782 NEWTEXTMETRIC
* lptm
;
5786 return EnumFontFamilies (lpef
->hdc
,
5787 lplf
->elfLogFont
.lfFaceName
,
5788 (FONTENUMPROC
) enum_font_cb2
,
5794 enum_fontex_cb2 (lplf
, lptm
, font_type
, lpef
)
5795 ENUMLOGFONTEX
* lplf
;
5796 NEWTEXTMETRICEX
* lptm
;
5800 /* We are not interested in the extra info we get back from the 'Ex
5801 version - only the fact that we get character set variations
5802 enumerated seperately. */
5803 return enum_font_cb2 ((ENUMLOGFONT
*) lplf
, (NEWTEXTMETRIC
*) lptm
,
5808 enum_fontex_cb1 (lplf
, lptm
, font_type
, lpef
)
5809 ENUMLOGFONTEX
* lplf
;
5810 NEWTEXTMETRICEX
* lptm
;
5814 HMODULE gdi32
= GetModuleHandle ("gdi32.dll");
5815 FARPROC enum_font_families_ex
5816 = GetProcAddress ( gdi32
, "EnumFontFamiliesExA");
5817 /* We don't really expect EnumFontFamiliesEx to disappear once we
5818 get here, so don't bother handling it gracefully. */
5819 if (enum_font_families_ex
== NULL
)
5820 error ("gdi32.dll has disappeared!");
5821 return enum_font_families_ex (lpef
->hdc
,
5823 (FONTENUMPROC
) enum_fontex_cb2
,
5827 /* Interface to fontset handler. (adapted from mw32font.c in Meadow
5828 and xterm.c in Emacs 20.3) */
5830 Lisp_Object
w32_list_bdf_fonts (Lisp_Object pattern
, int max_names
)
5832 char *fontname
, *ptnstr
;
5833 Lisp_Object list
, tem
, newlist
= Qnil
;
5836 list
= Vw32_bdf_filename_alist
;
5837 ptnstr
= XSTRING (pattern
)->data
;
5839 for ( ; CONSP (list
); list
= XCONS (list
)->cdr
)
5841 tem
= XCONS (list
)->car
;
5843 fontname
= XSTRING (XCONS (tem
)->car
)->data
;
5844 else if (STRINGP (tem
))
5845 fontname
= XSTRING (tem
)->data
;
5849 if (w32_font_match (fontname
, ptnstr
))
5851 newlist
= Fcons (XCONS (tem
)->car
, newlist
);
5853 if (n_fonts
>= max_names
)
5861 Lisp_Object
w32_list_synthesized_fonts (FRAME_PTR f
, Lisp_Object pattern
,
5862 int size
, int max_names
);
5864 /* Return a list of names of available fonts matching PATTERN on frame
5865 F. If SIZE is not 0, it is the size (maximum bound width) of fonts
5866 to be listed. Frame F NULL means we have not yet created any
5867 frame, which means we can't get proper size info, as we don't have
5868 a device context to use for GetTextMetrics.
5869 MAXNAMES sets a limit on how many fonts to match. */
5872 w32_list_fonts (FRAME_PTR f
, Lisp_Object pattern
, int size
, int maxnames
)
5874 Lisp_Object patterns
, key
, tem
, tpat
;
5875 Lisp_Object list
= Qnil
, newlist
= Qnil
, second_best
= Qnil
;
5876 struct w32_display_info
*dpyinfo
= &one_w32_display_info
;
5879 patterns
= Fassoc (pattern
, Valternate_fontname_alist
);
5880 if (NILP (patterns
))
5881 patterns
= Fcons (pattern
, Qnil
);
5883 for (; CONSP (patterns
); patterns
= XCONS (patterns
)->cdr
)
5887 tpat
= XCONS (patterns
)->car
;
5889 /* See if we cached the result for this particular query.
5890 The cache is an alist of the form:
5891 ((PATTERN (FONTNAME . WIDTH) ...) ...)
5893 if (tem
= XCONS (dpyinfo
->name_list_element
)->cdr
,
5894 !NILP (list
= Fassoc (tpat
, tem
)))
5896 list
= Fcdr_safe (list
);
5897 /* We have a cached list. Don't have to get the list again. */
5902 /* At first, put PATTERN in the cache. */
5908 /* Use EnumFontFamiliesEx where it is available, as it knows
5909 about character sets. Fall back to EnumFontFamilies for
5910 older versions of NT that don't support the 'Ex function. */
5911 x_to_w32_font (STRINGP (tpat
) ? XSTRING (tpat
)->data
:
5914 LOGFONT font_match_pattern
;
5915 HMODULE gdi32
= GetModuleHandle ("gdi32.dll");
5916 FARPROC enum_font_families_ex
5917 = GetProcAddress ( gdi32
, "EnumFontFamiliesExA");
5919 /* We do our own pattern matching so we can handle wildcards. */
5920 font_match_pattern
.lfFaceName
[0] = 0;
5921 font_match_pattern
.lfPitchAndFamily
= 0;
5922 /* We can use the charset, because if it is a wildcard it will
5923 be DEFAULT_CHARSET anyway. */
5924 font_match_pattern
.lfCharSet
= ef
.logfont
.lfCharSet
;
5926 ef
.hdc
= GetDC (dpyinfo
->root_window
);
5928 if (enum_font_families_ex
)
5929 enum_font_families_ex (ef
.hdc
,
5930 &font_match_pattern
,
5931 (FONTENUMPROC
) enum_fontex_cb1
,
5934 EnumFontFamilies (ef
.hdc
, NULL
, (FONTENUMPROC
) enum_font_cb1
,
5937 ReleaseDC (dpyinfo
->root_window
, ef
.hdc
);
5942 /* Make a list of the fonts we got back.
5943 Store that in the font cache for the display. */
5944 XCONS (dpyinfo
->name_list_element
)->cdr
5945 = Fcons (Fcons (tpat
, list
),
5946 XCONS (dpyinfo
->name_list_element
)->cdr
);
5949 if (NILP (list
)) continue; /* Try the remaining alternatives. */
5951 newlist
= second_best
= Qnil
;
5953 /* Make a list of the fonts that have the right width. */
5954 for (; CONSP (list
); list
= XCONS (list
)->cdr
)
5957 tem
= XCONS (list
)->car
;
5961 if (NILP (XCONS (tem
)->car
))
5965 newlist
= Fcons (XCONS (tem
)->car
, newlist
);
5967 if (n_fonts
>= maxnames
)
5972 if (!INTEGERP (XCONS (tem
)->cdr
))
5974 /* Since we don't yet know the size of the font, we must
5975 load it and try GetTextMetrics. */
5976 W32FontStruct thisinfo
;
5981 if (!x_to_w32_font (XSTRING (XCONS (tem
)->car
)->data
, &lf
))
5985 thisinfo
.bdf
= NULL
;
5986 thisinfo
.hfont
= CreateFontIndirect (&lf
);
5987 if (thisinfo
.hfont
== NULL
)
5990 hdc
= GetDC (dpyinfo
->root_window
);
5991 oldobj
= SelectObject (hdc
, thisinfo
.hfont
);
5992 if (GetTextMetrics (hdc
, &thisinfo
.tm
))
5993 XCONS (tem
)->cdr
= make_number (FONT_WIDTH (&thisinfo
));
5995 XCONS (tem
)->cdr
= make_number (0);
5996 SelectObject (hdc
, oldobj
);
5997 ReleaseDC (dpyinfo
->root_window
, hdc
);
5998 DeleteObject(thisinfo
.hfont
);
6001 found_size
= XINT (XCONS (tem
)->cdr
);
6002 if (found_size
== size
)
6004 newlist
= Fcons (XCONS (tem
)->car
, newlist
);
6006 if (n_fonts
>= maxnames
)
6009 /* keep track of the closest matching size in case
6010 no exact match is found. */
6011 else if (found_size
> 0)
6013 if (NILP (second_best
))
6016 else if (found_size
< size
)
6018 if (XINT (XCONS (second_best
)->cdr
) > size
6019 || XINT (XCONS (second_best
)->cdr
) < found_size
)
6024 if (XINT (XCONS (second_best
)->cdr
) > size
6025 && XINT (XCONS (second_best
)->cdr
) >
6032 if (!NILP (newlist
))
6034 else if (!NILP (second_best
))
6036 newlist
= Fcons (XCONS (second_best
)->car
, Qnil
);
6041 /* Include any bdf fonts. */
6042 if (n_fonts
< maxnames
)
6044 Lisp_Object combined
[2];
6045 combined
[0] = w32_list_bdf_fonts (pattern
, maxnames
- n_fonts
);
6046 combined
[1] = newlist
;
6047 newlist
= Fnconc(2, combined
);
6050 /* If we can't find a font that matches, check if Windows would be
6051 able to synthesize it from a different style. */
6052 if (NILP (newlist
) && !NILP (Vw32_enable_italics
))
6053 newlist
= w32_list_synthesized_fonts (f
, pattern
, size
, maxnames
);
6059 w32_list_synthesized_fonts (f
, pattern
, size
, max_names
)
6061 Lisp_Object pattern
;
6066 char *full_pattn
, *new_pattn
, foundary
[50], family
[50], *pattn_part2
;
6067 char style
[20], slant
;
6068 Lisp_Object matches
, match
, tem
, synthed_matches
= Qnil
;
6070 full_pattn
= XSTRING (pattern
)->data
;
6072 pattn_part2
= alloca (XSTRING (pattern
)->size
);
6073 /* Allow some space for wildcard expansion. */
6074 new_pattn
= alloca (XSTRING (pattern
)->size
+ 100);
6076 fields
= sscanf (full_pattn
, "-%49[^-]-%49[^-]-%19[^-]-%c-%s",
6077 foundary
, family
, style
, &slant
, pattn_part2
);
6078 if (fields
== EOF
|| fields
< 5)
6081 /* If the style and slant are wildcards already there is no point
6082 checking again (and we don't want to keep recursing). */
6083 if (*style
== '*' && slant
== '*')
6086 sprintf (new_pattn
, "-%s-%s-*-*-%s", foundary
, family
, pattn_part2
);
6088 matches
= w32_list_fonts (f
, build_string (new_pattn
), size
, max_names
);
6090 for ( ; CONSP (matches
); matches
= XCONS (matches
)->cdr
)
6092 tem
= XCONS (matches
)->car
;
6096 full_pattn
= XSTRING (tem
)->data
;
6097 fields
= sscanf (full_pattn
, "-%49[^-]-%49[^-]-%*[^-]-%*c-%s",
6098 foundary
, family
, pattn_part2
);
6099 if (fields
== EOF
|| fields
< 3)
6102 sprintf (new_pattn
, "-%s-%s-%s-%c-%s", foundary
, family
, style
,
6103 slant
, pattn_part2
);
6105 synthed_matches
= Fcons (build_string (new_pattn
),
6109 return synthed_matches
;
6113 /* Return a pointer to struct font_info of font FONT_IDX of frame F. */
6115 w32_get_font_info (f
, font_idx
)
6119 return (FRAME_W32_FONT_TABLE (f
) + font_idx
);
6124 w32_query_font (struct frame
*f
, char *fontname
)
6127 struct font_info
*pfi
;
6129 pfi
= FRAME_W32_FONT_TABLE (f
);
6131 for (i
= 0; i
< one_w32_display_info
.n_fonts
;i
++, pfi
++)
6133 if (strcmp(pfi
->name
, fontname
) == 0) return pfi
;
6139 /* Find a CCL program for a font specified by FONTP, and set the member
6140 `encoder' of the structure. */
6143 w32_find_ccl_program (fontp
)
6144 struct font_info
*fontp
;
6146 extern Lisp_Object Vfont_ccl_encoder_alist
, Vccl_program_table
;
6147 extern Lisp_Object Qccl_program_idx
;
6148 extern Lisp_Object
resolve_symbol_ccl_program ();
6149 Lisp_Object list
, elt
, ccl_prog
, ccl_id
;
6151 for (list
= Vfont_ccl_encoder_alist
; CONSP (list
); list
= XCONS (list
)->cdr
)
6153 elt
= XCONS (list
)->car
;
6155 && STRINGP (XCONS (elt
)->car
)
6156 && (fast_c_string_match_ignore_case (XCONS (elt
)->car
, fontp
->name
)
6159 if (SYMBOLP (XCONS (elt
)->cdr
) &&
6160 (!NILP (ccl_id
= Fget (XCONS (elt
)->cdr
, Qccl_program_idx
))))
6162 ccl_prog
= XVECTOR (Vccl_program_table
)->contents
[XUINT (ccl_id
)];
6163 if (!CONSP (ccl_prog
)) continue;
6164 ccl_prog
= XCONS (ccl_prog
)->cdr
;
6168 ccl_prog
= XCONS (elt
)->cdr
;
6169 if (!VECTORP (ccl_prog
)) continue;
6173 = (struct ccl_program
*) xmalloc (sizeof (struct ccl_program
));
6174 setup_ccl_program (fontp
->font_encoder
,
6175 resolve_symbol_ccl_program (ccl_prog
));
6183 #include "x-list-font.c"
6185 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 4, 0,
6186 "Return a list of the names of available fonts matching PATTERN.\n\
6187 If optional arguments FACE and FRAME are specified, return only fonts\n\
6188 the same size as FACE on FRAME.\n\
6190 PATTERN is a string, perhaps with wildcard characters;\n\
6191 the * character matches any substring, and\n\
6192 the ? character matches any single character.\n\
6193 PATTERN is case-insensitive.\n\
6194 FACE is a face name--a symbol.\n\
6196 The return value is a list of strings, suitable as arguments to\n\
6199 Fonts Emacs can't use (i.e. proportional fonts) may or may not be excluded\n\
6200 even if they match PATTERN and FACE.\n\
6202 The optional fourth argument MAXIMUM sets a limit on how many\n\
6203 fonts to match. The first MAXIMUM fonts are reported.")
6204 (pattern
, face
, frame
, maximum
)
6205 Lisp_Object pattern
, face
, frame
, maximum
;
6210 XFontStruct
*size_ref
;
6211 Lisp_Object namelist
;
6216 CHECK_STRING (pattern
, 0);
6218 CHECK_SYMBOL (face
, 1);
6220 f
= check_x_frame (frame
);
6222 /* Determine the width standard for comparison with the fonts we find. */
6230 /* Don't die if we get called with a terminal frame. */
6231 if (! FRAME_W32_P (f
))
6232 error ("non-w32 frame used in `x-list-fonts'");
6234 face_id
= face_name_id_number (f
, face
);
6236 if (face_id
< 0 || face_id
>= FRAME_N_PARAM_FACES (f
)
6237 || FRAME_PARAM_FACES (f
) [face_id
] == 0)
6238 size_ref
= f
->output_data
.w32
->font
;
6241 size_ref
= FRAME_PARAM_FACES (f
) [face_id
]->font
;
6242 if (size_ref
== (XFontStruct
*) (~0))
6243 size_ref
= f
->output_data
.w32
->font
;
6247 /* See if we cached the result for this particular query. */
6248 list
= Fassoc (pattern
,
6249 XCONS (FRAME_W32_DISPLAY_INFO (f
)->name_list_element
)->cdr
);
6251 /* We have info in the cache for this PATTERN. */
6254 Lisp_Object tem
, newlist
;
6256 /* We have info about this pattern. */
6257 list
= XCONS (list
)->cdr
;
6264 /* Filter the cached info and return just the fonts that match FACE. */
6266 for (tem
= list
; CONSP (tem
); tem
= XCONS (tem
)->cdr
)
6268 struct font_info
*fontinf
;
6269 XFontStruct
*thisinfo
= NULL
;
6271 fontinf
= w32_load_font (f
, XSTRING (XCONS (tem
)->car
)->data
, 0);
6273 thisinfo
= (XFontStruct
*)fontinf
->font
;
6274 if (thisinfo
&& same_size_fonts (thisinfo
, size_ref
))
6275 newlist
= Fcons (XCONS (tem
)->car
, newlist
);
6277 w32_unload_font (FRAME_W32_DISPLAY_INFO (f
), thisinfo
);
6288 ef
.pattern
= &pattern
;
6291 x_to_w32_font (STRINGP (pattern
) ? XSTRING (pattern
)->data
: NULL
, &ef
.logfont
);
6294 ef
.hdc
= GetDC (FRAME_W32_WINDOW (f
));
6296 EnumFontFamilies (ef
.hdc
, NULL
, (FONTENUMPROC
) enum_font_cb1
, (LPARAM
)&ef
);
6298 ReleaseDC (FRAME_W32_WINDOW (f
), ef
.hdc
);
6308 /* Make a list of all the fonts we got back.
6309 Store that in the font cache for the display. */
6310 XCONS (FRAME_W32_DISPLAY_INFO (f
)->name_list_element
)->cdr
6311 = Fcons (Fcons (pattern
, namelist
),
6312 XCONS (FRAME_W32_DISPLAY_INFO (f
)->name_list_element
)->cdr
);
6314 /* Make a list of the fonts that have the right width. */
6317 for (i
= 0; i
< ef
.numFonts
; i
++)
6325 struct font_info
*fontinf
;
6326 XFontStruct
*thisinfo
= NULL
;
6329 fontinf
= w32_load_font (f
, XSTRING (Fcar (cur
))->data
, 0);
6331 thisinfo
= (XFontStruct
*)fontinf
->font
;
6333 keeper
= thisinfo
&& same_size_fonts (thisinfo
, size_ref
);
6335 w32_unload_font (FRAME_W32_DISPLAY_INFO (f
), thisinfo
);
6340 list
= Fcons (build_string (XSTRING (Fcar (cur
))->data
), list
);
6344 list
= Fnreverse (list
);
6351 DEFUN ("w32-find-bdf-fonts", Fw32_find_bdf_fonts
, Sw32_find_bdf_fonts
,
6353 "Return a list of BDF fonts in DIR, suitable for appending to\n\
6354 w32-bdf-filename-alist. Fonts which do not contain an xfld description\n\
6355 will not be included in the list. DIR may be a list of directories.")
6357 Lisp_Object directory
;
6359 Lisp_Object list
= Qnil
;
6360 struct gcpro gcpro1
, gcpro2
;
6362 if (!CONSP (directory
))
6363 return w32_find_bdf_fonts_in_dir (directory
);
6365 for ( ; CONSP (directory
); directory
= XCONS (directory
)->cdr
)
6367 Lisp_Object pair
[2];
6370 GCPRO2 (directory
, list
);
6371 pair
[1] = w32_find_bdf_fonts_in_dir( XCONS (directory
)->car
);
6372 list
= Fnconc( 2, pair
);
6378 /* Find BDF files in a specified directory. (use GCPRO when calling,
6379 as this calls lisp to get a directory listing). */
6380 Lisp_Object
w32_find_bdf_fonts_in_dir( Lisp_Object directory
)
6382 Lisp_Object filelist
, list
= Qnil
;
6385 if (!STRINGP(directory
))
6388 filelist
= Fdirectory_files (directory
, Qt
,
6389 build_string (".*\\.[bB][dD][fF]"), Qt
);
6391 for ( ; CONSP(filelist
); filelist
= XCONS (filelist
)->cdr
)
6393 Lisp_Object filename
= XCONS (filelist
)->car
;
6394 if (w32_BDF_to_x_font (XSTRING (filename
)->data
, fontname
, 100))
6395 store_in_alist (&list
, build_string (fontname
), filename
);
6401 DEFUN ("x-color-defined-p", Fx_color_defined_p
, Sx_color_defined_p
, 1, 2, 0,
6402 "Return non-nil if color COLOR is supported on frame FRAME.\n\
6403 If FRAME is omitted or nil, use the selected frame.")
6405 Lisp_Object color
, frame
;
6408 FRAME_PTR f
= check_x_frame (frame
);
6410 CHECK_STRING (color
, 1);
6412 if (defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
6418 DEFUN ("x-color-values", Fx_color_values
, Sx_color_values
, 1, 2, 0,
6419 "Return a description of the color named COLOR on frame FRAME.\n\
6420 The value is a list of integer RGB values--(RED GREEN BLUE).\n\
6421 These values appear to range from 0 to 65280 or 65535, depending\n\
6422 on the system; white is (65280 65280 65280) or (65535 65535 65535).\n\
6423 If FRAME is omitted or nil, use the selected frame.")
6425 Lisp_Object color
, frame
;
6428 FRAME_PTR f
= check_x_frame (frame
);
6430 CHECK_STRING (color
, 1);
6432 if (defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
6436 rgb
[0] = make_number ((GetRValue (foo
) << 8) | GetRValue (foo
));
6437 rgb
[1] = make_number ((GetGValue (foo
) << 8) | GetGValue (foo
));
6438 rgb
[2] = make_number ((GetBValue (foo
) << 8) | GetBValue (foo
));
6439 return Flist (3, rgb
);
6445 DEFUN ("x-display-color-p", Fx_display_color_p
, Sx_display_color_p
, 0, 1, 0,
6446 "Return t if the X display supports color.\n\
6447 The optional argument DISPLAY specifies which display to ask about.\n\
6448 DISPLAY should be either a frame or a display name (a string).\n\
6449 If omitted or nil, that stands for the selected frame's display.")
6451 Lisp_Object display
;
6453 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6455 if ((dpyinfo
->n_planes
* dpyinfo
->n_cbits
) <= 2)
6461 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
, Sx_display_grayscale_p
,
6463 "Return t if the X display supports shades of gray.\n\
6464 Note that color displays do support shades of gray.\n\
6465 The optional argument DISPLAY specifies which display to ask about.\n\
6466 DISPLAY should be either a frame or a display name (a string).\n\
6467 If omitted or nil, that stands for the selected frame's display.")
6469 Lisp_Object display
;
6471 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6473 if ((dpyinfo
->n_planes
* dpyinfo
->n_cbits
) <= 1)
6479 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
6481 "Returns the width in pixels of the X display DISPLAY.\n\
6482 The optional argument DISPLAY specifies which display to ask about.\n\
6483 DISPLAY should be either a frame or a display name (a string).\n\
6484 If omitted or nil, that stands for the selected frame's display.")
6486 Lisp_Object display
;
6488 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6490 return make_number (dpyinfo
->width
);
6493 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
6494 Sx_display_pixel_height
, 0, 1, 0,
6495 "Returns the height in pixels of the X display DISPLAY.\n\
6496 The optional argument DISPLAY specifies which display to ask about.\n\
6497 DISPLAY should be either a frame or a display name (a string).\n\
6498 If omitted or nil, that stands for the selected frame's display.")
6500 Lisp_Object display
;
6502 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6504 return make_number (dpyinfo
->height
);
6507 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
6509 "Returns the number of bitplanes of the display DISPLAY.\n\
6510 The optional argument DISPLAY specifies which display to ask about.\n\
6511 DISPLAY should be either a frame or a display name (a string).\n\
6512 If omitted or nil, that stands for the selected frame's display.")
6514 Lisp_Object display
;
6516 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6518 return make_number (dpyinfo
->n_planes
* dpyinfo
->n_cbits
);
6521 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
6523 "Returns the number of color cells of the display DISPLAY.\n\
6524 The optional argument DISPLAY specifies which display to ask about.\n\
6525 DISPLAY should be either a frame or a display name (a string).\n\
6526 If omitted or nil, that stands for the selected frame's display.")
6528 Lisp_Object display
;
6530 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6534 hdc
= GetDC (dpyinfo
->root_window
);
6535 if (dpyinfo
->has_palette
)
6536 cap
= GetDeviceCaps (hdc
,SIZEPALETTE
);
6538 cap
= GetDeviceCaps (hdc
,NUMCOLORS
);
6540 ReleaseDC (dpyinfo
->root_window
, hdc
);
6542 return make_number (cap
);
6545 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
6546 Sx_server_max_request_size
,
6548 "Returns the maximum request size of the server of display DISPLAY.\n\
6549 The optional argument DISPLAY specifies which display to ask about.\n\
6550 DISPLAY should be either a frame or a display name (a string).\n\
6551 If omitted or nil, that stands for the selected frame's display.")
6553 Lisp_Object display
;
6555 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6557 return make_number (1);
6560 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
6561 "Returns the vendor ID string of the W32 system (Microsoft).\n\
6562 The optional argument DISPLAY specifies which display to ask about.\n\
6563 DISPLAY should be either a frame or a display name (a string).\n\
6564 If omitted or nil, that stands for the selected frame's display.")
6566 Lisp_Object display
;
6568 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6569 char *vendor
= "Microsoft Corp.";
6571 if (! vendor
) vendor
= "";
6572 return build_string (vendor
);
6575 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
6576 "Returns the version numbers of the server of display DISPLAY.\n\
6577 The value is a list of three integers: the major and minor\n\
6578 version numbers, and the vendor-specific release\n\
6579 number. See also the function `x-server-vendor'.\n\n\
6580 The optional argument DISPLAY specifies which display to ask about.\n\
6581 DISPLAY should be either a frame or a display name (a string).\n\
6582 If omitted or nil, that stands for the selected frame's display.")
6584 Lisp_Object display
;
6586 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6588 return Fcons (make_number (w32_major_version
),
6589 Fcons (make_number (w32_minor_version
), Qnil
));
6592 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
6593 "Returns the number of screens on the server of display DISPLAY.\n\
6594 The optional argument DISPLAY specifies which display to ask about.\n\
6595 DISPLAY should be either a frame or a display name (a string).\n\
6596 If omitted or nil, that stands for the selected frame's display.")
6598 Lisp_Object display
;
6600 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6602 return make_number (1);
6605 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
6606 "Returns the height in millimeters of the X display DISPLAY.\n\
6607 The optional argument DISPLAY specifies which display to ask about.\n\
6608 DISPLAY should be either a frame or a display name (a string).\n\
6609 If omitted or nil, that stands for the selected frame's display.")
6611 Lisp_Object display
;
6613 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6617 hdc
= GetDC (dpyinfo
->root_window
);
6619 cap
= GetDeviceCaps (hdc
, VERTSIZE
);
6621 ReleaseDC (dpyinfo
->root_window
, hdc
);
6623 return make_number (cap
);
6626 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
6627 "Returns the width in millimeters of the X display DISPLAY.\n\
6628 The optional argument DISPLAY specifies which display to ask about.\n\
6629 DISPLAY should be either a frame or a display name (a string).\n\
6630 If omitted or nil, that stands for the selected frame's display.")
6632 Lisp_Object display
;
6634 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6639 hdc
= GetDC (dpyinfo
->root_window
);
6641 cap
= GetDeviceCaps (hdc
, HORZSIZE
);
6643 ReleaseDC (dpyinfo
->root_window
, hdc
);
6645 return make_number (cap
);
6648 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
6649 Sx_display_backing_store
, 0, 1, 0,
6650 "Returns an indication of whether display DISPLAY does backing store.\n\
6651 The value may be `always', `when-mapped', or `not-useful'.\n\
6652 The optional argument DISPLAY specifies which display to ask about.\n\
6653 DISPLAY should be either a frame or a display name (a string).\n\
6654 If omitted or nil, that stands for the selected frame's display.")
6656 Lisp_Object display
;
6658 return intern ("not-useful");
6661 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
6662 Sx_display_visual_class
, 0, 1, 0,
6663 "Returns the visual class of the display DISPLAY.\n\
6664 The value is one of the symbols `static-gray', `gray-scale',\n\
6665 `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
6666 The optional argument DISPLAY specifies which display to ask about.\n\
6667 DISPLAY should be either a frame or a display name (a string).\n\
6668 If omitted or nil, that stands for the selected frame's display.")
6670 Lisp_Object display
;
6672 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6675 switch (dpyinfo
->visual
->class)
6677 case StaticGray
: return (intern ("static-gray"));
6678 case GrayScale
: return (intern ("gray-scale"));
6679 case StaticColor
: return (intern ("static-color"));
6680 case PseudoColor
: return (intern ("pseudo-color"));
6681 case TrueColor
: return (intern ("true-color"));
6682 case DirectColor
: return (intern ("direct-color"));
6684 error ("Display has an unknown visual class");
6688 error ("Display has an unknown visual class");
6691 DEFUN ("x-display-save-under", Fx_display_save_under
,
6692 Sx_display_save_under
, 0, 1, 0,
6693 "Returns t if the display DISPLAY supports the save-under feature.\n\
6694 The optional argument DISPLAY specifies which display to ask about.\n\
6695 DISPLAY should be either a frame or a display name (a string).\n\
6696 If omitted or nil, that stands for the selected frame's display.")
6698 Lisp_Object display
;
6700 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6707 register struct frame
*f
;
6709 return PIXEL_WIDTH (f
);
6714 register struct frame
*f
;
6716 return PIXEL_HEIGHT (f
);
6721 register struct frame
*f
;
6723 return FONT_WIDTH (f
->output_data
.w32
->font
);
6728 register struct frame
*f
;
6730 return f
->output_data
.w32
->line_height
;
6734 x_screen_planes (frame
)
6737 return (FRAME_W32_DISPLAY_INFO (XFRAME (frame
))->n_planes
*
6738 FRAME_W32_DISPLAY_INFO (XFRAME (frame
))->n_cbits
);
6741 /* Return the display structure for the display named NAME.
6742 Open a new connection if necessary. */
6744 struct w32_display_info
*
6745 x_display_info_for_name (name
)
6749 struct w32_display_info
*dpyinfo
;
6751 CHECK_STRING (name
, 0);
6753 for (dpyinfo
= &one_w32_display_info
, names
= w32_display_name_list
;
6755 dpyinfo
= dpyinfo
->next
, names
= XCONS (names
)->cdr
)
6758 tem
= Fstring_equal (XCONS (XCONS (names
)->car
)->car
, name
);
6763 /* Use this general default value to start with. */
6764 Vx_resource_name
= Vinvocation_name
;
6766 validate_x_resource_name ();
6768 dpyinfo
= w32_term_init (name
, (unsigned char *)0,
6769 (char *) XSTRING (Vx_resource_name
)->data
);
6772 error ("Cannot connect to server %s", XSTRING (name
)->data
);
6775 XSETFASTINT (Vwindow_system_version
, 3);
6780 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
6781 1, 3, 0, "Open a connection to a server.\n\
6782 DISPLAY is the name of the display to connect to.\n\
6783 Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
6784 If the optional third arg MUST-SUCCEED is non-nil,\n\
6785 terminate Emacs if we can't open the connection.")
6786 (display
, xrm_string
, must_succeed
)
6787 Lisp_Object display
, xrm_string
, must_succeed
;
6789 unsigned int n_planes
;
6790 unsigned char *xrm_option
;
6791 struct w32_display_info
*dpyinfo
;
6793 CHECK_STRING (display
, 0);
6794 if (! NILP (xrm_string
))
6795 CHECK_STRING (xrm_string
, 1);
6797 if (! EQ (Vwindow_system
, intern ("w32")))
6798 error ("Not using Microsoft Windows");
6800 /* Allow color mapping to be defined externally; first look in user's
6801 HOME directory, then in Emacs etc dir for a file called rgb.txt. */
6803 Lisp_Object color_file
;
6804 struct gcpro gcpro1
;
6806 color_file
= build_string("~/rgb.txt");
6808 GCPRO1 (color_file
);
6810 if (NILP (Ffile_readable_p (color_file
)))
6812 Fexpand_file_name (build_string ("rgb.txt"),
6813 Fsymbol_value (intern ("data-directory")));
6815 Vw32_color_map
= Fw32_load_color_file (color_file
);
6819 if (NILP (Vw32_color_map
))
6820 Vw32_color_map
= Fw32_default_color_map ();
6822 if (! NILP (xrm_string
))
6823 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
6825 xrm_option
= (unsigned char *) 0;
6827 /* Use this general default value to start with. */
6828 /* First remove .exe suffix from invocation-name - it looks ugly. */
6830 char basename
[ MAX_PATH
], *str
;
6832 strcpy (basename
, XSTRING (Vinvocation_name
)->data
);
6833 str
= strrchr (basename
, '.');
6835 Vinvocation_name
= build_string (basename
);
6837 Vx_resource_name
= Vinvocation_name
;
6839 validate_x_resource_name ();
6841 /* This is what opens the connection and sets x_current_display.
6842 This also initializes many symbols, such as those used for input. */
6843 dpyinfo
= w32_term_init (display
, xrm_option
,
6844 (char *) XSTRING (Vx_resource_name
)->data
);
6848 if (!NILP (must_succeed
))
6849 fatal ("Cannot connect to server %s.\n",
6850 XSTRING (display
)->data
);
6852 error ("Cannot connect to server %s", XSTRING (display
)->data
);
6857 XSETFASTINT (Vwindow_system_version
, 3);
6861 DEFUN ("x-close-connection", Fx_close_connection
,
6862 Sx_close_connection
, 1, 1, 0,
6863 "Close the connection to DISPLAY's server.\n\
6864 For DISPLAY, specify either a frame or a display name (a string).\n\
6865 If DISPLAY is nil, that stands for the selected frame's display.")
6867 Lisp_Object display
;
6869 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6870 struct w32_display_info
*tail
;
6873 if (dpyinfo
->reference_count
> 0)
6874 error ("Display still has frames on it");
6877 /* Free the fonts in the font table. */
6878 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
6880 if (dpyinfo
->font_table
[i
].name
)
6881 free (dpyinfo
->font_table
[i
].name
);
6882 /* Don't free the full_name string;
6883 it is always shared with something else. */
6884 w32_unload_font (dpyinfo
, dpyinfo
->font_table
[i
].font
);
6886 x_destroy_all_bitmaps (dpyinfo
);
6888 x_delete_display (dpyinfo
);
6894 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
6895 "Return the list of display names that Emacs has connections to.")
6898 Lisp_Object tail
, result
;
6901 for (tail
= w32_display_name_list
; ! NILP (tail
); tail
= XCONS (tail
)->cdr
)
6902 result
= Fcons (XCONS (XCONS (tail
)->car
)->car
, result
);
6907 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
6908 "If ON is non-nil, report errors as soon as the erring request is made.\n\
6909 If ON is nil, allow buffering of requests.\n\
6910 This is a noop on W32 systems.\n\
6911 The optional second argument DISPLAY specifies which display to act on.\n\
6912 DISPLAY should be either a frame or a display name (a string).\n\
6913 If DISPLAY is omitted or nil, that stands for the selected frame's display.")
6915 Lisp_Object display
, on
;
6917 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6923 /* These are the w32 specialized functions */
6925 DEFUN ("w32-select-font", Fw32_select_font
, Sw32_select_font
, 0, 1, 0,
6926 "This will display the W32 font dialog and return an X font string corresponding to the selection.")
6930 FRAME_PTR f
= check_x_frame (frame
);
6938 bzero (&cf
, sizeof (cf
));
6939 bzero (&lf
, sizeof (lf
));
6941 cf
.lStructSize
= sizeof (cf
);
6942 cf
.hwndOwner
= FRAME_W32_WINDOW (f
);
6943 cf
.Flags
= CF_FIXEDPITCHONLY
| CF_FORCEFONTEXIST
| CF_SCREENFONTS
;
6946 /* Initialize as much of the font details as we can from the current
6948 hdc
= GetDC (FRAME_W32_WINDOW (f
));
6949 oldobj
= SelectObject (hdc
, FRAME_FONT (f
)->hfont
);
6950 GetTextFace (hdc
, LF_FACESIZE
, lf
.lfFaceName
);
6951 if (GetTextMetrics (hdc
, &tm
))
6953 lf
.lfHeight
= tm
.tmInternalLeading
- tm
.tmHeight
;
6954 lf
.lfWeight
= tm
.tmWeight
;
6955 lf
.lfItalic
= tm
.tmItalic
;
6956 lf
.lfUnderline
= tm
.tmUnderlined
;
6957 lf
.lfStrikeOut
= tm
.tmStruckOut
;
6958 lf
.lfPitchAndFamily
= tm
.tmPitchAndFamily
;
6959 lf
.lfCharSet
= tm
.tmCharSet
;
6960 cf
.Flags
|= CF_INITTOLOGFONTSTRUCT
;
6962 SelectObject (hdc
, oldobj
);
6963 ReleaseDC (FRAME_W32_WINDOW(f
), hdc
);
6965 if (!ChooseFont (&cf
) || !w32_to_x_font (&lf
, buf
, 100))
6968 return build_string (buf
);
6971 DEFUN ("w32-send-sys-command", Fw32_send_sys_command
, Sw32_send_sys_command
, 1, 2, 0,
6972 "Send frame a Windows WM_SYSCOMMAND message of type COMMAND.\n\
6973 Some useful values for command are 0xf030 to maximise frame (0xf020\n\
6974 to minimize), 0xf120 to restore frame to original size, and 0xf100\n\
6975 to activate the menubar for keyboard access. 0xf140 activates the\n\
6976 screen saver if defined.\n\
6978 If optional parameter FRAME is not specified, use selected frame.")
6980 Lisp_Object command
, frame
;
6983 FRAME_PTR f
= check_x_frame (frame
);
6985 CHECK_NUMBER (command
, 0);
6987 SendMessage (FRAME_W32_WINDOW (f
), WM_SYSCOMMAND
, XINT (command
), 0);
6992 DEFUN ("w32-shell-execute", Fw32_shell_execute
, Sw32_shell_execute
, 2, 4, 0,
6993 "Get Windows to perform OPERATION on DOCUMENT.\n\
6994 This is a wrapper around the ShellExecute system function, which\n\
6995 invokes the application registered to handle OPERATION for DOCUMENT.\n\
6996 OPERATION is typically \"open\", \"print\" or \"explore\", and DOCUMENT\n\
6997 is typically the name of a document file or URL, but can also be a\n\
6998 program executable to run or a directory to open in the Windows Explorer.\n\
7000 If DOCUMENT is a program executable, PARAMETERS can be a list of command\n\
7001 line parameters, but otherwise should be nil.\n\
7003 SHOW-FLAG can be used to control whether the invoked application is hidden\n\
7004 or minimized. If SHOw-FLAG is nil, the application is displayed normally,\n\
7005 otherwise it is an integer representing a ShowWindow flag:\n\
7008 1 - start normally\n\
7009 3 - start maximized\n\
7010 6 - start minimized")
7011 (operation
, document
, parameters
, show_flag
)
7012 Lisp_Object operation
, document
, parameters
, show_flag
;
7014 Lisp_Object current_dir
;
7016 CHECK_STRING (operation
, 0);
7017 CHECK_STRING (document
, 0);
7019 /* Encode filename and current directory. */
7020 current_dir
= ENCODE_FILE (current_buffer
->directory
);
7021 document
= ENCODE_FILE (document
);
7022 if ((int) ShellExecute (NULL
,
7023 XSTRING (operation
)->data
,
7024 XSTRING (document
)->data
,
7025 (STRINGP (parameters
) ?
7026 XSTRING (parameters
)->data
: NULL
),
7027 XSTRING (current_dir
)->data
,
7028 (INTEGERP (show_flag
) ?
7029 XINT (show_flag
) : SW_SHOWDEFAULT
))
7032 error ("ShellExecute failed");
7035 /* Lookup virtual keycode from string representing the name of a
7036 non-ascii keystroke into the corresponding virtual key, using
7037 lispy_function_keys. */
7039 lookup_vk_code (char *key
)
7043 for (i
= 0; i
< 256; i
++)
7044 if (lispy_function_keys
[i
] != 0
7045 && strcmp (lispy_function_keys
[i
], key
) == 0)
7051 /* Convert a one-element vector style key sequence to a hot key
7054 w32_parse_hot_key (key
)
7057 /* Copied from Fdefine_key and store_in_keymap. */
7058 register Lisp_Object c
;
7062 struct gcpro gcpro1
;
7064 CHECK_VECTOR (key
, 0);
7066 if (XFASTINT (Flength (key
)) != 1)
7071 c
= Faref (key
, make_number (0));
7073 if (CONSP (c
) && lucid_event_type_list_p (c
))
7074 c
= Fevent_convert_list (c
);
7078 if (! INTEGERP (c
) && ! SYMBOLP (c
))
7079 error ("Key definition is invalid");
7081 /* Work out the base key and the modifiers. */
7084 c
= parse_modifiers (c
);
7085 lisp_modifiers
= Fcar (Fcdr (c
));
7089 vk_code
= lookup_vk_code (XSYMBOL (c
)->name
->data
);
7091 else if (INTEGERP (c
))
7093 lisp_modifiers
= XINT (c
) & ~CHARACTERBITS
;
7094 /* Many ascii characters are their own virtual key code. */
7095 vk_code
= XINT (c
) & CHARACTERBITS
;
7098 if (vk_code
< 0 || vk_code
> 255)
7101 if ((lisp_modifiers
& meta_modifier
) != 0
7102 && !NILP (Vw32_alt_is_meta
))
7103 lisp_modifiers
|= alt_modifier
;
7105 /* Convert lisp modifiers to Windows hot-key form. */
7106 w32_modifiers
= (lisp_modifiers
& hyper_modifier
) ? MOD_WIN
: 0;
7107 w32_modifiers
|= (lisp_modifiers
& alt_modifier
) ? MOD_ALT
: 0;
7108 w32_modifiers
|= (lisp_modifiers
& ctrl_modifier
) ? MOD_CONTROL
: 0;
7109 w32_modifiers
|= (lisp_modifiers
& shift_modifier
) ? MOD_SHIFT
: 0;
7111 return HOTKEY (vk_code
, w32_modifiers
);
7114 DEFUN ("w32-register-hot-key", Fw32_register_hot_key
, Sw32_register_hot_key
, 1, 1, 0,
7115 "Register KEY as a hot-key combination.\n\
7116 Certain key combinations like Alt-Tab are reserved for system use on\n\
7117 Windows, and therefore are normally intercepted by the system. However,\n\
7118 most of these key combinations can be received by registering them as\n\
7119 hot-keys, overriding their special meaning.\n\
7121 KEY must be a one element key definition in vector form that would be\n\
7122 acceptable to `define-key' (e.g. [A-tab] for Alt-Tab). The meta\n\
7123 modifier is interpreted as Alt if `w32-alt-is-meta' is t, and hyper\n\
7124 is always interpreted as the Windows modifier keys.\n\
7126 The return value is the hotkey-id if registered, otherwise nil.")
7130 key
= w32_parse_hot_key (key
);
7132 if (NILP (Fmemq (key
, w32_grabbed_keys
)))
7134 /* Reuse an empty slot if possible. */
7135 Lisp_Object item
= Fmemq (Qnil
, w32_grabbed_keys
);
7137 /* Safe to add new key to list, even if we have focus. */
7139 w32_grabbed_keys
= Fcons (key
, w32_grabbed_keys
);
7143 /* Notify input thread about new hot-key definition, so that it
7144 takes effect without needing to switch focus. */
7145 PostThreadMessage (dwWindowsThreadId
, WM_EMACS_REGISTER_HOT_KEY
,
7152 DEFUN ("w32-unregister-hot-key", Fw32_unregister_hot_key
, Sw32_unregister_hot_key
, 1, 1, 0,
7153 "Unregister HOTKEY as a hot-key combination.")
7159 if (!INTEGERP (key
))
7160 key
= w32_parse_hot_key (key
);
7162 item
= Fmemq (key
, w32_grabbed_keys
);
7166 /* Notify input thread about hot-key definition being removed, so
7167 that it takes effect without needing focus switch. */
7168 if (PostThreadMessage (dwWindowsThreadId
, WM_EMACS_UNREGISTER_HOT_KEY
,
7169 (WPARAM
) XINT (XCAR (item
)), (LPARAM
) item
))
7172 GetMessage (&msg
, NULL
, WM_EMACS_DONE
, WM_EMACS_DONE
);
7179 DEFUN ("w32-registered-hot-keys", Fw32_registered_hot_keys
, Sw32_registered_hot_keys
, 0, 0, 0,
7180 "Return list of registered hot-key IDs.")
7183 return Fcopy_sequence (w32_grabbed_keys
);
7186 DEFUN ("w32-reconstruct-hot-key", Fw32_reconstruct_hot_key
, Sw32_reconstruct_hot_key
, 1, 1, 0,
7187 "Convert hot-key ID to a lisp key combination.")
7189 Lisp_Object hotkeyid
;
7191 int vk_code
, w32_modifiers
;
7194 CHECK_NUMBER (hotkeyid
, 0);
7196 vk_code
= HOTKEY_VK_CODE (hotkeyid
);
7197 w32_modifiers
= HOTKEY_MODIFIERS (hotkeyid
);
7199 if (lispy_function_keys
[vk_code
])
7200 key
= intern (lispy_function_keys
[vk_code
]);
7202 key
= make_number (vk_code
);
7204 key
= Fcons (key
, Qnil
);
7205 if (w32_modifiers
& MOD_SHIFT
)
7206 key
= Fcons (Qshift
, key
);
7207 if (w32_modifiers
& MOD_CONTROL
)
7208 key
= Fcons (Qctrl
, key
);
7209 if (w32_modifiers
& MOD_ALT
)
7210 key
= Fcons (NILP (Vw32_alt_is_meta
) ? Qalt
: Qmeta
, key
);
7211 if (w32_modifiers
& MOD_WIN
)
7212 key
= Fcons (Qhyper
, key
);
7217 DEFUN ("w32-toggle-lock-key", Fw32_toggle_lock_key
, Sw32_toggle_lock_key
, 1, 2, 0,
7218 "Toggle the state of the lock key KEY.\n\
7219 KEY can be `capslock', `kp-numlock', or `scroll'.\n\
7220 If the optional parameter NEW-STATE is a number, then the state of KEY\n\
7221 is set to off if the low bit of NEW-STATE is zero, otherwise on.")
7223 Lisp_Object key
, new_state
;
7228 if (EQ (key
, intern ("capslock")))
7229 vk_code
= VK_CAPITAL
;
7230 else if (EQ (key
, intern ("kp-numlock")))
7231 vk_code
= VK_NUMLOCK
;
7232 else if (EQ (key
, intern ("scroll")))
7233 vk_code
= VK_SCROLL
;
7237 if (!dwWindowsThreadId
)
7238 return make_number (w32_console_toggle_lock_key (vk_code
, new_state
));
7240 if (PostThreadMessage (dwWindowsThreadId
, WM_EMACS_TOGGLE_LOCK_KEY
,
7241 (WPARAM
) vk_code
, (LPARAM
) new_state
))
7244 GetMessage (&msg
, NULL
, WM_EMACS_DONE
, WM_EMACS_DONE
);
7245 return make_number (msg
.wParam
);
7252 /* This is zero if not using MS-Windows. */
7255 /* The section below is built by the lisp expression at the top of the file,
7256 just above where these variables are declared. */
7257 /*&&& init symbols here &&&*/
7258 Qauto_raise
= intern ("auto-raise");
7259 staticpro (&Qauto_raise
);
7260 Qauto_lower
= intern ("auto-lower");
7261 staticpro (&Qauto_lower
);
7262 Qbackground_color
= intern ("background-color");
7263 staticpro (&Qbackground_color
);
7264 Qbar
= intern ("bar");
7266 Qborder_color
= intern ("border-color");
7267 staticpro (&Qborder_color
);
7268 Qborder_width
= intern ("border-width");
7269 staticpro (&Qborder_width
);
7270 Qbox
= intern ("box");
7272 Qcursor_color
= intern ("cursor-color");
7273 staticpro (&Qcursor_color
);
7274 Qcursor_type
= intern ("cursor-type");
7275 staticpro (&Qcursor_type
);
7276 Qforeground_color
= intern ("foreground-color");
7277 staticpro (&Qforeground_color
);
7278 Qgeometry
= intern ("geometry");
7279 staticpro (&Qgeometry
);
7280 Qicon_left
= intern ("icon-left");
7281 staticpro (&Qicon_left
);
7282 Qicon_top
= intern ("icon-top");
7283 staticpro (&Qicon_top
);
7284 Qicon_type
= intern ("icon-type");
7285 staticpro (&Qicon_type
);
7286 Qicon_name
= intern ("icon-name");
7287 staticpro (&Qicon_name
);
7288 Qinternal_border_width
= intern ("internal-border-width");
7289 staticpro (&Qinternal_border_width
);
7290 Qleft
= intern ("left");
7292 Qright
= intern ("right");
7293 staticpro (&Qright
);
7294 Qmouse_color
= intern ("mouse-color");
7295 staticpro (&Qmouse_color
);
7296 Qnone
= intern ("none");
7298 Qparent_id
= intern ("parent-id");
7299 staticpro (&Qparent_id
);
7300 Qscroll_bar_width
= intern ("scroll-bar-width");
7301 staticpro (&Qscroll_bar_width
);
7302 Qsuppress_icon
= intern ("suppress-icon");
7303 staticpro (&Qsuppress_icon
);
7304 Qtop
= intern ("top");
7306 Qundefined_color
= intern ("undefined-color");
7307 staticpro (&Qundefined_color
);
7308 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
7309 staticpro (&Qvertical_scroll_bars
);
7310 Qvisibility
= intern ("visibility");
7311 staticpro (&Qvisibility
);
7312 Qwindow_id
= intern ("window-id");
7313 staticpro (&Qwindow_id
);
7314 Qx_frame_parameter
= intern ("x-frame-parameter");
7315 staticpro (&Qx_frame_parameter
);
7316 Qx_resource_name
= intern ("x-resource-name");
7317 staticpro (&Qx_resource_name
);
7318 Quser_position
= intern ("user-position");
7319 staticpro (&Quser_position
);
7320 Quser_size
= intern ("user-size");
7321 staticpro (&Quser_size
);
7322 Qdisplay
= intern ("display");
7323 staticpro (&Qdisplay
);
7324 /* This is the end of symbol initialization. */
7326 Qhyper
= intern ("hyper");
7327 staticpro (&Qhyper
);
7328 Qsuper
= intern ("super");
7329 staticpro (&Qsuper
);
7330 Qmeta
= intern ("meta");
7332 Qalt
= intern ("alt");
7334 Qctrl
= intern ("ctrl");
7336 Qcontrol
= intern ("control");
7337 staticpro (&Qcontrol
);
7338 Qshift
= intern ("shift");
7339 staticpro (&Qshift
);
7341 Qface_set_after_frame_default
= intern ("face-set-after-frame-default");
7342 staticpro (&Qface_set_after_frame_default
);
7344 Fput (Qundefined_color
, Qerror_conditions
,
7345 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
7346 Fput (Qundefined_color
, Qerror_message
,
7347 build_string ("Undefined color"));
7349 staticpro (&w32_grabbed_keys
);
7350 w32_grabbed_keys
= Qnil
;
7352 DEFVAR_LISP ("w32-color-map", &Vw32_color_map
,
7353 "An array of color name mappings for windows.");
7354 Vw32_color_map
= Qnil
;
7356 DEFVAR_LISP ("w32-pass-alt-to-system", &Vw32_pass_alt_to_system
,
7357 "Non-nil if alt key presses are passed on to Windows.\n\
7358 When non-nil, for example, alt pressed and released and then space will\n\
7359 open the System menu. When nil, Emacs silently swallows alt key events.");
7360 Vw32_pass_alt_to_system
= Qnil
;
7362 DEFVAR_LISP ("w32-alt-is-meta", &Vw32_alt_is_meta
,
7363 "Non-nil if the alt key is to be considered the same as the meta key.\n\
7364 When nil, Emacs will translate the alt key to the Alt modifier, and not Meta.");
7365 Vw32_alt_is_meta
= Qt
;
7367 DEFVAR_INT ("w32-quit-key", &Vw32_quit_key
,
7368 "If non-zero, the virtual key code for an alternative quit key.");
7369 XSETINT (Vw32_quit_key
, 0);
7371 DEFVAR_LISP ("w32-pass-lwindow-to-system",
7372 &Vw32_pass_lwindow_to_system
,
7373 "Non-nil if the left \"Windows\" key is passed on to Windows.\n\
7374 When non-nil, the Start menu is opened by tapping the key.");
7375 Vw32_pass_lwindow_to_system
= Qt
;
7377 DEFVAR_LISP ("w32-pass-rwindow-to-system",
7378 &Vw32_pass_rwindow_to_system
,
7379 "Non-nil if the right \"Windows\" key is passed on to Windows.\n\
7380 When non-nil, the Start menu is opened by tapping the key.");
7381 Vw32_pass_rwindow_to_system
= Qt
;
7383 DEFVAR_INT ("w32-phantom-key-code",
7384 &Vw32_phantom_key_code
,
7385 "Virtual key code used to generate \"phantom\" key presses.\n\
7386 Value is a number between 0 and 255.\n\
7388 Phantom key presses are generated in order to stop the system from\n\
7389 acting on \"Windows\" key events when `w32-pass-lwindow-to-system' or\n\
7390 `w32-pass-rwindow-to-system' is nil.");
7391 Vw32_phantom_key_code
= VK_SPACE
;
7393 DEFVAR_LISP ("w32-enable-num-lock",
7394 &Vw32_enable_num_lock
,
7395 "Non-nil if Num Lock should act normally.\n\
7396 Set to nil to see Num Lock as the key `kp-numlock'.");
7397 Vw32_enable_num_lock
= Qt
;
7399 DEFVAR_LISP ("w32-enable-caps-lock",
7400 &Vw32_enable_caps_lock
,
7401 "Non-nil if Caps Lock should act normally.\n\
7402 Set to nil to see Caps Lock as the key `capslock'.");
7403 Vw32_enable_caps_lock
= Qt
;
7405 DEFVAR_LISP ("w32-scroll-lock-modifier",
7406 &Vw32_scroll_lock_modifier
,
7407 "Modifier to use for the Scroll Lock on state.\n\
7408 The value can be hyper, super, meta, alt, control or shift for the\n\
7409 respective modifier, or nil to see Scroll Lock as the key `scroll'.\n\
7410 Any other value will cause the key to be ignored.");
7411 Vw32_scroll_lock_modifier
= Qt
;
7413 DEFVAR_LISP ("w32-lwindow-modifier",
7414 &Vw32_lwindow_modifier
,
7415 "Modifier to use for the left \"Windows\" key.\n\
7416 The value can be hyper, super, meta, alt, control or shift for the\n\
7417 respective modifier, or nil to appear as the key `lwindow'.\n\
7418 Any other value will cause the key to be ignored.");
7419 Vw32_lwindow_modifier
= Qnil
;
7421 DEFVAR_LISP ("w32-rwindow-modifier",
7422 &Vw32_rwindow_modifier
,
7423 "Modifier to use for the right \"Windows\" key.\n\
7424 The value can be hyper, super, meta, alt, control or shift for the\n\
7425 respective modifier, or nil to appear as the key `rwindow'.\n\
7426 Any other value will cause the key to be ignored.");
7427 Vw32_rwindow_modifier
= Qnil
;
7429 DEFVAR_LISP ("w32-apps-modifier",
7430 &Vw32_apps_modifier
,
7431 "Modifier to use for the \"Apps\" key.\n\
7432 The value can be hyper, super, meta, alt, control or shift for the\n\
7433 respective modifier, or nil to appear as the key `apps'.\n\
7434 Any other value will cause the key to be ignored.");
7435 Vw32_apps_modifier
= Qnil
;
7437 DEFVAR_LISP ("w32-enable-italics", &Vw32_enable_italics
,
7438 "Non-nil enables selection of artificially italicized fonts.");
7439 Vw32_enable_italics
= Qnil
;
7441 DEFVAR_LISP ("w32-enable-palette", &Vw32_enable_palette
,
7442 "Non-nil enables Windows palette management to map colors exactly.");
7443 Vw32_enable_palette
= Qt
;
7445 DEFVAR_INT ("w32-mouse-button-tolerance",
7446 &Vw32_mouse_button_tolerance
,
7447 "Analogue of double click interval for faking middle mouse events.\n\
7448 The value is the minimum time in milliseconds that must elapse between\n\
7449 left/right button down events before they are considered distinct events.\n\
7450 If both mouse buttons are depressed within this interval, a middle mouse\n\
7451 button down event is generated instead.");
7452 XSETINT (Vw32_mouse_button_tolerance
, GetDoubleClickTime () / 2);
7454 DEFVAR_INT ("w32-mouse-move-interval",
7455 &Vw32_mouse_move_interval
,
7456 "Minimum interval between mouse move events.\n\
7457 The value is the minimum time in milliseconds that must elapse between\n\
7458 successive mouse move (or scroll bar drag) events before they are\n\
7459 reported as lisp events.");
7460 XSETINT (Vw32_mouse_move_interval
, 0);
7462 init_x_parm_symbols ();
7464 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path
,
7465 "List of directories to search for bitmap files for w32.");
7466 Vx_bitmap_file_path
= decode_env_path ((char *) 0, "PATH");
7468 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
7469 "The shape of the pointer when over text.\n\
7470 Changing the value does not affect existing frames\n\
7471 unless you set the mouse color.");
7472 Vx_pointer_shape
= Qnil
;
7474 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
7475 "The name Emacs uses to look up resources; for internal use only.\n\
7476 `x-get-resource' uses this as the first component of the instance name\n\
7477 when requesting resource values.\n\
7478 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
7479 was invoked, or to the value specified with the `-name' or `-rn'\n\
7480 switches, if present.");
7481 Vx_resource_name
= Qnil
;
7483 Vx_nontext_pointer_shape
= Qnil
;
7485 Vx_mode_pointer_shape
= Qnil
;
7487 DEFVAR_INT ("x-sensitive-text-pointer-shape",
7488 &Vx_sensitive_text_pointer_shape
,
7489 "The shape of the pointer when over mouse-sensitive text.\n\
7490 This variable takes effect when you create a new frame\n\
7491 or when you set the mouse color.");
7492 Vx_sensitive_text_pointer_shape
= Qnil
;
7494 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
7495 "A string indicating the foreground color of the cursor box.");
7496 Vx_cursor_fore_pixel
= Qnil
;
7498 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
7499 "Non-nil if no window manager is in use.\n\
7500 Emacs doesn't try to figure this out; this is always nil\n\
7501 unless you set it to something else.");
7502 /* We don't have any way to find this out, so set it to nil
7503 and maybe the user would like to set it to t. */
7504 Vx_no_window_manager
= Qnil
;
7506 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
7507 &Vx_pixel_size_width_font_regexp
,
7508 "Regexp matching a font name whose width is the same as `PIXEL_SIZE'.\n\
7510 Since Emacs gets width of a font matching with this regexp from\n\
7511 PIXEL_SIZE field of the name, font finding mechanism gets faster for\n\
7512 such a font. This is especially effective for such large fonts as\n\
7513 Chinese, Japanese, and Korean.");
7514 Vx_pixel_size_width_font_regexp
= Qnil
;
7516 DEFVAR_LISP ("w32-bdf-filename-alist",
7517 &Vw32_bdf_filename_alist
,
7518 "List of bdf fonts and their corresponding filenames.");
7519 Vw32_bdf_filename_alist
= Qnil
;
7521 DEFVAR_BOOL ("w32-strict-fontnames",
7522 &w32_strict_fontnames
,
7523 "Non-nil means only use fonts that are exact matches for those requested.\n\
7524 Default is nil, which allows old fontnames that are not XLFD compliant,\n\
7525 and allows third-party CJK display to work by specifying false charset\n\
7526 fields to trick Emacs into translating to Big5, SJIS etc.\n\
7527 Setting this to t will prevent wrong fonts being selected when\n\
7528 fontsets are automatically created.");
7529 w32_strict_fontnames
= 0;
7531 DEFVAR_LISP ("w32-system-coding-system",
7532 &Vw32_system_coding_system
,
7533 "Coding system used by Windows system functions, such as for font names.");
7534 Vw32_system_coding_system
= Qnil
;
7536 defsubr (&Sx_get_resource
);
7537 defsubr (&Sx_list_fonts
);
7538 defsubr (&Sx_display_color_p
);
7539 defsubr (&Sx_display_grayscale_p
);
7540 defsubr (&Sx_color_defined_p
);
7541 defsubr (&Sx_color_values
);
7542 defsubr (&Sx_server_max_request_size
);
7543 defsubr (&Sx_server_vendor
);
7544 defsubr (&Sx_server_version
);
7545 defsubr (&Sx_display_pixel_width
);
7546 defsubr (&Sx_display_pixel_height
);
7547 defsubr (&Sx_display_mm_width
);
7548 defsubr (&Sx_display_mm_height
);
7549 defsubr (&Sx_display_screens
);
7550 defsubr (&Sx_display_planes
);
7551 defsubr (&Sx_display_color_cells
);
7552 defsubr (&Sx_display_visual_class
);
7553 defsubr (&Sx_display_backing_store
);
7554 defsubr (&Sx_display_save_under
);
7555 defsubr (&Sx_parse_geometry
);
7556 defsubr (&Sx_create_frame
);
7557 defsubr (&Sx_open_connection
);
7558 defsubr (&Sx_close_connection
);
7559 defsubr (&Sx_display_list
);
7560 defsubr (&Sx_synchronize
);
7562 /* W32 specific functions */
7564 defsubr (&Sw32_focus_frame
);
7565 defsubr (&Sw32_select_font
);
7566 defsubr (&Sw32_define_rgb_color
);
7567 defsubr (&Sw32_default_color_map
);
7568 defsubr (&Sw32_load_color_file
);
7569 defsubr (&Sw32_send_sys_command
);
7570 defsubr (&Sw32_shell_execute
);
7571 defsubr (&Sw32_register_hot_key
);
7572 defsubr (&Sw32_unregister_hot_key
);
7573 defsubr (&Sw32_registered_hot_keys
);
7574 defsubr (&Sw32_reconstruct_hot_key
);
7575 defsubr (&Sw32_toggle_lock_key
);
7576 defsubr (&Sw32_find_bdf_fonts
);
7578 /* Setting callback functions for fontset handler. */
7579 get_font_info_func
= w32_get_font_info
;
7580 list_fonts_func
= w32_list_fonts
;
7581 load_font_func
= w32_load_font
;
7582 find_ccl_program_func
= w32_find_ccl_program
;
7583 query_font_func
= w32_query_font
;
7584 set_frame_fontset_func
= x_set_font
;
7585 check_window_system_func
= check_w32
;
7594 button
= MessageBox (NULL
,
7595 "A fatal error has occurred!\n\n"
7596 "Select Abort to exit, Retry to debug, Ignore to continue",
7597 "Emacs Abort Dialog",
7598 MB_ICONEXCLAMATION
| MB_TASKMODAL
7599 | MB_SETFOREGROUND
| MB_ABORTRETRYIGNORE
);
7614 /* For convenience when debugging. */
7618 return GetLastError ();