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 */
32 #include "dispextern.h"
34 #include "blockinput.h"
37 #include "termhooks.h"
42 extern void free_frame_menubar ();
43 extern struct scroll_bar
*x_window_to_scroll_bar ();
46 /* The colormap for converting color names to RGB values */
47 Lisp_Object Vw32_color_map
;
49 /* Non nil if alt key presses are passed on to Windows. */
50 Lisp_Object Vw32_pass_alt_to_system
;
52 /* Non nil if alt key is translated to meta_modifier, nil if it is translated
54 Lisp_Object Vw32_alt_is_meta
;
56 /* Non nil if left window, right window, and application key events
57 are passed on to Windows. */
58 Lisp_Object Vw32_pass_optional_keys_to_system
;
60 /* Switch to control whether we inhibit requests for italicised fonts (which
61 are synthesized, look ugly, and are trashed by cursor movement under NT). */
62 Lisp_Object Vw32_enable_italics
;
64 /* Enable palette management. */
65 Lisp_Object Vw32_enable_palette
;
67 /* Control how close left/right button down events must be to
68 be converted to a middle button down event. */
69 Lisp_Object Vw32_mouse_button_tolerance
;
71 /* Minimum interval between mouse movement (and scroll bar drag)
72 events that are passed on to the event loop. */
73 Lisp_Object Vw32_mouse_move_interval
;
75 /* The name we're using in resource queries. */
76 Lisp_Object Vx_resource_name
;
78 /* Non nil if no window manager is in use. */
79 Lisp_Object Vx_no_window_manager
;
81 /* The background and shape of the mouse pointer, and shape when not
82 over text or in the modeline. */
83 Lisp_Object Vx_pointer_shape
, Vx_nontext_pointer_shape
, Vx_mode_pointer_shape
;
84 /* The shape when over mouse-sensitive text. */
85 Lisp_Object Vx_sensitive_text_pointer_shape
;
87 /* Color of chars displayed in cursor box. */
88 Lisp_Object Vx_cursor_fore_pixel
;
90 /* Search path for bitmap files. */
91 Lisp_Object Vx_bitmap_file_path
;
93 /* Evaluate this expression to rebuild the section of syms_of_w32fns
94 that initializes and staticpros the symbols declared below. Note
95 that Emacs 18 has a bug that keeps C-x C-e from being able to
96 evaluate this expression.
99 ;; Accumulate a list of the symbols we want to initialize from the
100 ;; declarations at the top of the file.
101 (goto-char (point-min))
102 (search-forward "/\*&&& symbols declared here &&&*\/\n")
104 (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)")
106 (cons (buffer-substring (match-beginning 1) (match-end 1))
109 (setq symbol-list (nreverse symbol-list))
110 ;; Delete the section of syms_of_... where we initialize the symbols.
111 (search-forward "\n /\*&&& init symbols here &&&*\/\n")
112 (let ((start (point)))
113 (while (looking-at "^ Q")
115 (kill-region start (point)))
116 ;; Write a new symbol initialization section.
118 (insert (format " %s = intern (\"" (car symbol-list)))
119 (let ((start (point)))
120 (insert (substring (car symbol-list) 1))
121 (subst-char-in-region start (point) ?_ ?-))
122 (insert (format "\");\n staticpro (&%s);\n" (car symbol-list)))
123 (setq symbol-list (cdr symbol-list)))))
127 /*&&& symbols declared here &&&*/
128 Lisp_Object Qauto_raise
;
129 Lisp_Object Qauto_lower
;
130 Lisp_Object Qbackground_color
;
132 Lisp_Object Qborder_color
;
133 Lisp_Object Qborder_width
;
135 Lisp_Object Qcursor_color
;
136 Lisp_Object Qcursor_type
;
137 Lisp_Object Qforeground_color
;
138 Lisp_Object Qgeometry
;
139 Lisp_Object Qicon_left
;
140 Lisp_Object Qicon_top
;
141 Lisp_Object Qicon_type
;
142 Lisp_Object Qicon_name
;
143 Lisp_Object Qinternal_border_width
;
146 Lisp_Object Qmouse_color
;
148 Lisp_Object Qparent_id
;
149 Lisp_Object Qscroll_bar_width
;
150 Lisp_Object Qsuppress_icon
;
152 Lisp_Object Qundefined_color
;
153 Lisp_Object Qvertical_scroll_bars
;
154 Lisp_Object Qvisibility
;
155 Lisp_Object Qwindow_id
;
156 Lisp_Object Qx_frame_parameter
;
157 Lisp_Object Qx_resource_name
;
158 Lisp_Object Quser_position
;
159 Lisp_Object Quser_size
;
160 Lisp_Object Qdisplay
;
162 /* State variables for emulating a three button mouse. */
167 static int button_state
= 0;
168 static W32Msg saved_mouse_button_msg
;
169 static unsigned mouse_button_timer
; /* non-zero when timer is active */
170 static W32Msg saved_mouse_move_msg
;
171 static unsigned mouse_move_timer
;
173 #define MOUSE_BUTTON_ID 1
174 #define MOUSE_MOVE_ID 2
176 /* The below are defined in frame.c. */
177 extern Lisp_Object Qheight
, Qminibuffer
, Qname
, Qonly
, Qwidth
;
178 extern Lisp_Object Qunsplittable
, Qmenu_bar_lines
;
180 extern Lisp_Object Vwindow_system_version
;
182 extern Lisp_Object last_mouse_scroll_bar
;
183 extern int last_mouse_scroll_bar_pos
;
185 /* From w32term.c. */
186 extern Lisp_Object Vw32_num_mouse_buttons
;
188 Time last_mouse_movement_time
;
191 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
192 and checking validity for W32. */
195 check_x_frame (frame
)
204 CHECK_LIVE_FRAME (frame
, 0);
207 if (! FRAME_W32_P (f
))
208 error ("non-w32 frame used");
212 /* Let the user specify an display with a frame.
213 nil stands for the selected frame--or, if that is not a w32 frame,
214 the first display on the list. */
216 static struct w32_display_info
*
217 check_x_display_info (frame
)
222 if (FRAME_W32_P (selected_frame
))
223 return FRAME_W32_DISPLAY_INFO (selected_frame
);
225 return &one_w32_display_info
;
227 else if (STRINGP (frame
))
228 return x_display_info_for_name (frame
);
233 CHECK_LIVE_FRAME (frame
, 0);
235 if (! FRAME_W32_P (f
))
236 error ("non-w32 frame used");
237 return FRAME_W32_DISPLAY_INFO (f
);
241 /* Return the Emacs frame-object corresponding to an w32 window.
242 It could be the frame's main window or an icon window. */
244 /* This function can be called during GC, so use GC_xxx type test macros. */
247 x_window_to_frame (dpyinfo
, wdesc
)
248 struct w32_display_info
*dpyinfo
;
251 Lisp_Object tail
, frame
;
254 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
256 frame
= XCONS (tail
)->car
;
257 if (!GC_FRAMEP (frame
))
260 if (f
->output_data
.nothing
== 1
261 || FRAME_W32_DISPLAY_INFO (f
) != dpyinfo
)
263 if (FRAME_W32_WINDOW (f
) == wdesc
)
271 /* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
272 id, which is just an int that this section returns. Bitmaps are
273 reference counted so they can be shared among frames.
275 Bitmap indices are guaranteed to be > 0, so a negative number can
276 be used to indicate no bitmap.
278 If you use x_create_bitmap_from_data, then you must keep track of
279 the bitmaps yourself. That is, creating a bitmap from the same
280 data more than once will not be caught. */
283 /* Functions to access the contents of a bitmap, given an id. */
286 x_bitmap_height (f
, id
)
290 return FRAME_W32_DISPLAY_INFO (f
)->bitmaps
[id
- 1].height
;
294 x_bitmap_width (f
, id
)
298 return FRAME_W32_DISPLAY_INFO (f
)->bitmaps
[id
- 1].width
;
302 x_bitmap_pixmap (f
, id
)
306 return (int) FRAME_W32_DISPLAY_INFO (f
)->bitmaps
[id
- 1].pixmap
;
310 /* Allocate a new bitmap record. Returns index of new record. */
313 x_allocate_bitmap_record (f
)
316 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
319 if (dpyinfo
->bitmaps
== NULL
)
321 dpyinfo
->bitmaps_size
= 10;
323 = (struct w32_bitmap_record
*) xmalloc (dpyinfo
->bitmaps_size
* sizeof (struct w32_bitmap_record
));
324 dpyinfo
->bitmaps_last
= 1;
328 if (dpyinfo
->bitmaps_last
< dpyinfo
->bitmaps_size
)
329 return ++dpyinfo
->bitmaps_last
;
331 for (i
= 0; i
< dpyinfo
->bitmaps_size
; ++i
)
332 if (dpyinfo
->bitmaps
[i
].refcount
== 0)
335 dpyinfo
->bitmaps_size
*= 2;
337 = (struct w32_bitmap_record
*) xrealloc (dpyinfo
->bitmaps
,
338 dpyinfo
->bitmaps_size
* sizeof (struct w32_bitmap_record
));
339 return ++dpyinfo
->bitmaps_last
;
342 /* Add one reference to the reference count of the bitmap with id ID. */
345 x_reference_bitmap (f
, id
)
349 ++FRAME_W32_DISPLAY_INFO (f
)->bitmaps
[id
- 1].refcount
;
352 /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
355 x_create_bitmap_from_data (f
, bits
, width
, height
)
358 unsigned int width
, height
;
360 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
364 bitmap
= CreateBitmap (width
, height
,
365 FRAME_W32_DISPLAY_INFO (XFRAME (frame
))->n_planes
,
366 FRAME_W32_DISPLAY_INFO (XFRAME (frame
))->n_cbits
,
372 id
= x_allocate_bitmap_record (f
);
373 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
374 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
375 dpyinfo
->bitmaps
[id
- 1].hinst
= NULL
;
376 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
377 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
378 dpyinfo
->bitmaps
[id
- 1].height
= height
;
379 dpyinfo
->bitmaps
[id
- 1].width
= width
;
384 /* Create bitmap from file FILE for frame F. */
387 x_create_bitmap_from_file (f
, file
)
393 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
394 unsigned int width
, height
;
396 int xhot
, yhot
, result
, id
;
402 /* Look for an existing bitmap with the same name. */
403 for (id
= 0; id
< dpyinfo
->bitmaps_last
; ++id
)
405 if (dpyinfo
->bitmaps
[id
].refcount
406 && dpyinfo
->bitmaps
[id
].file
407 && !strcmp (dpyinfo
->bitmaps
[id
].file
, (char *) XSTRING (file
)->data
))
409 ++dpyinfo
->bitmaps
[id
].refcount
;
414 /* Search bitmap-file-path for the file, if appropriate. */
415 fd
= openp (Vx_bitmap_file_path
, file
, "", &found
, 0);
420 filename
= (char *) XSTRING (found
)->data
;
422 hinst
= LoadLibraryEx (filename
, NULL
, LOAD_LIBRARY_AS_DATAFILE
);
428 result
= XReadBitmapFile (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
429 filename
, &width
, &height
, &bitmap
, &xhot
, &yhot
);
430 if (result
!= BitmapSuccess
)
433 id
= x_allocate_bitmap_record (f
);
434 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
435 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
436 dpyinfo
->bitmaps
[id
- 1].file
= (char *) xmalloc (XSTRING (file
)->size
+ 1);
437 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
438 dpyinfo
->bitmaps
[id
- 1].height
= height
;
439 dpyinfo
->bitmaps
[id
- 1].width
= width
;
440 strcpy (dpyinfo
->bitmaps
[id
- 1].file
, XSTRING (file
)->data
);
446 /* Remove reference to bitmap with id number ID. */
449 x_destroy_bitmap (f
, id
)
453 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
457 --dpyinfo
->bitmaps
[id
- 1].refcount
;
458 if (dpyinfo
->bitmaps
[id
- 1].refcount
== 0)
461 DeleteObject (dpyinfo
->bitmaps
[id
- 1].pixmap
);
462 if (dpyinfo
->bitmaps
[id
- 1].file
)
464 free (dpyinfo
->bitmaps
[id
- 1].file
);
465 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
472 /* Free all the bitmaps for the display specified by DPYINFO. */
475 x_destroy_all_bitmaps (dpyinfo
)
476 struct w32_display_info
*dpyinfo
;
479 for (i
= 0; i
< dpyinfo
->bitmaps_last
; i
++)
480 if (dpyinfo
->bitmaps
[i
].refcount
> 0)
482 DeleteObject (dpyinfo
->bitmaps
[i
].pixmap
);
483 if (dpyinfo
->bitmaps
[i
].file
)
484 free (dpyinfo
->bitmaps
[i
].file
);
486 dpyinfo
->bitmaps_last
= 0;
489 /* Connect the frame-parameter names for W32 frames
490 to the ways of passing the parameter values to the window system.
492 The name of a parameter, as a Lisp symbol,
493 has an `x-frame-parameter' property which is an integer in Lisp
494 but can be interpreted as an `enum x_frame_parm' in C. */
498 X_PARM_FOREGROUND_COLOR
,
499 X_PARM_BACKGROUND_COLOR
,
506 X_PARM_INTERNAL_BORDER_WIDTH
,
510 X_PARM_VERT_SCROLL_BAR
,
512 X_PARM_MENU_BAR_LINES
516 struct x_frame_parm_table
519 void (*setter
)( /* struct frame *frame, Lisp_Object val, oldval */ );
522 void x_set_foreground_color ();
523 void x_set_background_color ();
524 void x_set_mouse_color ();
525 void x_set_cursor_color ();
526 void x_set_border_color ();
527 void x_set_cursor_type ();
528 void x_set_icon_type ();
529 void x_set_icon_name ();
531 void x_set_border_width ();
532 void x_set_internal_border_width ();
533 void x_explicitly_set_name ();
534 void x_set_autoraise ();
535 void x_set_autolower ();
536 void x_set_vertical_scroll_bars ();
537 void x_set_visibility ();
538 void x_set_menu_bar_lines ();
539 void x_set_scroll_bar_width ();
540 void x_set_unsplittable ();
542 static struct x_frame_parm_table x_frame_parms
[] =
544 "foreground-color", x_set_foreground_color
,
545 "background-color", x_set_background_color
,
546 "mouse-color", x_set_mouse_color
,
547 "cursor-color", x_set_cursor_color
,
548 "border-color", x_set_border_color
,
549 "cursor-type", x_set_cursor_type
,
550 "icon-type", x_set_icon_type
,
551 "icon-name", x_set_icon_name
,
553 "border-width", x_set_border_width
,
554 "internal-border-width", x_set_internal_border_width
,
555 "name", x_explicitly_set_name
,
556 "auto-raise", x_set_autoraise
,
557 "auto-lower", x_set_autolower
,
558 "vertical-scroll-bars", x_set_vertical_scroll_bars
,
559 "visibility", x_set_visibility
,
560 "menu-bar-lines", x_set_menu_bar_lines
,
561 "scroll-bar-width", x_set_scroll_bar_width
,
562 "unsplittable", x_set_unsplittable
,
565 /* Attach the `x-frame-parameter' properties to
566 the Lisp symbol names of parameters relevant to W32. */
568 init_x_parm_symbols ()
572 for (i
= 0; i
< sizeof (x_frame_parms
) / sizeof (x_frame_parms
[0]); i
++)
573 Fput (intern (x_frame_parms
[i
].name
), Qx_frame_parameter
,
577 /* Change the parameters of FRAME as specified by ALIST.
578 If a parameter is not specially recognized, do nothing;
579 otherwise call the `x_set_...' function for that parameter. */
582 x_set_frame_parameters (f
, alist
)
588 /* If both of these parameters are present, it's more efficient to
589 set them both at once. So we wait until we've looked at the
590 entire list before we set them. */
594 Lisp_Object left
, top
;
596 /* Same with these. */
597 Lisp_Object icon_left
, icon_top
;
599 /* Record in these vectors all the parms specified. */
603 int left_no_change
= 0, top_no_change
= 0;
604 int icon_left_no_change
= 0, icon_top_no_change
= 0;
607 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
610 parms
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
611 values
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
613 /* Extract parm names and values into those vectors. */
616 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
618 Lisp_Object elt
, prop
, val
;
621 parms
[i
] = Fcar (elt
);
622 values
[i
] = Fcdr (elt
);
626 top
= left
= Qunbound
;
627 icon_left
= icon_top
= Qunbound
;
629 /* Provide default values for HEIGHT and WIDTH. */
630 width
= FRAME_WIDTH (f
);
631 height
= FRAME_HEIGHT (f
);
633 /* Now process them in reverse of specified order. */
634 for (i
--; i
>= 0; i
--)
636 Lisp_Object prop
, val
;
641 if (EQ (prop
, Qwidth
) && NUMBERP (val
))
642 width
= XFASTINT (val
);
643 else if (EQ (prop
, Qheight
) && NUMBERP (val
))
644 height
= XFASTINT (val
);
645 else if (EQ (prop
, Qtop
))
647 else if (EQ (prop
, Qleft
))
649 else if (EQ (prop
, Qicon_top
))
651 else if (EQ (prop
, Qicon_left
))
655 register Lisp_Object param_index
, old_value
;
657 param_index
= Fget (prop
, Qx_frame_parameter
);
658 old_value
= get_frame_param (f
, prop
);
659 store_frame_param (f
, prop
, val
);
660 if (NATNUMP (param_index
)
661 && (XFASTINT (param_index
)
662 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
663 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
667 /* Don't die if just one of these was set. */
668 if (EQ (left
, Qunbound
))
671 if (f
->output_data
.w32
->left_pos
< 0)
672 left
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.w32
->left_pos
), Qnil
));
674 XSETINT (left
, f
->output_data
.w32
->left_pos
);
676 if (EQ (top
, Qunbound
))
679 if (f
->output_data
.w32
->top_pos
< 0)
680 top
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.w32
->top_pos
), Qnil
));
682 XSETINT (top
, f
->output_data
.w32
->top_pos
);
685 /* If one of the icon positions was not set, preserve or default it. */
686 if (EQ (icon_left
, Qunbound
) || ! INTEGERP (icon_left
))
688 icon_left_no_change
= 1;
689 icon_left
= Fcdr (Fassq (Qicon_left
, f
->param_alist
));
690 if (NILP (icon_left
))
691 XSETINT (icon_left
, 0);
693 if (EQ (icon_top
, Qunbound
) || ! INTEGERP (icon_top
))
695 icon_top_no_change
= 1;
696 icon_top
= Fcdr (Fassq (Qicon_top
, f
->param_alist
));
698 XSETINT (icon_top
, 0);
701 /* Don't set these parameters unless they've been explicitly
702 specified. The window might be mapped or resized while we're in
703 this function, and we don't want to override that unless the lisp
704 code has asked for it.
706 Don't set these parameters unless they actually differ from the
707 window's current parameters; the window may not actually exist
712 check_frame_size (f
, &height
, &width
);
714 XSETFRAME (frame
, f
);
716 if (XINT (width
) != FRAME_WIDTH (f
)
717 || XINT (height
) != FRAME_HEIGHT (f
))
718 Fset_frame_size (frame
, make_number (width
), make_number (height
));
720 if ((!NILP (left
) || !NILP (top
))
721 && ! (left_no_change
&& top_no_change
)
722 && ! (NUMBERP (left
) && XINT (left
) == f
->output_data
.w32
->left_pos
723 && NUMBERP (top
) && XINT (top
) == f
->output_data
.w32
->top_pos
))
728 /* Record the signs. */
729 f
->output_data
.w32
->size_hint_flags
&= ~ (XNegative
| YNegative
);
730 if (EQ (left
, Qminus
))
731 f
->output_data
.w32
->size_hint_flags
|= XNegative
;
732 else if (INTEGERP (left
))
734 leftpos
= XINT (left
);
736 f
->output_data
.w32
->size_hint_flags
|= XNegative
;
738 else if (CONSP (left
) && EQ (XCONS (left
)->car
, Qminus
)
739 && CONSP (XCONS (left
)->cdr
)
740 && INTEGERP (XCONS (XCONS (left
)->cdr
)->car
))
742 leftpos
= - XINT (XCONS (XCONS (left
)->cdr
)->car
);
743 f
->output_data
.w32
->size_hint_flags
|= XNegative
;
745 else if (CONSP (left
) && EQ (XCONS (left
)->car
, Qplus
)
746 && CONSP (XCONS (left
)->cdr
)
747 && INTEGERP (XCONS (XCONS (left
)->cdr
)->car
))
749 leftpos
= XINT (XCONS (XCONS (left
)->cdr
)->car
);
752 if (EQ (top
, Qminus
))
753 f
->output_data
.w32
->size_hint_flags
|= YNegative
;
754 else if (INTEGERP (top
))
758 f
->output_data
.w32
->size_hint_flags
|= YNegative
;
760 else if (CONSP (top
) && EQ (XCONS (top
)->car
, Qminus
)
761 && CONSP (XCONS (top
)->cdr
)
762 && INTEGERP (XCONS (XCONS (top
)->cdr
)->car
))
764 toppos
= - XINT (XCONS (XCONS (top
)->cdr
)->car
);
765 f
->output_data
.w32
->size_hint_flags
|= YNegative
;
767 else if (CONSP (top
) && EQ (XCONS (top
)->car
, Qplus
)
768 && CONSP (XCONS (top
)->cdr
)
769 && INTEGERP (XCONS (XCONS (top
)->cdr
)->car
))
771 toppos
= XINT (XCONS (XCONS (top
)->cdr
)->car
);
775 /* Store the numeric value of the position. */
776 f
->output_data
.w32
->top_pos
= toppos
;
777 f
->output_data
.w32
->left_pos
= leftpos
;
779 f
->output_data
.w32
->win_gravity
= NorthWestGravity
;
781 /* Actually set that position, and convert to absolute. */
782 x_set_offset (f
, leftpos
, toppos
, -1);
785 if ((!NILP (icon_left
) || !NILP (icon_top
))
786 && ! (icon_left_no_change
&& icon_top_no_change
))
787 x_wm_set_icon_position (f
, XINT (icon_left
), XINT (icon_top
));
791 /* Store the screen positions of frame F into XPTR and YPTR.
792 These are the positions of the containing window manager window,
793 not Emacs's own window. */
796 x_real_positions (f
, xptr
, yptr
)
805 GetClientRect(FRAME_W32_WINDOW(f
), &rect
);
806 AdjustWindowRect(&rect
, f
->output_data
.w32
->dwStyle
, FRAME_EXTERNAL_MENU_BAR(f
));
812 ClientToScreen (FRAME_W32_WINDOW(f
), &pt
);
818 /* Insert a description of internally-recorded parameters of frame X
819 into the parameter alist *ALISTPTR that is to be given to the user.
820 Only parameters that are specific to W32
821 and whose values are not correctly recorded in the frame's
822 param_alist need to be considered here. */
824 x_report_frame_params (f
, alistptr
)
826 Lisp_Object
*alistptr
;
831 /* Represent negative positions (off the top or left screen edge)
832 in a way that Fmodify_frame_parameters will understand correctly. */
833 XSETINT (tem
, f
->output_data
.w32
->left_pos
);
834 if (f
->output_data
.w32
->left_pos
>= 0)
835 store_in_alist (alistptr
, Qleft
, tem
);
837 store_in_alist (alistptr
, Qleft
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
839 XSETINT (tem
, f
->output_data
.w32
->top_pos
);
840 if (f
->output_data
.w32
->top_pos
>= 0)
841 store_in_alist (alistptr
, Qtop
, tem
);
843 store_in_alist (alistptr
, Qtop
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
845 store_in_alist (alistptr
, Qborder_width
,
846 make_number (f
->output_data
.w32
->border_width
));
847 store_in_alist (alistptr
, Qinternal_border_width
,
848 make_number (f
->output_data
.w32
->internal_border_width
));
849 sprintf (buf
, "%ld", (long) FRAME_W32_WINDOW (f
));
850 store_in_alist (alistptr
, Qwindow_id
,
852 store_in_alist (alistptr
, Qicon_name
, f
->icon_name
);
853 FRAME_SAMPLE_VISIBILITY (f
);
854 store_in_alist (alistptr
, Qvisibility
,
855 (FRAME_VISIBLE_P (f
) ? Qt
856 : FRAME_ICONIFIED_P (f
) ? Qicon
: Qnil
));
857 store_in_alist (alistptr
, Qdisplay
,
858 XCONS (FRAME_W32_DISPLAY_INFO (f
)->name_list_element
)->car
);
862 DEFUN ("w32-define-rgb-color", Fw32_define_rgb_color
, Sw32_define_rgb_color
, 4, 4, 0,
863 "Convert RGB numbers to a windows color reference and associate with NAME (a string).\n\
864 This adds or updates a named color to w32-color-map, making it available for use.\n\
865 The original entry's RGB ref is returned, or nil if the entry is new.")
866 (red
, green
, blue
, name
)
867 Lisp_Object red
, green
, blue
, name
;
870 Lisp_Object oldrgb
= Qnil
;
873 CHECK_NUMBER (red
, 0);
874 CHECK_NUMBER (green
, 0);
875 CHECK_NUMBER (blue
, 0);
876 CHECK_STRING (name
, 0);
878 XSET (rgb
, Lisp_Int
, RGB(XUINT (red
), XUINT (green
), XUINT (blue
)));
882 /* replace existing entry in w32-color-map or add new entry. */
883 entry
= Fassoc (name
, Vw32_color_map
);
886 entry
= Fcons (name
, rgb
);
887 Vw32_color_map
= Fcons (entry
, Vw32_color_map
);
891 oldrgb
= Fcdr (entry
);
892 Fsetcdr (entry
, rgb
);
900 DEFUN ("w32-load-color-file", Fw32_load_color_file
, Sw32_load_color_file
, 1, 1, 0,
901 "Create an alist of color entries from an external file (ie. rgb.txt).\n\
902 Assign this value to w32-color-map to replace the existing color map.\n\
904 The file should define one named RGB color per line like so:\
906 where R,G,B are numbers between 0 and 255 and name is an arbitrary string.")
908 Lisp_Object filename
;
911 Lisp_Object cmap
= Qnil
;
914 CHECK_STRING (filename
, 0);
915 abspath
= Fexpand_file_name (filename
, Qnil
);
917 fp
= fopen (XSTRING (filename
)->data
, "rt");
921 int red
, green
, blue
;
926 while (fgets (buf
, sizeof (buf
), fp
) != NULL
) {
927 if (sscanf (buf
, "%u %u %u %n", &red
, &green
, &blue
, &num
) == 3)
929 char *name
= buf
+ num
;
930 num
= strlen (name
) - 1;
931 if (name
[num
] == '\n')
933 cmap
= Fcons (Fcons (build_string (name
),
934 make_number (RGB (red
, green
, blue
))),
946 /* The default colors for the w32 color map */
947 typedef struct colormap_t
953 colormap_t w32_color_map
[] =
955 {"snow" , PALETTERGB (255,250,250)},
956 {"ghost white" , PALETTERGB (248,248,255)},
957 {"GhostWhite" , PALETTERGB (248,248,255)},
958 {"white smoke" , PALETTERGB (245,245,245)},
959 {"WhiteSmoke" , PALETTERGB (245,245,245)},
960 {"gainsboro" , PALETTERGB (220,220,220)},
961 {"floral white" , PALETTERGB (255,250,240)},
962 {"FloralWhite" , PALETTERGB (255,250,240)},
963 {"old lace" , PALETTERGB (253,245,230)},
964 {"OldLace" , PALETTERGB (253,245,230)},
965 {"linen" , PALETTERGB (250,240,230)},
966 {"antique white" , PALETTERGB (250,235,215)},
967 {"AntiqueWhite" , PALETTERGB (250,235,215)},
968 {"papaya whip" , PALETTERGB (255,239,213)},
969 {"PapayaWhip" , PALETTERGB (255,239,213)},
970 {"blanched almond" , PALETTERGB (255,235,205)},
971 {"BlanchedAlmond" , PALETTERGB (255,235,205)},
972 {"bisque" , PALETTERGB (255,228,196)},
973 {"peach puff" , PALETTERGB (255,218,185)},
974 {"PeachPuff" , PALETTERGB (255,218,185)},
975 {"navajo white" , PALETTERGB (255,222,173)},
976 {"NavajoWhite" , PALETTERGB (255,222,173)},
977 {"moccasin" , PALETTERGB (255,228,181)},
978 {"cornsilk" , PALETTERGB (255,248,220)},
979 {"ivory" , PALETTERGB (255,255,240)},
980 {"lemon chiffon" , PALETTERGB (255,250,205)},
981 {"LemonChiffon" , PALETTERGB (255,250,205)},
982 {"seashell" , PALETTERGB (255,245,238)},
983 {"honeydew" , PALETTERGB (240,255,240)},
984 {"mint cream" , PALETTERGB (245,255,250)},
985 {"MintCream" , PALETTERGB (245,255,250)},
986 {"azure" , PALETTERGB (240,255,255)},
987 {"alice blue" , PALETTERGB (240,248,255)},
988 {"AliceBlue" , PALETTERGB (240,248,255)},
989 {"lavender" , PALETTERGB (230,230,250)},
990 {"lavender blush" , PALETTERGB (255,240,245)},
991 {"LavenderBlush" , PALETTERGB (255,240,245)},
992 {"misty rose" , PALETTERGB (255,228,225)},
993 {"MistyRose" , PALETTERGB (255,228,225)},
994 {"white" , PALETTERGB (255,255,255)},
995 {"black" , PALETTERGB ( 0, 0, 0)},
996 {"dark slate gray" , PALETTERGB ( 47, 79, 79)},
997 {"DarkSlateGray" , PALETTERGB ( 47, 79, 79)},
998 {"dark slate grey" , PALETTERGB ( 47, 79, 79)},
999 {"DarkSlateGrey" , PALETTERGB ( 47, 79, 79)},
1000 {"dim gray" , PALETTERGB (105,105,105)},
1001 {"DimGray" , PALETTERGB (105,105,105)},
1002 {"dim grey" , PALETTERGB (105,105,105)},
1003 {"DimGrey" , PALETTERGB (105,105,105)},
1004 {"slate gray" , PALETTERGB (112,128,144)},
1005 {"SlateGray" , PALETTERGB (112,128,144)},
1006 {"slate grey" , PALETTERGB (112,128,144)},
1007 {"SlateGrey" , PALETTERGB (112,128,144)},
1008 {"light slate gray" , PALETTERGB (119,136,153)},
1009 {"LightSlateGray" , PALETTERGB (119,136,153)},
1010 {"light slate grey" , PALETTERGB (119,136,153)},
1011 {"LightSlateGrey" , PALETTERGB (119,136,153)},
1012 {"gray" , PALETTERGB (190,190,190)},
1013 {"grey" , PALETTERGB (190,190,190)},
1014 {"light grey" , PALETTERGB (211,211,211)},
1015 {"LightGrey" , PALETTERGB (211,211,211)},
1016 {"light gray" , PALETTERGB (211,211,211)},
1017 {"LightGray" , PALETTERGB (211,211,211)},
1018 {"midnight blue" , PALETTERGB ( 25, 25,112)},
1019 {"MidnightBlue" , PALETTERGB ( 25, 25,112)},
1020 {"navy" , PALETTERGB ( 0, 0,128)},
1021 {"navy blue" , PALETTERGB ( 0, 0,128)},
1022 {"NavyBlue" , PALETTERGB ( 0, 0,128)},
1023 {"cornflower blue" , PALETTERGB (100,149,237)},
1024 {"CornflowerBlue" , PALETTERGB (100,149,237)},
1025 {"dark slate blue" , PALETTERGB ( 72, 61,139)},
1026 {"DarkSlateBlue" , PALETTERGB ( 72, 61,139)},
1027 {"slate blue" , PALETTERGB (106, 90,205)},
1028 {"SlateBlue" , PALETTERGB (106, 90,205)},
1029 {"medium slate blue" , PALETTERGB (123,104,238)},
1030 {"MediumSlateBlue" , PALETTERGB (123,104,238)},
1031 {"light slate blue" , PALETTERGB (132,112,255)},
1032 {"LightSlateBlue" , PALETTERGB (132,112,255)},
1033 {"medium blue" , PALETTERGB ( 0, 0,205)},
1034 {"MediumBlue" , PALETTERGB ( 0, 0,205)},
1035 {"royal blue" , PALETTERGB ( 65,105,225)},
1036 {"RoyalBlue" , PALETTERGB ( 65,105,225)},
1037 {"blue" , PALETTERGB ( 0, 0,255)},
1038 {"dodger blue" , PALETTERGB ( 30,144,255)},
1039 {"DodgerBlue" , PALETTERGB ( 30,144,255)},
1040 {"deep sky blue" , PALETTERGB ( 0,191,255)},
1041 {"DeepSkyBlue" , PALETTERGB ( 0,191,255)},
1042 {"sky blue" , PALETTERGB (135,206,235)},
1043 {"SkyBlue" , PALETTERGB (135,206,235)},
1044 {"light sky blue" , PALETTERGB (135,206,250)},
1045 {"LightSkyBlue" , PALETTERGB (135,206,250)},
1046 {"steel blue" , PALETTERGB ( 70,130,180)},
1047 {"SteelBlue" , PALETTERGB ( 70,130,180)},
1048 {"light steel blue" , PALETTERGB (176,196,222)},
1049 {"LightSteelBlue" , PALETTERGB (176,196,222)},
1050 {"light blue" , PALETTERGB (173,216,230)},
1051 {"LightBlue" , PALETTERGB (173,216,230)},
1052 {"powder blue" , PALETTERGB (176,224,230)},
1053 {"PowderBlue" , PALETTERGB (176,224,230)},
1054 {"pale turquoise" , PALETTERGB (175,238,238)},
1055 {"PaleTurquoise" , PALETTERGB (175,238,238)},
1056 {"dark turquoise" , PALETTERGB ( 0,206,209)},
1057 {"DarkTurquoise" , PALETTERGB ( 0,206,209)},
1058 {"medium turquoise" , PALETTERGB ( 72,209,204)},
1059 {"MediumTurquoise" , PALETTERGB ( 72,209,204)},
1060 {"turquoise" , PALETTERGB ( 64,224,208)},
1061 {"cyan" , PALETTERGB ( 0,255,255)},
1062 {"light cyan" , PALETTERGB (224,255,255)},
1063 {"LightCyan" , PALETTERGB (224,255,255)},
1064 {"cadet blue" , PALETTERGB ( 95,158,160)},
1065 {"CadetBlue" , PALETTERGB ( 95,158,160)},
1066 {"medium aquamarine" , PALETTERGB (102,205,170)},
1067 {"MediumAquamarine" , PALETTERGB (102,205,170)},
1068 {"aquamarine" , PALETTERGB (127,255,212)},
1069 {"dark green" , PALETTERGB ( 0,100, 0)},
1070 {"DarkGreen" , PALETTERGB ( 0,100, 0)},
1071 {"dark olive green" , PALETTERGB ( 85,107, 47)},
1072 {"DarkOliveGreen" , PALETTERGB ( 85,107, 47)},
1073 {"dark sea green" , PALETTERGB (143,188,143)},
1074 {"DarkSeaGreen" , PALETTERGB (143,188,143)},
1075 {"sea green" , PALETTERGB ( 46,139, 87)},
1076 {"SeaGreen" , PALETTERGB ( 46,139, 87)},
1077 {"medium sea green" , PALETTERGB ( 60,179,113)},
1078 {"MediumSeaGreen" , PALETTERGB ( 60,179,113)},
1079 {"light sea green" , PALETTERGB ( 32,178,170)},
1080 {"LightSeaGreen" , PALETTERGB ( 32,178,170)},
1081 {"pale green" , PALETTERGB (152,251,152)},
1082 {"PaleGreen" , PALETTERGB (152,251,152)},
1083 {"spring green" , PALETTERGB ( 0,255,127)},
1084 {"SpringGreen" , PALETTERGB ( 0,255,127)},
1085 {"lawn green" , PALETTERGB (124,252, 0)},
1086 {"LawnGreen" , PALETTERGB (124,252, 0)},
1087 {"green" , PALETTERGB ( 0,255, 0)},
1088 {"chartreuse" , PALETTERGB (127,255, 0)},
1089 {"medium spring green" , PALETTERGB ( 0,250,154)},
1090 {"MediumSpringGreen" , PALETTERGB ( 0,250,154)},
1091 {"green yellow" , PALETTERGB (173,255, 47)},
1092 {"GreenYellow" , PALETTERGB (173,255, 47)},
1093 {"lime green" , PALETTERGB ( 50,205, 50)},
1094 {"LimeGreen" , PALETTERGB ( 50,205, 50)},
1095 {"yellow green" , PALETTERGB (154,205, 50)},
1096 {"YellowGreen" , PALETTERGB (154,205, 50)},
1097 {"forest green" , PALETTERGB ( 34,139, 34)},
1098 {"ForestGreen" , PALETTERGB ( 34,139, 34)},
1099 {"olive drab" , PALETTERGB (107,142, 35)},
1100 {"OliveDrab" , PALETTERGB (107,142, 35)},
1101 {"dark khaki" , PALETTERGB (189,183,107)},
1102 {"DarkKhaki" , PALETTERGB (189,183,107)},
1103 {"khaki" , PALETTERGB (240,230,140)},
1104 {"pale goldenrod" , PALETTERGB (238,232,170)},
1105 {"PaleGoldenrod" , PALETTERGB (238,232,170)},
1106 {"light goldenrod yellow" , PALETTERGB (250,250,210)},
1107 {"LightGoldenrodYellow" , PALETTERGB (250,250,210)},
1108 {"light yellow" , PALETTERGB (255,255,224)},
1109 {"LightYellow" , PALETTERGB (255,255,224)},
1110 {"yellow" , PALETTERGB (255,255, 0)},
1111 {"gold" , PALETTERGB (255,215, 0)},
1112 {"light goldenrod" , PALETTERGB (238,221,130)},
1113 {"LightGoldenrod" , PALETTERGB (238,221,130)},
1114 {"goldenrod" , PALETTERGB (218,165, 32)},
1115 {"dark goldenrod" , PALETTERGB (184,134, 11)},
1116 {"DarkGoldenrod" , PALETTERGB (184,134, 11)},
1117 {"rosy brown" , PALETTERGB (188,143,143)},
1118 {"RosyBrown" , PALETTERGB (188,143,143)},
1119 {"indian red" , PALETTERGB (205, 92, 92)},
1120 {"IndianRed" , PALETTERGB (205, 92, 92)},
1121 {"saddle brown" , PALETTERGB (139, 69, 19)},
1122 {"SaddleBrown" , PALETTERGB (139, 69, 19)},
1123 {"sienna" , PALETTERGB (160, 82, 45)},
1124 {"peru" , PALETTERGB (205,133, 63)},
1125 {"burlywood" , PALETTERGB (222,184,135)},
1126 {"beige" , PALETTERGB (245,245,220)},
1127 {"wheat" , PALETTERGB (245,222,179)},
1128 {"sandy brown" , PALETTERGB (244,164, 96)},
1129 {"SandyBrown" , PALETTERGB (244,164, 96)},
1130 {"tan" , PALETTERGB (210,180,140)},
1131 {"chocolate" , PALETTERGB (210,105, 30)},
1132 {"firebrick" , PALETTERGB (178,34, 34)},
1133 {"brown" , PALETTERGB (165,42, 42)},
1134 {"dark salmon" , PALETTERGB (233,150,122)},
1135 {"DarkSalmon" , PALETTERGB (233,150,122)},
1136 {"salmon" , PALETTERGB (250,128,114)},
1137 {"light salmon" , PALETTERGB (255,160,122)},
1138 {"LightSalmon" , PALETTERGB (255,160,122)},
1139 {"orange" , PALETTERGB (255,165, 0)},
1140 {"dark orange" , PALETTERGB (255,140, 0)},
1141 {"DarkOrange" , PALETTERGB (255,140, 0)},
1142 {"coral" , PALETTERGB (255,127, 80)},
1143 {"light coral" , PALETTERGB (240,128,128)},
1144 {"LightCoral" , PALETTERGB (240,128,128)},
1145 {"tomato" , PALETTERGB (255, 99, 71)},
1146 {"orange red" , PALETTERGB (255, 69, 0)},
1147 {"OrangeRed" , PALETTERGB (255, 69, 0)},
1148 {"red" , PALETTERGB (255, 0, 0)},
1149 {"hot pink" , PALETTERGB (255,105,180)},
1150 {"HotPink" , PALETTERGB (255,105,180)},
1151 {"deep pink" , PALETTERGB (255, 20,147)},
1152 {"DeepPink" , PALETTERGB (255, 20,147)},
1153 {"pink" , PALETTERGB (255,192,203)},
1154 {"light pink" , PALETTERGB (255,182,193)},
1155 {"LightPink" , PALETTERGB (255,182,193)},
1156 {"pale violet red" , PALETTERGB (219,112,147)},
1157 {"PaleVioletRed" , PALETTERGB (219,112,147)},
1158 {"maroon" , PALETTERGB (176, 48, 96)},
1159 {"medium violet red" , PALETTERGB (199, 21,133)},
1160 {"MediumVioletRed" , PALETTERGB (199, 21,133)},
1161 {"violet red" , PALETTERGB (208, 32,144)},
1162 {"VioletRed" , PALETTERGB (208, 32,144)},
1163 {"magenta" , PALETTERGB (255, 0,255)},
1164 {"violet" , PALETTERGB (238,130,238)},
1165 {"plum" , PALETTERGB (221,160,221)},
1166 {"orchid" , PALETTERGB (218,112,214)},
1167 {"medium orchid" , PALETTERGB (186, 85,211)},
1168 {"MediumOrchid" , PALETTERGB (186, 85,211)},
1169 {"dark orchid" , PALETTERGB (153, 50,204)},
1170 {"DarkOrchid" , PALETTERGB (153, 50,204)},
1171 {"dark violet" , PALETTERGB (148, 0,211)},
1172 {"DarkViolet" , PALETTERGB (148, 0,211)},
1173 {"blue violet" , PALETTERGB (138, 43,226)},
1174 {"BlueViolet" , PALETTERGB (138, 43,226)},
1175 {"purple" , PALETTERGB (160, 32,240)},
1176 {"medium purple" , PALETTERGB (147,112,219)},
1177 {"MediumPurple" , PALETTERGB (147,112,219)},
1178 {"thistle" , PALETTERGB (216,191,216)},
1179 {"gray0" , PALETTERGB ( 0, 0, 0)},
1180 {"grey0" , PALETTERGB ( 0, 0, 0)},
1181 {"dark grey" , PALETTERGB (169,169,169)},
1182 {"DarkGrey" , PALETTERGB (169,169,169)},
1183 {"dark gray" , PALETTERGB (169,169,169)},
1184 {"DarkGray" , PALETTERGB (169,169,169)},
1185 {"dark blue" , PALETTERGB ( 0, 0,139)},
1186 {"DarkBlue" , PALETTERGB ( 0, 0,139)},
1187 {"dark cyan" , PALETTERGB ( 0,139,139)},
1188 {"DarkCyan" , PALETTERGB ( 0,139,139)},
1189 {"dark magenta" , PALETTERGB (139, 0,139)},
1190 {"DarkMagenta" , PALETTERGB (139, 0,139)},
1191 {"dark red" , PALETTERGB (139, 0, 0)},
1192 {"DarkRed" , PALETTERGB (139, 0, 0)},
1193 {"light green" , PALETTERGB (144,238,144)},
1194 {"LightGreen" , PALETTERGB (144,238,144)},
1197 DEFUN ("w32-default-color-map", Fw32_default_color_map
, Sw32_default_color_map
,
1198 0, 0, 0, "Return the default color map.")
1202 colormap_t
*pc
= w32_color_map
;
1209 for (i
= 0; i
< sizeof (w32_color_map
) / sizeof (w32_color_map
[0]);
1211 cmap
= Fcons (Fcons (build_string (pc
->name
),
1212 make_number (pc
->colorref
)),
1221 w32_to_x_color (rgb
)
1226 CHECK_NUMBER (rgb
, 0);
1230 color
= Frassq (rgb
, Vw32_color_map
);
1235 return (Fcar (color
));
1241 x_to_w32_color (colorname
)
1244 register Lisp_Object tail
, ret
= Qnil
;
1248 for (tail
= Vw32_color_map
; !NILP (tail
); tail
= Fcdr (tail
))
1250 register Lisp_Object elt
, tem
;
1253 if (!CONSP (elt
)) continue;
1257 if (lstrcmpi (XSTRING (tem
)->data
, colorname
) == 0)
1259 ret
= XUINT(Fcdr (elt
));
1273 w32_regenerate_palette (FRAME_PTR f
)
1275 struct w32_palette_entry
* list
;
1276 LOGPALETTE
* log_palette
;
1277 HPALETTE new_palette
;
1280 /* don't bother trying to create palette if not supported */
1281 if (! FRAME_W32_DISPLAY_INFO (f
)->has_palette
)
1284 log_palette
= (LOGPALETTE
*)
1285 alloca (sizeof (LOGPALETTE
) +
1286 FRAME_W32_DISPLAY_INFO (f
)->num_colors
* sizeof (PALETTEENTRY
));
1287 log_palette
->palVersion
= 0x300;
1288 log_palette
->palNumEntries
= FRAME_W32_DISPLAY_INFO (f
)->num_colors
;
1290 list
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1292 i
< FRAME_W32_DISPLAY_INFO (f
)->num_colors
;
1293 i
++, list
= list
->next
)
1294 log_palette
->palPalEntry
[i
] = list
->entry
;
1296 new_palette
= CreatePalette (log_palette
);
1300 if (FRAME_W32_DISPLAY_INFO (f
)->palette
)
1301 DeleteObject (FRAME_W32_DISPLAY_INFO (f
)->palette
);
1302 FRAME_W32_DISPLAY_INFO (f
)->palette
= new_palette
;
1304 /* Realize display palette and garbage all frames. */
1305 release_frame_dc (f
, get_frame_dc (f
));
1310 #define W32_COLOR(pe) RGB (pe.peRed, pe.peGreen, pe.peBlue)
1311 #define SET_W32_COLOR(pe, color) \
1314 pe.peRed = GetRValue (color); \
1315 pe.peGreen = GetGValue (color); \
1316 pe.peBlue = GetBValue (color); \
1321 /* Keep these around in case we ever want to track color usage. */
1323 w32_map_color (FRAME_PTR f
, COLORREF color
)
1325 struct w32_palette_entry
* list
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1327 if (NILP (Vw32_enable_palette
))
1330 /* check if color is already mapped */
1333 if (W32_COLOR (list
->entry
) == color
)
1341 /* not already mapped, so add to list and recreate Windows palette */
1342 list
= (struct w32_palette_entry
*)
1343 xmalloc (sizeof (struct w32_palette_entry
));
1344 SET_W32_COLOR (list
->entry
, color
);
1346 list
->next
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1347 FRAME_W32_DISPLAY_INFO (f
)->color_list
= list
;
1348 FRAME_W32_DISPLAY_INFO (f
)->num_colors
++;
1350 /* set flag that palette must be regenerated */
1351 FRAME_W32_DISPLAY_INFO (f
)->regen_palette
= TRUE
;
1355 w32_unmap_color (FRAME_PTR f
, COLORREF color
)
1357 struct w32_palette_entry
* list
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1358 struct w32_palette_entry
**prev
= &FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1360 if (NILP (Vw32_enable_palette
))
1363 /* check if color is already mapped */
1366 if (W32_COLOR (list
->entry
) == color
)
1368 if (--list
->refcount
== 0)
1372 FRAME_W32_DISPLAY_INFO (f
)->num_colors
--;
1382 /* set flag that palette must be regenerated */
1383 FRAME_W32_DISPLAY_INFO (f
)->regen_palette
= TRUE
;
1387 /* Decide if color named COLOR is valid for the display associated with
1388 the selected frame; if so, return the rgb values in COLOR_DEF.
1389 If ALLOC is nonzero, allocate a new colormap cell. */
1392 defined_color (f
, color
, color_def
, alloc
)
1395 COLORREF
*color_def
;
1398 register Lisp_Object tem
;
1400 tem
= x_to_w32_color (color
);
1404 if (!NILP (Vw32_enable_palette
))
1406 struct w32_palette_entry
* entry
=
1407 FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1408 struct w32_palette_entry
** prev
=
1409 &FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1411 /* check if color is already mapped */
1414 if (W32_COLOR (entry
->entry
) == XUINT (tem
))
1416 prev
= &entry
->next
;
1417 entry
= entry
->next
;
1420 if (entry
== NULL
&& alloc
)
1422 /* not already mapped, so add to list */
1423 entry
= (struct w32_palette_entry
*)
1424 xmalloc (sizeof (struct w32_palette_entry
));
1425 SET_W32_COLOR (entry
->entry
, XUINT (tem
));
1428 FRAME_W32_DISPLAY_INFO (f
)->num_colors
++;
1430 /* set flag that palette must be regenerated */
1431 FRAME_W32_DISPLAY_INFO (f
)->regen_palette
= TRUE
;
1434 /* Ensure COLORREF value is snapped to nearest color in (default)
1435 palette by simulating the PALETTERGB macro. This works whether
1436 or not the display device has a palette. */
1437 *color_def
= XUINT (tem
) | 0x2000000;
1446 /* Given a string ARG naming a color, compute a pixel value from it
1447 suitable for screen F.
1448 If F is not a color screen, return DEF (default) regardless of what
1452 x_decode_color (f
, arg
, def
)
1459 CHECK_STRING (arg
, 0);
1461 if (strcmp (XSTRING (arg
)->data
, "black") == 0)
1462 return BLACK_PIX_DEFAULT (f
);
1463 else if (strcmp (XSTRING (arg
)->data
, "white") == 0)
1464 return WHITE_PIX_DEFAULT (f
);
1466 if ((FRAME_W32_DISPLAY_INFO (f
)->n_planes
* FRAME_W32_DISPLAY_INFO (f
)->n_cbits
) == 1)
1469 /* defined_color is responsible for coping with failures
1470 by looking for a near-miss. */
1471 if (defined_color (f
, XSTRING (arg
)->data
, &cdef
, 1))
1474 /* defined_color failed; return an ultimate default. */
1478 /* Functions called only from `x_set_frame_param'
1479 to set individual parameters.
1481 If FRAME_W32_WINDOW (f) is 0,
1482 the frame is being created and its window does not exist yet.
1483 In that case, just record the parameter's new value
1484 in the standard place; do not attempt to change the window. */
1487 x_set_foreground_color (f
, arg
, oldval
)
1489 Lisp_Object arg
, oldval
;
1491 f
->output_data
.w32
->foreground_pixel
1492 = x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1494 if (FRAME_W32_WINDOW (f
) != 0)
1496 recompute_basic_faces (f
);
1497 if (FRAME_VISIBLE_P (f
))
1503 x_set_background_color (f
, arg
, oldval
)
1505 Lisp_Object arg
, oldval
;
1510 f
->output_data
.w32
->background_pixel
1511 = x_decode_color (f
, arg
, WHITE_PIX_DEFAULT (f
));
1513 if (FRAME_W32_WINDOW (f
) != 0)
1515 SetWindowLong (FRAME_W32_WINDOW (f
), WND_BACKGROUND_INDEX
, f
->output_data
.w32
->background_pixel
);
1517 recompute_basic_faces (f
);
1519 if (FRAME_VISIBLE_P (f
))
1525 x_set_mouse_color (f
, arg
, oldval
)
1527 Lisp_Object arg
, oldval
;
1530 Cursor cursor
, nontext_cursor
, mode_cursor
, cross_cursor
;
1535 if (!EQ (Qnil
, arg
))
1536 f
->output_data
.w32
->mouse_pixel
1537 = x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1538 mask_color
= f
->output_data
.w32
->background_pixel
;
1539 /* No invisible pointers. */
1540 if (mask_color
== f
->output_data
.w32
->mouse_pixel
1541 && mask_color
== f
->output_data
.w32
->background_pixel
)
1542 f
->output_data
.w32
->mouse_pixel
= f
->output_data
.w32
->foreground_pixel
;
1547 /* It's not okay to crash if the user selects a screwy cursor. */
1548 count
= x_catch_errors (FRAME_W32_DISPLAY (f
));
1550 if (!EQ (Qnil
, Vx_pointer_shape
))
1552 CHECK_NUMBER (Vx_pointer_shape
, 0);
1553 cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XINT (Vx_pointer_shape
));
1556 cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_xterm
);
1557 x_check_errors (FRAME_W32_DISPLAY (f
), "bad text pointer cursor: %s");
1559 if (!EQ (Qnil
, Vx_nontext_pointer_shape
))
1561 CHECK_NUMBER (Vx_nontext_pointer_shape
, 0);
1562 nontext_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
),
1563 XINT (Vx_nontext_pointer_shape
));
1566 nontext_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_left_ptr
);
1567 x_check_errors (FRAME_W32_DISPLAY (f
), "bad nontext pointer cursor: %s");
1569 if (!EQ (Qnil
, Vx_mode_pointer_shape
))
1571 CHECK_NUMBER (Vx_mode_pointer_shape
, 0);
1572 mode_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
),
1573 XINT (Vx_mode_pointer_shape
));
1576 mode_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_xterm
);
1577 x_check_errors (FRAME_W32_DISPLAY (f
), "bad modeline pointer cursor: %s");
1579 if (!EQ (Qnil
, Vx_sensitive_text_pointer_shape
))
1581 CHECK_NUMBER (Vx_sensitive_text_pointer_shape
, 0);
1583 = XCreateFontCursor (FRAME_W32_DISPLAY (f
),
1584 XINT (Vx_sensitive_text_pointer_shape
));
1587 cross_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_crosshair
);
1589 /* Check and report errors with the above calls. */
1590 x_check_errors (FRAME_W32_DISPLAY (f
), "can't set cursor shape: %s");
1591 x_uncatch_errors (FRAME_W32_DISPLAY (f
), count
);
1594 XColor fore_color
, back_color
;
1596 fore_color
.pixel
= f
->output_data
.w32
->mouse_pixel
;
1597 back_color
.pixel
= mask_color
;
1598 XQueryColor (FRAME_W32_DISPLAY (f
),
1599 DefaultColormap (FRAME_W32_DISPLAY (f
),
1600 DefaultScreen (FRAME_W32_DISPLAY (f
))),
1602 XQueryColor (FRAME_W32_DISPLAY (f
),
1603 DefaultColormap (FRAME_W32_DISPLAY (f
),
1604 DefaultScreen (FRAME_W32_DISPLAY (f
))),
1606 XRecolorCursor (FRAME_W32_DISPLAY (f
), cursor
,
1607 &fore_color
, &back_color
);
1608 XRecolorCursor (FRAME_W32_DISPLAY (f
), nontext_cursor
,
1609 &fore_color
, &back_color
);
1610 XRecolorCursor (FRAME_W32_DISPLAY (f
), mode_cursor
,
1611 &fore_color
, &back_color
);
1612 XRecolorCursor (FRAME_W32_DISPLAY (f
), cross_cursor
,
1613 &fore_color
, &back_color
);
1616 if (FRAME_W32_WINDOW (f
) != 0)
1618 XDefineCursor (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
), cursor
);
1621 if (cursor
!= f
->output_data
.w32
->text_cursor
&& f
->output_data
.w32
->text_cursor
!= 0)
1622 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->text_cursor
);
1623 f
->output_data
.w32
->text_cursor
= cursor
;
1625 if (nontext_cursor
!= f
->output_data
.w32
->nontext_cursor
1626 && f
->output_data
.w32
->nontext_cursor
!= 0)
1627 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->nontext_cursor
);
1628 f
->output_data
.w32
->nontext_cursor
= nontext_cursor
;
1630 if (mode_cursor
!= f
->output_data
.w32
->modeline_cursor
1631 && f
->output_data
.w32
->modeline_cursor
!= 0)
1632 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->modeline_cursor
);
1633 f
->output_data
.w32
->modeline_cursor
= mode_cursor
;
1634 if (cross_cursor
!= f
->output_data
.w32
->cross_cursor
1635 && f
->output_data
.w32
->cross_cursor
!= 0)
1636 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->cross_cursor
);
1637 f
->output_data
.w32
->cross_cursor
= cross_cursor
;
1639 XFlush (FRAME_W32_DISPLAY (f
));
1645 x_set_cursor_color (f
, arg
, oldval
)
1647 Lisp_Object arg
, oldval
;
1649 unsigned long fore_pixel
;
1651 if (!EQ (Vx_cursor_fore_pixel
, Qnil
))
1652 fore_pixel
= x_decode_color (f
, Vx_cursor_fore_pixel
,
1653 WHITE_PIX_DEFAULT (f
));
1655 fore_pixel
= f
->output_data
.w32
->background_pixel
;
1656 f
->output_data
.w32
->cursor_pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1658 /* Make sure that the cursor color differs from the background color. */
1659 if (f
->output_data
.w32
->cursor_pixel
== f
->output_data
.w32
->background_pixel
)
1661 f
->output_data
.w32
->cursor_pixel
= f
->output_data
.w32
->mouse_pixel
;
1662 if (f
->output_data
.w32
->cursor_pixel
== fore_pixel
)
1663 fore_pixel
= f
->output_data
.w32
->background_pixel
;
1665 f
->output_data
.w32
->cursor_foreground_pixel
= fore_pixel
;
1667 if (FRAME_W32_WINDOW (f
) != 0)
1669 if (FRAME_VISIBLE_P (f
))
1671 x_display_cursor (f
, 0);
1672 x_display_cursor (f
, 1);
1677 /* Set the border-color of frame F to value described by ARG.
1678 ARG can be a string naming a color.
1679 The border-color is used for the border that is drawn by the server.
1680 Note that this does not fully take effect if done before
1681 F has a window; it must be redone when the window is created. */
1684 x_set_border_color (f
, arg
, oldval
)
1686 Lisp_Object arg
, oldval
;
1691 CHECK_STRING (arg
, 0);
1692 str
= XSTRING (arg
)->data
;
1694 pix
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1696 x_set_border_pixel (f
, pix
);
1699 /* Set the border-color of frame F to pixel value PIX.
1700 Note that this does not fully take effect if done before
1703 x_set_border_pixel (f
, pix
)
1707 f
->output_data
.w32
->border_pixel
= pix
;
1709 if (FRAME_W32_WINDOW (f
) != 0 && f
->output_data
.w32
->border_width
> 0)
1711 if (FRAME_VISIBLE_P (f
))
1717 x_set_cursor_type (f
, arg
, oldval
)
1719 Lisp_Object arg
, oldval
;
1723 FRAME_DESIRED_CURSOR (f
) = bar_cursor
;
1724 f
->output_data
.w32
->cursor_width
= 2;
1726 else if (CONSP (arg
) && EQ (XCONS (arg
)->car
, Qbar
)
1727 && INTEGERP (XCONS (arg
)->cdr
))
1729 FRAME_DESIRED_CURSOR (f
) = bar_cursor
;
1730 f
->output_data
.w32
->cursor_width
= XINT (XCONS (arg
)->cdr
);
1733 /* Treat anything unknown as "box cursor".
1734 It was bad to signal an error; people have trouble fixing
1735 .Xdefaults with Emacs, when it has something bad in it. */
1736 FRAME_DESIRED_CURSOR (f
) = filled_box_cursor
;
1738 /* Make sure the cursor gets redrawn. This is overkill, but how
1739 often do people change cursor types? */
1740 update_mode_lines
++;
1744 x_set_icon_type (f
, arg
, oldval
)
1746 Lisp_Object arg
, oldval
;
1754 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1757 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1762 result
= x_text_icon (f
,
1763 (char *) XSTRING ((!NILP (f
->icon_name
)
1767 result
= x_bitmap_icon (f
, arg
);
1772 error ("No icon window available");
1775 /* If the window was unmapped (and its icon was mapped),
1776 the new icon is not mapped, so map the window in its stead. */
1777 if (FRAME_VISIBLE_P (f
))
1779 #ifdef USE_X_TOOLKIT
1780 XtPopup (f
->output_data
.w32
->widget
, XtGrabNone
);
1782 XMapWindow (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
));
1785 XFlush (FRAME_W32_DISPLAY (f
));
1790 /* Return non-nil if frame F wants a bitmap icon. */
1798 tem
= assq_no_quit (Qicon_type
, f
->param_alist
);
1800 return XCONS (tem
)->cdr
;
1806 x_set_icon_name (f
, arg
, oldval
)
1808 Lisp_Object arg
, oldval
;
1815 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1818 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1824 if (f
->output_data
.w32
->icon_bitmap
!= 0)
1829 result
= x_text_icon (f
,
1830 (char *) XSTRING ((!NILP (f
->icon_name
)
1837 error ("No icon window available");
1840 /* If the window was unmapped (and its icon was mapped),
1841 the new icon is not mapped, so map the window in its stead. */
1842 if (FRAME_VISIBLE_P (f
))
1844 #ifdef USE_X_TOOLKIT
1845 XtPopup (f
->output_data
.w32
->widget
, XtGrabNone
);
1847 XMapWindow (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
));
1850 XFlush (FRAME_W32_DISPLAY (f
));
1855 extern Lisp_Object
x_new_font ();
1858 x_set_font (f
, arg
, oldval
)
1860 Lisp_Object arg
, oldval
;
1864 CHECK_STRING (arg
, 1);
1867 result
= x_new_font (f
, XSTRING (arg
)->data
);
1870 if (EQ (result
, Qnil
))
1871 error ("Font \"%s\" is not defined", XSTRING (arg
)->data
);
1872 else if (EQ (result
, Qt
))
1873 error ("the characters of the given font have varying widths");
1874 else if (STRINGP (result
))
1876 recompute_basic_faces (f
);
1877 store_frame_param (f
, Qfont
, result
);
1884 x_set_border_width (f
, arg
, oldval
)
1886 Lisp_Object arg
, oldval
;
1888 CHECK_NUMBER (arg
, 0);
1890 if (XINT (arg
) == f
->output_data
.w32
->border_width
)
1893 if (FRAME_W32_WINDOW (f
) != 0)
1894 error ("Cannot change the border width of a window");
1896 f
->output_data
.w32
->border_width
= XINT (arg
);
1900 x_set_internal_border_width (f
, arg
, oldval
)
1902 Lisp_Object arg
, oldval
;
1905 int old
= f
->output_data
.w32
->internal_border_width
;
1907 CHECK_NUMBER (arg
, 0);
1908 f
->output_data
.w32
->internal_border_width
= XINT (arg
);
1909 if (f
->output_data
.w32
->internal_border_width
< 0)
1910 f
->output_data
.w32
->internal_border_width
= 0;
1912 if (f
->output_data
.w32
->internal_border_width
== old
)
1915 if (FRAME_W32_WINDOW (f
) != 0)
1918 x_set_window_size (f
, 0, f
->width
, f
->height
);
1920 SET_FRAME_GARBAGED (f
);
1925 x_set_visibility (f
, value
, oldval
)
1927 Lisp_Object value
, oldval
;
1930 XSETFRAME (frame
, f
);
1933 Fmake_frame_invisible (frame
, Qt
);
1934 else if (EQ (value
, Qicon
))
1935 Ficonify_frame (frame
);
1937 Fmake_frame_visible (frame
);
1941 x_set_menu_bar_lines (f
, value
, oldval
)
1943 Lisp_Object value
, oldval
;
1946 int olines
= FRAME_MENU_BAR_LINES (f
);
1948 /* Right now, menu bars don't work properly in minibuf-only frames;
1949 most of the commands try to apply themselves to the minibuffer
1950 frame itslef, and get an error because you can't switch buffers
1951 in or split the minibuffer window. */
1952 if (FRAME_MINIBUF_ONLY_P (f
))
1955 if (INTEGERP (value
))
1956 nlines
= XINT (value
);
1960 FRAME_MENU_BAR_LINES (f
) = 0;
1962 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
1965 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
1966 free_frame_menubar (f
);
1967 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
1971 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
1974 If EXPLICIT is non-zero, that indicates that lisp code is setting the
1975 name; if NAME is a string, set F's name to NAME and set
1976 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
1978 If EXPLICIT is zero, that indicates that Emacs redisplay code is
1979 suggesting a new name, which lisp code should override; if
1980 F->explicit_name is set, ignore the new name; otherwise, set it. */
1983 x_set_name (f
, name
, explicit)
1988 /* Make sure that requests from lisp code override requests from
1989 Emacs redisplay code. */
1992 /* If we're switching from explicit to implicit, we had better
1993 update the mode lines and thereby update the title. */
1994 if (f
->explicit_name
&& NILP (name
))
1995 update_mode_lines
= 1;
1997 f
->explicit_name
= ! NILP (name
);
1999 else if (f
->explicit_name
)
2002 /* If NAME is nil, set the name to the w32_id_name. */
2005 /* Check for no change needed in this very common case
2006 before we do any consing. */
2007 if (!strcmp (FRAME_W32_DISPLAY_INFO (f
)->w32_id_name
,
2008 XSTRING (f
->name
)->data
))
2010 name
= build_string (FRAME_W32_DISPLAY_INFO (f
)->w32_id_name
);
2013 CHECK_STRING (name
, 0);
2015 /* Don't change the name if it's already NAME. */
2016 if (! NILP (Fstring_equal (name
, f
->name
)))
2019 if (FRAME_W32_WINDOW (f
))
2022 SetWindowText(FRAME_W32_WINDOW (f
), XSTRING (name
)->data
);
2029 /* This function should be called when the user's lisp code has
2030 specified a name for the frame; the name will override any set by the
2033 x_explicitly_set_name (f
, arg
, oldval
)
2035 Lisp_Object arg
, oldval
;
2037 x_set_name (f
, arg
, 1);
2040 /* This function should be called by Emacs redisplay code to set the
2041 name; names set this way will never override names set by the user's
2044 x_implicitly_set_name (f
, arg
, oldval
)
2046 Lisp_Object arg
, oldval
;
2048 x_set_name (f
, arg
, 0);
2052 x_set_autoraise (f
, arg
, oldval
)
2054 Lisp_Object arg
, oldval
;
2056 f
->auto_raise
= !EQ (Qnil
, arg
);
2060 x_set_autolower (f
, arg
, oldval
)
2062 Lisp_Object arg
, oldval
;
2064 f
->auto_lower
= !EQ (Qnil
, arg
);
2068 x_set_unsplittable (f
, arg
, oldval
)
2070 Lisp_Object arg
, oldval
;
2072 f
->no_split
= !NILP (arg
);
2076 x_set_vertical_scroll_bars (f
, arg
, oldval
)
2078 Lisp_Object arg
, oldval
;
2080 if ((EQ (arg
, Qleft
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f
))
2081 || (EQ (arg
, Qright
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f
))
2082 || (NILP (arg
) && FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
2083 || (!NILP (arg
) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
)))
2085 FRAME_VERTICAL_SCROLL_BAR_TYPE (f
) = NILP (arg
) ?
2086 vertical_scroll_bar_none
:
2088 ? vertical_scroll_bar_right
2089 : vertical_scroll_bar_left
;
2091 /* We set this parameter before creating the window for the
2092 frame, so we can get the geometry right from the start.
2093 However, if the window hasn't been created yet, we shouldn't
2094 call x_set_window_size. */
2095 if (FRAME_W32_WINDOW (f
))
2096 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2101 x_set_scroll_bar_width (f
, arg
, oldval
)
2103 Lisp_Object arg
, oldval
;
2107 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = 0;
2108 FRAME_SCROLL_BAR_COLS (f
) = 2;
2110 else if (INTEGERP (arg
) && XINT (arg
) > 0
2111 && XFASTINT (arg
) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f
))
2113 int wid
= FONT_WIDTH (f
->output_data
.w32
->font
);
2114 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = XFASTINT (arg
);
2115 FRAME_SCROLL_BAR_COLS (f
) = (XFASTINT (arg
) + wid
-1) / wid
;
2116 if (FRAME_W32_WINDOW (f
))
2117 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2121 /* Subroutines of creating an frame. */
2123 /* Make sure that Vx_resource_name is set to a reasonable value.
2124 Fix it up, or set it to `emacs' if it is too hopeless. */
2127 validate_x_resource_name ()
2130 /* Number of valid characters in the resource name. */
2132 /* Number of invalid characters in the resource name. */
2137 if (STRINGP (Vx_resource_name
))
2139 unsigned char *p
= XSTRING (Vx_resource_name
)->data
;
2142 len
= XSTRING (Vx_resource_name
)->size
;
2144 /* Only letters, digits, - and _ are valid in resource names.
2145 Count the valid characters and count the invalid ones. */
2146 for (i
= 0; i
< len
; i
++)
2149 if (! ((c
>= 'a' && c
<= 'z')
2150 || (c
>= 'A' && c
<= 'Z')
2151 || (c
>= '0' && c
<= '9')
2152 || c
== '-' || c
== '_'))
2159 /* Not a string => completely invalid. */
2160 bad_count
= 5, good_count
= 0;
2162 /* If name is valid already, return. */
2166 /* If name is entirely invalid, or nearly so, use `emacs'. */
2168 || (good_count
== 1 && bad_count
> 0))
2170 Vx_resource_name
= build_string ("emacs");
2174 /* Name is partly valid. Copy it and replace the invalid characters
2175 with underscores. */
2177 Vx_resource_name
= new = Fcopy_sequence (Vx_resource_name
);
2179 for (i
= 0; i
< len
; i
++)
2181 int c
= XSTRING (new)->data
[i
];
2182 if (! ((c
>= 'a' && c
<= 'z')
2183 || (c
>= 'A' && c
<= 'Z')
2184 || (c
>= '0' && c
<= '9')
2185 || c
== '-' || c
== '_'))
2186 XSTRING (new)->data
[i
] = '_';
2191 extern char *x_get_string_resource ();
2193 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
2194 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
2195 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
2196 class, where INSTANCE is the name under which Emacs was invoked, or\n\
2197 the name specified by the `-name' or `-rn' command-line arguments.\n\
2199 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
2200 class, respectively. You must specify both of them or neither.\n\
2201 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
2202 and the class is `Emacs.CLASS.SUBCLASS'.")
2203 (attribute
, class, component
, subclass
)
2204 Lisp_Object attribute
, class, component
, subclass
;
2206 register char *value
;
2210 CHECK_STRING (attribute
, 0);
2211 CHECK_STRING (class, 0);
2213 if (!NILP (component
))
2214 CHECK_STRING (component
, 1);
2215 if (!NILP (subclass
))
2216 CHECK_STRING (subclass
, 2);
2217 if (NILP (component
) != NILP (subclass
))
2218 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2220 validate_x_resource_name ();
2222 /* Allocate space for the components, the dots which separate them,
2223 and the final '\0'. Make them big enough for the worst case. */
2224 name_key
= (char *) alloca (XSTRING (Vx_resource_name
)->size
2225 + (STRINGP (component
)
2226 ? XSTRING (component
)->size
: 0)
2227 + XSTRING (attribute
)->size
2230 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
2231 + XSTRING (class)->size
2232 + (STRINGP (subclass
)
2233 ? XSTRING (subclass
)->size
: 0)
2236 /* Start with emacs.FRAMENAME for the name (the specific one)
2237 and with `Emacs' for the class key (the general one). */
2238 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2239 strcpy (class_key
, EMACS_CLASS
);
2241 strcat (class_key
, ".");
2242 strcat (class_key
, XSTRING (class)->data
);
2244 if (!NILP (component
))
2246 strcat (class_key
, ".");
2247 strcat (class_key
, XSTRING (subclass
)->data
);
2249 strcat (name_key
, ".");
2250 strcat (name_key
, XSTRING (component
)->data
);
2253 strcat (name_key
, ".");
2254 strcat (name_key
, XSTRING (attribute
)->data
);
2256 value
= x_get_string_resource (Qnil
,
2257 name_key
, class_key
);
2259 if (value
!= (char *) 0)
2260 return build_string (value
);
2265 /* Used when C code wants a resource value. */
2268 x_get_resource_string (attribute
, class)
2269 char *attribute
, *class;
2271 register char *value
;
2275 /* Allocate space for the components, the dots which separate them,
2276 and the final '\0'. */
2277 name_key
= (char *) alloca (XSTRING (Vinvocation_name
)->size
2278 + strlen (attribute
) + 2);
2279 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
2280 + strlen (class) + 2);
2282 sprintf (name_key
, "%s.%s",
2283 XSTRING (Vinvocation_name
)->data
,
2285 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
2287 return x_get_string_resource (selected_frame
,
2288 name_key
, class_key
);
2291 /* Types we might convert a resource string into. */
2294 number
, boolean
, string
, symbol
2297 /* Return the value of parameter PARAM.
2299 First search ALIST, then Vdefault_frame_alist, then the X defaults
2300 database, using ATTRIBUTE as the attribute name and CLASS as its class.
2302 Convert the resource to the type specified by desired_type.
2304 If no default is specified, return Qunbound. If you call
2305 x_get_arg, make sure you deal with Qunbound in a reasonable way,
2306 and don't let it get stored in any Lisp-visible variables! */
2309 x_get_arg (alist
, param
, attribute
, class, type
)
2310 Lisp_Object alist
, param
;
2313 enum resource_types type
;
2315 register Lisp_Object tem
;
2317 tem
= Fassq (param
, alist
);
2319 tem
= Fassq (param
, Vdefault_frame_alist
);
2325 tem
= Fx_get_resource (build_string (attribute
),
2326 build_string (class),
2335 return make_number (atoi (XSTRING (tem
)->data
));
2338 tem
= Fdowncase (tem
);
2339 if (!strcmp (XSTRING (tem
)->data
, "on")
2340 || !strcmp (XSTRING (tem
)->data
, "true"))
2349 /* As a special case, we map the values `true' and `on'
2350 to Qt, and `false' and `off' to Qnil. */
2353 lower
= Fdowncase (tem
);
2354 if (!strcmp (XSTRING (lower
)->data
, "on")
2355 || !strcmp (XSTRING (lower
)->data
, "true"))
2357 else if (!strcmp (XSTRING (lower
)->data
, "off")
2358 || !strcmp (XSTRING (lower
)->data
, "false"))
2361 return Fintern (tem
, Qnil
);
2374 /* Record in frame F the specified or default value according to ALIST
2375 of the parameter named PARAM (a Lisp symbol).
2376 If no value is specified for PARAM, look for an X default for XPROP
2377 on the frame named NAME.
2378 If that is not found either, use the value DEFLT. */
2381 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
2388 enum resource_types type
;
2392 tem
= x_get_arg (alist
, prop
, xprop
, xclass
, type
);
2393 if (EQ (tem
, Qunbound
))
2395 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2399 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
2400 "Parse an X-style geometry string STRING.\n\
2401 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
2402 The properties returned may include `top', `left', `height', and `width'.\n\
2403 The value of `left' or `top' may be an integer,\n\
2404 or a list (+ N) meaning N pixels relative to top/left corner,\n\
2405 or a list (- N) meaning -N pixels relative to bottom/right corner.")
2410 unsigned int width
, height
;
2413 CHECK_STRING (string
, 0);
2415 geometry
= XParseGeometry ((char *) XSTRING (string
)->data
,
2416 &x
, &y
, &width
, &height
);
2419 if (geometry
& XValue
)
2421 Lisp_Object element
;
2423 if (x
>= 0 && (geometry
& XNegative
))
2424 element
= Fcons (Qleft
, Fcons (Qminus
, Fcons (make_number (-x
), Qnil
)));
2425 else if (x
< 0 && ! (geometry
& XNegative
))
2426 element
= Fcons (Qleft
, Fcons (Qplus
, Fcons (make_number (x
), Qnil
)));
2428 element
= Fcons (Qleft
, make_number (x
));
2429 result
= Fcons (element
, result
);
2432 if (geometry
& YValue
)
2434 Lisp_Object element
;
2436 if (y
>= 0 && (geometry
& YNegative
))
2437 element
= Fcons (Qtop
, Fcons (Qminus
, Fcons (make_number (-y
), Qnil
)));
2438 else if (y
< 0 && ! (geometry
& YNegative
))
2439 element
= Fcons (Qtop
, Fcons (Qplus
, Fcons (make_number (y
), Qnil
)));
2441 element
= Fcons (Qtop
, make_number (y
));
2442 result
= Fcons (element
, result
);
2445 if (geometry
& WidthValue
)
2446 result
= Fcons (Fcons (Qwidth
, make_number (width
)), result
);
2447 if (geometry
& HeightValue
)
2448 result
= Fcons (Fcons (Qheight
, make_number (height
)), result
);
2453 /* Calculate the desired size and position of this window,
2454 and return the flags saying which aspects were specified.
2456 This function does not make the coordinates positive. */
2458 #define DEFAULT_ROWS 40
2459 #define DEFAULT_COLS 80
2462 x_figure_window_size (f
, parms
)
2466 register Lisp_Object tem0
, tem1
, tem2
;
2467 int height
, width
, left
, top
;
2468 register int geometry
;
2469 long window_prompting
= 0;
2471 /* Default values if we fall through.
2472 Actually, if that happens we should get
2473 window manager prompting. */
2474 SET_FRAME_WIDTH (f
, DEFAULT_COLS
);
2475 f
->height
= DEFAULT_ROWS
;
2476 /* Window managers expect that if program-specified
2477 positions are not (0,0), they're intentional, not defaults. */
2478 f
->output_data
.w32
->top_pos
= 0;
2479 f
->output_data
.w32
->left_pos
= 0;
2481 tem0
= x_get_arg (parms
, Qheight
, 0, 0, number
);
2482 tem1
= x_get_arg (parms
, Qwidth
, 0, 0, number
);
2483 tem2
= x_get_arg (parms
, Quser_size
, 0, 0, number
);
2484 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
2486 if (!EQ (tem0
, Qunbound
))
2488 CHECK_NUMBER (tem0
, 0);
2489 f
->height
= XINT (tem0
);
2491 if (!EQ (tem1
, Qunbound
))
2493 CHECK_NUMBER (tem1
, 0);
2494 SET_FRAME_WIDTH (f
, XINT (tem1
));
2496 if (!NILP (tem2
) && !EQ (tem2
, Qunbound
))
2497 window_prompting
|= USSize
;
2499 window_prompting
|= PSize
;
2502 f
->output_data
.w32
->vertical_scroll_bar_extra
2503 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
2505 : FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) > 0
2506 ? FRAME_SCROLL_BAR_PIXEL_WIDTH (f
)
2507 : (FRAME_SCROLL_BAR_COLS (f
) * FONT_WIDTH (f
->output_data
.w32
->font
)));
2508 f
->output_data
.w32
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
2509 f
->output_data
.w32
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
2511 tem0
= x_get_arg (parms
, Qtop
, 0, 0, number
);
2512 tem1
= x_get_arg (parms
, Qleft
, 0, 0, number
);
2513 tem2
= x_get_arg (parms
, Quser_position
, 0, 0, number
);
2514 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
2516 if (EQ (tem0
, Qminus
))
2518 f
->output_data
.w32
->top_pos
= 0;
2519 window_prompting
|= YNegative
;
2521 else if (CONSP (tem0
) && EQ (XCONS (tem0
)->car
, Qminus
)
2522 && CONSP (XCONS (tem0
)->cdr
)
2523 && INTEGERP (XCONS (XCONS (tem0
)->cdr
)->car
))
2525 f
->output_data
.w32
->top_pos
= - XINT (XCONS (XCONS (tem0
)->cdr
)->car
);
2526 window_prompting
|= YNegative
;
2528 else if (CONSP (tem0
) && EQ (XCONS (tem0
)->car
, Qplus
)
2529 && CONSP (XCONS (tem0
)->cdr
)
2530 && INTEGERP (XCONS (XCONS (tem0
)->cdr
)->car
))
2532 f
->output_data
.w32
->top_pos
= XINT (XCONS (XCONS (tem0
)->cdr
)->car
);
2534 else if (EQ (tem0
, Qunbound
))
2535 f
->output_data
.w32
->top_pos
= 0;
2538 CHECK_NUMBER (tem0
, 0);
2539 f
->output_data
.w32
->top_pos
= XINT (tem0
);
2540 if (f
->output_data
.w32
->top_pos
< 0)
2541 window_prompting
|= YNegative
;
2544 if (EQ (tem1
, Qminus
))
2546 f
->output_data
.w32
->left_pos
= 0;
2547 window_prompting
|= XNegative
;
2549 else if (CONSP (tem1
) && EQ (XCONS (tem1
)->car
, Qminus
)
2550 && CONSP (XCONS (tem1
)->cdr
)
2551 && INTEGERP (XCONS (XCONS (tem1
)->cdr
)->car
))
2553 f
->output_data
.w32
->left_pos
= - XINT (XCONS (XCONS (tem1
)->cdr
)->car
);
2554 window_prompting
|= XNegative
;
2556 else if (CONSP (tem1
) && EQ (XCONS (tem1
)->car
, Qplus
)
2557 && CONSP (XCONS (tem1
)->cdr
)
2558 && INTEGERP (XCONS (XCONS (tem1
)->cdr
)->car
))
2560 f
->output_data
.w32
->left_pos
= XINT (XCONS (XCONS (tem1
)->cdr
)->car
);
2562 else if (EQ (tem1
, Qunbound
))
2563 f
->output_data
.w32
->left_pos
= 0;
2566 CHECK_NUMBER (tem1
, 0);
2567 f
->output_data
.w32
->left_pos
= XINT (tem1
);
2568 if (f
->output_data
.w32
->left_pos
< 0)
2569 window_prompting
|= XNegative
;
2572 if (!NILP (tem2
) && ! EQ (tem2
, Qunbound
))
2573 window_prompting
|= USPosition
;
2575 window_prompting
|= PPosition
;
2578 return window_prompting
;
2583 extern LRESULT CALLBACK
w32_wnd_proc ();
2586 w32_init_class (hinst
)
2591 wc
.style
= CS_HREDRAW
| CS_VREDRAW
;
2592 wc
.lpfnWndProc
= (WNDPROC
) w32_wnd_proc
;
2594 wc
.cbWndExtra
= WND_EXTRA_BYTES
;
2595 wc
.hInstance
= hinst
;
2596 wc
.hIcon
= LoadIcon (hinst
, EMACS_CLASS
);
2597 wc
.hCursor
= LoadCursor (NULL
, IDC_ARROW
);
2598 wc
.hbrBackground
= NULL
; // GetStockObject (WHITE_BRUSH);
2599 wc
.lpszMenuName
= NULL
;
2600 wc
.lpszClassName
= EMACS_CLASS
;
2602 return (RegisterClass (&wc
));
2606 w32_createscrollbar (f
, bar
)
2608 struct scroll_bar
* bar
;
2610 return (CreateWindow ("SCROLLBAR", "", SBS_VERT
| WS_CHILD
| WS_VISIBLE
,
2611 /* Position and size of scroll bar. */
2612 XINT(bar
->left
), XINT(bar
->top
),
2613 XINT(bar
->width
), XINT(bar
->height
),
2614 FRAME_W32_WINDOW (f
),
2621 w32_createwindow (f
)
2626 /* Do first time app init */
2630 w32_init_class (hinst
);
2633 FRAME_W32_WINDOW (f
) = hwnd
= CreateWindow (EMACS_CLASS
,
2635 f
->output_data
.w32
->dwStyle
| WS_CLIPCHILDREN
,
2636 f
->output_data
.w32
->left_pos
,
2637 f
->output_data
.w32
->top_pos
,
2647 SetWindowLong (hwnd
, WND_X_UNITS_INDEX
, FONT_WIDTH (f
->output_data
.w32
->font
));
2648 SetWindowLong (hwnd
, WND_Y_UNITS_INDEX
, f
->output_data
.w32
->line_height
);
2649 SetWindowLong (hwnd
, WND_BACKGROUND_INDEX
, f
->output_data
.w32
->background_pixel
);
2651 /* Do this to discard the default setting specified by our parent. */
2652 ShowWindow (hwnd
, SW_HIDE
);
2656 /* Convert between the modifier bits W32 uses and the modifier bits
2659 w32_get_modifiers ()
2661 return (((GetKeyState (VK_SHIFT
)&0x8000) ? shift_modifier
: 0) |
2662 ((GetKeyState (VK_CONTROL
)&0x8000) ? ctrl_modifier
: 0) |
2663 ((GetKeyState (VK_MENU
)&0x8000) ?
2664 ((NILP (Vw32_alt_is_meta
)) ? alt_modifier
: meta_modifier
) : 0));
2668 my_post_msg (wmsg
, hwnd
, msg
, wParam
, lParam
)
2675 wmsg
->msg
.hwnd
= hwnd
;
2676 wmsg
->msg
.message
= msg
;
2677 wmsg
->msg
.wParam
= wParam
;
2678 wmsg
->msg
.lParam
= lParam
;
2679 wmsg
->msg
.time
= GetMessageTime ();
2684 /* GetKeyState and MapVirtualKey on Windows 95 do not actually distinguish
2685 between left and right keys as advertised. We test for this
2686 support dynamically, and set a flag when the support is absent. If
2687 absent, we keep track of the left and right control and alt keys
2688 ourselves. This is particularly necessary on keyboards that rely
2689 upon the AltGr key, which is represented as having the left control
2690 and right alt keys pressed. For these keyboards, we need to know
2691 when the left alt key has been pressed in addition to the AltGr key
2692 so that we can properly support M-AltGr-key sequences (such as M-@
2693 on Swedish keyboards). */
2695 #define EMACS_LCONTROL 0
2696 #define EMACS_RCONTROL 1
2697 #define EMACS_LMENU 2
2698 #define EMACS_RMENU 3
2700 static int modifiers
[4];
2701 static int modifiers_recorded
;
2702 static int modifier_key_support_tested
;
2705 test_modifier_support (unsigned int wparam
)
2709 if (wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
)
2711 if (wparam
== VK_CONTROL
)
2721 if (!(GetKeyState (l
) & 0x8000) && !(GetKeyState (r
) & 0x8000))
2722 modifiers_recorded
= 1;
2724 modifiers_recorded
= 0;
2725 modifier_key_support_tested
= 1;
2729 record_keydown (unsigned int wparam
, unsigned int lparam
)
2733 if (!modifier_key_support_tested
)
2734 test_modifier_support (wparam
);
2736 if ((wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
) || !modifiers_recorded
)
2739 if (wparam
== VK_CONTROL
)
2740 i
= (lparam
& 0x1000000) ? EMACS_RCONTROL
: EMACS_LCONTROL
;
2742 i
= (lparam
& 0x1000000) ? EMACS_RMENU
: EMACS_LMENU
;
2748 record_keyup (unsigned int wparam
, unsigned int lparam
)
2752 if ((wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
) || !modifiers_recorded
)
2755 if (wparam
== VK_CONTROL
)
2756 i
= (lparam
& 0x1000000) ? EMACS_RCONTROL
: EMACS_LCONTROL
;
2758 i
= (lparam
& 0x1000000) ? EMACS_RMENU
: EMACS_LMENU
;
2763 /* Emacs can lose focus while a modifier key has been pressed. When
2764 it regains focus, be conservative and clear all modifiers since
2765 we cannot reconstruct the left and right modifier state. */
2771 if (!modifiers_recorded
)
2774 ctrl
= GetAsyncKeyState (VK_CONTROL
);
2775 alt
= GetAsyncKeyState (VK_MENU
);
2777 if (ctrl
== 0 || alt
== 0)
2778 /* Emacs doesn't have keyboard focus. Do nothing. */
2781 if (!(ctrl
& 0x08000))
2782 /* Clear any recorded control modifier state. */
2783 modifiers
[EMACS_RCONTROL
] = modifiers
[EMACS_LCONTROL
] = 0;
2785 if (!(alt
& 0x08000))
2786 /* Clear any recorded alt modifier state. */
2787 modifiers
[EMACS_RMENU
] = modifiers
[EMACS_LMENU
] = 0;
2789 /* Otherwise, leave the modifier state as it was when Emacs lost
2793 /* Synchronize modifier state with what is reported with the current
2794 keystroke. Even if we cannot distinguish between left and right
2795 modifier keys, we know that, if no modifiers are set, then neither
2796 the left or right modifier should be set. */
2800 if (!modifiers_recorded
)
2803 if (!(GetKeyState (VK_CONTROL
) & 0x8000))
2804 modifiers
[EMACS_RCONTROL
] = modifiers
[EMACS_LCONTROL
] = 0;
2806 if (!(GetKeyState (VK_MENU
) & 0x8000))
2807 modifiers
[EMACS_RMENU
] = modifiers
[EMACS_LMENU
] = 0;
2811 modifier_set (int vkey
)
2813 if (vkey
== VK_CAPITAL
)
2814 return (GetKeyState (vkey
) & 0x1);
2815 if (!modifiers_recorded
)
2816 return (GetKeyState (vkey
) & 0x8000);
2821 return modifiers
[EMACS_LCONTROL
];
2823 return modifiers
[EMACS_RCONTROL
];
2825 return modifiers
[EMACS_LMENU
];
2827 return modifiers
[EMACS_RMENU
];
2831 return (GetKeyState (vkey
) & 0x8000);
2834 /* We map the VK_* modifiers into console modifier constants
2835 so that we can use the same routines to handle both console
2836 and window input. */
2839 construct_modifiers (unsigned int wparam
, unsigned int lparam
)
2843 if (wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
)
2844 mods
= GetLastError ();
2847 mods
|= (modifier_set (VK_SHIFT
)) ? SHIFT_PRESSED
: 0;
2848 mods
|= (modifier_set (VK_CAPITAL
)) ? CAPSLOCK_ON
: 0;
2849 mods
|= (modifier_set (VK_LCONTROL
)) ? LEFT_CTRL_PRESSED
: 0;
2850 mods
|= (modifier_set (VK_RCONTROL
)) ? RIGHT_CTRL_PRESSED
: 0;
2851 mods
|= (modifier_set (VK_LMENU
)) ? LEFT_ALT_PRESSED
: 0;
2852 mods
|= (modifier_set (VK_RMENU
)) ? RIGHT_ALT_PRESSED
: 0;
2858 map_keypad_keys (unsigned int wparam
, unsigned int lparam
)
2860 unsigned int extended
= (lparam
& 0x1000000L
);
2862 if (wparam
< VK_CLEAR
|| wparam
> VK_DELETE
)
2865 if (wparam
== VK_RETURN
)
2866 return (extended
? VK_NUMPAD_ENTER
: VK_RETURN
);
2868 if (wparam
>= VK_PRIOR
&& wparam
<= VK_DOWN
)
2869 return (!extended
? (VK_NUMPAD_PRIOR
+ (wparam
- VK_PRIOR
)) : wparam
);
2871 if (wparam
== VK_INSERT
|| wparam
== VK_DELETE
)
2872 return (!extended
? (VK_NUMPAD_INSERT
+ (wparam
- VK_INSERT
)) : wparam
);
2874 if (wparam
== VK_CLEAR
)
2875 return (!extended
? VK_NUMPAD_CLEAR
: wparam
);
2880 /* Main message dispatch loop. */
2883 windows_msg_worker (dw
)
2888 /* Ensure our message queue is created */
2890 PeekMessage (&msg
, NULL
, 0, 0, PM_NOREMOVE
);
2892 PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
, 0, 0);
2894 while (GetMessage (&msg
, NULL
, 0, 0))
2896 if (msg
.hwnd
== NULL
)
2898 switch (msg
.message
)
2900 case WM_EMACS_CREATEWINDOW
:
2901 w32_createwindow ((struct frame
*) msg
.wParam
);
2902 PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
, 0, 0);
2904 case WM_EMACS_CREATESCROLLBAR
:
2906 HWND hwnd
= w32_createscrollbar ((struct frame
*) msg
.wParam
,
2907 (struct scroll_bar
*) msg
.lParam
);
2908 PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
, (WPARAM
)hwnd
, 0);
2917 DispatchMessage (&msg
);
2924 /* Main window procedure */
2926 extern char *lispy_function_keys
[];
2929 w32_wnd_proc (hwnd
, msg
, wParam
, lParam
)
2937 struct w32_display_info
*dpyinfo
= &one_w32_display_info
;
2939 int windows_translate
;
2941 /* Note that it is okay to call x_window_to_frame, even though we are
2942 not running in the main lisp thread, because frame deletion
2943 requires the lisp thread to synchronize with this thread. Thus, if
2944 a frame struct is returned, it can be used without concern that the
2945 lisp thread might make it disappear while we are using it.
2947 NB. Walking the frame list in this thread is safe (as long as
2948 writes of Lisp_Object slots are atomic, which they are on Windows).
2949 Although delete-frame can destructively modify the frame list while
2950 we are walking it, a garbage collection cannot occur until after
2951 delete-frame has synchronized with this thread.
2953 It is also safe to use functions that make GDI calls, such as
2954 w32_clear_rect, because these functions must obtain a DC handle
2955 from the frame struct using get_frame_dc which is thread-aware. */
2960 f
= x_window_to_frame (dpyinfo
, hwnd
);
2963 GetUpdateRect (hwnd
, &wmsg
.rect
, FALSE
);
2964 w32_clear_rect (f
, NULL
, &wmsg
.rect
);
2967 case WM_PALETTECHANGED
:
2968 /* ignore our own changes */
2969 if ((HWND
)wParam
!= hwnd
)
2971 f
= x_window_to_frame (dpyinfo
, hwnd
);
2973 /* get_frame_dc will realize our palette and force all
2974 frames to be redrawn if needed. */
2975 release_frame_dc (f
, get_frame_dc (f
));
2980 PAINTSTRUCT paintStruct
;
2983 BeginPaint (hwnd
, &paintStruct
);
2984 wmsg
.rect
= paintStruct
.rcPaint
;
2985 EndPaint (hwnd
, &paintStruct
);
2988 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
2995 record_keyup (wParam
, lParam
);
3000 /* Synchronize modifiers with current keystroke. */
3003 record_keydown (wParam
, lParam
);
3005 wParam
= map_keypad_keys (wParam
, lParam
);
3007 windows_translate
= 0;
3012 /* More support for these keys will likely be necessary. */
3013 if (!NILP (Vw32_pass_optional_keys_to_system
))
3014 windows_translate
= 1;
3017 if (NILP (Vw32_pass_alt_to_system
))
3019 windows_translate
= 1;
3026 windows_translate
= 1;
3029 /* If not defined as a function key, change it to a WM_CHAR message. */
3030 if (lispy_function_keys
[wParam
] == 0)
3035 if (windows_translate
)
3037 MSG windows_msg
= { hwnd
, msg
, wParam
, lParam
, 0, {0,0} };
3039 windows_msg
.time
= GetMessageTime ();
3040 TranslateMessage (&windows_msg
);
3048 wmsg
.dwModifiers
= construct_modifiers (wParam
, lParam
);
3051 /* Detect quit_char and set quit-flag directly. Note that we
3052 still need to post a message to ensure the main thread will be
3053 woken up if blocked in sys_select(), but we do NOT want to post
3054 the quit_char message itself (because it will usually be as if
3055 the user had typed quit_char twice). Instead, we post a dummy
3056 message that has no particular effect. */
3059 if (isalpha (c
) && (wmsg
.dwModifiers
== LEFT_CTRL_PRESSED
3060 || wmsg
.dwModifiers
== RIGHT_CTRL_PRESSED
))
3061 c
= make_ctrl_char (c
) & 0377;
3066 /* The choice of message is somewhat arbitrary, as long as
3067 the main thread handler just ignores it. */
3073 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3077 /* Simulate middle mouse button events when left and right buttons
3078 are used together, but only if user has two button mouse. */
3079 case WM_LBUTTONDOWN
:
3080 case WM_RBUTTONDOWN
:
3081 if (XINT (Vw32_num_mouse_buttons
) == 3)
3082 goto handle_plain_button
;
3085 int this = (msg
== WM_LBUTTONDOWN
) ? LMOUSE
: RMOUSE
;
3086 int other
= (msg
== WM_LBUTTONDOWN
) ? RMOUSE
: LMOUSE
;
3088 if (button_state
& this)
3091 if (button_state
== 0)
3094 button_state
|= this;
3096 if (button_state
& other
)
3098 if (mouse_button_timer
)
3100 KillTimer (hwnd
, mouse_button_timer
);
3101 mouse_button_timer
= 0;
3103 /* Generate middle mouse event instead. */
3104 msg
= WM_MBUTTONDOWN
;
3105 button_state
|= MMOUSE
;
3107 else if (button_state
& MMOUSE
)
3109 /* Ignore button event if we've already generated a
3110 middle mouse down event. This happens if the
3111 user releases and press one of the two buttons
3112 after we've faked a middle mouse event. */
3117 /* Flush out saved message. */
3118 post_msg (&saved_mouse_button_msg
);
3120 wmsg
.dwModifiers
= w32_get_modifiers ();
3121 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3123 /* Clear message buffer. */
3124 saved_mouse_button_msg
.msg
.hwnd
= 0;
3128 /* Hold onto message for now. */
3129 mouse_button_timer
=
3130 SetTimer (hwnd
, MOUSE_BUTTON_ID
, XINT (Vw32_mouse_button_tolerance
), NULL
);
3131 saved_mouse_button_msg
.msg
.hwnd
= hwnd
;
3132 saved_mouse_button_msg
.msg
.message
= msg
;
3133 saved_mouse_button_msg
.msg
.wParam
= wParam
;
3134 saved_mouse_button_msg
.msg
.lParam
= lParam
;
3135 saved_mouse_button_msg
.msg
.time
= GetMessageTime ();
3136 saved_mouse_button_msg
.dwModifiers
= w32_get_modifiers ();
3143 if (XINT (Vw32_num_mouse_buttons
) == 3)
3144 goto handle_plain_button
;
3147 int this = (msg
== WM_LBUTTONUP
) ? LMOUSE
: RMOUSE
;
3148 int other
= (msg
== WM_LBUTTONUP
) ? RMOUSE
: LMOUSE
;
3150 if ((button_state
& this) == 0)
3153 button_state
&= ~this;
3155 if (button_state
& MMOUSE
)
3157 /* Only generate event when second button is released. */
3158 if ((button_state
& other
) == 0)
3161 button_state
&= ~MMOUSE
;
3163 if (button_state
) abort ();
3170 /* Flush out saved message if necessary. */
3171 if (saved_mouse_button_msg
.msg
.hwnd
)
3173 post_msg (&saved_mouse_button_msg
);
3176 wmsg
.dwModifiers
= w32_get_modifiers ();
3177 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3179 /* Always clear message buffer and cancel timer. */
3180 saved_mouse_button_msg
.msg
.hwnd
= 0;
3181 KillTimer (hwnd
, mouse_button_timer
);
3182 mouse_button_timer
= 0;
3184 if (button_state
== 0)
3189 case WM_MBUTTONDOWN
:
3191 handle_plain_button
:
3195 if (parse_button (msg
, NULL
, &up
))
3197 if (up
) ReleaseCapture ();
3198 else SetCapture (hwnd
);
3202 wmsg
.dwModifiers
= w32_get_modifiers ();
3203 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3208 if (XINT (Vw32_mouse_move_interval
) <= 0
3209 || (msg
== WM_MOUSEMOVE
&& button_state
== 0))
3211 wmsg
.dwModifiers
= w32_get_modifiers ();
3212 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3216 /* Hang onto mouse move and scroll messages for a bit, to avoid
3217 sending such events to Emacs faster than it can process them.
3218 If we get more events before the timer from the first message
3219 expires, we just replace the first message. */
3221 if (saved_mouse_move_msg
.msg
.hwnd
== 0)
3223 SetTimer (hwnd
, MOUSE_MOVE_ID
, XINT (Vw32_mouse_move_interval
), NULL
);
3225 /* Hold onto message for now. */
3226 saved_mouse_move_msg
.msg
.hwnd
= hwnd
;
3227 saved_mouse_move_msg
.msg
.message
= msg
;
3228 saved_mouse_move_msg
.msg
.wParam
= wParam
;
3229 saved_mouse_move_msg
.msg
.lParam
= lParam
;
3230 saved_mouse_move_msg
.msg
.time
= GetMessageTime ();
3231 saved_mouse_move_msg
.dwModifiers
= w32_get_modifiers ();
3236 /* Flush out saved messages if necessary. */
3237 if (wParam
== mouse_button_timer
)
3239 if (saved_mouse_button_msg
.msg
.hwnd
)
3241 post_msg (&saved_mouse_button_msg
);
3242 saved_mouse_button_msg
.msg
.hwnd
= 0;
3244 KillTimer (hwnd
, mouse_button_timer
);
3245 mouse_button_timer
= 0;
3247 else if (wParam
== mouse_move_timer
)
3249 if (saved_mouse_move_msg
.msg
.hwnd
)
3251 post_msg (&saved_mouse_move_msg
);
3252 saved_mouse_move_msg
.msg
.hwnd
= 0;
3254 KillTimer (hwnd
, mouse_move_timer
);
3255 mouse_move_timer
= 0;
3260 /* Windows doesn't send us focus messages when putting up and
3261 taking down a system popup dialog as for Ctrl-Alt-Del on Windows 95.
3262 The only indication we get that something happened is receiving
3263 this message afterwards. So this is a good time to reset our
3264 keyboard modifiers' state. */
3275 wmsg
.dwModifiers
= w32_get_modifiers ();
3276 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3280 wmsg
.dwModifiers
= w32_get_modifiers ();
3281 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3284 case WM_WINDOWPOSCHANGING
:
3287 LPWINDOWPOS lppos
= (WINDOWPOS
*) lParam
;
3289 GetWindowPlacement (hwnd
, &wp
);
3291 if (wp
.showCmd
!= SW_SHOWMINIMIZED
&& ! (lppos
->flags
& SWP_NOSIZE
))
3300 wp
.length
= sizeof(wp
);
3301 GetWindowRect (hwnd
, &wr
);
3305 dwXUnits
= GetWindowLong (hwnd
, WND_X_UNITS_INDEX
);
3306 dwYUnits
= GetWindowLong (hwnd
, WND_Y_UNITS_INDEX
);
3310 memset (&rect
, 0, sizeof (rect
));
3311 AdjustWindowRect (&rect
, GetWindowLong (hwnd
, GWL_STYLE
),
3312 GetMenu (hwnd
) != NULL
);
3314 /* All windows have an extra pixel so subtract 1 */
3316 wdiff
= (lppos
->cx
- (rect
.right
- rect
.left
) - 0) % dwXUnits
;
3317 hdiff
= (lppos
->cy
- (rect
.bottom
- rect
.top
) - 0) % dwYUnits
;
3321 /* For right/bottom sizing we can just fix the sizes.
3322 However for top/left sizing we will need to fix the X
3323 and Y positions as well. */
3328 if (wp
.showCmd
!= SW_SHOWMAXIMIZED
3329 && ! (lppos
->flags
& SWP_NOMOVE
))
3331 if (lppos
->x
!= wr
.left
|| lppos
->y
!= wr
.top
)
3338 lppos
->flags
|= SWP_NOMOVE
;
3347 if (ret
== 0) return (0);
3350 case WM_EMACS_SHOWWINDOW
:
3351 return ShowWindow (hwnd
, wParam
);
3352 case WM_EMACS_SETWINDOWPOS
:
3354 W32WindowPos
* pos
= (W32WindowPos
*) wParam
;
3355 return SetWindowPos (hwnd
, pos
->hwndAfter
,
3356 pos
->x
, pos
->y
, pos
->cx
, pos
->cy
, pos
->flags
);
3358 case WM_EMACS_DESTROYWINDOW
:
3359 DestroyWindow ((HWND
) wParam
);
3363 return DefWindowProc (hwnd
, msg
, wParam
, lParam
);
3370 my_create_window (f
)
3375 PostThreadMessage (dwWindowsThreadId
, WM_EMACS_CREATEWINDOW
, (WPARAM
)f
, 0);
3376 GetMessage (&msg
, NULL
, WM_EMACS_DONE
, WM_EMACS_DONE
);
3379 /* Create and set up the w32 window for frame F. */
3382 w32_window (f
, window_prompting
, minibuffer_only
)
3384 long window_prompting
;
3385 int minibuffer_only
;
3389 /* Use the resource name as the top-level window name
3390 for looking up resources. Make a non-Lisp copy
3391 for the window manager, so GC relocation won't bother it.
3393 Elsewhere we specify the window name for the window manager. */
3396 char *str
= (char *) XSTRING (Vx_resource_name
)->data
;
3397 f
->namebuf
= (char *) xmalloc (strlen (str
) + 1);
3398 strcpy (f
->namebuf
, str
);
3401 my_create_window (f
);
3403 validate_x_resource_name ();
3405 /* x_set_name normally ignores requests to set the name if the
3406 requested name is the same as the current name. This is the one
3407 place where that assumption isn't correct; f->name is set, but
3408 the server hasn't been told. */
3411 int explicit = f
->explicit_name
;
3413 f
->explicit_name
= 0;
3416 x_set_name (f
, name
, explicit);
3421 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
3422 initialize_frame_menubar (f
);
3424 if (FRAME_W32_WINDOW (f
) == 0)
3425 error ("Unable to create window");
3428 /* Handle the icon stuff for this window. Perhaps later we might
3429 want an x_set_icon_position which can be called interactively as
3437 Lisp_Object icon_x
, icon_y
;
3439 /* Set the position of the icon. Note that Windows 95 groups all
3440 icons in the tray. */
3441 icon_x
= x_get_arg (parms
, Qicon_left
, 0, 0, number
);
3442 icon_y
= x_get_arg (parms
, Qicon_top
, 0, 0, number
);
3443 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
3445 CHECK_NUMBER (icon_x
, 0);
3446 CHECK_NUMBER (icon_y
, 0);
3448 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
3449 error ("Both left and top icon corners of icon must be specified");
3453 if (! EQ (icon_x
, Qunbound
))
3454 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
3459 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
3461 "Make a new window, which is called a \"frame\" in Emacs terms.\n\
3462 Returns an Emacs frame object.\n\
3463 ALIST is an alist of frame parameters.\n\
3464 If the parameters specify that the frame should not have a minibuffer,\n\
3465 and do not specify a specific minibuffer window to use,\n\
3466 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
3467 be shared by the new frame.\n\
3469 This function is an internal primitive--use `make-frame' instead.")
3474 Lisp_Object frame
, tem
;
3476 int minibuffer_only
= 0;
3477 long window_prompting
= 0;
3479 int count
= specpdl_ptr
- specpdl
;
3480 struct gcpro gcpro1
;
3481 Lisp_Object display
;
3482 struct w32_display_info
*dpyinfo
;
3486 /* Use this general default value to start with
3487 until we know if this frame has a specified name. */
3488 Vx_resource_name
= Vinvocation_name
;
3490 display
= x_get_arg (parms
, Qdisplay
, 0, 0, string
);
3491 if (EQ (display
, Qunbound
))
3493 dpyinfo
= check_x_display_info (display
);
3495 kb
= dpyinfo
->kboard
;
3497 kb
= &the_only_kboard
;
3500 name
= x_get_arg (parms
, Qname
, "title", "Title", string
);
3502 && ! EQ (name
, Qunbound
)
3504 error ("Invalid frame name--not a string or nil");
3507 Vx_resource_name
= name
;
3509 /* See if parent window is specified. */
3510 parent
= x_get_arg (parms
, Qparent_id
, NULL
, NULL
, number
);
3511 if (EQ (parent
, Qunbound
))
3513 if (! NILP (parent
))
3514 CHECK_NUMBER (parent
, 0);
3516 tem
= x_get_arg (parms
, Qminibuffer
, 0, 0, symbol
);
3517 if (EQ (tem
, Qnone
) || NILP (tem
))
3518 f
= make_frame_without_minibuffer (Qnil
, kb
, display
);
3519 else if (EQ (tem
, Qonly
))
3521 f
= make_minibuffer_frame ();
3522 minibuffer_only
= 1;
3524 else if (WINDOWP (tem
))
3525 f
= make_frame_without_minibuffer (tem
, kb
, display
);
3529 /* Note that Windows does support scroll bars. */
3530 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
3531 /* By default, make scrollbars the system standard width. */
3532 f
->scroll_bar_pixel_width
= GetSystemMetrics (SM_CXVSCROLL
);
3534 XSETFRAME (frame
, f
);
3537 f
->output_method
= output_w32
;
3538 f
->output_data
.w32
= (struct w32_output
*) xmalloc (sizeof (struct w32_output
));
3539 bzero (f
->output_data
.w32
, sizeof (struct w32_output
));
3541 /* FRAME_W32_DISPLAY_INFO (f) = dpyinfo; */
3543 FRAME_KBOARD (f
) = kb
;
3546 /* Specify the parent under which to make this window. */
3550 f
->output_data
.w32
->parent_desc
= (Window
) parent
;
3551 f
->output_data
.w32
->explicit_parent
= 1;
3555 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
3556 f
->output_data
.w32
->explicit_parent
= 0;
3559 /* Note that the frame has no physical cursor right now. */
3560 f
->phys_cursor_x
= -1;
3562 /* Set the name; the functions to which we pass f expect the name to
3564 if (EQ (name
, Qunbound
) || NILP (name
))
3566 f
->name
= build_string (dpyinfo
->w32_id_name
);
3567 f
->explicit_name
= 0;
3572 f
->explicit_name
= 1;
3573 /* use the frame's title when getting resources for this frame. */
3574 specbind (Qx_resource_name
, name
);
3577 /* Extract the window parameters from the supplied values
3578 that are needed to determine window geometry. */
3582 font
= x_get_arg (parms
, Qfont
, "font", "Font", string
);
3584 /* First, try whatever font the caller has specified. */
3586 font
= x_new_font (f
, XSTRING (font
)->data
);
3588 /* Try out a font which we hope has bold and italic variations. */
3589 if (!STRINGP (font
))
3590 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3591 if (! STRINGP (font
))
3592 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3593 if (! STRINGP (font
))
3594 /* This was formerly the first thing tried, but it finds too many fonts
3595 and takes too long. */
3596 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
3597 /* If those didn't work, look for something which will at least work. */
3598 if (! STRINGP (font
))
3599 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
3600 if (! STRINGP (font
))
3601 font
= x_new_font (f
, "-*-system-medium-r-normal-*-*-200-*-*-c-120-*-*");
3603 if (! STRINGP (font
))
3604 font
= x_new_font (f
, "-*-Fixedsys-*-r-*-*-12-90-*-*-c-*-*-*");
3606 if (! STRINGP (font
))
3607 font
= build_string ("-*-system");
3609 x_default_parameter (f
, parms
, Qfont
, font
,
3610 "font", "Font", string
);
3613 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
3614 "borderwidth", "BorderWidth", number
);
3615 /* This defaults to 2 in order to match xterm. We recognize either
3616 internalBorderWidth or internalBorder (which is what xterm calls
3618 if (NILP (Fassq (Qinternal_border_width
, parms
)))
3622 value
= x_get_arg (parms
, Qinternal_border_width
,
3623 "internalBorder", "BorderWidth", number
);
3624 if (! EQ (value
, Qunbound
))
3625 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
3628 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (0),
3629 "internalBorderWidth", "BorderWidth", number
);
3630 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qt
,
3631 "verticalScrollBars", "ScrollBars", boolean
);
3633 /* Also do the stuff which must be set before the window exists. */
3634 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
3635 "foreground", "Foreground", string
);
3636 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
3637 "background", "Background", string
);
3638 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
3639 "pointerColor", "Foreground", string
);
3640 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
3641 "cursorColor", "Foreground", string
);
3642 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
3643 "borderColor", "BorderColor", string
);
3645 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (1),
3646 "menuBar", "MenuBar", number
);
3647 x_default_parameter (f
, parms
, Qscroll_bar_width
, Qnil
,
3648 "scrollBarWidth", "ScrollBarWidth", number
);
3650 f
->output_data
.w32
->dwStyle
= WS_OVERLAPPEDWINDOW
;
3651 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
3652 window_prompting
= x_figure_window_size (f
, parms
);
3654 if (window_prompting
& XNegative
)
3656 if (window_prompting
& YNegative
)
3657 f
->output_data
.w32
->win_gravity
= SouthEastGravity
;
3659 f
->output_data
.w32
->win_gravity
= NorthEastGravity
;
3663 if (window_prompting
& YNegative
)
3664 f
->output_data
.w32
->win_gravity
= SouthWestGravity
;
3666 f
->output_data
.w32
->win_gravity
= NorthWestGravity
;
3669 f
->output_data
.w32
->size_hint_flags
= window_prompting
;
3671 w32_window (f
, window_prompting
, minibuffer_only
);
3673 init_frame_faces (f
);
3675 /* We need to do this after creating the window, so that the
3676 icon-creation functions can say whose icon they're describing. */
3677 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
3678 "bitmapIcon", "BitmapIcon", symbol
);
3680 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
3681 "autoRaise", "AutoRaiseLower", boolean
);
3682 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
3683 "autoLower", "AutoRaiseLower", boolean
);
3684 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
3685 "cursorType", "CursorType", symbol
);
3687 /* Dimensions, especially f->height, must be done via change_frame_size.
3688 Change will not be effected unless different from the current
3693 SET_FRAME_WIDTH (f
, 0);
3694 change_frame_size (f
, height
, width
, 1, 0);
3696 /* Tell the server what size and position, etc, we want,
3697 and how badly we want them. */
3699 x_wm_set_size_hint (f
, window_prompting
, 0);
3702 tem
= x_get_arg (parms
, Qunsplittable
, 0, 0, boolean
);
3703 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
3707 /* It is now ok to make the frame official
3708 even if we get an error below.
3709 And the frame needs to be on Vframe_list
3710 or making it visible won't work. */
3711 Vframe_list
= Fcons (frame
, Vframe_list
);
3713 /* Now that the frame is official, it counts as a reference to
3715 FRAME_W32_DISPLAY_INFO (f
)->reference_count
++;
3717 /* Make the window appear on the frame and enable display,
3718 unless the caller says not to. However, with explicit parent,
3719 Emacs cannot control visibility, so don't try. */
3720 if (! f
->output_data
.w32
->explicit_parent
)
3722 Lisp_Object visibility
;
3724 visibility
= x_get_arg (parms
, Qvisibility
, 0, 0, symbol
);
3725 if (EQ (visibility
, Qunbound
))
3728 if (EQ (visibility
, Qicon
))
3729 x_iconify_frame (f
);
3730 else if (! NILP (visibility
))
3731 x_make_frame_visible (f
);
3733 /* Must have been Qnil. */
3737 return unbind_to (count
, frame
);
3740 /* FRAME is used only to get a handle on the X display. We don't pass the
3741 display info directly because we're called from frame.c, which doesn't
3742 know about that structure. */
3744 x_get_focus_frame (frame
)
3745 struct frame
*frame
;
3747 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (frame
);
3749 if (! dpyinfo
->w32_focus_frame
)
3752 XSETFRAME (xfocus
, dpyinfo
->w32_focus_frame
);
3757 w32_load_font (dpyinfo
,name
)
3758 struct w32_display_info
*dpyinfo
;
3761 XFontStruct
* font
= NULL
;
3767 if (!name
|| !x_to_w32_font (name
, &lf
))
3770 font
= (XFontStruct
*) xmalloc (sizeof (XFontStruct
));
3772 if (!font
) return (NULL
);
3776 font
->hfont
= CreateFontIndirect (&lf
);
3779 if (font
->hfont
== NULL
)
3788 hdc
= GetDC (dpyinfo
->root_window
);
3789 oldobj
= SelectObject (hdc
, font
->hfont
);
3790 ok
= GetTextMetrics (hdc
, &font
->tm
);
3791 SelectObject (hdc
, oldobj
);
3792 ReleaseDC (dpyinfo
->root_window
, hdc
);
3797 if (ok
) return (font
);
3799 w32_unload_font (dpyinfo
, font
);
3804 w32_unload_font (dpyinfo
, font
)
3805 struct w32_display_info
*dpyinfo
;
3810 if (font
->hfont
) DeleteObject(font
->hfont
);
3815 /* The font conversion stuff between x and w32 */
3817 /* X font string is as follows (from faces.el)
3821 * (weight "\\(bold\\|demibold\\|medium\\)") ; 1
3822 * (weight\? "\\([^-]*\\)") ; 1
3823 * (slant "\\([ior]\\)") ; 2
3824 * (slant\? "\\([^-]?\\)") ; 2
3825 * (swidth "\\([^-]*\\)") ; 3
3826 * (adstyle "[^-]*") ; 4
3827 * (pixelsize "[0-9]+")
3828 * (pointsize "[0-9][0-9]+")
3829 * (resx "[0-9][0-9]+")
3830 * (resy "[0-9][0-9]+")
3831 * (spacing "[cmp?*]")
3832 * (avgwidth "[0-9]+")
3833 * (registry "[^-]+")
3834 * (encoding "[^-]+")
3836 * (setq x-font-regexp
3837 * (concat "\\`\\*?[-?*]"
3838 * foundry - family - weight\? - slant\? - swidth - adstyle -
3839 * pixelsize - pointsize - resx - resy - spacing - registry -
3840 * encoding "[-?*]\\*?\\'"
3842 * (setq x-font-regexp-head
3843 * (concat "\\`[-?*]" foundry - family - weight\? - slant\?
3844 * "\\([-*?]\\|\\'\\)"))
3845 * (setq x-font-regexp-slant (concat - slant -))
3846 * (setq x-font-regexp-weight (concat - weight -))
3850 #define FONT_START "[-?]"
3851 #define FONT_FOUNDRY "[^-]+"
3852 #define FONT_FAMILY "\\([^-]+\\)" /* 1 */
3853 #define FONT_WEIGHT "\\(bold\\|demibold\\|medium\\)" /* 2 */
3854 #define FONT_WEIGHT_Q "\\([^-]*\\)" /* 2 */
3855 #define FONT_SLANT "\\([ior]\\)" /* 3 */
3856 #define FONT_SLANT_Q "\\([^-]?\\)" /* 3 */
3857 #define FONT_SWIDTH "\\([^-]*\\)" /* 4 */
3858 #define FONT_ADSTYLE "[^-]*"
3859 #define FONT_PIXELSIZE "[^-]*"
3860 #define FONT_POINTSIZE "\\([0-9][0-9]+\\|\\*\\)" /* 5 */
3861 #define FONT_RESX "[0-9][0-9]+"
3862 #define FONT_RESY "[0-9][0-9]+"
3863 #define FONT_SPACING "[cmp?*]"
3864 #define FONT_AVGWIDTH "[0-9]+"
3865 #define FONT_REGISTRY "[^-]+"
3866 #define FONT_ENCODING "[^-]+"
3868 #define FONT_REGEXP ("\\`\\*?[-?*]" \
3875 FONT_PIXELSIZE "-" \
3876 FONT_POINTSIZE "-" \
3879 #define FONT_REGEXP_HEAD ("\\`[-?*]" \
3884 "\\([-*?]\\|\\'\\)")
3886 #define FONT_REGEXP_SLANT "-" FONT_SLANT "-"
3887 #define FONT_REGEXP_WEIGHT "-" FONT_WEIGHT "-"
3890 x_to_w32_weight (lpw
)
3893 if (!lpw
) return (FW_DONTCARE
);
3895 if (stricmp (lpw
,"heavy") == 0) return FW_HEAVY
;
3896 else if (stricmp (lpw
,"extrabold") == 0) return FW_EXTRABOLD
;
3897 else if (stricmp (lpw
,"bold") == 0) return FW_BOLD
;
3898 else if (stricmp (lpw
,"demibold") == 0) return FW_SEMIBOLD
;
3899 else if (stricmp (lpw
,"medium") == 0) return FW_MEDIUM
;
3900 else if (stricmp (lpw
,"normal") == 0) return FW_NORMAL
;
3901 else if (stricmp (lpw
,"light") == 0) return FW_LIGHT
;
3902 else if (stricmp (lpw
,"extralight") == 0) return FW_EXTRALIGHT
;
3903 else if (stricmp (lpw
,"thin") == 0) return FW_THIN
;
3910 w32_to_x_weight (fnweight
)
3913 if (fnweight
>= FW_HEAVY
) return "heavy";
3914 if (fnweight
>= FW_EXTRABOLD
) return "extrabold";
3915 if (fnweight
>= FW_BOLD
) return "bold";
3916 if (fnweight
>= FW_SEMIBOLD
) return "semibold";
3917 if (fnweight
>= FW_MEDIUM
) return "medium";
3918 if (fnweight
>= FW_NORMAL
) return "normal";
3919 if (fnweight
>= FW_LIGHT
) return "light";
3920 if (fnweight
>= FW_EXTRALIGHT
) return "extralight";
3921 if (fnweight
>= FW_THIN
) return "thin";
3927 x_to_w32_charset (lpcs
)
3930 if (!lpcs
) return (0);
3932 if (stricmp (lpcs
,"ansi") == 0) return ANSI_CHARSET
;
3933 else if (stricmp (lpcs
,"iso8859-1") == 0) return ANSI_CHARSET
;
3934 else if (stricmp (lpcs
,"iso8859") == 0) return ANSI_CHARSET
;
3935 else if (stricmp (lpcs
,"oem") == 0) return OEM_CHARSET
;
3936 #ifdef UNICODE_CHARSET
3937 else if (stricmp (lpcs
,"unicode") == 0) return UNICODE_CHARSET
;
3938 else if (stricmp (lpcs
,"iso10646") == 0) return UNICODE_CHARSET
;
3945 w32_to_x_charset (fncharset
)
3950 case ANSI_CHARSET
: return "ansi";
3951 case OEM_CHARSET
: return "oem";
3952 case SYMBOL_CHARSET
: return "symbol";
3953 #ifdef UNICODE_CHARSET
3954 case UNICODE_CHARSET
: return "unicode";
3961 w32_to_x_font (lplogfont
, lpxstr
, len
)
3962 LOGFONT
* lplogfont
;
3966 char height_pixels
[8];
3968 char width_pixels
[8];
3970 if (!lpxstr
) abort ();
3975 if (lplogfont
->lfHeight
)
3977 sprintf (height_pixels
, "%u", abs (lplogfont
->lfHeight
));
3978 sprintf (height_dpi
, "%u",
3979 (abs (lplogfont
->lfHeight
) * 720) / one_w32_display_info
.height_in
);
3983 strcpy (height_pixels
, "*");
3984 strcpy (height_dpi
, "*");
3986 if (lplogfont
->lfWidth
)
3987 sprintf (width_pixels
, "%u", lplogfont
->lfWidth
* 10);
3989 strcpy (width_pixels
, "*");
3991 _snprintf (lpxstr
, len
- 1,
3992 "-*-%s-%s-%c-*-*-%s-%s-*-*-%c-%s-*-%s-",
3993 lplogfont
->lfFaceName
,
3994 w32_to_x_weight (lplogfont
->lfWeight
),
3995 lplogfont
->lfItalic
?'i':'r',
3998 ((lplogfont
->lfPitchAndFamily
& 0x3) == VARIABLE_PITCH
) ? 'p' : 'c',
4000 w32_to_x_charset (lplogfont
->lfCharSet
)
4003 lpxstr
[len
- 1] = 0; /* just to be sure */
4008 x_to_w32_font (lpxstr
, lplogfont
)
4010 LOGFONT
* lplogfont
;
4012 if (!lplogfont
) return (FALSE
);
4014 memset (lplogfont
, 0, sizeof (*lplogfont
));
4017 lplogfont
->lfOutPrecision
= OUT_DEFAULT_PRECIS
;
4018 lplogfont
->lfClipPrecision
= CLIP_DEFAULT_PRECIS
;
4019 lplogfont
->lfQuality
= DEFAULT_QUALITY
;
4021 /* go for maximum quality */
4022 lplogfont
->lfOutPrecision
= OUT_STROKE_PRECIS
;
4023 lplogfont
->lfClipPrecision
= CLIP_STROKE_PRECIS
;
4024 lplogfont
->lfQuality
= PROOF_QUALITY
;
4030 /* Provide a simple escape mechanism for specifying Windows font names
4031 * directly -- if font spec does not beginning with '-', assume this
4033 * "<font name>[:height in pixels[:width in pixels[:weight]]]"
4039 char name
[50], weight
[20], slant
, pitch
, pixels
[10], height
[10], width
[10], remainder
[20];
4042 fields
= sscanf (lpxstr
,
4043 "-%*[^-]-%49[^-]-%19[^-]-%c-%*[^-]-%*[^-]-%9[^-]-%9[^-]-%*[^-]-%*[^-]-%c-%9[^-]-%19s",
4044 name
, weight
, &slant
, pixels
, height
, &pitch
, width
, remainder
);
4046 if (fields
== EOF
) return (FALSE
);
4048 if (fields
> 0 && name
[0] != '*')
4050 strncpy (lplogfont
->lfFaceName
,name
, LF_FACESIZE
);
4051 lplogfont
->lfFaceName
[LF_FACESIZE
-1] = 0;
4055 lplogfont
->lfFaceName
[0] = 0;
4060 lplogfont
->lfWeight
= x_to_w32_weight ((fields
> 0 ? weight
: ""));
4064 if (!NILP (Vw32_enable_italics
))
4065 lplogfont
->lfItalic
= (fields
> 0 && slant
== 'i');
4069 if (fields
> 0 && pixels
[0] != '*')
4070 lplogfont
->lfHeight
= atoi (pixels
);
4074 if (fields
> 0 && lplogfont
->lfHeight
== 0 && height
[0] != '*')
4075 lplogfont
->lfHeight
= (atoi (height
)
4076 * one_w32_display_info
.height_in
) / 720;
4080 lplogfont
->lfPitchAndFamily
=
4081 (fields
> 0 && pitch
== 'p') ? VARIABLE_PITCH
: FIXED_PITCH
;
4085 if (fields
> 0 && width
[0] != '*')
4086 lplogfont
->lfWidth
= atoi (width
) / 10;
4090 /* Not all font specs include the registry field, so we allow for an
4091 optional registry field before the encoding when parsing
4092 remainder. Also we strip the trailing '-' if present. */
4094 int len
= strlen (remainder
);
4095 if (len
> 0 && remainder
[len
-1] == '-')
4096 remainder
[len
-1] = 0;
4098 encoding
= remainder
;
4099 if (strncmp (encoding
, "*-", 2) == 0)
4101 lplogfont
->lfCharSet
= x_to_w32_charset (fields
> 0 ? encoding
: "");
4106 char name
[100], height
[10], width
[10], weight
[20];
4108 fields
= sscanf (lpxstr
,
4109 "%99[^:]:%9[^:]:%9[^:]:%19s",
4110 name
, height
, width
, weight
);
4112 if (fields
== EOF
) return (FALSE
);
4116 strncpy (lplogfont
->lfFaceName
,name
, LF_FACESIZE
);
4117 lplogfont
->lfFaceName
[LF_FACESIZE
-1] = 0;
4121 lplogfont
->lfFaceName
[0] = 0;
4127 lplogfont
->lfHeight
= atoi (height
);
4132 lplogfont
->lfWidth
= atoi (width
);
4136 lplogfont
->lfWeight
= x_to_w32_weight ((fields
> 0 ? weight
: ""));
4139 /* This makes TrueType fonts work better. */
4140 lplogfont
->lfHeight
= - abs (lplogfont
->lfHeight
);
4146 w32_font_match (lpszfont1
, lpszfont2
)
4150 char * s1
= lpszfont1
, *e1
;
4151 char * s2
= lpszfont2
, *e2
;
4153 if (s1
== NULL
|| s2
== NULL
) return (FALSE
);
4155 if (*s1
== '-') s1
++;
4156 if (*s2
== '-') s2
++;
4162 e1
= strchr (s1
, '-');
4163 e2
= strchr (s2
, '-');
4165 if (e1
== NULL
|| e2
== NULL
) return (TRUE
);
4170 if (*s1
!= '*' && *s2
!= '*'
4171 && (len1
!= len2
|| strnicmp (s1
, s2
, len1
) != 0))
4179 typedef struct enumfont_t
4184 XFontStruct
*size_ref
;
4185 Lisp_Object
*pattern
;
4191 enum_font_cb2 (lplf
, lptm
, FontType
, lpef
)
4193 NEWTEXTMETRIC
* lptm
;
4197 if (lplf
->elfLogFont
.lfStrikeOut
|| lplf
->elfLogFont
.lfUnderline
4198 || (lplf
->elfLogFont
.lfCharSet
!= ANSI_CHARSET
&& lplf
->elfLogFont
.lfCharSet
!= OEM_CHARSET
))
4201 /* if (!lpef->size_ref || lptm->tmMaxCharWidth == FONT_WIDTH (lpef->size_ref)) */
4205 if (!NILP (*(lpef
->pattern
)) && FontType
== TRUETYPE_FONTTYPE
)
4207 lplf
->elfLogFont
.lfHeight
= lpef
->logfont
.lfHeight
;
4208 lplf
->elfLogFont
.lfWidth
= lpef
->logfont
.lfWidth
;
4211 if (!w32_to_x_font (lplf
, buf
, 100)) return (0);
4213 if (NILP (*(lpef
->pattern
)) || w32_font_match (buf
, XSTRING (*(lpef
->pattern
))->data
))
4215 *lpef
->tail
= Fcons (build_string (buf
), Qnil
);
4216 lpef
->tail
= &XCONS (*lpef
->tail
)->cdr
;
4225 enum_font_cb1 (lplf
, lptm
, FontType
, lpef
)
4227 NEWTEXTMETRIC
* lptm
;
4231 return EnumFontFamilies (lpef
->hdc
,
4232 lplf
->elfLogFont
.lfFaceName
,
4233 (FONTENUMPROC
) enum_font_cb2
,
4238 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 3, 0,
4239 "Return a list of the names of available fonts matching PATTERN.\n\
4240 If optional arguments FACE and FRAME are specified, return only fonts\n\
4241 the same size as FACE on FRAME.\n\
4243 PATTERN is a string, perhaps with wildcard characters;\n\
4244 the * character matches any substring, and\n\
4245 the ? character matches any single character.\n\
4246 PATTERN is case-insensitive.\n\
4247 FACE is a face name--a symbol.\n\
4249 The return value is a list of strings, suitable as arguments to\n\
4252 Fonts Emacs can't use (i.e. proportional fonts) may or may not be excluded\n\
4253 even if they match PATTERN and FACE.")
4254 (pattern
, face
, frame
)
4255 Lisp_Object pattern
, face
, frame
;
4260 XFontStruct
*size_ref
;
4261 Lisp_Object namelist
;
4266 CHECK_STRING (pattern
, 0);
4268 CHECK_SYMBOL (face
, 1);
4270 f
= check_x_frame (frame
);
4272 /* Determine the width standard for comparison with the fonts we find. */
4280 /* Don't die if we get called with a terminal frame. */
4281 if (! FRAME_W32_P (f
))
4282 error ("non-w32 frame used in `x-list-fonts'");
4284 face_id
= face_name_id_number (f
, face
);
4286 if (face_id
< 0 || face_id
>= FRAME_N_PARAM_FACES (f
)
4287 || FRAME_PARAM_FACES (f
) [face_id
] == 0)
4288 size_ref
= f
->output_data
.w32
->font
;
4291 size_ref
= FRAME_PARAM_FACES (f
) [face_id
]->font
;
4292 if (size_ref
== (XFontStruct
*) (~0))
4293 size_ref
= f
->output_data
.w32
->font
;
4297 /* See if we cached the result for this particular query. */
4298 list
= Fassoc (pattern
,
4299 XCONS (FRAME_W32_DISPLAY_INFO (f
)->name_list_element
)->cdr
);
4301 /* We have info in the cache for this PATTERN. */
4304 Lisp_Object tem
, newlist
;
4306 /* We have info about this pattern. */
4307 list
= XCONS (list
)->cdr
;
4314 /* Filter the cached info and return just the fonts that match FACE. */
4316 for (tem
= list
; CONSP (tem
); tem
= XCONS (tem
)->cdr
)
4318 XFontStruct
*thisinfo
;
4320 thisinfo
= w32_load_font (FRAME_W32_DISPLAY_INFO (f
), XSTRING (XCONS (tem
)->car
)->data
);
4322 if (thisinfo
&& same_size_fonts (thisinfo
, size_ref
))
4323 newlist
= Fcons (XCONS (tem
)->car
, newlist
);
4325 w32_unload_font (FRAME_W32_DISPLAY_INFO (f
), thisinfo
);
4336 ef
.pattern
= &pattern
;
4337 ef
.tail
= ef
.head
= &namelist
;
4339 x_to_w32_font (STRINGP (pattern
) ? XSTRING (pattern
)->data
: NULL
, &ef
.logfont
);
4342 ef
.hdc
= GetDC (FRAME_W32_WINDOW (f
));
4344 EnumFontFamilies (ef
.hdc
, NULL
, (FONTENUMPROC
) enum_font_cb1
, (LPARAM
)&ef
);
4346 ReleaseDC (FRAME_W32_WINDOW (f
), ef
.hdc
);
4356 /* Make a list of all the fonts we got back.
4357 Store that in the font cache for the display. */
4358 XCONS (FRAME_W32_DISPLAY_INFO (f
)->name_list_element
)->cdr
4359 = Fcons (Fcons (pattern
, namelist
),
4360 XCONS (FRAME_W32_DISPLAY_INFO (f
)->name_list_element
)->cdr
);
4362 /* Make a list of the fonts that have the right width. */
4365 for (i
= 0; i
< ef
.numFonts
; i
++)
4373 XFontStruct
*thisinfo
;
4376 thisinfo
= w32_load_font (FRAME_W32_DISPLAY_INFO (f
), XSTRING (Fcar (cur
))->data
);
4378 keeper
= thisinfo
&& same_size_fonts (thisinfo
, size_ref
);
4380 w32_unload_font (FRAME_W32_DISPLAY_INFO (f
), thisinfo
);
4385 list
= Fcons (build_string (XSTRING (Fcar (cur
))->data
), list
);
4389 list
= Fnreverse (list
);
4395 DEFUN ("x-color-defined-p", Fx_color_defined_p
, Sx_color_defined_p
, 1, 2, 0,
4396 "Return non-nil if color COLOR is supported on frame FRAME.\n\
4397 If FRAME is omitted or nil, use the selected frame.")
4399 Lisp_Object color
, frame
;
4402 FRAME_PTR f
= check_x_frame (frame
);
4404 CHECK_STRING (color
, 1);
4406 if (defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
4412 DEFUN ("x-color-values", Fx_color_values
, Sx_color_values
, 1, 2, 0,
4413 "Return a description of the color named COLOR on frame FRAME.\n\
4414 The value is a list of integer RGB values--(RED GREEN BLUE).\n\
4415 These values appear to range from 0 to 65280 or 65535, depending\n\
4416 on the system; white is (65280 65280 65280) or (65535 65535 65535).\n\
4417 If FRAME is omitted or nil, use the selected frame.")
4419 Lisp_Object color
, frame
;
4422 FRAME_PTR f
= check_x_frame (frame
);
4424 CHECK_STRING (color
, 1);
4426 if (defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
4430 rgb
[0] = make_number (GetRValue (foo
));
4431 rgb
[1] = make_number (GetGValue (foo
));
4432 rgb
[2] = make_number (GetBValue (foo
));
4433 return Flist (3, rgb
);
4439 DEFUN ("x-display-color-p", Fx_display_color_p
, Sx_display_color_p
, 0, 1, 0,
4440 "Return t if the X display supports color.\n\
4441 The optional argument DISPLAY specifies which display to ask about.\n\
4442 DISPLAY should be either a frame or a display name (a string).\n\
4443 If omitted or nil, that stands for the selected frame's display.")
4445 Lisp_Object display
;
4447 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
4449 if ((dpyinfo
->n_planes
* dpyinfo
->n_cbits
) <= 2)
4455 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
, Sx_display_grayscale_p
,
4457 "Return t if the X display supports shades of gray.\n\
4458 Note that color displays do support shades of gray.\n\
4459 The optional argument DISPLAY specifies which display to ask about.\n\
4460 DISPLAY should be either a frame or a display name (a string).\n\
4461 If omitted or nil, that stands for the selected frame's display.")
4463 Lisp_Object display
;
4465 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
4467 if ((dpyinfo
->n_planes
* dpyinfo
->n_cbits
) <= 1)
4473 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
4475 "Returns the width in pixels of the X display DISPLAY.\n\
4476 The optional argument DISPLAY specifies which display to ask about.\n\
4477 DISPLAY should be either a frame or a display name (a string).\n\
4478 If omitted or nil, that stands for the selected frame's display.")
4480 Lisp_Object display
;
4482 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
4484 return make_number (dpyinfo
->width
);
4487 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
4488 Sx_display_pixel_height
, 0, 1, 0,
4489 "Returns the height in pixels of the X display DISPLAY.\n\
4490 The optional argument DISPLAY specifies which display to ask about.\n\
4491 DISPLAY should be either a frame or a display name (a string).\n\
4492 If omitted or nil, that stands for the selected frame's display.")
4494 Lisp_Object display
;
4496 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
4498 return make_number (dpyinfo
->height
);
4501 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
4503 "Returns the number of bitplanes of the display DISPLAY.\n\
4504 The optional argument DISPLAY specifies which display to ask about.\n\
4505 DISPLAY should be either a frame or a display name (a string).\n\
4506 If omitted or nil, that stands for the selected frame's display.")
4508 Lisp_Object display
;
4510 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
4512 return make_number (dpyinfo
->n_planes
* dpyinfo
->n_cbits
);
4515 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
4517 "Returns the number of color cells of the display DISPLAY.\n\
4518 The optional argument DISPLAY specifies which display to ask about.\n\
4519 DISPLAY should be either a frame or a display name (a string).\n\
4520 If omitted or nil, that stands for the selected frame's display.")
4522 Lisp_Object display
;
4524 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
4528 hdc
= GetDC (dpyinfo
->root_window
);
4529 if (dpyinfo
->has_palette
)
4530 cap
= GetDeviceCaps (hdc
,SIZEPALETTE
);
4532 cap
= GetDeviceCaps (hdc
,NUMCOLORS
);
4534 ReleaseDC (dpyinfo
->root_window
, hdc
);
4536 return make_number (cap
);
4539 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
4540 Sx_server_max_request_size
,
4542 "Returns the maximum request size of the server of display DISPLAY.\n\
4543 The optional argument DISPLAY specifies which display to ask about.\n\
4544 DISPLAY should be either a frame or a display name (a string).\n\
4545 If omitted or nil, that stands for the selected frame's display.")
4547 Lisp_Object display
;
4549 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
4551 return make_number (1);
4554 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
4555 "Returns the vendor ID string of the W32 system (Microsoft).\n\
4556 The optional argument DISPLAY specifies which display to ask about.\n\
4557 DISPLAY should be either a frame or a display name (a string).\n\
4558 If omitted or nil, that stands for the selected frame's display.")
4560 Lisp_Object display
;
4562 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
4563 char *vendor
= "Microsoft Corp.";
4565 if (! vendor
) vendor
= "";
4566 return build_string (vendor
);
4569 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
4570 "Returns the version numbers of the server of display DISPLAY.\n\
4571 The value is a list of three integers: the major and minor\n\
4572 version numbers, and the vendor-specific release\n\
4573 number. See also the function `x-server-vendor'.\n\n\
4574 The optional argument DISPLAY specifies which display to ask about.\n\
4575 DISPLAY should be either a frame or a display name (a string).\n\
4576 If omitted or nil, that stands for the selected frame's display.")
4578 Lisp_Object display
;
4580 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
4582 return Fcons (make_number (w32_major_version
),
4583 Fcons (make_number (w32_minor_version
), Qnil
));
4586 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
4587 "Returns the number of screens on the server of display DISPLAY.\n\
4588 The optional argument DISPLAY specifies which display to ask about.\n\
4589 DISPLAY should be either a frame or a display name (a string).\n\
4590 If omitted or nil, that stands for the selected frame's display.")
4592 Lisp_Object display
;
4594 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
4596 return make_number (1);
4599 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
4600 "Returns the height in millimeters of the X display DISPLAY.\n\
4601 The optional argument DISPLAY specifies which display to ask about.\n\
4602 DISPLAY should be either a frame or a display name (a string).\n\
4603 If omitted or nil, that stands for the selected frame's display.")
4605 Lisp_Object display
;
4607 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
4611 hdc
= GetDC (dpyinfo
->root_window
);
4613 cap
= GetDeviceCaps (hdc
, VERTSIZE
);
4615 ReleaseDC (dpyinfo
->root_window
, hdc
);
4617 return make_number (cap
);
4620 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
4621 "Returns the width in millimeters of the X display DISPLAY.\n\
4622 The optional argument DISPLAY specifies which display to ask about.\n\
4623 DISPLAY should be either a frame or a display name (a string).\n\
4624 If omitted or nil, that stands for the selected frame's display.")
4626 Lisp_Object display
;
4628 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
4633 hdc
= GetDC (dpyinfo
->root_window
);
4635 cap
= GetDeviceCaps (hdc
, HORZSIZE
);
4637 ReleaseDC (dpyinfo
->root_window
, hdc
);
4639 return make_number (cap
);
4642 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
4643 Sx_display_backing_store
, 0, 1, 0,
4644 "Returns an indication of whether display DISPLAY does backing store.\n\
4645 The value may be `always', `when-mapped', or `not-useful'.\n\
4646 The optional argument DISPLAY specifies which display to ask about.\n\
4647 DISPLAY should be either a frame or a display name (a string).\n\
4648 If omitted or nil, that stands for the selected frame's display.")
4650 Lisp_Object display
;
4652 return intern ("not-useful");
4655 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
4656 Sx_display_visual_class
, 0, 1, 0,
4657 "Returns the visual class of the display DISPLAY.\n\
4658 The value is one of the symbols `static-gray', `gray-scale',\n\
4659 `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
4660 The optional argument DISPLAY specifies which display to ask about.\n\
4661 DISPLAY should be either a frame or a display name (a string).\n\
4662 If omitted or nil, that stands for the selected frame's display.")
4664 Lisp_Object display
;
4666 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
4669 switch (dpyinfo
->visual
->class)
4671 case StaticGray
: return (intern ("static-gray"));
4672 case GrayScale
: return (intern ("gray-scale"));
4673 case StaticColor
: return (intern ("static-color"));
4674 case PseudoColor
: return (intern ("pseudo-color"));
4675 case TrueColor
: return (intern ("true-color"));
4676 case DirectColor
: return (intern ("direct-color"));
4678 error ("Display has an unknown visual class");
4682 error ("Display has an unknown visual class");
4685 DEFUN ("x-display-save-under", Fx_display_save_under
,
4686 Sx_display_save_under
, 0, 1, 0,
4687 "Returns t if the display DISPLAY supports the save-under feature.\n\
4688 The optional argument DISPLAY specifies which display to ask about.\n\
4689 DISPLAY should be either a frame or a display name (a string).\n\
4690 If omitted or nil, that stands for the selected frame's display.")
4692 Lisp_Object display
;
4694 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
4701 register struct frame
*f
;
4703 return PIXEL_WIDTH (f
);
4708 register struct frame
*f
;
4710 return PIXEL_HEIGHT (f
);
4715 register struct frame
*f
;
4717 return FONT_WIDTH (f
->output_data
.w32
->font
);
4722 register struct frame
*f
;
4724 return f
->output_data
.w32
->line_height
;
4728 x_screen_planes (frame
)
4731 return (FRAME_W32_DISPLAY_INFO (XFRAME (frame
))->n_planes
*
4732 FRAME_W32_DISPLAY_INFO (XFRAME (frame
))->n_cbits
);
4735 /* Return the display structure for the display named NAME.
4736 Open a new connection if necessary. */
4738 struct w32_display_info
*
4739 x_display_info_for_name (name
)
4743 struct w32_display_info
*dpyinfo
;
4745 CHECK_STRING (name
, 0);
4747 for (dpyinfo
= &one_w32_display_info
, names
= w32_display_name_list
;
4749 dpyinfo
= dpyinfo
->next
, names
= XCONS (names
)->cdr
)
4752 tem
= Fstring_equal (XCONS (XCONS (names
)->car
)->car
, name
);
4757 /* Use this general default value to start with. */
4758 Vx_resource_name
= Vinvocation_name
;
4760 validate_x_resource_name ();
4762 dpyinfo
= w32_term_init (name
, (unsigned char *)0,
4763 (char *) XSTRING (Vx_resource_name
)->data
);
4766 error ("Cannot connect to server %s", XSTRING (name
)->data
);
4768 XSETFASTINT (Vwindow_system_version
, 3);
4773 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
4774 1, 3, 0, "Open a connection to a server.\n\
4775 DISPLAY is the name of the display to connect to.\n\
4776 Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
4777 If the optional third arg MUST-SUCCEED is non-nil,\n\
4778 terminate Emacs if we can't open the connection.")
4779 (display
, xrm_string
, must_succeed
)
4780 Lisp_Object display
, xrm_string
, must_succeed
;
4782 unsigned int n_planes
;
4783 unsigned char *xrm_option
;
4784 struct w32_display_info
*dpyinfo
;
4786 CHECK_STRING (display
, 0);
4787 if (! NILP (xrm_string
))
4788 CHECK_STRING (xrm_string
, 1);
4790 /* Allow color mapping to be defined externally; first look in user's
4791 HOME directory, then in Emacs etc dir for a file called rgb.txt. */
4793 Lisp_Object color_file
;
4794 struct gcpro gcpro1
;
4796 color_file
= build_string("~/rgb.txt");
4798 GCPRO1 (color_file
);
4800 if (NILP (Ffile_readable_p (color_file
)))
4802 Fexpand_file_name (build_string ("rgb.txt"),
4803 Fsymbol_value (intern ("data-directory")));
4805 Vw32_color_map
= Fw32_load_color_file (color_file
);
4809 if (NILP (Vw32_color_map
))
4810 Vw32_color_map
= Fw32_default_color_map ();
4812 if (! NILP (xrm_string
))
4813 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
4815 xrm_option
= (unsigned char *) 0;
4817 /* Use this general default value to start with. */
4818 /* First remove .exe suffix from invocation-name - it looks ugly. */
4820 char basename
[ MAX_PATH
], *str
;
4822 strcpy (basename
, XSTRING (Vinvocation_name
)->data
);
4823 str
= strrchr (basename
, '.');
4825 Vinvocation_name
= build_string (basename
);
4827 Vx_resource_name
= Vinvocation_name
;
4829 validate_x_resource_name ();
4831 /* This is what opens the connection and sets x_current_display.
4832 This also initializes many symbols, such as those used for input. */
4833 dpyinfo
= w32_term_init (display
, xrm_option
,
4834 (char *) XSTRING (Vx_resource_name
)->data
);
4838 if (!NILP (must_succeed
))
4839 fatal ("Cannot connect to server %s.\n",
4840 XSTRING (display
)->data
);
4842 error ("Cannot connect to server %s", XSTRING (display
)->data
);
4845 XSETFASTINT (Vwindow_system_version
, 3);
4849 DEFUN ("x-close-connection", Fx_close_connection
,
4850 Sx_close_connection
, 1, 1, 0,
4851 "Close the connection to DISPLAY's server.\n\
4852 For DISPLAY, specify either a frame or a display name (a string).\n\
4853 If DISPLAY is nil, that stands for the selected frame's display.")
4855 Lisp_Object display
;
4857 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
4858 struct w32_display_info
*tail
;
4861 if (dpyinfo
->reference_count
> 0)
4862 error ("Display still has frames on it");
4865 /* Free the fonts in the font table. */
4866 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
4868 if (dpyinfo
->font_table
[i
].name
)
4869 free (dpyinfo
->font_table
[i
].name
);
4870 /* Don't free the full_name string;
4871 it is always shared with something else. */
4872 w32_unload_font (dpyinfo
, dpyinfo
->font_table
[i
].font
);
4874 x_destroy_all_bitmaps (dpyinfo
);
4876 x_delete_display (dpyinfo
);
4882 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
4883 "Return the list of display names that Emacs has connections to.")
4886 Lisp_Object tail
, result
;
4889 for (tail
= w32_display_name_list
; ! NILP (tail
); tail
= XCONS (tail
)->cdr
)
4890 result
= Fcons (XCONS (XCONS (tail
)->car
)->car
, result
);
4895 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
4896 "If ON is non-nil, report errors as soon as the erring request is made.\n\
4897 If ON is nil, allow buffering of requests.\n\
4898 This is a noop on W32 systems.\n\
4899 The optional second argument DISPLAY specifies which display to act on.\n\
4900 DISPLAY should be either a frame or a display name (a string).\n\
4901 If DISPLAY is omitted or nil, that stands for the selected frame's display.")
4903 Lisp_Object display
, on
;
4905 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
4911 /* These are the w32 specialized functions */
4913 DEFUN ("w32-select-font", Fw32_select_font
, Sw32_select_font
, 0, 1, 0,
4914 "This will display the W32 font dialog and return an X font string corresponding to the selection.")
4918 FRAME_PTR f
= check_x_frame (frame
);
4923 bzero (&cf
, sizeof (cf
));
4925 cf
.lStructSize
= sizeof (cf
);
4926 cf
.hwndOwner
= FRAME_W32_WINDOW (f
);
4927 cf
.Flags
= CF_FIXEDPITCHONLY
| CF_FORCEFONTEXIST
| CF_SCREENFONTS
;
4930 if (!ChooseFont (&cf
) || !w32_to_x_font (&lf
, buf
, 100))
4933 return build_string (buf
);
4939 /* The section below is built by the lisp expression at the top of the file,
4940 just above where these variables are declared. */
4941 /*&&& init symbols here &&&*/
4942 Qauto_raise
= intern ("auto-raise");
4943 staticpro (&Qauto_raise
);
4944 Qauto_lower
= intern ("auto-lower");
4945 staticpro (&Qauto_lower
);
4946 Qbackground_color
= intern ("background-color");
4947 staticpro (&Qbackground_color
);
4948 Qbar
= intern ("bar");
4950 Qborder_color
= intern ("border-color");
4951 staticpro (&Qborder_color
);
4952 Qborder_width
= intern ("border-width");
4953 staticpro (&Qborder_width
);
4954 Qbox
= intern ("box");
4956 Qcursor_color
= intern ("cursor-color");
4957 staticpro (&Qcursor_color
);
4958 Qcursor_type
= intern ("cursor-type");
4959 staticpro (&Qcursor_type
);
4960 Qforeground_color
= intern ("foreground-color");
4961 staticpro (&Qforeground_color
);
4962 Qgeometry
= intern ("geometry");
4963 staticpro (&Qgeometry
);
4964 Qicon_left
= intern ("icon-left");
4965 staticpro (&Qicon_left
);
4966 Qicon_top
= intern ("icon-top");
4967 staticpro (&Qicon_top
);
4968 Qicon_type
= intern ("icon-type");
4969 staticpro (&Qicon_type
);
4970 Qicon_name
= intern ("icon-name");
4971 staticpro (&Qicon_name
);
4972 Qinternal_border_width
= intern ("internal-border-width");
4973 staticpro (&Qinternal_border_width
);
4974 Qleft
= intern ("left");
4976 Qright
= intern ("right");
4977 staticpro (&Qright
);
4978 Qmouse_color
= intern ("mouse-color");
4979 staticpro (&Qmouse_color
);
4980 Qnone
= intern ("none");
4982 Qparent_id
= intern ("parent-id");
4983 staticpro (&Qparent_id
);
4984 Qscroll_bar_width
= intern ("scroll-bar-width");
4985 staticpro (&Qscroll_bar_width
);
4986 Qsuppress_icon
= intern ("suppress-icon");
4987 staticpro (&Qsuppress_icon
);
4988 Qtop
= intern ("top");
4990 Qundefined_color
= intern ("undefined-color");
4991 staticpro (&Qundefined_color
);
4992 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
4993 staticpro (&Qvertical_scroll_bars
);
4994 Qvisibility
= intern ("visibility");
4995 staticpro (&Qvisibility
);
4996 Qwindow_id
= intern ("window-id");
4997 staticpro (&Qwindow_id
);
4998 Qx_frame_parameter
= intern ("x-frame-parameter");
4999 staticpro (&Qx_frame_parameter
);
5000 Qx_resource_name
= intern ("x-resource-name");
5001 staticpro (&Qx_resource_name
);
5002 Quser_position
= intern ("user-position");
5003 staticpro (&Quser_position
);
5004 Quser_size
= intern ("user-size");
5005 staticpro (&Quser_size
);
5006 Qdisplay
= intern ("display");
5007 staticpro (&Qdisplay
);
5008 /* This is the end of symbol initialization. */
5010 Fput (Qundefined_color
, Qerror_conditions
,
5011 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
5012 Fput (Qundefined_color
, Qerror_message
,
5013 build_string ("Undefined color"));
5015 DEFVAR_LISP ("w32-color-map", &Vw32_color_map
,
5016 "A array of color name mappings for windows.");
5017 Vw32_color_map
= Qnil
;
5019 DEFVAR_LISP ("w32-pass-alt-to-system", &Vw32_pass_alt_to_system
,
5020 "Non-nil if alt key presses are passed on to Windows.\n\
5021 When non-nil, for example, alt pressed and released and then space will\n\
5022 open the System menu. When nil, Emacs silently swallows alt key events.");
5023 Vw32_pass_alt_to_system
= Qnil
;
5025 DEFVAR_LISP ("w32-alt-is-meta", &Vw32_alt_is_meta
,
5026 "Non-nil if the alt key is to be considered the same as the meta key.\n\
5027 When nil, Emacs will translate the alt key to the Alt modifier, and not Meta.");
5028 Vw32_alt_is_meta
= Qt
;
5030 DEFVAR_LISP ("w32-pass-optional-keys-to-system",
5031 &Vw32_pass_optional_keys_to_system
,
5032 "Non-nil if the 'optional' keys (left window, right window,\n\
5033 and application keys) are passed on to Windows.");
5034 Vw32_pass_optional_keys_to_system
= Qnil
;
5036 DEFVAR_LISP ("w32-enable-italics", &Vw32_enable_italics
,
5037 "Non-nil enables selection of artificially italicized fonts.");
5038 Vw32_enable_italics
= Qnil
;
5040 DEFVAR_LISP ("w32-enable-palette", &Vw32_enable_palette
,
5041 "Non-nil enables Windows palette management to map colors exactly.");
5042 Vw32_enable_palette
= Qt
;
5044 DEFVAR_INT ("w32-mouse-button-tolerance",
5045 &Vw32_mouse_button_tolerance
,
5046 "Analogue of double click interval for faking middle mouse events.\n\
5047 The value is the minimum time in milliseconds that must elapse between\n\
5048 left/right button down events before they are considered distinct events.\n\
5049 If both mouse buttons are depressed within this interval, a middle mouse\n\
5050 button down event is generated instead.");
5051 XSETINT (Vw32_mouse_button_tolerance
, GetDoubleClickTime () / 2);
5053 DEFVAR_INT ("w32-mouse-move-interval",
5054 &Vw32_mouse_move_interval
,
5055 "Minimum interval between mouse move events.\n\
5056 The value is the minimum time in milliseconds that must elapse between\n\
5057 successive mouse move (or scroll bar drag) events before they are\n\
5058 reported as lisp events.");
5059 XSETINT (Vw32_mouse_move_interval
, 50);
5061 init_x_parm_symbols ();
5063 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path
,
5064 "List of directories to search for bitmap files for w32.");
5065 Vx_bitmap_file_path
= decode_env_path ((char *) 0, "PATH");
5067 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
5068 "The shape of the pointer when over text.\n\
5069 Changing the value does not affect existing frames\n\
5070 unless you set the mouse color.");
5071 Vx_pointer_shape
= Qnil
;
5073 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
5074 "The name Emacs uses to look up resources; for internal use only.\n\
5075 `x-get-resource' uses this as the first component of the instance name\n\
5076 when requesting resource values.\n\
5077 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
5078 was invoked, or to the value specified with the `-name' or `-rn'\n\
5079 switches, if present.");
5080 Vx_resource_name
= Qnil
;
5082 Vx_nontext_pointer_shape
= Qnil
;
5084 Vx_mode_pointer_shape
= Qnil
;
5086 DEFVAR_INT ("x-sensitive-text-pointer-shape",
5087 &Vx_sensitive_text_pointer_shape
,
5088 "The shape of the pointer when over mouse-sensitive text.\n\
5089 This variable takes effect when you create a new frame\n\
5090 or when you set the mouse color.");
5091 Vx_sensitive_text_pointer_shape
= Qnil
;
5093 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
5094 "A string indicating the foreground color of the cursor box.");
5095 Vx_cursor_fore_pixel
= Qnil
;
5097 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
5098 "Non-nil if no window manager is in use.\n\
5099 Emacs doesn't try to figure this out; this is always nil\n\
5100 unless you set it to something else.");
5101 /* We don't have any way to find this out, so set it to nil
5102 and maybe the user would like to set it to t. */
5103 Vx_no_window_manager
= Qnil
;
5105 defsubr (&Sx_get_resource
);
5106 defsubr (&Sx_list_fonts
);
5107 defsubr (&Sx_display_color_p
);
5108 defsubr (&Sx_display_grayscale_p
);
5109 defsubr (&Sx_color_defined_p
);
5110 defsubr (&Sx_color_values
);
5111 defsubr (&Sx_server_max_request_size
);
5112 defsubr (&Sx_server_vendor
);
5113 defsubr (&Sx_server_version
);
5114 defsubr (&Sx_display_pixel_width
);
5115 defsubr (&Sx_display_pixel_height
);
5116 defsubr (&Sx_display_mm_width
);
5117 defsubr (&Sx_display_mm_height
);
5118 defsubr (&Sx_display_screens
);
5119 defsubr (&Sx_display_planes
);
5120 defsubr (&Sx_display_color_cells
);
5121 defsubr (&Sx_display_visual_class
);
5122 defsubr (&Sx_display_backing_store
);
5123 defsubr (&Sx_display_save_under
);
5124 defsubr (&Sx_parse_geometry
);
5125 defsubr (&Sx_create_frame
);
5126 defsubr (&Sx_open_connection
);
5127 defsubr (&Sx_close_connection
);
5128 defsubr (&Sx_display_list
);
5129 defsubr (&Sx_synchronize
);
5131 /* W32 specific functions */
5133 defsubr (&Sw32_select_font
);
5134 defsubr (&Sw32_define_rgb_color
);
5135 defsubr (&Sw32_default_color_map
);
5136 defsubr (&Sw32_load_color_file
);
5145 button
= MessageBox (NULL
,
5146 "A fatal error has occurred!\n\n"
5147 "Select Abort to exit, Retry to debug, Ignore to continue",
5148 "Emacs Abort Dialog",
5149 MB_ICONEXCLAMATION
| MB_TASKMODAL
5150 | MB_SETFOREGROUND
| MB_ABORTRETRYIGNORE
);