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 /* Map all Japanese charsets to the Windows Shift-JIS charset. */
5335 else if (strnicmp (lpcs
, "jis", 3) == 0) return SHIFTJIS_CHARSET
;
5336 else if (stricmp (lpcs
, "ksc5601.1987") == 0) return HANGEUL_CHARSET
;
5337 else if (stricmp (lpcs
, "gb2312") == 0) return GB2312_CHARSET
;
5338 else if (stricmp (lpcs
, "big5") == 0) return CHINESEBIG5_CHARSET
;
5339 else if (stricmp (lpcs
, "ms-oem") == 0) return OEM_CHARSET
;
5341 #ifdef EASTEUROPE_CHARSET
5342 else if (stricmp (lpcs
, "iso8859-2") == 0) return EASTEUROPE_CHARSET
;
5343 else if (stricmp (lpcs
, "iso8859-3") == 0) return TURKISH_CHARSET
;
5344 else if (stricmp (lpcs
, "iso8859-4") == 0) return BALTIC_CHARSET
;
5345 else if (stricmp (lpcs
, "iso8859-5") == 0) return RUSSIAN_CHARSET
;
5346 else if (stricmp (lpcs
, "koi8") == 0) return RUSSIAN_CHARSET
;
5347 else if (stricmp (lpcs
, "iso8859-6") == 0) return ARABIC_CHARSET
;
5348 else if (stricmp (lpcs
, "iso8859-7") == 0) return GREEK_CHARSET
;
5349 else if (stricmp (lpcs
, "iso8859-8") == 0) return HEBREW_CHARSET
;
5350 else if (stricmp (lpcs
, "iso8859-9") == 0) return TURKISH_CHARSET
;
5351 else if (stricmp (lpcs
, "viscii") == 0) return VIETNAMESE_CHARSET
;
5352 else if (stricmp (lpcs
, "vscii") == 0) return VIETNAMESE_CHARSET
;
5353 else if (stricmp (lpcs
, "tis620") == 0) return THAI_CHARSET
;
5354 else if (stricmp (lpcs
, "mac") == 0) return MAC_CHARSET
;
5355 else if (stricmp (lpcs
, "ksc5601.1992") == 0) return JOHAB_CHARSET
;
5356 /* For backwards compatibility with previous 20.4 pretests. */
5357 else if (stricmp (lpcs
, "ksc5601") == 0) return HANGEUL_CHARSET
;
5358 else if (stricmp (lpcs
, "johab") == 0) return JOHAB_CHARSET
;
5361 #ifdef UNICODE_CHARSET
5362 else if (stricmp (lpcs
,"iso10646") == 0) return UNICODE_CHARSET
;
5363 else if (stricmp (lpcs
, "unicode") == 0) return UNICODE_CHARSET
;
5365 else if (lpcs
[0] == '#') return atoi (lpcs
+ 1);
5367 return DEFAULT_CHARSET
;
5371 w32_to_x_charset (fncharset
)
5374 static char buf
[16];
5378 /* ansi is considered iso8859-1, as most modern ansi fonts are. */
5379 case ANSI_CHARSET
: return "iso8859-1";
5380 case DEFAULT_CHARSET
: return "ascii-*";
5381 case SYMBOL_CHARSET
: return "ms-symbol";
5382 case SHIFTJIS_CHARSET
: return "jisx0208-sjis";
5383 case HANGEUL_CHARSET
: return "ksc5601.1987-*";
5384 case GB2312_CHARSET
: return "gb2312-*";
5385 case CHINESEBIG5_CHARSET
: return "big5-*";
5386 case OEM_CHARSET
: return "ms-oem";
5388 /* More recent versions of Windows (95 and NT4.0) define more
5390 #ifdef EASTEUROPE_CHARSET
5391 case EASTEUROPE_CHARSET
: return "iso8859-2";
5392 case TURKISH_CHARSET
: return "iso8859-9";
5393 case BALTIC_CHARSET
: return "iso8859-4";
5395 /* W95 with international support but not IE4 often has the
5396 KOI8-R codepage but not ISO8859-5. */
5397 case RUSSIAN_CHARSET
:
5398 if (!IsValidCodePage(28595) && IsValidCodePage(20886))
5402 case ARABIC_CHARSET
: return "iso8859-6";
5403 case GREEK_CHARSET
: return "iso8859-7";
5404 case HEBREW_CHARSET
: return "iso8859-8";
5405 case VIETNAMESE_CHARSET
: return "viscii1.1-*";
5406 case THAI_CHARSET
: return "tis620-*";
5407 case MAC_CHARSET
: return "mac-*";
5408 case JOHAB_CHARSET
: return "ksc5601.1992-*";
5412 #ifdef UNICODE_CHARSET
5413 case UNICODE_CHARSET
: return "iso10646-unicode";
5416 /* Encode numerical value of unknown charset. */
5417 sprintf (buf
, "*-#%u", fncharset
);
5422 w32_to_x_font (lplogfont
, lpxstr
, len
)
5423 LOGFONT
* lplogfont
;
5428 char height_pixels
[8];
5430 char width_pixels
[8];
5431 char *fontname_dash
;
5432 int display_resy
= one_w32_display_info
.height_in
;
5433 int display_resx
= one_w32_display_info
.width_in
;
5435 struct coding_system coding
;
5437 if (!lpxstr
) abort ();
5442 setup_coding_system (Fcheck_coding_system (Vw32_system_coding_system
),
5444 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5445 bufsz
= decoding_buffer_size (&coding
, LF_FACESIZE
);
5447 fontname
= alloca(sizeof(*fontname
) * bufsz
);
5448 decode_coding (&coding
, lplogfont
->lfFaceName
, fontname
,
5449 strlen(lplogfont
->lfFaceName
), bufsz
- 1);
5450 *(fontname
+ coding
.produced
) = '\0';
5452 /* Replace dashes with underscores so the dashes are not
5454 fontname_dash
= fontname
;
5455 while (fontname_dash
= strchr (fontname_dash
, '-'))
5456 *fontname_dash
= '_';
5458 if (lplogfont
->lfHeight
)
5460 sprintf (height_pixels
, "%u", abs (lplogfont
->lfHeight
));
5461 sprintf (height_dpi
, "%u",
5462 abs (lplogfont
->lfHeight
) * 720 / display_resy
);
5466 strcpy (height_pixels
, "*");
5467 strcpy (height_dpi
, "*");
5469 if (lplogfont
->lfWidth
)
5470 sprintf (width_pixels
, "%u", lplogfont
->lfWidth
* 10);
5472 strcpy (width_pixels
, "*");
5474 _snprintf (lpxstr
, len
- 1,
5475 "-*-%s-%s-%c-*-*-%s-%s-%d-%d-%c-%s-%s",
5477 fontname
, /* family */
5478 w32_to_x_weight (lplogfont
->lfWeight
), /* weight */
5479 lplogfont
->lfItalic
?'i':'r', /* slant */
5481 /* add style name */
5482 height_pixels
, /* pixel size */
5483 height_dpi
, /* point size */
5484 display_resx
, /* resx */
5485 display_resy
, /* resy */
5486 ((lplogfont
->lfPitchAndFamily
& 0x3) == VARIABLE_PITCH
)
5487 ? 'p' : 'c', /* spacing */
5488 width_pixels
, /* avg width */
5489 w32_to_x_charset (lplogfont
->lfCharSet
) /* charset registry
5493 lpxstr
[len
- 1] = 0; /* just to be sure */
5498 x_to_w32_font (lpxstr
, lplogfont
)
5500 LOGFONT
* lplogfont
;
5502 struct coding_system coding
;
5504 if (!lplogfont
) return (FALSE
);
5506 memset (lplogfont
, 0, sizeof (*lplogfont
));
5508 /* Set default value for each field. */
5510 lplogfont
->lfOutPrecision
= OUT_DEFAULT_PRECIS
;
5511 lplogfont
->lfClipPrecision
= CLIP_DEFAULT_PRECIS
;
5512 lplogfont
->lfQuality
= DEFAULT_QUALITY
;
5514 /* go for maximum quality */
5515 lplogfont
->lfOutPrecision
= OUT_STROKE_PRECIS
;
5516 lplogfont
->lfClipPrecision
= CLIP_STROKE_PRECIS
;
5517 lplogfont
->lfQuality
= PROOF_QUALITY
;
5520 lplogfont
->lfCharSet
= DEFAULT_CHARSET
;
5521 lplogfont
->lfWeight
= FW_DONTCARE
;
5522 lplogfont
->lfPitchAndFamily
= DEFAULT_PITCH
| FF_DONTCARE
;
5527 /* Provide a simple escape mechanism for specifying Windows font names
5528 * directly -- if font spec does not beginning with '-', assume this
5530 * "<font name>[:height in pixels[:width in pixels[:weight]]]"
5536 char name
[50], weight
[20], slant
, pitch
, pixels
[10], height
[10],
5537 width
[10], resy
[10], remainder
[20];
5539 int dpi
= one_w32_display_info
.height_in
;
5541 fields
= sscanf (lpxstr
,
5542 "-%*[^-]-%49[^-]-%19[^-]-%c-%*[^-]-%*[^-]-%9[^-]-%9[^-]-%*[^-]-%9[^-]-%c-%9[^-]-%19s",
5543 name
, weight
, &slant
, pixels
, height
, resy
, &pitch
, width
, remainder
);
5544 if (fields
== EOF
) return (FALSE
);
5546 if (fields
> 0 && name
[0] != '*')
5552 (Fcheck_coding_system (Vw32_system_coding_system
), &coding
);
5553 bufsize
= encoding_buffer_size (&coding
, strlen (name
));
5554 buf
= (unsigned char *) alloca (bufsize
);
5555 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5556 encode_coding (&coding
, name
, buf
, strlen (name
), bufsize
);
5557 if (coding
.produced
>= LF_FACESIZE
)
5558 coding
.produced
= LF_FACESIZE
- 1;
5559 buf
[coding
.produced
] = 0;
5560 strcpy (lplogfont
->lfFaceName
, buf
);
5564 lplogfont
->lfFaceName
[0] = 0;
5569 lplogfont
->lfWeight
= x_to_w32_weight ((fields
> 0 ? weight
: ""));
5573 if (!NILP (Vw32_enable_italics
))
5574 lplogfont
->lfItalic
= (fields
> 0 && slant
== 'i');
5578 if (fields
> 0 && pixels
[0] != '*')
5579 lplogfont
->lfHeight
= atoi (pixels
);
5583 if (fields
> 0 && resy
[0] != '*')
5585 tem
= atoi (pixels
);
5586 if (tem
> 0) dpi
= tem
;
5589 if (fields
> -1 && lplogfont
->lfHeight
== 0 && height
[0] != '*')
5590 lplogfont
->lfHeight
= atoi (height
) * dpi
/ 720;
5593 lplogfont
->lfPitchAndFamily
=
5594 (fields
> 0 && pitch
== 'p') ? VARIABLE_PITCH
: FIXED_PITCH
;
5598 if (fields
> 0 && width
[0] != '*')
5599 lplogfont
->lfWidth
= atoi (width
) / 10;
5603 /* Strip the trailing '-' if present. (it shouldn't be, as it
5604 fails the test against xlfn-tight-regexp in fontset.el). */
5606 int len
= strlen (remainder
);
5607 if (len
> 0 && remainder
[len
-1] == '-')
5608 remainder
[len
-1] = 0;
5610 encoding
= remainder
;
5611 if (strncmp (encoding
, "*-", 2) == 0)
5613 lplogfont
->lfCharSet
= x_to_w32_charset (fields
> 0 ? encoding
: "");
5618 char name
[100], height
[10], width
[10], weight
[20];
5620 fields
= sscanf (lpxstr
,
5621 "%99[^:]:%9[^:]:%9[^:]:%19s",
5622 name
, height
, width
, weight
);
5624 if (fields
== EOF
) return (FALSE
);
5628 strncpy (lplogfont
->lfFaceName
,name
, LF_FACESIZE
);
5629 lplogfont
->lfFaceName
[LF_FACESIZE
-1] = 0;
5633 lplogfont
->lfFaceName
[0] = 0;
5639 lplogfont
->lfHeight
= atoi (height
);
5644 lplogfont
->lfWidth
= atoi (width
);
5648 lplogfont
->lfWeight
= x_to_w32_weight ((fields
> 0 ? weight
: ""));
5651 /* This makes TrueType fonts work better. */
5652 lplogfont
->lfHeight
= - abs (lplogfont
->lfHeight
);
5658 w32_font_match (lpszfont1
, lpszfont2
)
5662 char * s1
= lpszfont1
, *e1
, *w1
;
5663 char * s2
= lpszfont2
, *e2
, *w2
;
5665 if (s1
== NULL
|| s2
== NULL
) return (FALSE
);
5667 if (*s1
== '-') s1
++;
5668 if (*s2
== '-') s2
++;
5672 int len1
, len2
, len3
=0;
5674 e1
= strchr (s1
, '-');
5675 e2
= strchr (s2
, '-');
5676 w1
= strchr (s1
, '*');
5677 w2
= strchr (s2
, '*');
5690 if (w2
&& w2
< e2
&& ( len3
== 0 || (w2
- s2
) < len3
))
5693 /* Whole field is not a wildcard, and ...*/
5694 if (*s1
!= '*' && *s2
!= '*' && *s1
!= '-' && *s2
!= '-'
5695 /* Lengths are different and there are no wildcards, or ... */
5696 && ((len1
!= len2
&& len3
== 0) ||
5697 /* strings don't match up until first wildcard or end. */
5698 strnicmp (s1
, s2
, len3
> 0 ? len3
: len1
) != 0))
5701 if (e1
== NULL
|| e2
== NULL
)
5709 /* Callback functions, and a structure holding info they need, for
5710 listing system fonts on W32. We need one set of functions to do the
5711 job properly, but these don't work on NT 3.51 and earlier, so we
5712 have a second set which don't handle character sets properly to
5715 In both cases, there are two passes made. The first pass gets one
5716 font from each family, the second pass lists all the fonts from
5719 typedef struct enumfont_t
5724 XFontStruct
*size_ref
;
5725 Lisp_Object
*pattern
;
5730 enum_font_cb2 (lplf
, lptm
, FontType
, lpef
)
5732 NEWTEXTMETRIC
* lptm
;
5736 if (lplf
->elfLogFont
.lfStrikeOut
|| lplf
->elfLogFont
.lfUnderline
)
5739 /* Check that the character set matches if it was specified */
5740 if (lpef
->logfont
.lfCharSet
!= DEFAULT_CHARSET
&&
5741 lplf
->elfLogFont
.lfCharSet
!= lpef
->logfont
.lfCharSet
)
5744 /* We want all fonts cached, so don't compare sizes just yet */
5745 /* if (!lpef->size_ref || lptm->tmMaxCharWidth == FONT_WIDTH (lpef->size_ref)) */
5748 Lisp_Object width
= Qnil
;
5750 if (!NILP (*(lpef
->pattern
)) && FontType
!= RASTER_FONTTYPE
)
5752 /* Scalable fonts are as big as you want them to be. */
5753 lplf
->elfLogFont
.lfHeight
= lpef
->logfont
.lfHeight
;
5754 lplf
->elfLogFont
.lfWidth
= lpef
->logfont
.lfWidth
;
5756 /* Make sure the height used here is the same as everywhere
5757 else (ie character height, not cell height). */
5758 else if (lplf
->elfLogFont
.lfHeight
> 0)
5759 lplf
->elfLogFont
.lfHeight
= lptm
->tmInternalLeading
- lptm
->tmHeight
;
5761 /* The MaxCharWidth is not valid at this stage for scalable fonts. */
5762 if (FontType
== RASTER_FONTTYPE
)
5763 width
= make_number (lptm
->tmMaxCharWidth
);
5765 if (!w32_to_x_font (&(lplf
->elfLogFont
), buf
, 100))
5768 if (NILP (*(lpef
->pattern
))
5769 || w32_font_match (buf
, XSTRING (*(lpef
->pattern
))->data
))
5771 *lpef
->tail
= Fcons (Fcons (build_string (buf
), width
), Qnil
);
5772 lpef
->tail
= &(XCONS (*lpef
->tail
)->cdr
);
5781 enum_font_cb1 (lplf
, lptm
, FontType
, lpef
)
5783 NEWTEXTMETRIC
* lptm
;
5787 return EnumFontFamilies (lpef
->hdc
,
5788 lplf
->elfLogFont
.lfFaceName
,
5789 (FONTENUMPROC
) enum_font_cb2
,
5795 enum_fontex_cb2 (lplf
, lptm
, font_type
, lpef
)
5796 ENUMLOGFONTEX
* lplf
;
5797 NEWTEXTMETRICEX
* lptm
;
5801 /* We are not interested in the extra info we get back from the 'Ex
5802 version - only the fact that we get character set variations
5803 enumerated seperately. */
5804 return enum_font_cb2 ((ENUMLOGFONT
*) lplf
, (NEWTEXTMETRIC
*) lptm
,
5809 enum_fontex_cb1 (lplf
, lptm
, font_type
, lpef
)
5810 ENUMLOGFONTEX
* lplf
;
5811 NEWTEXTMETRICEX
* lptm
;
5815 HMODULE gdi32
= GetModuleHandle ("gdi32.dll");
5816 FARPROC enum_font_families_ex
5817 = GetProcAddress ( gdi32
, "EnumFontFamiliesExA");
5818 /* We don't really expect EnumFontFamiliesEx to disappear once we
5819 get here, so don't bother handling it gracefully. */
5820 if (enum_font_families_ex
== NULL
)
5821 error ("gdi32.dll has disappeared!");
5822 return enum_font_families_ex (lpef
->hdc
,
5824 (FONTENUMPROC
) enum_fontex_cb2
,
5828 /* Interface to fontset handler. (adapted from mw32font.c in Meadow
5829 and xterm.c in Emacs 20.3) */
5831 Lisp_Object
w32_list_bdf_fonts (Lisp_Object pattern
, int max_names
)
5833 char *fontname
, *ptnstr
;
5834 Lisp_Object list
, tem
, newlist
= Qnil
;
5837 list
= Vw32_bdf_filename_alist
;
5838 ptnstr
= XSTRING (pattern
)->data
;
5840 for ( ; CONSP (list
); list
= XCONS (list
)->cdr
)
5842 tem
= XCONS (list
)->car
;
5844 fontname
= XSTRING (XCONS (tem
)->car
)->data
;
5845 else if (STRINGP (tem
))
5846 fontname
= XSTRING (tem
)->data
;
5850 if (w32_font_match (fontname
, ptnstr
))
5852 newlist
= Fcons (XCONS (tem
)->car
, newlist
);
5854 if (n_fonts
>= max_names
)
5862 Lisp_Object
w32_list_synthesized_fonts (FRAME_PTR f
, Lisp_Object pattern
,
5863 int size
, int max_names
);
5865 /* Return a list of names of available fonts matching PATTERN on frame
5866 F. If SIZE is not 0, it is the size (maximum bound width) of fonts
5867 to be listed. Frame F NULL means we have not yet created any
5868 frame, which means we can't get proper size info, as we don't have
5869 a device context to use for GetTextMetrics.
5870 MAXNAMES sets a limit on how many fonts to match. */
5873 w32_list_fonts (FRAME_PTR f
, Lisp_Object pattern
, int size
, int maxnames
)
5875 Lisp_Object patterns
, key
, tem
, tpat
;
5876 Lisp_Object list
= Qnil
, newlist
= Qnil
, second_best
= Qnil
;
5877 struct w32_display_info
*dpyinfo
= &one_w32_display_info
;
5880 patterns
= Fassoc (pattern
, Valternate_fontname_alist
);
5881 if (NILP (patterns
))
5882 patterns
= Fcons (pattern
, Qnil
);
5884 for (; CONSP (patterns
); patterns
= XCONS (patterns
)->cdr
)
5888 tpat
= XCONS (patterns
)->car
;
5890 /* See if we cached the result for this particular query.
5891 The cache is an alist of the form:
5892 ((PATTERN (FONTNAME . WIDTH) ...) ...)
5894 if (tem
= XCONS (dpyinfo
->name_list_element
)->cdr
,
5895 !NILP (list
= Fassoc (tpat
, tem
)))
5897 list
= Fcdr_safe (list
);
5898 /* We have a cached list. Don't have to get the list again. */
5903 /* At first, put PATTERN in the cache. */
5909 /* Use EnumFontFamiliesEx where it is available, as it knows
5910 about character sets. Fall back to EnumFontFamilies for
5911 older versions of NT that don't support the 'Ex function. */
5912 x_to_w32_font (STRINGP (tpat
) ? XSTRING (tpat
)->data
:
5915 LOGFONT font_match_pattern
;
5916 HMODULE gdi32
= GetModuleHandle ("gdi32.dll");
5917 FARPROC enum_font_families_ex
5918 = GetProcAddress ( gdi32
, "EnumFontFamiliesExA");
5920 /* We do our own pattern matching so we can handle wildcards. */
5921 font_match_pattern
.lfFaceName
[0] = 0;
5922 font_match_pattern
.lfPitchAndFamily
= 0;
5923 /* We can use the charset, because if it is a wildcard it will
5924 be DEFAULT_CHARSET anyway. */
5925 font_match_pattern
.lfCharSet
= ef
.logfont
.lfCharSet
;
5927 ef
.hdc
= GetDC (dpyinfo
->root_window
);
5929 if (enum_font_families_ex
)
5930 enum_font_families_ex (ef
.hdc
,
5931 &font_match_pattern
,
5932 (FONTENUMPROC
) enum_fontex_cb1
,
5935 EnumFontFamilies (ef
.hdc
, NULL
, (FONTENUMPROC
) enum_font_cb1
,
5938 ReleaseDC (dpyinfo
->root_window
, ef
.hdc
);
5943 /* Make a list of the fonts we got back.
5944 Store that in the font cache for the display. */
5945 XCONS (dpyinfo
->name_list_element
)->cdr
5946 = Fcons (Fcons (tpat
, list
),
5947 XCONS (dpyinfo
->name_list_element
)->cdr
);
5950 if (NILP (list
)) continue; /* Try the remaining alternatives. */
5952 newlist
= second_best
= Qnil
;
5954 /* Make a list of the fonts that have the right width. */
5955 for (; CONSP (list
); list
= XCONS (list
)->cdr
)
5958 tem
= XCONS (list
)->car
;
5962 if (NILP (XCONS (tem
)->car
))
5966 newlist
= Fcons (XCONS (tem
)->car
, newlist
);
5968 if (n_fonts
>= maxnames
)
5973 if (!INTEGERP (XCONS (tem
)->cdr
))
5975 /* Since we don't yet know the size of the font, we must
5976 load it and try GetTextMetrics. */
5977 W32FontStruct thisinfo
;
5982 if (!x_to_w32_font (XSTRING (XCONS (tem
)->car
)->data
, &lf
))
5986 thisinfo
.bdf
= NULL
;
5987 thisinfo
.hfont
= CreateFontIndirect (&lf
);
5988 if (thisinfo
.hfont
== NULL
)
5991 hdc
= GetDC (dpyinfo
->root_window
);
5992 oldobj
= SelectObject (hdc
, thisinfo
.hfont
);
5993 if (GetTextMetrics (hdc
, &thisinfo
.tm
))
5994 XCONS (tem
)->cdr
= make_number (FONT_WIDTH (&thisinfo
));
5996 XCONS (tem
)->cdr
= make_number (0);
5997 SelectObject (hdc
, oldobj
);
5998 ReleaseDC (dpyinfo
->root_window
, hdc
);
5999 DeleteObject(thisinfo
.hfont
);
6002 found_size
= XINT (XCONS (tem
)->cdr
);
6003 if (found_size
== size
)
6005 newlist
= Fcons (XCONS (tem
)->car
, newlist
);
6007 if (n_fonts
>= maxnames
)
6010 /* keep track of the closest matching size in case
6011 no exact match is found. */
6012 else if (found_size
> 0)
6014 if (NILP (second_best
))
6017 else if (found_size
< size
)
6019 if (XINT (XCONS (second_best
)->cdr
) > size
6020 || XINT (XCONS (second_best
)->cdr
) < found_size
)
6025 if (XINT (XCONS (second_best
)->cdr
) > size
6026 && XINT (XCONS (second_best
)->cdr
) >
6033 if (!NILP (newlist
))
6035 else if (!NILP (second_best
))
6037 newlist
= Fcons (XCONS (second_best
)->car
, Qnil
);
6042 /* Include any bdf fonts. */
6043 if (n_fonts
< maxnames
)
6045 Lisp_Object combined
[2];
6046 combined
[0] = w32_list_bdf_fonts (pattern
, maxnames
- n_fonts
);
6047 combined
[1] = newlist
;
6048 newlist
= Fnconc(2, combined
);
6051 /* If we can't find a font that matches, check if Windows would be
6052 able to synthesize it from a different style. */
6053 if (NILP (newlist
) && !NILP (Vw32_enable_italics
))
6054 newlist
= w32_list_synthesized_fonts (f
, pattern
, size
, maxnames
);
6060 w32_list_synthesized_fonts (f
, pattern
, size
, max_names
)
6062 Lisp_Object pattern
;
6067 char *full_pattn
, *new_pattn
, foundary
[50], family
[50], *pattn_part2
;
6068 char style
[20], slant
;
6069 Lisp_Object matches
, match
, tem
, synthed_matches
= Qnil
;
6071 full_pattn
= XSTRING (pattern
)->data
;
6073 pattn_part2
= alloca (XSTRING (pattern
)->size
);
6074 /* Allow some space for wildcard expansion. */
6075 new_pattn
= alloca (XSTRING (pattern
)->size
+ 100);
6077 fields
= sscanf (full_pattn
, "-%49[^-]-%49[^-]-%19[^-]-%c-%s",
6078 foundary
, family
, style
, &slant
, pattn_part2
);
6079 if (fields
== EOF
|| fields
< 5)
6082 /* If the style and slant are wildcards already there is no point
6083 checking again (and we don't want to keep recursing). */
6084 if (*style
== '*' && slant
== '*')
6087 sprintf (new_pattn
, "-%s-%s-*-*-%s", foundary
, family
, pattn_part2
);
6089 matches
= w32_list_fonts (f
, build_string (new_pattn
), size
, max_names
);
6091 for ( ; CONSP (matches
); matches
= XCONS (matches
)->cdr
)
6093 tem
= XCONS (matches
)->car
;
6097 full_pattn
= XSTRING (tem
)->data
;
6098 fields
= sscanf (full_pattn
, "-%49[^-]-%49[^-]-%*[^-]-%*c-%s",
6099 foundary
, family
, pattn_part2
);
6100 if (fields
== EOF
|| fields
< 3)
6103 sprintf (new_pattn
, "-%s-%s-%s-%c-%s", foundary
, family
, style
,
6104 slant
, pattn_part2
);
6106 synthed_matches
= Fcons (build_string (new_pattn
),
6110 return synthed_matches
;
6114 /* Return a pointer to struct font_info of font FONT_IDX of frame F. */
6116 w32_get_font_info (f
, font_idx
)
6120 return (FRAME_W32_FONT_TABLE (f
) + font_idx
);
6125 w32_query_font (struct frame
*f
, char *fontname
)
6128 struct font_info
*pfi
;
6130 pfi
= FRAME_W32_FONT_TABLE (f
);
6132 for (i
= 0; i
< one_w32_display_info
.n_fonts
;i
++, pfi
++)
6134 if (strcmp(pfi
->name
, fontname
) == 0) return pfi
;
6140 /* Find a CCL program for a font specified by FONTP, and set the member
6141 `encoder' of the structure. */
6144 w32_find_ccl_program (fontp
)
6145 struct font_info
*fontp
;
6147 extern Lisp_Object Vfont_ccl_encoder_alist
, Vccl_program_table
;
6148 extern Lisp_Object Qccl_program_idx
;
6149 extern Lisp_Object
resolve_symbol_ccl_program ();
6150 Lisp_Object list
, elt
, ccl_prog
, ccl_id
;
6152 for (list
= Vfont_ccl_encoder_alist
; CONSP (list
); list
= XCONS (list
)->cdr
)
6154 elt
= XCONS (list
)->car
;
6156 && STRINGP (XCONS (elt
)->car
)
6157 && (fast_c_string_match_ignore_case (XCONS (elt
)->car
, fontp
->name
)
6160 if (SYMBOLP (XCONS (elt
)->cdr
) &&
6161 (!NILP (ccl_id
= Fget (XCONS (elt
)->cdr
, Qccl_program_idx
))))
6163 ccl_prog
= XVECTOR (Vccl_program_table
)->contents
[XUINT (ccl_id
)];
6164 if (!CONSP (ccl_prog
)) continue;
6165 ccl_prog
= XCONS (ccl_prog
)->cdr
;
6169 ccl_prog
= XCONS (elt
)->cdr
;
6170 if (!VECTORP (ccl_prog
)) continue;
6174 = (struct ccl_program
*) xmalloc (sizeof (struct ccl_program
));
6175 setup_ccl_program (fontp
->font_encoder
,
6176 resolve_symbol_ccl_program (ccl_prog
));
6184 #include "x-list-font.c"
6186 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 4, 0,
6187 "Return a list of the names of available fonts matching PATTERN.\n\
6188 If optional arguments FACE and FRAME are specified, return only fonts\n\
6189 the same size as FACE on FRAME.\n\
6191 PATTERN is a string, perhaps with wildcard characters;\n\
6192 the * character matches any substring, and\n\
6193 the ? character matches any single character.\n\
6194 PATTERN is case-insensitive.\n\
6195 FACE is a face name--a symbol.\n\
6197 The return value is a list of strings, suitable as arguments to\n\
6200 Fonts Emacs can't use (i.e. proportional fonts) may or may not be excluded\n\
6201 even if they match PATTERN and FACE.\n\
6203 The optional fourth argument MAXIMUM sets a limit on how many\n\
6204 fonts to match. The first MAXIMUM fonts are reported.")
6205 (pattern
, face
, frame
, maximum
)
6206 Lisp_Object pattern
, face
, frame
, maximum
;
6211 XFontStruct
*size_ref
;
6212 Lisp_Object namelist
;
6217 CHECK_STRING (pattern
, 0);
6219 CHECK_SYMBOL (face
, 1);
6221 f
= check_x_frame (frame
);
6223 /* Determine the width standard for comparison with the fonts we find. */
6231 /* Don't die if we get called with a terminal frame. */
6232 if (! FRAME_W32_P (f
))
6233 error ("non-w32 frame used in `x-list-fonts'");
6235 face_id
= face_name_id_number (f
, face
);
6237 if (face_id
< 0 || face_id
>= FRAME_N_PARAM_FACES (f
)
6238 || FRAME_PARAM_FACES (f
) [face_id
] == 0)
6239 size_ref
= f
->output_data
.w32
->font
;
6242 size_ref
= FRAME_PARAM_FACES (f
) [face_id
]->font
;
6243 if (size_ref
== (XFontStruct
*) (~0))
6244 size_ref
= f
->output_data
.w32
->font
;
6248 /* See if we cached the result for this particular query. */
6249 list
= Fassoc (pattern
,
6250 XCONS (FRAME_W32_DISPLAY_INFO (f
)->name_list_element
)->cdr
);
6252 /* We have info in the cache for this PATTERN. */
6255 Lisp_Object tem
, newlist
;
6257 /* We have info about this pattern. */
6258 list
= XCONS (list
)->cdr
;
6265 /* Filter the cached info and return just the fonts that match FACE. */
6267 for (tem
= list
; CONSP (tem
); tem
= XCONS (tem
)->cdr
)
6269 struct font_info
*fontinf
;
6270 XFontStruct
*thisinfo
= NULL
;
6272 fontinf
= w32_load_font (f
, XSTRING (XCONS (tem
)->car
)->data
, 0);
6274 thisinfo
= (XFontStruct
*)fontinf
->font
;
6275 if (thisinfo
&& same_size_fonts (thisinfo
, size_ref
))
6276 newlist
= Fcons (XCONS (tem
)->car
, newlist
);
6278 w32_unload_font (FRAME_W32_DISPLAY_INFO (f
), thisinfo
);
6289 ef
.pattern
= &pattern
;
6292 x_to_w32_font (STRINGP (pattern
) ? XSTRING (pattern
)->data
: NULL
, &ef
.logfont
);
6295 ef
.hdc
= GetDC (FRAME_W32_WINDOW (f
));
6297 EnumFontFamilies (ef
.hdc
, NULL
, (FONTENUMPROC
) enum_font_cb1
, (LPARAM
)&ef
);
6299 ReleaseDC (FRAME_W32_WINDOW (f
), ef
.hdc
);
6309 /* Make a list of all the fonts we got back.
6310 Store that in the font cache for the display. */
6311 XCONS (FRAME_W32_DISPLAY_INFO (f
)->name_list_element
)->cdr
6312 = Fcons (Fcons (pattern
, namelist
),
6313 XCONS (FRAME_W32_DISPLAY_INFO (f
)->name_list_element
)->cdr
);
6315 /* Make a list of the fonts that have the right width. */
6318 for (i
= 0; i
< ef
.numFonts
; i
++)
6326 struct font_info
*fontinf
;
6327 XFontStruct
*thisinfo
= NULL
;
6330 fontinf
= w32_load_font (f
, XSTRING (Fcar (cur
))->data
, 0);
6332 thisinfo
= (XFontStruct
*)fontinf
->font
;
6334 keeper
= thisinfo
&& same_size_fonts (thisinfo
, size_ref
);
6336 w32_unload_font (FRAME_W32_DISPLAY_INFO (f
), thisinfo
);
6341 list
= Fcons (build_string (XSTRING (Fcar (cur
))->data
), list
);
6345 list
= Fnreverse (list
);
6352 DEFUN ("w32-find-bdf-fonts", Fw32_find_bdf_fonts
, Sw32_find_bdf_fonts
,
6354 "Return a list of BDF fonts in DIR, suitable for appending to\n\
6355 w32-bdf-filename-alist. Fonts which do not contain an xfld description\n\
6356 will not be included in the list. DIR may be a list of directories.")
6358 Lisp_Object directory
;
6360 Lisp_Object list
= Qnil
;
6361 struct gcpro gcpro1
, gcpro2
;
6363 if (!CONSP (directory
))
6364 return w32_find_bdf_fonts_in_dir (directory
);
6366 for ( ; CONSP (directory
); directory
= XCONS (directory
)->cdr
)
6368 Lisp_Object pair
[2];
6371 GCPRO2 (directory
, list
);
6372 pair
[1] = w32_find_bdf_fonts_in_dir( XCONS (directory
)->car
);
6373 list
= Fnconc( 2, pair
);
6379 /* Find BDF files in a specified directory. (use GCPRO when calling,
6380 as this calls lisp to get a directory listing). */
6381 Lisp_Object
w32_find_bdf_fonts_in_dir( Lisp_Object directory
)
6383 Lisp_Object filelist
, list
= Qnil
;
6386 if (!STRINGP(directory
))
6389 filelist
= Fdirectory_files (directory
, Qt
,
6390 build_string (".*\\.[bB][dD][fF]"), Qt
);
6392 for ( ; CONSP(filelist
); filelist
= XCONS (filelist
)->cdr
)
6394 Lisp_Object filename
= XCONS (filelist
)->car
;
6395 if (w32_BDF_to_x_font (XSTRING (filename
)->data
, fontname
, 100))
6396 store_in_alist (&list
, build_string (fontname
), filename
);
6402 DEFUN ("x-color-defined-p", Fx_color_defined_p
, Sx_color_defined_p
, 1, 2, 0,
6403 "Return non-nil if color COLOR is supported on frame FRAME.\n\
6404 If FRAME is omitted or nil, use the selected frame.")
6406 Lisp_Object color
, frame
;
6409 FRAME_PTR f
= check_x_frame (frame
);
6411 CHECK_STRING (color
, 1);
6413 if (defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
6419 DEFUN ("x-color-values", Fx_color_values
, Sx_color_values
, 1, 2, 0,
6420 "Return a description of the color named COLOR on frame FRAME.\n\
6421 The value is a list of integer RGB values--(RED GREEN BLUE).\n\
6422 These values appear to range from 0 to 65280 or 65535, depending\n\
6423 on the system; white is (65280 65280 65280) or (65535 65535 65535).\n\
6424 If FRAME is omitted or nil, use the selected frame.")
6426 Lisp_Object color
, frame
;
6429 FRAME_PTR f
= check_x_frame (frame
);
6431 CHECK_STRING (color
, 1);
6433 if (defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
6437 rgb
[0] = make_number ((GetRValue (foo
) << 8) | GetRValue (foo
));
6438 rgb
[1] = make_number ((GetGValue (foo
) << 8) | GetGValue (foo
));
6439 rgb
[2] = make_number ((GetBValue (foo
) << 8) | GetBValue (foo
));
6440 return Flist (3, rgb
);
6446 DEFUN ("x-display-color-p", Fx_display_color_p
, Sx_display_color_p
, 0, 1, 0,
6447 "Return t if the X display supports color.\n\
6448 The optional argument DISPLAY specifies which display to ask about.\n\
6449 DISPLAY should be either a frame or a display name (a string).\n\
6450 If omitted or nil, that stands for the selected frame's display.")
6452 Lisp_Object display
;
6454 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6456 if ((dpyinfo
->n_planes
* dpyinfo
->n_cbits
) <= 2)
6462 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
, Sx_display_grayscale_p
,
6464 "Return t if the X display supports shades of gray.\n\
6465 Note that color displays do support shades of gray.\n\
6466 The optional argument DISPLAY specifies which display to ask about.\n\
6467 DISPLAY should be either a frame or a display name (a string).\n\
6468 If omitted or nil, that stands for the selected frame's display.")
6470 Lisp_Object display
;
6472 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6474 if ((dpyinfo
->n_planes
* dpyinfo
->n_cbits
) <= 1)
6480 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
6482 "Returns the width in pixels of the X display DISPLAY.\n\
6483 The optional argument DISPLAY specifies which display to ask about.\n\
6484 DISPLAY should be either a frame or a display name (a string).\n\
6485 If omitted or nil, that stands for the selected frame's display.")
6487 Lisp_Object display
;
6489 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6491 return make_number (dpyinfo
->width
);
6494 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
6495 Sx_display_pixel_height
, 0, 1, 0,
6496 "Returns the height in pixels of the X display DISPLAY.\n\
6497 The optional argument DISPLAY specifies which display to ask about.\n\
6498 DISPLAY should be either a frame or a display name (a string).\n\
6499 If omitted or nil, that stands for the selected frame's display.")
6501 Lisp_Object display
;
6503 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6505 return make_number (dpyinfo
->height
);
6508 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
6510 "Returns the number of bitplanes of the display DISPLAY.\n\
6511 The optional argument DISPLAY specifies which display to ask about.\n\
6512 DISPLAY should be either a frame or a display name (a string).\n\
6513 If omitted or nil, that stands for the selected frame's display.")
6515 Lisp_Object display
;
6517 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6519 return make_number (dpyinfo
->n_planes
* dpyinfo
->n_cbits
);
6522 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
6524 "Returns the number of color cells of the display DISPLAY.\n\
6525 The optional argument DISPLAY specifies which display to ask about.\n\
6526 DISPLAY should be either a frame or a display name (a string).\n\
6527 If omitted or nil, that stands for the selected frame's display.")
6529 Lisp_Object display
;
6531 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6535 hdc
= GetDC (dpyinfo
->root_window
);
6536 if (dpyinfo
->has_palette
)
6537 cap
= GetDeviceCaps (hdc
,SIZEPALETTE
);
6539 cap
= GetDeviceCaps (hdc
,NUMCOLORS
);
6541 ReleaseDC (dpyinfo
->root_window
, hdc
);
6543 return make_number (cap
);
6546 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
6547 Sx_server_max_request_size
,
6549 "Returns the maximum request size of the server of display DISPLAY.\n\
6550 The optional argument DISPLAY specifies which display to ask about.\n\
6551 DISPLAY should be either a frame or a display name (a string).\n\
6552 If omitted or nil, that stands for the selected frame's display.")
6554 Lisp_Object display
;
6556 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6558 return make_number (1);
6561 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
6562 "Returns the vendor ID string of the W32 system (Microsoft).\n\
6563 The optional argument DISPLAY specifies which display to ask about.\n\
6564 DISPLAY should be either a frame or a display name (a string).\n\
6565 If omitted or nil, that stands for the selected frame's display.")
6567 Lisp_Object display
;
6569 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6570 char *vendor
= "Microsoft Corp.";
6572 if (! vendor
) vendor
= "";
6573 return build_string (vendor
);
6576 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
6577 "Returns the version numbers of the server of display DISPLAY.\n\
6578 The value is a list of three integers: the major and minor\n\
6579 version numbers, and the vendor-specific release\n\
6580 number. See also the function `x-server-vendor'.\n\n\
6581 The optional argument DISPLAY specifies which display to ask about.\n\
6582 DISPLAY should be either a frame or a display name (a string).\n\
6583 If omitted or nil, that stands for the selected frame's display.")
6585 Lisp_Object display
;
6587 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6589 return Fcons (make_number (w32_major_version
),
6590 Fcons (make_number (w32_minor_version
), Qnil
));
6593 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
6594 "Returns the number of screens on the server of display DISPLAY.\n\
6595 The optional argument DISPLAY specifies which display to ask about.\n\
6596 DISPLAY should be either a frame or a display name (a string).\n\
6597 If omitted or nil, that stands for the selected frame's display.")
6599 Lisp_Object display
;
6601 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6603 return make_number (1);
6606 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
6607 "Returns the height in millimeters of the X display DISPLAY.\n\
6608 The optional argument DISPLAY specifies which display to ask about.\n\
6609 DISPLAY should be either a frame or a display name (a string).\n\
6610 If omitted or nil, that stands for the selected frame's display.")
6612 Lisp_Object display
;
6614 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6618 hdc
= GetDC (dpyinfo
->root_window
);
6620 cap
= GetDeviceCaps (hdc
, VERTSIZE
);
6622 ReleaseDC (dpyinfo
->root_window
, hdc
);
6624 return make_number (cap
);
6627 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
6628 "Returns the width in millimeters of the X display DISPLAY.\n\
6629 The optional argument DISPLAY specifies which display to ask about.\n\
6630 DISPLAY should be either a frame or a display name (a string).\n\
6631 If omitted or nil, that stands for the selected frame's display.")
6633 Lisp_Object display
;
6635 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6640 hdc
= GetDC (dpyinfo
->root_window
);
6642 cap
= GetDeviceCaps (hdc
, HORZSIZE
);
6644 ReleaseDC (dpyinfo
->root_window
, hdc
);
6646 return make_number (cap
);
6649 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
6650 Sx_display_backing_store
, 0, 1, 0,
6651 "Returns an indication of whether display DISPLAY does backing store.\n\
6652 The value may be `always', `when-mapped', or `not-useful'.\n\
6653 The optional argument DISPLAY specifies which display to ask about.\n\
6654 DISPLAY should be either a frame or a display name (a string).\n\
6655 If omitted or nil, that stands for the selected frame's display.")
6657 Lisp_Object display
;
6659 return intern ("not-useful");
6662 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
6663 Sx_display_visual_class
, 0, 1, 0,
6664 "Returns the visual class of the display DISPLAY.\n\
6665 The value is one of the symbols `static-gray', `gray-scale',\n\
6666 `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
6667 The optional argument DISPLAY specifies which display to ask about.\n\
6668 DISPLAY should be either a frame or a display name (a string).\n\
6669 If omitted or nil, that stands for the selected frame's display.")
6671 Lisp_Object display
;
6673 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6676 switch (dpyinfo
->visual
->class)
6678 case StaticGray
: return (intern ("static-gray"));
6679 case GrayScale
: return (intern ("gray-scale"));
6680 case StaticColor
: return (intern ("static-color"));
6681 case PseudoColor
: return (intern ("pseudo-color"));
6682 case TrueColor
: return (intern ("true-color"));
6683 case DirectColor
: return (intern ("direct-color"));
6685 error ("Display has an unknown visual class");
6689 error ("Display has an unknown visual class");
6692 DEFUN ("x-display-save-under", Fx_display_save_under
,
6693 Sx_display_save_under
, 0, 1, 0,
6694 "Returns t if the display DISPLAY supports the save-under feature.\n\
6695 The optional argument DISPLAY specifies which display to ask about.\n\
6696 DISPLAY should be either a frame or a display name (a string).\n\
6697 If omitted or nil, that stands for the selected frame's display.")
6699 Lisp_Object display
;
6701 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6708 register struct frame
*f
;
6710 return PIXEL_WIDTH (f
);
6715 register struct frame
*f
;
6717 return PIXEL_HEIGHT (f
);
6722 register struct frame
*f
;
6724 return FONT_WIDTH (f
->output_data
.w32
->font
);
6729 register struct frame
*f
;
6731 return f
->output_data
.w32
->line_height
;
6735 x_screen_planes (frame
)
6738 return (FRAME_W32_DISPLAY_INFO (XFRAME (frame
))->n_planes
*
6739 FRAME_W32_DISPLAY_INFO (XFRAME (frame
))->n_cbits
);
6742 /* Return the display structure for the display named NAME.
6743 Open a new connection if necessary. */
6745 struct w32_display_info
*
6746 x_display_info_for_name (name
)
6750 struct w32_display_info
*dpyinfo
;
6752 CHECK_STRING (name
, 0);
6754 for (dpyinfo
= &one_w32_display_info
, names
= w32_display_name_list
;
6756 dpyinfo
= dpyinfo
->next
, names
= XCONS (names
)->cdr
)
6759 tem
= Fstring_equal (XCONS (XCONS (names
)->car
)->car
, name
);
6764 /* Use this general default value to start with. */
6765 Vx_resource_name
= Vinvocation_name
;
6767 validate_x_resource_name ();
6769 dpyinfo
= w32_term_init (name
, (unsigned char *)0,
6770 (char *) XSTRING (Vx_resource_name
)->data
);
6773 error ("Cannot connect to server %s", XSTRING (name
)->data
);
6776 XSETFASTINT (Vwindow_system_version
, 3);
6781 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
6782 1, 3, 0, "Open a connection to a server.\n\
6783 DISPLAY is the name of the display to connect to.\n\
6784 Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
6785 If the optional third arg MUST-SUCCEED is non-nil,\n\
6786 terminate Emacs if we can't open the connection.")
6787 (display
, xrm_string
, must_succeed
)
6788 Lisp_Object display
, xrm_string
, must_succeed
;
6790 unsigned int n_planes
;
6791 unsigned char *xrm_option
;
6792 struct w32_display_info
*dpyinfo
;
6794 CHECK_STRING (display
, 0);
6795 if (! NILP (xrm_string
))
6796 CHECK_STRING (xrm_string
, 1);
6798 if (! EQ (Vwindow_system
, intern ("w32")))
6799 error ("Not using Microsoft Windows");
6801 /* Allow color mapping to be defined externally; first look in user's
6802 HOME directory, then in Emacs etc dir for a file called rgb.txt. */
6804 Lisp_Object color_file
;
6805 struct gcpro gcpro1
;
6807 color_file
= build_string("~/rgb.txt");
6809 GCPRO1 (color_file
);
6811 if (NILP (Ffile_readable_p (color_file
)))
6813 Fexpand_file_name (build_string ("rgb.txt"),
6814 Fsymbol_value (intern ("data-directory")));
6816 Vw32_color_map
= Fw32_load_color_file (color_file
);
6820 if (NILP (Vw32_color_map
))
6821 Vw32_color_map
= Fw32_default_color_map ();
6823 if (! NILP (xrm_string
))
6824 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
6826 xrm_option
= (unsigned char *) 0;
6828 /* Use this general default value to start with. */
6829 /* First remove .exe suffix from invocation-name - it looks ugly. */
6831 char basename
[ MAX_PATH
], *str
;
6833 strcpy (basename
, XSTRING (Vinvocation_name
)->data
);
6834 str
= strrchr (basename
, '.');
6836 Vinvocation_name
= build_string (basename
);
6838 Vx_resource_name
= Vinvocation_name
;
6840 validate_x_resource_name ();
6842 /* This is what opens the connection and sets x_current_display.
6843 This also initializes many symbols, such as those used for input. */
6844 dpyinfo
= w32_term_init (display
, xrm_option
,
6845 (char *) XSTRING (Vx_resource_name
)->data
);
6849 if (!NILP (must_succeed
))
6850 fatal ("Cannot connect to server %s.\n",
6851 XSTRING (display
)->data
);
6853 error ("Cannot connect to server %s", XSTRING (display
)->data
);
6858 XSETFASTINT (Vwindow_system_version
, 3);
6862 DEFUN ("x-close-connection", Fx_close_connection
,
6863 Sx_close_connection
, 1, 1, 0,
6864 "Close the connection to DISPLAY's server.\n\
6865 For DISPLAY, specify either a frame or a display name (a string).\n\
6866 If DISPLAY is nil, that stands for the selected frame's display.")
6868 Lisp_Object display
;
6870 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6871 struct w32_display_info
*tail
;
6874 if (dpyinfo
->reference_count
> 0)
6875 error ("Display still has frames on it");
6878 /* Free the fonts in the font table. */
6879 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
6881 if (dpyinfo
->font_table
[i
].name
)
6882 free (dpyinfo
->font_table
[i
].name
);
6883 /* Don't free the full_name string;
6884 it is always shared with something else. */
6885 w32_unload_font (dpyinfo
, dpyinfo
->font_table
[i
].font
);
6887 x_destroy_all_bitmaps (dpyinfo
);
6889 x_delete_display (dpyinfo
);
6895 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
6896 "Return the list of display names that Emacs has connections to.")
6899 Lisp_Object tail
, result
;
6902 for (tail
= w32_display_name_list
; ! NILP (tail
); tail
= XCONS (tail
)->cdr
)
6903 result
= Fcons (XCONS (XCONS (tail
)->car
)->car
, result
);
6908 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
6909 "If ON is non-nil, report errors as soon as the erring request is made.\n\
6910 If ON is nil, allow buffering of requests.\n\
6911 This is a noop on W32 systems.\n\
6912 The optional second argument DISPLAY specifies which display to act on.\n\
6913 DISPLAY should be either a frame or a display name (a string).\n\
6914 If DISPLAY is omitted or nil, that stands for the selected frame's display.")
6916 Lisp_Object display
, on
;
6918 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6924 /* These are the w32 specialized functions */
6926 DEFUN ("w32-select-font", Fw32_select_font
, Sw32_select_font
, 0, 1, 0,
6927 "This will display the W32 font dialog and return an X font string corresponding to the selection.")
6931 FRAME_PTR f
= check_x_frame (frame
);
6939 bzero (&cf
, sizeof (cf
));
6940 bzero (&lf
, sizeof (lf
));
6942 cf
.lStructSize
= sizeof (cf
);
6943 cf
.hwndOwner
= FRAME_W32_WINDOW (f
);
6944 cf
.Flags
= CF_FIXEDPITCHONLY
| CF_FORCEFONTEXIST
| CF_SCREENFONTS
;
6947 /* Initialize as much of the font details as we can from the current
6949 hdc
= GetDC (FRAME_W32_WINDOW (f
));
6950 oldobj
= SelectObject (hdc
, FRAME_FONT (f
)->hfont
);
6951 GetTextFace (hdc
, LF_FACESIZE
, lf
.lfFaceName
);
6952 if (GetTextMetrics (hdc
, &tm
))
6954 lf
.lfHeight
= tm
.tmInternalLeading
- tm
.tmHeight
;
6955 lf
.lfWeight
= tm
.tmWeight
;
6956 lf
.lfItalic
= tm
.tmItalic
;
6957 lf
.lfUnderline
= tm
.tmUnderlined
;
6958 lf
.lfStrikeOut
= tm
.tmStruckOut
;
6959 lf
.lfPitchAndFamily
= tm
.tmPitchAndFamily
;
6960 lf
.lfCharSet
= tm
.tmCharSet
;
6961 cf
.Flags
|= CF_INITTOLOGFONTSTRUCT
;
6963 SelectObject (hdc
, oldobj
);
6964 ReleaseDC (FRAME_W32_WINDOW(f
), hdc
);
6966 if (!ChooseFont (&cf
) || !w32_to_x_font (&lf
, buf
, 100))
6969 return build_string (buf
);
6972 DEFUN ("w32-send-sys-command", Fw32_send_sys_command
, Sw32_send_sys_command
, 1, 2, 0,
6973 "Send frame a Windows WM_SYSCOMMAND message of type COMMAND.\n\
6974 Some useful values for command are 0xf030 to maximise frame (0xf020\n\
6975 to minimize), 0xf120 to restore frame to original size, and 0xf100\n\
6976 to activate the menubar for keyboard access. 0xf140 activates the\n\
6977 screen saver if defined.\n\
6979 If optional parameter FRAME is not specified, use selected frame.")
6981 Lisp_Object command
, frame
;
6984 FRAME_PTR f
= check_x_frame (frame
);
6986 CHECK_NUMBER (command
, 0);
6988 SendMessage (FRAME_W32_WINDOW (f
), WM_SYSCOMMAND
, XINT (command
), 0);
6993 DEFUN ("w32-shell-execute", Fw32_shell_execute
, Sw32_shell_execute
, 2, 4, 0,
6994 "Get Windows to perform OPERATION on DOCUMENT.\n\
6995 This is a wrapper around the ShellExecute system function, which\n\
6996 invokes the application registered to handle OPERATION for DOCUMENT.\n\
6997 OPERATION is typically \"open\", \"print\" or \"explore\", and DOCUMENT\n\
6998 is typically the name of a document file or URL, but can also be a\n\
6999 program executable to run or a directory to open in the Windows Explorer.\n\
7001 If DOCUMENT is a program executable, PARAMETERS can be a list of command\n\
7002 line parameters, but otherwise should be nil.\n\
7004 SHOW-FLAG can be used to control whether the invoked application is hidden\n\
7005 or minimized. If SHOw-FLAG is nil, the application is displayed normally,\n\
7006 otherwise it is an integer representing a ShowWindow flag:\n\
7009 1 - start normally\n\
7010 3 - start maximized\n\
7011 6 - start minimized")
7012 (operation
, document
, parameters
, show_flag
)
7013 Lisp_Object operation
, document
, parameters
, show_flag
;
7015 Lisp_Object current_dir
;
7017 CHECK_STRING (operation
, 0);
7018 CHECK_STRING (document
, 0);
7020 /* Encode filename and current directory. */
7021 current_dir
= ENCODE_FILE (current_buffer
->directory
);
7022 document
= ENCODE_FILE (document
);
7023 if ((int) ShellExecute (NULL
,
7024 XSTRING (operation
)->data
,
7025 XSTRING (document
)->data
,
7026 (STRINGP (parameters
) ?
7027 XSTRING (parameters
)->data
: NULL
),
7028 XSTRING (current_dir
)->data
,
7029 (INTEGERP (show_flag
) ?
7030 XINT (show_flag
) : SW_SHOWDEFAULT
))
7033 error ("ShellExecute failed");
7036 /* Lookup virtual keycode from string representing the name of a
7037 non-ascii keystroke into the corresponding virtual key, using
7038 lispy_function_keys. */
7040 lookup_vk_code (char *key
)
7044 for (i
= 0; i
< 256; i
++)
7045 if (lispy_function_keys
[i
] != 0
7046 && strcmp (lispy_function_keys
[i
], key
) == 0)
7052 /* Convert a one-element vector style key sequence to a hot key
7055 w32_parse_hot_key (key
)
7058 /* Copied from Fdefine_key and store_in_keymap. */
7059 register Lisp_Object c
;
7063 struct gcpro gcpro1
;
7065 CHECK_VECTOR (key
, 0);
7067 if (XFASTINT (Flength (key
)) != 1)
7072 c
= Faref (key
, make_number (0));
7074 if (CONSP (c
) && lucid_event_type_list_p (c
))
7075 c
= Fevent_convert_list (c
);
7079 if (! INTEGERP (c
) && ! SYMBOLP (c
))
7080 error ("Key definition is invalid");
7082 /* Work out the base key and the modifiers. */
7085 c
= parse_modifiers (c
);
7086 lisp_modifiers
= Fcar (Fcdr (c
));
7090 vk_code
= lookup_vk_code (XSYMBOL (c
)->name
->data
);
7092 else if (INTEGERP (c
))
7094 lisp_modifiers
= XINT (c
) & ~CHARACTERBITS
;
7095 /* Many ascii characters are their own virtual key code. */
7096 vk_code
= XINT (c
) & CHARACTERBITS
;
7099 if (vk_code
< 0 || vk_code
> 255)
7102 if ((lisp_modifiers
& meta_modifier
) != 0
7103 && !NILP (Vw32_alt_is_meta
))
7104 lisp_modifiers
|= alt_modifier
;
7106 /* Convert lisp modifiers to Windows hot-key form. */
7107 w32_modifiers
= (lisp_modifiers
& hyper_modifier
) ? MOD_WIN
: 0;
7108 w32_modifiers
|= (lisp_modifiers
& alt_modifier
) ? MOD_ALT
: 0;
7109 w32_modifiers
|= (lisp_modifiers
& ctrl_modifier
) ? MOD_CONTROL
: 0;
7110 w32_modifiers
|= (lisp_modifiers
& shift_modifier
) ? MOD_SHIFT
: 0;
7112 return HOTKEY (vk_code
, w32_modifiers
);
7115 DEFUN ("w32-register-hot-key", Fw32_register_hot_key
, Sw32_register_hot_key
, 1, 1, 0,
7116 "Register KEY as a hot-key combination.\n\
7117 Certain key combinations like Alt-Tab are reserved for system use on\n\
7118 Windows, and therefore are normally intercepted by the system. However,\n\
7119 most of these key combinations can be received by registering them as\n\
7120 hot-keys, overriding their special meaning.\n\
7122 KEY must be a one element key definition in vector form that would be\n\
7123 acceptable to `define-key' (e.g. [A-tab] for Alt-Tab). The meta\n\
7124 modifier is interpreted as Alt if `w32-alt-is-meta' is t, and hyper\n\
7125 is always interpreted as the Windows modifier keys.\n\
7127 The return value is the hotkey-id if registered, otherwise nil.")
7131 key
= w32_parse_hot_key (key
);
7133 if (NILP (Fmemq (key
, w32_grabbed_keys
)))
7135 /* Reuse an empty slot if possible. */
7136 Lisp_Object item
= Fmemq (Qnil
, w32_grabbed_keys
);
7138 /* Safe to add new key to list, even if we have focus. */
7140 w32_grabbed_keys
= Fcons (key
, w32_grabbed_keys
);
7144 /* Notify input thread about new hot-key definition, so that it
7145 takes effect without needing to switch focus. */
7146 PostThreadMessage (dwWindowsThreadId
, WM_EMACS_REGISTER_HOT_KEY
,
7153 DEFUN ("w32-unregister-hot-key", Fw32_unregister_hot_key
, Sw32_unregister_hot_key
, 1, 1, 0,
7154 "Unregister HOTKEY as a hot-key combination.")
7160 if (!INTEGERP (key
))
7161 key
= w32_parse_hot_key (key
);
7163 item
= Fmemq (key
, w32_grabbed_keys
);
7167 /* Notify input thread about hot-key definition being removed, so
7168 that it takes effect without needing focus switch. */
7169 if (PostThreadMessage (dwWindowsThreadId
, WM_EMACS_UNREGISTER_HOT_KEY
,
7170 (WPARAM
) XINT (XCAR (item
)), (LPARAM
) item
))
7173 GetMessage (&msg
, NULL
, WM_EMACS_DONE
, WM_EMACS_DONE
);
7180 DEFUN ("w32-registered-hot-keys", Fw32_registered_hot_keys
, Sw32_registered_hot_keys
, 0, 0, 0,
7181 "Return list of registered hot-key IDs.")
7184 return Fcopy_sequence (w32_grabbed_keys
);
7187 DEFUN ("w32-reconstruct-hot-key", Fw32_reconstruct_hot_key
, Sw32_reconstruct_hot_key
, 1, 1, 0,
7188 "Convert hot-key ID to a lisp key combination.")
7190 Lisp_Object hotkeyid
;
7192 int vk_code
, w32_modifiers
;
7195 CHECK_NUMBER (hotkeyid
, 0);
7197 vk_code
= HOTKEY_VK_CODE (hotkeyid
);
7198 w32_modifiers
= HOTKEY_MODIFIERS (hotkeyid
);
7200 if (lispy_function_keys
[vk_code
])
7201 key
= intern (lispy_function_keys
[vk_code
]);
7203 key
= make_number (vk_code
);
7205 key
= Fcons (key
, Qnil
);
7206 if (w32_modifiers
& MOD_SHIFT
)
7207 key
= Fcons (Qshift
, key
);
7208 if (w32_modifiers
& MOD_CONTROL
)
7209 key
= Fcons (Qctrl
, key
);
7210 if (w32_modifiers
& MOD_ALT
)
7211 key
= Fcons (NILP (Vw32_alt_is_meta
) ? Qalt
: Qmeta
, key
);
7212 if (w32_modifiers
& MOD_WIN
)
7213 key
= Fcons (Qhyper
, key
);
7218 DEFUN ("w32-toggle-lock-key", Fw32_toggle_lock_key
, Sw32_toggle_lock_key
, 1, 2, 0,
7219 "Toggle the state of the lock key KEY.\n\
7220 KEY can be `capslock', `kp-numlock', or `scroll'.\n\
7221 If the optional parameter NEW-STATE is a number, then the state of KEY\n\
7222 is set to off if the low bit of NEW-STATE is zero, otherwise on.")
7224 Lisp_Object key
, new_state
;
7229 if (EQ (key
, intern ("capslock")))
7230 vk_code
= VK_CAPITAL
;
7231 else if (EQ (key
, intern ("kp-numlock")))
7232 vk_code
= VK_NUMLOCK
;
7233 else if (EQ (key
, intern ("scroll")))
7234 vk_code
= VK_SCROLL
;
7238 if (!dwWindowsThreadId
)
7239 return make_number (w32_console_toggle_lock_key (vk_code
, new_state
));
7241 if (PostThreadMessage (dwWindowsThreadId
, WM_EMACS_TOGGLE_LOCK_KEY
,
7242 (WPARAM
) vk_code
, (LPARAM
) new_state
))
7245 GetMessage (&msg
, NULL
, WM_EMACS_DONE
, WM_EMACS_DONE
);
7246 return make_number (msg
.wParam
);
7253 /* This is zero if not using MS-Windows. */
7256 /* The section below is built by the lisp expression at the top of the file,
7257 just above where these variables are declared. */
7258 /*&&& init symbols here &&&*/
7259 Qauto_raise
= intern ("auto-raise");
7260 staticpro (&Qauto_raise
);
7261 Qauto_lower
= intern ("auto-lower");
7262 staticpro (&Qauto_lower
);
7263 Qbackground_color
= intern ("background-color");
7264 staticpro (&Qbackground_color
);
7265 Qbar
= intern ("bar");
7267 Qborder_color
= intern ("border-color");
7268 staticpro (&Qborder_color
);
7269 Qborder_width
= intern ("border-width");
7270 staticpro (&Qborder_width
);
7271 Qbox
= intern ("box");
7273 Qcursor_color
= intern ("cursor-color");
7274 staticpro (&Qcursor_color
);
7275 Qcursor_type
= intern ("cursor-type");
7276 staticpro (&Qcursor_type
);
7277 Qforeground_color
= intern ("foreground-color");
7278 staticpro (&Qforeground_color
);
7279 Qgeometry
= intern ("geometry");
7280 staticpro (&Qgeometry
);
7281 Qicon_left
= intern ("icon-left");
7282 staticpro (&Qicon_left
);
7283 Qicon_top
= intern ("icon-top");
7284 staticpro (&Qicon_top
);
7285 Qicon_type
= intern ("icon-type");
7286 staticpro (&Qicon_type
);
7287 Qicon_name
= intern ("icon-name");
7288 staticpro (&Qicon_name
);
7289 Qinternal_border_width
= intern ("internal-border-width");
7290 staticpro (&Qinternal_border_width
);
7291 Qleft
= intern ("left");
7293 Qright
= intern ("right");
7294 staticpro (&Qright
);
7295 Qmouse_color
= intern ("mouse-color");
7296 staticpro (&Qmouse_color
);
7297 Qnone
= intern ("none");
7299 Qparent_id
= intern ("parent-id");
7300 staticpro (&Qparent_id
);
7301 Qscroll_bar_width
= intern ("scroll-bar-width");
7302 staticpro (&Qscroll_bar_width
);
7303 Qsuppress_icon
= intern ("suppress-icon");
7304 staticpro (&Qsuppress_icon
);
7305 Qtop
= intern ("top");
7307 Qundefined_color
= intern ("undefined-color");
7308 staticpro (&Qundefined_color
);
7309 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
7310 staticpro (&Qvertical_scroll_bars
);
7311 Qvisibility
= intern ("visibility");
7312 staticpro (&Qvisibility
);
7313 Qwindow_id
= intern ("window-id");
7314 staticpro (&Qwindow_id
);
7315 Qx_frame_parameter
= intern ("x-frame-parameter");
7316 staticpro (&Qx_frame_parameter
);
7317 Qx_resource_name
= intern ("x-resource-name");
7318 staticpro (&Qx_resource_name
);
7319 Quser_position
= intern ("user-position");
7320 staticpro (&Quser_position
);
7321 Quser_size
= intern ("user-size");
7322 staticpro (&Quser_size
);
7323 Qdisplay
= intern ("display");
7324 staticpro (&Qdisplay
);
7325 /* This is the end of symbol initialization. */
7327 Qhyper
= intern ("hyper");
7328 staticpro (&Qhyper
);
7329 Qsuper
= intern ("super");
7330 staticpro (&Qsuper
);
7331 Qmeta
= intern ("meta");
7333 Qalt
= intern ("alt");
7335 Qctrl
= intern ("ctrl");
7337 Qcontrol
= intern ("control");
7338 staticpro (&Qcontrol
);
7339 Qshift
= intern ("shift");
7340 staticpro (&Qshift
);
7342 Qface_set_after_frame_default
= intern ("face-set-after-frame-default");
7343 staticpro (&Qface_set_after_frame_default
);
7345 Fput (Qundefined_color
, Qerror_conditions
,
7346 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
7347 Fput (Qundefined_color
, Qerror_message
,
7348 build_string ("Undefined color"));
7350 staticpro (&w32_grabbed_keys
);
7351 w32_grabbed_keys
= Qnil
;
7353 DEFVAR_LISP ("w32-color-map", &Vw32_color_map
,
7354 "An array of color name mappings for windows.");
7355 Vw32_color_map
= Qnil
;
7357 DEFVAR_LISP ("w32-pass-alt-to-system", &Vw32_pass_alt_to_system
,
7358 "Non-nil if alt key presses are passed on to Windows.\n\
7359 When non-nil, for example, alt pressed and released and then space will\n\
7360 open the System menu. When nil, Emacs silently swallows alt key events.");
7361 Vw32_pass_alt_to_system
= Qnil
;
7363 DEFVAR_LISP ("w32-alt-is-meta", &Vw32_alt_is_meta
,
7364 "Non-nil if the alt key is to be considered the same as the meta key.\n\
7365 When nil, Emacs will translate the alt key to the Alt modifier, and not Meta.");
7366 Vw32_alt_is_meta
= Qt
;
7368 DEFVAR_INT ("w32-quit-key", &Vw32_quit_key
,
7369 "If non-zero, the virtual key code for an alternative quit key.");
7370 XSETINT (Vw32_quit_key
, 0);
7372 DEFVAR_LISP ("w32-pass-lwindow-to-system",
7373 &Vw32_pass_lwindow_to_system
,
7374 "Non-nil if the left \"Windows\" key is passed on to Windows.\n\
7375 When non-nil, the Start menu is opened by tapping the key.");
7376 Vw32_pass_lwindow_to_system
= Qt
;
7378 DEFVAR_LISP ("w32-pass-rwindow-to-system",
7379 &Vw32_pass_rwindow_to_system
,
7380 "Non-nil if the right \"Windows\" key is passed on to Windows.\n\
7381 When non-nil, the Start menu is opened by tapping the key.");
7382 Vw32_pass_rwindow_to_system
= Qt
;
7384 DEFVAR_INT ("w32-phantom-key-code",
7385 &Vw32_phantom_key_code
,
7386 "Virtual key code used to generate \"phantom\" key presses.\n\
7387 Value is a number between 0 and 255.\n\
7389 Phantom key presses are generated in order to stop the system from\n\
7390 acting on \"Windows\" key events when `w32-pass-lwindow-to-system' or\n\
7391 `w32-pass-rwindow-to-system' is nil.");
7392 Vw32_phantom_key_code
= VK_SPACE
;
7394 DEFVAR_LISP ("w32-enable-num-lock",
7395 &Vw32_enable_num_lock
,
7396 "Non-nil if Num Lock should act normally.\n\
7397 Set to nil to see Num Lock as the key `kp-numlock'.");
7398 Vw32_enable_num_lock
= Qt
;
7400 DEFVAR_LISP ("w32-enable-caps-lock",
7401 &Vw32_enable_caps_lock
,
7402 "Non-nil if Caps Lock should act normally.\n\
7403 Set to nil to see Caps Lock as the key `capslock'.");
7404 Vw32_enable_caps_lock
= Qt
;
7406 DEFVAR_LISP ("w32-scroll-lock-modifier",
7407 &Vw32_scroll_lock_modifier
,
7408 "Modifier to use for the Scroll Lock on state.\n\
7409 The value can be hyper, super, meta, alt, control or shift for the\n\
7410 respective modifier, or nil to see Scroll Lock as the key `scroll'.\n\
7411 Any other value will cause the key to be ignored.");
7412 Vw32_scroll_lock_modifier
= Qt
;
7414 DEFVAR_LISP ("w32-lwindow-modifier",
7415 &Vw32_lwindow_modifier
,
7416 "Modifier to use for the left \"Windows\" key.\n\
7417 The value can be hyper, super, meta, alt, control or shift for the\n\
7418 respective modifier, or nil to appear as the key `lwindow'.\n\
7419 Any other value will cause the key to be ignored.");
7420 Vw32_lwindow_modifier
= Qnil
;
7422 DEFVAR_LISP ("w32-rwindow-modifier",
7423 &Vw32_rwindow_modifier
,
7424 "Modifier to use for the right \"Windows\" key.\n\
7425 The value can be hyper, super, meta, alt, control or shift for the\n\
7426 respective modifier, or nil to appear as the key `rwindow'.\n\
7427 Any other value will cause the key to be ignored.");
7428 Vw32_rwindow_modifier
= Qnil
;
7430 DEFVAR_LISP ("w32-apps-modifier",
7431 &Vw32_apps_modifier
,
7432 "Modifier to use for the \"Apps\" key.\n\
7433 The value can be hyper, super, meta, alt, control or shift for the\n\
7434 respective modifier, or nil to appear as the key `apps'.\n\
7435 Any other value will cause the key to be ignored.");
7436 Vw32_apps_modifier
= Qnil
;
7438 DEFVAR_LISP ("w32-enable-italics", &Vw32_enable_italics
,
7439 "Non-nil enables selection of artificially italicized fonts.");
7440 Vw32_enable_italics
= Qnil
;
7442 DEFVAR_LISP ("w32-enable-palette", &Vw32_enable_palette
,
7443 "Non-nil enables Windows palette management to map colors exactly.");
7444 Vw32_enable_palette
= Qt
;
7446 DEFVAR_INT ("w32-mouse-button-tolerance",
7447 &Vw32_mouse_button_tolerance
,
7448 "Analogue of double click interval for faking middle mouse events.\n\
7449 The value is the minimum time in milliseconds that must elapse between\n\
7450 left/right button down events before they are considered distinct events.\n\
7451 If both mouse buttons are depressed within this interval, a middle mouse\n\
7452 button down event is generated instead.");
7453 XSETINT (Vw32_mouse_button_tolerance
, GetDoubleClickTime () / 2);
7455 DEFVAR_INT ("w32-mouse-move-interval",
7456 &Vw32_mouse_move_interval
,
7457 "Minimum interval between mouse move events.\n\
7458 The value is the minimum time in milliseconds that must elapse between\n\
7459 successive mouse move (or scroll bar drag) events before they are\n\
7460 reported as lisp events.");
7461 XSETINT (Vw32_mouse_move_interval
, 0);
7463 init_x_parm_symbols ();
7465 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path
,
7466 "List of directories to search for bitmap files for w32.");
7467 Vx_bitmap_file_path
= decode_env_path ((char *) 0, "PATH");
7469 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
7470 "The shape of the pointer when over text.\n\
7471 Changing the value does not affect existing frames\n\
7472 unless you set the mouse color.");
7473 Vx_pointer_shape
= Qnil
;
7475 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
7476 "The name Emacs uses to look up resources; for internal use only.\n\
7477 `x-get-resource' uses this as the first component of the instance name\n\
7478 when requesting resource values.\n\
7479 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
7480 was invoked, or to the value specified with the `-name' or `-rn'\n\
7481 switches, if present.");
7482 Vx_resource_name
= Qnil
;
7484 Vx_nontext_pointer_shape
= Qnil
;
7486 Vx_mode_pointer_shape
= Qnil
;
7488 DEFVAR_INT ("x-sensitive-text-pointer-shape",
7489 &Vx_sensitive_text_pointer_shape
,
7490 "The shape of the pointer when over mouse-sensitive text.\n\
7491 This variable takes effect when you create a new frame\n\
7492 or when you set the mouse color.");
7493 Vx_sensitive_text_pointer_shape
= Qnil
;
7495 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
7496 "A string indicating the foreground color of the cursor box.");
7497 Vx_cursor_fore_pixel
= Qnil
;
7499 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
7500 "Non-nil if no window manager is in use.\n\
7501 Emacs doesn't try to figure this out; this is always nil\n\
7502 unless you set it to something else.");
7503 /* We don't have any way to find this out, so set it to nil
7504 and maybe the user would like to set it to t. */
7505 Vx_no_window_manager
= Qnil
;
7507 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
7508 &Vx_pixel_size_width_font_regexp
,
7509 "Regexp matching a font name whose width is the same as `PIXEL_SIZE'.\n\
7511 Since Emacs gets width of a font matching with this regexp from\n\
7512 PIXEL_SIZE field of the name, font finding mechanism gets faster for\n\
7513 such a font. This is especially effective for such large fonts as\n\
7514 Chinese, Japanese, and Korean.");
7515 Vx_pixel_size_width_font_regexp
= Qnil
;
7517 DEFVAR_LISP ("w32-bdf-filename-alist",
7518 &Vw32_bdf_filename_alist
,
7519 "List of bdf fonts and their corresponding filenames.");
7520 Vw32_bdf_filename_alist
= Qnil
;
7522 DEFVAR_BOOL ("w32-strict-fontnames",
7523 &w32_strict_fontnames
,
7524 "Non-nil means only use fonts that are exact matches for those requested.\n\
7525 Default is nil, which allows old fontnames that are not XLFD compliant,\n\
7526 and allows third-party CJK display to work by specifying false charset\n\
7527 fields to trick Emacs into translating to Big5, SJIS etc.\n\
7528 Setting this to t will prevent wrong fonts being selected when\n\
7529 fontsets are automatically created.");
7530 w32_strict_fontnames
= 0;
7532 DEFVAR_LISP ("w32-system-coding-system",
7533 &Vw32_system_coding_system
,
7534 "Coding system used by Windows system functions, such as for font names.");
7535 Vw32_system_coding_system
= Qnil
;
7537 defsubr (&Sx_get_resource
);
7538 defsubr (&Sx_list_fonts
);
7539 defsubr (&Sx_display_color_p
);
7540 defsubr (&Sx_display_grayscale_p
);
7541 defsubr (&Sx_color_defined_p
);
7542 defsubr (&Sx_color_values
);
7543 defsubr (&Sx_server_max_request_size
);
7544 defsubr (&Sx_server_vendor
);
7545 defsubr (&Sx_server_version
);
7546 defsubr (&Sx_display_pixel_width
);
7547 defsubr (&Sx_display_pixel_height
);
7548 defsubr (&Sx_display_mm_width
);
7549 defsubr (&Sx_display_mm_height
);
7550 defsubr (&Sx_display_screens
);
7551 defsubr (&Sx_display_planes
);
7552 defsubr (&Sx_display_color_cells
);
7553 defsubr (&Sx_display_visual_class
);
7554 defsubr (&Sx_display_backing_store
);
7555 defsubr (&Sx_display_save_under
);
7556 defsubr (&Sx_parse_geometry
);
7557 defsubr (&Sx_create_frame
);
7558 defsubr (&Sx_open_connection
);
7559 defsubr (&Sx_close_connection
);
7560 defsubr (&Sx_display_list
);
7561 defsubr (&Sx_synchronize
);
7563 /* W32 specific functions */
7565 defsubr (&Sw32_focus_frame
);
7566 defsubr (&Sw32_select_font
);
7567 defsubr (&Sw32_define_rgb_color
);
7568 defsubr (&Sw32_default_color_map
);
7569 defsubr (&Sw32_load_color_file
);
7570 defsubr (&Sw32_send_sys_command
);
7571 defsubr (&Sw32_shell_execute
);
7572 defsubr (&Sw32_register_hot_key
);
7573 defsubr (&Sw32_unregister_hot_key
);
7574 defsubr (&Sw32_registered_hot_keys
);
7575 defsubr (&Sw32_reconstruct_hot_key
);
7576 defsubr (&Sw32_toggle_lock_key
);
7577 defsubr (&Sw32_find_bdf_fonts
);
7579 /* Setting callback functions for fontset handler. */
7580 get_font_info_func
= w32_get_font_info
;
7581 list_fonts_func
= w32_list_fonts
;
7582 load_font_func
= w32_load_font
;
7583 find_ccl_program_func
= w32_find_ccl_program
;
7584 query_font_func
= w32_query_font
;
7585 set_frame_fontset_func
= x_set_font
;
7586 check_window_system_func
= check_w32
;
7595 button
= MessageBox (NULL
,
7596 "A fatal error has occurred!\n\n"
7597 "Select Abort to exit, Retry to debug, Ignore to continue",
7598 "Emacs Abort Dialog",
7599 MB_ICONEXCLAMATION
| MB_TASKMODAL
7600 | MB_SETFOREGROUND
| MB_ABORTRETRYIGNORE
);
7615 /* For convenience when debugging. */
7619 return GetLastError ();