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 /* A flag to control whether we should only repaint if GetUpdateRect
150 indicates there is an update region. */
151 int w32_strict_painting
;
153 /* Evaluate this expression to rebuild the section of syms_of_w32fns
154 that initializes and staticpros the symbols declared below. Note
155 that Emacs 18 has a bug that keeps C-x C-e from being able to
156 evaluate this expression.
159 ;; Accumulate a list of the symbols we want to initialize from the
160 ;; declarations at the top of the file.
161 (goto-char (point-min))
162 (search-forward "/\*&&& symbols declared here &&&*\/\n")
164 (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)")
166 (cons (buffer-substring (match-beginning 1) (match-end 1))
169 (setq symbol-list (nreverse symbol-list))
170 ;; Delete the section of syms_of_... where we initialize the symbols.
171 (search-forward "\n /\*&&& init symbols here &&&*\/\n")
172 (let ((start (point)))
173 (while (looking-at "^ Q")
175 (kill-region start (point)))
176 ;; Write a new symbol initialization section.
178 (insert (format " %s = intern (\"" (car symbol-list)))
179 (let ((start (point)))
180 (insert (substring (car symbol-list) 1))
181 (subst-char-in-region start (point) ?_ ?-))
182 (insert (format "\");\n staticpro (&%s);\n" (car symbol-list)))
183 (setq symbol-list (cdr symbol-list)))))
187 /*&&& symbols declared here &&&*/
188 Lisp_Object Qauto_raise
;
189 Lisp_Object Qauto_lower
;
190 Lisp_Object Qbackground_color
;
192 Lisp_Object Qborder_color
;
193 Lisp_Object Qborder_width
;
195 Lisp_Object Qcursor_color
;
196 Lisp_Object Qcursor_type
;
197 Lisp_Object Qforeground_color
;
198 Lisp_Object Qgeometry
;
199 Lisp_Object Qicon_left
;
200 Lisp_Object Qicon_top
;
201 Lisp_Object Qicon_type
;
202 Lisp_Object Qicon_name
;
203 Lisp_Object Qinternal_border_width
;
206 Lisp_Object Qmouse_color
;
208 Lisp_Object Qparent_id
;
209 Lisp_Object Qscroll_bar_width
;
210 Lisp_Object Qsuppress_icon
;
212 Lisp_Object Qundefined_color
;
213 Lisp_Object Qvertical_scroll_bars
;
214 Lisp_Object Qvisibility
;
215 Lisp_Object Qwindow_id
;
216 Lisp_Object Qx_frame_parameter
;
217 Lisp_Object Qx_resource_name
;
218 Lisp_Object Quser_position
;
219 Lisp_Object Quser_size
;
220 Lisp_Object Qdisplay
;
227 Lisp_Object Qcontrol
;
230 /* State variables for emulating a three button mouse. */
235 static int button_state
= 0;
236 static W32Msg saved_mouse_button_msg
;
237 static unsigned mouse_button_timer
; /* non-zero when timer is active */
238 static W32Msg saved_mouse_move_msg
;
239 static unsigned mouse_move_timer
;
241 /* W95 mousewheel handler */
242 unsigned int msh_mousewheel
= 0;
244 #define MOUSE_BUTTON_ID 1
245 #define MOUSE_MOVE_ID 2
247 /* The below are defined in frame.c. */
248 extern Lisp_Object Qheight
, Qminibuffer
, Qname
, Qonly
, Qwidth
;
249 extern Lisp_Object Qunsplittable
, Qmenu_bar_lines
, Qbuffer_predicate
, Qtitle
;
251 extern Lisp_Object Vwindow_system_version
;
253 Lisp_Object Qface_set_after_frame_default
;
255 extern Lisp_Object last_mouse_scroll_bar
;
256 extern int last_mouse_scroll_bar_pos
;
258 /* From w32term.c. */
259 extern Lisp_Object Vw32_num_mouse_buttons
;
260 extern Lisp_Object Vw32_recognize_altgr
;
263 /* Error if we are not connected to MS-Windows. */
268 error ("MS-Windows not in use or not initialized");
271 /* Nonzero if we can use mouse menus.
272 You should not call this unless HAVE_MENUS is defined. */
280 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
281 and checking validity for W32. */
284 check_x_frame (frame
)
293 CHECK_LIVE_FRAME (frame
, 0);
296 if (! FRAME_W32_P (f
))
297 error ("non-w32 frame used");
301 /* Let the user specify an display with a frame.
302 nil stands for the selected frame--or, if that is not a w32 frame,
303 the first display on the list. */
305 static struct w32_display_info
*
306 check_x_display_info (frame
)
311 if (FRAME_W32_P (selected_frame
))
312 return FRAME_W32_DISPLAY_INFO (selected_frame
);
314 return &one_w32_display_info
;
316 else if (STRINGP (frame
))
317 return x_display_info_for_name (frame
);
322 CHECK_LIVE_FRAME (frame
, 0);
324 if (! FRAME_W32_P (f
))
325 error ("non-w32 frame used");
326 return FRAME_W32_DISPLAY_INFO (f
);
330 /* Return the Emacs frame-object corresponding to an w32 window.
331 It could be the frame's main window or an icon window. */
333 /* This function can be called during GC, so use GC_xxx type test macros. */
336 x_window_to_frame (dpyinfo
, wdesc
)
337 struct w32_display_info
*dpyinfo
;
340 Lisp_Object tail
, frame
;
343 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
345 frame
= XCONS (tail
)->car
;
346 if (!GC_FRAMEP (frame
))
349 if (f
->output_data
.nothing
== 1
350 || FRAME_W32_DISPLAY_INFO (f
) != dpyinfo
)
352 if (FRAME_W32_WINDOW (f
) == wdesc
)
360 /* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
361 id, which is just an int that this section returns. Bitmaps are
362 reference counted so they can be shared among frames.
364 Bitmap indices are guaranteed to be > 0, so a negative number can
365 be used to indicate no bitmap.
367 If you use x_create_bitmap_from_data, then you must keep track of
368 the bitmaps yourself. That is, creating a bitmap from the same
369 data more than once will not be caught. */
372 /* Functions to access the contents of a bitmap, given an id. */
375 x_bitmap_height (f
, id
)
379 return FRAME_W32_DISPLAY_INFO (f
)->bitmaps
[id
- 1].height
;
383 x_bitmap_width (f
, id
)
387 return FRAME_W32_DISPLAY_INFO (f
)->bitmaps
[id
- 1].width
;
391 x_bitmap_pixmap (f
, id
)
395 return (int) FRAME_W32_DISPLAY_INFO (f
)->bitmaps
[id
- 1].pixmap
;
399 /* Allocate a new bitmap record. Returns index of new record. */
402 x_allocate_bitmap_record (f
)
405 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
408 if (dpyinfo
->bitmaps
== NULL
)
410 dpyinfo
->bitmaps_size
= 10;
412 = (struct w32_bitmap_record
*) xmalloc (dpyinfo
->bitmaps_size
* sizeof (struct w32_bitmap_record
));
413 dpyinfo
->bitmaps_last
= 1;
417 if (dpyinfo
->bitmaps_last
< dpyinfo
->bitmaps_size
)
418 return ++dpyinfo
->bitmaps_last
;
420 for (i
= 0; i
< dpyinfo
->bitmaps_size
; ++i
)
421 if (dpyinfo
->bitmaps
[i
].refcount
== 0)
424 dpyinfo
->bitmaps_size
*= 2;
426 = (struct w32_bitmap_record
*) xrealloc (dpyinfo
->bitmaps
,
427 dpyinfo
->bitmaps_size
* sizeof (struct w32_bitmap_record
));
428 return ++dpyinfo
->bitmaps_last
;
431 /* Add one reference to the reference count of the bitmap with id ID. */
434 x_reference_bitmap (f
, id
)
438 ++FRAME_W32_DISPLAY_INFO (f
)->bitmaps
[id
- 1].refcount
;
441 /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
444 x_create_bitmap_from_data (f
, bits
, width
, height
)
447 unsigned int width
, height
;
449 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
453 bitmap
= CreateBitmap (width
, height
,
454 FRAME_W32_DISPLAY_INFO (XFRAME (frame
))->n_planes
,
455 FRAME_W32_DISPLAY_INFO (XFRAME (frame
))->n_cbits
,
461 id
= x_allocate_bitmap_record (f
);
462 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
463 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
464 dpyinfo
->bitmaps
[id
- 1].hinst
= NULL
;
465 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
466 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
467 dpyinfo
->bitmaps
[id
- 1].height
= height
;
468 dpyinfo
->bitmaps
[id
- 1].width
= width
;
473 /* Create bitmap from file FILE for frame F. */
476 x_create_bitmap_from_file (f
, file
)
482 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
483 unsigned int width
, height
;
485 int xhot
, yhot
, result
, id
;
491 /* Look for an existing bitmap with the same name. */
492 for (id
= 0; id
< dpyinfo
->bitmaps_last
; ++id
)
494 if (dpyinfo
->bitmaps
[id
].refcount
495 && dpyinfo
->bitmaps
[id
].file
496 && !strcmp (dpyinfo
->bitmaps
[id
].file
, (char *) XSTRING (file
)->data
))
498 ++dpyinfo
->bitmaps
[id
].refcount
;
503 /* Search bitmap-file-path for the file, if appropriate. */
504 fd
= openp (Vx_bitmap_file_path
, file
, "", &found
, 0);
507 /* LoadLibraryEx won't handle special files handled by Emacs handler. */
512 filename
= (char *) XSTRING (found
)->data
;
514 hinst
= LoadLibraryEx (filename
, NULL
, LOAD_LIBRARY_AS_DATAFILE
);
520 result
= XReadBitmapFile (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
521 filename
, &width
, &height
, &bitmap
, &xhot
, &yhot
);
522 if (result
!= BitmapSuccess
)
525 id
= x_allocate_bitmap_record (f
);
526 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
527 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
528 dpyinfo
->bitmaps
[id
- 1].file
= (char *) xmalloc (XSTRING (file
)->size
+ 1);
529 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
530 dpyinfo
->bitmaps
[id
- 1].height
= height
;
531 dpyinfo
->bitmaps
[id
- 1].width
= width
;
532 strcpy (dpyinfo
->bitmaps
[id
- 1].file
, XSTRING (file
)->data
);
538 /* Remove reference to bitmap with id number ID. */
541 x_destroy_bitmap (f
, id
)
545 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
549 --dpyinfo
->bitmaps
[id
- 1].refcount
;
550 if (dpyinfo
->bitmaps
[id
- 1].refcount
== 0)
553 DeleteObject (dpyinfo
->bitmaps
[id
- 1].pixmap
);
554 if (dpyinfo
->bitmaps
[id
- 1].file
)
556 free (dpyinfo
->bitmaps
[id
- 1].file
);
557 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
564 /* Free all the bitmaps for the display specified by DPYINFO. */
567 x_destroy_all_bitmaps (dpyinfo
)
568 struct w32_display_info
*dpyinfo
;
571 for (i
= 0; i
< dpyinfo
->bitmaps_last
; i
++)
572 if (dpyinfo
->bitmaps
[i
].refcount
> 0)
574 DeleteObject (dpyinfo
->bitmaps
[i
].pixmap
);
575 if (dpyinfo
->bitmaps
[i
].file
)
576 free (dpyinfo
->bitmaps
[i
].file
);
578 dpyinfo
->bitmaps_last
= 0;
581 /* Connect the frame-parameter names for W32 frames
582 to the ways of passing the parameter values to the window system.
584 The name of a parameter, as a Lisp symbol,
585 has an `x-frame-parameter' property which is an integer in Lisp
586 but can be interpreted as an `enum x_frame_parm' in C. */
590 X_PARM_FOREGROUND_COLOR
,
591 X_PARM_BACKGROUND_COLOR
,
598 X_PARM_INTERNAL_BORDER_WIDTH
,
602 X_PARM_VERT_SCROLL_BAR
,
604 X_PARM_MENU_BAR_LINES
608 struct x_frame_parm_table
611 void (*setter
)( /* struct frame *frame, Lisp_Object val, oldval */ );
614 void x_set_foreground_color ();
615 void x_set_background_color ();
616 void x_set_mouse_color ();
617 void x_set_cursor_color ();
618 void x_set_border_color ();
619 void x_set_cursor_type ();
620 void x_set_icon_type ();
621 void x_set_icon_name ();
623 void x_set_border_width ();
624 void x_set_internal_border_width ();
625 void x_explicitly_set_name ();
626 void x_set_autoraise ();
627 void x_set_autolower ();
628 void x_set_vertical_scroll_bars ();
629 void x_set_visibility ();
630 void x_set_menu_bar_lines ();
631 void x_set_scroll_bar_width ();
633 void x_set_unsplittable ();
635 static struct x_frame_parm_table x_frame_parms
[] =
637 "auto-raise", x_set_autoraise
,
638 "auto-lower", x_set_autolower
,
639 "background-color", x_set_background_color
,
640 "border-color", x_set_border_color
,
641 "border-width", x_set_border_width
,
642 "cursor-color", x_set_cursor_color
,
643 "cursor-type", x_set_cursor_type
,
645 "foreground-color", x_set_foreground_color
,
646 "icon-name", x_set_icon_name
,
647 "icon-type", x_set_icon_type
,
648 "internal-border-width", x_set_internal_border_width
,
649 "menu-bar-lines", x_set_menu_bar_lines
,
650 "mouse-color", x_set_mouse_color
,
651 "name", x_explicitly_set_name
,
652 "scroll-bar-width", x_set_scroll_bar_width
,
653 "title", x_set_title
,
654 "unsplittable", x_set_unsplittable
,
655 "vertical-scroll-bars", x_set_vertical_scroll_bars
,
656 "visibility", x_set_visibility
,
659 /* Attach the `x-frame-parameter' properties to
660 the Lisp symbol names of parameters relevant to W32. */
662 init_x_parm_symbols ()
666 for (i
= 0; i
< sizeof (x_frame_parms
) / sizeof (x_frame_parms
[0]); i
++)
667 Fput (intern (x_frame_parms
[i
].name
), Qx_frame_parameter
,
671 /* Change the parameters of FRAME as specified by ALIST.
672 If a parameter is not specially recognized, do nothing;
673 otherwise call the `x_set_...' function for that parameter. */
676 x_set_frame_parameters (f
, alist
)
682 /* If both of these parameters are present, it's more efficient to
683 set them both at once. So we wait until we've looked at the
684 entire list before we set them. */
688 Lisp_Object left
, top
;
690 /* Same with these. */
691 Lisp_Object icon_left
, icon_top
;
693 /* Record in these vectors all the parms specified. */
697 int left_no_change
= 0, top_no_change
= 0;
698 int icon_left_no_change
= 0, icon_top_no_change
= 0;
700 struct gcpro gcpro1
, gcpro2
;
703 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
706 parms
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
707 values
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
709 /* Extract parm names and values into those vectors. */
712 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
714 Lisp_Object elt
, prop
, val
;
717 parms
[i
] = Fcar (elt
);
718 values
[i
] = Fcdr (elt
);
722 /* TAIL and ALIST are not used again below here. */
725 GCPRO2 (*parms
, *values
);
729 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
730 because their values appear in VALUES and strings are not valid. */
731 top
= left
= Qunbound
;
732 icon_left
= icon_top
= Qunbound
;
734 /* Provide default values for HEIGHT and WIDTH. */
735 width
= FRAME_WIDTH (f
);
736 height
= FRAME_HEIGHT (f
);
738 /* Now process them in reverse of specified order. */
739 for (i
--; i
>= 0; i
--)
741 Lisp_Object prop
, val
;
746 if (EQ (prop
, Qwidth
) && NUMBERP (val
))
747 width
= XFASTINT (val
);
748 else if (EQ (prop
, Qheight
) && NUMBERP (val
))
749 height
= XFASTINT (val
);
750 else if (EQ (prop
, Qtop
))
752 else if (EQ (prop
, Qleft
))
754 else if (EQ (prop
, Qicon_top
))
756 else if (EQ (prop
, Qicon_left
))
760 register Lisp_Object param_index
, old_value
;
762 param_index
= Fget (prop
, Qx_frame_parameter
);
763 old_value
= get_frame_param (f
, prop
);
764 store_frame_param (f
, prop
, val
);
765 if (NATNUMP (param_index
)
766 && (XFASTINT (param_index
)
767 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
768 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
772 /* Don't die if just one of these was set. */
773 if (EQ (left
, Qunbound
))
776 if (f
->output_data
.w32
->left_pos
< 0)
777 left
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.w32
->left_pos
), Qnil
));
779 XSETINT (left
, f
->output_data
.w32
->left_pos
);
781 if (EQ (top
, Qunbound
))
784 if (f
->output_data
.w32
->top_pos
< 0)
785 top
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.w32
->top_pos
), Qnil
));
787 XSETINT (top
, f
->output_data
.w32
->top_pos
);
790 /* If one of the icon positions was not set, preserve or default it. */
791 if (EQ (icon_left
, Qunbound
) || ! INTEGERP (icon_left
))
793 icon_left_no_change
= 1;
794 icon_left
= Fcdr (Fassq (Qicon_left
, f
->param_alist
));
795 if (NILP (icon_left
))
796 XSETINT (icon_left
, 0);
798 if (EQ (icon_top
, Qunbound
) || ! INTEGERP (icon_top
))
800 icon_top_no_change
= 1;
801 icon_top
= Fcdr (Fassq (Qicon_top
, f
->param_alist
));
803 XSETINT (icon_top
, 0);
806 /* Don't set these parameters unless they've been explicitly
807 specified. The window might be mapped or resized while we're in
808 this function, and we don't want to override that unless the lisp
809 code has asked for it.
811 Don't set these parameters unless they actually differ from the
812 window's current parameters; the window may not actually exist
817 check_frame_size (f
, &height
, &width
);
819 XSETFRAME (frame
, f
);
821 if (XINT (width
) != FRAME_WIDTH (f
)
822 || XINT (height
) != FRAME_HEIGHT (f
))
823 Fset_frame_size (frame
, make_number (width
), make_number (height
));
825 if ((!NILP (left
) || !NILP (top
))
826 && ! (left_no_change
&& top_no_change
)
827 && ! (NUMBERP (left
) && XINT (left
) == f
->output_data
.w32
->left_pos
828 && NUMBERP (top
) && XINT (top
) == f
->output_data
.w32
->top_pos
))
833 /* Record the signs. */
834 f
->output_data
.w32
->size_hint_flags
&= ~ (XNegative
| YNegative
);
835 if (EQ (left
, Qminus
))
836 f
->output_data
.w32
->size_hint_flags
|= XNegative
;
837 else if (INTEGERP (left
))
839 leftpos
= XINT (left
);
841 f
->output_data
.w32
->size_hint_flags
|= XNegative
;
843 else if (CONSP (left
) && EQ (XCONS (left
)->car
, Qminus
)
844 && CONSP (XCONS (left
)->cdr
)
845 && INTEGERP (XCONS (XCONS (left
)->cdr
)->car
))
847 leftpos
= - XINT (XCONS (XCONS (left
)->cdr
)->car
);
848 f
->output_data
.w32
->size_hint_flags
|= XNegative
;
850 else if (CONSP (left
) && EQ (XCONS (left
)->car
, Qplus
)
851 && CONSP (XCONS (left
)->cdr
)
852 && INTEGERP (XCONS (XCONS (left
)->cdr
)->car
))
854 leftpos
= XINT (XCONS (XCONS (left
)->cdr
)->car
);
857 if (EQ (top
, Qminus
))
858 f
->output_data
.w32
->size_hint_flags
|= YNegative
;
859 else if (INTEGERP (top
))
863 f
->output_data
.w32
->size_hint_flags
|= YNegative
;
865 else if (CONSP (top
) && EQ (XCONS (top
)->car
, Qminus
)
866 && CONSP (XCONS (top
)->cdr
)
867 && INTEGERP (XCONS (XCONS (top
)->cdr
)->car
))
869 toppos
= - XINT (XCONS (XCONS (top
)->cdr
)->car
);
870 f
->output_data
.w32
->size_hint_flags
|= YNegative
;
872 else if (CONSP (top
) && EQ (XCONS (top
)->car
, Qplus
)
873 && CONSP (XCONS (top
)->cdr
)
874 && INTEGERP (XCONS (XCONS (top
)->cdr
)->car
))
876 toppos
= XINT (XCONS (XCONS (top
)->cdr
)->car
);
880 /* Store the numeric value of the position. */
881 f
->output_data
.w32
->top_pos
= toppos
;
882 f
->output_data
.w32
->left_pos
= leftpos
;
884 f
->output_data
.w32
->win_gravity
= NorthWestGravity
;
886 /* Actually set that position, and convert to absolute. */
887 x_set_offset (f
, leftpos
, toppos
, -1);
890 if ((!NILP (icon_left
) || !NILP (icon_top
))
891 && ! (icon_left_no_change
&& icon_top_no_change
))
892 x_wm_set_icon_position (f
, XINT (icon_left
), XINT (icon_top
));
898 /* Store the screen positions of frame F into XPTR and YPTR.
899 These are the positions of the containing window manager window,
900 not Emacs's own window. */
903 x_real_positions (f
, xptr
, yptr
)
912 GetClientRect(FRAME_W32_WINDOW(f
), &rect
);
913 AdjustWindowRect(&rect
, f
->output_data
.w32
->dwStyle
, FRAME_EXTERNAL_MENU_BAR(f
));
919 ClientToScreen (FRAME_W32_WINDOW(f
), &pt
);
925 /* Insert a description of internally-recorded parameters of frame X
926 into the parameter alist *ALISTPTR that is to be given to the user.
927 Only parameters that are specific to W32
928 and whose values are not correctly recorded in the frame's
929 param_alist need to be considered here. */
931 x_report_frame_params (f
, alistptr
)
933 Lisp_Object
*alistptr
;
938 /* Represent negative positions (off the top or left screen edge)
939 in a way that Fmodify_frame_parameters will understand correctly. */
940 XSETINT (tem
, f
->output_data
.w32
->left_pos
);
941 if (f
->output_data
.w32
->left_pos
>= 0)
942 store_in_alist (alistptr
, Qleft
, tem
);
944 store_in_alist (alistptr
, Qleft
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
946 XSETINT (tem
, f
->output_data
.w32
->top_pos
);
947 if (f
->output_data
.w32
->top_pos
>= 0)
948 store_in_alist (alistptr
, Qtop
, tem
);
950 store_in_alist (alistptr
, Qtop
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
952 store_in_alist (alistptr
, Qborder_width
,
953 make_number (f
->output_data
.w32
->border_width
));
954 store_in_alist (alistptr
, Qinternal_border_width
,
955 make_number (f
->output_data
.w32
->internal_border_width
));
956 sprintf (buf
, "%ld", (long) FRAME_W32_WINDOW (f
));
957 store_in_alist (alistptr
, Qwindow_id
,
959 store_in_alist (alistptr
, Qicon_name
, f
->icon_name
);
960 FRAME_SAMPLE_VISIBILITY (f
);
961 store_in_alist (alistptr
, Qvisibility
,
962 (FRAME_VISIBLE_P (f
) ? Qt
963 : FRAME_ICONIFIED_P (f
) ? Qicon
: Qnil
));
964 store_in_alist (alistptr
, Qdisplay
,
965 XCONS (FRAME_W32_DISPLAY_INFO (f
)->name_list_element
)->car
);
969 DEFUN ("w32-define-rgb-color", Fw32_define_rgb_color
, Sw32_define_rgb_color
, 4, 4, 0,
970 "Convert RGB numbers to a windows color reference and associate with NAME (a string).\n\
971 This adds or updates a named color to w32-color-map, making it available for use.\n\
972 The original entry's RGB ref is returned, or nil if the entry is new.")
973 (red
, green
, blue
, name
)
974 Lisp_Object red
, green
, blue
, name
;
977 Lisp_Object oldrgb
= Qnil
;
980 CHECK_NUMBER (red
, 0);
981 CHECK_NUMBER (green
, 0);
982 CHECK_NUMBER (blue
, 0);
983 CHECK_STRING (name
, 0);
985 XSET (rgb
, Lisp_Int
, RGB(XUINT (red
), XUINT (green
), XUINT (blue
)));
989 /* replace existing entry in w32-color-map or add new entry. */
990 entry
= Fassoc (name
, Vw32_color_map
);
993 entry
= Fcons (name
, rgb
);
994 Vw32_color_map
= Fcons (entry
, Vw32_color_map
);
998 oldrgb
= Fcdr (entry
);
999 Fsetcdr (entry
, rgb
);
1007 DEFUN ("w32-load-color-file", Fw32_load_color_file
, Sw32_load_color_file
, 1, 1, 0,
1008 "Create an alist of color entries from an external file (ie. rgb.txt).\n\
1009 Assign this value to w32-color-map to replace the existing color map.\n\
1011 The file should define one named RGB color per line like so:\
1013 where R,G,B are numbers between 0 and 255 and name is an arbitrary string.")
1015 Lisp_Object filename
;
1018 Lisp_Object cmap
= Qnil
;
1019 Lisp_Object abspath
;
1021 CHECK_STRING (filename
, 0);
1022 abspath
= Fexpand_file_name (filename
, Qnil
);
1024 fp
= fopen (XSTRING (filename
)->data
, "rt");
1028 int red
, green
, blue
;
1033 while (fgets (buf
, sizeof (buf
), fp
) != NULL
) {
1034 if (sscanf (buf
, "%u %u %u %n", &red
, &green
, &blue
, &num
) == 3)
1036 char *name
= buf
+ num
;
1037 num
= strlen (name
) - 1;
1038 if (name
[num
] == '\n')
1040 cmap
= Fcons (Fcons (build_string (name
),
1041 make_number (RGB (red
, green
, blue
))),
1053 /* The default colors for the w32 color map */
1054 typedef struct colormap_t
1060 colormap_t w32_color_map
[] =
1062 {"snow" , PALETTERGB (255,250,250)},
1063 {"ghost white" , PALETTERGB (248,248,255)},
1064 {"GhostWhite" , PALETTERGB (248,248,255)},
1065 {"white smoke" , PALETTERGB (245,245,245)},
1066 {"WhiteSmoke" , PALETTERGB (245,245,245)},
1067 {"gainsboro" , PALETTERGB (220,220,220)},
1068 {"floral white" , PALETTERGB (255,250,240)},
1069 {"FloralWhite" , PALETTERGB (255,250,240)},
1070 {"old lace" , PALETTERGB (253,245,230)},
1071 {"OldLace" , PALETTERGB (253,245,230)},
1072 {"linen" , PALETTERGB (250,240,230)},
1073 {"antique white" , PALETTERGB (250,235,215)},
1074 {"AntiqueWhite" , PALETTERGB (250,235,215)},
1075 {"papaya whip" , PALETTERGB (255,239,213)},
1076 {"PapayaWhip" , PALETTERGB (255,239,213)},
1077 {"blanched almond" , PALETTERGB (255,235,205)},
1078 {"BlanchedAlmond" , PALETTERGB (255,235,205)},
1079 {"bisque" , PALETTERGB (255,228,196)},
1080 {"peach puff" , PALETTERGB (255,218,185)},
1081 {"PeachPuff" , PALETTERGB (255,218,185)},
1082 {"navajo white" , PALETTERGB (255,222,173)},
1083 {"NavajoWhite" , PALETTERGB (255,222,173)},
1084 {"moccasin" , PALETTERGB (255,228,181)},
1085 {"cornsilk" , PALETTERGB (255,248,220)},
1086 {"ivory" , PALETTERGB (255,255,240)},
1087 {"lemon chiffon" , PALETTERGB (255,250,205)},
1088 {"LemonChiffon" , PALETTERGB (255,250,205)},
1089 {"seashell" , PALETTERGB (255,245,238)},
1090 {"honeydew" , PALETTERGB (240,255,240)},
1091 {"mint cream" , PALETTERGB (245,255,250)},
1092 {"MintCream" , PALETTERGB (245,255,250)},
1093 {"azure" , PALETTERGB (240,255,255)},
1094 {"alice blue" , PALETTERGB (240,248,255)},
1095 {"AliceBlue" , PALETTERGB (240,248,255)},
1096 {"lavender" , PALETTERGB (230,230,250)},
1097 {"lavender blush" , PALETTERGB (255,240,245)},
1098 {"LavenderBlush" , PALETTERGB (255,240,245)},
1099 {"misty rose" , PALETTERGB (255,228,225)},
1100 {"MistyRose" , PALETTERGB (255,228,225)},
1101 {"white" , PALETTERGB (255,255,255)},
1102 {"black" , PALETTERGB ( 0, 0, 0)},
1103 {"dark slate gray" , PALETTERGB ( 47, 79, 79)},
1104 {"DarkSlateGray" , PALETTERGB ( 47, 79, 79)},
1105 {"dark slate grey" , PALETTERGB ( 47, 79, 79)},
1106 {"DarkSlateGrey" , PALETTERGB ( 47, 79, 79)},
1107 {"dim gray" , PALETTERGB (105,105,105)},
1108 {"DimGray" , PALETTERGB (105,105,105)},
1109 {"dim grey" , PALETTERGB (105,105,105)},
1110 {"DimGrey" , PALETTERGB (105,105,105)},
1111 {"slate gray" , PALETTERGB (112,128,144)},
1112 {"SlateGray" , PALETTERGB (112,128,144)},
1113 {"slate grey" , PALETTERGB (112,128,144)},
1114 {"SlateGrey" , PALETTERGB (112,128,144)},
1115 {"light slate gray" , PALETTERGB (119,136,153)},
1116 {"LightSlateGray" , PALETTERGB (119,136,153)},
1117 {"light slate grey" , PALETTERGB (119,136,153)},
1118 {"LightSlateGrey" , PALETTERGB (119,136,153)},
1119 {"gray" , PALETTERGB (190,190,190)},
1120 {"grey" , PALETTERGB (190,190,190)},
1121 {"light grey" , PALETTERGB (211,211,211)},
1122 {"LightGrey" , PALETTERGB (211,211,211)},
1123 {"light gray" , PALETTERGB (211,211,211)},
1124 {"LightGray" , PALETTERGB (211,211,211)},
1125 {"midnight blue" , PALETTERGB ( 25, 25,112)},
1126 {"MidnightBlue" , PALETTERGB ( 25, 25,112)},
1127 {"navy" , PALETTERGB ( 0, 0,128)},
1128 {"navy blue" , PALETTERGB ( 0, 0,128)},
1129 {"NavyBlue" , PALETTERGB ( 0, 0,128)},
1130 {"cornflower blue" , PALETTERGB (100,149,237)},
1131 {"CornflowerBlue" , PALETTERGB (100,149,237)},
1132 {"dark slate blue" , PALETTERGB ( 72, 61,139)},
1133 {"DarkSlateBlue" , PALETTERGB ( 72, 61,139)},
1134 {"slate blue" , PALETTERGB (106, 90,205)},
1135 {"SlateBlue" , PALETTERGB (106, 90,205)},
1136 {"medium slate blue" , PALETTERGB (123,104,238)},
1137 {"MediumSlateBlue" , PALETTERGB (123,104,238)},
1138 {"light slate blue" , PALETTERGB (132,112,255)},
1139 {"LightSlateBlue" , PALETTERGB (132,112,255)},
1140 {"medium blue" , PALETTERGB ( 0, 0,205)},
1141 {"MediumBlue" , PALETTERGB ( 0, 0,205)},
1142 {"royal blue" , PALETTERGB ( 65,105,225)},
1143 {"RoyalBlue" , PALETTERGB ( 65,105,225)},
1144 {"blue" , PALETTERGB ( 0, 0,255)},
1145 {"dodger blue" , PALETTERGB ( 30,144,255)},
1146 {"DodgerBlue" , PALETTERGB ( 30,144,255)},
1147 {"deep sky blue" , PALETTERGB ( 0,191,255)},
1148 {"DeepSkyBlue" , PALETTERGB ( 0,191,255)},
1149 {"sky blue" , PALETTERGB (135,206,235)},
1150 {"SkyBlue" , PALETTERGB (135,206,235)},
1151 {"light sky blue" , PALETTERGB (135,206,250)},
1152 {"LightSkyBlue" , PALETTERGB (135,206,250)},
1153 {"steel blue" , PALETTERGB ( 70,130,180)},
1154 {"SteelBlue" , PALETTERGB ( 70,130,180)},
1155 {"light steel blue" , PALETTERGB (176,196,222)},
1156 {"LightSteelBlue" , PALETTERGB (176,196,222)},
1157 {"light blue" , PALETTERGB (173,216,230)},
1158 {"LightBlue" , PALETTERGB (173,216,230)},
1159 {"powder blue" , PALETTERGB (176,224,230)},
1160 {"PowderBlue" , PALETTERGB (176,224,230)},
1161 {"pale turquoise" , PALETTERGB (175,238,238)},
1162 {"PaleTurquoise" , PALETTERGB (175,238,238)},
1163 {"dark turquoise" , PALETTERGB ( 0,206,209)},
1164 {"DarkTurquoise" , PALETTERGB ( 0,206,209)},
1165 {"medium turquoise" , PALETTERGB ( 72,209,204)},
1166 {"MediumTurquoise" , PALETTERGB ( 72,209,204)},
1167 {"turquoise" , PALETTERGB ( 64,224,208)},
1168 {"cyan" , PALETTERGB ( 0,255,255)},
1169 {"light cyan" , PALETTERGB (224,255,255)},
1170 {"LightCyan" , PALETTERGB (224,255,255)},
1171 {"cadet blue" , PALETTERGB ( 95,158,160)},
1172 {"CadetBlue" , PALETTERGB ( 95,158,160)},
1173 {"medium aquamarine" , PALETTERGB (102,205,170)},
1174 {"MediumAquamarine" , PALETTERGB (102,205,170)},
1175 {"aquamarine" , PALETTERGB (127,255,212)},
1176 {"dark green" , PALETTERGB ( 0,100, 0)},
1177 {"DarkGreen" , PALETTERGB ( 0,100, 0)},
1178 {"dark olive green" , PALETTERGB ( 85,107, 47)},
1179 {"DarkOliveGreen" , PALETTERGB ( 85,107, 47)},
1180 {"dark sea green" , PALETTERGB (143,188,143)},
1181 {"DarkSeaGreen" , PALETTERGB (143,188,143)},
1182 {"sea green" , PALETTERGB ( 46,139, 87)},
1183 {"SeaGreen" , PALETTERGB ( 46,139, 87)},
1184 {"medium sea green" , PALETTERGB ( 60,179,113)},
1185 {"MediumSeaGreen" , PALETTERGB ( 60,179,113)},
1186 {"light sea green" , PALETTERGB ( 32,178,170)},
1187 {"LightSeaGreen" , PALETTERGB ( 32,178,170)},
1188 {"pale green" , PALETTERGB (152,251,152)},
1189 {"PaleGreen" , PALETTERGB (152,251,152)},
1190 {"spring green" , PALETTERGB ( 0,255,127)},
1191 {"SpringGreen" , PALETTERGB ( 0,255,127)},
1192 {"lawn green" , PALETTERGB (124,252, 0)},
1193 {"LawnGreen" , PALETTERGB (124,252, 0)},
1194 {"green" , PALETTERGB ( 0,255, 0)},
1195 {"chartreuse" , PALETTERGB (127,255, 0)},
1196 {"medium spring green" , PALETTERGB ( 0,250,154)},
1197 {"MediumSpringGreen" , PALETTERGB ( 0,250,154)},
1198 {"green yellow" , PALETTERGB (173,255, 47)},
1199 {"GreenYellow" , PALETTERGB (173,255, 47)},
1200 {"lime green" , PALETTERGB ( 50,205, 50)},
1201 {"LimeGreen" , PALETTERGB ( 50,205, 50)},
1202 {"yellow green" , PALETTERGB (154,205, 50)},
1203 {"YellowGreen" , PALETTERGB (154,205, 50)},
1204 {"forest green" , PALETTERGB ( 34,139, 34)},
1205 {"ForestGreen" , PALETTERGB ( 34,139, 34)},
1206 {"olive drab" , PALETTERGB (107,142, 35)},
1207 {"OliveDrab" , PALETTERGB (107,142, 35)},
1208 {"dark khaki" , PALETTERGB (189,183,107)},
1209 {"DarkKhaki" , PALETTERGB (189,183,107)},
1210 {"khaki" , PALETTERGB (240,230,140)},
1211 {"pale goldenrod" , PALETTERGB (238,232,170)},
1212 {"PaleGoldenrod" , PALETTERGB (238,232,170)},
1213 {"light goldenrod yellow" , PALETTERGB (250,250,210)},
1214 {"LightGoldenrodYellow" , PALETTERGB (250,250,210)},
1215 {"light yellow" , PALETTERGB (255,255,224)},
1216 {"LightYellow" , PALETTERGB (255,255,224)},
1217 {"yellow" , PALETTERGB (255,255, 0)},
1218 {"gold" , PALETTERGB (255,215, 0)},
1219 {"light goldenrod" , PALETTERGB (238,221,130)},
1220 {"LightGoldenrod" , PALETTERGB (238,221,130)},
1221 {"goldenrod" , PALETTERGB (218,165, 32)},
1222 {"dark goldenrod" , PALETTERGB (184,134, 11)},
1223 {"DarkGoldenrod" , PALETTERGB (184,134, 11)},
1224 {"rosy brown" , PALETTERGB (188,143,143)},
1225 {"RosyBrown" , PALETTERGB (188,143,143)},
1226 {"indian red" , PALETTERGB (205, 92, 92)},
1227 {"IndianRed" , PALETTERGB (205, 92, 92)},
1228 {"saddle brown" , PALETTERGB (139, 69, 19)},
1229 {"SaddleBrown" , PALETTERGB (139, 69, 19)},
1230 {"sienna" , PALETTERGB (160, 82, 45)},
1231 {"peru" , PALETTERGB (205,133, 63)},
1232 {"burlywood" , PALETTERGB (222,184,135)},
1233 {"beige" , PALETTERGB (245,245,220)},
1234 {"wheat" , PALETTERGB (245,222,179)},
1235 {"sandy brown" , PALETTERGB (244,164, 96)},
1236 {"SandyBrown" , PALETTERGB (244,164, 96)},
1237 {"tan" , PALETTERGB (210,180,140)},
1238 {"chocolate" , PALETTERGB (210,105, 30)},
1239 {"firebrick" , PALETTERGB (178,34, 34)},
1240 {"brown" , PALETTERGB (165,42, 42)},
1241 {"dark salmon" , PALETTERGB (233,150,122)},
1242 {"DarkSalmon" , PALETTERGB (233,150,122)},
1243 {"salmon" , PALETTERGB (250,128,114)},
1244 {"light salmon" , PALETTERGB (255,160,122)},
1245 {"LightSalmon" , PALETTERGB (255,160,122)},
1246 {"orange" , PALETTERGB (255,165, 0)},
1247 {"dark orange" , PALETTERGB (255,140, 0)},
1248 {"DarkOrange" , PALETTERGB (255,140, 0)},
1249 {"coral" , PALETTERGB (255,127, 80)},
1250 {"light coral" , PALETTERGB (240,128,128)},
1251 {"LightCoral" , PALETTERGB (240,128,128)},
1252 {"tomato" , PALETTERGB (255, 99, 71)},
1253 {"orange red" , PALETTERGB (255, 69, 0)},
1254 {"OrangeRed" , PALETTERGB (255, 69, 0)},
1255 {"red" , PALETTERGB (255, 0, 0)},
1256 {"hot pink" , PALETTERGB (255,105,180)},
1257 {"HotPink" , PALETTERGB (255,105,180)},
1258 {"deep pink" , PALETTERGB (255, 20,147)},
1259 {"DeepPink" , PALETTERGB (255, 20,147)},
1260 {"pink" , PALETTERGB (255,192,203)},
1261 {"light pink" , PALETTERGB (255,182,193)},
1262 {"LightPink" , PALETTERGB (255,182,193)},
1263 {"pale violet red" , PALETTERGB (219,112,147)},
1264 {"PaleVioletRed" , PALETTERGB (219,112,147)},
1265 {"maroon" , PALETTERGB (176, 48, 96)},
1266 {"medium violet red" , PALETTERGB (199, 21,133)},
1267 {"MediumVioletRed" , PALETTERGB (199, 21,133)},
1268 {"violet red" , PALETTERGB (208, 32,144)},
1269 {"VioletRed" , PALETTERGB (208, 32,144)},
1270 {"magenta" , PALETTERGB (255, 0,255)},
1271 {"violet" , PALETTERGB (238,130,238)},
1272 {"plum" , PALETTERGB (221,160,221)},
1273 {"orchid" , PALETTERGB (218,112,214)},
1274 {"medium orchid" , PALETTERGB (186, 85,211)},
1275 {"MediumOrchid" , PALETTERGB (186, 85,211)},
1276 {"dark orchid" , PALETTERGB (153, 50,204)},
1277 {"DarkOrchid" , PALETTERGB (153, 50,204)},
1278 {"dark violet" , PALETTERGB (148, 0,211)},
1279 {"DarkViolet" , PALETTERGB (148, 0,211)},
1280 {"blue violet" , PALETTERGB (138, 43,226)},
1281 {"BlueViolet" , PALETTERGB (138, 43,226)},
1282 {"purple" , PALETTERGB (160, 32,240)},
1283 {"medium purple" , PALETTERGB (147,112,219)},
1284 {"MediumPurple" , PALETTERGB (147,112,219)},
1285 {"thistle" , PALETTERGB (216,191,216)},
1286 {"gray0" , PALETTERGB ( 0, 0, 0)},
1287 {"grey0" , PALETTERGB ( 0, 0, 0)},
1288 {"dark grey" , PALETTERGB (169,169,169)},
1289 {"DarkGrey" , PALETTERGB (169,169,169)},
1290 {"dark gray" , PALETTERGB (169,169,169)},
1291 {"DarkGray" , PALETTERGB (169,169,169)},
1292 {"dark blue" , PALETTERGB ( 0, 0,139)},
1293 {"DarkBlue" , PALETTERGB ( 0, 0,139)},
1294 {"dark cyan" , PALETTERGB ( 0,139,139)},
1295 {"DarkCyan" , PALETTERGB ( 0,139,139)},
1296 {"dark magenta" , PALETTERGB (139, 0,139)},
1297 {"DarkMagenta" , PALETTERGB (139, 0,139)},
1298 {"dark red" , PALETTERGB (139, 0, 0)},
1299 {"DarkRed" , PALETTERGB (139, 0, 0)},
1300 {"light green" , PALETTERGB (144,238,144)},
1301 {"LightGreen" , PALETTERGB (144,238,144)},
1304 DEFUN ("w32-default-color-map", Fw32_default_color_map
, Sw32_default_color_map
,
1305 0, 0, 0, "Return the default color map.")
1309 colormap_t
*pc
= w32_color_map
;
1316 for (i
= 0; i
< sizeof (w32_color_map
) / sizeof (w32_color_map
[0]);
1318 cmap
= Fcons (Fcons (build_string (pc
->name
),
1319 make_number (pc
->colorref
)),
1328 w32_to_x_color (rgb
)
1333 CHECK_NUMBER (rgb
, 0);
1337 color
= Frassq (rgb
, Vw32_color_map
);
1342 return (Fcar (color
));
1348 w32_color_map_lookup (colorname
)
1351 Lisp_Object tail
, ret
= Qnil
;
1355 for (tail
= Vw32_color_map
; !NILP (tail
); tail
= Fcdr (tail
))
1357 register Lisp_Object elt
, tem
;
1360 if (!CONSP (elt
)) continue;
1364 if (lstrcmpi (XSTRING (tem
)->data
, colorname
) == 0)
1366 ret
= XUINT (Fcdr (elt
));
1380 x_to_w32_color (colorname
)
1383 register Lisp_Object tail
, ret
= Qnil
;
1387 if (colorname
[0] == '#')
1389 /* Could be an old-style RGB Device specification. */
1392 color
= colorname
+ 1;
1394 size
= strlen(color
);
1395 if (size
== 3 || size
== 6 || size
== 9 || size
== 12)
1403 for (i
= 0; i
< 3; i
++)
1407 unsigned long value
;
1409 /* The check for 'x' in the following conditional takes into
1410 account the fact that strtol allows a "0x" in front of
1411 our numbers, and we don't. */
1412 if (!isxdigit(color
[0]) || color
[1] == 'x')
1416 value
= strtoul(color
, &end
, 16);
1418 if (errno
== ERANGE
|| end
- color
!= size
)
1423 value
= value
* 0x10;
1434 colorval
|= (value
<< pos
);
1445 else if (strnicmp(colorname
, "rgb:", 4) == 0)
1453 color
= colorname
+ 4;
1454 for (i
= 0; i
< 3; i
++)
1457 unsigned long value
;
1459 /* The check for 'x' in the following conditional takes into
1460 account the fact that strtol allows a "0x" in front of
1461 our numbers, and we don't. */
1462 if (!isxdigit(color
[0]) || color
[1] == 'x')
1464 value
= strtoul(color
, &end
, 16);
1465 if (errno
== ERANGE
)
1467 switch (end
- color
)
1470 value
= value
* 0x10 + value
;
1483 if (value
== ULONG_MAX
)
1485 colorval
|= (value
<< pos
);
1499 else if (strnicmp(colorname
, "rgbi:", 5) == 0)
1501 /* This is an RGB Intensity specification. */
1508 color
= colorname
+ 5;
1509 for (i
= 0; i
< 3; i
++)
1515 value
= strtod(color
, &end
);
1516 if (errno
== ERANGE
)
1518 if (value
< 0.0 || value
> 1.0)
1520 val
= (UINT
)(0x100 * value
);
1521 /* We used 0x100 instead of 0xFF to give an continuous
1522 range between 0.0 and 1.0 inclusive. The next statement
1523 fixes the 1.0 case. */
1526 colorval
|= (val
<< pos
);
1540 /* I am not going to attempt to handle any of the CIE color schemes
1541 or TekHVC, since I don't know the algorithms for conversion to
1544 /* If we fail to lookup the color name in w32_color_map, then check the
1545 colorname to see if it can be crudely approximated: If the X color
1546 ends in a number (e.g., "darkseagreen2"), strip the number and
1547 return the result of looking up the base color name. */
1548 ret
= w32_color_map_lookup (colorname
);
1551 int len
= strlen (colorname
);
1553 if (isdigit (colorname
[len
- 1]))
1555 char *ptr
, *approx
= alloca (len
);
1557 strcpy (approx
, colorname
);
1558 ptr
= &approx
[len
- 1];
1559 while (ptr
> approx
&& isdigit (*ptr
))
1562 ret
= w32_color_map_lookup (approx
);
1572 w32_regenerate_palette (FRAME_PTR f
)
1574 struct w32_palette_entry
* list
;
1575 LOGPALETTE
* log_palette
;
1576 HPALETTE new_palette
;
1579 /* don't bother trying to create palette if not supported */
1580 if (! FRAME_W32_DISPLAY_INFO (f
)->has_palette
)
1583 log_palette
= (LOGPALETTE
*)
1584 alloca (sizeof (LOGPALETTE
) +
1585 FRAME_W32_DISPLAY_INFO (f
)->num_colors
* sizeof (PALETTEENTRY
));
1586 log_palette
->palVersion
= 0x300;
1587 log_palette
->palNumEntries
= FRAME_W32_DISPLAY_INFO (f
)->num_colors
;
1589 list
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1591 i
< FRAME_W32_DISPLAY_INFO (f
)->num_colors
;
1592 i
++, list
= list
->next
)
1593 log_palette
->palPalEntry
[i
] = list
->entry
;
1595 new_palette
= CreatePalette (log_palette
);
1599 if (FRAME_W32_DISPLAY_INFO (f
)->palette
)
1600 DeleteObject (FRAME_W32_DISPLAY_INFO (f
)->palette
);
1601 FRAME_W32_DISPLAY_INFO (f
)->palette
= new_palette
;
1603 /* Realize display palette and garbage all frames. */
1604 release_frame_dc (f
, get_frame_dc (f
));
1609 #define W32_COLOR(pe) RGB (pe.peRed, pe.peGreen, pe.peBlue)
1610 #define SET_W32_COLOR(pe, color) \
1613 pe.peRed = GetRValue (color); \
1614 pe.peGreen = GetGValue (color); \
1615 pe.peBlue = GetBValue (color); \
1620 /* Keep these around in case we ever want to track color usage. */
1622 w32_map_color (FRAME_PTR f
, COLORREF color
)
1624 struct w32_palette_entry
* list
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1626 if (NILP (Vw32_enable_palette
))
1629 /* check if color is already mapped */
1632 if (W32_COLOR (list
->entry
) == color
)
1640 /* not already mapped, so add to list and recreate Windows palette */
1641 list
= (struct w32_palette_entry
*)
1642 xmalloc (sizeof (struct w32_palette_entry
));
1643 SET_W32_COLOR (list
->entry
, color
);
1645 list
->next
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1646 FRAME_W32_DISPLAY_INFO (f
)->color_list
= list
;
1647 FRAME_W32_DISPLAY_INFO (f
)->num_colors
++;
1649 /* set flag that palette must be regenerated */
1650 FRAME_W32_DISPLAY_INFO (f
)->regen_palette
= TRUE
;
1654 w32_unmap_color (FRAME_PTR f
, COLORREF color
)
1656 struct w32_palette_entry
* list
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1657 struct w32_palette_entry
**prev
= &FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1659 if (NILP (Vw32_enable_palette
))
1662 /* check if color is already mapped */
1665 if (W32_COLOR (list
->entry
) == color
)
1667 if (--list
->refcount
== 0)
1671 FRAME_W32_DISPLAY_INFO (f
)->num_colors
--;
1681 /* set flag that palette must be regenerated */
1682 FRAME_W32_DISPLAY_INFO (f
)->regen_palette
= TRUE
;
1686 /* Decide if color named COLOR is valid for the display associated with
1687 the selected frame; if so, return the rgb values in COLOR_DEF.
1688 If ALLOC is nonzero, allocate a new colormap cell. */
1691 defined_color (f
, color
, color_def
, alloc
)
1694 COLORREF
*color_def
;
1697 register Lisp_Object tem
;
1699 tem
= x_to_w32_color (color
);
1703 if (!NILP (Vw32_enable_palette
))
1705 struct w32_palette_entry
* entry
=
1706 FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1707 struct w32_palette_entry
** prev
=
1708 &FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1710 /* check if color is already mapped */
1713 if (W32_COLOR (entry
->entry
) == XUINT (tem
))
1715 prev
= &entry
->next
;
1716 entry
= entry
->next
;
1719 if (entry
== NULL
&& alloc
)
1721 /* not already mapped, so add to list */
1722 entry
= (struct w32_palette_entry
*)
1723 xmalloc (sizeof (struct w32_palette_entry
));
1724 SET_W32_COLOR (entry
->entry
, XUINT (tem
));
1727 FRAME_W32_DISPLAY_INFO (f
)->num_colors
++;
1729 /* set flag that palette must be regenerated */
1730 FRAME_W32_DISPLAY_INFO (f
)->regen_palette
= TRUE
;
1733 /* Ensure COLORREF value is snapped to nearest color in (default)
1734 palette by simulating the PALETTERGB macro. This works whether
1735 or not the display device has a palette. */
1736 *color_def
= XUINT (tem
) | 0x2000000;
1745 /* Given a string ARG naming a color, compute a pixel value from it
1746 suitable for screen F.
1747 If F is not a color screen, return DEF (default) regardless of what
1751 x_decode_color (f
, arg
, def
)
1758 CHECK_STRING (arg
, 0);
1760 if (strcmp (XSTRING (arg
)->data
, "black") == 0)
1761 return BLACK_PIX_DEFAULT (f
);
1762 else if (strcmp (XSTRING (arg
)->data
, "white") == 0)
1763 return WHITE_PIX_DEFAULT (f
);
1765 if ((FRAME_W32_DISPLAY_INFO (f
)->n_planes
* FRAME_W32_DISPLAY_INFO (f
)->n_cbits
) == 1)
1768 /* defined_color is responsible for coping with failures
1769 by looking for a near-miss. */
1770 if (defined_color (f
, XSTRING (arg
)->data
, &cdef
, 1))
1773 /* defined_color failed; return an ultimate default. */
1777 /* Functions called only from `x_set_frame_param'
1778 to set individual parameters.
1780 If FRAME_W32_WINDOW (f) is 0,
1781 the frame is being created and its window does not exist yet.
1782 In that case, just record the parameter's new value
1783 in the standard place; do not attempt to change the window. */
1786 x_set_foreground_color (f
, arg
, oldval
)
1788 Lisp_Object arg
, oldval
;
1790 f
->output_data
.w32
->foreground_pixel
1791 = x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1793 if (FRAME_W32_WINDOW (f
) != 0)
1795 recompute_basic_faces (f
);
1796 if (FRAME_VISIBLE_P (f
))
1802 x_set_background_color (f
, arg
, oldval
)
1804 Lisp_Object arg
, oldval
;
1809 f
->output_data
.w32
->background_pixel
1810 = x_decode_color (f
, arg
, WHITE_PIX_DEFAULT (f
));
1812 if (FRAME_W32_WINDOW (f
) != 0)
1814 SetWindowLong (FRAME_W32_WINDOW (f
), WND_BACKGROUND_INDEX
, f
->output_data
.w32
->background_pixel
);
1816 recompute_basic_faces (f
);
1818 if (FRAME_VISIBLE_P (f
))
1824 x_set_mouse_color (f
, arg
, oldval
)
1826 Lisp_Object arg
, oldval
;
1829 Cursor cursor
, nontext_cursor
, mode_cursor
, cross_cursor
;
1834 if (!EQ (Qnil
, arg
))
1835 f
->output_data
.w32
->mouse_pixel
1836 = x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1837 mask_color
= f
->output_data
.w32
->background_pixel
;
1838 /* No invisible pointers. */
1839 if (mask_color
== f
->output_data
.w32
->mouse_pixel
1840 && mask_color
== f
->output_data
.w32
->background_pixel
)
1841 f
->output_data
.w32
->mouse_pixel
= f
->output_data
.w32
->foreground_pixel
;
1846 /* It's not okay to crash if the user selects a screwy cursor. */
1847 count
= x_catch_errors (FRAME_W32_DISPLAY (f
));
1849 if (!EQ (Qnil
, Vx_pointer_shape
))
1851 CHECK_NUMBER (Vx_pointer_shape
, 0);
1852 cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XINT (Vx_pointer_shape
));
1855 cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_xterm
);
1856 x_check_errors (FRAME_W32_DISPLAY (f
), "bad text pointer cursor: %s");
1858 if (!EQ (Qnil
, Vx_nontext_pointer_shape
))
1860 CHECK_NUMBER (Vx_nontext_pointer_shape
, 0);
1861 nontext_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
),
1862 XINT (Vx_nontext_pointer_shape
));
1865 nontext_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_left_ptr
);
1866 x_check_errors (FRAME_W32_DISPLAY (f
), "bad nontext pointer cursor: %s");
1868 if (!EQ (Qnil
, Vx_mode_pointer_shape
))
1870 CHECK_NUMBER (Vx_mode_pointer_shape
, 0);
1871 mode_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
),
1872 XINT (Vx_mode_pointer_shape
));
1875 mode_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_xterm
);
1876 x_check_errors (FRAME_W32_DISPLAY (f
), "bad modeline pointer cursor: %s");
1878 if (!EQ (Qnil
, Vx_sensitive_text_pointer_shape
))
1880 CHECK_NUMBER (Vx_sensitive_text_pointer_shape
, 0);
1882 = XCreateFontCursor (FRAME_W32_DISPLAY (f
),
1883 XINT (Vx_sensitive_text_pointer_shape
));
1886 cross_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_crosshair
);
1888 /* Check and report errors with the above calls. */
1889 x_check_errors (FRAME_W32_DISPLAY (f
), "can't set cursor shape: %s");
1890 x_uncatch_errors (FRAME_W32_DISPLAY (f
), count
);
1893 XColor fore_color
, back_color
;
1895 fore_color
.pixel
= f
->output_data
.w32
->mouse_pixel
;
1896 back_color
.pixel
= mask_color
;
1897 XQueryColor (FRAME_W32_DISPLAY (f
),
1898 DefaultColormap (FRAME_W32_DISPLAY (f
),
1899 DefaultScreen (FRAME_W32_DISPLAY (f
))),
1901 XQueryColor (FRAME_W32_DISPLAY (f
),
1902 DefaultColormap (FRAME_W32_DISPLAY (f
),
1903 DefaultScreen (FRAME_W32_DISPLAY (f
))),
1905 XRecolorCursor (FRAME_W32_DISPLAY (f
), cursor
,
1906 &fore_color
, &back_color
);
1907 XRecolorCursor (FRAME_W32_DISPLAY (f
), nontext_cursor
,
1908 &fore_color
, &back_color
);
1909 XRecolorCursor (FRAME_W32_DISPLAY (f
), mode_cursor
,
1910 &fore_color
, &back_color
);
1911 XRecolorCursor (FRAME_W32_DISPLAY (f
), cross_cursor
,
1912 &fore_color
, &back_color
);
1915 if (FRAME_W32_WINDOW (f
) != 0)
1917 XDefineCursor (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
), cursor
);
1920 if (cursor
!= f
->output_data
.w32
->text_cursor
&& f
->output_data
.w32
->text_cursor
!= 0)
1921 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->text_cursor
);
1922 f
->output_data
.w32
->text_cursor
= cursor
;
1924 if (nontext_cursor
!= f
->output_data
.w32
->nontext_cursor
1925 && f
->output_data
.w32
->nontext_cursor
!= 0)
1926 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->nontext_cursor
);
1927 f
->output_data
.w32
->nontext_cursor
= nontext_cursor
;
1929 if (mode_cursor
!= f
->output_data
.w32
->modeline_cursor
1930 && f
->output_data
.w32
->modeline_cursor
!= 0)
1931 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->modeline_cursor
);
1932 f
->output_data
.w32
->modeline_cursor
= mode_cursor
;
1933 if (cross_cursor
!= f
->output_data
.w32
->cross_cursor
1934 && f
->output_data
.w32
->cross_cursor
!= 0)
1935 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->cross_cursor
);
1936 f
->output_data
.w32
->cross_cursor
= cross_cursor
;
1938 XFlush (FRAME_W32_DISPLAY (f
));
1944 x_set_cursor_color (f
, arg
, oldval
)
1946 Lisp_Object arg
, oldval
;
1948 unsigned long fore_pixel
;
1950 if (!EQ (Vx_cursor_fore_pixel
, Qnil
))
1951 fore_pixel
= x_decode_color (f
, Vx_cursor_fore_pixel
,
1952 WHITE_PIX_DEFAULT (f
));
1954 fore_pixel
= f
->output_data
.w32
->background_pixel
;
1955 f
->output_data
.w32
->cursor_pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1957 /* Make sure that the cursor color differs from the background color. */
1958 if (f
->output_data
.w32
->cursor_pixel
== f
->output_data
.w32
->background_pixel
)
1960 f
->output_data
.w32
->cursor_pixel
= f
->output_data
.w32
->mouse_pixel
;
1961 if (f
->output_data
.w32
->cursor_pixel
== fore_pixel
)
1962 fore_pixel
= f
->output_data
.w32
->background_pixel
;
1964 f
->output_data
.w32
->cursor_foreground_pixel
= fore_pixel
;
1966 if (FRAME_W32_WINDOW (f
) != 0)
1968 if (FRAME_VISIBLE_P (f
))
1970 x_display_cursor (f
, 0);
1971 x_display_cursor (f
, 1);
1976 /* Set the border-color of frame F to pixel value PIX.
1977 Note that this does not fully take effect if done before
1980 x_set_border_pixel (f
, pix
)
1984 f
->output_data
.w32
->border_pixel
= pix
;
1986 if (FRAME_W32_WINDOW (f
) != 0 && f
->output_data
.w32
->border_width
> 0)
1988 if (FRAME_VISIBLE_P (f
))
1993 /* Set the border-color of frame F to value described by ARG.
1994 ARG can be a string naming a color.
1995 The border-color is used for the border that is drawn by the server.
1996 Note that this does not fully take effect if done before
1997 F has a window; it must be redone when the window is created. */
2000 x_set_border_color (f
, arg
, oldval
)
2002 Lisp_Object arg
, oldval
;
2007 CHECK_STRING (arg
, 0);
2008 str
= XSTRING (arg
)->data
;
2010 pix
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
2012 x_set_border_pixel (f
, pix
);
2016 x_set_cursor_type (f
, arg
, oldval
)
2018 Lisp_Object arg
, oldval
;
2022 FRAME_DESIRED_CURSOR (f
) = bar_cursor
;
2023 f
->output_data
.w32
->cursor_width
= 2;
2025 else if (CONSP (arg
) && EQ (XCONS (arg
)->car
, Qbar
)
2026 && INTEGERP (XCONS (arg
)->cdr
))
2028 FRAME_DESIRED_CURSOR (f
) = bar_cursor
;
2029 f
->output_data
.w32
->cursor_width
= XINT (XCONS (arg
)->cdr
);
2032 /* Treat anything unknown as "box cursor".
2033 It was bad to signal an error; people have trouble fixing
2034 .Xdefaults with Emacs, when it has something bad in it. */
2035 FRAME_DESIRED_CURSOR (f
) = filled_box_cursor
;
2037 /* Make sure the cursor gets redrawn. This is overkill, but how
2038 often do people change cursor types? */
2039 update_mode_lines
++;
2043 x_set_icon_type (f
, arg
, oldval
)
2045 Lisp_Object arg
, oldval
;
2053 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
2056 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
2061 result
= x_text_icon (f
,
2062 (char *) XSTRING ((!NILP (f
->icon_name
)
2066 result
= x_bitmap_icon (f
, arg
);
2071 error ("No icon window available");
2074 /* If the window was unmapped (and its icon was mapped),
2075 the new icon is not mapped, so map the window in its stead. */
2076 if (FRAME_VISIBLE_P (f
))
2078 #ifdef USE_X_TOOLKIT
2079 XtPopup (f
->output_data
.w32
->widget
, XtGrabNone
);
2081 XMapWindow (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
));
2084 XFlush (FRAME_W32_DISPLAY (f
));
2089 /* Return non-nil if frame F wants a bitmap icon. */
2097 tem
= assq_no_quit (Qicon_type
, f
->param_alist
);
2099 return XCONS (tem
)->cdr
;
2105 x_set_icon_name (f
, arg
, oldval
)
2107 Lisp_Object arg
, oldval
;
2114 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
2117 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
2123 if (f
->output_data
.w32
->icon_bitmap
!= 0)
2128 result
= x_text_icon (f
,
2129 (char *) XSTRING ((!NILP (f
->icon_name
)
2138 error ("No icon window available");
2141 /* If the window was unmapped (and its icon was mapped),
2142 the new icon is not mapped, so map the window in its stead. */
2143 if (FRAME_VISIBLE_P (f
))
2145 #ifdef USE_X_TOOLKIT
2146 XtPopup (f
->output_data
.w32
->widget
, XtGrabNone
);
2148 XMapWindow (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
));
2151 XFlush (FRAME_W32_DISPLAY (f
));
2156 extern Lisp_Object
x_new_font ();
2157 extern Lisp_Object
x_new_fontset();
2160 x_set_font (f
, arg
, oldval
)
2162 Lisp_Object arg
, oldval
;
2165 Lisp_Object fontset_name
;
2168 CHECK_STRING (arg
, 1);
2170 fontset_name
= Fquery_fontset (arg
, Qnil
);
2173 result
= (STRINGP (fontset_name
)
2174 ? x_new_fontset (f
, XSTRING (fontset_name
)->data
)
2175 : x_new_font (f
, XSTRING (arg
)->data
));
2178 if (EQ (result
, Qnil
))
2179 error ("Font \"%s\" is not defined", XSTRING (arg
)->data
);
2180 else if (EQ (result
, Qt
))
2181 error ("the characters of the given font have varying widths");
2182 else if (STRINGP (result
))
2184 recompute_basic_faces (f
);
2185 store_frame_param (f
, Qfont
, result
);
2190 XSETFRAME (frame
, f
);
2191 call1 (Qface_set_after_frame_default
, frame
);
2195 x_set_border_width (f
, arg
, oldval
)
2197 Lisp_Object arg
, oldval
;
2199 CHECK_NUMBER (arg
, 0);
2201 if (XINT (arg
) == f
->output_data
.w32
->border_width
)
2204 if (FRAME_W32_WINDOW (f
) != 0)
2205 error ("Cannot change the border width of a window");
2207 f
->output_data
.w32
->border_width
= XINT (arg
);
2211 x_set_internal_border_width (f
, arg
, oldval
)
2213 Lisp_Object arg
, oldval
;
2216 int old
= f
->output_data
.w32
->internal_border_width
;
2218 CHECK_NUMBER (arg
, 0);
2219 f
->output_data
.w32
->internal_border_width
= XINT (arg
);
2220 if (f
->output_data
.w32
->internal_border_width
< 0)
2221 f
->output_data
.w32
->internal_border_width
= 0;
2223 if (f
->output_data
.w32
->internal_border_width
== old
)
2226 if (FRAME_W32_WINDOW (f
) != 0)
2229 x_set_window_size (f
, 0, f
->width
, f
->height
);
2231 SET_FRAME_GARBAGED (f
);
2236 x_set_visibility (f
, value
, oldval
)
2238 Lisp_Object value
, oldval
;
2241 XSETFRAME (frame
, f
);
2244 Fmake_frame_invisible (frame
, Qt
);
2245 else if (EQ (value
, Qicon
))
2246 Ficonify_frame (frame
);
2248 Fmake_frame_visible (frame
);
2252 x_set_menu_bar_lines (f
, value
, oldval
)
2254 Lisp_Object value
, oldval
;
2257 int olines
= FRAME_MENU_BAR_LINES (f
);
2259 /* Right now, menu bars don't work properly in minibuf-only frames;
2260 most of the commands try to apply themselves to the minibuffer
2261 frame itslef, and get an error because you can't switch buffers
2262 in or split the minibuffer window. */
2263 if (FRAME_MINIBUF_ONLY_P (f
))
2266 if (INTEGERP (value
))
2267 nlines
= XINT (value
);
2271 FRAME_MENU_BAR_LINES (f
) = 0;
2273 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
2276 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
2277 free_frame_menubar (f
);
2278 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
2280 /* Adjust the frame size so that the client (text) dimensions
2281 remain the same. This depends on FRAME_EXTERNAL_MENU_BAR being
2283 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2287 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
2290 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2291 name; if NAME is a string, set F's name to NAME and set
2292 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2294 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2295 suggesting a new name, which lisp code should override; if
2296 F->explicit_name is set, ignore the new name; otherwise, set it. */
2299 x_set_name (f
, name
, explicit)
2304 /* Make sure that requests from lisp code override requests from
2305 Emacs redisplay code. */
2308 /* If we're switching from explicit to implicit, we had better
2309 update the mode lines and thereby update the title. */
2310 if (f
->explicit_name
&& NILP (name
))
2311 update_mode_lines
= 1;
2313 f
->explicit_name
= ! NILP (name
);
2315 else if (f
->explicit_name
)
2318 /* If NAME is nil, set the name to the w32_id_name. */
2321 /* Check for no change needed in this very common case
2322 before we do any consing. */
2323 if (!strcmp (FRAME_W32_DISPLAY_INFO (f
)->w32_id_name
,
2324 XSTRING (f
->name
)->data
))
2326 name
= build_string (FRAME_W32_DISPLAY_INFO (f
)->w32_id_name
);
2329 CHECK_STRING (name
, 0);
2331 /* Don't change the name if it's already NAME. */
2332 if (! NILP (Fstring_equal (name
, f
->name
)))
2337 /* For setting the frame title, the title parameter should override
2338 the name parameter. */
2339 if (! NILP (f
->title
))
2342 if (FRAME_W32_WINDOW (f
))
2345 SetWindowText(FRAME_W32_WINDOW (f
), XSTRING (name
)->data
);
2350 /* This function should be called when the user's lisp code has
2351 specified a name for the frame; the name will override any set by the
2354 x_explicitly_set_name (f
, arg
, oldval
)
2356 Lisp_Object arg
, oldval
;
2358 x_set_name (f
, arg
, 1);
2361 /* This function should be called by Emacs redisplay code to set the
2362 name; names set this way will never override names set by the user's
2365 x_implicitly_set_name (f
, arg
, oldval
)
2367 Lisp_Object arg
, oldval
;
2369 x_set_name (f
, arg
, 0);
2372 /* Change the title of frame F to NAME.
2373 If NAME is nil, use the frame name as the title.
2375 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2376 name; if NAME is a string, set F's name to NAME and set
2377 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2379 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2380 suggesting a new name, which lisp code should override; if
2381 F->explicit_name is set, ignore the new name; otherwise, set it. */
2384 x_set_title (f
, name
)
2388 /* Don't change the title if it's already NAME. */
2389 if (EQ (name
, f
->title
))
2392 update_mode_lines
= 1;
2399 if (FRAME_W32_WINDOW (f
))
2402 SetWindowText(FRAME_W32_WINDOW (f
), XSTRING (name
)->data
);
2408 x_set_autoraise (f
, arg
, oldval
)
2410 Lisp_Object arg
, oldval
;
2412 f
->auto_raise
= !EQ (Qnil
, arg
);
2416 x_set_autolower (f
, arg
, oldval
)
2418 Lisp_Object arg
, oldval
;
2420 f
->auto_lower
= !EQ (Qnil
, arg
);
2424 x_set_unsplittable (f
, arg
, oldval
)
2426 Lisp_Object arg
, oldval
;
2428 f
->no_split
= !NILP (arg
);
2432 x_set_vertical_scroll_bars (f
, arg
, oldval
)
2434 Lisp_Object arg
, oldval
;
2436 if ((EQ (arg
, Qleft
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f
))
2437 || (EQ (arg
, Qright
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f
))
2438 || (NILP (arg
) && FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
2439 || (!NILP (arg
) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
)))
2441 FRAME_VERTICAL_SCROLL_BAR_TYPE (f
) = NILP (arg
) ?
2442 vertical_scroll_bar_none
:
2443 /* Put scroll bars on the right by default, as is conventional
2446 ? vertical_scroll_bar_left
2447 : vertical_scroll_bar_right
;
2449 /* We set this parameter before creating the window for the
2450 frame, so we can get the geometry right from the start.
2451 However, if the window hasn't been created yet, we shouldn't
2452 call x_set_window_size. */
2453 if (FRAME_W32_WINDOW (f
))
2454 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2459 x_set_scroll_bar_width (f
, arg
, oldval
)
2461 Lisp_Object arg
, oldval
;
2465 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = 0;
2466 FRAME_SCROLL_BAR_COLS (f
) = 2;
2468 else if (INTEGERP (arg
) && XINT (arg
) > 0
2469 && XFASTINT (arg
) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f
))
2471 int wid
= FONT_WIDTH (f
->output_data
.w32
->font
);
2472 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = XFASTINT (arg
);
2473 FRAME_SCROLL_BAR_COLS (f
) = (XFASTINT (arg
) + wid
-1) / wid
;
2474 if (FRAME_W32_WINDOW (f
))
2475 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2479 /* Subroutines of creating an frame. */
2481 /* Make sure that Vx_resource_name is set to a reasonable value.
2482 Fix it up, or set it to `emacs' if it is too hopeless. */
2485 validate_x_resource_name ()
2488 /* Number of valid characters in the resource name. */
2490 /* Number of invalid characters in the resource name. */
2495 if (STRINGP (Vx_resource_name
))
2497 unsigned char *p
= XSTRING (Vx_resource_name
)->data
;
2500 len
= XSTRING (Vx_resource_name
)->size
;
2502 /* Only letters, digits, - and _ are valid in resource names.
2503 Count the valid characters and count the invalid ones. */
2504 for (i
= 0; i
< len
; i
++)
2507 if (! ((c
>= 'a' && c
<= 'z')
2508 || (c
>= 'A' && c
<= 'Z')
2509 || (c
>= '0' && c
<= '9')
2510 || c
== '-' || c
== '_'))
2517 /* Not a string => completely invalid. */
2518 bad_count
= 5, good_count
= 0;
2520 /* If name is valid already, return. */
2524 /* If name is entirely invalid, or nearly so, use `emacs'. */
2526 || (good_count
== 1 && bad_count
> 0))
2528 Vx_resource_name
= build_string ("emacs");
2532 /* Name is partly valid. Copy it and replace the invalid characters
2533 with underscores. */
2535 Vx_resource_name
= new = Fcopy_sequence (Vx_resource_name
);
2537 for (i
= 0; i
< len
; i
++)
2539 int c
= XSTRING (new)->data
[i
];
2540 if (! ((c
>= 'a' && c
<= 'z')
2541 || (c
>= 'A' && c
<= 'Z')
2542 || (c
>= '0' && c
<= '9')
2543 || c
== '-' || c
== '_'))
2544 XSTRING (new)->data
[i
] = '_';
2549 extern char *x_get_string_resource ();
2551 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
2552 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
2553 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
2554 class, where INSTANCE is the name under which Emacs was invoked, or\n\
2555 the name specified by the `-name' or `-rn' command-line arguments.\n\
2557 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
2558 class, respectively. You must specify both of them or neither.\n\
2559 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
2560 and the class is `Emacs.CLASS.SUBCLASS'.")
2561 (attribute
, class, component
, subclass
)
2562 Lisp_Object attribute
, class, component
, subclass
;
2564 register char *value
;
2568 CHECK_STRING (attribute
, 0);
2569 CHECK_STRING (class, 0);
2571 if (!NILP (component
))
2572 CHECK_STRING (component
, 1);
2573 if (!NILP (subclass
))
2574 CHECK_STRING (subclass
, 2);
2575 if (NILP (component
) != NILP (subclass
))
2576 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2578 validate_x_resource_name ();
2580 /* Allocate space for the components, the dots which separate them,
2581 and the final '\0'. Make them big enough for the worst case. */
2582 name_key
= (char *) alloca (XSTRING (Vx_resource_name
)->size
2583 + (STRINGP (component
)
2584 ? XSTRING (component
)->size
: 0)
2585 + XSTRING (attribute
)->size
2588 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
2589 + XSTRING (class)->size
2590 + (STRINGP (subclass
)
2591 ? XSTRING (subclass
)->size
: 0)
2594 /* Start with emacs.FRAMENAME for the name (the specific one)
2595 and with `Emacs' for the class key (the general one). */
2596 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2597 strcpy (class_key
, EMACS_CLASS
);
2599 strcat (class_key
, ".");
2600 strcat (class_key
, XSTRING (class)->data
);
2602 if (!NILP (component
))
2604 strcat (class_key
, ".");
2605 strcat (class_key
, XSTRING (subclass
)->data
);
2607 strcat (name_key
, ".");
2608 strcat (name_key
, XSTRING (component
)->data
);
2611 strcat (name_key
, ".");
2612 strcat (name_key
, XSTRING (attribute
)->data
);
2614 value
= x_get_string_resource (Qnil
,
2615 name_key
, class_key
);
2617 if (value
!= (char *) 0)
2618 return build_string (value
);
2623 /* Used when C code wants a resource value. */
2626 x_get_resource_string (attribute
, class)
2627 char *attribute
, *class;
2629 register char *value
;
2633 /* Allocate space for the components, the dots which separate them,
2634 and the final '\0'. */
2635 name_key
= (char *) alloca (XSTRING (Vinvocation_name
)->size
2636 + strlen (attribute
) + 2);
2637 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
2638 + strlen (class) + 2);
2640 sprintf (name_key
, "%s.%s",
2641 XSTRING (Vinvocation_name
)->data
,
2643 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
2645 return x_get_string_resource (selected_frame
,
2646 name_key
, class_key
);
2649 /* Types we might convert a resource string into. */
2652 number
, boolean
, string
, symbol
2655 /* Return the value of parameter PARAM.
2657 First search ALIST, then Vdefault_frame_alist, then the X defaults
2658 database, using ATTRIBUTE as the attribute name and CLASS as its class.
2660 Convert the resource to the type specified by desired_type.
2662 If no default is specified, return Qunbound. If you call
2663 x_get_arg, make sure you deal with Qunbound in a reasonable way,
2664 and don't let it get stored in any Lisp-visible variables! */
2667 x_get_arg (alist
, param
, attribute
, class, type
)
2668 Lisp_Object alist
, param
;
2671 enum resource_types type
;
2673 register Lisp_Object tem
;
2675 tem
= Fassq (param
, alist
);
2677 tem
= Fassq (param
, Vdefault_frame_alist
);
2683 tem
= Fx_get_resource (build_string (attribute
),
2684 build_string (class),
2693 return make_number (atoi (XSTRING (tem
)->data
));
2696 tem
= Fdowncase (tem
);
2697 if (!strcmp (XSTRING (tem
)->data
, "on")
2698 || !strcmp (XSTRING (tem
)->data
, "true"))
2707 /* As a special case, we map the values `true' and `on'
2708 to Qt, and `false' and `off' to Qnil. */
2711 lower
= Fdowncase (tem
);
2712 if (!strcmp (XSTRING (lower
)->data
, "on")
2713 || !strcmp (XSTRING (lower
)->data
, "true"))
2715 else if (!strcmp (XSTRING (lower
)->data
, "off")
2716 || !strcmp (XSTRING (lower
)->data
, "false"))
2719 return Fintern (tem
, Qnil
);
2732 /* Record in frame F the specified or default value according to ALIST
2733 of the parameter named PARAM (a Lisp symbol).
2734 If no value is specified for PARAM, look for an X default for XPROP
2735 on the frame named NAME.
2736 If that is not found either, use the value DEFLT. */
2739 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
2746 enum resource_types type
;
2750 tem
= x_get_arg (alist
, prop
, xprop
, xclass
, type
);
2751 if (EQ (tem
, Qunbound
))
2753 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2757 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
2758 "Parse an X-style geometry string STRING.\n\
2759 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
2760 The properties returned may include `top', `left', `height', and `width'.\n\
2761 The value of `left' or `top' may be an integer,\n\
2762 or a list (+ N) meaning N pixels relative to top/left corner,\n\
2763 or a list (- N) meaning -N pixels relative to bottom/right corner.")
2768 unsigned int width
, height
;
2771 CHECK_STRING (string
, 0);
2773 geometry
= XParseGeometry ((char *) XSTRING (string
)->data
,
2774 &x
, &y
, &width
, &height
);
2777 if (geometry
& XValue
)
2779 Lisp_Object element
;
2781 if (x
>= 0 && (geometry
& XNegative
))
2782 element
= Fcons (Qleft
, Fcons (Qminus
, Fcons (make_number (-x
), Qnil
)));
2783 else if (x
< 0 && ! (geometry
& XNegative
))
2784 element
= Fcons (Qleft
, Fcons (Qplus
, Fcons (make_number (x
), Qnil
)));
2786 element
= Fcons (Qleft
, make_number (x
));
2787 result
= Fcons (element
, result
);
2790 if (geometry
& YValue
)
2792 Lisp_Object element
;
2794 if (y
>= 0 && (geometry
& YNegative
))
2795 element
= Fcons (Qtop
, Fcons (Qminus
, Fcons (make_number (-y
), Qnil
)));
2796 else if (y
< 0 && ! (geometry
& YNegative
))
2797 element
= Fcons (Qtop
, Fcons (Qplus
, Fcons (make_number (y
), Qnil
)));
2799 element
= Fcons (Qtop
, make_number (y
));
2800 result
= Fcons (element
, result
);
2803 if (geometry
& WidthValue
)
2804 result
= Fcons (Fcons (Qwidth
, make_number (width
)), result
);
2805 if (geometry
& HeightValue
)
2806 result
= Fcons (Fcons (Qheight
, make_number (height
)), result
);
2811 /* Calculate the desired size and position of this window,
2812 and return the flags saying which aspects were specified.
2814 This function does not make the coordinates positive. */
2816 #define DEFAULT_ROWS 40
2817 #define DEFAULT_COLS 80
2820 x_figure_window_size (f
, parms
)
2824 register Lisp_Object tem0
, tem1
, tem2
;
2825 int height
, width
, left
, top
;
2826 register int geometry
;
2827 long window_prompting
= 0;
2829 /* Default values if we fall through.
2830 Actually, if that happens we should get
2831 window manager prompting. */
2832 SET_FRAME_WIDTH (f
, DEFAULT_COLS
);
2833 f
->height
= DEFAULT_ROWS
;
2834 /* Window managers expect that if program-specified
2835 positions are not (0,0), they're intentional, not defaults. */
2836 f
->output_data
.w32
->top_pos
= 0;
2837 f
->output_data
.w32
->left_pos
= 0;
2839 tem0
= x_get_arg (parms
, Qheight
, 0, 0, number
);
2840 tem1
= x_get_arg (parms
, Qwidth
, 0, 0, number
);
2841 tem2
= x_get_arg (parms
, Quser_size
, 0, 0, number
);
2842 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
2844 if (!EQ (tem0
, Qunbound
))
2846 CHECK_NUMBER (tem0
, 0);
2847 f
->height
= XINT (tem0
);
2849 if (!EQ (tem1
, Qunbound
))
2851 CHECK_NUMBER (tem1
, 0);
2852 SET_FRAME_WIDTH (f
, XINT (tem1
));
2854 if (!NILP (tem2
) && !EQ (tem2
, Qunbound
))
2855 window_prompting
|= USSize
;
2857 window_prompting
|= PSize
;
2860 f
->output_data
.w32
->vertical_scroll_bar_extra
2861 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
2863 : FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) > 0
2864 ? FRAME_SCROLL_BAR_PIXEL_WIDTH (f
)
2865 : (FRAME_SCROLL_BAR_COLS (f
) * FONT_WIDTH (f
->output_data
.w32
->font
)));
2866 f
->output_data
.w32
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
2867 f
->output_data
.w32
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
2869 tem0
= x_get_arg (parms
, Qtop
, 0, 0, number
);
2870 tem1
= x_get_arg (parms
, Qleft
, 0, 0, number
);
2871 tem2
= x_get_arg (parms
, Quser_position
, 0, 0, number
);
2872 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
2874 if (EQ (tem0
, Qminus
))
2876 f
->output_data
.w32
->top_pos
= 0;
2877 window_prompting
|= YNegative
;
2879 else if (CONSP (tem0
) && EQ (XCONS (tem0
)->car
, Qminus
)
2880 && CONSP (XCONS (tem0
)->cdr
)
2881 && INTEGERP (XCONS (XCONS (tem0
)->cdr
)->car
))
2883 f
->output_data
.w32
->top_pos
= - XINT (XCONS (XCONS (tem0
)->cdr
)->car
);
2884 window_prompting
|= YNegative
;
2886 else if (CONSP (tem0
) && EQ (XCONS (tem0
)->car
, Qplus
)
2887 && CONSP (XCONS (tem0
)->cdr
)
2888 && INTEGERP (XCONS (XCONS (tem0
)->cdr
)->car
))
2890 f
->output_data
.w32
->top_pos
= XINT (XCONS (XCONS (tem0
)->cdr
)->car
);
2892 else if (EQ (tem0
, Qunbound
))
2893 f
->output_data
.w32
->top_pos
= 0;
2896 CHECK_NUMBER (tem0
, 0);
2897 f
->output_data
.w32
->top_pos
= XINT (tem0
);
2898 if (f
->output_data
.w32
->top_pos
< 0)
2899 window_prompting
|= YNegative
;
2902 if (EQ (tem1
, Qminus
))
2904 f
->output_data
.w32
->left_pos
= 0;
2905 window_prompting
|= XNegative
;
2907 else if (CONSP (tem1
) && EQ (XCONS (tem1
)->car
, Qminus
)
2908 && CONSP (XCONS (tem1
)->cdr
)
2909 && INTEGERP (XCONS (XCONS (tem1
)->cdr
)->car
))
2911 f
->output_data
.w32
->left_pos
= - XINT (XCONS (XCONS (tem1
)->cdr
)->car
);
2912 window_prompting
|= XNegative
;
2914 else if (CONSP (tem1
) && EQ (XCONS (tem1
)->car
, Qplus
)
2915 && CONSP (XCONS (tem1
)->cdr
)
2916 && INTEGERP (XCONS (XCONS (tem1
)->cdr
)->car
))
2918 f
->output_data
.w32
->left_pos
= XINT (XCONS (XCONS (tem1
)->cdr
)->car
);
2920 else if (EQ (tem1
, Qunbound
))
2921 f
->output_data
.w32
->left_pos
= 0;
2924 CHECK_NUMBER (tem1
, 0);
2925 f
->output_data
.w32
->left_pos
= XINT (tem1
);
2926 if (f
->output_data
.w32
->left_pos
< 0)
2927 window_prompting
|= XNegative
;
2930 if (!NILP (tem2
) && ! EQ (tem2
, Qunbound
))
2931 window_prompting
|= USPosition
;
2933 window_prompting
|= PPosition
;
2936 return window_prompting
;
2941 extern LRESULT CALLBACK
w32_wnd_proc ();
2944 w32_init_class (hinst
)
2949 wc
.style
= CS_HREDRAW
| CS_VREDRAW
;
2950 wc
.lpfnWndProc
= (WNDPROC
) w32_wnd_proc
;
2952 wc
.cbWndExtra
= WND_EXTRA_BYTES
;
2953 wc
.hInstance
= hinst
;
2954 wc
.hIcon
= LoadIcon (hinst
, EMACS_CLASS
);
2955 wc
.hCursor
= LoadCursor (NULL
, IDC_ARROW
);
2956 wc
.hbrBackground
= NULL
; /* GetStockObject (WHITE_BRUSH); */
2957 wc
.lpszMenuName
= NULL
;
2958 wc
.lpszClassName
= EMACS_CLASS
;
2960 return (RegisterClass (&wc
));
2964 w32_createscrollbar (f
, bar
)
2966 struct scroll_bar
* bar
;
2968 return (CreateWindow ("SCROLLBAR", "", SBS_VERT
| WS_CHILD
| WS_VISIBLE
,
2969 /* Position and size of scroll bar. */
2970 XINT(bar
->left
), XINT(bar
->top
),
2971 XINT(bar
->width
), XINT(bar
->height
),
2972 FRAME_W32_WINDOW (f
),
2979 w32_createwindow (f
)
2985 rect
.left
= rect
.top
= 0;
2986 rect
.right
= PIXEL_WIDTH (f
);
2987 rect
.bottom
= PIXEL_HEIGHT (f
);
2989 AdjustWindowRect (&rect
, f
->output_data
.w32
->dwStyle
,
2990 FRAME_EXTERNAL_MENU_BAR (f
));
2992 /* Do first time app init */
2996 w32_init_class (hinst
);
2999 FRAME_W32_WINDOW (f
) = hwnd
3000 = CreateWindow (EMACS_CLASS
,
3002 f
->output_data
.w32
->dwStyle
| WS_CLIPCHILDREN
,
3003 f
->output_data
.w32
->left_pos
,
3004 f
->output_data
.w32
->top_pos
,
3005 rect
.right
- rect
.left
,
3006 rect
.bottom
- rect
.top
,
3014 SetWindowLong (hwnd
, WND_FONTWIDTH_INDEX
, FONT_WIDTH (f
->output_data
.w32
->font
));
3015 SetWindowLong (hwnd
, WND_LINEHEIGHT_INDEX
, f
->output_data
.w32
->line_height
);
3016 SetWindowLong (hwnd
, WND_BORDER_INDEX
, f
->output_data
.w32
->internal_border_width
);
3017 SetWindowLong (hwnd
, WND_SCROLLBAR_INDEX
, f
->output_data
.w32
->vertical_scroll_bar_extra
);
3018 SetWindowLong (hwnd
, WND_BACKGROUND_INDEX
, f
->output_data
.w32
->background_pixel
);
3020 /* Enable drag-n-drop. */
3021 DragAcceptFiles (hwnd
, TRUE
);
3023 /* Do this to discard the default setting specified by our parent. */
3024 ShowWindow (hwnd
, SW_HIDE
);
3029 my_post_msg (wmsg
, hwnd
, msg
, wParam
, lParam
)
3036 wmsg
->msg
.hwnd
= hwnd
;
3037 wmsg
->msg
.message
= msg
;
3038 wmsg
->msg
.wParam
= wParam
;
3039 wmsg
->msg
.lParam
= lParam
;
3040 wmsg
->msg
.time
= GetMessageTime ();
3045 /* GetKeyState and MapVirtualKey on Windows 95 do not actually distinguish
3046 between left and right keys as advertised. We test for this
3047 support dynamically, and set a flag when the support is absent. If
3048 absent, we keep track of the left and right control and alt keys
3049 ourselves. This is particularly necessary on keyboards that rely
3050 upon the AltGr key, which is represented as having the left control
3051 and right alt keys pressed. For these keyboards, we need to know
3052 when the left alt key has been pressed in addition to the AltGr key
3053 so that we can properly support M-AltGr-key sequences (such as M-@
3054 on Swedish keyboards). */
3056 #define EMACS_LCONTROL 0
3057 #define EMACS_RCONTROL 1
3058 #define EMACS_LMENU 2
3059 #define EMACS_RMENU 3
3061 static int modifiers
[4];
3062 static int modifiers_recorded
;
3063 static int modifier_key_support_tested
;
3066 test_modifier_support (unsigned int wparam
)
3070 if (wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
)
3072 if (wparam
== VK_CONTROL
)
3082 if (!(GetKeyState (l
) & 0x8000) && !(GetKeyState (r
) & 0x8000))
3083 modifiers_recorded
= 1;
3085 modifiers_recorded
= 0;
3086 modifier_key_support_tested
= 1;
3090 record_keydown (unsigned int wparam
, unsigned int lparam
)
3094 if (!modifier_key_support_tested
)
3095 test_modifier_support (wparam
);
3097 if ((wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
) || !modifiers_recorded
)
3100 if (wparam
== VK_CONTROL
)
3101 i
= (lparam
& 0x1000000) ? EMACS_RCONTROL
: EMACS_LCONTROL
;
3103 i
= (lparam
& 0x1000000) ? EMACS_RMENU
: EMACS_LMENU
;
3109 record_keyup (unsigned int wparam
, unsigned int lparam
)
3113 if ((wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
) || !modifiers_recorded
)
3116 if (wparam
== VK_CONTROL
)
3117 i
= (lparam
& 0x1000000) ? EMACS_RCONTROL
: EMACS_LCONTROL
;
3119 i
= (lparam
& 0x1000000) ? EMACS_RMENU
: EMACS_LMENU
;
3124 /* Emacs can lose focus while a modifier key has been pressed. When
3125 it regains focus, be conservative and clear all modifiers since
3126 we cannot reconstruct the left and right modifier state. */
3132 if (GetFocus () == NULL
)
3133 /* Emacs doesn't have keyboard focus. Do nothing. */
3136 ctrl
= GetAsyncKeyState (VK_CONTROL
);
3137 alt
= GetAsyncKeyState (VK_MENU
);
3139 if (!(ctrl
& 0x08000))
3140 /* Clear any recorded control modifier state. */
3141 modifiers
[EMACS_RCONTROL
] = modifiers
[EMACS_LCONTROL
] = 0;
3143 if (!(alt
& 0x08000))
3144 /* Clear any recorded alt modifier state. */
3145 modifiers
[EMACS_RMENU
] = modifiers
[EMACS_LMENU
] = 0;
3147 /* Update the state of all modifier keys, because modifiers used in
3148 hot-key combinations can get stuck on if Emacs loses focus as a
3149 result of a hot-key being pressed. */
3153 #define CURRENT_STATE(key) ((GetAsyncKeyState (key) & 0x8000) >> 8)
3155 GetKeyboardState (keystate
);
3156 keystate
[VK_SHIFT
] = CURRENT_STATE (VK_SHIFT
);
3157 keystate
[VK_CONTROL
] = CURRENT_STATE (VK_CONTROL
);
3158 keystate
[VK_LCONTROL
] = CURRENT_STATE (VK_LCONTROL
);
3159 keystate
[VK_RCONTROL
] = CURRENT_STATE (VK_RCONTROL
);
3160 keystate
[VK_MENU
] = CURRENT_STATE (VK_MENU
);
3161 keystate
[VK_LMENU
] = CURRENT_STATE (VK_LMENU
);
3162 keystate
[VK_RMENU
] = CURRENT_STATE (VK_RMENU
);
3163 keystate
[VK_LWIN
] = CURRENT_STATE (VK_LWIN
);
3164 keystate
[VK_RWIN
] = CURRENT_STATE (VK_RWIN
);
3165 keystate
[VK_APPS
] = CURRENT_STATE (VK_APPS
);
3166 SetKeyboardState (keystate
);
3170 /* Synchronize modifier state with what is reported with the current
3171 keystroke. Even if we cannot distinguish between left and right
3172 modifier keys, we know that, if no modifiers are set, then neither
3173 the left or right modifier should be set. */
3177 if (!modifiers_recorded
)
3180 if (!(GetKeyState (VK_CONTROL
) & 0x8000))
3181 modifiers
[EMACS_RCONTROL
] = modifiers
[EMACS_LCONTROL
] = 0;
3183 if (!(GetKeyState (VK_MENU
) & 0x8000))
3184 modifiers
[EMACS_RMENU
] = modifiers
[EMACS_LMENU
] = 0;
3188 modifier_set (int vkey
)
3190 if (vkey
== VK_CAPITAL
|| vkey
== VK_SCROLL
)
3191 return (GetKeyState (vkey
) & 0x1);
3192 if (!modifiers_recorded
)
3193 return (GetKeyState (vkey
) & 0x8000);
3198 return modifiers
[EMACS_LCONTROL
];
3200 return modifiers
[EMACS_RCONTROL
];
3202 return modifiers
[EMACS_LMENU
];
3204 return modifiers
[EMACS_RMENU
];
3206 return (GetKeyState (vkey
) & 0x8000);
3209 /* Convert between the modifier bits W32 uses and the modifier bits
3213 w32_key_to_modifier (int key
)
3215 Lisp_Object key_mapping
;
3220 key_mapping
= Vw32_lwindow_modifier
;
3223 key_mapping
= Vw32_rwindow_modifier
;
3226 key_mapping
= Vw32_apps_modifier
;
3229 key_mapping
= Vw32_scroll_lock_modifier
;
3235 /* NB. This code runs in the input thread, asychronously to the lisp
3236 thread, so we must be careful to ensure access to lisp data is
3237 thread-safe. The following code is safe because the modifier
3238 variable values are updated atomically from lisp and symbols are
3239 not relocated by GC. Also, we don't have to worry about seeing GC
3241 if (EQ (key_mapping
, Qhyper
))
3242 return hyper_modifier
;
3243 if (EQ (key_mapping
, Qsuper
))
3244 return super_modifier
;
3245 if (EQ (key_mapping
, Qmeta
))
3246 return meta_modifier
;
3247 if (EQ (key_mapping
, Qalt
))
3248 return alt_modifier
;
3249 if (EQ (key_mapping
, Qctrl
))
3250 return ctrl_modifier
;
3251 if (EQ (key_mapping
, Qcontrol
)) /* synonym for ctrl */
3252 return ctrl_modifier
;
3253 if (EQ (key_mapping
, Qshift
))
3254 return shift_modifier
;
3256 /* Don't generate any modifier if not explicitly requested. */
3261 w32_get_modifiers ()
3263 return ((modifier_set (VK_SHIFT
) ? shift_modifier
: 0) |
3264 (modifier_set (VK_CONTROL
) ? ctrl_modifier
: 0) |
3265 (modifier_set (VK_LWIN
) ? w32_key_to_modifier (VK_LWIN
) : 0) |
3266 (modifier_set (VK_RWIN
) ? w32_key_to_modifier (VK_RWIN
) : 0) |
3267 (modifier_set (VK_APPS
) ? w32_key_to_modifier (VK_APPS
) : 0) |
3268 (modifier_set (VK_SCROLL
) ? w32_key_to_modifier (VK_SCROLL
) : 0) |
3269 (modifier_set (VK_MENU
) ?
3270 ((NILP (Vw32_alt_is_meta
)) ? alt_modifier
: meta_modifier
) : 0));
3273 /* We map the VK_* modifiers into console modifier constants
3274 so that we can use the same routines to handle both console
3275 and window input. */
3278 construct_console_modifiers ()
3283 mods
|= (modifier_set (VK_SHIFT
)) ? SHIFT_PRESSED
: 0;
3284 mods
|= (modifier_set (VK_CAPITAL
)) ? CAPSLOCK_ON
: 0;
3285 mods
|= (modifier_set (VK_SCROLL
)) ? SCROLLLOCK_ON
: 0;
3286 mods
|= (modifier_set (VK_NUMLOCK
)) ? NUMLOCK_ON
: 0;
3287 mods
|= (modifier_set (VK_LCONTROL
)) ? LEFT_CTRL_PRESSED
: 0;
3288 mods
|= (modifier_set (VK_RCONTROL
)) ? RIGHT_CTRL_PRESSED
: 0;
3289 mods
|= (modifier_set (VK_LMENU
)) ? LEFT_ALT_PRESSED
: 0;
3290 mods
|= (modifier_set (VK_RMENU
)) ? RIGHT_ALT_PRESSED
: 0;
3291 mods
|= (modifier_set (VK_LWIN
)) ? LEFT_WIN_PRESSED
: 0;
3292 mods
|= (modifier_set (VK_RWIN
)) ? RIGHT_WIN_PRESSED
: 0;
3293 mods
|= (modifier_set (VK_APPS
)) ? APPS_PRESSED
: 0;
3299 w32_get_key_modifiers (unsigned int wparam
, unsigned int lparam
)
3303 /* Convert to emacs modifiers. */
3304 mods
= w32_kbd_mods_to_emacs (construct_console_modifiers (), wparam
);
3310 map_keypad_keys (unsigned int virt_key
, unsigned int extended
)
3312 if (virt_key
< VK_CLEAR
|| virt_key
> VK_DELETE
)
3315 if (virt_key
== VK_RETURN
)
3316 return (extended
? VK_NUMPAD_ENTER
: VK_RETURN
);
3318 if (virt_key
>= VK_PRIOR
&& virt_key
<= VK_DOWN
)
3319 return (!extended
? (VK_NUMPAD_PRIOR
+ (virt_key
- VK_PRIOR
)) : virt_key
);
3321 if (virt_key
== VK_INSERT
|| virt_key
== VK_DELETE
)
3322 return (!extended
? (VK_NUMPAD_INSERT
+ (virt_key
- VK_INSERT
)) : virt_key
);
3324 if (virt_key
== VK_CLEAR
)
3325 return (!extended
? VK_NUMPAD_CLEAR
: virt_key
);
3330 /* List of special key combinations which w32 would normally capture,
3331 but emacs should grab instead. Not directly visible to lisp, to
3332 simplify synchronization. Each item is an integer encoding a virtual
3333 key code and modifier combination to capture. */
3334 Lisp_Object w32_grabbed_keys
;
3336 #define HOTKEY(vk,mods) make_number (((vk) & 255) | ((mods) << 8))
3337 #define HOTKEY_ID(k) (XFASTINT (k) & 0xbfff)
3338 #define HOTKEY_VK_CODE(k) (XFASTINT (k) & 255)
3339 #define HOTKEY_MODIFIERS(k) (XFASTINT (k) >> 8)
3341 /* Register hot-keys for reserved key combinations when Emacs has
3342 keyboard focus, since this is the only way Emacs can receive key
3343 combinations like Alt-Tab which are used by the system. */
3346 register_hot_keys (hwnd
)
3349 Lisp_Object keylist
;
3351 /* Use GC_CONSP, since we are called asynchronously. */
3352 for (keylist
= w32_grabbed_keys
; GC_CONSP (keylist
); keylist
= XCDR (keylist
))
3354 Lisp_Object key
= XCAR (keylist
);
3356 /* Deleted entries get set to nil. */
3357 if (!INTEGERP (key
))
3360 RegisterHotKey (hwnd
, HOTKEY_ID (key
),
3361 HOTKEY_MODIFIERS (key
), HOTKEY_VK_CODE (key
));
3366 unregister_hot_keys (hwnd
)
3369 Lisp_Object keylist
;
3371 /* Use GC_CONSP, since we are called asynchronously. */
3372 for (keylist
= w32_grabbed_keys
; GC_CONSP (keylist
); keylist
= XCDR (keylist
))
3374 Lisp_Object key
= XCAR (keylist
);
3376 if (!INTEGERP (key
))
3379 UnregisterHotKey (hwnd
, HOTKEY_ID (key
));
3383 /* Main message dispatch loop. */
3386 w32_msg_pump (deferred_msg
* msg_buf
)
3392 msh_mousewheel
= RegisterWindowMessage (MSH_MOUSEWHEEL
);
3394 while (GetMessage (&msg
, NULL
, 0, 0))
3396 if (msg
.hwnd
== NULL
)
3398 switch (msg
.message
)
3401 /* Produced by complete_deferred_msg; just ignore. */
3403 case WM_EMACS_CREATEWINDOW
:
3404 w32_createwindow ((struct frame
*) msg
.wParam
);
3405 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
, 0, 0))
3408 case WM_EMACS_SETLOCALE
:
3409 SetThreadLocale (msg
.wParam
);
3410 /* Reply is not expected. */
3412 case WM_EMACS_SETKEYBOARDLAYOUT
:
3413 result
= (int) ActivateKeyboardLayout ((HKL
) msg
.wParam
, 0);
3414 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
,
3418 case WM_EMACS_REGISTER_HOT_KEY
:
3419 focus_window
= GetFocus ();
3420 if (focus_window
!= NULL
)
3421 RegisterHotKey (focus_window
,
3422 HOTKEY_ID (msg
.wParam
),
3423 HOTKEY_MODIFIERS (msg
.wParam
),
3424 HOTKEY_VK_CODE (msg
.wParam
));
3425 /* Reply is not expected. */
3427 case WM_EMACS_UNREGISTER_HOT_KEY
:
3428 focus_window
= GetFocus ();
3429 if (focus_window
!= NULL
)
3430 UnregisterHotKey (focus_window
, HOTKEY_ID (msg
.wParam
));
3431 /* Mark item as erased. NB: this code must be
3432 thread-safe. The next line is okay because the cons
3433 cell is never made into garbage and is not relocated by
3435 XCAR ((Lisp_Object
) msg
.lParam
) = Qnil
;
3436 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
, 0, 0))
3439 case WM_EMACS_TOGGLE_LOCK_KEY
:
3441 int vk_code
= (int) msg
.wParam
;
3442 int cur_state
= (GetKeyState (vk_code
) & 1);
3443 Lisp_Object new_state
= (Lisp_Object
) msg
.lParam
;
3445 /* NB: This code must be thread-safe. It is safe to
3446 call NILP because symbols are not relocated by GC,
3447 and pointer here is not touched by GC (so the markbit
3448 can't be set). Numbers are safe because they are
3449 immediate values. */
3450 if (NILP (new_state
)
3451 || (NUMBERP (new_state
)
3452 && (XUINT (new_state
)) & 1 != cur_state
))
3454 one_w32_display_info
.faked_key
= vk_code
;
3456 keybd_event ((BYTE
) vk_code
,
3457 (BYTE
) MapVirtualKey (vk_code
, 0),
3458 KEYEVENTF_EXTENDEDKEY
| KEYEVENTF_KEYUP
, 0);
3459 keybd_event ((BYTE
) vk_code
,
3460 (BYTE
) MapVirtualKey (vk_code
, 0),
3461 KEYEVENTF_EXTENDEDKEY
| 0, 0);
3462 keybd_event ((BYTE
) vk_code
,
3463 (BYTE
) MapVirtualKey (vk_code
, 0),
3464 KEYEVENTF_EXTENDEDKEY
| KEYEVENTF_KEYUP
, 0);
3465 cur_state
= !cur_state
;
3467 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
,
3473 DebPrint (("msg %x not expected by w32_msg_pump\n", msg
.message
));
3478 DispatchMessage (&msg
);
3481 /* Exit nested loop when our deferred message has completed. */
3482 if (msg_buf
->completed
)
3487 deferred_msg
* deferred_msg_head
;
3489 static deferred_msg
*
3490 find_deferred_msg (HWND hwnd
, UINT msg
)
3492 deferred_msg
* item
;
3494 /* Don't actually need synchronization for read access, since
3495 modification of single pointer is always atomic. */
3496 /* enter_crit (); */
3498 for (item
= deferred_msg_head
; item
!= NULL
; item
= item
->next
)
3499 if (item
->w32msg
.msg
.hwnd
== hwnd
3500 && item
->w32msg
.msg
.message
== msg
)
3503 /* leave_crit (); */
3509 send_deferred_msg (deferred_msg
* msg_buf
,
3515 /* Only input thread can send deferred messages. */
3516 if (GetCurrentThreadId () != dwWindowsThreadId
)
3519 /* It is an error to send a message that is already deferred. */
3520 if (find_deferred_msg (hwnd
, msg
) != NULL
)
3523 /* Enforced synchronization is not needed because this is the only
3524 function that alters deferred_msg_head, and the following critical
3525 section is guaranteed to only be serially reentered (since only the
3526 input thread can call us). */
3528 /* enter_crit (); */
3530 msg_buf
->completed
= 0;
3531 msg_buf
->next
= deferred_msg_head
;
3532 deferred_msg_head
= msg_buf
;
3533 my_post_msg (&msg_buf
->w32msg
, hwnd
, msg
, wParam
, lParam
);
3535 /* leave_crit (); */
3537 /* Start a new nested message loop to process other messages until
3538 this one is completed. */
3539 w32_msg_pump (msg_buf
);
3541 deferred_msg_head
= msg_buf
->next
;
3543 return msg_buf
->result
;
3547 complete_deferred_msg (HWND hwnd
, UINT msg
, LRESULT result
)
3549 deferred_msg
* msg_buf
= find_deferred_msg (hwnd
, msg
);
3551 if (msg_buf
== NULL
)
3552 /* Message may have been cancelled, so don't abort(). */
3555 msg_buf
->result
= result
;
3556 msg_buf
->completed
= 1;
3558 /* Ensure input thread is woken so it notices the completion. */
3559 PostThreadMessage (dwWindowsThreadId
, WM_NULL
, 0, 0);
3563 cancel_all_deferred_msgs ()
3565 deferred_msg
* item
;
3567 /* Don't actually need synchronization for read access, since
3568 modification of single pointer is always atomic. */
3569 /* enter_crit (); */
3571 for (item
= deferred_msg_head
; item
!= NULL
; item
= item
->next
)
3574 item
->completed
= 1;
3577 /* leave_crit (); */
3579 /* Ensure input thread is woken so it notices the completion. */
3580 PostThreadMessage (dwWindowsThreadId
, WM_NULL
, 0, 0);
3588 deferred_msg dummy_buf
;
3590 /* Ensure our message queue is created */
3592 PeekMessage (&msg
, NULL
, 0, 0, PM_NOREMOVE
);
3594 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
, 0, 0))
3597 memset (&dummy_buf
, 0, sizeof (dummy_buf
));
3598 dummy_buf
.w32msg
.msg
.hwnd
= NULL
;
3599 dummy_buf
.w32msg
.msg
.message
= WM_NULL
;
3601 /* This is the inital message loop which should only exit when the
3602 application quits. */
3603 w32_msg_pump (&dummy_buf
);
3609 post_character_message (hwnd
, msg
, wParam
, lParam
, modifiers
)
3619 wmsg
.dwModifiers
= modifiers
;
3621 /* Detect quit_char and set quit-flag directly. Note that we
3622 still need to post a message to ensure the main thread will be
3623 woken up if blocked in sys_select(), but we do NOT want to post
3624 the quit_char message itself (because it will usually be as if
3625 the user had typed quit_char twice). Instead, we post a dummy
3626 message that has no particular effect. */
3629 if (isalpha (c
) && wmsg
.dwModifiers
== ctrl_modifier
)
3630 c
= make_ctrl_char (c
) & 0377;
3632 || (wmsg
.dwModifiers
== 0 &&
3633 XFASTINT (Vw32_quit_key
) && wParam
== XFASTINT (Vw32_quit_key
)))
3637 /* The choice of message is somewhat arbitrary, as long as
3638 the main thread handler just ignores it. */
3641 /* Interrupt any blocking system calls. */
3644 /* As a safety precaution, forcibly complete any deferred
3645 messages. This is a kludge, but I don't see any particularly
3646 clean way to handle the situation where a deferred message is
3647 "dropped" in the lisp thread, and will thus never be
3648 completed, eg. by the user trying to activate the menubar
3649 when the lisp thread is busy, and then typing C-g when the
3650 menubar doesn't open promptly (with the result that the
3651 menubar never responds at all because the deferred
3652 WM_INITMENU message is never completed). Another problem
3653 situation is when the lisp thread calls SendMessage (to send
3654 a window manager command) when a message has been deferred;
3655 the lisp thread gets blocked indefinitely waiting for the
3656 deferred message to be completed, which itself is waiting for
3657 the lisp thread to respond.
3659 Note that we don't want to block the input thread waiting for
3660 a reponse from the lisp thread (although that would at least
3661 solve the deadlock problem above), because we want to be able
3662 to receive C-g to interrupt the lisp thread. */
3663 cancel_all_deferred_msgs ();
3667 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3670 /* Main window procedure */
3673 w32_wnd_proc (hwnd
, msg
, wParam
, lParam
)
3680 struct w32_display_info
*dpyinfo
= &one_w32_display_info
;
3682 int windows_translate
;
3685 /* Note that it is okay to call x_window_to_frame, even though we are
3686 not running in the main lisp thread, because frame deletion
3687 requires the lisp thread to synchronize with this thread. Thus, if
3688 a frame struct is returned, it can be used without concern that the
3689 lisp thread might make it disappear while we are using it.
3691 NB. Walking the frame list in this thread is safe (as long as
3692 writes of Lisp_Object slots are atomic, which they are on Windows).
3693 Although delete-frame can destructively modify the frame list while
3694 we are walking it, a garbage collection cannot occur until after
3695 delete-frame has synchronized with this thread.
3697 It is also safe to use functions that make GDI calls, such as
3698 w32_clear_rect, because these functions must obtain a DC handle
3699 from the frame struct using get_frame_dc which is thread-aware. */
3704 f
= x_window_to_frame (dpyinfo
, hwnd
);
3707 GetUpdateRect (hwnd
, &wmsg
.rect
, FALSE
);
3708 w32_clear_rect (f
, NULL
, &wmsg
.rect
);
3710 #if defined (W32_DEBUG_DISPLAY)
3711 DebPrint (("WM_ERASEBKGND: erasing %d,%d-%d,%d\n",
3712 wmsg
.rect
.left
, wmsg
.rect
.top
, wmsg
.rect
.right
,
3714 #endif /* W32_DEBUG_DISPLAY */
3717 case WM_PALETTECHANGED
:
3718 /* ignore our own changes */
3719 if ((HWND
)wParam
!= hwnd
)
3721 f
= x_window_to_frame (dpyinfo
, hwnd
);
3723 /* get_frame_dc will realize our palette and force all
3724 frames to be redrawn if needed. */
3725 release_frame_dc (f
, get_frame_dc (f
));
3730 PAINTSTRUCT paintStruct
;
3733 /* MSDN Docs say not to call BeginPaint if GetUpdateRect
3734 fails. Apparently this can happen under some
3736 if (!w32_strict_painting
|| GetUpdateRect (hwnd
, &update_rect
, FALSE
))
3739 BeginPaint (hwnd
, &paintStruct
);
3741 if (w32_strict_painting
)
3742 /* The rectangles returned by GetUpdateRect and BeginPaint
3743 do not always match. GetUpdateRect seems to be the
3744 more reliable of the two. */
3745 wmsg
.rect
= update_rect
;
3747 wmsg
.rect
= paintStruct
.rcPaint
;
3749 #if defined (W32_DEBUG_DISPLAY)
3750 DebPrint (("WM_PAINT: painting %d,%d-%d,%d\n", wmsg
.rect
.left
,
3751 wmsg
.rect
.top
, wmsg
.rect
.right
, wmsg
.rect
.bottom
));
3752 DebPrint (("WM_PAINT: update region is %d,%d-%d,%d\n",
3753 update_rect
.left
, update_rect
.top
,
3754 update_rect
.right
, update_rect
.bottom
));
3756 EndPaint (hwnd
, &paintStruct
);
3759 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3764 /* If GetUpdateRect returns 0 (meaning there is no update
3765 region), assume the whole window needs to be repainted. */
3766 GetClientRect(hwnd
, &wmsg
.rect
);
3767 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3771 case WM_INPUTLANGCHANGE
:
3772 /* Inform lisp thread of keyboard layout changes. */
3773 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3775 /* Clear dead keys in the keyboard state; for simplicity only
3776 preserve modifier key states. */
3781 GetKeyboardState (keystate
);
3782 for (i
= 0; i
< 256; i
++)
3799 SetKeyboardState (keystate
);
3804 /* Synchronize hot keys with normal input. */
3805 PostMessage (hwnd
, WM_KEYDOWN
, HIWORD (lParam
), 0);
3810 record_keyup (wParam
, lParam
);
3815 /* Ignore keystrokes we fake ourself; see below. */
3816 if (dpyinfo
->faked_key
== wParam
)
3818 dpyinfo
->faked_key
= 0;
3819 /* Make sure TranslateMessage sees them though (as long as
3820 they don't produce WM_CHAR messages). This ensures that
3821 indicator lights are toggled promptly on Windows 9x, for
3823 if (lispy_function_keys
[wParam
] != 0)
3825 windows_translate
= 1;
3831 /* Synchronize modifiers with current keystroke. */
3833 record_keydown (wParam
, lParam
);
3834 wParam
= map_keypad_keys (wParam
, (lParam
& 0x1000000L
) != 0);
3836 windows_translate
= 0;
3841 if (NILP (Vw32_pass_lwindow_to_system
))
3843 /* Prevent system from acting on keyup (which opens the
3844 Start menu if no other key was pressed) by simulating a
3845 press of Space which we will ignore. */
3846 if (GetAsyncKeyState (wParam
) & 1)
3848 if (NUMBERP (Vw32_phantom_key_code
))
3849 key
= XUINT (Vw32_phantom_key_code
) & 255;
3852 dpyinfo
->faked_key
= key
;
3853 keybd_event (key
, (BYTE
) MapVirtualKey (key
, 0), 0, 0);
3856 if (!NILP (Vw32_lwindow_modifier
))
3860 if (NILP (Vw32_pass_rwindow_to_system
))
3862 if (GetAsyncKeyState (wParam
) & 1)
3864 if (NUMBERP (Vw32_phantom_key_code
))
3865 key
= XUINT (Vw32_phantom_key_code
) & 255;
3868 dpyinfo
->faked_key
= key
;
3869 keybd_event (key
, (BYTE
) MapVirtualKey (key
, 0), 0, 0);
3872 if (!NILP (Vw32_rwindow_modifier
))
3876 if (!NILP (Vw32_apps_modifier
))
3880 if (NILP (Vw32_pass_alt_to_system
))
3881 /* Prevent DefWindowProc from activating the menu bar if an
3882 Alt key is pressed and released by itself. */
3884 windows_translate
= 1;
3887 /* Decide whether to treat as modifier or function key. */
3888 if (NILP (Vw32_enable_caps_lock
))
3889 goto disable_lock_key
;
3890 windows_translate
= 1;
3893 /* Decide whether to treat as modifier or function key. */
3894 if (NILP (Vw32_enable_num_lock
))
3895 goto disable_lock_key
;
3896 windows_translate
= 1;
3899 /* Decide whether to treat as modifier or function key. */
3900 if (NILP (Vw32_scroll_lock_modifier
))
3901 goto disable_lock_key
;
3902 windows_translate
= 1;
3905 /* Ensure the appropriate lock key state (and indicator light)
3906 remains in the same state. We do this by faking another
3907 press of the relevant key. Apparently, this really is the
3908 only way to toggle the state of the indicator lights. */
3909 dpyinfo
->faked_key
= wParam
;
3910 keybd_event ((BYTE
) wParam
, (BYTE
) MapVirtualKey (wParam
, 0),
3911 KEYEVENTF_EXTENDEDKEY
| KEYEVENTF_KEYUP
, 0);
3912 keybd_event ((BYTE
) wParam
, (BYTE
) MapVirtualKey (wParam
, 0),
3913 KEYEVENTF_EXTENDEDKEY
| 0, 0);
3914 keybd_event ((BYTE
) wParam
, (BYTE
) MapVirtualKey (wParam
, 0),
3915 KEYEVENTF_EXTENDEDKEY
| KEYEVENTF_KEYUP
, 0);
3916 /* Ensure indicator lights are updated promptly on Windows 9x
3917 (TranslateMessage apparently does this), after forwarding
3919 post_character_message (hwnd
, msg
, wParam
, lParam
,
3920 w32_get_key_modifiers (wParam
, lParam
));
3921 windows_translate
= 1;
3925 case VK_PROCESSKEY
: /* Generated by IME. */
3926 windows_translate
= 1;
3929 /* Windows maps Ctrl-Pause (aka Ctrl-Break) into VK_CANCEL,
3930 which is confusing for purposes of key binding; convert
3931 VK_CANCEL events into VK_PAUSE events. */
3935 /* Windows maps Ctrl-NumLock into VK_PAUSE, which is confusing
3936 for purposes of key binding; convert these back into
3937 VK_NUMLOCK events, at least when we want to see NumLock key
3938 presses. (Note that there is never any possibility that
3939 VK_PAUSE with Ctrl really is C-Pause as per above.) */
3940 if (NILP (Vw32_enable_num_lock
) && modifier_set (VK_CONTROL
))
3941 wParam
= VK_NUMLOCK
;
3944 /* If not defined as a function key, change it to a WM_CHAR message. */
3945 if (lispy_function_keys
[wParam
] == 0)
3947 DWORD modifiers
= construct_console_modifiers ();
3949 if (!NILP (Vw32_recognize_altgr
)
3950 && modifier_set (VK_LCONTROL
) && modifier_set (VK_RMENU
))
3952 /* Always let TranslateMessage handle AltGr key chords;
3953 for some reason, ToAscii doesn't always process AltGr
3954 chords correctly. */
3955 windows_translate
= 1;
3957 else if ((modifiers
& (~SHIFT_PRESSED
& ~CAPSLOCK_ON
)) != 0)
3959 /* Handle key chords including any modifiers other
3960 than shift directly, in order to preserve as much
3961 modifier information as possible. */
3962 if ('A' <= wParam
&& wParam
<= 'Z')
3964 /* Don't translate modified alphabetic keystrokes,
3965 so the user doesn't need to constantly switch
3966 layout to type control or meta keystrokes when
3967 the normal layout translates alphabetic
3968 characters to non-ascii characters. */
3969 if (!modifier_set (VK_SHIFT
))
3970 wParam
+= ('a' - 'A');
3975 /* Try to handle other keystrokes by determining the
3976 base character (ie. translating the base key plus
3980 KEY_EVENT_RECORD key
;
3982 key
.bKeyDown
= TRUE
;
3983 key
.wRepeatCount
= 1;
3984 key
.wVirtualKeyCode
= wParam
;
3985 key
.wVirtualScanCode
= (lParam
& 0xFF0000) >> 16;
3986 key
.uChar
.AsciiChar
= 0;
3987 key
.dwControlKeyState
= modifiers
;
3989 add
= w32_kbd_patch_key (&key
);
3990 /* 0 means an unrecognised keycode, negative means
3991 dead key. Ignore both. */
3994 /* Forward asciified character sequence. */
3995 post_character_message
3996 (hwnd
, WM_CHAR
, key
.uChar
.AsciiChar
, lParam
,
3997 w32_get_key_modifiers (wParam
, lParam
));
3998 w32_kbd_patch_key (&key
);
4005 /* Let TranslateMessage handle everything else. */
4006 windows_translate
= 1;
4012 if (windows_translate
)
4014 MSG windows_msg
= { hwnd
, msg
, wParam
, lParam
, 0, {0,0} };
4016 windows_msg
.time
= GetMessageTime ();
4017 TranslateMessage (&windows_msg
);
4025 post_character_message (hwnd
, msg
, wParam
, lParam
,
4026 w32_get_key_modifiers (wParam
, lParam
));
4029 /* Simulate middle mouse button events when left and right buttons
4030 are used together, but only if user has two button mouse. */
4031 case WM_LBUTTONDOWN
:
4032 case WM_RBUTTONDOWN
:
4033 if (XINT (Vw32_num_mouse_buttons
) == 3)
4034 goto handle_plain_button
;
4037 int this = (msg
== WM_LBUTTONDOWN
) ? LMOUSE
: RMOUSE
;
4038 int other
= (msg
== WM_LBUTTONDOWN
) ? RMOUSE
: LMOUSE
;
4040 if (button_state
& this)
4043 if (button_state
== 0)
4046 button_state
|= this;
4048 if (button_state
& other
)
4050 if (mouse_button_timer
)
4052 KillTimer (hwnd
, mouse_button_timer
);
4053 mouse_button_timer
= 0;
4055 /* Generate middle mouse event instead. */
4056 msg
= WM_MBUTTONDOWN
;
4057 button_state
|= MMOUSE
;
4059 else if (button_state
& MMOUSE
)
4061 /* Ignore button event if we've already generated a
4062 middle mouse down event. This happens if the
4063 user releases and press one of the two buttons
4064 after we've faked a middle mouse event. */
4069 /* Flush out saved message. */
4070 post_msg (&saved_mouse_button_msg
);
4072 wmsg
.dwModifiers
= w32_get_modifiers ();
4073 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4075 /* Clear message buffer. */
4076 saved_mouse_button_msg
.msg
.hwnd
= 0;
4080 /* Hold onto message for now. */
4081 mouse_button_timer
=
4082 SetTimer (hwnd
, MOUSE_BUTTON_ID
,
4083 XINT (Vw32_mouse_button_tolerance
), NULL
);
4084 saved_mouse_button_msg
.msg
.hwnd
= hwnd
;
4085 saved_mouse_button_msg
.msg
.message
= msg
;
4086 saved_mouse_button_msg
.msg
.wParam
= wParam
;
4087 saved_mouse_button_msg
.msg
.lParam
= lParam
;
4088 saved_mouse_button_msg
.msg
.time
= GetMessageTime ();
4089 saved_mouse_button_msg
.dwModifiers
= w32_get_modifiers ();
4096 if (XINT (Vw32_num_mouse_buttons
) == 3)
4097 goto handle_plain_button
;
4100 int this = (msg
== WM_LBUTTONUP
) ? LMOUSE
: RMOUSE
;
4101 int other
= (msg
== WM_LBUTTONUP
) ? RMOUSE
: LMOUSE
;
4103 if ((button_state
& this) == 0)
4106 button_state
&= ~this;
4108 if (button_state
& MMOUSE
)
4110 /* Only generate event when second button is released. */
4111 if ((button_state
& other
) == 0)
4114 button_state
&= ~MMOUSE
;
4116 if (button_state
) abort ();
4123 /* Flush out saved message if necessary. */
4124 if (saved_mouse_button_msg
.msg
.hwnd
)
4126 post_msg (&saved_mouse_button_msg
);
4129 wmsg
.dwModifiers
= w32_get_modifiers ();
4130 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4132 /* Always clear message buffer and cancel timer. */
4133 saved_mouse_button_msg
.msg
.hwnd
= 0;
4134 KillTimer (hwnd
, mouse_button_timer
);
4135 mouse_button_timer
= 0;
4137 if (button_state
== 0)
4142 case WM_MBUTTONDOWN
:
4144 handle_plain_button
:
4149 if (parse_button (msg
, &button
, &up
))
4151 if (up
) ReleaseCapture ();
4152 else SetCapture (hwnd
);
4153 button
= (button
== 0) ? LMOUSE
:
4154 ((button
== 1) ? MMOUSE
: RMOUSE
);
4156 button_state
&= ~button
;
4158 button_state
|= button
;
4162 wmsg
.dwModifiers
= w32_get_modifiers ();
4163 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4168 if (XINT (Vw32_mouse_move_interval
) <= 0
4169 || (msg
== WM_MOUSEMOVE
&& button_state
== 0))
4171 wmsg
.dwModifiers
= w32_get_modifiers ();
4172 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4176 /* Hang onto mouse move and scroll messages for a bit, to avoid
4177 sending such events to Emacs faster than it can process them.
4178 If we get more events before the timer from the first message
4179 expires, we just replace the first message. */
4181 if (saved_mouse_move_msg
.msg
.hwnd
== 0)
4183 SetTimer (hwnd
, MOUSE_MOVE_ID
,
4184 XINT (Vw32_mouse_move_interval
), NULL
);
4186 /* Hold onto message for now. */
4187 saved_mouse_move_msg
.msg
.hwnd
= hwnd
;
4188 saved_mouse_move_msg
.msg
.message
= msg
;
4189 saved_mouse_move_msg
.msg
.wParam
= wParam
;
4190 saved_mouse_move_msg
.msg
.lParam
= lParam
;
4191 saved_mouse_move_msg
.msg
.time
= GetMessageTime ();
4192 saved_mouse_move_msg
.dwModifiers
= w32_get_modifiers ();
4197 wmsg
.dwModifiers
= w32_get_modifiers ();
4198 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4202 wmsg
.dwModifiers
= w32_get_modifiers ();
4203 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4207 /* Flush out saved messages if necessary. */
4208 if (wParam
== mouse_button_timer
)
4210 if (saved_mouse_button_msg
.msg
.hwnd
)
4212 post_msg (&saved_mouse_button_msg
);
4213 saved_mouse_button_msg
.msg
.hwnd
= 0;
4215 KillTimer (hwnd
, mouse_button_timer
);
4216 mouse_button_timer
= 0;
4218 else if (wParam
== mouse_move_timer
)
4220 if (saved_mouse_move_msg
.msg
.hwnd
)
4222 post_msg (&saved_mouse_move_msg
);
4223 saved_mouse_move_msg
.msg
.hwnd
= 0;
4225 KillTimer (hwnd
, mouse_move_timer
);
4226 mouse_move_timer
= 0;
4231 /* Windows doesn't send us focus messages when putting up and
4232 taking down a system popup dialog as for Ctrl-Alt-Del on Windows 95.
4233 The only indication we get that something happened is receiving
4234 this message afterwards. So this is a good time to reset our
4235 keyboard modifiers' state. */
4242 /* We must ensure menu bar is fully constructed and up to date
4243 before allowing user interaction with it. To achieve this
4244 we send this message to the lisp thread and wait for a
4245 reply (whose value is not actually needed) to indicate that
4246 the menu bar is now ready for use, so we can now return.
4248 To remain responsive in the meantime, we enter a nested message
4249 loop that can process all other messages.
4251 However, we skip all this if the message results from calling
4252 TrackPopupMenu - in fact, we must NOT attempt to send the lisp
4253 thread a message because it is blocked on us at this point. We
4254 set menubar_active before calling TrackPopupMenu to indicate
4255 this (there is no possibility of confusion with real menubar
4258 f
= x_window_to_frame (dpyinfo
, hwnd
);
4260 && (f
->output_data
.w32
->menubar_active
4261 /* We can receive this message even in the absence of a
4262 menubar (ie. when the system menu is activated) - in this
4263 case we do NOT want to forward the message, otherwise it
4264 will cause the menubar to suddenly appear when the user
4265 had requested it to be turned off! */
4266 || f
->output_data
.w32
->menubar_widget
== NULL
))
4270 deferred_msg msg_buf
;
4272 /* Detect if message has already been deferred; in this case
4273 we cannot return any sensible value to ignore this. */
4274 if (find_deferred_msg (hwnd
, msg
) != NULL
)
4277 return send_deferred_msg (&msg_buf
, hwnd
, msg
, wParam
, lParam
);
4280 case WM_EXITMENULOOP
:
4281 f
= x_window_to_frame (dpyinfo
, hwnd
);
4283 /* Indicate that menubar can be modified again. */
4285 f
->output_data
.w32
->menubar_active
= 0;
4288 case WM_MEASUREITEM
:
4289 f
= x_window_to_frame (dpyinfo
, hwnd
);
4292 MEASUREITEMSTRUCT
* pMis
= (MEASUREITEMSTRUCT
*) lParam
;
4294 if (pMis
->CtlType
== ODT_MENU
)
4296 /* Work out dimensions for popup menu titles. */
4297 char * title
= (char *) pMis
->itemData
;
4298 HDC hdc
= GetDC (hwnd
);
4299 HFONT menu_font
= GetCurrentObject (hdc
, OBJ_FONT
);
4300 LOGFONT menu_logfont
;
4304 GetObject (menu_font
, sizeof (menu_logfont
), &menu_logfont
);
4305 menu_logfont
.lfWeight
= FW_BOLD
;
4306 menu_font
= CreateFontIndirect (&menu_logfont
);
4307 old_font
= SelectObject (hdc
, menu_font
);
4309 GetTextExtentPoint32 (hdc
, title
, strlen (title
), &size
);
4310 pMis
->itemWidth
= size
.cx
;
4311 pMis
->itemHeight
= GetSystemMetrics (SM_CYMENUSIZE
);
4312 if (pMis
->itemHeight
< size
.cy
)
4313 pMis
->itemHeight
= size
.cy
;
4315 SelectObject (hdc
, old_font
);
4316 DeleteObject (menu_font
);
4317 ReleaseDC (hwnd
, hdc
);
4324 f
= x_window_to_frame (dpyinfo
, hwnd
);
4327 DRAWITEMSTRUCT
* pDis
= (DRAWITEMSTRUCT
*) lParam
;
4329 if (pDis
->CtlType
== ODT_MENU
)
4331 /* Draw popup menu title. */
4332 char * title
= (char *) pDis
->itemData
;
4333 HDC hdc
= pDis
->hDC
;
4334 HFONT menu_font
= GetCurrentObject (hdc
, OBJ_FONT
);
4335 LOGFONT menu_logfont
;
4338 GetObject (menu_font
, sizeof (menu_logfont
), &menu_logfont
);
4339 menu_logfont
.lfWeight
= FW_BOLD
;
4340 menu_font
= CreateFontIndirect (&menu_logfont
);
4341 old_font
= SelectObject (hdc
, menu_font
);
4343 /* Always draw title as if not selected. */
4345 pDis
->rcItem
.left
+ GetSystemMetrics (SM_CXMENUCHECK
),
4347 ETO_OPAQUE
, &pDis
->rcItem
,
4348 title
, strlen (title
), NULL
);
4350 SelectObject (hdc
, old_font
);
4351 DeleteObject (menu_font
);
4358 /* Still not right - can't distinguish between clicks in the
4359 client area of the frame from clicks forwarded from the scroll
4360 bars - may have to hook WM_NCHITTEST to remember the mouse
4361 position and then check if it is in the client area ourselves. */
4362 case WM_MOUSEACTIVATE
:
4363 /* Discard the mouse click that activates a frame, allowing the
4364 user to click anywhere without changing point (or worse!).
4365 Don't eat mouse clicks on scrollbars though!! */
4366 if (LOWORD (lParam
) == HTCLIENT
)
4367 return MA_ACTIVATEANDEAT
;
4371 case WM_ACTIVATEAPP
:
4373 case WM_WINDOWPOSCHANGED
:
4375 /* Inform lisp thread that a frame might have just been obscured
4376 or exposed, so should recheck visibility of all frames. */
4377 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4381 dpyinfo
->faked_key
= 0;
4383 register_hot_keys (hwnd
);
4386 unregister_hot_keys (hwnd
);
4393 wmsg
.dwModifiers
= w32_get_modifiers ();
4394 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4398 wmsg
.dwModifiers
= w32_get_modifiers ();
4399 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4402 case WM_WINDOWPOSCHANGING
:
4405 LPWINDOWPOS lppos
= (WINDOWPOS
*) lParam
;
4407 wp
.length
= sizeof (WINDOWPLACEMENT
);
4408 GetWindowPlacement (hwnd
, &wp
);
4410 if (wp
.showCmd
!= SW_SHOWMINIMIZED
&& (lppos
->flags
& SWP_NOSIZE
) == 0)
4417 DWORD internal_border
;
4418 DWORD scrollbar_extra
;
4421 wp
.length
= sizeof(wp
);
4422 GetWindowRect (hwnd
, &wr
);
4426 font_width
= GetWindowLong (hwnd
, WND_FONTWIDTH_INDEX
);
4427 line_height
= GetWindowLong (hwnd
, WND_LINEHEIGHT_INDEX
);
4428 internal_border
= GetWindowLong (hwnd
, WND_BORDER_INDEX
);
4429 scrollbar_extra
= GetWindowLong (hwnd
, WND_SCROLLBAR_INDEX
);
4433 memset (&rect
, 0, sizeof (rect
));
4434 AdjustWindowRect (&rect
, GetWindowLong (hwnd
, GWL_STYLE
),
4435 GetMenu (hwnd
) != NULL
);
4437 /* Force width and height of client area to be exact
4438 multiples of the character cell dimensions. */
4439 wdiff
= (lppos
->cx
- (rect
.right
- rect
.left
)
4440 - 2 * internal_border
- scrollbar_extra
)
4442 hdiff
= (lppos
->cy
- (rect
.bottom
- rect
.top
)
4443 - 2 * internal_border
)
4448 /* For right/bottom sizing we can just fix the sizes.
4449 However for top/left sizing we will need to fix the X
4450 and Y positions as well. */
4455 if (wp
.showCmd
!= SW_SHOWMAXIMIZED
4456 && (lppos
->flags
& SWP_NOMOVE
) == 0)
4458 if (lppos
->x
!= wr
.left
|| lppos
->y
!= wr
.top
)
4465 lppos
->flags
|= SWP_NOMOVE
;
4476 case WM_GETMINMAXINFO
:
4477 /* Hack to correct bug that allows Emacs frames to be resized
4478 below the Minimum Tracking Size. */
4479 ((LPMINMAXINFO
) lParam
)->ptMinTrackSize
.y
++;
4482 case WM_EMACS_CREATESCROLLBAR
:
4483 return (LRESULT
) w32_createscrollbar ((struct frame
*) wParam
,
4484 (struct scroll_bar
*) lParam
);
4486 case WM_EMACS_SHOWWINDOW
:
4487 return ShowWindow ((HWND
) wParam
, (WPARAM
) lParam
);
4489 case WM_EMACS_SETFOREGROUND
:
4491 HWND foreground_window
;
4492 DWORD foreground_thread
, retval
;
4494 /* On NT 5.0, and apparently Windows 98, it is necessary to
4495 attach to the thread that currently has focus in order to
4496 pull the focus away from it. */
4497 foreground_window
= GetForegroundWindow ();
4498 foreground_thread
= GetWindowThreadProcessId (foreground_window
, NULL
);
4499 if (!foreground_window
4500 || foreground_thread
== GetCurrentThreadId ()
4501 || !AttachThreadInput (GetCurrentThreadId (),
4502 foreground_thread
, TRUE
))
4503 foreground_thread
= 0;
4505 retval
= SetForegroundWindow ((HWND
) wParam
);
4507 /* Detach from the previous foreground thread. */
4508 if (foreground_thread
)
4509 AttachThreadInput (GetCurrentThreadId (),
4510 foreground_thread
, FALSE
);
4515 case WM_EMACS_SETWINDOWPOS
:
4517 WINDOWPOS
* pos
= (WINDOWPOS
*) wParam
;
4518 return SetWindowPos (hwnd
, pos
->hwndInsertAfter
,
4519 pos
->x
, pos
->y
, pos
->cx
, pos
->cy
, pos
->flags
);
4522 case WM_EMACS_DESTROYWINDOW
:
4523 DragAcceptFiles ((HWND
) wParam
, FALSE
);
4524 return DestroyWindow ((HWND
) wParam
);
4526 case WM_EMACS_TRACKPOPUPMENU
:
4531 pos
= (POINT
*)lParam
;
4532 flags
= TPM_CENTERALIGN
;
4533 if (button_state
& LMOUSE
)
4534 flags
|= TPM_LEFTBUTTON
;
4535 else if (button_state
& RMOUSE
)
4536 flags
|= TPM_RIGHTBUTTON
;
4538 /* Remember we did a SetCapture on the initial mouse down event,
4539 so for safety, we make sure the capture is cancelled now. */
4543 /* Use menubar_active to indicate that WM_INITMENU is from
4544 TrackPopupMenu below, and should be ignored. */
4545 f
= x_window_to_frame (dpyinfo
, hwnd
);
4547 f
->output_data
.w32
->menubar_active
= 1;
4549 if (TrackPopupMenu ((HMENU
)wParam
, flags
, pos
->x
, pos
->y
,
4553 /* Eat any mouse messages during popupmenu */
4554 while (PeekMessage (&amsg
, hwnd
, WM_MOUSEFIRST
, WM_MOUSELAST
,
4556 /* Get the menu selection, if any */
4557 if (PeekMessage (&amsg
, hwnd
, WM_COMMAND
, WM_COMMAND
, PM_REMOVE
))
4559 retval
= LOWORD (amsg
.wParam
);
4575 /* Check for messages registered at runtime. */
4576 if (msg
== msh_mousewheel
)
4578 wmsg
.dwModifiers
= w32_get_modifiers ();
4579 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4584 return DefWindowProc (hwnd
, msg
, wParam
, lParam
);
4588 /* The most common default return code for handled messages is 0. */
4593 my_create_window (f
)
4598 if (!PostThreadMessage (dwWindowsThreadId
, WM_EMACS_CREATEWINDOW
, (WPARAM
)f
, 0))
4600 GetMessage (&msg
, NULL
, WM_EMACS_DONE
, WM_EMACS_DONE
);
4603 /* Create and set up the w32 window for frame F. */
4606 w32_window (f
, window_prompting
, minibuffer_only
)
4608 long window_prompting
;
4609 int minibuffer_only
;
4613 /* Use the resource name as the top-level window name
4614 for looking up resources. Make a non-Lisp copy
4615 for the window manager, so GC relocation won't bother it.
4617 Elsewhere we specify the window name for the window manager. */
4620 char *str
= (char *) XSTRING (Vx_resource_name
)->data
;
4621 f
->namebuf
= (char *) xmalloc (strlen (str
) + 1);
4622 strcpy (f
->namebuf
, str
);
4625 my_create_window (f
);
4627 validate_x_resource_name ();
4629 /* x_set_name normally ignores requests to set the name if the
4630 requested name is the same as the current name. This is the one
4631 place where that assumption isn't correct; f->name is set, but
4632 the server hasn't been told. */
4635 int explicit = f
->explicit_name
;
4637 f
->explicit_name
= 0;
4640 x_set_name (f
, name
, explicit);
4645 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
4646 initialize_frame_menubar (f
);
4648 if (FRAME_W32_WINDOW (f
) == 0)
4649 error ("Unable to create window");
4652 /* Handle the icon stuff for this window. Perhaps later we might
4653 want an x_set_icon_position which can be called interactively as
4661 Lisp_Object icon_x
, icon_y
;
4663 /* Set the position of the icon. Note that Windows 95 groups all
4664 icons in the tray. */
4665 icon_x
= x_get_arg (parms
, Qicon_left
, 0, 0, number
);
4666 icon_y
= x_get_arg (parms
, Qicon_top
, 0, 0, number
);
4667 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
4669 CHECK_NUMBER (icon_x
, 0);
4670 CHECK_NUMBER (icon_y
, 0);
4672 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
4673 error ("Both left and top icon corners of icon must be specified");
4677 if (! EQ (icon_x
, Qunbound
))
4678 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
4681 /* Start up iconic or window? */
4682 x_wm_set_window_state
4683 (f
, (EQ (x_get_arg (parms
, Qvisibility
, 0, 0, symbol
), Qicon
)
4687 x_text_icon (f
, (char *) XSTRING ((!NILP (f
->icon_name
)
4695 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
4697 "Make a new window, which is called a \"frame\" in Emacs terms.\n\
4698 Returns an Emacs frame object.\n\
4699 ALIST is an alist of frame parameters.\n\
4700 If the parameters specify that the frame should not have a minibuffer,\n\
4701 and do not specify a specific minibuffer window to use,\n\
4702 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
4703 be shared by the new frame.\n\
4705 This function is an internal primitive--use `make-frame' instead.")
4710 Lisp_Object frame
, tem
;
4712 int minibuffer_only
= 0;
4713 long window_prompting
= 0;
4715 int count
= specpdl_ptr
- specpdl
;
4716 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
4717 Lisp_Object display
;
4718 struct w32_display_info
*dpyinfo
;
4724 /* Use this general default value to start with
4725 until we know if this frame has a specified name. */
4726 Vx_resource_name
= Vinvocation_name
;
4728 display
= x_get_arg (parms
, Qdisplay
, 0, 0, string
);
4729 if (EQ (display
, Qunbound
))
4731 dpyinfo
= check_x_display_info (display
);
4733 kb
= dpyinfo
->kboard
;
4735 kb
= &the_only_kboard
;
4738 name
= x_get_arg (parms
, Qname
, "name", "Name", string
);
4740 && ! EQ (name
, Qunbound
)
4742 error ("Invalid frame name--not a string or nil");
4745 Vx_resource_name
= name
;
4747 /* See if parent window is specified. */
4748 parent
= x_get_arg (parms
, Qparent_id
, NULL
, NULL
, number
);
4749 if (EQ (parent
, Qunbound
))
4751 if (! NILP (parent
))
4752 CHECK_NUMBER (parent
, 0);
4754 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
4755 /* No need to protect DISPLAY because that's not used after passing
4756 it to make_frame_without_minibuffer. */
4758 GCPRO4 (parms
, parent
, name
, frame
);
4759 tem
= x_get_arg (parms
, Qminibuffer
, 0, 0, symbol
);
4760 if (EQ (tem
, Qnone
) || NILP (tem
))
4761 f
= make_frame_without_minibuffer (Qnil
, kb
, display
);
4762 else if (EQ (tem
, Qonly
))
4764 f
= make_minibuffer_frame ();
4765 minibuffer_only
= 1;
4767 else if (WINDOWP (tem
))
4768 f
= make_frame_without_minibuffer (tem
, kb
, display
);
4772 XSETFRAME (frame
, f
);
4774 /* Note that Windows does support scroll bars. */
4775 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
4776 /* By default, make scrollbars the system standard width. */
4777 f
->scroll_bar_pixel_width
= GetSystemMetrics (SM_CXVSCROLL
);
4779 f
->output_method
= output_w32
;
4780 f
->output_data
.w32
= (struct w32_output
*) xmalloc (sizeof (struct w32_output
));
4781 bzero (f
->output_data
.w32
, sizeof (struct w32_output
));
4783 FRAME_FONTSET (f
) = -1;
4786 = x_get_arg (parms
, Qicon_name
, "iconName", "Title", string
);
4787 if (! STRINGP (f
->icon_name
))
4788 f
->icon_name
= Qnil
;
4790 /* FRAME_W32_DISPLAY_INFO (f) = dpyinfo; */
4792 FRAME_KBOARD (f
) = kb
;
4795 /* Specify the parent under which to make this window. */
4799 f
->output_data
.w32
->parent_desc
= (Window
) parent
;
4800 f
->output_data
.w32
->explicit_parent
= 1;
4804 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
4805 f
->output_data
.w32
->explicit_parent
= 0;
4808 /* Note that the frame has no physical cursor right now. */
4809 f
->phys_cursor_x
= -1;
4811 /* Set the name; the functions to which we pass f expect the name to
4813 if (EQ (name
, Qunbound
) || NILP (name
))
4815 f
->name
= build_string (dpyinfo
->w32_id_name
);
4816 f
->explicit_name
= 0;
4821 f
->explicit_name
= 1;
4822 /* use the frame's title when getting resources for this frame. */
4823 specbind (Qx_resource_name
, name
);
4826 /* Create fontsets from `global_fontset_alist' before handling fonts. */
4827 for (tem
= Vglobal_fontset_alist
; CONSP (tem
); tem
= XCONS (tem
)->cdr
)
4828 fs_register_fontset (f
, XCONS (tem
)->car
);
4830 /* Extract the window parameters from the supplied values
4831 that are needed to determine window geometry. */
4835 font
= x_get_arg (parms
, Qfont
, "font", "Font", string
);
4837 /* First, try whatever font the caller has specified. */
4840 tem
= Fquery_fontset (font
, Qnil
);
4842 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
4844 font
= x_new_font (f
, XSTRING (font
)->data
);
4846 /* Try out a font which we hope has bold and italic variations. */
4847 if (!STRINGP (font
))
4848 font
= x_new_font (f
, "-*-Courier New-normal-r-*-*-13-*-*-*-c-*-iso8859-1");
4849 if (! STRINGP (font
))
4850 font
= x_new_font (f
, "-*-Courier-normal-r-*-*-*-97-*-*-c-*-iso8859-1");
4851 /* If those didn't work, look for something which will at least work. */
4852 if (! STRINGP (font
))
4853 font
= x_new_font (f
, "-*-Fixedsys-normal-r-*-*-*-*-90-*-c-*-iso8859-1");
4855 if (! STRINGP (font
))
4856 font
= build_string ("Fixedsys");
4858 x_default_parameter (f
, parms
, Qfont
, font
,
4859 "font", "Font", string
);
4862 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
4863 "borderwidth", "BorderWidth", number
);
4864 /* This defaults to 2 in order to match xterm. We recognize either
4865 internalBorderWidth or internalBorder (which is what xterm calls
4867 if (NILP (Fassq (Qinternal_border_width
, parms
)))
4871 value
= x_get_arg (parms
, Qinternal_border_width
,
4872 "internalBorder", "BorderWidth", number
);
4873 if (! EQ (value
, Qunbound
))
4874 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
4877 /* Default internalBorderWidth to 0 on Windows to match other programs. */
4878 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (0),
4879 "internalBorderWidth", "BorderWidth", number
);
4880 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qt
,
4881 "verticalScrollBars", "ScrollBars", boolean
);
4883 /* Also do the stuff which must be set before the window exists. */
4884 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
4885 "foreground", "Foreground", string
);
4886 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
4887 "background", "Background", string
);
4888 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
4889 "pointerColor", "Foreground", string
);
4890 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
4891 "cursorColor", "Foreground", string
);
4892 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
4893 "borderColor", "BorderColor", string
);
4895 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (1),
4896 "menuBar", "MenuBar", number
);
4897 x_default_parameter (f
, parms
, Qscroll_bar_width
, Qnil
,
4898 "scrollBarWidth", "ScrollBarWidth", number
);
4899 x_default_parameter (f
, parms
, Qbuffer_predicate
, Qnil
,
4900 "bufferPredicate", "BufferPredicate", symbol
);
4901 x_default_parameter (f
, parms
, Qtitle
, Qnil
,
4902 "title", "Title", string
);
4904 f
->output_data
.w32
->dwStyle
= WS_OVERLAPPEDWINDOW
;
4905 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
4906 window_prompting
= x_figure_window_size (f
, parms
);
4908 if (window_prompting
& XNegative
)
4910 if (window_prompting
& YNegative
)
4911 f
->output_data
.w32
->win_gravity
= SouthEastGravity
;
4913 f
->output_data
.w32
->win_gravity
= NorthEastGravity
;
4917 if (window_prompting
& YNegative
)
4918 f
->output_data
.w32
->win_gravity
= SouthWestGravity
;
4920 f
->output_data
.w32
->win_gravity
= NorthWestGravity
;
4923 f
->output_data
.w32
->size_hint_flags
= window_prompting
;
4925 w32_window (f
, window_prompting
, minibuffer_only
);
4927 init_frame_faces (f
);
4929 /* We need to do this after creating the window, so that the
4930 icon-creation functions can say whose icon they're describing. */
4931 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
4932 "bitmapIcon", "BitmapIcon", symbol
);
4934 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
4935 "autoRaise", "AutoRaiseLower", boolean
);
4936 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
4937 "autoLower", "AutoRaiseLower", boolean
);
4938 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
4939 "cursorType", "CursorType", symbol
);
4941 /* Dimensions, especially f->height, must be done via change_frame_size.
4942 Change will not be effected unless different from the current
4947 SET_FRAME_WIDTH (f
, 0);
4948 change_frame_size (f
, height
, width
, 1, 0);
4950 /* Tell the server what size and position, etc, we want,
4951 and how badly we want them. */
4953 x_wm_set_size_hint (f
, window_prompting
, 0);
4956 tem
= x_get_arg (parms
, Qunsplittable
, 0, 0, boolean
);
4957 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
4961 /* It is now ok to make the frame official
4962 even if we get an error below.
4963 And the frame needs to be on Vframe_list
4964 or making it visible won't work. */
4965 Vframe_list
= Fcons (frame
, Vframe_list
);
4967 /* Now that the frame is official, it counts as a reference to
4969 FRAME_W32_DISPLAY_INFO (f
)->reference_count
++;
4971 /* Make the window appear on the frame and enable display,
4972 unless the caller says not to. However, with explicit parent,
4973 Emacs cannot control visibility, so don't try. */
4974 if (! f
->output_data
.w32
->explicit_parent
)
4976 Lisp_Object visibility
;
4978 visibility
= x_get_arg (parms
, Qvisibility
, 0, 0, symbol
);
4979 if (EQ (visibility
, Qunbound
))
4982 if (EQ (visibility
, Qicon
))
4983 x_iconify_frame (f
);
4984 else if (! NILP (visibility
))
4985 x_make_frame_visible (f
);
4987 /* Must have been Qnil. */
4991 return unbind_to (count
, frame
);
4994 /* FRAME is used only to get a handle on the X display. We don't pass the
4995 display info directly because we're called from frame.c, which doesn't
4996 know about that structure. */
4998 x_get_focus_frame (frame
)
4999 struct frame
*frame
;
5001 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (frame
);
5003 if (! dpyinfo
->w32_focus_frame
)
5006 XSETFRAME (xfocus
, dpyinfo
->w32_focus_frame
);
5010 DEFUN ("w32-focus-frame", Fw32_focus_frame
, Sw32_focus_frame
, 1, 1, 0,
5011 "Give FRAME input focus, raising to foreground if necessary.")
5015 x_focus_on_frame (check_x_frame (frame
));
5020 struct font_info
*w32_load_bdf_font (struct frame
*f
, char *fontname
,
5021 int size
, char* filename
);
5024 w32_load_system_font (f
,fontname
,size
)
5029 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
5030 Lisp_Object font_names
;
5032 /* Get a list of all the fonts that match this name. Once we
5033 have a list of matching fonts, we compare them against the fonts
5034 we already have loaded by comparing names. */
5035 font_names
= w32_list_fonts (f
, build_string (fontname
), size
, 100);
5037 if (!NILP (font_names
))
5041 #if 0 /* This code has nasty side effects that cause Emacs to crash. */
5043 /* First check if any are already loaded, as that is cheaper
5044 than loading another one. */
5045 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
5046 for (tail
= font_names
; CONSP (tail
); tail
= XCONS (tail
)->cdr
)
5047 if (!strcmp (dpyinfo
->font_table
[i
].name
,
5048 XSTRING (XCONS (tail
)->car
)->data
)
5049 || !strcmp (dpyinfo
->font_table
[i
].full_name
,
5050 XSTRING (XCONS (tail
)->car
)->data
))
5051 return (dpyinfo
->font_table
+ i
);
5053 fontname
= (char *) XSTRING (XCONS (font_names
)->car
)->data
;
5055 else if (w32_strict_fontnames
)
5057 /* If EnumFontFamiliesEx was available, we got a full list of
5058 fonts back so stop now to avoid the possibility of loading a
5059 random font. If we had to fall back to EnumFontFamilies, the
5060 list is incomplete, so continue whether the font we want was
5062 HMODULE gdi32
= GetModuleHandle ("gdi32.dll");
5063 FARPROC enum_font_families_ex
5064 = GetProcAddress (gdi32
, "EnumFontFamiliesExA");
5065 if (enum_font_families_ex
)
5069 /* Load the font and add it to the table. */
5071 char *full_name
, *encoding
;
5073 struct font_info
*fontp
;
5077 if (!fontname
|| !x_to_w32_font (fontname
, &lf
))
5080 if (!*lf
.lfFaceName
)
5081 /* If no name was specified for the font, we get a random font
5082 from CreateFontIndirect - this is not particularly
5083 desirable, especially since CreateFontIndirect does not
5084 fill out the missing name in lf, so we never know what we
5088 font
= (XFontStruct
*) xmalloc (sizeof (XFontStruct
));
5090 /* Set bdf to NULL to indicate that this is a Windows font. */
5095 font
->hfont
= CreateFontIndirect (&lf
);
5097 if (font
->hfont
== NULL
)
5106 hdc
= GetDC (dpyinfo
->root_window
);
5107 oldobj
= SelectObject (hdc
, font
->hfont
);
5108 ok
= GetTextMetrics (hdc
, &font
->tm
);
5109 SelectObject (hdc
, oldobj
);
5110 ReleaseDC (dpyinfo
->root_window
, hdc
);
5112 /* [andrewi, 25-Apr-99] A number of fixed pitch fonts,
5113 eg. Courier New and perhaps others, report a max width which
5114 is larger than the average character width, at least on some
5115 NT systems (I don't understand why - my best guess is that it
5116 results from installing the CJK language packs for NT4).
5117 Unfortunately, this forces the redisplay code in dumpglyphs
5118 to draw text character by character.
5120 I don't like this hack, but it seems better to force the max
5121 width to match the average width if the font is marked as
5122 fixed pitch, for the sake of redisplay performance. */
5124 if ((font
->tm
.tmPitchAndFamily
& TMPF_FIXED_PITCH
) == 0)
5125 font
->tm
.tmMaxCharWidth
= font
->tm
.tmAveCharWidth
;
5132 w32_unload_font (dpyinfo
, font
);
5136 /* Do we need to create the table? */
5137 if (dpyinfo
->font_table_size
== 0)
5139 dpyinfo
->font_table_size
= 16;
5141 = (struct font_info
*) xmalloc (dpyinfo
->font_table_size
5142 * sizeof (struct font_info
));
5144 /* Do we need to grow the table? */
5145 else if (dpyinfo
->n_fonts
5146 >= dpyinfo
->font_table_size
)
5148 dpyinfo
->font_table_size
*= 2;
5150 = (struct font_info
*) xrealloc (dpyinfo
->font_table
,
5151 (dpyinfo
->font_table_size
5152 * sizeof (struct font_info
)));
5155 fontp
= dpyinfo
->font_table
+ dpyinfo
->n_fonts
;
5157 /* Now fill in the slots of *FONTP. */
5160 fontp
->font_idx
= dpyinfo
->n_fonts
;
5161 fontp
->name
= (char *) xmalloc (strlen (fontname
) + 1);
5162 bcopy (fontname
, fontp
->name
, strlen (fontname
) + 1);
5164 /* Work out the font's full name. */
5165 full_name
= (char *)xmalloc (100);
5166 if (full_name
&& w32_to_x_font (&lf
, full_name
, 100))
5167 fontp
->full_name
= full_name
;
5170 /* If all else fails - just use the name we used to load it. */
5172 fontp
->full_name
= fontp
->name
;
5175 fontp
->size
= FONT_WIDTH (font
);
5176 fontp
->height
= FONT_HEIGHT (font
);
5178 /* The slot `encoding' specifies how to map a character
5179 code-points (0x20..0x7F or 0x2020..0x7F7F) of each charset to
5180 the font code-points (0:0x20..0x7F, 1:0xA0..0xFF, 0:0x2020..0x7F7F,
5181 the font code-points (0:0x20..0x7F, 1:0xA0..0xFF,
5182 0:0x2020..0x7F7F, 1:0xA0A0..0xFFFF, 3:0x20A0..0x7FFF, or
5183 2:0xA020..0xFF7F). For the moment, we don't know which charset
5184 uses this font. So, we set informatoin in fontp->encoding[1]
5185 which is never used by any charset. If mapping can't be
5186 decided, set FONT_ENCODING_NOT_DECIDED. */
5188 /* SJIS fonts need to be set to type 4, all others seem to work as
5189 type FONT_ENCODING_NOT_DECIDED. */
5190 encoding
= strrchr (fontp
->name
, '-');
5191 if (encoding
&& stricmp (encoding
+1, "sjis") == 0)
5192 fontp
->encoding
[1] = 4;
5194 fontp
->encoding
[1] = FONT_ENCODING_NOT_DECIDED
;
5196 /* The following three values are set to 0 under W32, which is
5197 what they get set to if XGetFontProperty fails under X. */
5198 fontp
->baseline_offset
= 0;
5199 fontp
->relative_compose
= 0;
5200 fontp
->default_ascent
= 0;
5209 /* Load font named FONTNAME of size SIZE for frame F, and return a
5210 pointer to the structure font_info while allocating it dynamically.
5211 If loading fails, return NULL. */
5213 w32_load_font (f
,fontname
,size
)
5218 Lisp_Object bdf_fonts
;
5219 struct font_info
*retval
= NULL
;
5221 bdf_fonts
= w32_list_bdf_fonts (build_string (fontname
));
5223 while (!retval
&& CONSP (bdf_fonts
))
5225 char *bdf_name
, *bdf_file
;
5226 Lisp_Object bdf_pair
;
5228 bdf_name
= XSTRING (XCONS (bdf_fonts
)->car
)->data
;
5229 bdf_pair
= Fassoc (XCONS (bdf_fonts
)->car
, Vw32_bdf_filename_alist
);
5230 bdf_file
= XSTRING (XCONS (bdf_pair
)->cdr
)->data
;
5232 retval
= w32_load_bdf_font (f
, bdf_name
, size
, bdf_file
);
5234 bdf_fonts
= XCONS (bdf_fonts
)->cdr
;
5240 return w32_load_system_font(f
, fontname
, size
);
5245 w32_unload_font (dpyinfo
, font
)
5246 struct w32_display_info
*dpyinfo
;
5251 if (font
->bdf
) w32_free_bdf_font (font
->bdf
);
5253 if (font
->hfont
) DeleteObject(font
->hfont
);
5258 /* The font conversion stuff between x and w32 */
5260 /* X font string is as follows (from faces.el)
5264 * (weight "\\(bold\\|demibold\\|medium\\)") ; 1
5265 * (weight\? "\\([^-]*\\)") ; 1
5266 * (slant "\\([ior]\\)") ; 2
5267 * (slant\? "\\([^-]?\\)") ; 2
5268 * (swidth "\\([^-]*\\)") ; 3
5269 * (adstyle "[^-]*") ; 4
5270 * (pixelsize "[0-9]+")
5271 * (pointsize "[0-9][0-9]+")
5272 * (resx "[0-9][0-9]+")
5273 * (resy "[0-9][0-9]+")
5274 * (spacing "[cmp?*]")
5275 * (avgwidth "[0-9]+")
5276 * (registry "[^-]+")
5277 * (encoding "[^-]+")
5279 * (setq x-font-regexp
5280 * (concat "\\`\\*?[-?*]"
5281 * foundry - family - weight\? - slant\? - swidth - adstyle -
5282 * pixelsize - pointsize - resx - resy - spacing - registry -
5283 * encoding "[-?*]\\*?\\'"
5285 * (setq x-font-regexp-head
5286 * (concat "\\`[-?*]" foundry - family - weight\? - slant\?
5287 * "\\([-*?]\\|\\'\\)"))
5288 * (setq x-font-regexp-slant (concat - slant -))
5289 * (setq x-font-regexp-weight (concat - weight -))
5293 #define FONT_START "[-?]"
5294 #define FONT_FOUNDRY "[^-]+"
5295 #define FONT_FAMILY "\\([^-]+\\)" /* 1 */
5296 #define FONT_WEIGHT "\\(bold\\|demibold\\|medium\\)" /* 2 */
5297 #define FONT_WEIGHT_Q "\\([^-]*\\)" /* 2 */
5298 #define FONT_SLANT "\\([ior]\\)" /* 3 */
5299 #define FONT_SLANT_Q "\\([^-]?\\)" /* 3 */
5300 #define FONT_SWIDTH "\\([^-]*\\)" /* 4 */
5301 #define FONT_ADSTYLE "[^-]*"
5302 #define FONT_PIXELSIZE "[^-]*"
5303 #define FONT_POINTSIZE "\\([0-9][0-9]+\\|\\*\\)" /* 5 */
5304 #define FONT_RESX "[0-9][0-9]+"
5305 #define FONT_RESY "[0-9][0-9]+"
5306 #define FONT_SPACING "[cmp?*]"
5307 #define FONT_AVGWIDTH "[0-9]+"
5308 #define FONT_REGISTRY "[^-]+"
5309 #define FONT_ENCODING "[^-]+"
5311 #define FONT_REGEXP ("\\`\\*?[-?*]" \
5318 FONT_PIXELSIZE "-" \
5319 FONT_POINTSIZE "-" \
5322 #define FONT_REGEXP_HEAD ("\\`[-?*]" \
5327 "\\([-*?]\\|\\'\\)")
5329 #define FONT_REGEXP_SLANT "-" FONT_SLANT "-"
5330 #define FONT_REGEXP_WEIGHT "-" FONT_WEIGHT "-"
5333 x_to_w32_weight (lpw
)
5336 if (!lpw
) return (FW_DONTCARE
);
5338 if (stricmp (lpw
,"heavy") == 0) return FW_HEAVY
;
5339 else if (stricmp (lpw
,"extrabold") == 0) return FW_EXTRABOLD
;
5340 else if (stricmp (lpw
,"bold") == 0) return FW_BOLD
;
5341 else if (stricmp (lpw
,"demibold") == 0) return FW_SEMIBOLD
;
5342 else if (stricmp (lpw
,"semibold") == 0) return FW_SEMIBOLD
;
5343 else if (stricmp (lpw
,"medium") == 0) return FW_MEDIUM
;
5344 else if (stricmp (lpw
,"normal") == 0) return FW_NORMAL
;
5345 else if (stricmp (lpw
,"light") == 0) return FW_LIGHT
;
5346 else if (stricmp (lpw
,"extralight") == 0) return FW_EXTRALIGHT
;
5347 else if (stricmp (lpw
,"thin") == 0) return FW_THIN
;
5354 w32_to_x_weight (fnweight
)
5357 if (fnweight
>= FW_HEAVY
) return "heavy";
5358 if (fnweight
>= FW_EXTRABOLD
) return "extrabold";
5359 if (fnweight
>= FW_BOLD
) return "bold";
5360 if (fnweight
>= FW_SEMIBOLD
) return "demibold";
5361 if (fnweight
>= FW_MEDIUM
) return "medium";
5362 if (fnweight
>= FW_NORMAL
) return "normal";
5363 if (fnweight
>= FW_LIGHT
) return "light";
5364 if (fnweight
>= FW_EXTRALIGHT
) return "extralight";
5365 if (fnweight
>= FW_THIN
) return "thin";
5371 x_to_w32_charset (lpcs
)
5374 if (!lpcs
) return (0);
5376 if (stricmp (lpcs
,"ansi") == 0) return ANSI_CHARSET
;
5377 else if (stricmp (lpcs
,"iso8859-1") == 0) return ANSI_CHARSET
;
5378 else if (stricmp (lpcs
, "ms-symbol") == 0) return SYMBOL_CHARSET
;
5379 /* Map all Japanese charsets to the Windows Shift-JIS charset. */
5380 else if (strnicmp (lpcs
, "jis", 3) == 0) return SHIFTJIS_CHARSET
;
5381 /* Map all GB charsets to the Windows GB2312 charset. */
5382 else if (strnicmp (lpcs
, "gb2312", 6) == 0) return GB2312_CHARSET
;
5383 /* Map all Big5 charsets to the Windows Big5 charset. */
5384 else if (strnicmp (lpcs
, "big5", 4) == 0) return CHINESEBIG5_CHARSET
;
5385 else if (stricmp (lpcs
, "ksc5601.1987") == 0) return HANGEUL_CHARSET
;
5386 else if (stricmp (lpcs
, "ms-oem") == 0) return OEM_CHARSET
;
5388 #ifdef EASTEUROPE_CHARSET
5389 else if (stricmp (lpcs
, "iso8859-2") == 0) return EASTEUROPE_CHARSET
;
5390 else if (stricmp (lpcs
, "iso8859-3") == 0) return TURKISH_CHARSET
;
5391 else if (stricmp (lpcs
, "iso8859-4") == 0) return BALTIC_CHARSET
;
5392 else if (stricmp (lpcs
, "iso8859-5") == 0) return RUSSIAN_CHARSET
;
5393 else if (stricmp (lpcs
, "koi8") == 0) return RUSSIAN_CHARSET
;
5394 else if (stricmp (lpcs
, "iso8859-6") == 0) return ARABIC_CHARSET
;
5395 else if (stricmp (lpcs
, "iso8859-7") == 0) return GREEK_CHARSET
;
5396 else if (stricmp (lpcs
, "iso8859-8") == 0) return HEBREW_CHARSET
;
5397 else if (stricmp (lpcs
, "iso8859-9") == 0) return TURKISH_CHARSET
;
5398 #ifndef VIETNAMESE_CHARSET
5399 #define VIETNAMESE_CHARSET 163
5401 /* Map all Viscii charsets to the Windows Vietnamese charset. */
5402 else if (strnicmp (lpcs
, "viscii", 6) == 0) return VIETNAMESE_CHARSET
;
5403 else if (strnicmp (lpcs
, "vscii", 5) == 0) return VIETNAMESE_CHARSET
;
5404 /* Map all TIS charsets to the Windows Thai charset. */
5405 else if (strnicmp (lpcs
, "tis620", 6) == 0) return THAI_CHARSET
;
5406 else if (stricmp (lpcs
, "mac") == 0) return MAC_CHARSET
;
5407 else if (stricmp (lpcs
, "ksc5601.1992") == 0) return JOHAB_CHARSET
;
5408 /* For backwards compatibility with previous 20.4 pretests, map
5409 non-specific KSC charsets to the Windows Hangeul charset. */
5410 else if (strnicmp (lpcs
, "ksc5601", 7) == 0) return HANGEUL_CHARSET
;
5411 else if (stricmp (lpcs
, "johab") == 0) return JOHAB_CHARSET
;
5414 #ifdef UNICODE_CHARSET
5415 else if (stricmp (lpcs
,"iso10646") == 0) return UNICODE_CHARSET
;
5416 else if (stricmp (lpcs
, "unicode") == 0) return UNICODE_CHARSET
;
5418 else if (lpcs
[0] == '#') return atoi (lpcs
+ 1);
5420 return DEFAULT_CHARSET
;
5424 w32_to_x_charset (fncharset
)
5427 static char buf
[16];
5431 /* ansi is considered iso8859-1, as most modern ansi fonts are. */
5432 case ANSI_CHARSET
: return "iso8859-1";
5433 case DEFAULT_CHARSET
: return "ascii-*";
5434 case SYMBOL_CHARSET
: return "ms-symbol";
5435 case SHIFTJIS_CHARSET
: return "jisx0208-sjis";
5436 case HANGEUL_CHARSET
: return "ksc5601.1987-*";
5437 case GB2312_CHARSET
: return "gb2312-*";
5438 case CHINESEBIG5_CHARSET
: return "big5-*";
5439 case OEM_CHARSET
: return "ms-oem";
5441 /* More recent versions of Windows (95 and NT4.0) define more
5443 #ifdef EASTEUROPE_CHARSET
5444 case EASTEUROPE_CHARSET
: return "iso8859-2";
5445 case TURKISH_CHARSET
: return "iso8859-9";
5446 case BALTIC_CHARSET
: return "iso8859-4";
5448 /* W95 with international support but not IE4 often has the
5449 KOI8-R codepage but not ISO8859-5. */
5450 case RUSSIAN_CHARSET
:
5451 if (!IsValidCodePage(28595) && IsValidCodePage(20886))
5455 case ARABIC_CHARSET
: return "iso8859-6";
5456 case GREEK_CHARSET
: return "iso8859-7";
5457 case HEBREW_CHARSET
: return "iso8859-8";
5458 case VIETNAMESE_CHARSET
: return "viscii1.1-*";
5459 case THAI_CHARSET
: return "tis620-*";
5460 case MAC_CHARSET
: return "mac-*";
5461 case JOHAB_CHARSET
: return "ksc5601.1992-*";
5465 #ifdef UNICODE_CHARSET
5466 case UNICODE_CHARSET
: return "iso10646-unicode";
5469 /* Encode numerical value of unknown charset. */
5470 sprintf (buf
, "*-#%u", fncharset
);
5475 w32_to_x_font (lplogfont
, lpxstr
, len
)
5476 LOGFONT
* lplogfont
;
5481 char height_pixels
[8];
5483 char width_pixels
[8];
5484 char *fontname_dash
;
5485 int display_resy
= one_w32_display_info
.height_in
;
5486 int display_resx
= one_w32_display_info
.width_in
;
5488 struct coding_system coding
;
5490 if (!lpxstr
) abort ();
5495 setup_coding_system (Fcheck_coding_system (Vw32_system_coding_system
),
5497 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5498 bufsz
= decoding_buffer_size (&coding
, LF_FACESIZE
);
5500 fontname
= alloca(sizeof(*fontname
) * bufsz
);
5501 decode_coding (&coding
, lplogfont
->lfFaceName
, fontname
,
5502 strlen(lplogfont
->lfFaceName
), bufsz
- 1);
5503 *(fontname
+ coding
.produced
) = '\0';
5505 /* Replace dashes with underscores so the dashes are not
5507 fontname_dash
= fontname
;
5508 while (fontname_dash
= strchr (fontname_dash
, '-'))
5509 *fontname_dash
= '_';
5511 if (lplogfont
->lfHeight
)
5513 sprintf (height_pixels
, "%u", abs (lplogfont
->lfHeight
));
5514 sprintf (height_dpi
, "%u",
5515 abs (lplogfont
->lfHeight
) * 720 / display_resy
);
5519 strcpy (height_pixels
, "*");
5520 strcpy (height_dpi
, "*");
5522 if (lplogfont
->lfWidth
)
5523 sprintf (width_pixels
, "%u", lplogfont
->lfWidth
* 10);
5525 strcpy (width_pixels
, "*");
5527 _snprintf (lpxstr
, len
- 1,
5528 "-*-%s-%s-%c-*-*-%s-%s-%d-%d-%c-%s-%s",
5530 fontname
, /* family */
5531 w32_to_x_weight (lplogfont
->lfWeight
), /* weight */
5532 lplogfont
->lfItalic
?'i':'r', /* slant */
5534 /* add style name */
5535 height_pixels
, /* pixel size */
5536 height_dpi
, /* point size */
5537 display_resx
, /* resx */
5538 display_resy
, /* resy */
5539 ((lplogfont
->lfPitchAndFamily
& 0x3) == VARIABLE_PITCH
)
5540 ? 'p' : 'c', /* spacing */
5541 width_pixels
, /* avg width */
5542 w32_to_x_charset (lplogfont
->lfCharSet
) /* charset registry
5546 lpxstr
[len
- 1] = 0; /* just to be sure */
5551 x_to_w32_font (lpxstr
, lplogfont
)
5553 LOGFONT
* lplogfont
;
5555 struct coding_system coding
;
5557 if (!lplogfont
) return (FALSE
);
5559 memset (lplogfont
, 0, sizeof (*lplogfont
));
5561 /* Set default value for each field. */
5563 lplogfont
->lfOutPrecision
= OUT_DEFAULT_PRECIS
;
5564 lplogfont
->lfClipPrecision
= CLIP_DEFAULT_PRECIS
;
5565 lplogfont
->lfQuality
= DEFAULT_QUALITY
;
5567 /* go for maximum quality */
5568 lplogfont
->lfOutPrecision
= OUT_STROKE_PRECIS
;
5569 lplogfont
->lfClipPrecision
= CLIP_STROKE_PRECIS
;
5570 lplogfont
->lfQuality
= PROOF_QUALITY
;
5573 lplogfont
->lfCharSet
= DEFAULT_CHARSET
;
5574 lplogfont
->lfWeight
= FW_DONTCARE
;
5575 lplogfont
->lfPitchAndFamily
= DEFAULT_PITCH
| FF_DONTCARE
;
5580 /* Provide a simple escape mechanism for specifying Windows font names
5581 * directly -- if font spec does not beginning with '-', assume this
5583 * "<font name>[:height in pixels[:width in pixels[:weight]]]"
5589 char name
[50], weight
[20], slant
, pitch
, pixels
[10], height
[10],
5590 width
[10], resy
[10], remainder
[20];
5592 int dpi
= one_w32_display_info
.height_in
;
5594 fields
= sscanf (lpxstr
,
5595 "-%*[^-]-%49[^-]-%19[^-]-%c-%*[^-]-%*[^-]-%9[^-]-%9[^-]-%*[^-]-%9[^-]-%c-%9[^-]-%19s",
5596 name
, weight
, &slant
, pixels
, height
, resy
, &pitch
, width
, remainder
);
5597 if (fields
== EOF
) return (FALSE
);
5599 if (fields
> 0 && name
[0] != '*')
5605 (Fcheck_coding_system (Vw32_system_coding_system
), &coding
);
5606 bufsize
= encoding_buffer_size (&coding
, strlen (name
));
5607 buf
= (unsigned char *) alloca (bufsize
);
5608 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
5609 encode_coding (&coding
, name
, buf
, strlen (name
), bufsize
);
5610 if (coding
.produced
>= LF_FACESIZE
)
5611 coding
.produced
= LF_FACESIZE
- 1;
5612 buf
[coding
.produced
] = 0;
5613 strcpy (lplogfont
->lfFaceName
, buf
);
5617 lplogfont
->lfFaceName
[0] = 0;
5622 lplogfont
->lfWeight
= x_to_w32_weight ((fields
> 0 ? weight
: ""));
5626 if (!NILP (Vw32_enable_italics
))
5627 lplogfont
->lfItalic
= (fields
> 0 && slant
== 'i');
5631 if (fields
> 0 && pixels
[0] != '*')
5632 lplogfont
->lfHeight
= atoi (pixels
);
5636 if (fields
> 0 && resy
[0] != '*')
5638 tem
= atoi (pixels
);
5639 if (tem
> 0) dpi
= tem
;
5642 if (fields
> -1 && lplogfont
->lfHeight
== 0 && height
[0] != '*')
5643 lplogfont
->lfHeight
= atoi (height
) * dpi
/ 720;
5646 lplogfont
->lfPitchAndFamily
=
5647 (fields
> 0 && pitch
== 'p') ? VARIABLE_PITCH
: FIXED_PITCH
;
5651 if (fields
> 0 && width
[0] != '*')
5652 lplogfont
->lfWidth
= atoi (width
) / 10;
5656 /* Strip the trailing '-' if present. (it shouldn't be, as it
5657 fails the test against xlfn-tight-regexp in fontset.el). */
5659 int len
= strlen (remainder
);
5660 if (len
> 0 && remainder
[len
-1] == '-')
5661 remainder
[len
-1] = 0;
5663 encoding
= remainder
;
5664 if (strncmp (encoding
, "*-", 2) == 0)
5666 lplogfont
->lfCharSet
= x_to_w32_charset (fields
> 0 ? encoding
: "");
5671 char name
[100], height
[10], width
[10], weight
[20];
5673 fields
= sscanf (lpxstr
,
5674 "%99[^:]:%9[^:]:%9[^:]:%19s",
5675 name
, height
, width
, weight
);
5677 if (fields
== EOF
) return (FALSE
);
5681 strncpy (lplogfont
->lfFaceName
,name
, LF_FACESIZE
);
5682 lplogfont
->lfFaceName
[LF_FACESIZE
-1] = 0;
5686 lplogfont
->lfFaceName
[0] = 0;
5692 lplogfont
->lfHeight
= atoi (height
);
5697 lplogfont
->lfWidth
= atoi (width
);
5701 lplogfont
->lfWeight
= x_to_w32_weight ((fields
> 0 ? weight
: ""));
5704 /* This makes TrueType fonts work better. */
5705 lplogfont
->lfHeight
= - abs (lplogfont
->lfHeight
);
5711 w32_font_match (lpszfont1
, lpszfont2
)
5715 char * s1
= lpszfont1
, *e1
, *w1
;
5716 char * s2
= lpszfont2
, *e2
, *w2
;
5718 if (s1
== NULL
|| s2
== NULL
) return (FALSE
);
5720 if (*s1
== '-') s1
++;
5721 if (*s2
== '-') s2
++;
5725 int len1
, len2
, len3
=0;
5727 e1
= strchr (s1
, '-');
5728 e2
= strchr (s2
, '-');
5729 w1
= strchr (s1
, '*');
5730 w2
= strchr (s2
, '*');
5743 if (w2
&& w2
< e2
&& ( len3
== 0 || (w2
- s2
) < len3
))
5746 /* Whole field is not a wildcard, and ...*/
5747 if (*s1
!= '*' && *s2
!= '*' && *s1
!= '-' && *s2
!= '-'
5748 /* Lengths are different and there are no wildcards, or ... */
5749 && ((len1
!= len2
&& len3
== 0) ||
5750 /* strings don't match up until first wildcard or end. */
5751 strnicmp (s1
, s2
, len3
> 0 ? len3
: len1
) != 0))
5754 if (e1
== NULL
|| e2
== NULL
)
5762 /* Callback functions, and a structure holding info they need, for
5763 listing system fonts on W32. We need one set of functions to do the
5764 job properly, but these don't work on NT 3.51 and earlier, so we
5765 have a second set which don't handle character sets properly to
5768 In both cases, there are two passes made. The first pass gets one
5769 font from each family, the second pass lists all the fonts from
5772 typedef struct enumfont_t
5777 XFontStruct
*size_ref
;
5778 Lisp_Object
*pattern
;
5783 enum_font_cb2 (lplf
, lptm
, FontType
, lpef
)
5785 NEWTEXTMETRIC
* lptm
;
5789 if (lplf
->elfLogFont
.lfStrikeOut
|| lplf
->elfLogFont
.lfUnderline
)
5792 /* Check that the character set matches if it was specified */
5793 if (lpef
->logfont
.lfCharSet
!= DEFAULT_CHARSET
&&
5794 lplf
->elfLogFont
.lfCharSet
!= lpef
->logfont
.lfCharSet
)
5797 /* We want all fonts cached, so don't compare sizes just yet */
5798 /* if (!lpef->size_ref || lptm->tmMaxCharWidth == FONT_WIDTH (lpef->size_ref)) */
5801 Lisp_Object width
= Qnil
;
5803 if (!NILP (*(lpef
->pattern
)) && FontType
!= RASTER_FONTTYPE
)
5805 /* Scalable fonts are as big as you want them to be. */
5806 lplf
->elfLogFont
.lfHeight
= lpef
->logfont
.lfHeight
;
5807 lplf
->elfLogFont
.lfWidth
= lpef
->logfont
.lfWidth
;
5809 /* Make sure the height used here is the same as everywhere
5810 else (ie character height, not cell height). */
5811 else if (lplf
->elfLogFont
.lfHeight
> 0)
5812 lplf
->elfLogFont
.lfHeight
= lptm
->tmInternalLeading
- lptm
->tmHeight
;
5814 /* The MaxCharWidth is not valid at this stage for scalable fonts. */
5815 if (FontType
== RASTER_FONTTYPE
)
5816 width
= make_number (lptm
->tmMaxCharWidth
);
5818 if (!w32_to_x_font (&(lplf
->elfLogFont
), buf
, 100))
5821 if (NILP (*(lpef
->pattern
))
5822 || w32_font_match (buf
, XSTRING (*(lpef
->pattern
))->data
))
5824 *lpef
->tail
= Fcons (Fcons (build_string (buf
), width
), Qnil
);
5825 lpef
->tail
= &(XCONS (*lpef
->tail
)->cdr
);
5834 enum_font_cb1 (lplf
, lptm
, FontType
, lpef
)
5836 NEWTEXTMETRIC
* lptm
;
5840 return EnumFontFamilies (lpef
->hdc
,
5841 lplf
->elfLogFont
.lfFaceName
,
5842 (FONTENUMPROC
) enum_font_cb2
,
5848 enum_fontex_cb2 (lplf
, lptm
, font_type
, lpef
)
5849 ENUMLOGFONTEX
* lplf
;
5850 NEWTEXTMETRICEX
* lptm
;
5854 /* We are not interested in the extra info we get back from the 'Ex
5855 version - only the fact that we get character set variations
5856 enumerated seperately. */
5857 return enum_font_cb2 ((ENUMLOGFONT
*) lplf
, (NEWTEXTMETRIC
*) lptm
,
5862 enum_fontex_cb1 (lplf
, lptm
, font_type
, lpef
)
5863 ENUMLOGFONTEX
* lplf
;
5864 NEWTEXTMETRICEX
* lptm
;
5868 HMODULE gdi32
= GetModuleHandle ("gdi32.dll");
5869 FARPROC enum_font_families_ex
5870 = GetProcAddress ( gdi32
, "EnumFontFamiliesExA");
5871 /* We don't really expect EnumFontFamiliesEx to disappear once we
5872 get here, so don't bother handling it gracefully. */
5873 if (enum_font_families_ex
== NULL
)
5874 error ("gdi32.dll has disappeared!");
5875 return enum_font_families_ex (lpef
->hdc
,
5877 (FONTENUMPROC
) enum_fontex_cb2
,
5881 /* Interface to fontset handler. (adapted from mw32font.c in Meadow
5882 and xterm.c in Emacs 20.3) */
5884 Lisp_Object
w32_list_bdf_fonts (Lisp_Object pattern
, int max_names
)
5886 char *fontname
, *ptnstr
;
5887 Lisp_Object list
, tem
, newlist
= Qnil
;
5890 list
= Vw32_bdf_filename_alist
;
5891 ptnstr
= XSTRING (pattern
)->data
;
5893 for ( ; CONSP (list
); list
= XCONS (list
)->cdr
)
5895 tem
= XCONS (list
)->car
;
5897 fontname
= XSTRING (XCONS (tem
)->car
)->data
;
5898 else if (STRINGP (tem
))
5899 fontname
= XSTRING (tem
)->data
;
5903 if (w32_font_match (fontname
, ptnstr
))
5905 newlist
= Fcons (XCONS (tem
)->car
, newlist
);
5907 if (n_fonts
>= max_names
)
5915 Lisp_Object
w32_list_synthesized_fonts (FRAME_PTR f
, Lisp_Object pattern
,
5916 int size
, int max_names
);
5918 /* Return a list of names of available fonts matching PATTERN on frame
5919 F. If SIZE is not 0, it is the size (maximum bound width) of fonts
5920 to be listed. Frame F NULL means we have not yet created any
5921 frame, which means we can't get proper size info, as we don't have
5922 a device context to use for GetTextMetrics.
5923 MAXNAMES sets a limit on how many fonts to match. */
5926 w32_list_fonts (FRAME_PTR f
, Lisp_Object pattern
, int size
, int maxnames
)
5928 Lisp_Object patterns
, key
, tem
, tpat
;
5929 Lisp_Object list
= Qnil
, newlist
= Qnil
, second_best
= Qnil
;
5930 struct w32_display_info
*dpyinfo
= &one_w32_display_info
;
5933 patterns
= Fassoc (pattern
, Valternate_fontname_alist
);
5934 if (NILP (patterns
))
5935 patterns
= Fcons (pattern
, Qnil
);
5937 for (; CONSP (patterns
); patterns
= XCONS (patterns
)->cdr
)
5941 tpat
= XCONS (patterns
)->car
;
5943 /* See if we cached the result for this particular query.
5944 The cache is an alist of the form:
5945 ((PATTERN (FONTNAME . WIDTH) ...) ...)
5947 if (tem
= XCONS (dpyinfo
->name_list_element
)->cdr
,
5948 !NILP (list
= Fassoc (tpat
, tem
)))
5950 list
= Fcdr_safe (list
);
5951 /* We have a cached list. Don't have to get the list again. */
5956 /* At first, put PATTERN in the cache. */
5962 /* Use EnumFontFamiliesEx where it is available, as it knows
5963 about character sets. Fall back to EnumFontFamilies for
5964 older versions of NT that don't support the 'Ex function. */
5965 x_to_w32_font (STRINGP (tpat
) ? XSTRING (tpat
)->data
:
5968 LOGFONT font_match_pattern
;
5969 HMODULE gdi32
= GetModuleHandle ("gdi32.dll");
5970 FARPROC enum_font_families_ex
5971 = GetProcAddress ( gdi32
, "EnumFontFamiliesExA");
5973 /* We do our own pattern matching so we can handle wildcards. */
5974 font_match_pattern
.lfFaceName
[0] = 0;
5975 font_match_pattern
.lfPitchAndFamily
= 0;
5976 /* We can use the charset, because if it is a wildcard it will
5977 be DEFAULT_CHARSET anyway. */
5978 font_match_pattern
.lfCharSet
= ef
.logfont
.lfCharSet
;
5980 ef
.hdc
= GetDC (dpyinfo
->root_window
);
5982 if (enum_font_families_ex
)
5983 enum_font_families_ex (ef
.hdc
,
5984 &font_match_pattern
,
5985 (FONTENUMPROC
) enum_fontex_cb1
,
5988 EnumFontFamilies (ef
.hdc
, NULL
, (FONTENUMPROC
) enum_font_cb1
,
5991 ReleaseDC (dpyinfo
->root_window
, ef
.hdc
);
5996 /* Make a list of the fonts we got back.
5997 Store that in the font cache for the display. */
5998 XCONS (dpyinfo
->name_list_element
)->cdr
5999 = Fcons (Fcons (tpat
, list
),
6000 XCONS (dpyinfo
->name_list_element
)->cdr
);
6003 if (NILP (list
)) continue; /* Try the remaining alternatives. */
6005 newlist
= second_best
= Qnil
;
6007 /* Make a list of the fonts that have the right width. */
6008 for (; CONSP (list
); list
= XCONS (list
)->cdr
)
6011 tem
= XCONS (list
)->car
;
6015 if (NILP (XCONS (tem
)->car
))
6019 newlist
= Fcons (XCONS (tem
)->car
, newlist
);
6021 if (n_fonts
>= maxnames
)
6026 if (!INTEGERP (XCONS (tem
)->cdr
))
6028 /* Since we don't yet know the size of the font, we must
6029 load it and try GetTextMetrics. */
6030 W32FontStruct thisinfo
;
6035 if (!x_to_w32_font (XSTRING (XCONS (tem
)->car
)->data
, &lf
))
6039 thisinfo
.bdf
= NULL
;
6040 thisinfo
.hfont
= CreateFontIndirect (&lf
);
6041 if (thisinfo
.hfont
== NULL
)
6044 hdc
= GetDC (dpyinfo
->root_window
);
6045 oldobj
= SelectObject (hdc
, thisinfo
.hfont
);
6046 if (GetTextMetrics (hdc
, &thisinfo
.tm
))
6047 XCONS (tem
)->cdr
= make_number (FONT_WIDTH (&thisinfo
));
6049 XCONS (tem
)->cdr
= make_number (0);
6050 SelectObject (hdc
, oldobj
);
6051 ReleaseDC (dpyinfo
->root_window
, hdc
);
6052 DeleteObject(thisinfo
.hfont
);
6055 found_size
= XINT (XCONS (tem
)->cdr
);
6056 if (found_size
== size
)
6058 newlist
= Fcons (XCONS (tem
)->car
, newlist
);
6060 if (n_fonts
>= maxnames
)
6063 /* keep track of the closest matching size in case
6064 no exact match is found. */
6065 else if (found_size
> 0)
6067 if (NILP (second_best
))
6070 else if (found_size
< size
)
6072 if (XINT (XCONS (second_best
)->cdr
) > size
6073 || XINT (XCONS (second_best
)->cdr
) < found_size
)
6078 if (XINT (XCONS (second_best
)->cdr
) > size
6079 && XINT (XCONS (second_best
)->cdr
) >
6086 if (!NILP (newlist
))
6088 else if (!NILP (second_best
))
6090 newlist
= Fcons (XCONS (second_best
)->car
, Qnil
);
6095 /* Include any bdf fonts. */
6096 if (n_fonts
< maxnames
)
6098 Lisp_Object combined
[2];
6099 combined
[0] = w32_list_bdf_fonts (pattern
, maxnames
- n_fonts
);
6100 combined
[1] = newlist
;
6101 newlist
= Fnconc(2, combined
);
6104 /* If we can't find a font that matches, check if Windows would be
6105 able to synthesize it from a different style. */
6106 if (NILP (newlist
) && !NILP (Vw32_enable_italics
))
6107 newlist
= w32_list_synthesized_fonts (f
, pattern
, size
, maxnames
);
6113 w32_list_synthesized_fonts (f
, pattern
, size
, max_names
)
6115 Lisp_Object pattern
;
6120 char *full_pattn
, *new_pattn
, foundary
[50], family
[50], *pattn_part2
;
6121 char style
[20], slant
;
6122 Lisp_Object matches
, match
, tem
, synthed_matches
= Qnil
;
6124 full_pattn
= XSTRING (pattern
)->data
;
6126 pattn_part2
= alloca (XSTRING (pattern
)->size
);
6127 /* Allow some space for wildcard expansion. */
6128 new_pattn
= alloca (XSTRING (pattern
)->size
+ 100);
6130 fields
= sscanf (full_pattn
, "-%49[^-]-%49[^-]-%19[^-]-%c-%s",
6131 foundary
, family
, style
, &slant
, pattn_part2
);
6132 if (fields
== EOF
|| fields
< 5)
6135 /* If the style and slant are wildcards already there is no point
6136 checking again (and we don't want to keep recursing). */
6137 if (*style
== '*' && slant
== '*')
6140 sprintf (new_pattn
, "-%s-%s-*-*-%s", foundary
, family
, pattn_part2
);
6142 matches
= w32_list_fonts (f
, build_string (new_pattn
), size
, max_names
);
6144 for ( ; CONSP (matches
); matches
= XCONS (matches
)->cdr
)
6146 tem
= XCONS (matches
)->car
;
6150 full_pattn
= XSTRING (tem
)->data
;
6151 fields
= sscanf (full_pattn
, "-%49[^-]-%49[^-]-%*[^-]-%*c-%s",
6152 foundary
, family
, pattn_part2
);
6153 if (fields
== EOF
|| fields
< 3)
6156 sprintf (new_pattn
, "-%s-%s-%s-%c-%s", foundary
, family
, style
,
6157 slant
, pattn_part2
);
6159 synthed_matches
= Fcons (build_string (new_pattn
),
6163 return synthed_matches
;
6167 /* Return a pointer to struct font_info of font FONT_IDX of frame F. */
6169 w32_get_font_info (f
, font_idx
)
6173 return (FRAME_W32_FONT_TABLE (f
) + font_idx
);
6178 w32_query_font (struct frame
*f
, char *fontname
)
6181 struct font_info
*pfi
;
6183 pfi
= FRAME_W32_FONT_TABLE (f
);
6185 for (i
= 0; i
< one_w32_display_info
.n_fonts
;i
++, pfi
++)
6187 if (strcmp(pfi
->name
, fontname
) == 0) return pfi
;
6193 /* Find a CCL program for a font specified by FONTP, and set the member
6194 `encoder' of the structure. */
6197 w32_find_ccl_program (fontp
)
6198 struct font_info
*fontp
;
6200 extern Lisp_Object Vfont_ccl_encoder_alist
, Vccl_program_table
;
6201 extern Lisp_Object Qccl_program_idx
;
6202 extern Lisp_Object
resolve_symbol_ccl_program ();
6203 Lisp_Object list
, elt
, ccl_prog
, ccl_id
;
6205 for (list
= Vfont_ccl_encoder_alist
; CONSP (list
); list
= XCONS (list
)->cdr
)
6207 elt
= XCONS (list
)->car
;
6209 && STRINGP (XCONS (elt
)->car
)
6210 && (fast_c_string_match_ignore_case (XCONS (elt
)->car
, fontp
->name
)
6213 if (SYMBOLP (XCONS (elt
)->cdr
) &&
6214 (!NILP (ccl_id
= Fget (XCONS (elt
)->cdr
, Qccl_program_idx
))))
6216 ccl_prog
= XVECTOR (Vccl_program_table
)->contents
[XUINT (ccl_id
)];
6217 if (!CONSP (ccl_prog
)) continue;
6218 ccl_prog
= XCONS (ccl_prog
)->cdr
;
6222 ccl_prog
= XCONS (elt
)->cdr
;
6223 if (!VECTORP (ccl_prog
)) continue;
6227 = (struct ccl_program
*) xmalloc (sizeof (struct ccl_program
));
6228 setup_ccl_program (fontp
->font_encoder
,
6229 resolve_symbol_ccl_program (ccl_prog
));
6237 #include "x-list-font.c"
6239 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 4, 0,
6240 "Return a list of the names of available fonts matching PATTERN.\n\
6241 If optional arguments FACE and FRAME are specified, return only fonts\n\
6242 the same size as FACE on FRAME.\n\
6244 PATTERN is a string, perhaps with wildcard characters;\n\
6245 the * character matches any substring, and\n\
6246 the ? character matches any single character.\n\
6247 PATTERN is case-insensitive.\n\
6248 FACE is a face name--a symbol.\n\
6250 The return value is a list of strings, suitable as arguments to\n\
6253 Fonts Emacs can't use (i.e. proportional fonts) may or may not be excluded\n\
6254 even if they match PATTERN and FACE.\n\
6256 The optional fourth argument MAXIMUM sets a limit on how many\n\
6257 fonts to match. The first MAXIMUM fonts are reported.")
6258 (pattern
, face
, frame
, maximum
)
6259 Lisp_Object pattern
, face
, frame
, maximum
;
6264 XFontStruct
*size_ref
;
6265 Lisp_Object namelist
;
6270 CHECK_STRING (pattern
, 0);
6272 CHECK_SYMBOL (face
, 1);
6274 f
= check_x_frame (frame
);
6276 /* Determine the width standard for comparison with the fonts we find. */
6284 /* Don't die if we get called with a terminal frame. */
6285 if (! FRAME_W32_P (f
))
6286 error ("non-w32 frame used in `x-list-fonts'");
6288 face_id
= face_name_id_number (f
, face
);
6290 if (face_id
< 0 || face_id
>= FRAME_N_PARAM_FACES (f
)
6291 || FRAME_PARAM_FACES (f
) [face_id
] == 0)
6292 size_ref
= f
->output_data
.w32
->font
;
6295 size_ref
= FRAME_PARAM_FACES (f
) [face_id
]->font
;
6296 if (size_ref
== (XFontStruct
*) (~0))
6297 size_ref
= f
->output_data
.w32
->font
;
6301 /* See if we cached the result for this particular query. */
6302 list
= Fassoc (pattern
,
6303 XCONS (FRAME_W32_DISPLAY_INFO (f
)->name_list_element
)->cdr
);
6305 /* We have info in the cache for this PATTERN. */
6308 Lisp_Object tem
, newlist
;
6310 /* We have info about this pattern. */
6311 list
= XCONS (list
)->cdr
;
6318 /* Filter the cached info and return just the fonts that match FACE. */
6320 for (tem
= list
; CONSP (tem
); tem
= XCONS (tem
)->cdr
)
6322 struct font_info
*fontinf
;
6323 XFontStruct
*thisinfo
= NULL
;
6325 fontinf
= w32_load_font (f
, XSTRING (XCONS (tem
)->car
)->data
, 0);
6327 thisinfo
= (XFontStruct
*)fontinf
->font
;
6328 if (thisinfo
&& same_size_fonts (thisinfo
, size_ref
))
6329 newlist
= Fcons (XCONS (tem
)->car
, newlist
);
6331 w32_unload_font (FRAME_W32_DISPLAY_INFO (f
), thisinfo
);
6342 ef
.pattern
= &pattern
;
6345 x_to_w32_font (STRINGP (pattern
) ? XSTRING (pattern
)->data
: NULL
, &ef
.logfont
);
6348 ef
.hdc
= GetDC (FRAME_W32_WINDOW (f
));
6350 EnumFontFamilies (ef
.hdc
, NULL
, (FONTENUMPROC
) enum_font_cb1
, (LPARAM
)&ef
);
6352 ReleaseDC (FRAME_W32_WINDOW (f
), ef
.hdc
);
6362 /* Make a list of all the fonts we got back.
6363 Store that in the font cache for the display. */
6364 XCONS (FRAME_W32_DISPLAY_INFO (f
)->name_list_element
)->cdr
6365 = Fcons (Fcons (pattern
, namelist
),
6366 XCONS (FRAME_W32_DISPLAY_INFO (f
)->name_list_element
)->cdr
);
6368 /* Make a list of the fonts that have the right width. */
6371 for (i
= 0; i
< ef
.numFonts
; i
++)
6379 struct font_info
*fontinf
;
6380 XFontStruct
*thisinfo
= NULL
;
6383 fontinf
= w32_load_font (f
, XSTRING (Fcar (cur
))->data
, 0);
6385 thisinfo
= (XFontStruct
*)fontinf
->font
;
6387 keeper
= thisinfo
&& same_size_fonts (thisinfo
, size_ref
);
6389 w32_unload_font (FRAME_W32_DISPLAY_INFO (f
), thisinfo
);
6394 list
= Fcons (build_string (XSTRING (Fcar (cur
))->data
), list
);
6398 list
= Fnreverse (list
);
6405 DEFUN ("w32-find-bdf-fonts", Fw32_find_bdf_fonts
, Sw32_find_bdf_fonts
,
6407 "Return a list of BDF fonts in DIR, suitable for appending to\n\
6408 w32-bdf-filename-alist. Fonts which do not contain an xfld description\n\
6409 will not be included in the list. DIR may be a list of directories.")
6411 Lisp_Object directory
;
6413 Lisp_Object list
= Qnil
;
6414 struct gcpro gcpro1
, gcpro2
;
6416 if (!CONSP (directory
))
6417 return w32_find_bdf_fonts_in_dir (directory
);
6419 for ( ; CONSP (directory
); directory
= XCONS (directory
)->cdr
)
6421 Lisp_Object pair
[2];
6424 GCPRO2 (directory
, list
);
6425 pair
[1] = w32_find_bdf_fonts_in_dir( XCONS (directory
)->car
);
6426 list
= Fnconc( 2, pair
);
6432 /* Find BDF files in a specified directory. (use GCPRO when calling,
6433 as this calls lisp to get a directory listing). */
6434 Lisp_Object
w32_find_bdf_fonts_in_dir( Lisp_Object directory
)
6436 Lisp_Object filelist
, list
= Qnil
;
6439 if (!STRINGP(directory
))
6442 filelist
= Fdirectory_files (directory
, Qt
,
6443 build_string (".*\\.[bB][dD][fF]"), Qt
);
6445 for ( ; CONSP(filelist
); filelist
= XCONS (filelist
)->cdr
)
6447 Lisp_Object filename
= XCONS (filelist
)->car
;
6448 if (w32_BDF_to_x_font (XSTRING (filename
)->data
, fontname
, 100))
6449 store_in_alist (&list
, build_string (fontname
), filename
);
6455 DEFUN ("x-color-defined-p", Fx_color_defined_p
, Sx_color_defined_p
, 1, 2, 0,
6456 "Return non-nil if color COLOR is supported on frame FRAME.\n\
6457 If FRAME is omitted or nil, use the selected frame.")
6459 Lisp_Object color
, frame
;
6462 FRAME_PTR f
= check_x_frame (frame
);
6464 CHECK_STRING (color
, 1);
6466 if (defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
6472 DEFUN ("x-color-values", Fx_color_values
, Sx_color_values
, 1, 2, 0,
6473 "Return a description of the color named COLOR on frame FRAME.\n\
6474 The value is a list of integer RGB values--(RED GREEN BLUE).\n\
6475 These values appear to range from 0 to 65280 or 65535, depending\n\
6476 on the system; white is (65280 65280 65280) or (65535 65535 65535).\n\
6477 If FRAME is omitted or nil, use the selected frame.")
6479 Lisp_Object color
, frame
;
6482 FRAME_PTR f
= check_x_frame (frame
);
6484 CHECK_STRING (color
, 1);
6486 if (defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
6490 rgb
[0] = make_number ((GetRValue (foo
) << 8) | GetRValue (foo
));
6491 rgb
[1] = make_number ((GetGValue (foo
) << 8) | GetGValue (foo
));
6492 rgb
[2] = make_number ((GetBValue (foo
) << 8) | GetBValue (foo
));
6493 return Flist (3, rgb
);
6499 DEFUN ("x-display-color-p", Fx_display_color_p
, Sx_display_color_p
, 0, 1, 0,
6500 "Return t if the X display supports color.\n\
6501 The optional argument DISPLAY specifies which display to ask about.\n\
6502 DISPLAY should be either a frame or a display name (a string).\n\
6503 If omitted or nil, that stands for the selected frame's display.")
6505 Lisp_Object display
;
6507 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6509 if ((dpyinfo
->n_planes
* dpyinfo
->n_cbits
) <= 2)
6515 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
, Sx_display_grayscale_p
,
6517 "Return t if the X display supports shades of gray.\n\
6518 Note that color displays do support shades of gray.\n\
6519 The optional argument DISPLAY specifies which display to ask about.\n\
6520 DISPLAY should be either a frame or a display name (a string).\n\
6521 If omitted or nil, that stands for the selected frame's display.")
6523 Lisp_Object display
;
6525 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6527 if ((dpyinfo
->n_planes
* dpyinfo
->n_cbits
) <= 1)
6533 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
6535 "Returns the width in pixels of the X display DISPLAY.\n\
6536 The optional argument DISPLAY specifies which display to ask about.\n\
6537 DISPLAY should be either a frame or a display name (a string).\n\
6538 If omitted or nil, that stands for the selected frame's display.")
6540 Lisp_Object display
;
6542 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6544 return make_number (dpyinfo
->width
);
6547 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
6548 Sx_display_pixel_height
, 0, 1, 0,
6549 "Returns the height in pixels of the X 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 (dpyinfo
->height
);
6561 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
6563 "Returns the number of bitplanes of the display DISPLAY.\n\
6564 The optional argument DISPLAY specifies which display to ask about.\n\
6565 DISPLAY should be either a frame or a display name (a string).\n\
6566 If omitted or nil, that stands for the selected frame's display.")
6568 Lisp_Object display
;
6570 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6572 return make_number (dpyinfo
->n_planes
* dpyinfo
->n_cbits
);
6575 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
6577 "Returns the number of color cells of the display DISPLAY.\n\
6578 The optional argument DISPLAY specifies which display to ask about.\n\
6579 DISPLAY should be either a frame or a display name (a string).\n\
6580 If omitted or nil, that stands for the selected frame's display.")
6582 Lisp_Object display
;
6584 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6588 hdc
= GetDC (dpyinfo
->root_window
);
6589 if (dpyinfo
->has_palette
)
6590 cap
= GetDeviceCaps (hdc
,SIZEPALETTE
);
6592 cap
= GetDeviceCaps (hdc
,NUMCOLORS
);
6594 ReleaseDC (dpyinfo
->root_window
, hdc
);
6596 return make_number (cap
);
6599 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
6600 Sx_server_max_request_size
,
6602 "Returns the maximum request size of the server of display DISPLAY.\n\
6603 The optional argument DISPLAY specifies which display to ask about.\n\
6604 DISPLAY should be either a frame or a display name (a string).\n\
6605 If omitted or nil, that stands for the selected frame's display.")
6607 Lisp_Object display
;
6609 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6611 return make_number (1);
6614 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
6615 "Returns the vendor ID string of the W32 system (Microsoft).\n\
6616 The optional argument DISPLAY specifies which display to ask about.\n\
6617 DISPLAY should be either a frame or a display name (a string).\n\
6618 If omitted or nil, that stands for the selected frame's display.")
6620 Lisp_Object display
;
6622 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6623 char *vendor
= "Microsoft Corp.";
6625 if (! vendor
) vendor
= "";
6626 return build_string (vendor
);
6629 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
6630 "Returns the version numbers of the server of display DISPLAY.\n\
6631 The value is a list of three integers: the major and minor\n\
6632 version numbers, and the vendor-specific release\n\
6633 number. See also the function `x-server-vendor'.\n\n\
6634 The optional argument DISPLAY specifies which display to ask about.\n\
6635 DISPLAY should be either a frame or a display name (a string).\n\
6636 If omitted or nil, that stands for the selected frame's display.")
6638 Lisp_Object display
;
6640 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6642 return Fcons (make_number (w32_major_version
),
6643 Fcons (make_number (w32_minor_version
), Qnil
));
6646 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
6647 "Returns the number of screens on the server of display DISPLAY.\n\
6648 The optional argument DISPLAY specifies which display to ask about.\n\
6649 DISPLAY should be either a frame or a display name (a string).\n\
6650 If omitted or nil, that stands for the selected frame's display.")
6652 Lisp_Object display
;
6654 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6656 return make_number (1);
6659 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
6660 "Returns the height in millimeters of the X display DISPLAY.\n\
6661 The optional argument DISPLAY specifies which display to ask about.\n\
6662 DISPLAY should be either a frame or a display name (a string).\n\
6663 If omitted or nil, that stands for the selected frame's display.")
6665 Lisp_Object display
;
6667 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6671 hdc
= GetDC (dpyinfo
->root_window
);
6673 cap
= GetDeviceCaps (hdc
, VERTSIZE
);
6675 ReleaseDC (dpyinfo
->root_window
, hdc
);
6677 return make_number (cap
);
6680 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
6681 "Returns the width in millimeters of the X display DISPLAY.\n\
6682 The optional argument DISPLAY specifies which display to ask about.\n\
6683 DISPLAY should be either a frame or a display name (a string).\n\
6684 If omitted or nil, that stands for the selected frame's display.")
6686 Lisp_Object display
;
6688 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6693 hdc
= GetDC (dpyinfo
->root_window
);
6695 cap
= GetDeviceCaps (hdc
, HORZSIZE
);
6697 ReleaseDC (dpyinfo
->root_window
, hdc
);
6699 return make_number (cap
);
6702 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
6703 Sx_display_backing_store
, 0, 1, 0,
6704 "Returns an indication of whether display DISPLAY does backing store.\n\
6705 The value may be `always', `when-mapped', or `not-useful'.\n\
6706 The optional argument DISPLAY specifies which display to ask about.\n\
6707 DISPLAY should be either a frame or a display name (a string).\n\
6708 If omitted or nil, that stands for the selected frame's display.")
6710 Lisp_Object display
;
6712 return intern ("not-useful");
6715 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
6716 Sx_display_visual_class
, 0, 1, 0,
6717 "Returns the visual class of the display DISPLAY.\n\
6718 The value is one of the symbols `static-gray', `gray-scale',\n\
6719 `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
6720 The optional argument DISPLAY specifies which display to ask about.\n\
6721 DISPLAY should be either a frame or a display name (a string).\n\
6722 If omitted or nil, that stands for the selected frame's display.")
6724 Lisp_Object display
;
6726 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6729 switch (dpyinfo
->visual
->class)
6731 case StaticGray
: return (intern ("static-gray"));
6732 case GrayScale
: return (intern ("gray-scale"));
6733 case StaticColor
: return (intern ("static-color"));
6734 case PseudoColor
: return (intern ("pseudo-color"));
6735 case TrueColor
: return (intern ("true-color"));
6736 case DirectColor
: return (intern ("direct-color"));
6738 error ("Display has an unknown visual class");
6742 error ("Display has an unknown visual class");
6745 DEFUN ("x-display-save-under", Fx_display_save_under
,
6746 Sx_display_save_under
, 0, 1, 0,
6747 "Returns t if the display DISPLAY supports the save-under feature.\n\
6748 The optional argument DISPLAY specifies which display to ask about.\n\
6749 DISPLAY should be either a frame or a display name (a string).\n\
6750 If omitted or nil, that stands for the selected frame's display.")
6752 Lisp_Object display
;
6754 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6761 register struct frame
*f
;
6763 return PIXEL_WIDTH (f
);
6768 register struct frame
*f
;
6770 return PIXEL_HEIGHT (f
);
6775 register struct frame
*f
;
6777 return FONT_WIDTH (f
->output_data
.w32
->font
);
6782 register struct frame
*f
;
6784 return f
->output_data
.w32
->line_height
;
6788 x_screen_planes (frame
)
6791 return (FRAME_W32_DISPLAY_INFO (XFRAME (frame
))->n_planes
*
6792 FRAME_W32_DISPLAY_INFO (XFRAME (frame
))->n_cbits
);
6795 /* Return the display structure for the display named NAME.
6796 Open a new connection if necessary. */
6798 struct w32_display_info
*
6799 x_display_info_for_name (name
)
6803 struct w32_display_info
*dpyinfo
;
6805 CHECK_STRING (name
, 0);
6807 for (dpyinfo
= &one_w32_display_info
, names
= w32_display_name_list
;
6809 dpyinfo
= dpyinfo
->next
, names
= XCONS (names
)->cdr
)
6812 tem
= Fstring_equal (XCONS (XCONS (names
)->car
)->car
, name
);
6817 /* Use this general default value to start with. */
6818 Vx_resource_name
= Vinvocation_name
;
6820 validate_x_resource_name ();
6822 dpyinfo
= w32_term_init (name
, (unsigned char *)0,
6823 (char *) XSTRING (Vx_resource_name
)->data
);
6826 error ("Cannot connect to server %s", XSTRING (name
)->data
);
6829 XSETFASTINT (Vwindow_system_version
, 3);
6834 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
6835 1, 3, 0, "Open a connection to a server.\n\
6836 DISPLAY is the name of the display to connect to.\n\
6837 Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
6838 If the optional third arg MUST-SUCCEED is non-nil,\n\
6839 terminate Emacs if we can't open the connection.")
6840 (display
, xrm_string
, must_succeed
)
6841 Lisp_Object display
, xrm_string
, must_succeed
;
6843 unsigned int n_planes
;
6844 unsigned char *xrm_option
;
6845 struct w32_display_info
*dpyinfo
;
6847 CHECK_STRING (display
, 0);
6848 if (! NILP (xrm_string
))
6849 CHECK_STRING (xrm_string
, 1);
6851 if (! EQ (Vwindow_system
, intern ("w32")))
6852 error ("Not using Microsoft Windows");
6854 /* Allow color mapping to be defined externally; first look in user's
6855 HOME directory, then in Emacs etc dir for a file called rgb.txt. */
6857 Lisp_Object color_file
;
6858 struct gcpro gcpro1
;
6860 color_file
= build_string("~/rgb.txt");
6862 GCPRO1 (color_file
);
6864 if (NILP (Ffile_readable_p (color_file
)))
6866 Fexpand_file_name (build_string ("rgb.txt"),
6867 Fsymbol_value (intern ("data-directory")));
6869 Vw32_color_map
= Fw32_load_color_file (color_file
);
6873 if (NILP (Vw32_color_map
))
6874 Vw32_color_map
= Fw32_default_color_map ();
6876 if (! NILP (xrm_string
))
6877 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
6879 xrm_option
= (unsigned char *) 0;
6881 /* Use this general default value to start with. */
6882 /* First remove .exe suffix from invocation-name - it looks ugly. */
6884 char basename
[ MAX_PATH
], *str
;
6886 strcpy (basename
, XSTRING (Vinvocation_name
)->data
);
6887 str
= strrchr (basename
, '.');
6889 Vinvocation_name
= build_string (basename
);
6891 Vx_resource_name
= Vinvocation_name
;
6893 validate_x_resource_name ();
6895 /* This is what opens the connection and sets x_current_display.
6896 This also initializes many symbols, such as those used for input. */
6897 dpyinfo
= w32_term_init (display
, xrm_option
,
6898 (char *) XSTRING (Vx_resource_name
)->data
);
6902 if (!NILP (must_succeed
))
6903 fatal ("Cannot connect to server %s.\n",
6904 XSTRING (display
)->data
);
6906 error ("Cannot connect to server %s", XSTRING (display
)->data
);
6911 XSETFASTINT (Vwindow_system_version
, 3);
6915 DEFUN ("x-close-connection", Fx_close_connection
,
6916 Sx_close_connection
, 1, 1, 0,
6917 "Close the connection to DISPLAY's server.\n\
6918 For DISPLAY, specify either a frame or a display name (a string).\n\
6919 If DISPLAY is nil, that stands for the selected frame's display.")
6921 Lisp_Object display
;
6923 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6924 struct w32_display_info
*tail
;
6927 if (dpyinfo
->reference_count
> 0)
6928 error ("Display still has frames on it");
6931 /* Free the fonts in the font table. */
6932 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
6934 if (dpyinfo
->font_table
[i
].name
)
6935 free (dpyinfo
->font_table
[i
].name
);
6936 /* Don't free the full_name string;
6937 it is always shared with something else. */
6938 w32_unload_font (dpyinfo
, dpyinfo
->font_table
[i
].font
);
6940 x_destroy_all_bitmaps (dpyinfo
);
6942 x_delete_display (dpyinfo
);
6948 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
6949 "Return the list of display names that Emacs has connections to.")
6952 Lisp_Object tail
, result
;
6955 for (tail
= w32_display_name_list
; ! NILP (tail
); tail
= XCONS (tail
)->cdr
)
6956 result
= Fcons (XCONS (XCONS (tail
)->car
)->car
, result
);
6961 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
6962 "If ON is non-nil, report errors as soon as the erring request is made.\n\
6963 If ON is nil, allow buffering of requests.\n\
6964 This is a noop on W32 systems.\n\
6965 The optional second argument DISPLAY specifies which display to act on.\n\
6966 DISPLAY should be either a frame or a display name (a string).\n\
6967 If DISPLAY is omitted or nil, that stands for the selected frame's display.")
6969 Lisp_Object display
, on
;
6971 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6977 /* These are the w32 specialized functions */
6979 DEFUN ("w32-select-font", Fw32_select_font
, Sw32_select_font
, 0, 1, 0,
6980 "This will display the W32 font dialog and return an X font string corresponding to the selection.")
6984 FRAME_PTR f
= check_x_frame (frame
);
6992 bzero (&cf
, sizeof (cf
));
6993 bzero (&lf
, sizeof (lf
));
6995 cf
.lStructSize
= sizeof (cf
);
6996 cf
.hwndOwner
= FRAME_W32_WINDOW (f
);
6997 cf
.Flags
= CF_FIXEDPITCHONLY
| CF_FORCEFONTEXIST
| CF_SCREENFONTS
;
7000 /* Initialize as much of the font details as we can from the current
7002 hdc
= GetDC (FRAME_W32_WINDOW (f
));
7003 oldobj
= SelectObject (hdc
, FRAME_FONT (f
)->hfont
);
7004 GetTextFace (hdc
, LF_FACESIZE
, lf
.lfFaceName
);
7005 if (GetTextMetrics (hdc
, &tm
))
7007 lf
.lfHeight
= tm
.tmInternalLeading
- tm
.tmHeight
;
7008 lf
.lfWeight
= tm
.tmWeight
;
7009 lf
.lfItalic
= tm
.tmItalic
;
7010 lf
.lfUnderline
= tm
.tmUnderlined
;
7011 lf
.lfStrikeOut
= tm
.tmStruckOut
;
7012 lf
.lfPitchAndFamily
= tm
.tmPitchAndFamily
;
7013 lf
.lfCharSet
= tm
.tmCharSet
;
7014 cf
.Flags
|= CF_INITTOLOGFONTSTRUCT
;
7016 SelectObject (hdc
, oldobj
);
7017 ReleaseDC (FRAME_W32_WINDOW(f
), hdc
);
7019 if (!ChooseFont (&cf
) || !w32_to_x_font (&lf
, buf
, 100))
7022 return build_string (buf
);
7025 DEFUN ("w32-send-sys-command", Fw32_send_sys_command
, Sw32_send_sys_command
, 1, 2, 0,
7026 "Send frame a Windows WM_SYSCOMMAND message of type COMMAND.\n\
7027 Some useful values for command are 0xf030 to maximise frame (0xf020\n\
7028 to minimize), 0xf120 to restore frame to original size, and 0xf100\n\
7029 to activate the menubar for keyboard access. 0xf140 activates the\n\
7030 screen saver if defined.\n\
7032 If optional parameter FRAME is not specified, use selected frame.")
7034 Lisp_Object command
, frame
;
7037 FRAME_PTR f
= check_x_frame (frame
);
7039 CHECK_NUMBER (command
, 0);
7041 PostMessage (FRAME_W32_WINDOW (f
), WM_SYSCOMMAND
, XINT (command
), 0);
7046 DEFUN ("w32-shell-execute", Fw32_shell_execute
, Sw32_shell_execute
, 2, 4, 0,
7047 "Get Windows to perform OPERATION on DOCUMENT.\n\
7048 This is a wrapper around the ShellExecute system function, which\n\
7049 invokes the application registered to handle OPERATION for DOCUMENT.\n\
7050 OPERATION is typically \"open\", \"print\" or \"explore\", and DOCUMENT\n\
7051 is typically the name of a document file or URL, but can also be a\n\
7052 program executable to run or a directory to open in the Windows Explorer.\n\
7054 If DOCUMENT is a program executable, PARAMETERS can be a list of command\n\
7055 line parameters, but otherwise should be nil.\n\
7057 SHOW-FLAG can be used to control whether the invoked application is hidden\n\
7058 or minimized. If SHOw-FLAG is nil, the application is displayed normally,\n\
7059 otherwise it is an integer representing a ShowWindow flag:\n\
7062 1 - start normally\n\
7063 3 - start maximized\n\
7064 6 - start minimized")
7065 (operation
, document
, parameters
, show_flag
)
7066 Lisp_Object operation
, document
, parameters
, show_flag
;
7068 Lisp_Object current_dir
;
7070 CHECK_STRING (operation
, 0);
7071 CHECK_STRING (document
, 0);
7073 /* Encode filename and current directory. */
7074 current_dir
= ENCODE_FILE (current_buffer
->directory
);
7075 document
= ENCODE_FILE (document
);
7076 if ((int) ShellExecute (NULL
,
7077 XSTRING (operation
)->data
,
7078 XSTRING (document
)->data
,
7079 (STRINGP (parameters
) ?
7080 XSTRING (parameters
)->data
: NULL
),
7081 XSTRING (current_dir
)->data
,
7082 (INTEGERP (show_flag
) ?
7083 XINT (show_flag
) : SW_SHOWDEFAULT
))
7086 error ("ShellExecute failed");
7089 /* Lookup virtual keycode from string representing the name of a
7090 non-ascii keystroke into the corresponding virtual key, using
7091 lispy_function_keys. */
7093 lookup_vk_code (char *key
)
7097 for (i
= 0; i
< 256; i
++)
7098 if (lispy_function_keys
[i
] != 0
7099 && strcmp (lispy_function_keys
[i
], key
) == 0)
7105 /* Convert a one-element vector style key sequence to a hot key
7108 w32_parse_hot_key (key
)
7111 /* Copied from Fdefine_key and store_in_keymap. */
7112 register Lisp_Object c
;
7116 struct gcpro gcpro1
;
7118 CHECK_VECTOR (key
, 0);
7120 if (XFASTINT (Flength (key
)) != 1)
7125 c
= Faref (key
, make_number (0));
7127 if (CONSP (c
) && lucid_event_type_list_p (c
))
7128 c
= Fevent_convert_list (c
);
7132 if (! INTEGERP (c
) && ! SYMBOLP (c
))
7133 error ("Key definition is invalid");
7135 /* Work out the base key and the modifiers. */
7138 c
= parse_modifiers (c
);
7139 lisp_modifiers
= Fcar (Fcdr (c
));
7143 vk_code
= lookup_vk_code (XSYMBOL (c
)->name
->data
);
7145 else if (INTEGERP (c
))
7147 lisp_modifiers
= XINT (c
) & ~CHARACTERBITS
;
7148 /* Many ascii characters are their own virtual key code. */
7149 vk_code
= XINT (c
) & CHARACTERBITS
;
7152 if (vk_code
< 0 || vk_code
> 255)
7155 if ((lisp_modifiers
& meta_modifier
) != 0
7156 && !NILP (Vw32_alt_is_meta
))
7157 lisp_modifiers
|= alt_modifier
;
7159 /* Convert lisp modifiers to Windows hot-key form. */
7160 w32_modifiers
= (lisp_modifiers
& hyper_modifier
) ? MOD_WIN
: 0;
7161 w32_modifiers
|= (lisp_modifiers
& alt_modifier
) ? MOD_ALT
: 0;
7162 w32_modifiers
|= (lisp_modifiers
& ctrl_modifier
) ? MOD_CONTROL
: 0;
7163 w32_modifiers
|= (lisp_modifiers
& shift_modifier
) ? MOD_SHIFT
: 0;
7165 return HOTKEY (vk_code
, w32_modifiers
);
7168 DEFUN ("w32-register-hot-key", Fw32_register_hot_key
, Sw32_register_hot_key
, 1, 1, 0,
7169 "Register KEY as a hot-key combination.\n\
7170 Certain key combinations like Alt-Tab are reserved for system use on\n\
7171 Windows, and therefore are normally intercepted by the system. However,\n\
7172 most of these key combinations can be received by registering them as\n\
7173 hot-keys, overriding their special meaning.\n\
7175 KEY must be a one element key definition in vector form that would be\n\
7176 acceptable to `define-key' (e.g. [A-tab] for Alt-Tab). The meta\n\
7177 modifier is interpreted as Alt if `w32-alt-is-meta' is t, and hyper\n\
7178 is always interpreted as the Windows modifier keys.\n\
7180 The return value is the hotkey-id if registered, otherwise nil.")
7184 key
= w32_parse_hot_key (key
);
7186 if (NILP (Fmemq (key
, w32_grabbed_keys
)))
7188 /* Reuse an empty slot if possible. */
7189 Lisp_Object item
= Fmemq (Qnil
, w32_grabbed_keys
);
7191 /* Safe to add new key to list, even if we have focus. */
7193 w32_grabbed_keys
= Fcons (key
, w32_grabbed_keys
);
7197 /* Notify input thread about new hot-key definition, so that it
7198 takes effect without needing to switch focus. */
7199 PostThreadMessage (dwWindowsThreadId
, WM_EMACS_REGISTER_HOT_KEY
,
7206 DEFUN ("w32-unregister-hot-key", Fw32_unregister_hot_key
, Sw32_unregister_hot_key
, 1, 1, 0,
7207 "Unregister HOTKEY as a hot-key combination.")
7213 if (!INTEGERP (key
))
7214 key
= w32_parse_hot_key (key
);
7216 item
= Fmemq (key
, w32_grabbed_keys
);
7220 /* Notify input thread about hot-key definition being removed, so
7221 that it takes effect without needing focus switch. */
7222 if (PostThreadMessage (dwWindowsThreadId
, WM_EMACS_UNREGISTER_HOT_KEY
,
7223 (WPARAM
) XINT (XCAR (item
)), (LPARAM
) item
))
7226 GetMessage (&msg
, NULL
, WM_EMACS_DONE
, WM_EMACS_DONE
);
7233 DEFUN ("w32-registered-hot-keys", Fw32_registered_hot_keys
, Sw32_registered_hot_keys
, 0, 0, 0,
7234 "Return list of registered hot-key IDs.")
7237 return Fcopy_sequence (w32_grabbed_keys
);
7240 DEFUN ("w32-reconstruct-hot-key", Fw32_reconstruct_hot_key
, Sw32_reconstruct_hot_key
, 1, 1, 0,
7241 "Convert hot-key ID to a lisp key combination.")
7243 Lisp_Object hotkeyid
;
7245 int vk_code
, w32_modifiers
;
7248 CHECK_NUMBER (hotkeyid
, 0);
7250 vk_code
= HOTKEY_VK_CODE (hotkeyid
);
7251 w32_modifiers
= HOTKEY_MODIFIERS (hotkeyid
);
7253 if (lispy_function_keys
[vk_code
])
7254 key
= intern (lispy_function_keys
[vk_code
]);
7256 key
= make_number (vk_code
);
7258 key
= Fcons (key
, Qnil
);
7259 if (w32_modifiers
& MOD_SHIFT
)
7260 key
= Fcons (Qshift
, key
);
7261 if (w32_modifiers
& MOD_CONTROL
)
7262 key
= Fcons (Qctrl
, key
);
7263 if (w32_modifiers
& MOD_ALT
)
7264 key
= Fcons (NILP (Vw32_alt_is_meta
) ? Qalt
: Qmeta
, key
);
7265 if (w32_modifiers
& MOD_WIN
)
7266 key
= Fcons (Qhyper
, key
);
7271 DEFUN ("w32-toggle-lock-key", Fw32_toggle_lock_key
, Sw32_toggle_lock_key
, 1, 2, 0,
7272 "Toggle the state of the lock key KEY.\n\
7273 KEY can be `capslock', `kp-numlock', or `scroll'.\n\
7274 If the optional parameter NEW-STATE is a number, then the state of KEY\n\
7275 is set to off if the low bit of NEW-STATE is zero, otherwise on.")
7277 Lisp_Object key
, new_state
;
7282 if (EQ (key
, intern ("capslock")))
7283 vk_code
= VK_CAPITAL
;
7284 else if (EQ (key
, intern ("kp-numlock")))
7285 vk_code
= VK_NUMLOCK
;
7286 else if (EQ (key
, intern ("scroll")))
7287 vk_code
= VK_SCROLL
;
7291 if (!dwWindowsThreadId
)
7292 return make_number (w32_console_toggle_lock_key (vk_code
, new_state
));
7294 if (PostThreadMessage (dwWindowsThreadId
, WM_EMACS_TOGGLE_LOCK_KEY
,
7295 (WPARAM
) vk_code
, (LPARAM
) new_state
))
7298 GetMessage (&msg
, NULL
, WM_EMACS_DONE
, WM_EMACS_DONE
);
7299 return make_number (msg
.wParam
);
7306 /* This is zero if not using MS-Windows. */
7309 /* The section below is built by the lisp expression at the top of the file,
7310 just above where these variables are declared. */
7311 /*&&& init symbols here &&&*/
7312 Qauto_raise
= intern ("auto-raise");
7313 staticpro (&Qauto_raise
);
7314 Qauto_lower
= intern ("auto-lower");
7315 staticpro (&Qauto_lower
);
7316 Qbackground_color
= intern ("background-color");
7317 staticpro (&Qbackground_color
);
7318 Qbar
= intern ("bar");
7320 Qborder_color
= intern ("border-color");
7321 staticpro (&Qborder_color
);
7322 Qborder_width
= intern ("border-width");
7323 staticpro (&Qborder_width
);
7324 Qbox
= intern ("box");
7326 Qcursor_color
= intern ("cursor-color");
7327 staticpro (&Qcursor_color
);
7328 Qcursor_type
= intern ("cursor-type");
7329 staticpro (&Qcursor_type
);
7330 Qforeground_color
= intern ("foreground-color");
7331 staticpro (&Qforeground_color
);
7332 Qgeometry
= intern ("geometry");
7333 staticpro (&Qgeometry
);
7334 Qicon_left
= intern ("icon-left");
7335 staticpro (&Qicon_left
);
7336 Qicon_top
= intern ("icon-top");
7337 staticpro (&Qicon_top
);
7338 Qicon_type
= intern ("icon-type");
7339 staticpro (&Qicon_type
);
7340 Qicon_name
= intern ("icon-name");
7341 staticpro (&Qicon_name
);
7342 Qinternal_border_width
= intern ("internal-border-width");
7343 staticpro (&Qinternal_border_width
);
7344 Qleft
= intern ("left");
7346 Qright
= intern ("right");
7347 staticpro (&Qright
);
7348 Qmouse_color
= intern ("mouse-color");
7349 staticpro (&Qmouse_color
);
7350 Qnone
= intern ("none");
7352 Qparent_id
= intern ("parent-id");
7353 staticpro (&Qparent_id
);
7354 Qscroll_bar_width
= intern ("scroll-bar-width");
7355 staticpro (&Qscroll_bar_width
);
7356 Qsuppress_icon
= intern ("suppress-icon");
7357 staticpro (&Qsuppress_icon
);
7358 Qtop
= intern ("top");
7360 Qundefined_color
= intern ("undefined-color");
7361 staticpro (&Qundefined_color
);
7362 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
7363 staticpro (&Qvertical_scroll_bars
);
7364 Qvisibility
= intern ("visibility");
7365 staticpro (&Qvisibility
);
7366 Qwindow_id
= intern ("window-id");
7367 staticpro (&Qwindow_id
);
7368 Qx_frame_parameter
= intern ("x-frame-parameter");
7369 staticpro (&Qx_frame_parameter
);
7370 Qx_resource_name
= intern ("x-resource-name");
7371 staticpro (&Qx_resource_name
);
7372 Quser_position
= intern ("user-position");
7373 staticpro (&Quser_position
);
7374 Quser_size
= intern ("user-size");
7375 staticpro (&Quser_size
);
7376 Qdisplay
= intern ("display");
7377 staticpro (&Qdisplay
);
7378 /* This is the end of symbol initialization. */
7380 Qhyper
= intern ("hyper");
7381 staticpro (&Qhyper
);
7382 Qsuper
= intern ("super");
7383 staticpro (&Qsuper
);
7384 Qmeta
= intern ("meta");
7386 Qalt
= intern ("alt");
7388 Qctrl
= intern ("ctrl");
7390 Qcontrol
= intern ("control");
7391 staticpro (&Qcontrol
);
7392 Qshift
= intern ("shift");
7393 staticpro (&Qshift
);
7395 Qface_set_after_frame_default
= intern ("face-set-after-frame-default");
7396 staticpro (&Qface_set_after_frame_default
);
7398 Fput (Qundefined_color
, Qerror_conditions
,
7399 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
7400 Fput (Qundefined_color
, Qerror_message
,
7401 build_string ("Undefined color"));
7403 staticpro (&w32_grabbed_keys
);
7404 w32_grabbed_keys
= Qnil
;
7406 DEFVAR_LISP ("w32-color-map", &Vw32_color_map
,
7407 "An array of color name mappings for windows.");
7408 Vw32_color_map
= Qnil
;
7410 DEFVAR_LISP ("w32-pass-alt-to-system", &Vw32_pass_alt_to_system
,
7411 "Non-nil if alt key presses are passed on to Windows.\n\
7412 When non-nil, for example, alt pressed and released and then space will\n\
7413 open the System menu. When nil, Emacs silently swallows alt key events.");
7414 Vw32_pass_alt_to_system
= Qnil
;
7416 DEFVAR_LISP ("w32-alt-is-meta", &Vw32_alt_is_meta
,
7417 "Non-nil if the alt key is to be considered the same as the meta key.\n\
7418 When nil, Emacs will translate the alt key to the Alt modifier, and not Meta.");
7419 Vw32_alt_is_meta
= Qt
;
7421 DEFVAR_INT ("w32-quit-key", &Vw32_quit_key
,
7422 "If non-zero, the virtual key code for an alternative quit key.");
7423 XSETINT (Vw32_quit_key
, 0);
7425 DEFVAR_LISP ("w32-pass-lwindow-to-system",
7426 &Vw32_pass_lwindow_to_system
,
7427 "Non-nil if the left \"Windows\" key is passed on to Windows.\n\
7428 When non-nil, the Start menu is opened by tapping the key.");
7429 Vw32_pass_lwindow_to_system
= Qt
;
7431 DEFVAR_LISP ("w32-pass-rwindow-to-system",
7432 &Vw32_pass_rwindow_to_system
,
7433 "Non-nil if the right \"Windows\" key is passed on to Windows.\n\
7434 When non-nil, the Start menu is opened by tapping the key.");
7435 Vw32_pass_rwindow_to_system
= Qt
;
7437 DEFVAR_INT ("w32-phantom-key-code",
7438 &Vw32_phantom_key_code
,
7439 "Virtual key code used to generate \"phantom\" key presses.\n\
7440 Value is a number between 0 and 255.\n\
7442 Phantom key presses are generated in order to stop the system from\n\
7443 acting on \"Windows\" key events when `w32-pass-lwindow-to-system' or\n\
7444 `w32-pass-rwindow-to-system' is nil.");
7445 /* Although 255 is technically not a valid key code, it works and
7446 means that this hack won't interfere with any real key code. */
7447 Vw32_phantom_key_code
= 255;
7449 DEFVAR_LISP ("w32-enable-num-lock",
7450 &Vw32_enable_num_lock
,
7451 "Non-nil if Num Lock should act normally.\n\
7452 Set to nil to see Num Lock as the key `kp-numlock'.");
7453 Vw32_enable_num_lock
= Qt
;
7455 DEFVAR_LISP ("w32-enable-caps-lock",
7456 &Vw32_enable_caps_lock
,
7457 "Non-nil if Caps Lock should act normally.\n\
7458 Set to nil to see Caps Lock as the key `capslock'.");
7459 Vw32_enable_caps_lock
= Qt
;
7461 DEFVAR_LISP ("w32-scroll-lock-modifier",
7462 &Vw32_scroll_lock_modifier
,
7463 "Modifier to use for the Scroll Lock on state.\n\
7464 The value can be hyper, super, meta, alt, control or shift for the\n\
7465 respective modifier, or nil to see Scroll Lock as the key `scroll'.\n\
7466 Any other value will cause the key to be ignored.");
7467 Vw32_scroll_lock_modifier
= Qt
;
7469 DEFVAR_LISP ("w32-lwindow-modifier",
7470 &Vw32_lwindow_modifier
,
7471 "Modifier to use for the left \"Windows\" key.\n\
7472 The value can be hyper, super, meta, alt, control or shift for the\n\
7473 respective modifier, or nil to appear as the key `lwindow'.\n\
7474 Any other value will cause the key to be ignored.");
7475 Vw32_lwindow_modifier
= Qnil
;
7477 DEFVAR_LISP ("w32-rwindow-modifier",
7478 &Vw32_rwindow_modifier
,
7479 "Modifier to use for the right \"Windows\" key.\n\
7480 The value can be hyper, super, meta, alt, control or shift for the\n\
7481 respective modifier, or nil to appear as the key `rwindow'.\n\
7482 Any other value will cause the key to be ignored.");
7483 Vw32_rwindow_modifier
= Qnil
;
7485 DEFVAR_LISP ("w32-apps-modifier",
7486 &Vw32_apps_modifier
,
7487 "Modifier to use for the \"Apps\" key.\n\
7488 The value can be hyper, super, meta, alt, control or shift for the\n\
7489 respective modifier, or nil to appear as the key `apps'.\n\
7490 Any other value will cause the key to be ignored.");
7491 Vw32_apps_modifier
= Qnil
;
7493 DEFVAR_LISP ("w32-enable-italics", &Vw32_enable_italics
,
7494 "Non-nil enables selection of artificially italicized fonts.");
7495 Vw32_enable_italics
= Qnil
;
7497 DEFVAR_LISP ("w32-enable-palette", &Vw32_enable_palette
,
7498 "Non-nil enables Windows palette management to map colors exactly.");
7499 Vw32_enable_palette
= Qt
;
7501 DEFVAR_INT ("w32-mouse-button-tolerance",
7502 &Vw32_mouse_button_tolerance
,
7503 "Analogue of double click interval for faking middle mouse events.\n\
7504 The value is the minimum time in milliseconds that must elapse between\n\
7505 left/right button down events before they are considered distinct events.\n\
7506 If both mouse buttons are depressed within this interval, a middle mouse\n\
7507 button down event is generated instead.");
7508 XSETINT (Vw32_mouse_button_tolerance
, GetDoubleClickTime () / 2);
7510 DEFVAR_INT ("w32-mouse-move-interval",
7511 &Vw32_mouse_move_interval
,
7512 "Minimum interval between mouse move events.\n\
7513 The value is the minimum time in milliseconds that must elapse between\n\
7514 successive mouse move (or scroll bar drag) events before they are\n\
7515 reported as lisp events.");
7516 XSETINT (Vw32_mouse_move_interval
, 0);
7518 init_x_parm_symbols ();
7520 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path
,
7521 "List of directories to search for bitmap files for w32.");
7522 Vx_bitmap_file_path
= decode_env_path ((char *) 0, "PATH");
7524 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
7525 "The shape of the pointer when over text.\n\
7526 Changing the value does not affect existing frames\n\
7527 unless you set the mouse color.");
7528 Vx_pointer_shape
= Qnil
;
7530 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
7531 "The name Emacs uses to look up resources; for internal use only.\n\
7532 `x-get-resource' uses this as the first component of the instance name\n\
7533 when requesting resource values.\n\
7534 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
7535 was invoked, or to the value specified with the `-name' or `-rn'\n\
7536 switches, if present.");
7537 Vx_resource_name
= Qnil
;
7539 Vx_nontext_pointer_shape
= Qnil
;
7541 Vx_mode_pointer_shape
= Qnil
;
7543 DEFVAR_INT ("x-sensitive-text-pointer-shape",
7544 &Vx_sensitive_text_pointer_shape
,
7545 "The shape of the pointer when over mouse-sensitive text.\n\
7546 This variable takes effect when you create a new frame\n\
7547 or when you set the mouse color.");
7548 Vx_sensitive_text_pointer_shape
= Qnil
;
7550 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
7551 "A string indicating the foreground color of the cursor box.");
7552 Vx_cursor_fore_pixel
= Qnil
;
7554 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
7555 "Non-nil if no window manager is in use.\n\
7556 Emacs doesn't try to figure this out; this is always nil\n\
7557 unless you set it to something else.");
7558 /* We don't have any way to find this out, so set it to nil
7559 and maybe the user would like to set it to t. */
7560 Vx_no_window_manager
= Qnil
;
7562 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
7563 &Vx_pixel_size_width_font_regexp
,
7564 "Regexp matching a font name whose width is the same as `PIXEL_SIZE'.\n\
7566 Since Emacs gets width of a font matching with this regexp from\n\
7567 PIXEL_SIZE field of the name, font finding mechanism gets faster for\n\
7568 such a font. This is especially effective for such large fonts as\n\
7569 Chinese, Japanese, and Korean.");
7570 Vx_pixel_size_width_font_regexp
= Qnil
;
7572 DEFVAR_LISP ("w32-bdf-filename-alist",
7573 &Vw32_bdf_filename_alist
,
7574 "List of bdf fonts and their corresponding filenames.");
7575 Vw32_bdf_filename_alist
= Qnil
;
7577 DEFVAR_BOOL ("w32-strict-fontnames",
7578 &w32_strict_fontnames
,
7579 "Non-nil means only use fonts that are exact matches for those requested.\n\
7580 Default is nil, which allows old fontnames that are not XLFD compliant,\n\
7581 and allows third-party CJK display to work by specifying false charset\n\
7582 fields to trick Emacs into translating to Big5, SJIS etc.\n\
7583 Setting this to t will prevent wrong fonts being selected when\n\
7584 fontsets are automatically created.");
7585 w32_strict_fontnames
= 0;
7587 DEFVAR_BOOL ("w32-strict-painting",
7588 &w32_strict_painting
,
7589 "Non-nil means use strict rules for repainting frames.\n\
7590 Set this to nil to get the old behaviour for repainting; this should\n\
7591 only be necessary if the default setting causes problems.");
7592 w32_strict_painting
= 1;
7594 DEFVAR_LISP ("w32-system-coding-system",
7595 &Vw32_system_coding_system
,
7596 "Coding system used by Windows system functions, such as for font names.");
7597 Vw32_system_coding_system
= Qnil
;
7599 defsubr (&Sx_get_resource
);
7600 defsubr (&Sx_list_fonts
);
7601 defsubr (&Sx_display_color_p
);
7602 defsubr (&Sx_display_grayscale_p
);
7603 defsubr (&Sx_color_defined_p
);
7604 defsubr (&Sx_color_values
);
7605 defsubr (&Sx_server_max_request_size
);
7606 defsubr (&Sx_server_vendor
);
7607 defsubr (&Sx_server_version
);
7608 defsubr (&Sx_display_pixel_width
);
7609 defsubr (&Sx_display_pixel_height
);
7610 defsubr (&Sx_display_mm_width
);
7611 defsubr (&Sx_display_mm_height
);
7612 defsubr (&Sx_display_screens
);
7613 defsubr (&Sx_display_planes
);
7614 defsubr (&Sx_display_color_cells
);
7615 defsubr (&Sx_display_visual_class
);
7616 defsubr (&Sx_display_backing_store
);
7617 defsubr (&Sx_display_save_under
);
7618 defsubr (&Sx_parse_geometry
);
7619 defsubr (&Sx_create_frame
);
7620 defsubr (&Sx_open_connection
);
7621 defsubr (&Sx_close_connection
);
7622 defsubr (&Sx_display_list
);
7623 defsubr (&Sx_synchronize
);
7625 /* W32 specific functions */
7627 defsubr (&Sw32_focus_frame
);
7628 defsubr (&Sw32_select_font
);
7629 defsubr (&Sw32_define_rgb_color
);
7630 defsubr (&Sw32_default_color_map
);
7631 defsubr (&Sw32_load_color_file
);
7632 defsubr (&Sw32_send_sys_command
);
7633 defsubr (&Sw32_shell_execute
);
7634 defsubr (&Sw32_register_hot_key
);
7635 defsubr (&Sw32_unregister_hot_key
);
7636 defsubr (&Sw32_registered_hot_keys
);
7637 defsubr (&Sw32_reconstruct_hot_key
);
7638 defsubr (&Sw32_toggle_lock_key
);
7639 defsubr (&Sw32_find_bdf_fonts
);
7641 /* Setting callback functions for fontset handler. */
7642 get_font_info_func
= w32_get_font_info
;
7643 list_fonts_func
= w32_list_fonts
;
7644 load_font_func
= w32_load_font
;
7645 find_ccl_program_func
= w32_find_ccl_program
;
7646 query_font_func
= w32_query_font
;
7647 set_frame_fontset_func
= x_set_font
;
7648 check_window_system_func
= check_w32
;
7657 button
= MessageBox (NULL
,
7658 "A fatal error has occurred!\n\n"
7659 "Select Abort to exit, Retry to debug, Ignore to continue",
7660 "Emacs Abort Dialog",
7661 MB_ICONEXCLAMATION
| MB_TASKMODAL
7662 | MB_SETFOREGROUND
| MB_ABORTRETRYIGNORE
);
7677 /* For convenience when debugging. */
7681 return GetLastError ();