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 */
35 #include "dispextern.h"
37 #include "blockinput.h"
40 #include "termhooks.h"
46 extern void free_frame_menubar ();
47 extern struct scroll_bar
*x_window_to_scroll_bar ();
50 /* The colormap for converting color names to RGB values */
51 Lisp_Object Vw32_color_map
;
53 /* Non nil if alt key presses are passed on to Windows. */
54 Lisp_Object Vw32_pass_alt_to_system
;
56 /* Non nil if alt key is translated to meta_modifier, nil if it is translated
58 Lisp_Object Vw32_alt_is_meta
;
60 /* Non nil if left window, right window, and application key events
61 are passed on to Windows. */
62 Lisp_Object Vw32_pass_optional_keys_to_system
;
64 /* Switch to control whether we inhibit requests for italicised fonts (which
65 are synthesized, look ugly, and are trashed by cursor movement under NT). */
66 Lisp_Object Vw32_enable_italics
;
68 /* Enable palette management. */
69 Lisp_Object Vw32_enable_palette
;
71 /* Control how close left/right button down events must be to
72 be converted to a middle button down event. */
73 Lisp_Object Vw32_mouse_button_tolerance
;
75 /* Minimum interval between mouse movement (and scroll bar drag)
76 events that are passed on to the event loop. */
77 Lisp_Object Vw32_mouse_move_interval
;
79 /* The name we're using in resource queries. */
80 Lisp_Object Vx_resource_name
;
82 /* Non nil if no window manager is in use. */
83 Lisp_Object Vx_no_window_manager
;
85 /* The background and shape of the mouse pointer, and shape when not
86 over text or in the modeline. */
87 Lisp_Object Vx_pointer_shape
, Vx_nontext_pointer_shape
, Vx_mode_pointer_shape
;
88 /* The shape when over mouse-sensitive text. */
89 Lisp_Object Vx_sensitive_text_pointer_shape
;
91 /* Color of chars displayed in cursor box. */
92 Lisp_Object Vx_cursor_fore_pixel
;
94 /* Nonzero if using Windows. */
95 static int w32_in_use
;
97 /* Search path for bitmap files. */
98 Lisp_Object Vx_bitmap_file_path
;
100 /* Evaluate this expression to rebuild the section of syms_of_w32fns
101 that initializes and staticpros the symbols declared below. Note
102 that Emacs 18 has a bug that keeps C-x C-e from being able to
103 evaluate this expression.
106 ;; Accumulate a list of the symbols we want to initialize from the
107 ;; declarations at the top of the file.
108 (goto-char (point-min))
109 (search-forward "/\*&&& symbols declared here &&&*\/\n")
111 (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)")
113 (cons (buffer-substring (match-beginning 1) (match-end 1))
116 (setq symbol-list (nreverse symbol-list))
117 ;; Delete the section of syms_of_... where we initialize the symbols.
118 (search-forward "\n /\*&&& init symbols here &&&*\/\n")
119 (let ((start (point)))
120 (while (looking-at "^ Q")
122 (kill-region start (point)))
123 ;; Write a new symbol initialization section.
125 (insert (format " %s = intern (\"" (car symbol-list)))
126 (let ((start (point)))
127 (insert (substring (car symbol-list) 1))
128 (subst-char-in-region start (point) ?_ ?-))
129 (insert (format "\");\n staticpro (&%s);\n" (car symbol-list)))
130 (setq symbol-list (cdr symbol-list)))))
134 /*&&& symbols declared here &&&*/
135 Lisp_Object Qauto_raise
;
136 Lisp_Object Qauto_lower
;
137 Lisp_Object Qbackground_color
;
139 Lisp_Object Qborder_color
;
140 Lisp_Object Qborder_width
;
142 Lisp_Object Qcursor_color
;
143 Lisp_Object Qcursor_type
;
144 Lisp_Object Qforeground_color
;
145 Lisp_Object Qgeometry
;
146 Lisp_Object Qicon_left
;
147 Lisp_Object Qicon_top
;
148 Lisp_Object Qicon_type
;
149 Lisp_Object Qicon_name
;
150 Lisp_Object Qinternal_border_width
;
153 Lisp_Object Qmouse_color
;
155 Lisp_Object Qparent_id
;
156 Lisp_Object Qscroll_bar_width
;
157 Lisp_Object Qsuppress_icon
;
159 Lisp_Object Qundefined_color
;
160 Lisp_Object Qvertical_scroll_bars
;
161 Lisp_Object Qvisibility
;
162 Lisp_Object Qwindow_id
;
163 Lisp_Object Qx_frame_parameter
;
164 Lisp_Object Qx_resource_name
;
165 Lisp_Object Quser_position
;
166 Lisp_Object Quser_size
;
167 Lisp_Object Qdisplay
;
169 /* State variables for emulating a three button mouse. */
174 static int button_state
= 0;
175 static W32Msg saved_mouse_button_msg
;
176 static unsigned mouse_button_timer
; /* non-zero when timer is active */
177 static W32Msg saved_mouse_move_msg
;
178 static unsigned mouse_move_timer
;
180 /* W95 mousewheel handler */
181 unsigned int msh_mousewheel
= 0;
183 #define MOUSE_BUTTON_ID 1
184 #define MOUSE_MOVE_ID 2
186 /* The below are defined in frame.c. */
187 extern Lisp_Object Qheight
, Qminibuffer
, Qname
, Qonly
, Qwidth
;
188 extern Lisp_Object Qunsplittable
, Qmenu_bar_lines
, Qbuffer_predicate
, Qtitle
;
190 extern Lisp_Object Vwindow_system_version
;
192 extern Lisp_Object last_mouse_scroll_bar
;
193 extern int last_mouse_scroll_bar_pos
;
195 /* From w32term.c. */
196 extern Lisp_Object Vw32_num_mouse_buttons
;
199 /* Error if we are not connected to MS-Windows. */
204 error ("MS-Windows not in use or not initialized");
207 /* Nonzero if we can use mouse menus.
208 You should not call this unless HAVE_MENUS is defined. */
216 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
217 and checking validity for W32. */
220 check_x_frame (frame
)
229 CHECK_LIVE_FRAME (frame
, 0);
232 if (! FRAME_W32_P (f
))
233 error ("non-w32 frame used");
237 /* Let the user specify an display with a frame.
238 nil stands for the selected frame--or, if that is not a w32 frame,
239 the first display on the list. */
241 static struct w32_display_info
*
242 check_x_display_info (frame
)
247 if (FRAME_W32_P (selected_frame
))
248 return FRAME_W32_DISPLAY_INFO (selected_frame
);
250 return &one_w32_display_info
;
252 else if (STRINGP (frame
))
253 return x_display_info_for_name (frame
);
258 CHECK_LIVE_FRAME (frame
, 0);
260 if (! FRAME_W32_P (f
))
261 error ("non-w32 frame used");
262 return FRAME_W32_DISPLAY_INFO (f
);
266 /* Return the Emacs frame-object corresponding to an w32 window.
267 It could be the frame's main window or an icon window. */
269 /* This function can be called during GC, so use GC_xxx type test macros. */
272 x_window_to_frame (dpyinfo
, wdesc
)
273 struct w32_display_info
*dpyinfo
;
276 Lisp_Object tail
, frame
;
279 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
281 frame
= XCONS (tail
)->car
;
282 if (!GC_FRAMEP (frame
))
285 if (f
->output_data
.nothing
== 1
286 || FRAME_W32_DISPLAY_INFO (f
) != dpyinfo
)
288 if (FRAME_W32_WINDOW (f
) == wdesc
)
296 /* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
297 id, which is just an int that this section returns. Bitmaps are
298 reference counted so they can be shared among frames.
300 Bitmap indices are guaranteed to be > 0, so a negative number can
301 be used to indicate no bitmap.
303 If you use x_create_bitmap_from_data, then you must keep track of
304 the bitmaps yourself. That is, creating a bitmap from the same
305 data more than once will not be caught. */
308 /* Functions to access the contents of a bitmap, given an id. */
311 x_bitmap_height (f
, id
)
315 return FRAME_W32_DISPLAY_INFO (f
)->bitmaps
[id
- 1].height
;
319 x_bitmap_width (f
, id
)
323 return FRAME_W32_DISPLAY_INFO (f
)->bitmaps
[id
- 1].width
;
327 x_bitmap_pixmap (f
, id
)
331 return (int) FRAME_W32_DISPLAY_INFO (f
)->bitmaps
[id
- 1].pixmap
;
335 /* Allocate a new bitmap record. Returns index of new record. */
338 x_allocate_bitmap_record (f
)
341 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
344 if (dpyinfo
->bitmaps
== NULL
)
346 dpyinfo
->bitmaps_size
= 10;
348 = (struct w32_bitmap_record
*) xmalloc (dpyinfo
->bitmaps_size
* sizeof (struct w32_bitmap_record
));
349 dpyinfo
->bitmaps_last
= 1;
353 if (dpyinfo
->bitmaps_last
< dpyinfo
->bitmaps_size
)
354 return ++dpyinfo
->bitmaps_last
;
356 for (i
= 0; i
< dpyinfo
->bitmaps_size
; ++i
)
357 if (dpyinfo
->bitmaps
[i
].refcount
== 0)
360 dpyinfo
->bitmaps_size
*= 2;
362 = (struct w32_bitmap_record
*) xrealloc (dpyinfo
->bitmaps
,
363 dpyinfo
->bitmaps_size
* sizeof (struct w32_bitmap_record
));
364 return ++dpyinfo
->bitmaps_last
;
367 /* Add one reference to the reference count of the bitmap with id ID. */
370 x_reference_bitmap (f
, id
)
374 ++FRAME_W32_DISPLAY_INFO (f
)->bitmaps
[id
- 1].refcount
;
377 /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
380 x_create_bitmap_from_data (f
, bits
, width
, height
)
383 unsigned int width
, height
;
385 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
389 bitmap
= CreateBitmap (width
, height
,
390 FRAME_W32_DISPLAY_INFO (XFRAME (frame
))->n_planes
,
391 FRAME_W32_DISPLAY_INFO (XFRAME (frame
))->n_cbits
,
397 id
= x_allocate_bitmap_record (f
);
398 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
399 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
400 dpyinfo
->bitmaps
[id
- 1].hinst
= NULL
;
401 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
402 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
403 dpyinfo
->bitmaps
[id
- 1].height
= height
;
404 dpyinfo
->bitmaps
[id
- 1].width
= width
;
409 /* Create bitmap from file FILE for frame F. */
412 x_create_bitmap_from_file (f
, file
)
418 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
419 unsigned int width
, height
;
421 int xhot
, yhot
, result
, id
;
427 /* Look for an existing bitmap with the same name. */
428 for (id
= 0; id
< dpyinfo
->bitmaps_last
; ++id
)
430 if (dpyinfo
->bitmaps
[id
].refcount
431 && dpyinfo
->bitmaps
[id
].file
432 && !strcmp (dpyinfo
->bitmaps
[id
].file
, (char *) XSTRING (file
)->data
))
434 ++dpyinfo
->bitmaps
[id
].refcount
;
439 /* Search bitmap-file-path for the file, if appropriate. */
440 fd
= openp (Vx_bitmap_file_path
, file
, "", &found
, 0);
445 filename
= (char *) XSTRING (found
)->data
;
447 hinst
= LoadLibraryEx (filename
, NULL
, LOAD_LIBRARY_AS_DATAFILE
);
453 result
= XReadBitmapFile (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
454 filename
, &width
, &height
, &bitmap
, &xhot
, &yhot
);
455 if (result
!= BitmapSuccess
)
458 id
= x_allocate_bitmap_record (f
);
459 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
460 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
461 dpyinfo
->bitmaps
[id
- 1].file
= (char *) xmalloc (XSTRING (file
)->size
+ 1);
462 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
463 dpyinfo
->bitmaps
[id
- 1].height
= height
;
464 dpyinfo
->bitmaps
[id
- 1].width
= width
;
465 strcpy (dpyinfo
->bitmaps
[id
- 1].file
, XSTRING (file
)->data
);
471 /* Remove reference to bitmap with id number ID. */
474 x_destroy_bitmap (f
, id
)
478 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
482 --dpyinfo
->bitmaps
[id
- 1].refcount
;
483 if (dpyinfo
->bitmaps
[id
- 1].refcount
== 0)
486 DeleteObject (dpyinfo
->bitmaps
[id
- 1].pixmap
);
487 if (dpyinfo
->bitmaps
[id
- 1].file
)
489 free (dpyinfo
->bitmaps
[id
- 1].file
);
490 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
497 /* Free all the bitmaps for the display specified by DPYINFO. */
500 x_destroy_all_bitmaps (dpyinfo
)
501 struct w32_display_info
*dpyinfo
;
504 for (i
= 0; i
< dpyinfo
->bitmaps_last
; i
++)
505 if (dpyinfo
->bitmaps
[i
].refcount
> 0)
507 DeleteObject (dpyinfo
->bitmaps
[i
].pixmap
);
508 if (dpyinfo
->bitmaps
[i
].file
)
509 free (dpyinfo
->bitmaps
[i
].file
);
511 dpyinfo
->bitmaps_last
= 0;
514 /* Connect the frame-parameter names for W32 frames
515 to the ways of passing the parameter values to the window system.
517 The name of a parameter, as a Lisp symbol,
518 has an `x-frame-parameter' property which is an integer in Lisp
519 but can be interpreted as an `enum x_frame_parm' in C. */
523 X_PARM_FOREGROUND_COLOR
,
524 X_PARM_BACKGROUND_COLOR
,
531 X_PARM_INTERNAL_BORDER_WIDTH
,
535 X_PARM_VERT_SCROLL_BAR
,
537 X_PARM_MENU_BAR_LINES
541 struct x_frame_parm_table
544 void (*setter
)( /* struct frame *frame, Lisp_Object val, oldval */ );
547 void x_set_foreground_color ();
548 void x_set_background_color ();
549 void x_set_mouse_color ();
550 void x_set_cursor_color ();
551 void x_set_border_color ();
552 void x_set_cursor_type ();
553 void x_set_icon_type ();
554 void x_set_icon_name ();
556 void x_set_border_width ();
557 void x_set_internal_border_width ();
558 void x_explicitly_set_name ();
559 void x_set_autoraise ();
560 void x_set_autolower ();
561 void x_set_vertical_scroll_bars ();
562 void x_set_visibility ();
563 void x_set_menu_bar_lines ();
564 void x_set_scroll_bar_width ();
566 void x_set_unsplittable ();
568 static struct x_frame_parm_table x_frame_parms
[] =
570 "auto-raise", x_set_autoraise
,
571 "auto-lower", x_set_autolower
,
572 "background-color", x_set_background_color
,
573 "border-color", x_set_border_color
,
574 "border-width", x_set_border_width
,
575 "cursor-color", x_set_cursor_color
,
576 "cursor-type", x_set_cursor_type
,
578 "foreground-color", x_set_foreground_color
,
579 "icon-name", x_set_icon_name
,
580 "icon-type", x_set_icon_type
,
581 "internal-border-width", x_set_internal_border_width
,
582 "menu-bar-lines", x_set_menu_bar_lines
,
583 "mouse-color", x_set_mouse_color
,
584 "name", x_explicitly_set_name
,
585 "scroll-bar-width", x_set_scroll_bar_width
,
586 "title", x_set_title
,
587 "unsplittable", x_set_unsplittable
,
588 "vertical-scroll-bars", x_set_vertical_scroll_bars
,
589 "visibility", x_set_visibility
,
592 /* Attach the `x-frame-parameter' properties to
593 the Lisp symbol names of parameters relevant to W32. */
595 init_x_parm_symbols ()
599 for (i
= 0; i
< sizeof (x_frame_parms
) / sizeof (x_frame_parms
[0]); i
++)
600 Fput (intern (x_frame_parms
[i
].name
), Qx_frame_parameter
,
604 /* Change the parameters of FRAME as specified by ALIST.
605 If a parameter is not specially recognized, do nothing;
606 otherwise call the `x_set_...' function for that parameter. */
609 x_set_frame_parameters (f
, alist
)
615 /* If both of these parameters are present, it's more efficient to
616 set them both at once. So we wait until we've looked at the
617 entire list before we set them. */
621 Lisp_Object left
, top
;
623 /* Same with these. */
624 Lisp_Object icon_left
, icon_top
;
626 /* Record in these vectors all the parms specified. */
630 int left_no_change
= 0, top_no_change
= 0;
631 int icon_left_no_change
= 0, icon_top_no_change
= 0;
634 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
637 parms
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
638 values
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
640 /* Extract parm names and values into those vectors. */
643 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
645 Lisp_Object elt
, prop
, val
;
648 parms
[i
] = Fcar (elt
);
649 values
[i
] = Fcdr (elt
);
653 top
= left
= Qunbound
;
654 icon_left
= icon_top
= Qunbound
;
656 /* Provide default values for HEIGHT and WIDTH. */
657 width
= FRAME_WIDTH (f
);
658 height
= FRAME_HEIGHT (f
);
660 /* Now process them in reverse of specified order. */
661 for (i
--; i
>= 0; i
--)
663 Lisp_Object prop
, val
;
668 if (EQ (prop
, Qwidth
) && NUMBERP (val
))
669 width
= XFASTINT (val
);
670 else if (EQ (prop
, Qheight
) && NUMBERP (val
))
671 height
= XFASTINT (val
);
672 else if (EQ (prop
, Qtop
))
674 else if (EQ (prop
, Qleft
))
676 else if (EQ (prop
, Qicon_top
))
678 else if (EQ (prop
, Qicon_left
))
682 register Lisp_Object param_index
, old_value
;
684 param_index
= Fget (prop
, Qx_frame_parameter
);
685 old_value
= get_frame_param (f
, prop
);
686 store_frame_param (f
, prop
, val
);
687 if (NATNUMP (param_index
)
688 && (XFASTINT (param_index
)
689 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
690 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
694 /* Don't die if just one of these was set. */
695 if (EQ (left
, Qunbound
))
698 if (f
->output_data
.w32
->left_pos
< 0)
699 left
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.w32
->left_pos
), Qnil
));
701 XSETINT (left
, f
->output_data
.w32
->left_pos
);
703 if (EQ (top
, Qunbound
))
706 if (f
->output_data
.w32
->top_pos
< 0)
707 top
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.w32
->top_pos
), Qnil
));
709 XSETINT (top
, f
->output_data
.w32
->top_pos
);
712 /* If one of the icon positions was not set, preserve or default it. */
713 if (EQ (icon_left
, Qunbound
) || ! INTEGERP (icon_left
))
715 icon_left_no_change
= 1;
716 icon_left
= Fcdr (Fassq (Qicon_left
, f
->param_alist
));
717 if (NILP (icon_left
))
718 XSETINT (icon_left
, 0);
720 if (EQ (icon_top
, Qunbound
) || ! INTEGERP (icon_top
))
722 icon_top_no_change
= 1;
723 icon_top
= Fcdr (Fassq (Qicon_top
, f
->param_alist
));
725 XSETINT (icon_top
, 0);
728 /* Don't set these parameters unless they've been explicitly
729 specified. The window might be mapped or resized while we're in
730 this function, and we don't want to override that unless the lisp
731 code has asked for it.
733 Don't set these parameters unless they actually differ from the
734 window's current parameters; the window may not actually exist
739 check_frame_size (f
, &height
, &width
);
741 XSETFRAME (frame
, f
);
743 if (XINT (width
) != FRAME_WIDTH (f
)
744 || XINT (height
) != FRAME_HEIGHT (f
))
745 Fset_frame_size (frame
, make_number (width
), make_number (height
));
747 if ((!NILP (left
) || !NILP (top
))
748 && ! (left_no_change
&& top_no_change
)
749 && ! (NUMBERP (left
) && XINT (left
) == f
->output_data
.w32
->left_pos
750 && NUMBERP (top
) && XINT (top
) == f
->output_data
.w32
->top_pos
))
755 /* Record the signs. */
756 f
->output_data
.w32
->size_hint_flags
&= ~ (XNegative
| YNegative
);
757 if (EQ (left
, Qminus
))
758 f
->output_data
.w32
->size_hint_flags
|= XNegative
;
759 else if (INTEGERP (left
))
761 leftpos
= XINT (left
);
763 f
->output_data
.w32
->size_hint_flags
|= XNegative
;
765 else if (CONSP (left
) && EQ (XCONS (left
)->car
, Qminus
)
766 && CONSP (XCONS (left
)->cdr
)
767 && INTEGERP (XCONS (XCONS (left
)->cdr
)->car
))
769 leftpos
= - XINT (XCONS (XCONS (left
)->cdr
)->car
);
770 f
->output_data
.w32
->size_hint_flags
|= XNegative
;
772 else if (CONSP (left
) && EQ (XCONS (left
)->car
, Qplus
)
773 && CONSP (XCONS (left
)->cdr
)
774 && INTEGERP (XCONS (XCONS (left
)->cdr
)->car
))
776 leftpos
= XINT (XCONS (XCONS (left
)->cdr
)->car
);
779 if (EQ (top
, Qminus
))
780 f
->output_data
.w32
->size_hint_flags
|= YNegative
;
781 else if (INTEGERP (top
))
785 f
->output_data
.w32
->size_hint_flags
|= YNegative
;
787 else if (CONSP (top
) && EQ (XCONS (top
)->car
, Qminus
)
788 && CONSP (XCONS (top
)->cdr
)
789 && INTEGERP (XCONS (XCONS (top
)->cdr
)->car
))
791 toppos
= - XINT (XCONS (XCONS (top
)->cdr
)->car
);
792 f
->output_data
.w32
->size_hint_flags
|= YNegative
;
794 else if (CONSP (top
) && EQ (XCONS (top
)->car
, Qplus
)
795 && CONSP (XCONS (top
)->cdr
)
796 && INTEGERP (XCONS (XCONS (top
)->cdr
)->car
))
798 toppos
= XINT (XCONS (XCONS (top
)->cdr
)->car
);
802 /* Store the numeric value of the position. */
803 f
->output_data
.w32
->top_pos
= toppos
;
804 f
->output_data
.w32
->left_pos
= leftpos
;
806 f
->output_data
.w32
->win_gravity
= NorthWestGravity
;
808 /* Actually set that position, and convert to absolute. */
809 x_set_offset (f
, leftpos
, toppos
, -1);
812 if ((!NILP (icon_left
) || !NILP (icon_top
))
813 && ! (icon_left_no_change
&& icon_top_no_change
))
814 x_wm_set_icon_position (f
, XINT (icon_left
), XINT (icon_top
));
818 /* Store the screen positions of frame F into XPTR and YPTR.
819 These are the positions of the containing window manager window,
820 not Emacs's own window. */
823 x_real_positions (f
, xptr
, yptr
)
832 GetClientRect(FRAME_W32_WINDOW(f
), &rect
);
833 AdjustWindowRect(&rect
, f
->output_data
.w32
->dwStyle
, FRAME_EXTERNAL_MENU_BAR(f
));
839 ClientToScreen (FRAME_W32_WINDOW(f
), &pt
);
845 /* Insert a description of internally-recorded parameters of frame X
846 into the parameter alist *ALISTPTR that is to be given to the user.
847 Only parameters that are specific to W32
848 and whose values are not correctly recorded in the frame's
849 param_alist need to be considered here. */
851 x_report_frame_params (f
, alistptr
)
853 Lisp_Object
*alistptr
;
858 /* Represent negative positions (off the top or left screen edge)
859 in a way that Fmodify_frame_parameters will understand correctly. */
860 XSETINT (tem
, f
->output_data
.w32
->left_pos
);
861 if (f
->output_data
.w32
->left_pos
>= 0)
862 store_in_alist (alistptr
, Qleft
, tem
);
864 store_in_alist (alistptr
, Qleft
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
866 XSETINT (tem
, f
->output_data
.w32
->top_pos
);
867 if (f
->output_data
.w32
->top_pos
>= 0)
868 store_in_alist (alistptr
, Qtop
, tem
);
870 store_in_alist (alistptr
, Qtop
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
872 store_in_alist (alistptr
, Qborder_width
,
873 make_number (f
->output_data
.w32
->border_width
));
874 store_in_alist (alistptr
, Qinternal_border_width
,
875 make_number (f
->output_data
.w32
->internal_border_width
));
876 sprintf (buf
, "%ld", (long) FRAME_W32_WINDOW (f
));
877 store_in_alist (alistptr
, Qwindow_id
,
879 store_in_alist (alistptr
, Qicon_name
, f
->icon_name
);
880 FRAME_SAMPLE_VISIBILITY (f
);
881 store_in_alist (alistptr
, Qvisibility
,
882 (FRAME_VISIBLE_P (f
) ? Qt
883 : FRAME_ICONIFIED_P (f
) ? Qicon
: Qnil
));
884 store_in_alist (alistptr
, Qdisplay
,
885 XCONS (FRAME_W32_DISPLAY_INFO (f
)->name_list_element
)->car
);
889 DEFUN ("w32-define-rgb-color", Fw32_define_rgb_color
, Sw32_define_rgb_color
, 4, 4, 0,
890 "Convert RGB numbers to a windows color reference and associate with NAME (a string).\n\
891 This adds or updates a named color to w32-color-map, making it available for use.\n\
892 The original entry's RGB ref is returned, or nil if the entry is new.")
893 (red
, green
, blue
, name
)
894 Lisp_Object red
, green
, blue
, name
;
897 Lisp_Object oldrgb
= Qnil
;
900 CHECK_NUMBER (red
, 0);
901 CHECK_NUMBER (green
, 0);
902 CHECK_NUMBER (blue
, 0);
903 CHECK_STRING (name
, 0);
905 XSET (rgb
, Lisp_Int
, RGB(XUINT (red
), XUINT (green
), XUINT (blue
)));
909 /* replace existing entry in w32-color-map or add new entry. */
910 entry
= Fassoc (name
, Vw32_color_map
);
913 entry
= Fcons (name
, rgb
);
914 Vw32_color_map
= Fcons (entry
, Vw32_color_map
);
918 oldrgb
= Fcdr (entry
);
919 Fsetcdr (entry
, rgb
);
927 DEFUN ("w32-load-color-file", Fw32_load_color_file
, Sw32_load_color_file
, 1, 1, 0,
928 "Create an alist of color entries from an external file (ie. rgb.txt).\n\
929 Assign this value to w32-color-map to replace the existing color map.\n\
931 The file should define one named RGB color per line like so:\
933 where R,G,B are numbers between 0 and 255 and name is an arbitrary string.")
935 Lisp_Object filename
;
938 Lisp_Object cmap
= Qnil
;
941 CHECK_STRING (filename
, 0);
942 abspath
= Fexpand_file_name (filename
, Qnil
);
944 fp
= fopen (XSTRING (filename
)->data
, "rt");
948 int red
, green
, blue
;
953 while (fgets (buf
, sizeof (buf
), fp
) != NULL
) {
954 if (sscanf (buf
, "%u %u %u %n", &red
, &green
, &blue
, &num
) == 3)
956 char *name
= buf
+ num
;
957 num
= strlen (name
) - 1;
958 if (name
[num
] == '\n')
960 cmap
= Fcons (Fcons (build_string (name
),
961 make_number (RGB (red
, green
, blue
))),
973 /* The default colors for the w32 color map */
974 typedef struct colormap_t
980 colormap_t w32_color_map
[] =
982 {"snow" , PALETTERGB (255,250,250)},
983 {"ghost white" , PALETTERGB (248,248,255)},
984 {"GhostWhite" , PALETTERGB (248,248,255)},
985 {"white smoke" , PALETTERGB (245,245,245)},
986 {"WhiteSmoke" , PALETTERGB (245,245,245)},
987 {"gainsboro" , PALETTERGB (220,220,220)},
988 {"floral white" , PALETTERGB (255,250,240)},
989 {"FloralWhite" , PALETTERGB (255,250,240)},
990 {"old lace" , PALETTERGB (253,245,230)},
991 {"OldLace" , PALETTERGB (253,245,230)},
992 {"linen" , PALETTERGB (250,240,230)},
993 {"antique white" , PALETTERGB (250,235,215)},
994 {"AntiqueWhite" , PALETTERGB (250,235,215)},
995 {"papaya whip" , PALETTERGB (255,239,213)},
996 {"PapayaWhip" , PALETTERGB (255,239,213)},
997 {"blanched almond" , PALETTERGB (255,235,205)},
998 {"BlanchedAlmond" , PALETTERGB (255,235,205)},
999 {"bisque" , PALETTERGB (255,228,196)},
1000 {"peach puff" , PALETTERGB (255,218,185)},
1001 {"PeachPuff" , PALETTERGB (255,218,185)},
1002 {"navajo white" , PALETTERGB (255,222,173)},
1003 {"NavajoWhite" , PALETTERGB (255,222,173)},
1004 {"moccasin" , PALETTERGB (255,228,181)},
1005 {"cornsilk" , PALETTERGB (255,248,220)},
1006 {"ivory" , PALETTERGB (255,255,240)},
1007 {"lemon chiffon" , PALETTERGB (255,250,205)},
1008 {"LemonChiffon" , PALETTERGB (255,250,205)},
1009 {"seashell" , PALETTERGB (255,245,238)},
1010 {"honeydew" , PALETTERGB (240,255,240)},
1011 {"mint cream" , PALETTERGB (245,255,250)},
1012 {"MintCream" , PALETTERGB (245,255,250)},
1013 {"azure" , PALETTERGB (240,255,255)},
1014 {"alice blue" , PALETTERGB (240,248,255)},
1015 {"AliceBlue" , PALETTERGB (240,248,255)},
1016 {"lavender" , PALETTERGB (230,230,250)},
1017 {"lavender blush" , PALETTERGB (255,240,245)},
1018 {"LavenderBlush" , PALETTERGB (255,240,245)},
1019 {"misty rose" , PALETTERGB (255,228,225)},
1020 {"MistyRose" , PALETTERGB (255,228,225)},
1021 {"white" , PALETTERGB (255,255,255)},
1022 {"black" , PALETTERGB ( 0, 0, 0)},
1023 {"dark slate gray" , PALETTERGB ( 47, 79, 79)},
1024 {"DarkSlateGray" , PALETTERGB ( 47, 79, 79)},
1025 {"dark slate grey" , PALETTERGB ( 47, 79, 79)},
1026 {"DarkSlateGrey" , PALETTERGB ( 47, 79, 79)},
1027 {"dim gray" , PALETTERGB (105,105,105)},
1028 {"DimGray" , PALETTERGB (105,105,105)},
1029 {"dim grey" , PALETTERGB (105,105,105)},
1030 {"DimGrey" , PALETTERGB (105,105,105)},
1031 {"slate gray" , PALETTERGB (112,128,144)},
1032 {"SlateGray" , PALETTERGB (112,128,144)},
1033 {"slate grey" , PALETTERGB (112,128,144)},
1034 {"SlateGrey" , PALETTERGB (112,128,144)},
1035 {"light slate gray" , PALETTERGB (119,136,153)},
1036 {"LightSlateGray" , PALETTERGB (119,136,153)},
1037 {"light slate grey" , PALETTERGB (119,136,153)},
1038 {"LightSlateGrey" , PALETTERGB (119,136,153)},
1039 {"gray" , PALETTERGB (190,190,190)},
1040 {"grey" , PALETTERGB (190,190,190)},
1041 {"light grey" , PALETTERGB (211,211,211)},
1042 {"LightGrey" , PALETTERGB (211,211,211)},
1043 {"light gray" , PALETTERGB (211,211,211)},
1044 {"LightGray" , PALETTERGB (211,211,211)},
1045 {"midnight blue" , PALETTERGB ( 25, 25,112)},
1046 {"MidnightBlue" , PALETTERGB ( 25, 25,112)},
1047 {"navy" , PALETTERGB ( 0, 0,128)},
1048 {"navy blue" , PALETTERGB ( 0, 0,128)},
1049 {"NavyBlue" , PALETTERGB ( 0, 0,128)},
1050 {"cornflower blue" , PALETTERGB (100,149,237)},
1051 {"CornflowerBlue" , PALETTERGB (100,149,237)},
1052 {"dark slate blue" , PALETTERGB ( 72, 61,139)},
1053 {"DarkSlateBlue" , PALETTERGB ( 72, 61,139)},
1054 {"slate blue" , PALETTERGB (106, 90,205)},
1055 {"SlateBlue" , PALETTERGB (106, 90,205)},
1056 {"medium slate blue" , PALETTERGB (123,104,238)},
1057 {"MediumSlateBlue" , PALETTERGB (123,104,238)},
1058 {"light slate blue" , PALETTERGB (132,112,255)},
1059 {"LightSlateBlue" , PALETTERGB (132,112,255)},
1060 {"medium blue" , PALETTERGB ( 0, 0,205)},
1061 {"MediumBlue" , PALETTERGB ( 0, 0,205)},
1062 {"royal blue" , PALETTERGB ( 65,105,225)},
1063 {"RoyalBlue" , PALETTERGB ( 65,105,225)},
1064 {"blue" , PALETTERGB ( 0, 0,255)},
1065 {"dodger blue" , PALETTERGB ( 30,144,255)},
1066 {"DodgerBlue" , PALETTERGB ( 30,144,255)},
1067 {"deep sky blue" , PALETTERGB ( 0,191,255)},
1068 {"DeepSkyBlue" , PALETTERGB ( 0,191,255)},
1069 {"sky blue" , PALETTERGB (135,206,235)},
1070 {"SkyBlue" , PALETTERGB (135,206,235)},
1071 {"light sky blue" , PALETTERGB (135,206,250)},
1072 {"LightSkyBlue" , PALETTERGB (135,206,250)},
1073 {"steel blue" , PALETTERGB ( 70,130,180)},
1074 {"SteelBlue" , PALETTERGB ( 70,130,180)},
1075 {"light steel blue" , PALETTERGB (176,196,222)},
1076 {"LightSteelBlue" , PALETTERGB (176,196,222)},
1077 {"light blue" , PALETTERGB (173,216,230)},
1078 {"LightBlue" , PALETTERGB (173,216,230)},
1079 {"powder blue" , PALETTERGB (176,224,230)},
1080 {"PowderBlue" , PALETTERGB (176,224,230)},
1081 {"pale turquoise" , PALETTERGB (175,238,238)},
1082 {"PaleTurquoise" , PALETTERGB (175,238,238)},
1083 {"dark turquoise" , PALETTERGB ( 0,206,209)},
1084 {"DarkTurquoise" , PALETTERGB ( 0,206,209)},
1085 {"medium turquoise" , PALETTERGB ( 72,209,204)},
1086 {"MediumTurquoise" , PALETTERGB ( 72,209,204)},
1087 {"turquoise" , PALETTERGB ( 64,224,208)},
1088 {"cyan" , PALETTERGB ( 0,255,255)},
1089 {"light cyan" , PALETTERGB (224,255,255)},
1090 {"LightCyan" , PALETTERGB (224,255,255)},
1091 {"cadet blue" , PALETTERGB ( 95,158,160)},
1092 {"CadetBlue" , PALETTERGB ( 95,158,160)},
1093 {"medium aquamarine" , PALETTERGB (102,205,170)},
1094 {"MediumAquamarine" , PALETTERGB (102,205,170)},
1095 {"aquamarine" , PALETTERGB (127,255,212)},
1096 {"dark green" , PALETTERGB ( 0,100, 0)},
1097 {"DarkGreen" , PALETTERGB ( 0,100, 0)},
1098 {"dark olive green" , PALETTERGB ( 85,107, 47)},
1099 {"DarkOliveGreen" , PALETTERGB ( 85,107, 47)},
1100 {"dark sea green" , PALETTERGB (143,188,143)},
1101 {"DarkSeaGreen" , PALETTERGB (143,188,143)},
1102 {"sea green" , PALETTERGB ( 46,139, 87)},
1103 {"SeaGreen" , PALETTERGB ( 46,139, 87)},
1104 {"medium sea green" , PALETTERGB ( 60,179,113)},
1105 {"MediumSeaGreen" , PALETTERGB ( 60,179,113)},
1106 {"light sea green" , PALETTERGB ( 32,178,170)},
1107 {"LightSeaGreen" , PALETTERGB ( 32,178,170)},
1108 {"pale green" , PALETTERGB (152,251,152)},
1109 {"PaleGreen" , PALETTERGB (152,251,152)},
1110 {"spring green" , PALETTERGB ( 0,255,127)},
1111 {"SpringGreen" , PALETTERGB ( 0,255,127)},
1112 {"lawn green" , PALETTERGB (124,252, 0)},
1113 {"LawnGreen" , PALETTERGB (124,252, 0)},
1114 {"green" , PALETTERGB ( 0,255, 0)},
1115 {"chartreuse" , PALETTERGB (127,255, 0)},
1116 {"medium spring green" , PALETTERGB ( 0,250,154)},
1117 {"MediumSpringGreen" , PALETTERGB ( 0,250,154)},
1118 {"green yellow" , PALETTERGB (173,255, 47)},
1119 {"GreenYellow" , PALETTERGB (173,255, 47)},
1120 {"lime green" , PALETTERGB ( 50,205, 50)},
1121 {"LimeGreen" , PALETTERGB ( 50,205, 50)},
1122 {"yellow green" , PALETTERGB (154,205, 50)},
1123 {"YellowGreen" , PALETTERGB (154,205, 50)},
1124 {"forest green" , PALETTERGB ( 34,139, 34)},
1125 {"ForestGreen" , PALETTERGB ( 34,139, 34)},
1126 {"olive drab" , PALETTERGB (107,142, 35)},
1127 {"OliveDrab" , PALETTERGB (107,142, 35)},
1128 {"dark khaki" , PALETTERGB (189,183,107)},
1129 {"DarkKhaki" , PALETTERGB (189,183,107)},
1130 {"khaki" , PALETTERGB (240,230,140)},
1131 {"pale goldenrod" , PALETTERGB (238,232,170)},
1132 {"PaleGoldenrod" , PALETTERGB (238,232,170)},
1133 {"light goldenrod yellow" , PALETTERGB (250,250,210)},
1134 {"LightGoldenrodYellow" , PALETTERGB (250,250,210)},
1135 {"light yellow" , PALETTERGB (255,255,224)},
1136 {"LightYellow" , PALETTERGB (255,255,224)},
1137 {"yellow" , PALETTERGB (255,255, 0)},
1138 {"gold" , PALETTERGB (255,215, 0)},
1139 {"light goldenrod" , PALETTERGB (238,221,130)},
1140 {"LightGoldenrod" , PALETTERGB (238,221,130)},
1141 {"goldenrod" , PALETTERGB (218,165, 32)},
1142 {"dark goldenrod" , PALETTERGB (184,134, 11)},
1143 {"DarkGoldenrod" , PALETTERGB (184,134, 11)},
1144 {"rosy brown" , PALETTERGB (188,143,143)},
1145 {"RosyBrown" , PALETTERGB (188,143,143)},
1146 {"indian red" , PALETTERGB (205, 92, 92)},
1147 {"IndianRed" , PALETTERGB (205, 92, 92)},
1148 {"saddle brown" , PALETTERGB (139, 69, 19)},
1149 {"SaddleBrown" , PALETTERGB (139, 69, 19)},
1150 {"sienna" , PALETTERGB (160, 82, 45)},
1151 {"peru" , PALETTERGB (205,133, 63)},
1152 {"burlywood" , PALETTERGB (222,184,135)},
1153 {"beige" , PALETTERGB (245,245,220)},
1154 {"wheat" , PALETTERGB (245,222,179)},
1155 {"sandy brown" , PALETTERGB (244,164, 96)},
1156 {"SandyBrown" , PALETTERGB (244,164, 96)},
1157 {"tan" , PALETTERGB (210,180,140)},
1158 {"chocolate" , PALETTERGB (210,105, 30)},
1159 {"firebrick" , PALETTERGB (178,34, 34)},
1160 {"brown" , PALETTERGB (165,42, 42)},
1161 {"dark salmon" , PALETTERGB (233,150,122)},
1162 {"DarkSalmon" , PALETTERGB (233,150,122)},
1163 {"salmon" , PALETTERGB (250,128,114)},
1164 {"light salmon" , PALETTERGB (255,160,122)},
1165 {"LightSalmon" , PALETTERGB (255,160,122)},
1166 {"orange" , PALETTERGB (255,165, 0)},
1167 {"dark orange" , PALETTERGB (255,140, 0)},
1168 {"DarkOrange" , PALETTERGB (255,140, 0)},
1169 {"coral" , PALETTERGB (255,127, 80)},
1170 {"light coral" , PALETTERGB (240,128,128)},
1171 {"LightCoral" , PALETTERGB (240,128,128)},
1172 {"tomato" , PALETTERGB (255, 99, 71)},
1173 {"orange red" , PALETTERGB (255, 69, 0)},
1174 {"OrangeRed" , PALETTERGB (255, 69, 0)},
1175 {"red" , PALETTERGB (255, 0, 0)},
1176 {"hot pink" , PALETTERGB (255,105,180)},
1177 {"HotPink" , PALETTERGB (255,105,180)},
1178 {"deep pink" , PALETTERGB (255, 20,147)},
1179 {"DeepPink" , PALETTERGB (255, 20,147)},
1180 {"pink" , PALETTERGB (255,192,203)},
1181 {"light pink" , PALETTERGB (255,182,193)},
1182 {"LightPink" , PALETTERGB (255,182,193)},
1183 {"pale violet red" , PALETTERGB (219,112,147)},
1184 {"PaleVioletRed" , PALETTERGB (219,112,147)},
1185 {"maroon" , PALETTERGB (176, 48, 96)},
1186 {"medium violet red" , PALETTERGB (199, 21,133)},
1187 {"MediumVioletRed" , PALETTERGB (199, 21,133)},
1188 {"violet red" , PALETTERGB (208, 32,144)},
1189 {"VioletRed" , PALETTERGB (208, 32,144)},
1190 {"magenta" , PALETTERGB (255, 0,255)},
1191 {"violet" , PALETTERGB (238,130,238)},
1192 {"plum" , PALETTERGB (221,160,221)},
1193 {"orchid" , PALETTERGB (218,112,214)},
1194 {"medium orchid" , PALETTERGB (186, 85,211)},
1195 {"MediumOrchid" , PALETTERGB (186, 85,211)},
1196 {"dark orchid" , PALETTERGB (153, 50,204)},
1197 {"DarkOrchid" , PALETTERGB (153, 50,204)},
1198 {"dark violet" , PALETTERGB (148, 0,211)},
1199 {"DarkViolet" , PALETTERGB (148, 0,211)},
1200 {"blue violet" , PALETTERGB (138, 43,226)},
1201 {"BlueViolet" , PALETTERGB (138, 43,226)},
1202 {"purple" , PALETTERGB (160, 32,240)},
1203 {"medium purple" , PALETTERGB (147,112,219)},
1204 {"MediumPurple" , PALETTERGB (147,112,219)},
1205 {"thistle" , PALETTERGB (216,191,216)},
1206 {"gray0" , PALETTERGB ( 0, 0, 0)},
1207 {"grey0" , PALETTERGB ( 0, 0, 0)},
1208 {"dark grey" , PALETTERGB (169,169,169)},
1209 {"DarkGrey" , PALETTERGB (169,169,169)},
1210 {"dark gray" , PALETTERGB (169,169,169)},
1211 {"DarkGray" , PALETTERGB (169,169,169)},
1212 {"dark blue" , PALETTERGB ( 0, 0,139)},
1213 {"DarkBlue" , PALETTERGB ( 0, 0,139)},
1214 {"dark cyan" , PALETTERGB ( 0,139,139)},
1215 {"DarkCyan" , PALETTERGB ( 0,139,139)},
1216 {"dark magenta" , PALETTERGB (139, 0,139)},
1217 {"DarkMagenta" , PALETTERGB (139, 0,139)},
1218 {"dark red" , PALETTERGB (139, 0, 0)},
1219 {"DarkRed" , PALETTERGB (139, 0, 0)},
1220 {"light green" , PALETTERGB (144,238,144)},
1221 {"LightGreen" , PALETTERGB (144,238,144)},
1224 DEFUN ("w32-default-color-map", Fw32_default_color_map
, Sw32_default_color_map
,
1225 0, 0, 0, "Return the default color map.")
1229 colormap_t
*pc
= w32_color_map
;
1236 for (i
= 0; i
< sizeof (w32_color_map
) / sizeof (w32_color_map
[0]);
1238 cmap
= Fcons (Fcons (build_string (pc
->name
),
1239 make_number (pc
->colorref
)),
1248 w32_to_x_color (rgb
)
1253 CHECK_NUMBER (rgb
, 0);
1257 color
= Frassq (rgb
, Vw32_color_map
);
1262 return (Fcar (color
));
1268 x_to_w32_color (colorname
)
1271 register Lisp_Object tail
, ret
= Qnil
;
1275 if (colorname
[0] == '#')
1277 /* Could be an old-style RGB Device specification. */
1280 color
= colorname
+ 1;
1282 size
= strlen(color
);
1283 if (size
== 3 || size
== 6 || size
== 9 || size
== 12)
1291 for (i
= 0; i
< 3; i
++)
1295 unsigned long value
;
1297 /* The check for 'x' in the following conditional takes into
1298 account the fact that strtol allows a "0x" in front of
1299 our numbers, and we don't. */
1300 if (!isxdigit(color
[0]) || color
[1] == 'x')
1304 value
= strtoul(color
, &end
, 16);
1306 if (errno
== ERANGE
|| end
- color
!= size
)
1311 value
= value
* 0x10;
1322 colorval
|= (value
<< pos
);
1333 else if (strnicmp(colorname
, "rgb:", 4) == 0)
1341 color
= colorname
+ 4;
1342 for (i
= 0; i
< 3; i
++)
1345 unsigned long value
;
1347 /* The check for 'x' in the following conditional takes into
1348 account the fact that strtol allows a "0x" in front of
1349 our numbers, and we don't. */
1350 if (!isxdigit(color
[0]) || color
[1] == 'x')
1352 value
= strtoul(color
, &end
, 16);
1353 if (errno
== ERANGE
)
1355 switch (end
- color
)
1358 value
= value
* 0x10 + value
;
1371 if (value
== ULONG_MAX
)
1373 colorval
|= (value
<< pos
);
1387 else if (strnicmp(colorname
, "rgbi:", 5) == 0)
1389 /* This is an RGB Intensity specification. */
1396 color
= colorname
+ 5;
1397 for (i
= 0; i
< 3; i
++)
1403 value
= strtod(color
, &end
);
1404 if (errno
== ERANGE
)
1406 if (value
< 0.0 || value
> 1.0)
1408 val
= (UINT
)(0x100 * value
);
1409 /* We used 0x100 instead of 0xFF to give an continuous
1410 range between 0.0 and 1.0 inclusive. The next statement
1411 fixes the 1.0 case. */
1414 colorval
|= (val
<< pos
);
1428 /* I am not going to attempt to handle any of the CIE color schemes
1429 or TekHVC, since I don't know the algorithms for conversion to
1432 for (tail
= Vw32_color_map
; !NILP (tail
); tail
= Fcdr (tail
))
1434 register Lisp_Object elt
, tem
;
1437 if (!CONSP (elt
)) continue;
1441 if (lstrcmpi (XSTRING (tem
)->data
, colorname
) == 0)
1443 ret
= XUINT(Fcdr (elt
));
1457 w32_regenerate_palette (FRAME_PTR f
)
1459 struct w32_palette_entry
* list
;
1460 LOGPALETTE
* log_palette
;
1461 HPALETTE new_palette
;
1464 /* don't bother trying to create palette if not supported */
1465 if (! FRAME_W32_DISPLAY_INFO (f
)->has_palette
)
1468 log_palette
= (LOGPALETTE
*)
1469 alloca (sizeof (LOGPALETTE
) +
1470 FRAME_W32_DISPLAY_INFO (f
)->num_colors
* sizeof (PALETTEENTRY
));
1471 log_palette
->palVersion
= 0x300;
1472 log_palette
->palNumEntries
= FRAME_W32_DISPLAY_INFO (f
)->num_colors
;
1474 list
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1476 i
< FRAME_W32_DISPLAY_INFO (f
)->num_colors
;
1477 i
++, list
= list
->next
)
1478 log_palette
->palPalEntry
[i
] = list
->entry
;
1480 new_palette
= CreatePalette (log_palette
);
1484 if (FRAME_W32_DISPLAY_INFO (f
)->palette
)
1485 DeleteObject (FRAME_W32_DISPLAY_INFO (f
)->palette
);
1486 FRAME_W32_DISPLAY_INFO (f
)->palette
= new_palette
;
1488 /* Realize display palette and garbage all frames. */
1489 release_frame_dc (f
, get_frame_dc (f
));
1494 #define W32_COLOR(pe) RGB (pe.peRed, pe.peGreen, pe.peBlue)
1495 #define SET_W32_COLOR(pe, color) \
1498 pe.peRed = GetRValue (color); \
1499 pe.peGreen = GetGValue (color); \
1500 pe.peBlue = GetBValue (color); \
1505 /* Keep these around in case we ever want to track color usage. */
1507 w32_map_color (FRAME_PTR f
, COLORREF color
)
1509 struct w32_palette_entry
* list
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1511 if (NILP (Vw32_enable_palette
))
1514 /* check if color is already mapped */
1517 if (W32_COLOR (list
->entry
) == color
)
1525 /* not already mapped, so add to list and recreate Windows palette */
1526 list
= (struct w32_palette_entry
*)
1527 xmalloc (sizeof (struct w32_palette_entry
));
1528 SET_W32_COLOR (list
->entry
, color
);
1530 list
->next
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1531 FRAME_W32_DISPLAY_INFO (f
)->color_list
= list
;
1532 FRAME_W32_DISPLAY_INFO (f
)->num_colors
++;
1534 /* set flag that palette must be regenerated */
1535 FRAME_W32_DISPLAY_INFO (f
)->regen_palette
= TRUE
;
1539 w32_unmap_color (FRAME_PTR f
, COLORREF color
)
1541 struct w32_palette_entry
* list
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1542 struct w32_palette_entry
**prev
= &FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1544 if (NILP (Vw32_enable_palette
))
1547 /* check if color is already mapped */
1550 if (W32_COLOR (list
->entry
) == color
)
1552 if (--list
->refcount
== 0)
1556 FRAME_W32_DISPLAY_INFO (f
)->num_colors
--;
1566 /* set flag that palette must be regenerated */
1567 FRAME_W32_DISPLAY_INFO (f
)->regen_palette
= TRUE
;
1571 /* Decide if color named COLOR is valid for the display associated with
1572 the selected frame; if so, return the rgb values in COLOR_DEF.
1573 If ALLOC is nonzero, allocate a new colormap cell. */
1576 defined_color (f
, color
, color_def
, alloc
)
1579 COLORREF
*color_def
;
1582 register Lisp_Object tem
;
1584 tem
= x_to_w32_color (color
);
1588 if (!NILP (Vw32_enable_palette
))
1590 struct w32_palette_entry
* entry
=
1591 FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1592 struct w32_palette_entry
** prev
=
1593 &FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1595 /* check if color is already mapped */
1598 if (W32_COLOR (entry
->entry
) == XUINT (tem
))
1600 prev
= &entry
->next
;
1601 entry
= entry
->next
;
1604 if (entry
== NULL
&& alloc
)
1606 /* not already mapped, so add to list */
1607 entry
= (struct w32_palette_entry
*)
1608 xmalloc (sizeof (struct w32_palette_entry
));
1609 SET_W32_COLOR (entry
->entry
, XUINT (tem
));
1612 FRAME_W32_DISPLAY_INFO (f
)->num_colors
++;
1614 /* set flag that palette must be regenerated */
1615 FRAME_W32_DISPLAY_INFO (f
)->regen_palette
= TRUE
;
1618 /* Ensure COLORREF value is snapped to nearest color in (default)
1619 palette by simulating the PALETTERGB macro. This works whether
1620 or not the display device has a palette. */
1621 *color_def
= XUINT (tem
) | 0x2000000;
1630 /* Given a string ARG naming a color, compute a pixel value from it
1631 suitable for screen F.
1632 If F is not a color screen, return DEF (default) regardless of what
1636 x_decode_color (f
, arg
, def
)
1643 CHECK_STRING (arg
, 0);
1645 if (strcmp (XSTRING (arg
)->data
, "black") == 0)
1646 return BLACK_PIX_DEFAULT (f
);
1647 else if (strcmp (XSTRING (arg
)->data
, "white") == 0)
1648 return WHITE_PIX_DEFAULT (f
);
1650 if ((FRAME_W32_DISPLAY_INFO (f
)->n_planes
* FRAME_W32_DISPLAY_INFO (f
)->n_cbits
) == 1)
1653 /* defined_color is responsible for coping with failures
1654 by looking for a near-miss. */
1655 if (defined_color (f
, XSTRING (arg
)->data
, &cdef
, 1))
1658 /* defined_color failed; return an ultimate default. */
1662 /* Functions called only from `x_set_frame_param'
1663 to set individual parameters.
1665 If FRAME_W32_WINDOW (f) is 0,
1666 the frame is being created and its window does not exist yet.
1667 In that case, just record the parameter's new value
1668 in the standard place; do not attempt to change the window. */
1671 x_set_foreground_color (f
, arg
, oldval
)
1673 Lisp_Object arg
, oldval
;
1675 f
->output_data
.w32
->foreground_pixel
1676 = x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1678 if (FRAME_W32_WINDOW (f
) != 0)
1680 recompute_basic_faces (f
);
1681 if (FRAME_VISIBLE_P (f
))
1687 x_set_background_color (f
, arg
, oldval
)
1689 Lisp_Object arg
, oldval
;
1694 f
->output_data
.w32
->background_pixel
1695 = x_decode_color (f
, arg
, WHITE_PIX_DEFAULT (f
));
1697 if (FRAME_W32_WINDOW (f
) != 0)
1699 SetWindowLong (FRAME_W32_WINDOW (f
), WND_BACKGROUND_INDEX
, f
->output_data
.w32
->background_pixel
);
1701 recompute_basic_faces (f
);
1703 if (FRAME_VISIBLE_P (f
))
1709 x_set_mouse_color (f
, arg
, oldval
)
1711 Lisp_Object arg
, oldval
;
1714 Cursor cursor
, nontext_cursor
, mode_cursor
, cross_cursor
;
1719 if (!EQ (Qnil
, arg
))
1720 f
->output_data
.w32
->mouse_pixel
1721 = x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1722 mask_color
= f
->output_data
.w32
->background_pixel
;
1723 /* No invisible pointers. */
1724 if (mask_color
== f
->output_data
.w32
->mouse_pixel
1725 && mask_color
== f
->output_data
.w32
->background_pixel
)
1726 f
->output_data
.w32
->mouse_pixel
= f
->output_data
.w32
->foreground_pixel
;
1731 /* It's not okay to crash if the user selects a screwy cursor. */
1732 count
= x_catch_errors (FRAME_W32_DISPLAY (f
));
1734 if (!EQ (Qnil
, Vx_pointer_shape
))
1736 CHECK_NUMBER (Vx_pointer_shape
, 0);
1737 cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XINT (Vx_pointer_shape
));
1740 cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_xterm
);
1741 x_check_errors (FRAME_W32_DISPLAY (f
), "bad text pointer cursor: %s");
1743 if (!EQ (Qnil
, Vx_nontext_pointer_shape
))
1745 CHECK_NUMBER (Vx_nontext_pointer_shape
, 0);
1746 nontext_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
),
1747 XINT (Vx_nontext_pointer_shape
));
1750 nontext_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_left_ptr
);
1751 x_check_errors (FRAME_W32_DISPLAY (f
), "bad nontext pointer cursor: %s");
1753 if (!EQ (Qnil
, Vx_mode_pointer_shape
))
1755 CHECK_NUMBER (Vx_mode_pointer_shape
, 0);
1756 mode_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
),
1757 XINT (Vx_mode_pointer_shape
));
1760 mode_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_xterm
);
1761 x_check_errors (FRAME_W32_DISPLAY (f
), "bad modeline pointer cursor: %s");
1763 if (!EQ (Qnil
, Vx_sensitive_text_pointer_shape
))
1765 CHECK_NUMBER (Vx_sensitive_text_pointer_shape
, 0);
1767 = XCreateFontCursor (FRAME_W32_DISPLAY (f
),
1768 XINT (Vx_sensitive_text_pointer_shape
));
1771 cross_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_crosshair
);
1773 /* Check and report errors with the above calls. */
1774 x_check_errors (FRAME_W32_DISPLAY (f
), "can't set cursor shape: %s");
1775 x_uncatch_errors (FRAME_W32_DISPLAY (f
), count
);
1778 XColor fore_color
, back_color
;
1780 fore_color
.pixel
= f
->output_data
.w32
->mouse_pixel
;
1781 back_color
.pixel
= mask_color
;
1782 XQueryColor (FRAME_W32_DISPLAY (f
),
1783 DefaultColormap (FRAME_W32_DISPLAY (f
),
1784 DefaultScreen (FRAME_W32_DISPLAY (f
))),
1786 XQueryColor (FRAME_W32_DISPLAY (f
),
1787 DefaultColormap (FRAME_W32_DISPLAY (f
),
1788 DefaultScreen (FRAME_W32_DISPLAY (f
))),
1790 XRecolorCursor (FRAME_W32_DISPLAY (f
), cursor
,
1791 &fore_color
, &back_color
);
1792 XRecolorCursor (FRAME_W32_DISPLAY (f
), nontext_cursor
,
1793 &fore_color
, &back_color
);
1794 XRecolorCursor (FRAME_W32_DISPLAY (f
), mode_cursor
,
1795 &fore_color
, &back_color
);
1796 XRecolorCursor (FRAME_W32_DISPLAY (f
), cross_cursor
,
1797 &fore_color
, &back_color
);
1800 if (FRAME_W32_WINDOW (f
) != 0)
1802 XDefineCursor (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
), cursor
);
1805 if (cursor
!= f
->output_data
.w32
->text_cursor
&& f
->output_data
.w32
->text_cursor
!= 0)
1806 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->text_cursor
);
1807 f
->output_data
.w32
->text_cursor
= cursor
;
1809 if (nontext_cursor
!= f
->output_data
.w32
->nontext_cursor
1810 && f
->output_data
.w32
->nontext_cursor
!= 0)
1811 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->nontext_cursor
);
1812 f
->output_data
.w32
->nontext_cursor
= nontext_cursor
;
1814 if (mode_cursor
!= f
->output_data
.w32
->modeline_cursor
1815 && f
->output_data
.w32
->modeline_cursor
!= 0)
1816 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->modeline_cursor
);
1817 f
->output_data
.w32
->modeline_cursor
= mode_cursor
;
1818 if (cross_cursor
!= f
->output_data
.w32
->cross_cursor
1819 && f
->output_data
.w32
->cross_cursor
!= 0)
1820 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->cross_cursor
);
1821 f
->output_data
.w32
->cross_cursor
= cross_cursor
;
1823 XFlush (FRAME_W32_DISPLAY (f
));
1829 x_set_cursor_color (f
, arg
, oldval
)
1831 Lisp_Object arg
, oldval
;
1833 unsigned long fore_pixel
;
1835 if (!EQ (Vx_cursor_fore_pixel
, Qnil
))
1836 fore_pixel
= x_decode_color (f
, Vx_cursor_fore_pixel
,
1837 WHITE_PIX_DEFAULT (f
));
1839 fore_pixel
= f
->output_data
.w32
->background_pixel
;
1840 f
->output_data
.w32
->cursor_pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1842 /* Make sure that the cursor color differs from the background color. */
1843 if (f
->output_data
.w32
->cursor_pixel
== f
->output_data
.w32
->background_pixel
)
1845 f
->output_data
.w32
->cursor_pixel
= f
->output_data
.w32
->mouse_pixel
;
1846 if (f
->output_data
.w32
->cursor_pixel
== fore_pixel
)
1847 fore_pixel
= f
->output_data
.w32
->background_pixel
;
1849 f
->output_data
.w32
->cursor_foreground_pixel
= fore_pixel
;
1851 if (FRAME_W32_WINDOW (f
) != 0)
1853 if (FRAME_VISIBLE_P (f
))
1855 x_display_cursor (f
, 0);
1856 x_display_cursor (f
, 1);
1861 /* Set the border-color of frame F to value described by ARG.
1862 ARG can be a string naming a color.
1863 The border-color is used for the border that is drawn by the server.
1864 Note that this does not fully take effect if done before
1865 F has a window; it must be redone when the window is created. */
1868 x_set_border_color (f
, arg
, oldval
)
1870 Lisp_Object arg
, oldval
;
1875 CHECK_STRING (arg
, 0);
1876 str
= XSTRING (arg
)->data
;
1878 pix
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1880 x_set_border_pixel (f
, pix
);
1883 /* Set the border-color of frame F to pixel value PIX.
1884 Note that this does not fully take effect if done before
1887 x_set_border_pixel (f
, pix
)
1891 f
->output_data
.w32
->border_pixel
= pix
;
1893 if (FRAME_W32_WINDOW (f
) != 0 && f
->output_data
.w32
->border_width
> 0)
1895 if (FRAME_VISIBLE_P (f
))
1901 x_set_cursor_type (f
, arg
, oldval
)
1903 Lisp_Object arg
, oldval
;
1907 FRAME_DESIRED_CURSOR (f
) = bar_cursor
;
1908 f
->output_data
.w32
->cursor_width
= 2;
1910 else if (CONSP (arg
) && EQ (XCONS (arg
)->car
, Qbar
)
1911 && INTEGERP (XCONS (arg
)->cdr
))
1913 FRAME_DESIRED_CURSOR (f
) = bar_cursor
;
1914 f
->output_data
.w32
->cursor_width
= XINT (XCONS (arg
)->cdr
);
1917 /* Treat anything unknown as "box cursor".
1918 It was bad to signal an error; people have trouble fixing
1919 .Xdefaults with Emacs, when it has something bad in it. */
1920 FRAME_DESIRED_CURSOR (f
) = filled_box_cursor
;
1922 /* Make sure the cursor gets redrawn. This is overkill, but how
1923 often do people change cursor types? */
1924 update_mode_lines
++;
1928 x_set_icon_type (f
, arg
, oldval
)
1930 Lisp_Object arg
, oldval
;
1938 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1941 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1946 result
= x_text_icon (f
,
1947 (char *) XSTRING ((!NILP (f
->icon_name
)
1951 result
= x_bitmap_icon (f
, arg
);
1956 error ("No icon window available");
1959 /* If the window was unmapped (and its icon was mapped),
1960 the new icon is not mapped, so map the window in its stead. */
1961 if (FRAME_VISIBLE_P (f
))
1963 #ifdef USE_X_TOOLKIT
1964 XtPopup (f
->output_data
.w32
->widget
, XtGrabNone
);
1966 XMapWindow (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
));
1969 XFlush (FRAME_W32_DISPLAY (f
));
1974 /* Return non-nil if frame F wants a bitmap icon. */
1982 tem
= assq_no_quit (Qicon_type
, f
->param_alist
);
1984 return XCONS (tem
)->cdr
;
1990 x_set_icon_name (f
, arg
, oldval
)
1992 Lisp_Object arg
, oldval
;
1999 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
2002 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
2008 if (f
->output_data
.w32
->icon_bitmap
!= 0)
2013 result
= x_text_icon (f
,
2014 (char *) XSTRING ((!NILP (f
->icon_name
)
2023 error ("No icon window available");
2026 /* If the window was unmapped (and its icon was mapped),
2027 the new icon is not mapped, so map the window in its stead. */
2028 if (FRAME_VISIBLE_P (f
))
2030 #ifdef USE_X_TOOLKIT
2031 XtPopup (f
->output_data
.w32
->widget
, XtGrabNone
);
2033 XMapWindow (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
));
2036 XFlush (FRAME_W32_DISPLAY (f
));
2041 extern Lisp_Object
x_new_font ();
2044 x_set_font (f
, arg
, oldval
)
2046 Lisp_Object arg
, oldval
;
2050 CHECK_STRING (arg
, 1);
2053 result
= x_new_font (f
, XSTRING (arg
)->data
);
2056 if (EQ (result
, Qnil
))
2057 error ("Font \"%s\" is not defined", XSTRING (arg
)->data
);
2058 else if (EQ (result
, Qt
))
2059 error ("the characters of the given font have varying widths");
2060 else if (STRINGP (result
))
2062 recompute_basic_faces (f
);
2063 store_frame_param (f
, Qfont
, result
);
2070 x_set_border_width (f
, arg
, oldval
)
2072 Lisp_Object arg
, oldval
;
2074 CHECK_NUMBER (arg
, 0);
2076 if (XINT (arg
) == f
->output_data
.w32
->border_width
)
2079 if (FRAME_W32_WINDOW (f
) != 0)
2080 error ("Cannot change the border width of a window");
2082 f
->output_data
.w32
->border_width
= XINT (arg
);
2086 x_set_internal_border_width (f
, arg
, oldval
)
2088 Lisp_Object arg
, oldval
;
2091 int old
= f
->output_data
.w32
->internal_border_width
;
2093 CHECK_NUMBER (arg
, 0);
2094 f
->output_data
.w32
->internal_border_width
= XINT (arg
);
2095 if (f
->output_data
.w32
->internal_border_width
< 0)
2096 f
->output_data
.w32
->internal_border_width
= 0;
2098 if (f
->output_data
.w32
->internal_border_width
== old
)
2101 if (FRAME_W32_WINDOW (f
) != 0)
2104 x_set_window_size (f
, 0, f
->width
, f
->height
);
2106 SET_FRAME_GARBAGED (f
);
2111 x_set_visibility (f
, value
, oldval
)
2113 Lisp_Object value
, oldval
;
2116 XSETFRAME (frame
, f
);
2119 Fmake_frame_invisible (frame
, Qt
);
2120 else if (EQ (value
, Qicon
))
2121 Ficonify_frame (frame
);
2123 Fmake_frame_visible (frame
);
2127 x_set_menu_bar_lines (f
, value
, oldval
)
2129 Lisp_Object value
, oldval
;
2132 int olines
= FRAME_MENU_BAR_LINES (f
);
2134 /* Right now, menu bars don't work properly in minibuf-only frames;
2135 most of the commands try to apply themselves to the minibuffer
2136 frame itslef, and get an error because you can't switch buffers
2137 in or split the minibuffer window. */
2138 if (FRAME_MINIBUF_ONLY_P (f
))
2141 if (INTEGERP (value
))
2142 nlines
= XINT (value
);
2146 FRAME_MENU_BAR_LINES (f
) = 0;
2148 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
2151 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
2152 free_frame_menubar (f
);
2153 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
2155 /* Adjust the frame size so that the client (text) dimensions
2156 remain the same. This depends on FRAME_EXTERNAL_MENU_BAR being
2158 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2162 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
2165 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2166 name; if NAME is a string, set F's name to NAME and set
2167 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2169 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2170 suggesting a new name, which lisp code should override; if
2171 F->explicit_name is set, ignore the new name; otherwise, set it. */
2174 x_set_name (f
, name
, explicit)
2179 /* Make sure that requests from lisp code override requests from
2180 Emacs redisplay code. */
2183 /* If we're switching from explicit to implicit, we had better
2184 update the mode lines and thereby update the title. */
2185 if (f
->explicit_name
&& NILP (name
))
2186 update_mode_lines
= 1;
2188 f
->explicit_name
= ! NILP (name
);
2190 else if (f
->explicit_name
)
2193 /* If NAME is nil, set the name to the w32_id_name. */
2196 /* Check for no change needed in this very common case
2197 before we do any consing. */
2198 if (!strcmp (FRAME_W32_DISPLAY_INFO (f
)->w32_id_name
,
2199 XSTRING (f
->name
)->data
))
2201 name
= build_string (FRAME_W32_DISPLAY_INFO (f
)->w32_id_name
);
2204 CHECK_STRING (name
, 0);
2206 /* Don't change the name if it's already NAME. */
2207 if (! NILP (Fstring_equal (name
, f
->name
)))
2212 /* For setting the frame title, the title parameter should override
2213 the name parameter. */
2214 if (! NILP (f
->title
))
2217 if (FRAME_W32_WINDOW (f
))
2220 SetWindowText(FRAME_W32_WINDOW (f
), XSTRING (name
)->data
);
2225 /* This function should be called when the user's lisp code has
2226 specified a name for the frame; the name will override any set by the
2229 x_explicitly_set_name (f
, arg
, oldval
)
2231 Lisp_Object arg
, oldval
;
2233 x_set_name (f
, arg
, 1);
2236 /* This function should be called by Emacs redisplay code to set the
2237 name; names set this way will never override names set by the user's
2240 x_implicitly_set_name (f
, arg
, oldval
)
2242 Lisp_Object arg
, oldval
;
2244 x_set_name (f
, arg
, 0);
2247 /* Change the title of frame F to NAME.
2248 If NAME is nil, use the frame name as the title.
2250 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2251 name; if NAME is a string, set F's name to NAME and set
2252 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2254 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2255 suggesting a new name, which lisp code should override; if
2256 F->explicit_name is set, ignore the new name; otherwise, set it. */
2259 x_set_title (f
, name
)
2263 /* Don't change the title if it's already NAME. */
2264 if (EQ (name
, f
->title
))
2267 update_mode_lines
= 1;
2274 if (FRAME_W32_WINDOW (f
))
2277 SetWindowText(FRAME_W32_WINDOW (f
), XSTRING (name
)->data
);
2283 x_set_autoraise (f
, arg
, oldval
)
2285 Lisp_Object arg
, oldval
;
2287 f
->auto_raise
= !EQ (Qnil
, arg
);
2291 x_set_autolower (f
, arg
, oldval
)
2293 Lisp_Object arg
, oldval
;
2295 f
->auto_lower
= !EQ (Qnil
, arg
);
2299 x_set_unsplittable (f
, arg
, oldval
)
2301 Lisp_Object arg
, oldval
;
2303 f
->no_split
= !NILP (arg
);
2307 x_set_vertical_scroll_bars (f
, arg
, oldval
)
2309 Lisp_Object arg
, oldval
;
2311 if ((EQ (arg
, Qleft
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f
))
2312 || (EQ (arg
, Qright
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f
))
2313 || (NILP (arg
) && FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
2314 || (!NILP (arg
) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
)))
2316 FRAME_VERTICAL_SCROLL_BAR_TYPE (f
) = NILP (arg
) ?
2317 vertical_scroll_bar_none
:
2318 /* Put scroll bars on the right by default, as is conventional
2321 ? vertical_scroll_bar_left
2322 : vertical_scroll_bar_right
;
2324 /* We set this parameter before creating the window for the
2325 frame, so we can get the geometry right from the start.
2326 However, if the window hasn't been created yet, we shouldn't
2327 call x_set_window_size. */
2328 if (FRAME_W32_WINDOW (f
))
2329 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2334 x_set_scroll_bar_width (f
, arg
, oldval
)
2336 Lisp_Object arg
, oldval
;
2340 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = 0;
2341 FRAME_SCROLL_BAR_COLS (f
) = 2;
2343 else if (INTEGERP (arg
) && XINT (arg
) > 0
2344 && XFASTINT (arg
) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f
))
2346 int wid
= FONT_WIDTH (f
->output_data
.w32
->font
);
2347 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = XFASTINT (arg
);
2348 FRAME_SCROLL_BAR_COLS (f
) = (XFASTINT (arg
) + wid
-1) / wid
;
2349 if (FRAME_W32_WINDOW (f
))
2350 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2354 /* Subroutines of creating an frame. */
2356 /* Make sure that Vx_resource_name is set to a reasonable value.
2357 Fix it up, or set it to `emacs' if it is too hopeless. */
2360 validate_x_resource_name ()
2363 /* Number of valid characters in the resource name. */
2365 /* Number of invalid characters in the resource name. */
2370 if (STRINGP (Vx_resource_name
))
2372 unsigned char *p
= XSTRING (Vx_resource_name
)->data
;
2375 len
= XSTRING (Vx_resource_name
)->size
;
2377 /* Only letters, digits, - and _ are valid in resource names.
2378 Count the valid characters and count the invalid ones. */
2379 for (i
= 0; i
< len
; i
++)
2382 if (! ((c
>= 'a' && c
<= 'z')
2383 || (c
>= 'A' && c
<= 'Z')
2384 || (c
>= '0' && c
<= '9')
2385 || c
== '-' || c
== '_'))
2392 /* Not a string => completely invalid. */
2393 bad_count
= 5, good_count
= 0;
2395 /* If name is valid already, return. */
2399 /* If name is entirely invalid, or nearly so, use `emacs'. */
2401 || (good_count
== 1 && bad_count
> 0))
2403 Vx_resource_name
= build_string ("emacs");
2407 /* Name is partly valid. Copy it and replace the invalid characters
2408 with underscores. */
2410 Vx_resource_name
= new = Fcopy_sequence (Vx_resource_name
);
2412 for (i
= 0; i
< len
; i
++)
2414 int c
= XSTRING (new)->data
[i
];
2415 if (! ((c
>= 'a' && c
<= 'z')
2416 || (c
>= 'A' && c
<= 'Z')
2417 || (c
>= '0' && c
<= '9')
2418 || c
== '-' || c
== '_'))
2419 XSTRING (new)->data
[i
] = '_';
2424 extern char *x_get_string_resource ();
2426 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
2427 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
2428 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
2429 class, where INSTANCE is the name under which Emacs was invoked, or\n\
2430 the name specified by the `-name' or `-rn' command-line arguments.\n\
2432 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
2433 class, respectively. You must specify both of them or neither.\n\
2434 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
2435 and the class is `Emacs.CLASS.SUBCLASS'.")
2436 (attribute
, class, component
, subclass
)
2437 Lisp_Object attribute
, class, component
, subclass
;
2439 register char *value
;
2443 CHECK_STRING (attribute
, 0);
2444 CHECK_STRING (class, 0);
2446 if (!NILP (component
))
2447 CHECK_STRING (component
, 1);
2448 if (!NILP (subclass
))
2449 CHECK_STRING (subclass
, 2);
2450 if (NILP (component
) != NILP (subclass
))
2451 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2453 validate_x_resource_name ();
2455 /* Allocate space for the components, the dots which separate them,
2456 and the final '\0'. Make them big enough for the worst case. */
2457 name_key
= (char *) alloca (XSTRING (Vx_resource_name
)->size
2458 + (STRINGP (component
)
2459 ? XSTRING (component
)->size
: 0)
2460 + XSTRING (attribute
)->size
2463 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
2464 + XSTRING (class)->size
2465 + (STRINGP (subclass
)
2466 ? XSTRING (subclass
)->size
: 0)
2469 /* Start with emacs.FRAMENAME for the name (the specific one)
2470 and with `Emacs' for the class key (the general one). */
2471 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2472 strcpy (class_key
, EMACS_CLASS
);
2474 strcat (class_key
, ".");
2475 strcat (class_key
, XSTRING (class)->data
);
2477 if (!NILP (component
))
2479 strcat (class_key
, ".");
2480 strcat (class_key
, XSTRING (subclass
)->data
);
2482 strcat (name_key
, ".");
2483 strcat (name_key
, XSTRING (component
)->data
);
2486 strcat (name_key
, ".");
2487 strcat (name_key
, XSTRING (attribute
)->data
);
2489 value
= x_get_string_resource (Qnil
,
2490 name_key
, class_key
);
2492 if (value
!= (char *) 0)
2493 return build_string (value
);
2498 /* Used when C code wants a resource value. */
2501 x_get_resource_string (attribute
, class)
2502 char *attribute
, *class;
2504 register char *value
;
2508 /* Allocate space for the components, the dots which separate them,
2509 and the final '\0'. */
2510 name_key
= (char *) alloca (XSTRING (Vinvocation_name
)->size
2511 + strlen (attribute
) + 2);
2512 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
2513 + strlen (class) + 2);
2515 sprintf (name_key
, "%s.%s",
2516 XSTRING (Vinvocation_name
)->data
,
2518 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
2520 return x_get_string_resource (selected_frame
,
2521 name_key
, class_key
);
2524 /* Types we might convert a resource string into. */
2527 number
, boolean
, string
, symbol
2530 /* Return the value of parameter PARAM.
2532 First search ALIST, then Vdefault_frame_alist, then the X defaults
2533 database, using ATTRIBUTE as the attribute name and CLASS as its class.
2535 Convert the resource to the type specified by desired_type.
2537 If no default is specified, return Qunbound. If you call
2538 x_get_arg, make sure you deal with Qunbound in a reasonable way,
2539 and don't let it get stored in any Lisp-visible variables! */
2542 x_get_arg (alist
, param
, attribute
, class, type
)
2543 Lisp_Object alist
, param
;
2546 enum resource_types type
;
2548 register Lisp_Object tem
;
2550 tem
= Fassq (param
, alist
);
2552 tem
= Fassq (param
, Vdefault_frame_alist
);
2558 tem
= Fx_get_resource (build_string (attribute
),
2559 build_string (class),
2568 return make_number (atoi (XSTRING (tem
)->data
));
2571 tem
= Fdowncase (tem
);
2572 if (!strcmp (XSTRING (tem
)->data
, "on")
2573 || !strcmp (XSTRING (tem
)->data
, "true"))
2582 /* As a special case, we map the values `true' and `on'
2583 to Qt, and `false' and `off' to Qnil. */
2586 lower
= Fdowncase (tem
);
2587 if (!strcmp (XSTRING (lower
)->data
, "on")
2588 || !strcmp (XSTRING (lower
)->data
, "true"))
2590 else if (!strcmp (XSTRING (lower
)->data
, "off")
2591 || !strcmp (XSTRING (lower
)->data
, "false"))
2594 return Fintern (tem
, Qnil
);
2607 /* Record in frame F the specified or default value according to ALIST
2608 of the parameter named PARAM (a Lisp symbol).
2609 If no value is specified for PARAM, look for an X default for XPROP
2610 on the frame named NAME.
2611 If that is not found either, use the value DEFLT. */
2614 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
2621 enum resource_types type
;
2625 tem
= x_get_arg (alist
, prop
, xprop
, xclass
, type
);
2626 if (EQ (tem
, Qunbound
))
2628 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2632 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
2633 "Parse an X-style geometry string STRING.\n\
2634 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
2635 The properties returned may include `top', `left', `height', and `width'.\n\
2636 The value of `left' or `top' may be an integer,\n\
2637 or a list (+ N) meaning N pixels relative to top/left corner,\n\
2638 or a list (- N) meaning -N pixels relative to bottom/right corner.")
2643 unsigned int width
, height
;
2646 CHECK_STRING (string
, 0);
2648 geometry
= XParseGeometry ((char *) XSTRING (string
)->data
,
2649 &x
, &y
, &width
, &height
);
2652 if (geometry
& XValue
)
2654 Lisp_Object element
;
2656 if (x
>= 0 && (geometry
& XNegative
))
2657 element
= Fcons (Qleft
, Fcons (Qminus
, Fcons (make_number (-x
), Qnil
)));
2658 else if (x
< 0 && ! (geometry
& XNegative
))
2659 element
= Fcons (Qleft
, Fcons (Qplus
, Fcons (make_number (x
), Qnil
)));
2661 element
= Fcons (Qleft
, make_number (x
));
2662 result
= Fcons (element
, result
);
2665 if (geometry
& YValue
)
2667 Lisp_Object element
;
2669 if (y
>= 0 && (geometry
& YNegative
))
2670 element
= Fcons (Qtop
, Fcons (Qminus
, Fcons (make_number (-y
), Qnil
)));
2671 else if (y
< 0 && ! (geometry
& YNegative
))
2672 element
= Fcons (Qtop
, Fcons (Qplus
, Fcons (make_number (y
), Qnil
)));
2674 element
= Fcons (Qtop
, make_number (y
));
2675 result
= Fcons (element
, result
);
2678 if (geometry
& WidthValue
)
2679 result
= Fcons (Fcons (Qwidth
, make_number (width
)), result
);
2680 if (geometry
& HeightValue
)
2681 result
= Fcons (Fcons (Qheight
, make_number (height
)), result
);
2686 /* Calculate the desired size and position of this window,
2687 and return the flags saying which aspects were specified.
2689 This function does not make the coordinates positive. */
2691 #define DEFAULT_ROWS 40
2692 #define DEFAULT_COLS 80
2695 x_figure_window_size (f
, parms
)
2699 register Lisp_Object tem0
, tem1
, tem2
;
2700 int height
, width
, left
, top
;
2701 register int geometry
;
2702 long window_prompting
= 0;
2704 /* Default values if we fall through.
2705 Actually, if that happens we should get
2706 window manager prompting. */
2707 SET_FRAME_WIDTH (f
, DEFAULT_COLS
);
2708 f
->height
= DEFAULT_ROWS
;
2709 /* Window managers expect that if program-specified
2710 positions are not (0,0), they're intentional, not defaults. */
2711 f
->output_data
.w32
->top_pos
= 0;
2712 f
->output_data
.w32
->left_pos
= 0;
2714 tem0
= x_get_arg (parms
, Qheight
, 0, 0, number
);
2715 tem1
= x_get_arg (parms
, Qwidth
, 0, 0, number
);
2716 tem2
= x_get_arg (parms
, Quser_size
, 0, 0, number
);
2717 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
2719 if (!EQ (tem0
, Qunbound
))
2721 CHECK_NUMBER (tem0
, 0);
2722 f
->height
= XINT (tem0
);
2724 if (!EQ (tem1
, Qunbound
))
2726 CHECK_NUMBER (tem1
, 0);
2727 SET_FRAME_WIDTH (f
, XINT (tem1
));
2729 if (!NILP (tem2
) && !EQ (tem2
, Qunbound
))
2730 window_prompting
|= USSize
;
2732 window_prompting
|= PSize
;
2735 f
->output_data
.w32
->vertical_scroll_bar_extra
2736 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
2738 : FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) > 0
2739 ? FRAME_SCROLL_BAR_PIXEL_WIDTH (f
)
2740 : (FRAME_SCROLL_BAR_COLS (f
) * FONT_WIDTH (f
->output_data
.w32
->font
)));
2741 f
->output_data
.w32
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
2742 f
->output_data
.w32
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
2744 tem0
= x_get_arg (parms
, Qtop
, 0, 0, number
);
2745 tem1
= x_get_arg (parms
, Qleft
, 0, 0, number
);
2746 tem2
= x_get_arg (parms
, Quser_position
, 0, 0, number
);
2747 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
2749 if (EQ (tem0
, Qminus
))
2751 f
->output_data
.w32
->top_pos
= 0;
2752 window_prompting
|= YNegative
;
2754 else if (CONSP (tem0
) && EQ (XCONS (tem0
)->car
, Qminus
)
2755 && CONSP (XCONS (tem0
)->cdr
)
2756 && INTEGERP (XCONS (XCONS (tem0
)->cdr
)->car
))
2758 f
->output_data
.w32
->top_pos
= - XINT (XCONS (XCONS (tem0
)->cdr
)->car
);
2759 window_prompting
|= YNegative
;
2761 else if (CONSP (tem0
) && EQ (XCONS (tem0
)->car
, Qplus
)
2762 && CONSP (XCONS (tem0
)->cdr
)
2763 && INTEGERP (XCONS (XCONS (tem0
)->cdr
)->car
))
2765 f
->output_data
.w32
->top_pos
= XINT (XCONS (XCONS (tem0
)->cdr
)->car
);
2767 else if (EQ (tem0
, Qunbound
))
2768 f
->output_data
.w32
->top_pos
= 0;
2771 CHECK_NUMBER (tem0
, 0);
2772 f
->output_data
.w32
->top_pos
= XINT (tem0
);
2773 if (f
->output_data
.w32
->top_pos
< 0)
2774 window_prompting
|= YNegative
;
2777 if (EQ (tem1
, Qminus
))
2779 f
->output_data
.w32
->left_pos
= 0;
2780 window_prompting
|= XNegative
;
2782 else if (CONSP (tem1
) && EQ (XCONS (tem1
)->car
, Qminus
)
2783 && CONSP (XCONS (tem1
)->cdr
)
2784 && INTEGERP (XCONS (XCONS (tem1
)->cdr
)->car
))
2786 f
->output_data
.w32
->left_pos
= - XINT (XCONS (XCONS (tem1
)->cdr
)->car
);
2787 window_prompting
|= XNegative
;
2789 else if (CONSP (tem1
) && EQ (XCONS (tem1
)->car
, Qplus
)
2790 && CONSP (XCONS (tem1
)->cdr
)
2791 && INTEGERP (XCONS (XCONS (tem1
)->cdr
)->car
))
2793 f
->output_data
.w32
->left_pos
= XINT (XCONS (XCONS (tem1
)->cdr
)->car
);
2795 else if (EQ (tem1
, Qunbound
))
2796 f
->output_data
.w32
->left_pos
= 0;
2799 CHECK_NUMBER (tem1
, 0);
2800 f
->output_data
.w32
->left_pos
= XINT (tem1
);
2801 if (f
->output_data
.w32
->left_pos
< 0)
2802 window_prompting
|= XNegative
;
2805 if (!NILP (tem2
) && ! EQ (tem2
, Qunbound
))
2806 window_prompting
|= USPosition
;
2808 window_prompting
|= PPosition
;
2811 return window_prompting
;
2816 extern LRESULT CALLBACK
w32_wnd_proc ();
2819 w32_init_class (hinst
)
2824 wc
.style
= CS_HREDRAW
| CS_VREDRAW
;
2825 wc
.lpfnWndProc
= (WNDPROC
) w32_wnd_proc
;
2827 wc
.cbWndExtra
= WND_EXTRA_BYTES
;
2828 wc
.hInstance
= hinst
;
2829 wc
.hIcon
= LoadIcon (hinst
, EMACS_CLASS
);
2830 wc
.hCursor
= LoadCursor (NULL
, IDC_ARROW
);
2831 wc
.hbrBackground
= NULL
; // GetStockObject (WHITE_BRUSH);
2832 wc
.lpszMenuName
= NULL
;
2833 wc
.lpszClassName
= EMACS_CLASS
;
2835 return (RegisterClass (&wc
));
2839 w32_createscrollbar (f
, bar
)
2841 struct scroll_bar
* bar
;
2843 return (CreateWindow ("SCROLLBAR", "", SBS_VERT
| WS_CHILD
| WS_VISIBLE
,
2844 /* Position and size of scroll bar. */
2845 XINT(bar
->left
), XINT(bar
->top
),
2846 XINT(bar
->width
), XINT(bar
->height
),
2847 FRAME_W32_WINDOW (f
),
2854 w32_createwindow (f
)
2860 rect
.left
= rect
.top
= 0;
2861 rect
.right
= PIXEL_WIDTH (f
);
2862 rect
.bottom
= PIXEL_HEIGHT (f
);
2864 AdjustWindowRect (&rect
, f
->output_data
.w32
->dwStyle
,
2865 FRAME_EXTERNAL_MENU_BAR (f
));
2867 /* Do first time app init */
2871 w32_init_class (hinst
);
2874 FRAME_W32_WINDOW (f
) = hwnd
2875 = CreateWindow (EMACS_CLASS
,
2877 f
->output_data
.w32
->dwStyle
| WS_CLIPCHILDREN
,
2878 f
->output_data
.w32
->left_pos
,
2879 f
->output_data
.w32
->top_pos
,
2880 rect
.right
- rect
.left
,
2881 rect
.bottom
- rect
.top
,
2889 SetWindowLong (hwnd
, WND_FONTWIDTH_INDEX
, FONT_WIDTH (f
->output_data
.w32
->font
));
2890 SetWindowLong (hwnd
, WND_LINEHEIGHT_INDEX
, f
->output_data
.w32
->line_height
);
2891 SetWindowLong (hwnd
, WND_BORDER_INDEX
, f
->output_data
.w32
->internal_border_width
);
2892 SetWindowLong (hwnd
, WND_SCROLLBAR_INDEX
, f
->output_data
.w32
->vertical_scroll_bar_extra
);
2893 SetWindowLong (hwnd
, WND_BACKGROUND_INDEX
, f
->output_data
.w32
->background_pixel
);
2895 /* Enable drag-n-drop. */
2896 DragAcceptFiles (hwnd
, TRUE
);
2898 /* Do this to discard the default setting specified by our parent. */
2899 ShowWindow (hwnd
, SW_HIDE
);
2903 /* Convert between the modifier bits W32 uses and the modifier bits
2906 w32_get_modifiers ()
2908 return (((GetKeyState (VK_SHIFT
)&0x8000) ? shift_modifier
: 0) |
2909 ((GetKeyState (VK_CONTROL
)&0x8000) ? ctrl_modifier
: 0) |
2910 ((GetKeyState (VK_MENU
)&0x8000) ?
2911 ((NILP (Vw32_alt_is_meta
)) ? alt_modifier
: meta_modifier
) : 0));
2915 my_post_msg (wmsg
, hwnd
, msg
, wParam
, lParam
)
2922 wmsg
->msg
.hwnd
= hwnd
;
2923 wmsg
->msg
.message
= msg
;
2924 wmsg
->msg
.wParam
= wParam
;
2925 wmsg
->msg
.lParam
= lParam
;
2926 wmsg
->msg
.time
= GetMessageTime ();
2931 /* GetKeyState and MapVirtualKey on Windows 95 do not actually distinguish
2932 between left and right keys as advertised. We test for this
2933 support dynamically, and set a flag when the support is absent. If
2934 absent, we keep track of the left and right control and alt keys
2935 ourselves. This is particularly necessary on keyboards that rely
2936 upon the AltGr key, which is represented as having the left control
2937 and right alt keys pressed. For these keyboards, we need to know
2938 when the left alt key has been pressed in addition to the AltGr key
2939 so that we can properly support M-AltGr-key sequences (such as M-@
2940 on Swedish keyboards). */
2942 #define EMACS_LCONTROL 0
2943 #define EMACS_RCONTROL 1
2944 #define EMACS_LMENU 2
2945 #define EMACS_RMENU 3
2947 static int modifiers
[4];
2948 static int modifiers_recorded
;
2949 static int modifier_key_support_tested
;
2952 test_modifier_support (unsigned int wparam
)
2956 if (wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
)
2958 if (wparam
== VK_CONTROL
)
2968 if (!(GetKeyState (l
) & 0x8000) && !(GetKeyState (r
) & 0x8000))
2969 modifiers_recorded
= 1;
2971 modifiers_recorded
= 0;
2972 modifier_key_support_tested
= 1;
2976 record_keydown (unsigned int wparam
, unsigned int lparam
)
2980 if (!modifier_key_support_tested
)
2981 test_modifier_support (wparam
);
2983 if ((wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
) || !modifiers_recorded
)
2986 if (wparam
== VK_CONTROL
)
2987 i
= (lparam
& 0x1000000) ? EMACS_RCONTROL
: EMACS_LCONTROL
;
2989 i
= (lparam
& 0x1000000) ? EMACS_RMENU
: EMACS_LMENU
;
2995 record_keyup (unsigned int wparam
, unsigned int lparam
)
2999 if ((wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
) || !modifiers_recorded
)
3002 if (wparam
== VK_CONTROL
)
3003 i
= (lparam
& 0x1000000) ? EMACS_RCONTROL
: EMACS_LCONTROL
;
3005 i
= (lparam
& 0x1000000) ? EMACS_RMENU
: EMACS_LMENU
;
3010 /* Emacs can lose focus while a modifier key has been pressed. When
3011 it regains focus, be conservative and clear all modifiers since
3012 we cannot reconstruct the left and right modifier state. */
3018 if (!modifiers_recorded
)
3021 ctrl
= GetAsyncKeyState (VK_CONTROL
);
3022 alt
= GetAsyncKeyState (VK_MENU
);
3024 if (ctrl
== 0 || alt
== 0)
3025 /* Emacs doesn't have keyboard focus. Do nothing. */
3028 if (!(ctrl
& 0x08000))
3029 /* Clear any recorded control modifier state. */
3030 modifiers
[EMACS_RCONTROL
] = modifiers
[EMACS_LCONTROL
] = 0;
3032 if (!(alt
& 0x08000))
3033 /* Clear any recorded alt modifier state. */
3034 modifiers
[EMACS_RMENU
] = modifiers
[EMACS_LMENU
] = 0;
3036 /* Otherwise, leave the modifier state as it was when Emacs lost
3040 /* Synchronize modifier state with what is reported with the current
3041 keystroke. Even if we cannot distinguish between left and right
3042 modifier keys, we know that, if no modifiers are set, then neither
3043 the left or right modifier should be set. */
3047 if (!modifiers_recorded
)
3050 if (!(GetKeyState (VK_CONTROL
) & 0x8000))
3051 modifiers
[EMACS_RCONTROL
] = modifiers
[EMACS_LCONTROL
] = 0;
3053 if (!(GetKeyState (VK_MENU
) & 0x8000))
3054 modifiers
[EMACS_RMENU
] = modifiers
[EMACS_LMENU
] = 0;
3058 modifier_set (int vkey
)
3060 if (vkey
== VK_CAPITAL
)
3061 return (GetKeyState (vkey
) & 0x1);
3062 if (!modifiers_recorded
)
3063 return (GetKeyState (vkey
) & 0x8000);
3068 return modifiers
[EMACS_LCONTROL
];
3070 return modifiers
[EMACS_RCONTROL
];
3072 return modifiers
[EMACS_LMENU
];
3074 return modifiers
[EMACS_RMENU
];
3078 return (GetKeyState (vkey
) & 0x8000);
3081 /* We map the VK_* modifiers into console modifier constants
3082 so that we can use the same routines to handle both console
3083 and window input. */
3086 construct_modifiers (unsigned int wparam
, unsigned int lparam
)
3090 if (wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
)
3091 mods
= GetLastError ();
3094 mods
|= (modifier_set (VK_SHIFT
)) ? SHIFT_PRESSED
: 0;
3095 mods
|= (modifier_set (VK_CAPITAL
)) ? CAPSLOCK_ON
: 0;
3096 mods
|= (modifier_set (VK_LCONTROL
)) ? LEFT_CTRL_PRESSED
: 0;
3097 mods
|= (modifier_set (VK_RCONTROL
)) ? RIGHT_CTRL_PRESSED
: 0;
3098 mods
|= (modifier_set (VK_LMENU
)) ? LEFT_ALT_PRESSED
: 0;
3099 mods
|= (modifier_set (VK_RMENU
)) ? RIGHT_ALT_PRESSED
: 0;
3105 map_keypad_keys (unsigned int wparam
, unsigned int lparam
)
3107 unsigned int extended
= (lparam
& 0x1000000L
);
3109 if (wparam
< VK_CLEAR
|| wparam
> VK_DELETE
)
3112 if (wparam
== VK_RETURN
)
3113 return (extended
? VK_NUMPAD_ENTER
: VK_RETURN
);
3115 if (wparam
>= VK_PRIOR
&& wparam
<= VK_DOWN
)
3116 return (!extended
? (VK_NUMPAD_PRIOR
+ (wparam
- VK_PRIOR
)) : wparam
);
3118 if (wparam
== VK_INSERT
|| wparam
== VK_DELETE
)
3119 return (!extended
? (VK_NUMPAD_INSERT
+ (wparam
- VK_INSERT
)) : wparam
);
3121 if (wparam
== VK_CLEAR
)
3122 return (!extended
? VK_NUMPAD_CLEAR
: wparam
);
3127 /* Main message dispatch loop. */
3130 w32_msg_pump (deferred_msg
* msg_buf
)
3134 msh_mousewheel
= RegisterWindowMessage (MSH_MOUSEWHEEL
);
3136 while (GetMessage (&msg
, NULL
, 0, 0))
3138 if (msg
.hwnd
== NULL
)
3140 switch (msg
.message
)
3142 case WM_EMACS_CREATEWINDOW
:
3143 w32_createwindow ((struct frame
*) msg
.wParam
);
3144 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
, 0, 0))
3147 case WM_EMACS_SETLOCALE
:
3148 SetThreadLocale (msg
.wParam
);
3149 /* Reply is not expected. */
3152 /* No need to be so draconian! */
3154 DebPrint (("msg %x not expected by w32_msg_pump\n", msg
.message
));
3159 DispatchMessage (&msg
);
3162 /* Exit nested loop when our deferred message has completed. */
3163 if (msg_buf
->completed
)
3168 deferred_msg
* deferred_msg_head
;
3170 static deferred_msg
*
3171 find_deferred_msg (HWND hwnd
, UINT msg
)
3173 deferred_msg
* item
;
3175 /* Don't actually need synchronization for read access, since
3176 modification of single pointer is always atomic. */
3177 /* enter_crit (); */
3179 for (item
= deferred_msg_head
; item
!= NULL
; item
= item
->next
)
3180 if (item
->w32msg
.msg
.hwnd
== hwnd
3181 && item
->w32msg
.msg
.message
== msg
)
3184 /* leave_crit (); */
3190 send_deferred_msg (deferred_msg
* msg_buf
,
3196 /* Only input thread can send deferred messages. */
3197 if (GetCurrentThreadId () != dwWindowsThreadId
)
3200 /* It is an error to send a message that is already deferred. */
3201 if (find_deferred_msg (hwnd
, msg
) != NULL
)
3204 /* Enforced synchronization is not needed because this is the only
3205 function that alters deferred_msg_head, and the following critical
3206 section is guaranteed to only be serially reentered (since only the
3207 input thread can call us). */
3209 /* enter_crit (); */
3211 msg_buf
->completed
= 0;
3212 msg_buf
->next
= deferred_msg_head
;
3213 deferred_msg_head
= msg_buf
;
3214 my_post_msg (&msg_buf
->w32msg
, hwnd
, msg
, wParam
, lParam
);
3216 /* leave_crit (); */
3218 /* Start a new nested message loop to process other messages until
3219 this one is completed. */
3220 w32_msg_pump (msg_buf
);
3222 deferred_msg_head
= msg_buf
->next
;
3224 return msg_buf
->result
;
3228 complete_deferred_msg (HWND hwnd
, UINT msg
, LRESULT result
)
3230 deferred_msg
* msg_buf
= find_deferred_msg (hwnd
, msg
);
3232 if (msg_buf
== NULL
)
3235 msg_buf
->result
= result
;
3236 msg_buf
->completed
= 1;
3238 /* Ensure input thread is woken so it notices the completion. */
3239 PostThreadMessage (dwWindowsThreadId
, WM_NULL
, 0, 0);
3248 deferred_msg dummy_buf
;
3250 /* Ensure our message queue is created */
3252 PeekMessage (&msg
, NULL
, 0, 0, PM_NOREMOVE
);
3254 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
, 0, 0))
3257 memset (&dummy_buf
, 0, sizeof (dummy_buf
));
3258 dummy_buf
.w32msg
.msg
.hwnd
= NULL
;
3259 dummy_buf
.w32msg
.msg
.message
= WM_NULL
;
3261 /* This is the inital message loop which should only exit when the
3262 application quits. */
3263 w32_msg_pump (&dummy_buf
);
3268 /* Main window procedure */
3270 extern char *lispy_function_keys
[];
3273 w32_wnd_proc (hwnd
, msg
, wParam
, lParam
)
3280 struct w32_display_info
*dpyinfo
= &one_w32_display_info
;
3282 int windows_translate
;
3284 /* Note that it is okay to call x_window_to_frame, even though we are
3285 not running in the main lisp thread, because frame deletion
3286 requires the lisp thread to synchronize with this thread. Thus, if
3287 a frame struct is returned, it can be used without concern that the
3288 lisp thread might make it disappear while we are using it.
3290 NB. Walking the frame list in this thread is safe (as long as
3291 writes of Lisp_Object slots are atomic, which they are on Windows).
3292 Although delete-frame can destructively modify the frame list while
3293 we are walking it, a garbage collection cannot occur until after
3294 delete-frame has synchronized with this thread.
3296 It is also safe to use functions that make GDI calls, such as
3297 w32_clear_rect, because these functions must obtain a DC handle
3298 from the frame struct using get_frame_dc which is thread-aware. */
3303 f
= x_window_to_frame (dpyinfo
, hwnd
);
3306 GetUpdateRect (hwnd
, &wmsg
.rect
, FALSE
);
3307 w32_clear_rect (f
, NULL
, &wmsg
.rect
);
3310 case WM_PALETTECHANGED
:
3311 /* ignore our own changes */
3312 if ((HWND
)wParam
!= hwnd
)
3314 f
= x_window_to_frame (dpyinfo
, hwnd
);
3316 /* get_frame_dc will realize our palette and force all
3317 frames to be redrawn if needed. */
3318 release_frame_dc (f
, get_frame_dc (f
));
3323 PAINTSTRUCT paintStruct
;
3326 BeginPaint (hwnd
, &paintStruct
);
3327 wmsg
.rect
= paintStruct
.rcPaint
;
3328 EndPaint (hwnd
, &paintStruct
);
3331 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3338 record_keyup (wParam
, lParam
);
3343 /* Synchronize modifiers with current keystroke. */
3346 record_keydown (wParam
, lParam
);
3348 wParam
= map_keypad_keys (wParam
, lParam
);
3350 windows_translate
= 0;
3355 /* More support for these keys will likely be necessary. */
3356 if (!NILP (Vw32_pass_optional_keys_to_system
))
3357 windows_translate
= 1;
3360 if (NILP (Vw32_pass_alt_to_system
))
3362 windows_translate
= 1;
3369 windows_translate
= 1;
3372 /* If not defined as a function key, change it to a WM_CHAR message. */
3373 if (lispy_function_keys
[wParam
] == 0)
3378 if (windows_translate
)
3380 MSG windows_msg
= { hwnd
, msg
, wParam
, lParam
, 0, {0,0} };
3382 windows_msg
.time
= GetMessageTime ();
3383 TranslateMessage (&windows_msg
);
3391 wmsg
.dwModifiers
= construct_modifiers (wParam
, lParam
);
3394 /* Detect quit_char and set quit-flag directly. Note that we
3395 still need to post a message to ensure the main thread will be
3396 woken up if blocked in sys_select(), but we do NOT want to post
3397 the quit_char message itself (because it will usually be as if
3398 the user had typed quit_char twice). Instead, we post a dummy
3399 message that has no particular effect. */
3402 if (isalpha (c
) && (wmsg
.dwModifiers
== LEFT_CTRL_PRESSED
3403 || wmsg
.dwModifiers
== RIGHT_CTRL_PRESSED
))
3404 c
= make_ctrl_char (c
) & 0377;
3409 /* The choice of message is somewhat arbitrary, as long as
3410 the main thread handler just ignores it. */
3413 /* Interrupt any blocking system calls. */
3419 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3423 /* Simulate middle mouse button events when left and right buttons
3424 are used together, but only if user has two button mouse. */
3425 case WM_LBUTTONDOWN
:
3426 case WM_RBUTTONDOWN
:
3427 if (XINT (Vw32_num_mouse_buttons
) == 3)
3428 goto handle_plain_button
;
3431 int this = (msg
== WM_LBUTTONDOWN
) ? LMOUSE
: RMOUSE
;
3432 int other
= (msg
== WM_LBUTTONDOWN
) ? RMOUSE
: LMOUSE
;
3434 if (button_state
& this)
3437 if (button_state
== 0)
3440 button_state
|= this;
3442 if (button_state
& other
)
3444 if (mouse_button_timer
)
3446 KillTimer (hwnd
, mouse_button_timer
);
3447 mouse_button_timer
= 0;
3449 /* Generate middle mouse event instead. */
3450 msg
= WM_MBUTTONDOWN
;
3451 button_state
|= MMOUSE
;
3453 else if (button_state
& MMOUSE
)
3455 /* Ignore button event if we've already generated a
3456 middle mouse down event. This happens if the
3457 user releases and press one of the two buttons
3458 after we've faked a middle mouse event. */
3463 /* Flush out saved message. */
3464 post_msg (&saved_mouse_button_msg
);
3466 wmsg
.dwModifiers
= w32_get_modifiers ();
3467 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3469 /* Clear message buffer. */
3470 saved_mouse_button_msg
.msg
.hwnd
= 0;
3474 /* Hold onto message for now. */
3475 mouse_button_timer
=
3476 SetTimer (hwnd
, MOUSE_BUTTON_ID
, XINT (Vw32_mouse_button_tolerance
), NULL
);
3477 saved_mouse_button_msg
.msg
.hwnd
= hwnd
;
3478 saved_mouse_button_msg
.msg
.message
= msg
;
3479 saved_mouse_button_msg
.msg
.wParam
= wParam
;
3480 saved_mouse_button_msg
.msg
.lParam
= lParam
;
3481 saved_mouse_button_msg
.msg
.time
= GetMessageTime ();
3482 saved_mouse_button_msg
.dwModifiers
= w32_get_modifiers ();
3489 if (XINT (Vw32_num_mouse_buttons
) == 3)
3490 goto handle_plain_button
;
3493 int this = (msg
== WM_LBUTTONUP
) ? LMOUSE
: RMOUSE
;
3494 int other
= (msg
== WM_LBUTTONUP
) ? RMOUSE
: LMOUSE
;
3496 if ((button_state
& this) == 0)
3499 button_state
&= ~this;
3501 if (button_state
& MMOUSE
)
3503 /* Only generate event when second button is released. */
3504 if ((button_state
& other
) == 0)
3507 button_state
&= ~MMOUSE
;
3509 if (button_state
) abort ();
3516 /* Flush out saved message if necessary. */
3517 if (saved_mouse_button_msg
.msg
.hwnd
)
3519 post_msg (&saved_mouse_button_msg
);
3522 wmsg
.dwModifiers
= w32_get_modifiers ();
3523 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3525 /* Always clear message buffer and cancel timer. */
3526 saved_mouse_button_msg
.msg
.hwnd
= 0;
3527 KillTimer (hwnd
, mouse_button_timer
);
3528 mouse_button_timer
= 0;
3530 if (button_state
== 0)
3535 case WM_MBUTTONDOWN
:
3537 handle_plain_button
:
3542 if (parse_button (msg
, &button
, &up
))
3544 if (up
) ReleaseCapture ();
3545 else SetCapture (hwnd
);
3546 button
= (button
== 0) ? LMOUSE
:
3547 ((button
== 1) ? MMOUSE
: RMOUSE
);
3549 button_state
&= ~button
;
3551 button_state
|= button
;
3555 wmsg
.dwModifiers
= w32_get_modifiers ();
3556 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3561 if (XINT (Vw32_mouse_move_interval
) <= 0
3562 || (msg
== WM_MOUSEMOVE
&& button_state
== 0))
3564 wmsg
.dwModifiers
= w32_get_modifiers ();
3565 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3569 /* Hang onto mouse move and scroll messages for a bit, to avoid
3570 sending such events to Emacs faster than it can process them.
3571 If we get more events before the timer from the first message
3572 expires, we just replace the first message. */
3574 if (saved_mouse_move_msg
.msg
.hwnd
== 0)
3576 SetTimer (hwnd
, MOUSE_MOVE_ID
, XINT (Vw32_mouse_move_interval
), NULL
);
3578 /* Hold onto message for now. */
3579 saved_mouse_move_msg
.msg
.hwnd
= hwnd
;
3580 saved_mouse_move_msg
.msg
.message
= msg
;
3581 saved_mouse_move_msg
.msg
.wParam
= wParam
;
3582 saved_mouse_move_msg
.msg
.lParam
= lParam
;
3583 saved_mouse_move_msg
.msg
.time
= GetMessageTime ();
3584 saved_mouse_move_msg
.dwModifiers
= w32_get_modifiers ();
3589 wmsg
.dwModifiers
= w32_get_modifiers ();
3590 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3594 wmsg
.dwModifiers
= w32_get_modifiers ();
3595 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3599 /* Flush out saved messages if necessary. */
3600 if (wParam
== mouse_button_timer
)
3602 if (saved_mouse_button_msg
.msg
.hwnd
)
3604 post_msg (&saved_mouse_button_msg
);
3605 saved_mouse_button_msg
.msg
.hwnd
= 0;
3607 KillTimer (hwnd
, mouse_button_timer
);
3608 mouse_button_timer
= 0;
3610 else if (wParam
== mouse_move_timer
)
3612 if (saved_mouse_move_msg
.msg
.hwnd
)
3614 post_msg (&saved_mouse_move_msg
);
3615 saved_mouse_move_msg
.msg
.hwnd
= 0;
3617 KillTimer (hwnd
, mouse_move_timer
);
3618 mouse_move_timer
= 0;
3623 /* Windows doesn't send us focus messages when putting up and
3624 taking down a system popup dialog as for Ctrl-Alt-Del on Windows 95.
3625 The only indication we get that something happened is receiving
3626 this message afterwards. So this is a good time to reset our
3627 keyboard modifiers' state. */
3632 /* We must ensure menu bar is fully constructed and up to date
3633 before allowing user interaction with it. To achieve this
3634 we send this message to the lisp thread and wait for a
3635 reply (whose value is not actually needed) to indicate that
3636 the menu bar is now ready for use, so we can now return.
3638 To remain responsive in the meantime, we enter a nested message
3639 loop that can process all other messages.
3641 However, we skip all this if the message results from calling
3642 TrackPopupMenu - in fact, we must NOT attempt to send the lisp
3643 thread a message because it is blocked on us at this point. We
3644 set menubar_active before calling TrackPopupMenu to indicate
3645 this (there is no possibility of confusion with real menubar
3648 f
= x_window_to_frame (dpyinfo
, hwnd
);
3650 && (f
->output_data
.w32
->menubar_active
3651 /* We can receive this message even in the absence of a
3652 menubar (ie. when the system menu is activated) - in this
3653 case we do NOT want to forward the message, otherwise it
3654 will cause the menubar to suddenly appear when the user
3655 had requested it to be turned off! */
3656 || f
->output_data
.w32
->menubar_widget
== NULL
))
3660 deferred_msg msg_buf
;
3662 /* Detect if message has already been deferred; in this case
3663 we cannot return any sensible value to ignore this. */
3664 if (find_deferred_msg (hwnd
, msg
) != NULL
)
3667 return send_deferred_msg (&msg_buf
, hwnd
, msg
, wParam
, lParam
);
3670 case WM_EXITMENULOOP
:
3671 f
= x_window_to_frame (dpyinfo
, hwnd
);
3673 /* Indicate that menubar can be modified again. */
3675 f
->output_data
.w32
->menubar_active
= 0;
3678 case WM_MEASUREITEM
:
3679 f
= x_window_to_frame (dpyinfo
, hwnd
);
3682 MEASUREITEMSTRUCT
* pMis
= (MEASUREITEMSTRUCT
*) lParam
;
3684 if (pMis
->CtlType
== ODT_MENU
)
3686 /* Work out dimensions for popup menu titles. */
3687 char * title
= (char *) pMis
->itemData
;
3688 HDC hdc
= GetDC (hwnd
);
3689 HFONT menu_font
= GetCurrentObject (hdc
, OBJ_FONT
);
3690 LOGFONT menu_logfont
;
3694 GetObject (menu_font
, sizeof (menu_logfont
), &menu_logfont
);
3695 menu_logfont
.lfWeight
= FW_BOLD
;
3696 menu_font
= CreateFontIndirect (&menu_logfont
);
3697 old_font
= SelectObject (hdc
, menu_font
);
3699 GetTextExtentPoint32 (hdc
, title
, strlen (title
), &size
);
3700 pMis
->itemWidth
= size
.cx
;
3701 pMis
->itemHeight
= GetSystemMetrics (SM_CYMENUSIZE
);
3702 if (pMis
->itemHeight
< size
.cy
)
3703 pMis
->itemHeight
= size
.cy
;
3705 SelectObject (hdc
, old_font
);
3706 DeleteObject (menu_font
);
3707 ReleaseDC (hwnd
, hdc
);
3714 f
= x_window_to_frame (dpyinfo
, hwnd
);
3717 DRAWITEMSTRUCT
* pDis
= (DRAWITEMSTRUCT
*) lParam
;
3719 if (pDis
->CtlType
== ODT_MENU
)
3721 /* Draw popup menu title. */
3722 char * title
= (char *) pDis
->itemData
;
3723 HDC hdc
= pDis
->hDC
;
3724 HFONT menu_font
= GetCurrentObject (hdc
, OBJ_FONT
);
3725 LOGFONT menu_logfont
;
3728 GetObject (menu_font
, sizeof (menu_logfont
), &menu_logfont
);
3729 menu_logfont
.lfWeight
= FW_BOLD
;
3730 menu_font
= CreateFontIndirect (&menu_logfont
);
3731 old_font
= SelectObject (hdc
, menu_font
);
3733 /* Always draw title as if not selected. */
3735 pDis
->rcItem
.left
+ GetSystemMetrics (SM_CXMENUCHECK
),
3737 ETO_OPAQUE
, &pDis
->rcItem
,
3738 title
, strlen (title
), NULL
);
3740 SelectObject (hdc
, old_font
);
3741 DeleteObject (menu_font
);
3748 /* Still not right - can't distinguish between clicks in the
3749 client area of the frame from clicks forwarded from the scroll
3750 bars - may have to hook WM_NCHITTEST to remember the mouse
3751 position and then check if it is in the client area ourselves. */
3752 case WM_MOUSEACTIVATE
:
3753 /* Discard the mouse click that activates a frame, allowing the
3754 user to click anywhere without changing point (or worse!).
3755 Don't eat mouse clicks on scrollbars though!! */
3756 if (LOWORD (lParam
) == HTCLIENT
)
3757 return MA_ACTIVATEANDEAT
;
3762 case WM_ACTIVATEAPP
:
3763 case WM_WINDOWPOSCHANGED
:
3765 /* Inform lisp thread that a frame might have just been obscured
3766 or exposed, so should recheck visibility of all frames. */
3767 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3776 wmsg
.dwModifiers
= w32_get_modifiers ();
3777 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3781 wmsg
.dwModifiers
= w32_get_modifiers ();
3782 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3785 case WM_WINDOWPOSCHANGING
:
3788 LPWINDOWPOS lppos
= (WINDOWPOS
*) lParam
;
3790 wp
.length
= sizeof (WINDOWPLACEMENT
);
3791 GetWindowPlacement (hwnd
, &wp
);
3793 if (wp
.showCmd
!= SW_SHOWMINIMIZED
&& (lppos
->flags
& SWP_NOSIZE
) == 0)
3800 DWORD internal_border
;
3801 DWORD scrollbar_extra
;
3804 wp
.length
= sizeof(wp
);
3805 GetWindowRect (hwnd
, &wr
);
3809 font_width
= GetWindowLong (hwnd
, WND_FONTWIDTH_INDEX
);
3810 line_height
= GetWindowLong (hwnd
, WND_LINEHEIGHT_INDEX
);
3811 internal_border
= GetWindowLong (hwnd
, WND_BORDER_INDEX
);
3812 scrollbar_extra
= GetWindowLong (hwnd
, WND_SCROLLBAR_INDEX
);
3816 memset (&rect
, 0, sizeof (rect
));
3817 AdjustWindowRect (&rect
, GetWindowLong (hwnd
, GWL_STYLE
),
3818 GetMenu (hwnd
) != NULL
);
3820 /* Force width and height of client area to be exact
3821 multiples of the character cell dimensions. */
3822 wdiff
= (lppos
->cx
- (rect
.right
- rect
.left
)
3823 - 2 * internal_border
- scrollbar_extra
)
3825 hdiff
= (lppos
->cy
- (rect
.bottom
- rect
.top
)
3826 - 2 * internal_border
)
3831 /* For right/bottom sizing we can just fix the sizes.
3832 However for top/left sizing we will need to fix the X
3833 and Y positions as well. */
3838 if (wp
.showCmd
!= SW_SHOWMAXIMIZED
3839 && (lppos
->flags
& SWP_NOMOVE
) == 0)
3841 if (lppos
->x
!= wr
.left
|| lppos
->y
!= wr
.top
)
3848 lppos
->flags
|= SWP_NOMOVE
;
3859 case WM_EMACS_CREATESCROLLBAR
:
3860 return (LRESULT
) w32_createscrollbar ((struct frame
*) wParam
,
3861 (struct scroll_bar
*) lParam
);
3863 case WM_EMACS_SHOWWINDOW
:
3864 return ShowWindow ((HWND
) wParam
, (WPARAM
) lParam
);
3866 case WM_EMACS_SETFOREGROUND
:
3867 return SetForegroundWindow ((HWND
) wParam
);
3869 case WM_EMACS_SETWINDOWPOS
:
3871 WINDOWPOS
* pos
= (WINDOWPOS
*) wParam
;
3872 return SetWindowPos (hwnd
, pos
->hwndInsertAfter
,
3873 pos
->x
, pos
->y
, pos
->cx
, pos
->cy
, pos
->flags
);
3876 case WM_EMACS_DESTROYWINDOW
:
3877 DragAcceptFiles ((HWND
) wParam
, FALSE
);
3878 return DestroyWindow ((HWND
) wParam
);
3880 case WM_EMACS_TRACKPOPUPMENU
:
3885 pos
= (POINT
*)lParam
;
3886 flags
= TPM_CENTERALIGN
;
3887 if (button_state
& LMOUSE
)
3888 flags
|= TPM_LEFTBUTTON
;
3889 else if (button_state
& RMOUSE
)
3890 flags
|= TPM_RIGHTBUTTON
;
3892 /* Remember we did a SetCapture on the initial mouse down event,
3893 so for safety, we make sure the capture is cancelled now. */
3896 /* Use menubar_active to indicate that WM_INITMENU is from
3897 TrackPopupMenu below, and should be ignored. */
3898 f
= x_window_to_frame (dpyinfo
, hwnd
);
3900 f
->output_data
.w32
->menubar_active
= 1;
3902 if (TrackPopupMenu ((HMENU
)wParam
, flags
, pos
->x
, pos
->y
,
3906 /* Eat any mouse messages during popupmenu */
3907 while (PeekMessage (&amsg
, hwnd
, WM_MOUSEFIRST
, WM_MOUSELAST
,
3909 /* Get the menu selection, if any */
3910 if (PeekMessage (&amsg
, hwnd
, WM_COMMAND
, WM_COMMAND
, PM_REMOVE
))
3912 retval
= LOWORD (amsg
.wParam
);
3929 /* Check for messages registered at runtime. */
3930 if (msg
== msh_mousewheel
)
3932 wmsg
.dwModifiers
= w32_get_modifiers ();
3933 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3938 return DefWindowProc (hwnd
, msg
, wParam
, lParam
);
3942 /* The most common default return code for handled messages is 0. */
3947 my_create_window (f
)
3952 if (!PostThreadMessage (dwWindowsThreadId
, WM_EMACS_CREATEWINDOW
, (WPARAM
)f
, 0))
3954 GetMessage (&msg
, NULL
, WM_EMACS_DONE
, WM_EMACS_DONE
);
3957 /* Create and set up the w32 window for frame F. */
3960 w32_window (f
, window_prompting
, minibuffer_only
)
3962 long window_prompting
;
3963 int minibuffer_only
;
3967 /* Use the resource name as the top-level window name
3968 for looking up resources. Make a non-Lisp copy
3969 for the window manager, so GC relocation won't bother it.
3971 Elsewhere we specify the window name for the window manager. */
3974 char *str
= (char *) XSTRING (Vx_resource_name
)->data
;
3975 f
->namebuf
= (char *) xmalloc (strlen (str
) + 1);
3976 strcpy (f
->namebuf
, str
);
3979 my_create_window (f
);
3981 validate_x_resource_name ();
3983 /* x_set_name normally ignores requests to set the name if the
3984 requested name is the same as the current name. This is the one
3985 place where that assumption isn't correct; f->name is set, but
3986 the server hasn't been told. */
3989 int explicit = f
->explicit_name
;
3991 f
->explicit_name
= 0;
3994 x_set_name (f
, name
, explicit);
3999 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
4000 initialize_frame_menubar (f
);
4002 if (FRAME_W32_WINDOW (f
) == 0)
4003 error ("Unable to create window");
4006 /* Handle the icon stuff for this window. Perhaps later we might
4007 want an x_set_icon_position which can be called interactively as
4015 Lisp_Object icon_x
, icon_y
;
4017 /* Set the position of the icon. Note that Windows 95 groups all
4018 icons in the tray. */
4019 icon_x
= x_get_arg (parms
, Qicon_left
, 0, 0, number
);
4020 icon_y
= x_get_arg (parms
, Qicon_top
, 0, 0, number
);
4021 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
4023 CHECK_NUMBER (icon_x
, 0);
4024 CHECK_NUMBER (icon_y
, 0);
4026 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
4027 error ("Both left and top icon corners of icon must be specified");
4031 if (! EQ (icon_x
, Qunbound
))
4032 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
4035 /* Start up iconic or window? */
4036 x_wm_set_window_state
4037 (f
, (EQ (x_get_arg (parms
, Qvisibility
, 0, 0, symbol
), Qicon
)
4041 x_text_icon (f
, (char *) XSTRING ((!NILP (f
->icon_name
)
4049 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
4051 "Make a new window, which is called a \"frame\" in Emacs terms.\n\
4052 Returns an Emacs frame object.\n\
4053 ALIST is an alist of frame parameters.\n\
4054 If the parameters specify that the frame should not have a minibuffer,\n\
4055 and do not specify a specific minibuffer window to use,\n\
4056 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
4057 be shared by the new frame.\n\
4059 This function is an internal primitive--use `make-frame' instead.")
4064 Lisp_Object frame
, tem
;
4066 int minibuffer_only
= 0;
4067 long window_prompting
= 0;
4069 int count
= specpdl_ptr
- specpdl
;
4070 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
4071 Lisp_Object display
;
4072 struct w32_display_info
*dpyinfo
;
4076 /* Use this general default value to start with
4077 until we know if this frame has a specified name. */
4078 Vx_resource_name
= Vinvocation_name
;
4080 display
= x_get_arg (parms
, Qdisplay
, 0, 0, string
);
4081 if (EQ (display
, Qunbound
))
4083 dpyinfo
= check_x_display_info (display
);
4085 kb
= dpyinfo
->kboard
;
4087 kb
= &the_only_kboard
;
4090 name
= x_get_arg (parms
, Qname
, "name", "Name", string
);
4092 && ! EQ (name
, Qunbound
)
4094 error ("Invalid frame name--not a string or nil");
4097 Vx_resource_name
= name
;
4099 /* See if parent window is specified. */
4100 parent
= x_get_arg (parms
, Qparent_id
, NULL
, NULL
, number
);
4101 if (EQ (parent
, Qunbound
))
4103 if (! NILP (parent
))
4104 CHECK_NUMBER (parent
, 0);
4106 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
4107 /* No need to protect DISPLAY because that's not used after passing
4108 it to make_frame_without_minibuffer. */
4110 GCPRO4 (parms
, parent
, name
, frame
);
4111 tem
= x_get_arg (parms
, Qminibuffer
, 0, 0, symbol
);
4112 if (EQ (tem
, Qnone
) || NILP (tem
))
4113 f
= make_frame_without_minibuffer (Qnil
, kb
, display
);
4114 else if (EQ (tem
, Qonly
))
4116 f
= make_minibuffer_frame ();
4117 minibuffer_only
= 1;
4119 else if (WINDOWP (tem
))
4120 f
= make_frame_without_minibuffer (tem
, kb
, display
);
4124 XSETFRAME (frame
, f
);
4126 /* Note that Windows does support scroll bars. */
4127 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
4128 /* By default, make scrollbars the system standard width. */
4129 f
->scroll_bar_pixel_width
= GetSystemMetrics (SM_CXVSCROLL
);
4131 f
->output_method
= output_w32
;
4132 f
->output_data
.w32
= (struct w32_output
*) xmalloc (sizeof (struct w32_output
));
4133 bzero (f
->output_data
.w32
, sizeof (struct w32_output
));
4136 = x_get_arg (parms
, Qicon_name
, "iconName", "Title", string
);
4137 if (! STRINGP (f
->icon_name
))
4138 f
->icon_name
= Qnil
;
4140 /* FRAME_W32_DISPLAY_INFO (f) = dpyinfo; */
4142 FRAME_KBOARD (f
) = kb
;
4145 /* Specify the parent under which to make this window. */
4149 f
->output_data
.w32
->parent_desc
= (Window
) parent
;
4150 f
->output_data
.w32
->explicit_parent
= 1;
4154 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
4155 f
->output_data
.w32
->explicit_parent
= 0;
4158 /* Note that the frame has no physical cursor right now. */
4159 f
->phys_cursor_x
= -1;
4161 /* Set the name; the functions to which we pass f expect the name to
4163 if (EQ (name
, Qunbound
) || NILP (name
))
4165 f
->name
= build_string (dpyinfo
->w32_id_name
);
4166 f
->explicit_name
= 0;
4171 f
->explicit_name
= 1;
4172 /* use the frame's title when getting resources for this frame. */
4173 specbind (Qx_resource_name
, name
);
4176 /* Extract the window parameters from the supplied values
4177 that are needed to determine window geometry. */
4181 font
= x_get_arg (parms
, Qfont
, "font", "Font", string
);
4183 /* First, try whatever font the caller has specified. */
4185 font
= x_new_font (f
, XSTRING (font
)->data
);
4186 /* Try out a font which we hope has bold and italic variations. */
4187 if (!STRINGP (font
))
4188 font
= x_new_font (f
, "-*-Courier New-normal-r-*-*-13-97-*-*-c-*-*-ansi-");
4189 if (! STRINGP (font
))
4190 font
= x_new_font (f
, "-*-Courier-normal-r-*-*-13-97-*-*-c-*-*-ansi-");
4191 /* If those didn't work, look for something which will at least work. */
4192 if (! STRINGP (font
))
4193 font
= x_new_font (f
, "-*-Fixedsys-normal-r-*-*-13-97-*-*-c-*-*-ansi-");
4195 if (! STRINGP (font
))
4196 font
= build_string ("Fixedsys");
4198 x_default_parameter (f
, parms
, Qfont
, font
,
4199 "font", "Font", string
);
4202 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
4203 "borderwidth", "BorderWidth", number
);
4204 /* This defaults to 2 in order to match xterm. We recognize either
4205 internalBorderWidth or internalBorder (which is what xterm calls
4207 if (NILP (Fassq (Qinternal_border_width
, parms
)))
4211 value
= x_get_arg (parms
, Qinternal_border_width
,
4212 "internalBorder", "BorderWidth", number
);
4213 if (! EQ (value
, Qunbound
))
4214 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
4217 /* Default internalBorderWidth to 0 on Windows to match other programs. */
4218 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (0),
4219 "internalBorderWidth", "BorderWidth", number
);
4220 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qt
,
4221 "verticalScrollBars", "ScrollBars", boolean
);
4223 /* Also do the stuff which must be set before the window exists. */
4224 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
4225 "foreground", "Foreground", string
);
4226 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
4227 "background", "Background", string
);
4228 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
4229 "pointerColor", "Foreground", string
);
4230 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
4231 "cursorColor", "Foreground", string
);
4232 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
4233 "borderColor", "BorderColor", string
);
4235 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (1),
4236 "menuBar", "MenuBar", number
);
4237 x_default_parameter (f
, parms
, Qscroll_bar_width
, Qnil
,
4238 "scrollBarWidth", "ScrollBarWidth", number
);
4239 x_default_parameter (f
, parms
, Qbuffer_predicate
, Qnil
,
4240 "bufferPredicate", "BufferPredicate", symbol
);
4241 x_default_parameter (f
, parms
, Qtitle
, Qnil
,
4242 "title", "Title", string
);
4244 f
->output_data
.w32
->dwStyle
= WS_OVERLAPPEDWINDOW
;
4245 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
4246 window_prompting
= x_figure_window_size (f
, parms
);
4248 if (window_prompting
& XNegative
)
4250 if (window_prompting
& YNegative
)
4251 f
->output_data
.w32
->win_gravity
= SouthEastGravity
;
4253 f
->output_data
.w32
->win_gravity
= NorthEastGravity
;
4257 if (window_prompting
& YNegative
)
4258 f
->output_data
.w32
->win_gravity
= SouthWestGravity
;
4260 f
->output_data
.w32
->win_gravity
= NorthWestGravity
;
4263 f
->output_data
.w32
->size_hint_flags
= window_prompting
;
4265 w32_window (f
, window_prompting
, minibuffer_only
);
4267 init_frame_faces (f
);
4269 /* We need to do this after creating the window, so that the
4270 icon-creation functions can say whose icon they're describing. */
4271 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
4272 "bitmapIcon", "BitmapIcon", symbol
);
4274 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
4275 "autoRaise", "AutoRaiseLower", boolean
);
4276 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
4277 "autoLower", "AutoRaiseLower", boolean
);
4278 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
4279 "cursorType", "CursorType", symbol
);
4281 /* Dimensions, especially f->height, must be done via change_frame_size.
4282 Change will not be effected unless different from the current
4287 SET_FRAME_WIDTH (f
, 0);
4288 change_frame_size (f
, height
, width
, 1, 0);
4290 /* Tell the server what size and position, etc, we want,
4291 and how badly we want them. */
4293 x_wm_set_size_hint (f
, window_prompting
, 0);
4296 tem
= x_get_arg (parms
, Qunsplittable
, 0, 0, boolean
);
4297 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
4301 /* It is now ok to make the frame official
4302 even if we get an error below.
4303 And the frame needs to be on Vframe_list
4304 or making it visible won't work. */
4305 Vframe_list
= Fcons (frame
, Vframe_list
);
4307 /* Now that the frame is official, it counts as a reference to
4309 FRAME_W32_DISPLAY_INFO (f
)->reference_count
++;
4311 /* Make the window appear on the frame and enable display,
4312 unless the caller says not to. However, with explicit parent,
4313 Emacs cannot control visibility, so don't try. */
4314 if (! f
->output_data
.w32
->explicit_parent
)
4316 Lisp_Object visibility
;
4318 visibility
= x_get_arg (parms
, Qvisibility
, 0, 0, symbol
);
4319 if (EQ (visibility
, Qunbound
))
4322 if (EQ (visibility
, Qicon
))
4323 x_iconify_frame (f
);
4324 else if (! NILP (visibility
))
4325 x_make_frame_visible (f
);
4327 /* Must have been Qnil. */
4331 return unbind_to (count
, frame
);
4334 /* FRAME is used only to get a handle on the X display. We don't pass the
4335 display info directly because we're called from frame.c, which doesn't
4336 know about that structure. */
4338 x_get_focus_frame (frame
)
4339 struct frame
*frame
;
4341 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (frame
);
4343 if (! dpyinfo
->w32_focus_frame
)
4346 XSETFRAME (xfocus
, dpyinfo
->w32_focus_frame
);
4350 DEFUN ("w32-focus-frame", Fw32_focus_frame
, Sw32_focus_frame
, 1, 1, 0,
4351 "Give FRAME input focus, raising to foreground if necessary.")
4355 x_focus_on_frame (check_x_frame (frame
));
4361 w32_load_font (dpyinfo
,name
)
4362 struct w32_display_info
*dpyinfo
;
4365 XFontStruct
* font
= NULL
;
4371 if (!name
|| !x_to_w32_font (name
, &lf
))
4374 font
= (XFontStruct
*) xmalloc (sizeof (XFontStruct
));
4376 if (!font
) return (NULL
);
4380 font
->hfont
= CreateFontIndirect (&lf
);
4383 if (font
->hfont
== NULL
)
4392 hdc
= GetDC (dpyinfo
->root_window
);
4393 oldobj
= SelectObject (hdc
, font
->hfont
);
4394 ok
= GetTextMetrics (hdc
, &font
->tm
);
4395 SelectObject (hdc
, oldobj
);
4396 ReleaseDC (dpyinfo
->root_window
, hdc
);
4401 if (ok
) return (font
);
4403 w32_unload_font (dpyinfo
, font
);
4408 w32_unload_font (dpyinfo
, font
)
4409 struct w32_display_info
*dpyinfo
;
4414 if (font
->hfont
) DeleteObject(font
->hfont
);
4419 /* The font conversion stuff between x and w32 */
4421 /* X font string is as follows (from faces.el)
4425 * (weight "\\(bold\\|demibold\\|medium\\)") ; 1
4426 * (weight\? "\\([^-]*\\)") ; 1
4427 * (slant "\\([ior]\\)") ; 2
4428 * (slant\? "\\([^-]?\\)") ; 2
4429 * (swidth "\\([^-]*\\)") ; 3
4430 * (adstyle "[^-]*") ; 4
4431 * (pixelsize "[0-9]+")
4432 * (pointsize "[0-9][0-9]+")
4433 * (resx "[0-9][0-9]+")
4434 * (resy "[0-9][0-9]+")
4435 * (spacing "[cmp?*]")
4436 * (avgwidth "[0-9]+")
4437 * (registry "[^-]+")
4438 * (encoding "[^-]+")
4440 * (setq x-font-regexp
4441 * (concat "\\`\\*?[-?*]"
4442 * foundry - family - weight\? - slant\? - swidth - adstyle -
4443 * pixelsize - pointsize - resx - resy - spacing - registry -
4444 * encoding "[-?*]\\*?\\'"
4446 * (setq x-font-regexp-head
4447 * (concat "\\`[-?*]" foundry - family - weight\? - slant\?
4448 * "\\([-*?]\\|\\'\\)"))
4449 * (setq x-font-regexp-slant (concat - slant -))
4450 * (setq x-font-regexp-weight (concat - weight -))
4454 #define FONT_START "[-?]"
4455 #define FONT_FOUNDRY "[^-]+"
4456 #define FONT_FAMILY "\\([^-]+\\)" /* 1 */
4457 #define FONT_WEIGHT "\\(bold\\|demibold\\|medium\\)" /* 2 */
4458 #define FONT_WEIGHT_Q "\\([^-]*\\)" /* 2 */
4459 #define FONT_SLANT "\\([ior]\\)" /* 3 */
4460 #define FONT_SLANT_Q "\\([^-]?\\)" /* 3 */
4461 #define FONT_SWIDTH "\\([^-]*\\)" /* 4 */
4462 #define FONT_ADSTYLE "[^-]*"
4463 #define FONT_PIXELSIZE "[^-]*"
4464 #define FONT_POINTSIZE "\\([0-9][0-9]+\\|\\*\\)" /* 5 */
4465 #define FONT_RESX "[0-9][0-9]+"
4466 #define FONT_RESY "[0-9][0-9]+"
4467 #define FONT_SPACING "[cmp?*]"
4468 #define FONT_AVGWIDTH "[0-9]+"
4469 #define FONT_REGISTRY "[^-]+"
4470 #define FONT_ENCODING "[^-]+"
4472 #define FONT_REGEXP ("\\`\\*?[-?*]" \
4479 FONT_PIXELSIZE "-" \
4480 FONT_POINTSIZE "-" \
4483 #define FONT_REGEXP_HEAD ("\\`[-?*]" \
4488 "\\([-*?]\\|\\'\\)")
4490 #define FONT_REGEXP_SLANT "-" FONT_SLANT "-"
4491 #define FONT_REGEXP_WEIGHT "-" FONT_WEIGHT "-"
4494 x_to_w32_weight (lpw
)
4497 if (!lpw
) return (FW_DONTCARE
);
4499 if (stricmp (lpw
,"heavy") == 0) return FW_HEAVY
;
4500 else if (stricmp (lpw
,"extrabold") == 0) return FW_EXTRABOLD
;
4501 else if (stricmp (lpw
,"bold") == 0) return FW_BOLD
;
4502 else if (stricmp (lpw
,"demibold") == 0) return FW_SEMIBOLD
;
4503 else if (stricmp (lpw
,"semibold") == 0) return FW_SEMIBOLD
;
4504 else if (stricmp (lpw
,"medium") == 0) return FW_MEDIUM
;
4505 else if (stricmp (lpw
,"normal") == 0) return FW_NORMAL
;
4506 else if (stricmp (lpw
,"light") == 0) return FW_LIGHT
;
4507 else if (stricmp (lpw
,"extralight") == 0) return FW_EXTRALIGHT
;
4508 else if (stricmp (lpw
,"thin") == 0) return FW_THIN
;
4515 w32_to_x_weight (fnweight
)
4518 if (fnweight
>= FW_HEAVY
) return "heavy";
4519 if (fnweight
>= FW_EXTRABOLD
) return "extrabold";
4520 if (fnweight
>= FW_BOLD
) return "bold";
4521 if (fnweight
>= FW_SEMIBOLD
) return "semibold";
4522 if (fnweight
>= FW_MEDIUM
) return "medium";
4523 if (fnweight
>= FW_NORMAL
) return "normal";
4524 if (fnweight
>= FW_LIGHT
) return "light";
4525 if (fnweight
>= FW_EXTRALIGHT
) return "extralight";
4526 if (fnweight
>= FW_THIN
) return "thin";
4532 x_to_w32_charset (lpcs
)
4535 if (!lpcs
) return (0);
4537 if (stricmp (lpcs
,"ansi") == 0) return ANSI_CHARSET
;
4538 else if (stricmp (lpcs
,"iso8859-1") == 0) return ANSI_CHARSET
;
4539 else if (stricmp (lpcs
,"iso8859") == 0) return ANSI_CHARSET
;
4540 else if (stricmp (lpcs
,"oem") == 0) return OEM_CHARSET
;
4541 #ifdef UNICODE_CHARSET
4542 else if (stricmp (lpcs
,"unicode") == 0) return UNICODE_CHARSET
;
4543 else if (stricmp (lpcs
,"iso10646") == 0) return UNICODE_CHARSET
;
4545 else if (lpcs
[0] == '#') return atoi (lpcs
+ 1);
4547 return DEFAULT_CHARSET
;
4551 w32_to_x_charset (fncharset
)
4554 static char buf
[16];
4558 case ANSI_CHARSET
: return "ansi";
4559 case OEM_CHARSET
: return "oem";
4560 case SYMBOL_CHARSET
: return "symbol";
4561 #ifdef UNICODE_CHARSET
4562 case UNICODE_CHARSET
: return "unicode";
4565 /* Encode numerical value of unknown charset. */
4566 sprintf (buf
, "#%u", fncharset
);
4571 w32_to_x_font (lplogfont
, lpxstr
, len
)
4572 LOGFONT
* lplogfont
;
4576 char height_pixels
[8];
4578 char width_pixels
[8];
4580 if (!lpxstr
) abort ();
4585 if (lplogfont
->lfHeight
)
4587 sprintf (height_pixels
, "%u", abs (lplogfont
->lfHeight
));
4588 sprintf (height_dpi
, "%u",
4589 (abs (lplogfont
->lfHeight
) * 720) / one_w32_display_info
.height_in
);
4593 strcpy (height_pixels
, "*");
4594 strcpy (height_dpi
, "*");
4596 if (lplogfont
->lfWidth
)
4597 sprintf (width_pixels
, "%u", lplogfont
->lfWidth
* 10);
4599 strcpy (width_pixels
, "*");
4601 _snprintf (lpxstr
, len
- 1,
4602 "-*-%s-%s-%c-*-*-%s-%s-*-*-%c-%s-*-%s-",
4603 lplogfont
->lfFaceName
,
4604 w32_to_x_weight (lplogfont
->lfWeight
),
4605 lplogfont
->lfItalic
?'i':'r',
4608 ((lplogfont
->lfPitchAndFamily
& 0x3) == VARIABLE_PITCH
) ? 'p' : 'c',
4610 w32_to_x_charset (lplogfont
->lfCharSet
)
4613 lpxstr
[len
- 1] = 0; /* just to be sure */
4618 x_to_w32_font (lpxstr
, lplogfont
)
4620 LOGFONT
* lplogfont
;
4622 if (!lplogfont
) return (FALSE
);
4624 memset (lplogfont
, 0, sizeof (*lplogfont
));
4627 lplogfont
->lfOutPrecision
= OUT_DEFAULT_PRECIS
;
4628 lplogfont
->lfClipPrecision
= CLIP_DEFAULT_PRECIS
;
4629 lplogfont
->lfQuality
= DEFAULT_QUALITY
;
4631 /* go for maximum quality */
4632 lplogfont
->lfOutPrecision
= OUT_STROKE_PRECIS
;
4633 lplogfont
->lfClipPrecision
= CLIP_STROKE_PRECIS
;
4634 lplogfont
->lfQuality
= PROOF_QUALITY
;
4640 /* Provide a simple escape mechanism for specifying Windows font names
4641 * directly -- if font spec does not beginning with '-', assume this
4643 * "<font name>[:height in pixels[:width in pixels[:weight]]]"
4649 char name
[50], weight
[20], slant
, pitch
, pixels
[10], height
[10], width
[10], remainder
[20];
4652 fields
= sscanf (lpxstr
,
4653 "-%*[^-]-%49[^-]-%19[^-]-%c-%*[^-]-%*[^-]-%9[^-]-%9[^-]-%*[^-]-%*[^-]-%c-%9[^-]-%19s",
4654 name
, weight
, &slant
, pixels
, height
, &pitch
, width
, remainder
);
4656 if (fields
== EOF
) return (FALSE
);
4658 if (fields
> 0 && name
[0] != '*')
4660 strncpy (lplogfont
->lfFaceName
,name
, LF_FACESIZE
);
4661 lplogfont
->lfFaceName
[LF_FACESIZE
-1] = 0;
4665 lplogfont
->lfFaceName
[0] = 0;
4670 lplogfont
->lfWeight
= x_to_w32_weight ((fields
> 0 ? weight
: ""));
4674 if (!NILP (Vw32_enable_italics
))
4675 lplogfont
->lfItalic
= (fields
> 0 && slant
== 'i');
4679 if (fields
> 0 && pixels
[0] != '*')
4680 lplogfont
->lfHeight
= atoi (pixels
);
4684 if (fields
> 0 && lplogfont
->lfHeight
== 0 && height
[0] != '*')
4685 lplogfont
->lfHeight
= (atoi (height
)
4686 * one_w32_display_info
.height_in
) / 720;
4690 lplogfont
->lfPitchAndFamily
=
4691 (fields
> 0 && pitch
== 'p') ? VARIABLE_PITCH
: FIXED_PITCH
;
4695 if (fields
> 0 && width
[0] != '*')
4696 lplogfont
->lfWidth
= atoi (width
) / 10;
4700 /* Not all font specs include the registry field, so we allow for an
4701 optional registry field before the encoding when parsing
4702 remainder. Also we strip the trailing '-' if present. */
4704 int len
= strlen (remainder
);
4705 if (len
> 0 && remainder
[len
-1] == '-')
4706 remainder
[len
-1] = 0;
4708 encoding
= remainder
;
4709 if (strncmp (encoding
, "*-", 2) == 0)
4711 lplogfont
->lfCharSet
= x_to_w32_charset (fields
> 0 ? encoding
: "");
4716 char name
[100], height
[10], width
[10], weight
[20];
4718 fields
= sscanf (lpxstr
,
4719 "%99[^:]:%9[^:]:%9[^:]:%19s",
4720 name
, height
, width
, weight
);
4722 if (fields
== EOF
) return (FALSE
);
4726 strncpy (lplogfont
->lfFaceName
,name
, LF_FACESIZE
);
4727 lplogfont
->lfFaceName
[LF_FACESIZE
-1] = 0;
4731 lplogfont
->lfFaceName
[0] = 0;
4737 lplogfont
->lfHeight
= atoi (height
);
4742 lplogfont
->lfWidth
= atoi (width
);
4746 lplogfont
->lfWeight
= x_to_w32_weight ((fields
> 0 ? weight
: ""));
4749 /* This makes TrueType fonts work better. */
4750 lplogfont
->lfHeight
= - abs (lplogfont
->lfHeight
);
4756 w32_font_match (lpszfont1
, lpszfont2
)
4760 char * s1
= lpszfont1
, *e1
;
4761 char * s2
= lpszfont2
, *e2
;
4763 if (s1
== NULL
|| s2
== NULL
) return (FALSE
);
4765 if (*s1
== '-') s1
++;
4766 if (*s2
== '-') s2
++;
4772 e1
= strchr (s1
, '-');
4773 e2
= strchr (s2
, '-');
4775 if (e1
== NULL
|| e2
== NULL
) return (TRUE
);
4780 if (*s1
!= '*' && *s2
!= '*'
4781 && (len1
!= len2
|| strnicmp (s1
, s2
, len1
) != 0))
4789 typedef struct enumfont_t
4794 XFontStruct
*size_ref
;
4795 Lisp_Object
*pattern
;
4801 enum_font_cb2 (lplf
, lptm
, FontType
, lpef
)
4803 NEWTEXTMETRIC
* lptm
;
4807 if (lplf
->elfLogFont
.lfStrikeOut
|| lplf
->elfLogFont
.lfUnderline
)
4810 /* if (!lpef->size_ref || lptm->tmMaxCharWidth == FONT_WIDTH (lpef->size_ref)) */
4814 if (!NILP (*(lpef
->pattern
)) && FontType
!= RASTER_FONTTYPE
)
4816 lplf
->elfLogFont
.lfHeight
= lpef
->logfont
.lfHeight
;
4817 lplf
->elfLogFont
.lfWidth
= lpef
->logfont
.lfWidth
;
4820 if (!w32_to_x_font (lplf
, buf
, 100)) return (0);
4822 if (NILP (*(lpef
->pattern
)) || w32_font_match (buf
, XSTRING (*(lpef
->pattern
))->data
))
4824 *lpef
->tail
= Fcons (build_string (buf
), Qnil
);
4825 lpef
->tail
= &XCONS (*lpef
->tail
)->cdr
;
4834 enum_font_cb1 (lplf
, lptm
, FontType
, lpef
)
4836 NEWTEXTMETRIC
* lptm
;
4840 return EnumFontFamilies (lpef
->hdc
,
4841 lplf
->elfLogFont
.lfFaceName
,
4842 (FONTENUMPROC
) enum_font_cb2
,
4847 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 3, 0,
4848 "Return a list of the names of available fonts matching PATTERN.\n\
4849 If optional arguments FACE and FRAME are specified, return only fonts\n\
4850 the same size as FACE on FRAME.\n\
4852 PATTERN is a string, perhaps with wildcard characters;\n\
4853 the * character matches any substring, and\n\
4854 the ? character matches any single character.\n\
4855 PATTERN is case-insensitive.\n\
4856 FACE is a face name--a symbol.\n\
4858 The return value is a list of strings, suitable as arguments to\n\
4861 Fonts Emacs can't use (i.e. proportional fonts) may or may not be excluded\n\
4862 even if they match PATTERN and FACE.")
4863 (pattern
, face
, frame
)
4864 Lisp_Object pattern
, face
, frame
;
4869 XFontStruct
*size_ref
;
4870 Lisp_Object namelist
;
4875 CHECK_STRING (pattern
, 0);
4877 CHECK_SYMBOL (face
, 1);
4879 f
= check_x_frame (frame
);
4881 /* Determine the width standard for comparison with the fonts we find. */
4889 /* Don't die if we get called with a terminal frame. */
4890 if (! FRAME_W32_P (f
))
4891 error ("non-w32 frame used in `x-list-fonts'");
4893 face_id
= face_name_id_number (f
, face
);
4895 if (face_id
< 0 || face_id
>= FRAME_N_PARAM_FACES (f
)
4896 || FRAME_PARAM_FACES (f
) [face_id
] == 0)
4897 size_ref
= f
->output_data
.w32
->font
;
4900 size_ref
= FRAME_PARAM_FACES (f
) [face_id
]->font
;
4901 if (size_ref
== (XFontStruct
*) (~0))
4902 size_ref
= f
->output_data
.w32
->font
;
4906 /* See if we cached the result for this particular query. */
4907 list
= Fassoc (pattern
,
4908 XCONS (FRAME_W32_DISPLAY_INFO (f
)->name_list_element
)->cdr
);
4910 /* We have info in the cache for this PATTERN. */
4913 Lisp_Object tem
, newlist
;
4915 /* We have info about this pattern. */
4916 list
= XCONS (list
)->cdr
;
4923 /* Filter the cached info and return just the fonts that match FACE. */
4925 for (tem
= list
; CONSP (tem
); tem
= XCONS (tem
)->cdr
)
4927 XFontStruct
*thisinfo
;
4929 thisinfo
= w32_load_font (FRAME_W32_DISPLAY_INFO (f
), XSTRING (XCONS (tem
)->car
)->data
);
4931 if (thisinfo
&& same_size_fonts (thisinfo
, size_ref
))
4932 newlist
= Fcons (XCONS (tem
)->car
, newlist
);
4934 w32_unload_font (FRAME_W32_DISPLAY_INFO (f
), thisinfo
);
4945 ef
.pattern
= &pattern
;
4946 ef
.tail
= ef
.head
= &namelist
;
4948 x_to_w32_font (STRINGP (pattern
) ? XSTRING (pattern
)->data
: NULL
, &ef
.logfont
);
4951 ef
.hdc
= GetDC (FRAME_W32_WINDOW (f
));
4953 EnumFontFamilies (ef
.hdc
, NULL
, (FONTENUMPROC
) enum_font_cb1
, (LPARAM
)&ef
);
4955 ReleaseDC (FRAME_W32_WINDOW (f
), ef
.hdc
);
4965 /* Make a list of all the fonts we got back.
4966 Store that in the font cache for the display. */
4967 XCONS (FRAME_W32_DISPLAY_INFO (f
)->name_list_element
)->cdr
4968 = Fcons (Fcons (pattern
, namelist
),
4969 XCONS (FRAME_W32_DISPLAY_INFO (f
)->name_list_element
)->cdr
);
4971 /* Make a list of the fonts that have the right width. */
4974 for (i
= 0; i
< ef
.numFonts
; i
++)
4982 XFontStruct
*thisinfo
;
4985 thisinfo
= w32_load_font (FRAME_W32_DISPLAY_INFO (f
), XSTRING (Fcar (cur
))->data
);
4987 keeper
= thisinfo
&& same_size_fonts (thisinfo
, size_ref
);
4989 w32_unload_font (FRAME_W32_DISPLAY_INFO (f
), thisinfo
);
4994 list
= Fcons (build_string (XSTRING (Fcar (cur
))->data
), list
);
4998 list
= Fnreverse (list
);
5004 DEFUN ("x-color-defined-p", Fx_color_defined_p
, Sx_color_defined_p
, 1, 2, 0,
5005 "Return non-nil if color COLOR is supported on frame FRAME.\n\
5006 If FRAME is omitted or nil, use the selected frame.")
5008 Lisp_Object color
, frame
;
5011 FRAME_PTR f
= check_x_frame (frame
);
5013 CHECK_STRING (color
, 1);
5015 if (defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
5021 DEFUN ("x-color-values", Fx_color_values
, Sx_color_values
, 1, 2, 0,
5022 "Return a description of the color named COLOR on frame FRAME.\n\
5023 The value is a list of integer RGB values--(RED GREEN BLUE).\n\
5024 These values appear to range from 0 to 65280 or 65535, depending\n\
5025 on the system; white is (65280 65280 65280) or (65535 65535 65535).\n\
5026 If FRAME is omitted or nil, use the selected frame.")
5028 Lisp_Object color
, frame
;
5031 FRAME_PTR f
= check_x_frame (frame
);
5033 CHECK_STRING (color
, 1);
5035 if (defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
5039 rgb
[0] = make_number ((GetRValue (foo
) << 8) | GetRValue (foo
));
5040 rgb
[1] = make_number ((GetGValue (foo
) << 8) | GetGValue (foo
));
5041 rgb
[2] = make_number ((GetBValue (foo
) << 8) | GetBValue (foo
));
5042 return Flist (3, rgb
);
5048 DEFUN ("x-display-color-p", Fx_display_color_p
, Sx_display_color_p
, 0, 1, 0,
5049 "Return t if the X display supports color.\n\
5050 The optional argument DISPLAY specifies which display to ask about.\n\
5051 DISPLAY should be either a frame or a display name (a string).\n\
5052 If omitted or nil, that stands for the selected frame's display.")
5054 Lisp_Object display
;
5056 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
5058 if ((dpyinfo
->n_planes
* dpyinfo
->n_cbits
) <= 2)
5064 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
, Sx_display_grayscale_p
,
5066 "Return t if the X display supports shades of gray.\n\
5067 Note that color displays do support shades of gray.\n\
5068 The optional argument DISPLAY specifies which display to ask about.\n\
5069 DISPLAY should be either a frame or a display name (a string).\n\
5070 If omitted or nil, that stands for the selected frame's display.")
5072 Lisp_Object display
;
5074 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
5076 if ((dpyinfo
->n_planes
* dpyinfo
->n_cbits
) <= 1)
5082 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
5084 "Returns the width in pixels of the X display DISPLAY.\n\
5085 The optional argument DISPLAY specifies which display to ask about.\n\
5086 DISPLAY should be either a frame or a display name (a string).\n\
5087 If omitted or nil, that stands for the selected frame's display.")
5089 Lisp_Object display
;
5091 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
5093 return make_number (dpyinfo
->width
);
5096 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
5097 Sx_display_pixel_height
, 0, 1, 0,
5098 "Returns the height in pixels of the X display DISPLAY.\n\
5099 The optional argument DISPLAY specifies which display to ask about.\n\
5100 DISPLAY should be either a frame or a display name (a string).\n\
5101 If omitted or nil, that stands for the selected frame's display.")
5103 Lisp_Object display
;
5105 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
5107 return make_number (dpyinfo
->height
);
5110 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
5112 "Returns the number of bitplanes of the display DISPLAY.\n\
5113 The optional argument DISPLAY specifies which display to ask about.\n\
5114 DISPLAY should be either a frame or a display name (a string).\n\
5115 If omitted or nil, that stands for the selected frame's display.")
5117 Lisp_Object display
;
5119 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
5121 return make_number (dpyinfo
->n_planes
* dpyinfo
->n_cbits
);
5124 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
5126 "Returns the number of color cells of the display DISPLAY.\n\
5127 The optional argument DISPLAY specifies which display to ask about.\n\
5128 DISPLAY should be either a frame or a display name (a string).\n\
5129 If omitted or nil, that stands for the selected frame's display.")
5131 Lisp_Object display
;
5133 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
5137 hdc
= GetDC (dpyinfo
->root_window
);
5138 if (dpyinfo
->has_palette
)
5139 cap
= GetDeviceCaps (hdc
,SIZEPALETTE
);
5141 cap
= GetDeviceCaps (hdc
,NUMCOLORS
);
5143 ReleaseDC (dpyinfo
->root_window
, hdc
);
5145 return make_number (cap
);
5148 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
5149 Sx_server_max_request_size
,
5151 "Returns the maximum request size of the server of display DISPLAY.\n\
5152 The optional argument DISPLAY specifies which display to ask about.\n\
5153 DISPLAY should be either a frame or a display name (a string).\n\
5154 If omitted or nil, that stands for the selected frame's display.")
5156 Lisp_Object display
;
5158 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
5160 return make_number (1);
5163 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
5164 "Returns the vendor ID string of the W32 system (Microsoft).\n\
5165 The optional argument DISPLAY specifies which display to ask about.\n\
5166 DISPLAY should be either a frame or a display name (a string).\n\
5167 If omitted or nil, that stands for the selected frame's display.")
5169 Lisp_Object display
;
5171 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
5172 char *vendor
= "Microsoft Corp.";
5174 if (! vendor
) vendor
= "";
5175 return build_string (vendor
);
5178 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
5179 "Returns the version numbers of the server of display DISPLAY.\n\
5180 The value is a list of three integers: the major and minor\n\
5181 version numbers, and the vendor-specific release\n\
5182 number. See also the function `x-server-vendor'.\n\n\
5183 The optional argument DISPLAY specifies which display to ask about.\n\
5184 DISPLAY should be either a frame or a display name (a string).\n\
5185 If omitted or nil, that stands for the selected frame's display.")
5187 Lisp_Object display
;
5189 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
5191 return Fcons (make_number (w32_major_version
),
5192 Fcons (make_number (w32_minor_version
), Qnil
));
5195 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
5196 "Returns the number of screens on the server of display DISPLAY.\n\
5197 The optional argument DISPLAY specifies which display to ask about.\n\
5198 DISPLAY should be either a frame or a display name (a string).\n\
5199 If omitted or nil, that stands for the selected frame's display.")
5201 Lisp_Object display
;
5203 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
5205 return make_number (1);
5208 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
5209 "Returns the height in millimeters of the X display DISPLAY.\n\
5210 The optional argument DISPLAY specifies which display to ask about.\n\
5211 DISPLAY should be either a frame or a display name (a string).\n\
5212 If omitted or nil, that stands for the selected frame's display.")
5214 Lisp_Object display
;
5216 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
5220 hdc
= GetDC (dpyinfo
->root_window
);
5222 cap
= GetDeviceCaps (hdc
, VERTSIZE
);
5224 ReleaseDC (dpyinfo
->root_window
, hdc
);
5226 return make_number (cap
);
5229 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
5230 "Returns the width in millimeters of the X display DISPLAY.\n\
5231 The optional argument DISPLAY specifies which display to ask about.\n\
5232 DISPLAY should be either a frame or a display name (a string).\n\
5233 If omitted or nil, that stands for the selected frame's display.")
5235 Lisp_Object display
;
5237 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
5242 hdc
= GetDC (dpyinfo
->root_window
);
5244 cap
= GetDeviceCaps (hdc
, HORZSIZE
);
5246 ReleaseDC (dpyinfo
->root_window
, hdc
);
5248 return make_number (cap
);
5251 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
5252 Sx_display_backing_store
, 0, 1, 0,
5253 "Returns an indication of whether display DISPLAY does backing store.\n\
5254 The value may be `always', `when-mapped', or `not-useful'.\n\
5255 The optional argument DISPLAY specifies which display to ask about.\n\
5256 DISPLAY should be either a frame or a display name (a string).\n\
5257 If omitted or nil, that stands for the selected frame's display.")
5259 Lisp_Object display
;
5261 return intern ("not-useful");
5264 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
5265 Sx_display_visual_class
, 0, 1, 0,
5266 "Returns the visual class of the display DISPLAY.\n\
5267 The value is one of the symbols `static-gray', `gray-scale',\n\
5268 `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
5269 The optional argument DISPLAY specifies which display to ask about.\n\
5270 DISPLAY should be either a frame or a display name (a string).\n\
5271 If omitted or nil, that stands for the selected frame's display.")
5273 Lisp_Object display
;
5275 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
5278 switch (dpyinfo
->visual
->class)
5280 case StaticGray
: return (intern ("static-gray"));
5281 case GrayScale
: return (intern ("gray-scale"));
5282 case StaticColor
: return (intern ("static-color"));
5283 case PseudoColor
: return (intern ("pseudo-color"));
5284 case TrueColor
: return (intern ("true-color"));
5285 case DirectColor
: return (intern ("direct-color"));
5287 error ("Display has an unknown visual class");
5291 error ("Display has an unknown visual class");
5294 DEFUN ("x-display-save-under", Fx_display_save_under
,
5295 Sx_display_save_under
, 0, 1, 0,
5296 "Returns t if the display DISPLAY supports the save-under feature.\n\
5297 The optional argument DISPLAY specifies which display to ask about.\n\
5298 DISPLAY should be either a frame or a display name (a string).\n\
5299 If omitted or nil, that stands for the selected frame's display.")
5301 Lisp_Object display
;
5303 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
5310 register struct frame
*f
;
5312 return PIXEL_WIDTH (f
);
5317 register struct frame
*f
;
5319 return PIXEL_HEIGHT (f
);
5324 register struct frame
*f
;
5326 return FONT_WIDTH (f
->output_data
.w32
->font
);
5331 register struct frame
*f
;
5333 return f
->output_data
.w32
->line_height
;
5337 x_screen_planes (frame
)
5340 return (FRAME_W32_DISPLAY_INFO (XFRAME (frame
))->n_planes
*
5341 FRAME_W32_DISPLAY_INFO (XFRAME (frame
))->n_cbits
);
5344 /* Return the display structure for the display named NAME.
5345 Open a new connection if necessary. */
5347 struct w32_display_info
*
5348 x_display_info_for_name (name
)
5352 struct w32_display_info
*dpyinfo
;
5354 CHECK_STRING (name
, 0);
5356 for (dpyinfo
= &one_w32_display_info
, names
= w32_display_name_list
;
5358 dpyinfo
= dpyinfo
->next
, names
= XCONS (names
)->cdr
)
5361 tem
= Fstring_equal (XCONS (XCONS (names
)->car
)->car
, name
);
5366 /* Use this general default value to start with. */
5367 Vx_resource_name
= Vinvocation_name
;
5369 validate_x_resource_name ();
5371 dpyinfo
= w32_term_init (name
, (unsigned char *)0,
5372 (char *) XSTRING (Vx_resource_name
)->data
);
5375 error ("Cannot connect to server %s", XSTRING (name
)->data
);
5378 XSETFASTINT (Vwindow_system_version
, 3);
5383 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
5384 1, 3, 0, "Open a connection to a server.\n\
5385 DISPLAY is the name of the display to connect to.\n\
5386 Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
5387 If the optional third arg MUST-SUCCEED is non-nil,\n\
5388 terminate Emacs if we can't open the connection.")
5389 (display
, xrm_string
, must_succeed
)
5390 Lisp_Object display
, xrm_string
, must_succeed
;
5392 unsigned int n_planes
;
5393 unsigned char *xrm_option
;
5394 struct w32_display_info
*dpyinfo
;
5396 CHECK_STRING (display
, 0);
5397 if (! NILP (xrm_string
))
5398 CHECK_STRING (xrm_string
, 1);
5400 if (! EQ (Vwindow_system
, intern ("w32")))
5401 error ("Not using Microsoft Windows");
5403 /* Allow color mapping to be defined externally; first look in user's
5404 HOME directory, then in Emacs etc dir for a file called rgb.txt. */
5406 Lisp_Object color_file
;
5407 struct gcpro gcpro1
;
5409 color_file
= build_string("~/rgb.txt");
5411 GCPRO1 (color_file
);
5413 if (NILP (Ffile_readable_p (color_file
)))
5415 Fexpand_file_name (build_string ("rgb.txt"),
5416 Fsymbol_value (intern ("data-directory")));
5418 Vw32_color_map
= Fw32_load_color_file (color_file
);
5422 if (NILP (Vw32_color_map
))
5423 Vw32_color_map
= Fw32_default_color_map ();
5425 if (! NILP (xrm_string
))
5426 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
5428 xrm_option
= (unsigned char *) 0;
5430 /* Use this general default value to start with. */
5431 /* First remove .exe suffix from invocation-name - it looks ugly. */
5433 char basename
[ MAX_PATH
], *str
;
5435 strcpy (basename
, XSTRING (Vinvocation_name
)->data
);
5436 str
= strrchr (basename
, '.');
5438 Vinvocation_name
= build_string (basename
);
5440 Vx_resource_name
= Vinvocation_name
;
5442 validate_x_resource_name ();
5444 /* This is what opens the connection and sets x_current_display.
5445 This also initializes many symbols, such as those used for input. */
5446 dpyinfo
= w32_term_init (display
, xrm_option
,
5447 (char *) XSTRING (Vx_resource_name
)->data
);
5451 if (!NILP (must_succeed
))
5452 fatal ("Cannot connect to server %s.\n",
5453 XSTRING (display
)->data
);
5455 error ("Cannot connect to server %s", XSTRING (display
)->data
);
5460 XSETFASTINT (Vwindow_system_version
, 3);
5464 DEFUN ("x-close-connection", Fx_close_connection
,
5465 Sx_close_connection
, 1, 1, 0,
5466 "Close the connection to DISPLAY's server.\n\
5467 For DISPLAY, specify either a frame or a display name (a string).\n\
5468 If DISPLAY is nil, that stands for the selected frame's display.")
5470 Lisp_Object display
;
5472 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
5473 struct w32_display_info
*tail
;
5476 if (dpyinfo
->reference_count
> 0)
5477 error ("Display still has frames on it");
5480 /* Free the fonts in the font table. */
5481 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
5483 if (dpyinfo
->font_table
[i
].name
)
5484 free (dpyinfo
->font_table
[i
].name
);
5485 /* Don't free the full_name string;
5486 it is always shared with something else. */
5487 w32_unload_font (dpyinfo
, dpyinfo
->font_table
[i
].font
);
5489 x_destroy_all_bitmaps (dpyinfo
);
5491 x_delete_display (dpyinfo
);
5497 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
5498 "Return the list of display names that Emacs has connections to.")
5501 Lisp_Object tail
, result
;
5504 for (tail
= w32_display_name_list
; ! NILP (tail
); tail
= XCONS (tail
)->cdr
)
5505 result
= Fcons (XCONS (XCONS (tail
)->car
)->car
, result
);
5510 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
5511 "If ON is non-nil, report errors as soon as the erring request is made.\n\
5512 If ON is nil, allow buffering of requests.\n\
5513 This is a noop on W32 systems.\n\
5514 The optional second argument DISPLAY specifies which display to act on.\n\
5515 DISPLAY should be either a frame or a display name (a string).\n\
5516 If DISPLAY is omitted or nil, that stands for the selected frame's display.")
5518 Lisp_Object display
, on
;
5520 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
5526 /* These are the w32 specialized functions */
5528 DEFUN ("w32-select-font", Fw32_select_font
, Sw32_select_font
, 0, 1, 0,
5529 "This will display the W32 font dialog and return an X font string corresponding to the selection.")
5533 FRAME_PTR f
= check_x_frame (frame
);
5538 bzero (&cf
, sizeof (cf
));
5540 cf
.lStructSize
= sizeof (cf
);
5541 cf
.hwndOwner
= FRAME_W32_WINDOW (f
);
5542 cf
.Flags
= CF_FIXEDPITCHONLY
| CF_FORCEFONTEXIST
| CF_SCREENFONTS
;
5545 if (!ChooseFont (&cf
) || !w32_to_x_font (&lf
, buf
, 100))
5548 return build_string (buf
);
5551 DEFUN ("w32-send-sys-command", Fw32_send_sys_command
, Sw32_send_sys_command
, 1, 2, 0,
5552 "Send frame a Windows WM_SYSCOMMAND message of type COMMAND.\n\
5553 Some useful values for command are 0xf030 to maximise frame (0xf020\n\
5554 to minimize), 0xf120 to restore frame to original size, and 0xf100\n\
5555 to activate the menubar for keyboard access. 0xf140 activates the\n\
5556 screen saver if defined.\n\
5558 If optional parameter FRAME is not specified, use selected frame.")
5560 Lisp_Object command
, frame
;
5563 FRAME_PTR f
= check_x_frame (frame
);
5565 CHECK_NUMBER (command
, 0);
5567 PostMessage (FRAME_W32_WINDOW (f
), WM_SYSCOMMAND
, XINT (command
), 0);
5575 /* This is zero if not using MS-Windows. */
5578 /* The section below is built by the lisp expression at the top of the file,
5579 just above where these variables are declared. */
5580 /*&&& init symbols here &&&*/
5581 Qauto_raise
= intern ("auto-raise");
5582 staticpro (&Qauto_raise
);
5583 Qauto_lower
= intern ("auto-lower");
5584 staticpro (&Qauto_lower
);
5585 Qbackground_color
= intern ("background-color");
5586 staticpro (&Qbackground_color
);
5587 Qbar
= intern ("bar");
5589 Qborder_color
= intern ("border-color");
5590 staticpro (&Qborder_color
);
5591 Qborder_width
= intern ("border-width");
5592 staticpro (&Qborder_width
);
5593 Qbox
= intern ("box");
5595 Qcursor_color
= intern ("cursor-color");
5596 staticpro (&Qcursor_color
);
5597 Qcursor_type
= intern ("cursor-type");
5598 staticpro (&Qcursor_type
);
5599 Qforeground_color
= intern ("foreground-color");
5600 staticpro (&Qforeground_color
);
5601 Qgeometry
= intern ("geometry");
5602 staticpro (&Qgeometry
);
5603 Qicon_left
= intern ("icon-left");
5604 staticpro (&Qicon_left
);
5605 Qicon_top
= intern ("icon-top");
5606 staticpro (&Qicon_top
);
5607 Qicon_type
= intern ("icon-type");
5608 staticpro (&Qicon_type
);
5609 Qicon_name
= intern ("icon-name");
5610 staticpro (&Qicon_name
);
5611 Qinternal_border_width
= intern ("internal-border-width");
5612 staticpro (&Qinternal_border_width
);
5613 Qleft
= intern ("left");
5615 Qright
= intern ("right");
5616 staticpro (&Qright
);
5617 Qmouse_color
= intern ("mouse-color");
5618 staticpro (&Qmouse_color
);
5619 Qnone
= intern ("none");
5621 Qparent_id
= intern ("parent-id");
5622 staticpro (&Qparent_id
);
5623 Qscroll_bar_width
= intern ("scroll-bar-width");
5624 staticpro (&Qscroll_bar_width
);
5625 Qsuppress_icon
= intern ("suppress-icon");
5626 staticpro (&Qsuppress_icon
);
5627 Qtop
= intern ("top");
5629 Qundefined_color
= intern ("undefined-color");
5630 staticpro (&Qundefined_color
);
5631 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
5632 staticpro (&Qvertical_scroll_bars
);
5633 Qvisibility
= intern ("visibility");
5634 staticpro (&Qvisibility
);
5635 Qwindow_id
= intern ("window-id");
5636 staticpro (&Qwindow_id
);
5637 Qx_frame_parameter
= intern ("x-frame-parameter");
5638 staticpro (&Qx_frame_parameter
);
5639 Qx_resource_name
= intern ("x-resource-name");
5640 staticpro (&Qx_resource_name
);
5641 Quser_position
= intern ("user-position");
5642 staticpro (&Quser_position
);
5643 Quser_size
= intern ("user-size");
5644 staticpro (&Quser_size
);
5645 Qdisplay
= intern ("display");
5646 staticpro (&Qdisplay
);
5647 /* This is the end of symbol initialization. */
5649 Fput (Qundefined_color
, Qerror_conditions
,
5650 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
5651 Fput (Qundefined_color
, Qerror_message
,
5652 build_string ("Undefined color"));
5654 DEFVAR_LISP ("w32-color-map", &Vw32_color_map
,
5655 "A array of color name mappings for windows.");
5656 Vw32_color_map
= Qnil
;
5658 DEFVAR_LISP ("w32-pass-alt-to-system", &Vw32_pass_alt_to_system
,
5659 "Non-nil if alt key presses are passed on to Windows.\n\
5660 When non-nil, for example, alt pressed and released and then space will\n\
5661 open the System menu. When nil, Emacs silently swallows alt key events.");
5662 Vw32_pass_alt_to_system
= Qnil
;
5664 DEFVAR_LISP ("w32-alt-is-meta", &Vw32_alt_is_meta
,
5665 "Non-nil if the alt key is to be considered the same as the meta key.\n\
5666 When nil, Emacs will translate the alt key to the Alt modifier, and not Meta.");
5667 Vw32_alt_is_meta
= Qt
;
5669 DEFVAR_LISP ("w32-pass-optional-keys-to-system",
5670 &Vw32_pass_optional_keys_to_system
,
5671 "Non-nil if the 'optional' keys (left window, right window,\n\
5672 and application keys) are passed on to Windows.");
5673 Vw32_pass_optional_keys_to_system
= Qnil
;
5675 DEFVAR_LISP ("w32-enable-italics", &Vw32_enable_italics
,
5676 "Non-nil enables selection of artificially italicized fonts.");
5677 Vw32_enable_italics
= Qnil
;
5679 DEFVAR_LISP ("w32-enable-palette", &Vw32_enable_palette
,
5680 "Non-nil enables Windows palette management to map colors exactly.");
5681 Vw32_enable_palette
= Qt
;
5683 DEFVAR_INT ("w32-mouse-button-tolerance",
5684 &Vw32_mouse_button_tolerance
,
5685 "Analogue of double click interval for faking middle mouse events.\n\
5686 The value is the minimum time in milliseconds that must elapse between\n\
5687 left/right button down events before they are considered distinct events.\n\
5688 If both mouse buttons are depressed within this interval, a middle mouse\n\
5689 button down event is generated instead.");
5690 XSETINT (Vw32_mouse_button_tolerance
, GetDoubleClickTime () / 2);
5692 DEFVAR_INT ("w32-mouse-move-interval",
5693 &Vw32_mouse_move_interval
,
5694 "Minimum interval between mouse move events.\n\
5695 The value is the minimum time in milliseconds that must elapse between\n\
5696 successive mouse move (or scroll bar drag) events before they are\n\
5697 reported as lisp events.");
5698 XSETINT (Vw32_mouse_move_interval
, 50);
5700 init_x_parm_symbols ();
5702 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path
,
5703 "List of directories to search for bitmap files for w32.");
5704 Vx_bitmap_file_path
= decode_env_path ((char *) 0, "PATH");
5706 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
5707 "The shape of the pointer when over text.\n\
5708 Changing the value does not affect existing frames\n\
5709 unless you set the mouse color.");
5710 Vx_pointer_shape
= Qnil
;
5712 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
5713 "The name Emacs uses to look up resources; for internal use only.\n\
5714 `x-get-resource' uses this as the first component of the instance name\n\
5715 when requesting resource values.\n\
5716 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
5717 was invoked, or to the value specified with the `-name' or `-rn'\n\
5718 switches, if present.");
5719 Vx_resource_name
= Qnil
;
5721 Vx_nontext_pointer_shape
= Qnil
;
5723 Vx_mode_pointer_shape
= Qnil
;
5725 DEFVAR_INT ("x-sensitive-text-pointer-shape",
5726 &Vx_sensitive_text_pointer_shape
,
5727 "The shape of the pointer when over mouse-sensitive text.\n\
5728 This variable takes effect when you create a new frame\n\
5729 or when you set the mouse color.");
5730 Vx_sensitive_text_pointer_shape
= Qnil
;
5732 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
5733 "A string indicating the foreground color of the cursor box.");
5734 Vx_cursor_fore_pixel
= Qnil
;
5736 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
5737 "Non-nil if no window manager is in use.\n\
5738 Emacs doesn't try to figure this out; this is always nil\n\
5739 unless you set it to something else.");
5740 /* We don't have any way to find this out, so set it to nil
5741 and maybe the user would like to set it to t. */
5742 Vx_no_window_manager
= Qnil
;
5744 defsubr (&Sx_get_resource
);
5745 defsubr (&Sx_list_fonts
);
5746 defsubr (&Sx_display_color_p
);
5747 defsubr (&Sx_display_grayscale_p
);
5748 defsubr (&Sx_color_defined_p
);
5749 defsubr (&Sx_color_values
);
5750 defsubr (&Sx_server_max_request_size
);
5751 defsubr (&Sx_server_vendor
);
5752 defsubr (&Sx_server_version
);
5753 defsubr (&Sx_display_pixel_width
);
5754 defsubr (&Sx_display_pixel_height
);
5755 defsubr (&Sx_display_mm_width
);
5756 defsubr (&Sx_display_mm_height
);
5757 defsubr (&Sx_display_screens
);
5758 defsubr (&Sx_display_planes
);
5759 defsubr (&Sx_display_color_cells
);
5760 defsubr (&Sx_display_visual_class
);
5761 defsubr (&Sx_display_backing_store
);
5762 defsubr (&Sx_display_save_under
);
5763 defsubr (&Sx_parse_geometry
);
5764 defsubr (&Sx_create_frame
);
5765 defsubr (&Sx_open_connection
);
5766 defsubr (&Sx_close_connection
);
5767 defsubr (&Sx_display_list
);
5768 defsubr (&Sx_synchronize
);
5770 /* W32 specific functions */
5772 defsubr (&Sw32_focus_frame
);
5773 defsubr (&Sw32_select_font
);
5774 defsubr (&Sw32_define_rgb_color
);
5775 defsubr (&Sw32_default_color_map
);
5776 defsubr (&Sw32_load_color_file
);
5777 defsubr (&Sw32_send_sys_command
);
5786 button
= MessageBox (NULL
,
5787 "A fatal error has occurred!\n\n"
5788 "Select Abort to exit, Retry to debug, Ignore to continue",
5789 "Emacs Abort Dialog",
5790 MB_ICONEXCLAMATION
| MB_TASKMODAL
5791 | MB_SETFOREGROUND
| MB_ABORTRETRYIGNORE
);