1 /* Graphical user interface functions for the Microsoft W32 API.
2 Copyright (C) 1989, 92, 93, 94, 95, 1996 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
21 /* Added by Kevin Gallo */
35 #include "dispextern.h"
37 #include "blockinput.h"
40 #include "termhooks.h"
45 extern void free_frame_menubar ();
46 extern struct scroll_bar
*x_window_to_scroll_bar ();
49 /* The colormap for converting color names to RGB values */
50 Lisp_Object Vw32_color_map
;
52 /* Non nil if alt key presses are passed on to Windows. */
53 Lisp_Object Vw32_pass_alt_to_system
;
55 /* Non nil if alt key is translated to meta_modifier, nil if it is translated
57 Lisp_Object Vw32_alt_is_meta
;
59 /* Non nil if left window, right window, and application key events
60 are passed on to Windows. */
61 Lisp_Object Vw32_pass_optional_keys_to_system
;
63 /* Switch to control whether we inhibit requests for italicised fonts (which
64 are synthesized, look ugly, and are trashed by cursor movement under NT). */
65 Lisp_Object Vw32_enable_italics
;
67 /* Enable palette management. */
68 Lisp_Object Vw32_enable_palette
;
70 /* Control how close left/right button down events must be to
71 be converted to a middle button down event. */
72 Lisp_Object Vw32_mouse_button_tolerance
;
74 /* Minimum interval between mouse movement (and scroll bar drag)
75 events that are passed on to the event loop. */
76 Lisp_Object Vw32_mouse_move_interval
;
78 /* The name we're using in resource queries. */
79 Lisp_Object Vx_resource_name
;
81 /* Non nil if no window manager is in use. */
82 Lisp_Object Vx_no_window_manager
;
84 /* The background and shape of the mouse pointer, and shape when not
85 over text or in the modeline. */
86 Lisp_Object Vx_pointer_shape
, Vx_nontext_pointer_shape
, Vx_mode_pointer_shape
;
87 /* The shape when over mouse-sensitive text. */
88 Lisp_Object Vx_sensitive_text_pointer_shape
;
90 /* Color of chars displayed in cursor box. */
91 Lisp_Object Vx_cursor_fore_pixel
;
93 /* Nonzero if using Windows. */
94 static int w32_in_use
;
96 /* Search path for bitmap files. */
97 Lisp_Object Vx_bitmap_file_path
;
99 /* Evaluate this expression to rebuild the section of syms_of_w32fns
100 that initializes and staticpros the symbols declared below. Note
101 that Emacs 18 has a bug that keeps C-x C-e from being able to
102 evaluate this expression.
105 ;; Accumulate a list of the symbols we want to initialize from the
106 ;; declarations at the top of the file.
107 (goto-char (point-min))
108 (search-forward "/\*&&& symbols declared here &&&*\/\n")
110 (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)")
112 (cons (buffer-substring (match-beginning 1) (match-end 1))
115 (setq symbol-list (nreverse symbol-list))
116 ;; Delete the section of syms_of_... where we initialize the symbols.
117 (search-forward "\n /\*&&& init symbols here &&&*\/\n")
118 (let ((start (point)))
119 (while (looking-at "^ Q")
121 (kill-region start (point)))
122 ;; Write a new symbol initialization section.
124 (insert (format " %s = intern (\"" (car symbol-list)))
125 (let ((start (point)))
126 (insert (substring (car symbol-list) 1))
127 (subst-char-in-region start (point) ?_ ?-))
128 (insert (format "\");\n staticpro (&%s);\n" (car symbol-list)))
129 (setq symbol-list (cdr symbol-list)))))
133 /*&&& symbols declared here &&&*/
134 Lisp_Object Qauto_raise
;
135 Lisp_Object Qauto_lower
;
136 Lisp_Object Qbackground_color
;
138 Lisp_Object Qborder_color
;
139 Lisp_Object Qborder_width
;
141 Lisp_Object Qcursor_color
;
142 Lisp_Object Qcursor_type
;
143 Lisp_Object Qforeground_color
;
144 Lisp_Object Qgeometry
;
145 Lisp_Object Qicon_left
;
146 Lisp_Object Qicon_top
;
147 Lisp_Object Qicon_type
;
148 Lisp_Object Qicon_name
;
149 Lisp_Object Qinternal_border_width
;
152 Lisp_Object Qmouse_color
;
154 Lisp_Object Qparent_id
;
155 Lisp_Object Qscroll_bar_width
;
156 Lisp_Object Qsuppress_icon
;
158 Lisp_Object Qundefined_color
;
159 Lisp_Object Qvertical_scroll_bars
;
160 Lisp_Object Qvisibility
;
161 Lisp_Object Qwindow_id
;
162 Lisp_Object Qx_frame_parameter
;
163 Lisp_Object Qx_resource_name
;
164 Lisp_Object Quser_position
;
165 Lisp_Object Quser_size
;
166 Lisp_Object Qdisplay
;
168 /* State variables for emulating a three button mouse. */
173 static int button_state
= 0;
174 static W32Msg saved_mouse_button_msg
;
175 static unsigned mouse_button_timer
; /* non-zero when timer is active */
176 static W32Msg saved_mouse_move_msg
;
177 static unsigned mouse_move_timer
;
179 #define MOUSE_BUTTON_ID 1
180 #define MOUSE_MOVE_ID 2
182 /* The below are defined in frame.c. */
183 extern Lisp_Object Qheight
, Qminibuffer
, Qname
, Qonly
, Qwidth
;
184 extern Lisp_Object Qunsplittable
, Qmenu_bar_lines
, Qbuffer_predicate
, Qtitle
;
186 extern Lisp_Object Vwindow_system_version
;
188 extern Lisp_Object last_mouse_scroll_bar
;
189 extern int last_mouse_scroll_bar_pos
;
191 /* From w32term.c. */
192 extern Lisp_Object Vw32_num_mouse_buttons
;
195 /* Error if we are not connected to MS-Windows. */
200 error ("MS-Windows not in use or not initialized");
203 /* Nonzero if we can use mouse menus.
204 You should not call this unless HAVE_MENUS is defined. */
212 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
213 and checking validity for W32. */
216 check_x_frame (frame
)
225 CHECK_LIVE_FRAME (frame
, 0);
228 if (! FRAME_W32_P (f
))
229 error ("non-w32 frame used");
233 /* Let the user specify an display with a frame.
234 nil stands for the selected frame--or, if that is not a w32 frame,
235 the first display on the list. */
237 static struct w32_display_info
*
238 check_x_display_info (frame
)
243 if (FRAME_W32_P (selected_frame
))
244 return FRAME_W32_DISPLAY_INFO (selected_frame
);
246 return &one_w32_display_info
;
248 else if (STRINGP (frame
))
249 return x_display_info_for_name (frame
);
254 CHECK_LIVE_FRAME (frame
, 0);
256 if (! FRAME_W32_P (f
))
257 error ("non-w32 frame used");
258 return FRAME_W32_DISPLAY_INFO (f
);
262 /* Return the Emacs frame-object corresponding to an w32 window.
263 It could be the frame's main window or an icon window. */
265 /* This function can be called during GC, so use GC_xxx type test macros. */
268 x_window_to_frame (dpyinfo
, wdesc
)
269 struct w32_display_info
*dpyinfo
;
272 Lisp_Object tail
, frame
;
275 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
277 frame
= XCONS (tail
)->car
;
278 if (!GC_FRAMEP (frame
))
281 if (f
->output_data
.nothing
== 1
282 || FRAME_W32_DISPLAY_INFO (f
) != dpyinfo
)
284 if (FRAME_W32_WINDOW (f
) == wdesc
)
292 /* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
293 id, which is just an int that this section returns. Bitmaps are
294 reference counted so they can be shared among frames.
296 Bitmap indices are guaranteed to be > 0, so a negative number can
297 be used to indicate no bitmap.
299 If you use x_create_bitmap_from_data, then you must keep track of
300 the bitmaps yourself. That is, creating a bitmap from the same
301 data more than once will not be caught. */
304 /* Functions to access the contents of a bitmap, given an id. */
307 x_bitmap_height (f
, id
)
311 return FRAME_W32_DISPLAY_INFO (f
)->bitmaps
[id
- 1].height
;
315 x_bitmap_width (f
, id
)
319 return FRAME_W32_DISPLAY_INFO (f
)->bitmaps
[id
- 1].width
;
323 x_bitmap_pixmap (f
, id
)
327 return (int) FRAME_W32_DISPLAY_INFO (f
)->bitmaps
[id
- 1].pixmap
;
331 /* Allocate a new bitmap record. Returns index of new record. */
334 x_allocate_bitmap_record (f
)
337 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
340 if (dpyinfo
->bitmaps
== NULL
)
342 dpyinfo
->bitmaps_size
= 10;
344 = (struct w32_bitmap_record
*) xmalloc (dpyinfo
->bitmaps_size
* sizeof (struct w32_bitmap_record
));
345 dpyinfo
->bitmaps_last
= 1;
349 if (dpyinfo
->bitmaps_last
< dpyinfo
->bitmaps_size
)
350 return ++dpyinfo
->bitmaps_last
;
352 for (i
= 0; i
< dpyinfo
->bitmaps_size
; ++i
)
353 if (dpyinfo
->bitmaps
[i
].refcount
== 0)
356 dpyinfo
->bitmaps_size
*= 2;
358 = (struct w32_bitmap_record
*) xrealloc (dpyinfo
->bitmaps
,
359 dpyinfo
->bitmaps_size
* sizeof (struct w32_bitmap_record
));
360 return ++dpyinfo
->bitmaps_last
;
363 /* Add one reference to the reference count of the bitmap with id ID. */
366 x_reference_bitmap (f
, id
)
370 ++FRAME_W32_DISPLAY_INFO (f
)->bitmaps
[id
- 1].refcount
;
373 /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
376 x_create_bitmap_from_data (f
, bits
, width
, height
)
379 unsigned int width
, height
;
381 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
385 bitmap
= CreateBitmap (width
, height
,
386 FRAME_W32_DISPLAY_INFO (XFRAME (frame
))->n_planes
,
387 FRAME_W32_DISPLAY_INFO (XFRAME (frame
))->n_cbits
,
393 id
= x_allocate_bitmap_record (f
);
394 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
395 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
396 dpyinfo
->bitmaps
[id
- 1].hinst
= NULL
;
397 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
398 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
399 dpyinfo
->bitmaps
[id
- 1].height
= height
;
400 dpyinfo
->bitmaps
[id
- 1].width
= width
;
405 /* Create bitmap from file FILE for frame F. */
408 x_create_bitmap_from_file (f
, file
)
414 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
415 unsigned int width
, height
;
417 int xhot
, yhot
, result
, id
;
423 /* Look for an existing bitmap with the same name. */
424 for (id
= 0; id
< dpyinfo
->bitmaps_last
; ++id
)
426 if (dpyinfo
->bitmaps
[id
].refcount
427 && dpyinfo
->bitmaps
[id
].file
428 && !strcmp (dpyinfo
->bitmaps
[id
].file
, (char *) XSTRING (file
)->data
))
430 ++dpyinfo
->bitmaps
[id
].refcount
;
435 /* Search bitmap-file-path for the file, if appropriate. */
436 fd
= openp (Vx_bitmap_file_path
, file
, "", &found
, 0);
441 filename
= (char *) XSTRING (found
)->data
;
443 hinst
= LoadLibraryEx (filename
, NULL
, LOAD_LIBRARY_AS_DATAFILE
);
449 result
= XReadBitmapFile (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
450 filename
, &width
, &height
, &bitmap
, &xhot
, &yhot
);
451 if (result
!= BitmapSuccess
)
454 id
= x_allocate_bitmap_record (f
);
455 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
456 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
457 dpyinfo
->bitmaps
[id
- 1].file
= (char *) xmalloc (XSTRING (file
)->size
+ 1);
458 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
459 dpyinfo
->bitmaps
[id
- 1].height
= height
;
460 dpyinfo
->bitmaps
[id
- 1].width
= width
;
461 strcpy (dpyinfo
->bitmaps
[id
- 1].file
, XSTRING (file
)->data
);
467 /* Remove reference to bitmap with id number ID. */
470 x_destroy_bitmap (f
, id
)
474 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
478 --dpyinfo
->bitmaps
[id
- 1].refcount
;
479 if (dpyinfo
->bitmaps
[id
- 1].refcount
== 0)
482 DeleteObject (dpyinfo
->bitmaps
[id
- 1].pixmap
);
483 if (dpyinfo
->bitmaps
[id
- 1].file
)
485 free (dpyinfo
->bitmaps
[id
- 1].file
);
486 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
493 /* Free all the bitmaps for the display specified by DPYINFO. */
496 x_destroy_all_bitmaps (dpyinfo
)
497 struct w32_display_info
*dpyinfo
;
500 for (i
= 0; i
< dpyinfo
->bitmaps_last
; i
++)
501 if (dpyinfo
->bitmaps
[i
].refcount
> 0)
503 DeleteObject (dpyinfo
->bitmaps
[i
].pixmap
);
504 if (dpyinfo
->bitmaps
[i
].file
)
505 free (dpyinfo
->bitmaps
[i
].file
);
507 dpyinfo
->bitmaps_last
= 0;
510 /* Connect the frame-parameter names for W32 frames
511 to the ways of passing the parameter values to the window system.
513 The name of a parameter, as a Lisp symbol,
514 has an `x-frame-parameter' property which is an integer in Lisp
515 but can be interpreted as an `enum x_frame_parm' in C. */
519 X_PARM_FOREGROUND_COLOR
,
520 X_PARM_BACKGROUND_COLOR
,
527 X_PARM_INTERNAL_BORDER_WIDTH
,
531 X_PARM_VERT_SCROLL_BAR
,
533 X_PARM_MENU_BAR_LINES
537 struct x_frame_parm_table
540 void (*setter
)( /* struct frame *frame, Lisp_Object val, oldval */ );
543 void x_set_foreground_color ();
544 void x_set_background_color ();
545 void x_set_mouse_color ();
546 void x_set_cursor_color ();
547 void x_set_border_color ();
548 void x_set_cursor_type ();
549 void x_set_icon_type ();
550 void x_set_icon_name ();
552 void x_set_border_width ();
553 void x_set_internal_border_width ();
554 void x_explicitly_set_name ();
555 void x_set_autoraise ();
556 void x_set_autolower ();
557 void x_set_vertical_scroll_bars ();
558 void x_set_visibility ();
559 void x_set_menu_bar_lines ();
560 void x_set_scroll_bar_width ();
562 void x_set_unsplittable ();
564 static struct x_frame_parm_table x_frame_parms
[] =
566 "auto-raise", x_set_autoraise
,
567 "auto-lower", x_set_autolower
,
568 "background-color", x_set_background_color
,
569 "border-color", x_set_border_color
,
570 "border-width", x_set_border_width
,
571 "cursor-color", x_set_cursor_color
,
572 "cursor-type", x_set_cursor_type
,
574 "foreground-color", x_set_foreground_color
,
575 "icon-name", x_set_icon_name
,
576 "icon-type", x_set_icon_type
,
577 "internal-border-width", x_set_internal_border_width
,
578 "menu-bar-lines", x_set_menu_bar_lines
,
579 "mouse-color", x_set_mouse_color
,
580 "name", x_explicitly_set_name
,
581 "scroll-bar-width", x_set_scroll_bar_width
,
582 "title", x_set_title
,
583 "unsplittable", x_set_unsplittable
,
584 "vertical-scroll-bars", x_set_vertical_scroll_bars
,
585 "visibility", x_set_visibility
,
588 /* Attach the `x-frame-parameter' properties to
589 the Lisp symbol names of parameters relevant to W32. */
591 init_x_parm_symbols ()
595 for (i
= 0; i
< sizeof (x_frame_parms
) / sizeof (x_frame_parms
[0]); i
++)
596 Fput (intern (x_frame_parms
[i
].name
), Qx_frame_parameter
,
600 /* Change the parameters of FRAME as specified by ALIST.
601 If a parameter is not specially recognized, do nothing;
602 otherwise call the `x_set_...' function for that parameter. */
605 x_set_frame_parameters (f
, alist
)
611 /* If both of these parameters are present, it's more efficient to
612 set them both at once. So we wait until we've looked at the
613 entire list before we set them. */
617 Lisp_Object left
, top
;
619 /* Same with these. */
620 Lisp_Object icon_left
, icon_top
;
622 /* Record in these vectors all the parms specified. */
626 int left_no_change
= 0, top_no_change
= 0;
627 int icon_left_no_change
= 0, icon_top_no_change
= 0;
630 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
633 parms
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
634 values
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
636 /* Extract parm names and values into those vectors. */
639 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
641 Lisp_Object elt
, prop
, val
;
644 parms
[i
] = Fcar (elt
);
645 values
[i
] = Fcdr (elt
);
649 top
= left
= Qunbound
;
650 icon_left
= icon_top
= Qunbound
;
652 /* Provide default values for HEIGHT and WIDTH. */
653 width
= FRAME_WIDTH (f
);
654 height
= FRAME_HEIGHT (f
);
656 /* Now process them in reverse of specified order. */
657 for (i
--; i
>= 0; i
--)
659 Lisp_Object prop
, val
;
664 if (EQ (prop
, Qwidth
) && NUMBERP (val
))
665 width
= XFASTINT (val
);
666 else if (EQ (prop
, Qheight
) && NUMBERP (val
))
667 height
= XFASTINT (val
);
668 else if (EQ (prop
, Qtop
))
670 else if (EQ (prop
, Qleft
))
672 else if (EQ (prop
, Qicon_top
))
674 else if (EQ (prop
, Qicon_left
))
678 register Lisp_Object param_index
, old_value
;
680 param_index
= Fget (prop
, Qx_frame_parameter
);
681 old_value
= get_frame_param (f
, prop
);
682 store_frame_param (f
, prop
, val
);
683 if (NATNUMP (param_index
)
684 && (XFASTINT (param_index
)
685 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
686 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
690 /* Don't die if just one of these was set. */
691 if (EQ (left
, Qunbound
))
694 if (f
->output_data
.w32
->left_pos
< 0)
695 left
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.w32
->left_pos
), Qnil
));
697 XSETINT (left
, f
->output_data
.w32
->left_pos
);
699 if (EQ (top
, Qunbound
))
702 if (f
->output_data
.w32
->top_pos
< 0)
703 top
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.w32
->top_pos
), Qnil
));
705 XSETINT (top
, f
->output_data
.w32
->top_pos
);
708 /* If one of the icon positions was not set, preserve or default it. */
709 if (EQ (icon_left
, Qunbound
) || ! INTEGERP (icon_left
))
711 icon_left_no_change
= 1;
712 icon_left
= Fcdr (Fassq (Qicon_left
, f
->param_alist
));
713 if (NILP (icon_left
))
714 XSETINT (icon_left
, 0);
716 if (EQ (icon_top
, Qunbound
) || ! INTEGERP (icon_top
))
718 icon_top_no_change
= 1;
719 icon_top
= Fcdr (Fassq (Qicon_top
, f
->param_alist
));
721 XSETINT (icon_top
, 0);
724 /* Don't set these parameters unless they've been explicitly
725 specified. The window might be mapped or resized while we're in
726 this function, and we don't want to override that unless the lisp
727 code has asked for it.
729 Don't set these parameters unless they actually differ from the
730 window's current parameters; the window may not actually exist
735 check_frame_size (f
, &height
, &width
);
737 XSETFRAME (frame
, f
);
739 if (XINT (width
) != FRAME_WIDTH (f
)
740 || XINT (height
) != FRAME_HEIGHT (f
))
741 Fset_frame_size (frame
, make_number (width
), make_number (height
));
743 if ((!NILP (left
) || !NILP (top
))
744 && ! (left_no_change
&& top_no_change
)
745 && ! (NUMBERP (left
) && XINT (left
) == f
->output_data
.w32
->left_pos
746 && NUMBERP (top
) && XINT (top
) == f
->output_data
.w32
->top_pos
))
751 /* Record the signs. */
752 f
->output_data
.w32
->size_hint_flags
&= ~ (XNegative
| YNegative
);
753 if (EQ (left
, Qminus
))
754 f
->output_data
.w32
->size_hint_flags
|= XNegative
;
755 else if (INTEGERP (left
))
757 leftpos
= XINT (left
);
759 f
->output_data
.w32
->size_hint_flags
|= XNegative
;
761 else if (CONSP (left
) && EQ (XCONS (left
)->car
, Qminus
)
762 && CONSP (XCONS (left
)->cdr
)
763 && INTEGERP (XCONS (XCONS (left
)->cdr
)->car
))
765 leftpos
= - XINT (XCONS (XCONS (left
)->cdr
)->car
);
766 f
->output_data
.w32
->size_hint_flags
|= XNegative
;
768 else if (CONSP (left
) && EQ (XCONS (left
)->car
, Qplus
)
769 && CONSP (XCONS (left
)->cdr
)
770 && INTEGERP (XCONS (XCONS (left
)->cdr
)->car
))
772 leftpos
= XINT (XCONS (XCONS (left
)->cdr
)->car
);
775 if (EQ (top
, Qminus
))
776 f
->output_data
.w32
->size_hint_flags
|= YNegative
;
777 else if (INTEGERP (top
))
781 f
->output_data
.w32
->size_hint_flags
|= YNegative
;
783 else if (CONSP (top
) && EQ (XCONS (top
)->car
, Qminus
)
784 && CONSP (XCONS (top
)->cdr
)
785 && INTEGERP (XCONS (XCONS (top
)->cdr
)->car
))
787 toppos
= - XINT (XCONS (XCONS (top
)->cdr
)->car
);
788 f
->output_data
.w32
->size_hint_flags
|= YNegative
;
790 else if (CONSP (top
) && EQ (XCONS (top
)->car
, Qplus
)
791 && CONSP (XCONS (top
)->cdr
)
792 && INTEGERP (XCONS (XCONS (top
)->cdr
)->car
))
794 toppos
= XINT (XCONS (XCONS (top
)->cdr
)->car
);
798 /* Store the numeric value of the position. */
799 f
->output_data
.w32
->top_pos
= toppos
;
800 f
->output_data
.w32
->left_pos
= leftpos
;
802 f
->output_data
.w32
->win_gravity
= NorthWestGravity
;
804 /* Actually set that position, and convert to absolute. */
805 x_set_offset (f
, leftpos
, toppos
, -1);
808 if ((!NILP (icon_left
) || !NILP (icon_top
))
809 && ! (icon_left_no_change
&& icon_top_no_change
))
810 x_wm_set_icon_position (f
, XINT (icon_left
), XINT (icon_top
));
814 /* Store the screen positions of frame F into XPTR and YPTR.
815 These are the positions of the containing window manager window,
816 not Emacs's own window. */
819 x_real_positions (f
, xptr
, yptr
)
828 GetClientRect(FRAME_W32_WINDOW(f
), &rect
);
829 AdjustWindowRect(&rect
, f
->output_data
.w32
->dwStyle
, FRAME_EXTERNAL_MENU_BAR(f
));
835 ClientToScreen (FRAME_W32_WINDOW(f
), &pt
);
841 /* Insert a description of internally-recorded parameters of frame X
842 into the parameter alist *ALISTPTR that is to be given to the user.
843 Only parameters that are specific to W32
844 and whose values are not correctly recorded in the frame's
845 param_alist need to be considered here. */
847 x_report_frame_params (f
, alistptr
)
849 Lisp_Object
*alistptr
;
854 /* Represent negative positions (off the top or left screen edge)
855 in a way that Fmodify_frame_parameters will understand correctly. */
856 XSETINT (tem
, f
->output_data
.w32
->left_pos
);
857 if (f
->output_data
.w32
->left_pos
>= 0)
858 store_in_alist (alistptr
, Qleft
, tem
);
860 store_in_alist (alistptr
, Qleft
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
862 XSETINT (tem
, f
->output_data
.w32
->top_pos
);
863 if (f
->output_data
.w32
->top_pos
>= 0)
864 store_in_alist (alistptr
, Qtop
, tem
);
866 store_in_alist (alistptr
, Qtop
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
868 store_in_alist (alistptr
, Qborder_width
,
869 make_number (f
->output_data
.w32
->border_width
));
870 store_in_alist (alistptr
, Qinternal_border_width
,
871 make_number (f
->output_data
.w32
->internal_border_width
));
872 sprintf (buf
, "%ld", (long) FRAME_W32_WINDOW (f
));
873 store_in_alist (alistptr
, Qwindow_id
,
875 store_in_alist (alistptr
, Qicon_name
, f
->icon_name
);
876 FRAME_SAMPLE_VISIBILITY (f
);
877 store_in_alist (alistptr
, Qvisibility
,
878 (FRAME_VISIBLE_P (f
) ? Qt
879 : FRAME_ICONIFIED_P (f
) ? Qicon
: Qnil
));
880 store_in_alist (alistptr
, Qdisplay
,
881 XCONS (FRAME_W32_DISPLAY_INFO (f
)->name_list_element
)->car
);
885 DEFUN ("w32-define-rgb-color", Fw32_define_rgb_color
, Sw32_define_rgb_color
, 4, 4, 0,
886 "Convert RGB numbers to a windows color reference and associate with NAME (a string).\n\
887 This adds or updates a named color to w32-color-map, making it available for use.\n\
888 The original entry's RGB ref is returned, or nil if the entry is new.")
889 (red
, green
, blue
, name
)
890 Lisp_Object red
, green
, blue
, name
;
893 Lisp_Object oldrgb
= Qnil
;
896 CHECK_NUMBER (red
, 0);
897 CHECK_NUMBER (green
, 0);
898 CHECK_NUMBER (blue
, 0);
899 CHECK_STRING (name
, 0);
901 XSET (rgb
, Lisp_Int
, RGB(XUINT (red
), XUINT (green
), XUINT (blue
)));
905 /* replace existing entry in w32-color-map or add new entry. */
906 entry
= Fassoc (name
, Vw32_color_map
);
909 entry
= Fcons (name
, rgb
);
910 Vw32_color_map
= Fcons (entry
, Vw32_color_map
);
914 oldrgb
= Fcdr (entry
);
915 Fsetcdr (entry
, rgb
);
923 DEFUN ("w32-load-color-file", Fw32_load_color_file
, Sw32_load_color_file
, 1, 1, 0,
924 "Create an alist of color entries from an external file (ie. rgb.txt).\n\
925 Assign this value to w32-color-map to replace the existing color map.\n\
927 The file should define one named RGB color per line like so:\
929 where R,G,B are numbers between 0 and 255 and name is an arbitrary string.")
931 Lisp_Object filename
;
934 Lisp_Object cmap
= Qnil
;
937 CHECK_STRING (filename
, 0);
938 abspath
= Fexpand_file_name (filename
, Qnil
);
940 fp
= fopen (XSTRING (filename
)->data
, "rt");
944 int red
, green
, blue
;
949 while (fgets (buf
, sizeof (buf
), fp
) != NULL
) {
950 if (sscanf (buf
, "%u %u %u %n", &red
, &green
, &blue
, &num
) == 3)
952 char *name
= buf
+ num
;
953 num
= strlen (name
) - 1;
954 if (name
[num
] == '\n')
956 cmap
= Fcons (Fcons (build_string (name
),
957 make_number (RGB (red
, green
, blue
))),
969 /* The default colors for the w32 color map */
970 typedef struct colormap_t
976 colormap_t w32_color_map
[] =
978 {"snow" , PALETTERGB (255,250,250)},
979 {"ghost white" , PALETTERGB (248,248,255)},
980 {"GhostWhite" , PALETTERGB (248,248,255)},
981 {"white smoke" , PALETTERGB (245,245,245)},
982 {"WhiteSmoke" , PALETTERGB (245,245,245)},
983 {"gainsboro" , PALETTERGB (220,220,220)},
984 {"floral white" , PALETTERGB (255,250,240)},
985 {"FloralWhite" , PALETTERGB (255,250,240)},
986 {"old lace" , PALETTERGB (253,245,230)},
987 {"OldLace" , PALETTERGB (253,245,230)},
988 {"linen" , PALETTERGB (250,240,230)},
989 {"antique white" , PALETTERGB (250,235,215)},
990 {"AntiqueWhite" , PALETTERGB (250,235,215)},
991 {"papaya whip" , PALETTERGB (255,239,213)},
992 {"PapayaWhip" , PALETTERGB (255,239,213)},
993 {"blanched almond" , PALETTERGB (255,235,205)},
994 {"BlanchedAlmond" , PALETTERGB (255,235,205)},
995 {"bisque" , PALETTERGB (255,228,196)},
996 {"peach puff" , PALETTERGB (255,218,185)},
997 {"PeachPuff" , PALETTERGB (255,218,185)},
998 {"navajo white" , PALETTERGB (255,222,173)},
999 {"NavajoWhite" , PALETTERGB (255,222,173)},
1000 {"moccasin" , PALETTERGB (255,228,181)},
1001 {"cornsilk" , PALETTERGB (255,248,220)},
1002 {"ivory" , PALETTERGB (255,255,240)},
1003 {"lemon chiffon" , PALETTERGB (255,250,205)},
1004 {"LemonChiffon" , PALETTERGB (255,250,205)},
1005 {"seashell" , PALETTERGB (255,245,238)},
1006 {"honeydew" , PALETTERGB (240,255,240)},
1007 {"mint cream" , PALETTERGB (245,255,250)},
1008 {"MintCream" , PALETTERGB (245,255,250)},
1009 {"azure" , PALETTERGB (240,255,255)},
1010 {"alice blue" , PALETTERGB (240,248,255)},
1011 {"AliceBlue" , PALETTERGB (240,248,255)},
1012 {"lavender" , PALETTERGB (230,230,250)},
1013 {"lavender blush" , PALETTERGB (255,240,245)},
1014 {"LavenderBlush" , PALETTERGB (255,240,245)},
1015 {"misty rose" , PALETTERGB (255,228,225)},
1016 {"MistyRose" , PALETTERGB (255,228,225)},
1017 {"white" , PALETTERGB (255,255,255)},
1018 {"black" , PALETTERGB ( 0, 0, 0)},
1019 {"dark slate gray" , PALETTERGB ( 47, 79, 79)},
1020 {"DarkSlateGray" , PALETTERGB ( 47, 79, 79)},
1021 {"dark slate grey" , PALETTERGB ( 47, 79, 79)},
1022 {"DarkSlateGrey" , PALETTERGB ( 47, 79, 79)},
1023 {"dim gray" , PALETTERGB (105,105,105)},
1024 {"DimGray" , PALETTERGB (105,105,105)},
1025 {"dim grey" , PALETTERGB (105,105,105)},
1026 {"DimGrey" , PALETTERGB (105,105,105)},
1027 {"slate gray" , PALETTERGB (112,128,144)},
1028 {"SlateGray" , PALETTERGB (112,128,144)},
1029 {"slate grey" , PALETTERGB (112,128,144)},
1030 {"SlateGrey" , PALETTERGB (112,128,144)},
1031 {"light slate gray" , PALETTERGB (119,136,153)},
1032 {"LightSlateGray" , PALETTERGB (119,136,153)},
1033 {"light slate grey" , PALETTERGB (119,136,153)},
1034 {"LightSlateGrey" , PALETTERGB (119,136,153)},
1035 {"gray" , PALETTERGB (190,190,190)},
1036 {"grey" , PALETTERGB (190,190,190)},
1037 {"light grey" , PALETTERGB (211,211,211)},
1038 {"LightGrey" , PALETTERGB (211,211,211)},
1039 {"light gray" , PALETTERGB (211,211,211)},
1040 {"LightGray" , PALETTERGB (211,211,211)},
1041 {"midnight blue" , PALETTERGB ( 25, 25,112)},
1042 {"MidnightBlue" , PALETTERGB ( 25, 25,112)},
1043 {"navy" , PALETTERGB ( 0, 0,128)},
1044 {"navy blue" , PALETTERGB ( 0, 0,128)},
1045 {"NavyBlue" , PALETTERGB ( 0, 0,128)},
1046 {"cornflower blue" , PALETTERGB (100,149,237)},
1047 {"CornflowerBlue" , PALETTERGB (100,149,237)},
1048 {"dark slate blue" , PALETTERGB ( 72, 61,139)},
1049 {"DarkSlateBlue" , PALETTERGB ( 72, 61,139)},
1050 {"slate blue" , PALETTERGB (106, 90,205)},
1051 {"SlateBlue" , PALETTERGB (106, 90,205)},
1052 {"medium slate blue" , PALETTERGB (123,104,238)},
1053 {"MediumSlateBlue" , PALETTERGB (123,104,238)},
1054 {"light slate blue" , PALETTERGB (132,112,255)},
1055 {"LightSlateBlue" , PALETTERGB (132,112,255)},
1056 {"medium blue" , PALETTERGB ( 0, 0,205)},
1057 {"MediumBlue" , PALETTERGB ( 0, 0,205)},
1058 {"royal blue" , PALETTERGB ( 65,105,225)},
1059 {"RoyalBlue" , PALETTERGB ( 65,105,225)},
1060 {"blue" , PALETTERGB ( 0, 0,255)},
1061 {"dodger blue" , PALETTERGB ( 30,144,255)},
1062 {"DodgerBlue" , PALETTERGB ( 30,144,255)},
1063 {"deep sky blue" , PALETTERGB ( 0,191,255)},
1064 {"DeepSkyBlue" , PALETTERGB ( 0,191,255)},
1065 {"sky blue" , PALETTERGB (135,206,235)},
1066 {"SkyBlue" , PALETTERGB (135,206,235)},
1067 {"light sky blue" , PALETTERGB (135,206,250)},
1068 {"LightSkyBlue" , PALETTERGB (135,206,250)},
1069 {"steel blue" , PALETTERGB ( 70,130,180)},
1070 {"SteelBlue" , PALETTERGB ( 70,130,180)},
1071 {"light steel blue" , PALETTERGB (176,196,222)},
1072 {"LightSteelBlue" , PALETTERGB (176,196,222)},
1073 {"light blue" , PALETTERGB (173,216,230)},
1074 {"LightBlue" , PALETTERGB (173,216,230)},
1075 {"powder blue" , PALETTERGB (176,224,230)},
1076 {"PowderBlue" , PALETTERGB (176,224,230)},
1077 {"pale turquoise" , PALETTERGB (175,238,238)},
1078 {"PaleTurquoise" , PALETTERGB (175,238,238)},
1079 {"dark turquoise" , PALETTERGB ( 0,206,209)},
1080 {"DarkTurquoise" , PALETTERGB ( 0,206,209)},
1081 {"medium turquoise" , PALETTERGB ( 72,209,204)},
1082 {"MediumTurquoise" , PALETTERGB ( 72,209,204)},
1083 {"turquoise" , PALETTERGB ( 64,224,208)},
1084 {"cyan" , PALETTERGB ( 0,255,255)},
1085 {"light cyan" , PALETTERGB (224,255,255)},
1086 {"LightCyan" , PALETTERGB (224,255,255)},
1087 {"cadet blue" , PALETTERGB ( 95,158,160)},
1088 {"CadetBlue" , PALETTERGB ( 95,158,160)},
1089 {"medium aquamarine" , PALETTERGB (102,205,170)},
1090 {"MediumAquamarine" , PALETTERGB (102,205,170)},
1091 {"aquamarine" , PALETTERGB (127,255,212)},
1092 {"dark green" , PALETTERGB ( 0,100, 0)},
1093 {"DarkGreen" , PALETTERGB ( 0,100, 0)},
1094 {"dark olive green" , PALETTERGB ( 85,107, 47)},
1095 {"DarkOliveGreen" , PALETTERGB ( 85,107, 47)},
1096 {"dark sea green" , PALETTERGB (143,188,143)},
1097 {"DarkSeaGreen" , PALETTERGB (143,188,143)},
1098 {"sea green" , PALETTERGB ( 46,139, 87)},
1099 {"SeaGreen" , PALETTERGB ( 46,139, 87)},
1100 {"medium sea green" , PALETTERGB ( 60,179,113)},
1101 {"MediumSeaGreen" , PALETTERGB ( 60,179,113)},
1102 {"light sea green" , PALETTERGB ( 32,178,170)},
1103 {"LightSeaGreen" , PALETTERGB ( 32,178,170)},
1104 {"pale green" , PALETTERGB (152,251,152)},
1105 {"PaleGreen" , PALETTERGB (152,251,152)},
1106 {"spring green" , PALETTERGB ( 0,255,127)},
1107 {"SpringGreen" , PALETTERGB ( 0,255,127)},
1108 {"lawn green" , PALETTERGB (124,252, 0)},
1109 {"LawnGreen" , PALETTERGB (124,252, 0)},
1110 {"green" , PALETTERGB ( 0,255, 0)},
1111 {"chartreuse" , PALETTERGB (127,255, 0)},
1112 {"medium spring green" , PALETTERGB ( 0,250,154)},
1113 {"MediumSpringGreen" , PALETTERGB ( 0,250,154)},
1114 {"green yellow" , PALETTERGB (173,255, 47)},
1115 {"GreenYellow" , PALETTERGB (173,255, 47)},
1116 {"lime green" , PALETTERGB ( 50,205, 50)},
1117 {"LimeGreen" , PALETTERGB ( 50,205, 50)},
1118 {"yellow green" , PALETTERGB (154,205, 50)},
1119 {"YellowGreen" , PALETTERGB (154,205, 50)},
1120 {"forest green" , PALETTERGB ( 34,139, 34)},
1121 {"ForestGreen" , PALETTERGB ( 34,139, 34)},
1122 {"olive drab" , PALETTERGB (107,142, 35)},
1123 {"OliveDrab" , PALETTERGB (107,142, 35)},
1124 {"dark khaki" , PALETTERGB (189,183,107)},
1125 {"DarkKhaki" , PALETTERGB (189,183,107)},
1126 {"khaki" , PALETTERGB (240,230,140)},
1127 {"pale goldenrod" , PALETTERGB (238,232,170)},
1128 {"PaleGoldenrod" , PALETTERGB (238,232,170)},
1129 {"light goldenrod yellow" , PALETTERGB (250,250,210)},
1130 {"LightGoldenrodYellow" , PALETTERGB (250,250,210)},
1131 {"light yellow" , PALETTERGB (255,255,224)},
1132 {"LightYellow" , PALETTERGB (255,255,224)},
1133 {"yellow" , PALETTERGB (255,255, 0)},
1134 {"gold" , PALETTERGB (255,215, 0)},
1135 {"light goldenrod" , PALETTERGB (238,221,130)},
1136 {"LightGoldenrod" , PALETTERGB (238,221,130)},
1137 {"goldenrod" , PALETTERGB (218,165, 32)},
1138 {"dark goldenrod" , PALETTERGB (184,134, 11)},
1139 {"DarkGoldenrod" , PALETTERGB (184,134, 11)},
1140 {"rosy brown" , PALETTERGB (188,143,143)},
1141 {"RosyBrown" , PALETTERGB (188,143,143)},
1142 {"indian red" , PALETTERGB (205, 92, 92)},
1143 {"IndianRed" , PALETTERGB (205, 92, 92)},
1144 {"saddle brown" , PALETTERGB (139, 69, 19)},
1145 {"SaddleBrown" , PALETTERGB (139, 69, 19)},
1146 {"sienna" , PALETTERGB (160, 82, 45)},
1147 {"peru" , PALETTERGB (205,133, 63)},
1148 {"burlywood" , PALETTERGB (222,184,135)},
1149 {"beige" , PALETTERGB (245,245,220)},
1150 {"wheat" , PALETTERGB (245,222,179)},
1151 {"sandy brown" , PALETTERGB (244,164, 96)},
1152 {"SandyBrown" , PALETTERGB (244,164, 96)},
1153 {"tan" , PALETTERGB (210,180,140)},
1154 {"chocolate" , PALETTERGB (210,105, 30)},
1155 {"firebrick" , PALETTERGB (178,34, 34)},
1156 {"brown" , PALETTERGB (165,42, 42)},
1157 {"dark salmon" , PALETTERGB (233,150,122)},
1158 {"DarkSalmon" , PALETTERGB (233,150,122)},
1159 {"salmon" , PALETTERGB (250,128,114)},
1160 {"light salmon" , PALETTERGB (255,160,122)},
1161 {"LightSalmon" , PALETTERGB (255,160,122)},
1162 {"orange" , PALETTERGB (255,165, 0)},
1163 {"dark orange" , PALETTERGB (255,140, 0)},
1164 {"DarkOrange" , PALETTERGB (255,140, 0)},
1165 {"coral" , PALETTERGB (255,127, 80)},
1166 {"light coral" , PALETTERGB (240,128,128)},
1167 {"LightCoral" , PALETTERGB (240,128,128)},
1168 {"tomato" , PALETTERGB (255, 99, 71)},
1169 {"orange red" , PALETTERGB (255, 69, 0)},
1170 {"OrangeRed" , PALETTERGB (255, 69, 0)},
1171 {"red" , PALETTERGB (255, 0, 0)},
1172 {"hot pink" , PALETTERGB (255,105,180)},
1173 {"HotPink" , PALETTERGB (255,105,180)},
1174 {"deep pink" , PALETTERGB (255, 20,147)},
1175 {"DeepPink" , PALETTERGB (255, 20,147)},
1176 {"pink" , PALETTERGB (255,192,203)},
1177 {"light pink" , PALETTERGB (255,182,193)},
1178 {"LightPink" , PALETTERGB (255,182,193)},
1179 {"pale violet red" , PALETTERGB (219,112,147)},
1180 {"PaleVioletRed" , PALETTERGB (219,112,147)},
1181 {"maroon" , PALETTERGB (176, 48, 96)},
1182 {"medium violet red" , PALETTERGB (199, 21,133)},
1183 {"MediumVioletRed" , PALETTERGB (199, 21,133)},
1184 {"violet red" , PALETTERGB (208, 32,144)},
1185 {"VioletRed" , PALETTERGB (208, 32,144)},
1186 {"magenta" , PALETTERGB (255, 0,255)},
1187 {"violet" , PALETTERGB (238,130,238)},
1188 {"plum" , PALETTERGB (221,160,221)},
1189 {"orchid" , PALETTERGB (218,112,214)},
1190 {"medium orchid" , PALETTERGB (186, 85,211)},
1191 {"MediumOrchid" , PALETTERGB (186, 85,211)},
1192 {"dark orchid" , PALETTERGB (153, 50,204)},
1193 {"DarkOrchid" , PALETTERGB (153, 50,204)},
1194 {"dark violet" , PALETTERGB (148, 0,211)},
1195 {"DarkViolet" , PALETTERGB (148, 0,211)},
1196 {"blue violet" , PALETTERGB (138, 43,226)},
1197 {"BlueViolet" , PALETTERGB (138, 43,226)},
1198 {"purple" , PALETTERGB (160, 32,240)},
1199 {"medium purple" , PALETTERGB (147,112,219)},
1200 {"MediumPurple" , PALETTERGB (147,112,219)},
1201 {"thistle" , PALETTERGB (216,191,216)},
1202 {"gray0" , PALETTERGB ( 0, 0, 0)},
1203 {"grey0" , PALETTERGB ( 0, 0, 0)},
1204 {"dark grey" , PALETTERGB (169,169,169)},
1205 {"DarkGrey" , PALETTERGB (169,169,169)},
1206 {"dark gray" , PALETTERGB (169,169,169)},
1207 {"DarkGray" , PALETTERGB (169,169,169)},
1208 {"dark blue" , PALETTERGB ( 0, 0,139)},
1209 {"DarkBlue" , PALETTERGB ( 0, 0,139)},
1210 {"dark cyan" , PALETTERGB ( 0,139,139)},
1211 {"DarkCyan" , PALETTERGB ( 0,139,139)},
1212 {"dark magenta" , PALETTERGB (139, 0,139)},
1213 {"DarkMagenta" , PALETTERGB (139, 0,139)},
1214 {"dark red" , PALETTERGB (139, 0, 0)},
1215 {"DarkRed" , PALETTERGB (139, 0, 0)},
1216 {"light green" , PALETTERGB (144,238,144)},
1217 {"LightGreen" , PALETTERGB (144,238,144)},
1220 DEFUN ("w32-default-color-map", Fw32_default_color_map
, Sw32_default_color_map
,
1221 0, 0, 0, "Return the default color map.")
1225 colormap_t
*pc
= w32_color_map
;
1232 for (i
= 0; i
< sizeof (w32_color_map
) / sizeof (w32_color_map
[0]);
1234 cmap
= Fcons (Fcons (build_string (pc
->name
),
1235 make_number (pc
->colorref
)),
1244 w32_to_x_color (rgb
)
1249 CHECK_NUMBER (rgb
, 0);
1253 color
= Frassq (rgb
, Vw32_color_map
);
1258 return (Fcar (color
));
1264 x_to_w32_color (colorname
)
1267 register Lisp_Object tail
, ret
= Qnil
;
1271 if (colorname
[0] == '#')
1273 /* Could be an old-style RGB Device specification. */
1276 color
= colorname
+ 1;
1278 size
= strlen(color
);
1279 if (size
== 3 || size
== 6 || size
== 9 || size
== 12)
1287 for (i
= 0; i
< 3; i
++)
1291 unsigned long value
;
1293 /* The check for 'x' in the following conditional takes into
1294 account the fact that strtol allows a "0x" in front of
1295 our numbers, and we don't. */
1296 if (!isxdigit(color
[0]) || color
[1] == 'x')
1300 value
= strtoul(color
, &end
, 16);
1302 if (errno
== ERANGE
|| end
- color
!= size
)
1307 value
= value
* 0x10;
1318 colorval
|= (value
<< pos
);
1329 else if (strnicmp(colorname
, "rgb:", 4) == 0)
1337 color
= colorname
+ 4;
1338 for (i
= 0; i
< 3; i
++)
1341 unsigned long value
;
1343 /* The check for 'x' in the following conditional takes into
1344 account the fact that strtol allows a "0x" in front of
1345 our numbers, and we don't. */
1346 if (!isxdigit(color
[0]) || color
[1] == 'x')
1348 value
= strtoul(color
, &end
, 16);
1349 if (errno
== ERANGE
)
1351 switch (end
- color
)
1354 value
= value
* 0x10 + value
;
1367 if (value
== ULONG_MAX
)
1369 colorval
|= (value
<< pos
);
1383 else if (strnicmp(colorname
, "rgbi:", 5) == 0)
1385 /* This is an RGB Intensity specification. */
1392 color
= colorname
+ 5;
1393 for (i
= 0; i
< 3; i
++)
1399 value
= strtod(color
, &end
);
1400 if (errno
== ERANGE
)
1402 if (value
< 0.0 || value
> 1.0)
1404 val
= (UINT
)(0x100 * value
);
1405 /* We used 0x100 instead of 0xFF to give an continuous
1406 range between 0.0 and 1.0 inclusive. The next statement
1407 fixes the 1.0 case. */
1410 colorval
|= (val
<< pos
);
1424 /* I am not going to attempt to handle any of the CIE color schemes
1425 or TekHVC, since I don't know the algorithms for conversion to
1428 for (tail
= Vw32_color_map
; !NILP (tail
); tail
= Fcdr (tail
))
1430 register Lisp_Object elt
, tem
;
1433 if (!CONSP (elt
)) continue;
1437 if (lstrcmpi (XSTRING (tem
)->data
, colorname
) == 0)
1439 ret
= XUINT(Fcdr (elt
));
1453 w32_regenerate_palette (FRAME_PTR f
)
1455 struct w32_palette_entry
* list
;
1456 LOGPALETTE
* log_palette
;
1457 HPALETTE new_palette
;
1460 /* don't bother trying to create palette if not supported */
1461 if (! FRAME_W32_DISPLAY_INFO (f
)->has_palette
)
1464 log_palette
= (LOGPALETTE
*)
1465 alloca (sizeof (LOGPALETTE
) +
1466 FRAME_W32_DISPLAY_INFO (f
)->num_colors
* sizeof (PALETTEENTRY
));
1467 log_palette
->palVersion
= 0x300;
1468 log_palette
->palNumEntries
= FRAME_W32_DISPLAY_INFO (f
)->num_colors
;
1470 list
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1472 i
< FRAME_W32_DISPLAY_INFO (f
)->num_colors
;
1473 i
++, list
= list
->next
)
1474 log_palette
->palPalEntry
[i
] = list
->entry
;
1476 new_palette
= CreatePalette (log_palette
);
1480 if (FRAME_W32_DISPLAY_INFO (f
)->palette
)
1481 DeleteObject (FRAME_W32_DISPLAY_INFO (f
)->palette
);
1482 FRAME_W32_DISPLAY_INFO (f
)->palette
= new_palette
;
1484 /* Realize display palette and garbage all frames. */
1485 release_frame_dc (f
, get_frame_dc (f
));
1490 #define W32_COLOR(pe) RGB (pe.peRed, pe.peGreen, pe.peBlue)
1491 #define SET_W32_COLOR(pe, color) \
1494 pe.peRed = GetRValue (color); \
1495 pe.peGreen = GetGValue (color); \
1496 pe.peBlue = GetBValue (color); \
1501 /* Keep these around in case we ever want to track color usage. */
1503 w32_map_color (FRAME_PTR f
, COLORREF color
)
1505 struct w32_palette_entry
* list
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1507 if (NILP (Vw32_enable_palette
))
1510 /* check if color is already mapped */
1513 if (W32_COLOR (list
->entry
) == color
)
1521 /* not already mapped, so add to list and recreate Windows palette */
1522 list
= (struct w32_palette_entry
*)
1523 xmalloc (sizeof (struct w32_palette_entry
));
1524 SET_W32_COLOR (list
->entry
, color
);
1526 list
->next
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1527 FRAME_W32_DISPLAY_INFO (f
)->color_list
= list
;
1528 FRAME_W32_DISPLAY_INFO (f
)->num_colors
++;
1530 /* set flag that palette must be regenerated */
1531 FRAME_W32_DISPLAY_INFO (f
)->regen_palette
= TRUE
;
1535 w32_unmap_color (FRAME_PTR f
, COLORREF color
)
1537 struct w32_palette_entry
* list
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1538 struct w32_palette_entry
**prev
= &FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1540 if (NILP (Vw32_enable_palette
))
1543 /* check if color is already mapped */
1546 if (W32_COLOR (list
->entry
) == color
)
1548 if (--list
->refcount
== 0)
1552 FRAME_W32_DISPLAY_INFO (f
)->num_colors
--;
1562 /* set flag that palette must be regenerated */
1563 FRAME_W32_DISPLAY_INFO (f
)->regen_palette
= TRUE
;
1567 /* Decide if color named COLOR is valid for the display associated with
1568 the selected frame; if so, return the rgb values in COLOR_DEF.
1569 If ALLOC is nonzero, allocate a new colormap cell. */
1572 defined_color (f
, color
, color_def
, alloc
)
1575 COLORREF
*color_def
;
1578 register Lisp_Object tem
;
1580 tem
= x_to_w32_color (color
);
1584 if (!NILP (Vw32_enable_palette
))
1586 struct w32_palette_entry
* entry
=
1587 FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1588 struct w32_palette_entry
** prev
=
1589 &FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1591 /* check if color is already mapped */
1594 if (W32_COLOR (entry
->entry
) == XUINT (tem
))
1596 prev
= &entry
->next
;
1597 entry
= entry
->next
;
1600 if (entry
== NULL
&& alloc
)
1602 /* not already mapped, so add to list */
1603 entry
= (struct w32_palette_entry
*)
1604 xmalloc (sizeof (struct w32_palette_entry
));
1605 SET_W32_COLOR (entry
->entry
, XUINT (tem
));
1608 FRAME_W32_DISPLAY_INFO (f
)->num_colors
++;
1610 /* set flag that palette must be regenerated */
1611 FRAME_W32_DISPLAY_INFO (f
)->regen_palette
= TRUE
;
1614 /* Ensure COLORREF value is snapped to nearest color in (default)
1615 palette by simulating the PALETTERGB macro. This works whether
1616 or not the display device has a palette. */
1617 *color_def
= XUINT (tem
) | 0x2000000;
1626 /* Given a string ARG naming a color, compute a pixel value from it
1627 suitable for screen F.
1628 If F is not a color screen, return DEF (default) regardless of what
1632 x_decode_color (f
, arg
, def
)
1639 CHECK_STRING (arg
, 0);
1641 if (strcmp (XSTRING (arg
)->data
, "black") == 0)
1642 return BLACK_PIX_DEFAULT (f
);
1643 else if (strcmp (XSTRING (arg
)->data
, "white") == 0)
1644 return WHITE_PIX_DEFAULT (f
);
1646 if ((FRAME_W32_DISPLAY_INFO (f
)->n_planes
* FRAME_W32_DISPLAY_INFO (f
)->n_cbits
) == 1)
1649 /* defined_color is responsible for coping with failures
1650 by looking for a near-miss. */
1651 if (defined_color (f
, XSTRING (arg
)->data
, &cdef
, 1))
1654 /* defined_color failed; return an ultimate default. */
1658 /* Functions called only from `x_set_frame_param'
1659 to set individual parameters.
1661 If FRAME_W32_WINDOW (f) is 0,
1662 the frame is being created and its window does not exist yet.
1663 In that case, just record the parameter's new value
1664 in the standard place; do not attempt to change the window. */
1667 x_set_foreground_color (f
, arg
, oldval
)
1669 Lisp_Object arg
, oldval
;
1671 f
->output_data
.w32
->foreground_pixel
1672 = x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1674 if (FRAME_W32_WINDOW (f
) != 0)
1676 recompute_basic_faces (f
);
1677 if (FRAME_VISIBLE_P (f
))
1683 x_set_background_color (f
, arg
, oldval
)
1685 Lisp_Object arg
, oldval
;
1690 f
->output_data
.w32
->background_pixel
1691 = x_decode_color (f
, arg
, WHITE_PIX_DEFAULT (f
));
1693 if (FRAME_W32_WINDOW (f
) != 0)
1695 SetWindowLong (FRAME_W32_WINDOW (f
), WND_BACKGROUND_INDEX
, f
->output_data
.w32
->background_pixel
);
1697 recompute_basic_faces (f
);
1699 if (FRAME_VISIBLE_P (f
))
1705 x_set_mouse_color (f
, arg
, oldval
)
1707 Lisp_Object arg
, oldval
;
1710 Cursor cursor
, nontext_cursor
, mode_cursor
, cross_cursor
;
1715 if (!EQ (Qnil
, arg
))
1716 f
->output_data
.w32
->mouse_pixel
1717 = x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1718 mask_color
= f
->output_data
.w32
->background_pixel
;
1719 /* No invisible pointers. */
1720 if (mask_color
== f
->output_data
.w32
->mouse_pixel
1721 && mask_color
== f
->output_data
.w32
->background_pixel
)
1722 f
->output_data
.w32
->mouse_pixel
= f
->output_data
.w32
->foreground_pixel
;
1727 /* It's not okay to crash if the user selects a screwy cursor. */
1728 count
= x_catch_errors (FRAME_W32_DISPLAY (f
));
1730 if (!EQ (Qnil
, Vx_pointer_shape
))
1732 CHECK_NUMBER (Vx_pointer_shape
, 0);
1733 cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XINT (Vx_pointer_shape
));
1736 cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_xterm
);
1737 x_check_errors (FRAME_W32_DISPLAY (f
), "bad text pointer cursor: %s");
1739 if (!EQ (Qnil
, Vx_nontext_pointer_shape
))
1741 CHECK_NUMBER (Vx_nontext_pointer_shape
, 0);
1742 nontext_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
),
1743 XINT (Vx_nontext_pointer_shape
));
1746 nontext_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_left_ptr
);
1747 x_check_errors (FRAME_W32_DISPLAY (f
), "bad nontext pointer cursor: %s");
1749 if (!EQ (Qnil
, Vx_mode_pointer_shape
))
1751 CHECK_NUMBER (Vx_mode_pointer_shape
, 0);
1752 mode_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
),
1753 XINT (Vx_mode_pointer_shape
));
1756 mode_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_xterm
);
1757 x_check_errors (FRAME_W32_DISPLAY (f
), "bad modeline pointer cursor: %s");
1759 if (!EQ (Qnil
, Vx_sensitive_text_pointer_shape
))
1761 CHECK_NUMBER (Vx_sensitive_text_pointer_shape
, 0);
1763 = XCreateFontCursor (FRAME_W32_DISPLAY (f
),
1764 XINT (Vx_sensitive_text_pointer_shape
));
1767 cross_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_crosshair
);
1769 /* Check and report errors with the above calls. */
1770 x_check_errors (FRAME_W32_DISPLAY (f
), "can't set cursor shape: %s");
1771 x_uncatch_errors (FRAME_W32_DISPLAY (f
), count
);
1774 XColor fore_color
, back_color
;
1776 fore_color
.pixel
= f
->output_data
.w32
->mouse_pixel
;
1777 back_color
.pixel
= mask_color
;
1778 XQueryColor (FRAME_W32_DISPLAY (f
),
1779 DefaultColormap (FRAME_W32_DISPLAY (f
),
1780 DefaultScreen (FRAME_W32_DISPLAY (f
))),
1782 XQueryColor (FRAME_W32_DISPLAY (f
),
1783 DefaultColormap (FRAME_W32_DISPLAY (f
),
1784 DefaultScreen (FRAME_W32_DISPLAY (f
))),
1786 XRecolorCursor (FRAME_W32_DISPLAY (f
), cursor
,
1787 &fore_color
, &back_color
);
1788 XRecolorCursor (FRAME_W32_DISPLAY (f
), nontext_cursor
,
1789 &fore_color
, &back_color
);
1790 XRecolorCursor (FRAME_W32_DISPLAY (f
), mode_cursor
,
1791 &fore_color
, &back_color
);
1792 XRecolorCursor (FRAME_W32_DISPLAY (f
), cross_cursor
,
1793 &fore_color
, &back_color
);
1796 if (FRAME_W32_WINDOW (f
) != 0)
1798 XDefineCursor (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
), cursor
);
1801 if (cursor
!= f
->output_data
.w32
->text_cursor
&& f
->output_data
.w32
->text_cursor
!= 0)
1802 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->text_cursor
);
1803 f
->output_data
.w32
->text_cursor
= cursor
;
1805 if (nontext_cursor
!= f
->output_data
.w32
->nontext_cursor
1806 && f
->output_data
.w32
->nontext_cursor
!= 0)
1807 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->nontext_cursor
);
1808 f
->output_data
.w32
->nontext_cursor
= nontext_cursor
;
1810 if (mode_cursor
!= f
->output_data
.w32
->modeline_cursor
1811 && f
->output_data
.w32
->modeline_cursor
!= 0)
1812 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->modeline_cursor
);
1813 f
->output_data
.w32
->modeline_cursor
= mode_cursor
;
1814 if (cross_cursor
!= f
->output_data
.w32
->cross_cursor
1815 && f
->output_data
.w32
->cross_cursor
!= 0)
1816 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->cross_cursor
);
1817 f
->output_data
.w32
->cross_cursor
= cross_cursor
;
1819 XFlush (FRAME_W32_DISPLAY (f
));
1825 x_set_cursor_color (f
, arg
, oldval
)
1827 Lisp_Object arg
, oldval
;
1829 unsigned long fore_pixel
;
1831 if (!EQ (Vx_cursor_fore_pixel
, Qnil
))
1832 fore_pixel
= x_decode_color (f
, Vx_cursor_fore_pixel
,
1833 WHITE_PIX_DEFAULT (f
));
1835 fore_pixel
= f
->output_data
.w32
->background_pixel
;
1836 f
->output_data
.w32
->cursor_pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1838 /* Make sure that the cursor color differs from the background color. */
1839 if (f
->output_data
.w32
->cursor_pixel
== f
->output_data
.w32
->background_pixel
)
1841 f
->output_data
.w32
->cursor_pixel
= f
->output_data
.w32
->mouse_pixel
;
1842 if (f
->output_data
.w32
->cursor_pixel
== fore_pixel
)
1843 fore_pixel
= f
->output_data
.w32
->background_pixel
;
1845 f
->output_data
.w32
->cursor_foreground_pixel
= fore_pixel
;
1847 if (FRAME_W32_WINDOW (f
) != 0)
1849 if (FRAME_VISIBLE_P (f
))
1851 x_display_cursor (f
, 0);
1852 x_display_cursor (f
, 1);
1857 /* Set the border-color of frame F to value described by ARG.
1858 ARG can be a string naming a color.
1859 The border-color is used for the border that is drawn by the server.
1860 Note that this does not fully take effect if done before
1861 F has a window; it must be redone when the window is created. */
1864 x_set_border_color (f
, arg
, oldval
)
1866 Lisp_Object arg
, oldval
;
1871 CHECK_STRING (arg
, 0);
1872 str
= XSTRING (arg
)->data
;
1874 pix
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1876 x_set_border_pixel (f
, pix
);
1879 /* Set the border-color of frame F to pixel value PIX.
1880 Note that this does not fully take effect if done before
1883 x_set_border_pixel (f
, pix
)
1887 f
->output_data
.w32
->border_pixel
= pix
;
1889 if (FRAME_W32_WINDOW (f
) != 0 && f
->output_data
.w32
->border_width
> 0)
1891 if (FRAME_VISIBLE_P (f
))
1897 x_set_cursor_type (f
, arg
, oldval
)
1899 Lisp_Object arg
, oldval
;
1903 FRAME_DESIRED_CURSOR (f
) = bar_cursor
;
1904 f
->output_data
.w32
->cursor_width
= 2;
1906 else if (CONSP (arg
) && EQ (XCONS (arg
)->car
, Qbar
)
1907 && INTEGERP (XCONS (arg
)->cdr
))
1909 FRAME_DESIRED_CURSOR (f
) = bar_cursor
;
1910 f
->output_data
.w32
->cursor_width
= XINT (XCONS (arg
)->cdr
);
1913 /* Treat anything unknown as "box cursor".
1914 It was bad to signal an error; people have trouble fixing
1915 .Xdefaults with Emacs, when it has something bad in it. */
1916 FRAME_DESIRED_CURSOR (f
) = filled_box_cursor
;
1918 /* Make sure the cursor gets redrawn. This is overkill, but how
1919 often do people change cursor types? */
1920 update_mode_lines
++;
1924 x_set_icon_type (f
, arg
, oldval
)
1926 Lisp_Object arg
, oldval
;
1934 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1937 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1942 result
= x_text_icon (f
,
1943 (char *) XSTRING ((!NILP (f
->icon_name
)
1947 result
= x_bitmap_icon (f
, arg
);
1952 error ("No icon window available");
1955 /* If the window was unmapped (and its icon was mapped),
1956 the new icon is not mapped, so map the window in its stead. */
1957 if (FRAME_VISIBLE_P (f
))
1959 #ifdef USE_X_TOOLKIT
1960 XtPopup (f
->output_data
.w32
->widget
, XtGrabNone
);
1962 XMapWindow (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
));
1965 XFlush (FRAME_W32_DISPLAY (f
));
1970 /* Return non-nil if frame F wants a bitmap icon. */
1978 tem
= assq_no_quit (Qicon_type
, f
->param_alist
);
1980 return XCONS (tem
)->cdr
;
1986 x_set_icon_name (f
, arg
, oldval
)
1988 Lisp_Object arg
, oldval
;
1995 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1998 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
2004 if (f
->output_data
.w32
->icon_bitmap
!= 0)
2009 result
= x_text_icon (f
,
2010 (char *) XSTRING ((!NILP (f
->icon_name
)
2019 error ("No icon window available");
2022 /* If the window was unmapped (and its icon was mapped),
2023 the new icon is not mapped, so map the window in its stead. */
2024 if (FRAME_VISIBLE_P (f
))
2026 #ifdef USE_X_TOOLKIT
2027 XtPopup (f
->output_data
.w32
->widget
, XtGrabNone
);
2029 XMapWindow (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
));
2032 XFlush (FRAME_W32_DISPLAY (f
));
2037 extern Lisp_Object
x_new_font ();
2040 x_set_font (f
, arg
, oldval
)
2042 Lisp_Object arg
, oldval
;
2046 CHECK_STRING (arg
, 1);
2049 result
= x_new_font (f
, XSTRING (arg
)->data
);
2052 if (EQ (result
, Qnil
))
2053 error ("Font \"%s\" is not defined", XSTRING (arg
)->data
);
2054 else if (EQ (result
, Qt
))
2055 error ("the characters of the given font have varying widths");
2056 else if (STRINGP (result
))
2058 recompute_basic_faces (f
);
2059 store_frame_param (f
, Qfont
, result
);
2066 x_set_border_width (f
, arg
, oldval
)
2068 Lisp_Object arg
, oldval
;
2070 CHECK_NUMBER (arg
, 0);
2072 if (XINT (arg
) == f
->output_data
.w32
->border_width
)
2075 if (FRAME_W32_WINDOW (f
) != 0)
2076 error ("Cannot change the border width of a window");
2078 f
->output_data
.w32
->border_width
= XINT (arg
);
2082 x_set_internal_border_width (f
, arg
, oldval
)
2084 Lisp_Object arg
, oldval
;
2087 int old
= f
->output_data
.w32
->internal_border_width
;
2089 CHECK_NUMBER (arg
, 0);
2090 f
->output_data
.w32
->internal_border_width
= XINT (arg
);
2091 if (f
->output_data
.w32
->internal_border_width
< 0)
2092 f
->output_data
.w32
->internal_border_width
= 0;
2094 if (f
->output_data
.w32
->internal_border_width
== old
)
2097 if (FRAME_W32_WINDOW (f
) != 0)
2100 x_set_window_size (f
, 0, f
->width
, f
->height
);
2102 SET_FRAME_GARBAGED (f
);
2107 x_set_visibility (f
, value
, oldval
)
2109 Lisp_Object value
, oldval
;
2112 XSETFRAME (frame
, f
);
2115 Fmake_frame_invisible (frame
, Qt
);
2116 else if (EQ (value
, Qicon
))
2117 Ficonify_frame (frame
);
2119 Fmake_frame_visible (frame
);
2123 x_set_menu_bar_lines (f
, value
, oldval
)
2125 Lisp_Object value
, oldval
;
2128 int olines
= FRAME_MENU_BAR_LINES (f
);
2130 /* Right now, menu bars don't work properly in minibuf-only frames;
2131 most of the commands try to apply themselves to the minibuffer
2132 frame itslef, and get an error because you can't switch buffers
2133 in or split the minibuffer window. */
2134 if (FRAME_MINIBUF_ONLY_P (f
))
2137 if (INTEGERP (value
))
2138 nlines
= XINT (value
);
2142 FRAME_MENU_BAR_LINES (f
) = 0;
2144 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
2147 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
2148 free_frame_menubar (f
);
2149 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
2151 /* Adjust the frame size so that the client (text) dimensions
2152 remain the same. This depends on FRAME_EXTERNAL_MENU_BAR being
2154 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2158 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
2161 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2162 name; if NAME is a string, set F's name to NAME and set
2163 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2165 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2166 suggesting a new name, which lisp code should override; if
2167 F->explicit_name is set, ignore the new name; otherwise, set it. */
2170 x_set_name (f
, name
, explicit)
2175 /* Make sure that requests from lisp code override requests from
2176 Emacs redisplay code. */
2179 /* If we're switching from explicit to implicit, we had better
2180 update the mode lines and thereby update the title. */
2181 if (f
->explicit_name
&& NILP (name
))
2182 update_mode_lines
= 1;
2184 f
->explicit_name
= ! NILP (name
);
2186 else if (f
->explicit_name
)
2189 /* If NAME is nil, set the name to the w32_id_name. */
2192 /* Check for no change needed in this very common case
2193 before we do any consing. */
2194 if (!strcmp (FRAME_W32_DISPLAY_INFO (f
)->w32_id_name
,
2195 XSTRING (f
->name
)->data
))
2197 name
= build_string (FRAME_W32_DISPLAY_INFO (f
)->w32_id_name
);
2200 CHECK_STRING (name
, 0);
2202 /* Don't change the name if it's already NAME. */
2203 if (! NILP (Fstring_equal (name
, f
->name
)))
2208 /* For setting the frame title, the title parameter should override
2209 the name parameter. */
2210 if (! NILP (f
->title
))
2213 if (FRAME_W32_WINDOW (f
))
2216 SetWindowText(FRAME_W32_WINDOW (f
), XSTRING (name
)->data
);
2221 /* This function should be called when the user's lisp code has
2222 specified a name for the frame; the name will override any set by the
2225 x_explicitly_set_name (f
, arg
, oldval
)
2227 Lisp_Object arg
, oldval
;
2229 x_set_name (f
, arg
, 1);
2232 /* This function should be called by Emacs redisplay code to set the
2233 name; names set this way will never override names set by the user's
2236 x_implicitly_set_name (f
, arg
, oldval
)
2238 Lisp_Object arg
, oldval
;
2240 x_set_name (f
, arg
, 0);
2243 /* Change the title of frame F to NAME.
2244 If NAME is nil, use the frame name as the title.
2246 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2247 name; if NAME is a string, set F's name to NAME and set
2248 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2250 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2251 suggesting a new name, which lisp code should override; if
2252 F->explicit_name is set, ignore the new name; otherwise, set it. */
2255 x_set_title (f
, name
)
2259 /* Don't change the title if it's already NAME. */
2260 if (EQ (name
, f
->title
))
2263 update_mode_lines
= 1;
2270 if (FRAME_W32_WINDOW (f
))
2273 SetWindowText(FRAME_W32_WINDOW (f
), XSTRING (name
)->data
);
2279 x_set_autoraise (f
, arg
, oldval
)
2281 Lisp_Object arg
, oldval
;
2283 f
->auto_raise
= !EQ (Qnil
, arg
);
2287 x_set_autolower (f
, arg
, oldval
)
2289 Lisp_Object arg
, oldval
;
2291 f
->auto_lower
= !EQ (Qnil
, arg
);
2295 x_set_unsplittable (f
, arg
, oldval
)
2297 Lisp_Object arg
, oldval
;
2299 f
->no_split
= !NILP (arg
);
2303 x_set_vertical_scroll_bars (f
, arg
, oldval
)
2305 Lisp_Object arg
, oldval
;
2307 if ((EQ (arg
, Qleft
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f
))
2308 || (EQ (arg
, Qright
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f
))
2309 || (NILP (arg
) && FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
2310 || (!NILP (arg
) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
)))
2312 FRAME_VERTICAL_SCROLL_BAR_TYPE (f
) = NILP (arg
) ?
2313 vertical_scroll_bar_none
:
2315 ? vertical_scroll_bar_right
2316 : vertical_scroll_bar_left
;
2318 /* We set this parameter before creating the window for the
2319 frame, so we can get the geometry right from the start.
2320 However, if the window hasn't been created yet, we shouldn't
2321 call x_set_window_size. */
2322 if (FRAME_W32_WINDOW (f
))
2323 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2328 x_set_scroll_bar_width (f
, arg
, oldval
)
2330 Lisp_Object arg
, oldval
;
2334 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = 0;
2335 FRAME_SCROLL_BAR_COLS (f
) = 2;
2337 else if (INTEGERP (arg
) && XINT (arg
) > 0
2338 && XFASTINT (arg
) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f
))
2340 int wid
= FONT_WIDTH (f
->output_data
.w32
->font
);
2341 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = XFASTINT (arg
);
2342 FRAME_SCROLL_BAR_COLS (f
) = (XFASTINT (arg
) + wid
-1) / wid
;
2343 if (FRAME_W32_WINDOW (f
))
2344 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2348 /* Subroutines of creating an frame. */
2350 /* Make sure that Vx_resource_name is set to a reasonable value.
2351 Fix it up, or set it to `emacs' if it is too hopeless. */
2354 validate_x_resource_name ()
2357 /* Number of valid characters in the resource name. */
2359 /* Number of invalid characters in the resource name. */
2364 if (STRINGP (Vx_resource_name
))
2366 unsigned char *p
= XSTRING (Vx_resource_name
)->data
;
2369 len
= XSTRING (Vx_resource_name
)->size
;
2371 /* Only letters, digits, - and _ are valid in resource names.
2372 Count the valid characters and count the invalid ones. */
2373 for (i
= 0; i
< len
; i
++)
2376 if (! ((c
>= 'a' && c
<= 'z')
2377 || (c
>= 'A' && c
<= 'Z')
2378 || (c
>= '0' && c
<= '9')
2379 || c
== '-' || c
== '_'))
2386 /* Not a string => completely invalid. */
2387 bad_count
= 5, good_count
= 0;
2389 /* If name is valid already, return. */
2393 /* If name is entirely invalid, or nearly so, use `emacs'. */
2395 || (good_count
== 1 && bad_count
> 0))
2397 Vx_resource_name
= build_string ("emacs");
2401 /* Name is partly valid. Copy it and replace the invalid characters
2402 with underscores. */
2404 Vx_resource_name
= new = Fcopy_sequence (Vx_resource_name
);
2406 for (i
= 0; i
< len
; i
++)
2408 int c
= XSTRING (new)->data
[i
];
2409 if (! ((c
>= 'a' && c
<= 'z')
2410 || (c
>= 'A' && c
<= 'Z')
2411 || (c
>= '0' && c
<= '9')
2412 || c
== '-' || c
== '_'))
2413 XSTRING (new)->data
[i
] = '_';
2418 extern char *x_get_string_resource ();
2420 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
2421 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
2422 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
2423 class, where INSTANCE is the name under which Emacs was invoked, or\n\
2424 the name specified by the `-name' or `-rn' command-line arguments.\n\
2426 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
2427 class, respectively. You must specify both of them or neither.\n\
2428 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
2429 and the class is `Emacs.CLASS.SUBCLASS'.")
2430 (attribute
, class, component
, subclass
)
2431 Lisp_Object attribute
, class, component
, subclass
;
2433 register char *value
;
2437 CHECK_STRING (attribute
, 0);
2438 CHECK_STRING (class, 0);
2440 if (!NILP (component
))
2441 CHECK_STRING (component
, 1);
2442 if (!NILP (subclass
))
2443 CHECK_STRING (subclass
, 2);
2444 if (NILP (component
) != NILP (subclass
))
2445 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2447 validate_x_resource_name ();
2449 /* Allocate space for the components, the dots which separate them,
2450 and the final '\0'. Make them big enough for the worst case. */
2451 name_key
= (char *) alloca (XSTRING (Vx_resource_name
)->size
2452 + (STRINGP (component
)
2453 ? XSTRING (component
)->size
: 0)
2454 + XSTRING (attribute
)->size
2457 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
2458 + XSTRING (class)->size
2459 + (STRINGP (subclass
)
2460 ? XSTRING (subclass
)->size
: 0)
2463 /* Start with emacs.FRAMENAME for the name (the specific one)
2464 and with `Emacs' for the class key (the general one). */
2465 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2466 strcpy (class_key
, EMACS_CLASS
);
2468 strcat (class_key
, ".");
2469 strcat (class_key
, XSTRING (class)->data
);
2471 if (!NILP (component
))
2473 strcat (class_key
, ".");
2474 strcat (class_key
, XSTRING (subclass
)->data
);
2476 strcat (name_key
, ".");
2477 strcat (name_key
, XSTRING (component
)->data
);
2480 strcat (name_key
, ".");
2481 strcat (name_key
, XSTRING (attribute
)->data
);
2483 value
= x_get_string_resource (Qnil
,
2484 name_key
, class_key
);
2486 if (value
!= (char *) 0)
2487 return build_string (value
);
2492 /* Used when C code wants a resource value. */
2495 x_get_resource_string (attribute
, class)
2496 char *attribute
, *class;
2498 register char *value
;
2502 /* Allocate space for the components, the dots which separate them,
2503 and the final '\0'. */
2504 name_key
= (char *) alloca (XSTRING (Vinvocation_name
)->size
2505 + strlen (attribute
) + 2);
2506 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
2507 + strlen (class) + 2);
2509 sprintf (name_key
, "%s.%s",
2510 XSTRING (Vinvocation_name
)->data
,
2512 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
2514 return x_get_string_resource (selected_frame
,
2515 name_key
, class_key
);
2518 /* Types we might convert a resource string into. */
2521 number
, boolean
, string
, symbol
2524 /* Return the value of parameter PARAM.
2526 First search ALIST, then Vdefault_frame_alist, then the X defaults
2527 database, using ATTRIBUTE as the attribute name and CLASS as its class.
2529 Convert the resource to the type specified by desired_type.
2531 If no default is specified, return Qunbound. If you call
2532 x_get_arg, make sure you deal with Qunbound in a reasonable way,
2533 and don't let it get stored in any Lisp-visible variables! */
2536 x_get_arg (alist
, param
, attribute
, class, type
)
2537 Lisp_Object alist
, param
;
2540 enum resource_types type
;
2542 register Lisp_Object tem
;
2544 tem
= Fassq (param
, alist
);
2546 tem
= Fassq (param
, Vdefault_frame_alist
);
2552 tem
= Fx_get_resource (build_string (attribute
),
2553 build_string (class),
2562 return make_number (atoi (XSTRING (tem
)->data
));
2565 tem
= Fdowncase (tem
);
2566 if (!strcmp (XSTRING (tem
)->data
, "on")
2567 || !strcmp (XSTRING (tem
)->data
, "true"))
2576 /* As a special case, we map the values `true' and `on'
2577 to Qt, and `false' and `off' to Qnil. */
2580 lower
= Fdowncase (tem
);
2581 if (!strcmp (XSTRING (lower
)->data
, "on")
2582 || !strcmp (XSTRING (lower
)->data
, "true"))
2584 else if (!strcmp (XSTRING (lower
)->data
, "off")
2585 || !strcmp (XSTRING (lower
)->data
, "false"))
2588 return Fintern (tem
, Qnil
);
2601 /* Record in frame F the specified or default value according to ALIST
2602 of the parameter named PARAM (a Lisp symbol).
2603 If no value is specified for PARAM, look for an X default for XPROP
2604 on the frame named NAME.
2605 If that is not found either, use the value DEFLT. */
2608 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
2615 enum resource_types type
;
2619 tem
= x_get_arg (alist
, prop
, xprop
, xclass
, type
);
2620 if (EQ (tem
, Qunbound
))
2622 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2626 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
2627 "Parse an X-style geometry string STRING.\n\
2628 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
2629 The properties returned may include `top', `left', `height', and `width'.\n\
2630 The value of `left' or `top' may be an integer,\n\
2631 or a list (+ N) meaning N pixels relative to top/left corner,\n\
2632 or a list (- N) meaning -N pixels relative to bottom/right corner.")
2637 unsigned int width
, height
;
2640 CHECK_STRING (string
, 0);
2642 geometry
= XParseGeometry ((char *) XSTRING (string
)->data
,
2643 &x
, &y
, &width
, &height
);
2646 if (geometry
& XValue
)
2648 Lisp_Object element
;
2650 if (x
>= 0 && (geometry
& XNegative
))
2651 element
= Fcons (Qleft
, Fcons (Qminus
, Fcons (make_number (-x
), Qnil
)));
2652 else if (x
< 0 && ! (geometry
& XNegative
))
2653 element
= Fcons (Qleft
, Fcons (Qplus
, Fcons (make_number (x
), Qnil
)));
2655 element
= Fcons (Qleft
, make_number (x
));
2656 result
= Fcons (element
, result
);
2659 if (geometry
& YValue
)
2661 Lisp_Object element
;
2663 if (y
>= 0 && (geometry
& YNegative
))
2664 element
= Fcons (Qtop
, Fcons (Qminus
, Fcons (make_number (-y
), Qnil
)));
2665 else if (y
< 0 && ! (geometry
& YNegative
))
2666 element
= Fcons (Qtop
, Fcons (Qplus
, Fcons (make_number (y
), Qnil
)));
2668 element
= Fcons (Qtop
, make_number (y
));
2669 result
= Fcons (element
, result
);
2672 if (geometry
& WidthValue
)
2673 result
= Fcons (Fcons (Qwidth
, make_number (width
)), result
);
2674 if (geometry
& HeightValue
)
2675 result
= Fcons (Fcons (Qheight
, make_number (height
)), result
);
2680 /* Calculate the desired size and position of this window,
2681 and return the flags saying which aspects were specified.
2683 This function does not make the coordinates positive. */
2685 #define DEFAULT_ROWS 40
2686 #define DEFAULT_COLS 80
2689 x_figure_window_size (f
, parms
)
2693 register Lisp_Object tem0
, tem1
, tem2
;
2694 int height
, width
, left
, top
;
2695 register int geometry
;
2696 long window_prompting
= 0;
2698 /* Default values if we fall through.
2699 Actually, if that happens we should get
2700 window manager prompting. */
2701 SET_FRAME_WIDTH (f
, DEFAULT_COLS
);
2702 f
->height
= DEFAULT_ROWS
;
2703 /* Window managers expect that if program-specified
2704 positions are not (0,0), they're intentional, not defaults. */
2705 f
->output_data
.w32
->top_pos
= 0;
2706 f
->output_data
.w32
->left_pos
= 0;
2708 tem0
= x_get_arg (parms
, Qheight
, 0, 0, number
);
2709 tem1
= x_get_arg (parms
, Qwidth
, 0, 0, number
);
2710 tem2
= x_get_arg (parms
, Quser_size
, 0, 0, number
);
2711 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
2713 if (!EQ (tem0
, Qunbound
))
2715 CHECK_NUMBER (tem0
, 0);
2716 f
->height
= XINT (tem0
);
2718 if (!EQ (tem1
, Qunbound
))
2720 CHECK_NUMBER (tem1
, 0);
2721 SET_FRAME_WIDTH (f
, XINT (tem1
));
2723 if (!NILP (tem2
) && !EQ (tem2
, Qunbound
))
2724 window_prompting
|= USSize
;
2726 window_prompting
|= PSize
;
2729 f
->output_data
.w32
->vertical_scroll_bar_extra
2730 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
2732 : FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) > 0
2733 ? FRAME_SCROLL_BAR_PIXEL_WIDTH (f
)
2734 : (FRAME_SCROLL_BAR_COLS (f
) * FONT_WIDTH (f
->output_data
.w32
->font
)));
2735 f
->output_data
.w32
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
2736 f
->output_data
.w32
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
2738 tem0
= x_get_arg (parms
, Qtop
, 0, 0, number
);
2739 tem1
= x_get_arg (parms
, Qleft
, 0, 0, number
);
2740 tem2
= x_get_arg (parms
, Quser_position
, 0, 0, number
);
2741 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
2743 if (EQ (tem0
, Qminus
))
2745 f
->output_data
.w32
->top_pos
= 0;
2746 window_prompting
|= YNegative
;
2748 else if (CONSP (tem0
) && EQ (XCONS (tem0
)->car
, Qminus
)
2749 && CONSP (XCONS (tem0
)->cdr
)
2750 && INTEGERP (XCONS (XCONS (tem0
)->cdr
)->car
))
2752 f
->output_data
.w32
->top_pos
= - XINT (XCONS (XCONS (tem0
)->cdr
)->car
);
2753 window_prompting
|= YNegative
;
2755 else if (CONSP (tem0
) && EQ (XCONS (tem0
)->car
, Qplus
)
2756 && CONSP (XCONS (tem0
)->cdr
)
2757 && INTEGERP (XCONS (XCONS (tem0
)->cdr
)->car
))
2759 f
->output_data
.w32
->top_pos
= XINT (XCONS (XCONS (tem0
)->cdr
)->car
);
2761 else if (EQ (tem0
, Qunbound
))
2762 f
->output_data
.w32
->top_pos
= 0;
2765 CHECK_NUMBER (tem0
, 0);
2766 f
->output_data
.w32
->top_pos
= XINT (tem0
);
2767 if (f
->output_data
.w32
->top_pos
< 0)
2768 window_prompting
|= YNegative
;
2771 if (EQ (tem1
, Qminus
))
2773 f
->output_data
.w32
->left_pos
= 0;
2774 window_prompting
|= XNegative
;
2776 else if (CONSP (tem1
) && EQ (XCONS (tem1
)->car
, Qminus
)
2777 && CONSP (XCONS (tem1
)->cdr
)
2778 && INTEGERP (XCONS (XCONS (tem1
)->cdr
)->car
))
2780 f
->output_data
.w32
->left_pos
= - XINT (XCONS (XCONS (tem1
)->cdr
)->car
);
2781 window_prompting
|= XNegative
;
2783 else if (CONSP (tem1
) && EQ (XCONS (tem1
)->car
, Qplus
)
2784 && CONSP (XCONS (tem1
)->cdr
)
2785 && INTEGERP (XCONS (XCONS (tem1
)->cdr
)->car
))
2787 f
->output_data
.w32
->left_pos
= XINT (XCONS (XCONS (tem1
)->cdr
)->car
);
2789 else if (EQ (tem1
, Qunbound
))
2790 f
->output_data
.w32
->left_pos
= 0;
2793 CHECK_NUMBER (tem1
, 0);
2794 f
->output_data
.w32
->left_pos
= XINT (tem1
);
2795 if (f
->output_data
.w32
->left_pos
< 0)
2796 window_prompting
|= XNegative
;
2799 if (!NILP (tem2
) && ! EQ (tem2
, Qunbound
))
2800 window_prompting
|= USPosition
;
2802 window_prompting
|= PPosition
;
2805 return window_prompting
;
2810 extern LRESULT CALLBACK
w32_wnd_proc ();
2813 w32_init_class (hinst
)
2818 wc
.style
= CS_HREDRAW
| CS_VREDRAW
;
2819 wc
.lpfnWndProc
= (WNDPROC
) w32_wnd_proc
;
2821 wc
.cbWndExtra
= WND_EXTRA_BYTES
;
2822 wc
.hInstance
= hinst
;
2823 wc
.hIcon
= LoadIcon (hinst
, EMACS_CLASS
);
2824 wc
.hCursor
= LoadCursor (NULL
, IDC_ARROW
);
2825 wc
.hbrBackground
= NULL
; // GetStockObject (WHITE_BRUSH);
2826 wc
.lpszMenuName
= NULL
;
2827 wc
.lpszClassName
= EMACS_CLASS
;
2829 return (RegisterClass (&wc
));
2833 w32_createscrollbar (f
, bar
)
2835 struct scroll_bar
* bar
;
2837 return (CreateWindow ("SCROLLBAR", "", SBS_VERT
| WS_CHILD
| WS_VISIBLE
,
2838 /* Position and size of scroll bar. */
2839 XINT(bar
->left
), XINT(bar
->top
),
2840 XINT(bar
->width
), XINT(bar
->height
),
2841 FRAME_W32_WINDOW (f
),
2848 w32_createwindow (f
)
2854 rect
.left
= rect
.top
= 0;
2855 rect
.right
= PIXEL_WIDTH (f
);
2856 rect
.bottom
= PIXEL_HEIGHT (f
);
2858 AdjustWindowRect (&rect
, f
->output_data
.w32
->dwStyle
,
2859 FRAME_EXTERNAL_MENU_BAR (f
));
2861 /* Do first time app init */
2865 w32_init_class (hinst
);
2868 FRAME_W32_WINDOW (f
) = hwnd
2869 = CreateWindow (EMACS_CLASS
,
2871 f
->output_data
.w32
->dwStyle
| WS_CLIPCHILDREN
,
2872 f
->output_data
.w32
->left_pos
,
2873 f
->output_data
.w32
->top_pos
,
2874 rect
.right
- rect
.left
,
2875 rect
.bottom
- rect
.top
,
2883 SetWindowLong (hwnd
, WND_FONTWIDTH_INDEX
, FONT_WIDTH (f
->output_data
.w32
->font
));
2884 SetWindowLong (hwnd
, WND_LINEHEIGHT_INDEX
, f
->output_data
.w32
->line_height
);
2885 SetWindowLong (hwnd
, WND_BORDER_INDEX
, f
->output_data
.w32
->internal_border_width
);
2886 SetWindowLong (hwnd
, WND_SCROLLBAR_INDEX
, f
->output_data
.w32
->vertical_scroll_bar_extra
);
2887 SetWindowLong (hwnd
, WND_BACKGROUND_INDEX
, f
->output_data
.w32
->background_pixel
);
2889 /* Do this to discard the default setting specified by our parent. */
2890 ShowWindow (hwnd
, SW_HIDE
);
2894 /* Convert between the modifier bits W32 uses and the modifier bits
2897 w32_get_modifiers ()
2899 return (((GetKeyState (VK_SHIFT
)&0x8000) ? shift_modifier
: 0) |
2900 ((GetKeyState (VK_CONTROL
)&0x8000) ? ctrl_modifier
: 0) |
2901 ((GetKeyState (VK_MENU
)&0x8000) ?
2902 ((NILP (Vw32_alt_is_meta
)) ? alt_modifier
: meta_modifier
) : 0));
2906 my_post_msg (wmsg
, hwnd
, msg
, wParam
, lParam
)
2913 wmsg
->msg
.hwnd
= hwnd
;
2914 wmsg
->msg
.message
= msg
;
2915 wmsg
->msg
.wParam
= wParam
;
2916 wmsg
->msg
.lParam
= lParam
;
2917 wmsg
->msg
.time
= GetMessageTime ();
2922 /* GetKeyState and MapVirtualKey on Windows 95 do not actually distinguish
2923 between left and right keys as advertised. We test for this
2924 support dynamically, and set a flag when the support is absent. If
2925 absent, we keep track of the left and right control and alt keys
2926 ourselves. This is particularly necessary on keyboards that rely
2927 upon the AltGr key, which is represented as having the left control
2928 and right alt keys pressed. For these keyboards, we need to know
2929 when the left alt key has been pressed in addition to the AltGr key
2930 so that we can properly support M-AltGr-key sequences (such as M-@
2931 on Swedish keyboards). */
2933 #define EMACS_LCONTROL 0
2934 #define EMACS_RCONTROL 1
2935 #define EMACS_LMENU 2
2936 #define EMACS_RMENU 3
2938 static int modifiers
[4];
2939 static int modifiers_recorded
;
2940 static int modifier_key_support_tested
;
2943 test_modifier_support (unsigned int wparam
)
2947 if (wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
)
2949 if (wparam
== VK_CONTROL
)
2959 if (!(GetKeyState (l
) & 0x8000) && !(GetKeyState (r
) & 0x8000))
2960 modifiers_recorded
= 1;
2962 modifiers_recorded
= 0;
2963 modifier_key_support_tested
= 1;
2967 record_keydown (unsigned int wparam
, unsigned int lparam
)
2971 if (!modifier_key_support_tested
)
2972 test_modifier_support (wparam
);
2974 if ((wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
) || !modifiers_recorded
)
2977 if (wparam
== VK_CONTROL
)
2978 i
= (lparam
& 0x1000000) ? EMACS_RCONTROL
: EMACS_LCONTROL
;
2980 i
= (lparam
& 0x1000000) ? EMACS_RMENU
: EMACS_LMENU
;
2986 record_keyup (unsigned int wparam
, unsigned int lparam
)
2990 if ((wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
) || !modifiers_recorded
)
2993 if (wparam
== VK_CONTROL
)
2994 i
= (lparam
& 0x1000000) ? EMACS_RCONTROL
: EMACS_LCONTROL
;
2996 i
= (lparam
& 0x1000000) ? EMACS_RMENU
: EMACS_LMENU
;
3001 /* Emacs can lose focus while a modifier key has been pressed. When
3002 it regains focus, be conservative and clear all modifiers since
3003 we cannot reconstruct the left and right modifier state. */
3009 if (!modifiers_recorded
)
3012 ctrl
= GetAsyncKeyState (VK_CONTROL
);
3013 alt
= GetAsyncKeyState (VK_MENU
);
3015 if (ctrl
== 0 || alt
== 0)
3016 /* Emacs doesn't have keyboard focus. Do nothing. */
3019 if (!(ctrl
& 0x08000))
3020 /* Clear any recorded control modifier state. */
3021 modifiers
[EMACS_RCONTROL
] = modifiers
[EMACS_LCONTROL
] = 0;
3023 if (!(alt
& 0x08000))
3024 /* Clear any recorded alt modifier state. */
3025 modifiers
[EMACS_RMENU
] = modifiers
[EMACS_LMENU
] = 0;
3027 /* Otherwise, leave the modifier state as it was when Emacs lost
3031 /* Synchronize modifier state with what is reported with the current
3032 keystroke. Even if we cannot distinguish between left and right
3033 modifier keys, we know that, if no modifiers are set, then neither
3034 the left or right modifier should be set. */
3038 if (!modifiers_recorded
)
3041 if (!(GetKeyState (VK_CONTROL
) & 0x8000))
3042 modifiers
[EMACS_RCONTROL
] = modifiers
[EMACS_LCONTROL
] = 0;
3044 if (!(GetKeyState (VK_MENU
) & 0x8000))
3045 modifiers
[EMACS_RMENU
] = modifiers
[EMACS_LMENU
] = 0;
3049 modifier_set (int vkey
)
3051 if (vkey
== VK_CAPITAL
)
3052 return (GetKeyState (vkey
) & 0x1);
3053 if (!modifiers_recorded
)
3054 return (GetKeyState (vkey
) & 0x8000);
3059 return modifiers
[EMACS_LCONTROL
];
3061 return modifiers
[EMACS_RCONTROL
];
3063 return modifiers
[EMACS_LMENU
];
3065 return modifiers
[EMACS_RMENU
];
3069 return (GetKeyState (vkey
) & 0x8000);
3072 /* We map the VK_* modifiers into console modifier constants
3073 so that we can use the same routines to handle both console
3074 and window input. */
3077 construct_modifiers (unsigned int wparam
, unsigned int lparam
)
3081 if (wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
)
3082 mods
= GetLastError ();
3085 mods
|= (modifier_set (VK_SHIFT
)) ? SHIFT_PRESSED
: 0;
3086 mods
|= (modifier_set (VK_CAPITAL
)) ? CAPSLOCK_ON
: 0;
3087 mods
|= (modifier_set (VK_LCONTROL
)) ? LEFT_CTRL_PRESSED
: 0;
3088 mods
|= (modifier_set (VK_RCONTROL
)) ? RIGHT_CTRL_PRESSED
: 0;
3089 mods
|= (modifier_set (VK_LMENU
)) ? LEFT_ALT_PRESSED
: 0;
3090 mods
|= (modifier_set (VK_RMENU
)) ? RIGHT_ALT_PRESSED
: 0;
3096 map_keypad_keys (unsigned int wparam
, unsigned int lparam
)
3098 unsigned int extended
= (lparam
& 0x1000000L
);
3100 if (wparam
< VK_CLEAR
|| wparam
> VK_DELETE
)
3103 if (wparam
== VK_RETURN
)
3104 return (extended
? VK_NUMPAD_ENTER
: VK_RETURN
);
3106 if (wparam
>= VK_PRIOR
&& wparam
<= VK_DOWN
)
3107 return (!extended
? (VK_NUMPAD_PRIOR
+ (wparam
- VK_PRIOR
)) : wparam
);
3109 if (wparam
== VK_INSERT
|| wparam
== VK_DELETE
)
3110 return (!extended
? (VK_NUMPAD_INSERT
+ (wparam
- VK_INSERT
)) : wparam
);
3112 if (wparam
== VK_CLEAR
)
3113 return (!extended
? VK_NUMPAD_CLEAR
: wparam
);
3118 /* Main message dispatch loop. */
3121 w32_msg_pump (deferred_msg
* msg_buf
)
3125 while (GetMessage (&msg
, NULL
, 0, 0))
3127 if (msg
.hwnd
== NULL
)
3129 switch (msg
.message
)
3131 case WM_EMACS_CREATEWINDOW
:
3132 w32_createwindow ((struct frame
*) msg
.wParam
);
3133 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
, 0, 0))
3137 /* No need to be so draconian! */
3139 DebPrint (("msg %x not expected by w32_msg_pump\n", msg
.message
));
3144 DispatchMessage (&msg
);
3147 /* Exit nested loop when our deferred message has completed. */
3148 if (msg_buf
->completed
)
3153 deferred_msg
* deferred_msg_head
;
3155 static deferred_msg
*
3156 find_deferred_msg (HWND hwnd
, UINT msg
)
3158 deferred_msg
* item
;
3160 /* Don't actually need synchronization for read access, since
3161 modification of single pointer is always atomic. */
3162 /* enter_crit (); */
3164 for (item
= deferred_msg_head
; item
!= NULL
; item
= item
->next
)
3165 if (item
->w32msg
.msg
.hwnd
== hwnd
3166 && item
->w32msg
.msg
.message
== msg
)
3169 /* leave_crit (); */
3175 send_deferred_msg (deferred_msg
* msg_buf
,
3181 /* Only input thread can send deferred messages. */
3182 if (GetCurrentThreadId () != dwWindowsThreadId
)
3185 /* It is an error to send a message that is already deferred. */
3186 if (find_deferred_msg (hwnd
, msg
) != NULL
)
3189 /* Enforced synchronization is not needed because this is the only
3190 function that alters deferred_msg_head, and the following critical
3191 section is guaranteed to only be serially reentered (since only the
3192 input thread can call us). */
3194 /* enter_crit (); */
3196 msg_buf
->completed
= 0;
3197 msg_buf
->next
= deferred_msg_head
;
3198 deferred_msg_head
= msg_buf
;
3199 my_post_msg (&msg_buf
->w32msg
, hwnd
, msg
, wParam
, lParam
);
3201 /* leave_crit (); */
3203 /* Start a new nested message loop to process other messages until
3204 this one is completed. */
3205 w32_msg_pump (msg_buf
);
3207 deferred_msg_head
= msg_buf
->next
;
3209 return msg_buf
->result
;
3213 complete_deferred_msg (HWND hwnd
, UINT msg
, LRESULT result
)
3215 deferred_msg
* msg_buf
= find_deferred_msg (hwnd
, msg
);
3217 if (msg_buf
== NULL
)
3220 msg_buf
->result
= result
;
3221 msg_buf
->completed
= 1;
3223 /* Ensure input thread is woken so it notices the completion. */
3224 PostThreadMessage (dwWindowsThreadId
, WM_NULL
, 0, 0);
3233 deferred_msg dummy_buf
;
3235 /* Ensure our message queue is created */
3237 PeekMessage (&msg
, NULL
, 0, 0, PM_NOREMOVE
);
3239 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
, 0, 0))
3242 memset (&dummy_buf
, 0, sizeof (dummy_buf
));
3243 dummy_buf
.w32msg
.msg
.hwnd
= NULL
;
3244 dummy_buf
.w32msg
.msg
.message
= WM_NULL
;
3246 /* This is the inital message loop which should only exit when the
3247 application quits. */
3248 w32_msg_pump (&dummy_buf
);
3253 /* Main window procedure */
3255 extern char *lispy_function_keys
[];
3258 w32_wnd_proc (hwnd
, msg
, wParam
, lParam
)
3265 struct w32_display_info
*dpyinfo
= &one_w32_display_info
;
3267 int windows_translate
;
3269 /* Note that it is okay to call x_window_to_frame, even though we are
3270 not running in the main lisp thread, because frame deletion
3271 requires the lisp thread to synchronize with this thread. Thus, if
3272 a frame struct is returned, it can be used without concern that the
3273 lisp thread might make it disappear while we are using it.
3275 NB. Walking the frame list in this thread is safe (as long as
3276 writes of Lisp_Object slots are atomic, which they are on Windows).
3277 Although delete-frame can destructively modify the frame list while
3278 we are walking it, a garbage collection cannot occur until after
3279 delete-frame has synchronized with this thread.
3281 It is also safe to use functions that make GDI calls, such as
3282 w32_clear_rect, because these functions must obtain a DC handle
3283 from the frame struct using get_frame_dc which is thread-aware. */
3288 f
= x_window_to_frame (dpyinfo
, hwnd
);
3291 GetUpdateRect (hwnd
, &wmsg
.rect
, FALSE
);
3292 w32_clear_rect (f
, NULL
, &wmsg
.rect
);
3295 case WM_PALETTECHANGED
:
3296 /* ignore our own changes */
3297 if ((HWND
)wParam
!= hwnd
)
3299 f
= x_window_to_frame (dpyinfo
, hwnd
);
3301 /* get_frame_dc will realize our palette and force all
3302 frames to be redrawn if needed. */
3303 release_frame_dc (f
, get_frame_dc (f
));
3308 PAINTSTRUCT paintStruct
;
3311 BeginPaint (hwnd
, &paintStruct
);
3312 wmsg
.rect
= paintStruct
.rcPaint
;
3313 EndPaint (hwnd
, &paintStruct
);
3316 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3323 record_keyup (wParam
, lParam
);
3328 /* Synchronize modifiers with current keystroke. */
3331 record_keydown (wParam
, lParam
);
3333 wParam
= map_keypad_keys (wParam
, lParam
);
3335 windows_translate
= 0;
3340 /* More support for these keys will likely be necessary. */
3341 if (!NILP (Vw32_pass_optional_keys_to_system
))
3342 windows_translate
= 1;
3345 if (NILP (Vw32_pass_alt_to_system
))
3347 windows_translate
= 1;
3354 windows_translate
= 1;
3357 /* If not defined as a function key, change it to a WM_CHAR message. */
3358 if (lispy_function_keys
[wParam
] == 0)
3363 if (windows_translate
)
3365 MSG windows_msg
= { hwnd
, msg
, wParam
, lParam
, 0, {0,0} };
3367 windows_msg
.time
= GetMessageTime ();
3368 TranslateMessage (&windows_msg
);
3376 wmsg
.dwModifiers
= construct_modifiers (wParam
, lParam
);
3379 /* Detect quit_char and set quit-flag directly. Note that we
3380 still need to post a message to ensure the main thread will be
3381 woken up if blocked in sys_select(), but we do NOT want to post
3382 the quit_char message itself (because it will usually be as if
3383 the user had typed quit_char twice). Instead, we post a dummy
3384 message that has no particular effect. */
3387 if (isalpha (c
) && (wmsg
.dwModifiers
== LEFT_CTRL_PRESSED
3388 || wmsg
.dwModifiers
== RIGHT_CTRL_PRESSED
))
3389 c
= make_ctrl_char (c
) & 0377;
3394 /* The choice of message is somewhat arbitrary, as long as
3395 the main thread handler just ignores it. */
3401 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3405 /* Simulate middle mouse button events when left and right buttons
3406 are used together, but only if user has two button mouse. */
3407 case WM_LBUTTONDOWN
:
3408 case WM_RBUTTONDOWN
:
3409 if (XINT (Vw32_num_mouse_buttons
) == 3)
3410 goto handle_plain_button
;
3413 int this = (msg
== WM_LBUTTONDOWN
) ? LMOUSE
: RMOUSE
;
3414 int other
= (msg
== WM_LBUTTONDOWN
) ? RMOUSE
: LMOUSE
;
3416 if (button_state
& this)
3419 if (button_state
== 0)
3422 button_state
|= this;
3424 if (button_state
& other
)
3426 if (mouse_button_timer
)
3428 KillTimer (hwnd
, mouse_button_timer
);
3429 mouse_button_timer
= 0;
3431 /* Generate middle mouse event instead. */
3432 msg
= WM_MBUTTONDOWN
;
3433 button_state
|= MMOUSE
;
3435 else if (button_state
& MMOUSE
)
3437 /* Ignore button event if we've already generated a
3438 middle mouse down event. This happens if the
3439 user releases and press one of the two buttons
3440 after we've faked a middle mouse event. */
3445 /* Flush out saved message. */
3446 post_msg (&saved_mouse_button_msg
);
3448 wmsg
.dwModifiers
= w32_get_modifiers ();
3449 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3451 /* Clear message buffer. */
3452 saved_mouse_button_msg
.msg
.hwnd
= 0;
3456 /* Hold onto message for now. */
3457 mouse_button_timer
=
3458 SetTimer (hwnd
, MOUSE_BUTTON_ID
, XINT (Vw32_mouse_button_tolerance
), NULL
);
3459 saved_mouse_button_msg
.msg
.hwnd
= hwnd
;
3460 saved_mouse_button_msg
.msg
.message
= msg
;
3461 saved_mouse_button_msg
.msg
.wParam
= wParam
;
3462 saved_mouse_button_msg
.msg
.lParam
= lParam
;
3463 saved_mouse_button_msg
.msg
.time
= GetMessageTime ();
3464 saved_mouse_button_msg
.dwModifiers
= w32_get_modifiers ();
3471 if (XINT (Vw32_num_mouse_buttons
) == 3)
3472 goto handle_plain_button
;
3475 int this = (msg
== WM_LBUTTONUP
) ? LMOUSE
: RMOUSE
;
3476 int other
= (msg
== WM_LBUTTONUP
) ? RMOUSE
: LMOUSE
;
3478 if ((button_state
& this) == 0)
3481 button_state
&= ~this;
3483 if (button_state
& MMOUSE
)
3485 /* Only generate event when second button is released. */
3486 if ((button_state
& other
) == 0)
3489 button_state
&= ~MMOUSE
;
3491 if (button_state
) abort ();
3498 /* Flush out saved message if necessary. */
3499 if (saved_mouse_button_msg
.msg
.hwnd
)
3501 post_msg (&saved_mouse_button_msg
);
3504 wmsg
.dwModifiers
= w32_get_modifiers ();
3505 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3507 /* Always clear message buffer and cancel timer. */
3508 saved_mouse_button_msg
.msg
.hwnd
= 0;
3509 KillTimer (hwnd
, mouse_button_timer
);
3510 mouse_button_timer
= 0;
3512 if (button_state
== 0)
3517 case WM_MBUTTONDOWN
:
3519 handle_plain_button
:
3524 if (parse_button (msg
, &button
, &up
))
3526 if (up
) ReleaseCapture ();
3527 else SetCapture (hwnd
);
3528 button
= (button
== 0) ? LMOUSE
:
3529 ((button
== 1) ? MMOUSE
: RMOUSE
);
3531 button_state
&= ~button
;
3533 button_state
|= button
;
3537 wmsg
.dwModifiers
= w32_get_modifiers ();
3538 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3543 if (XINT (Vw32_mouse_move_interval
) <= 0
3544 || (msg
== WM_MOUSEMOVE
&& button_state
== 0))
3546 wmsg
.dwModifiers
= w32_get_modifiers ();
3547 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3551 /* Hang onto mouse move and scroll messages for a bit, to avoid
3552 sending such events to Emacs faster than it can process them.
3553 If we get more events before the timer from the first message
3554 expires, we just replace the first message. */
3556 if (saved_mouse_move_msg
.msg
.hwnd
== 0)
3558 SetTimer (hwnd
, MOUSE_MOVE_ID
, XINT (Vw32_mouse_move_interval
), NULL
);
3560 /* Hold onto message for now. */
3561 saved_mouse_move_msg
.msg
.hwnd
= hwnd
;
3562 saved_mouse_move_msg
.msg
.message
= msg
;
3563 saved_mouse_move_msg
.msg
.wParam
= wParam
;
3564 saved_mouse_move_msg
.msg
.lParam
= lParam
;
3565 saved_mouse_move_msg
.msg
.time
= GetMessageTime ();
3566 saved_mouse_move_msg
.dwModifiers
= w32_get_modifiers ();
3571 wmsg
.dwModifiers
= w32_get_modifiers ();
3572 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3576 /* Flush out saved messages if necessary. */
3577 if (wParam
== mouse_button_timer
)
3579 if (saved_mouse_button_msg
.msg
.hwnd
)
3581 post_msg (&saved_mouse_button_msg
);
3582 saved_mouse_button_msg
.msg
.hwnd
= 0;
3584 KillTimer (hwnd
, mouse_button_timer
);
3585 mouse_button_timer
= 0;
3587 else if (wParam
== mouse_move_timer
)
3589 if (saved_mouse_move_msg
.msg
.hwnd
)
3591 post_msg (&saved_mouse_move_msg
);
3592 saved_mouse_move_msg
.msg
.hwnd
= 0;
3594 KillTimer (hwnd
, mouse_move_timer
);
3595 mouse_move_timer
= 0;
3600 /* Windows doesn't send us focus messages when putting up and
3601 taking down a system popup dialog as for Ctrl-Alt-Del on Windows 95.
3602 The only indication we get that something happened is receiving
3603 this message afterwards. So this is a good time to reset our
3604 keyboard modifiers' state. */
3609 /* We must ensure menu bar is fully constructed and up to date
3610 before allowing user interaction with it. To achieve this
3611 we send this message to the lisp thread and wait for a
3612 reply (whose value is not actually needed) to indicate that
3613 the menu bar is now ready for use, so we can now return.
3615 To remain responsive in the meantime, we enter a nested message
3616 loop that can process all other messages.
3618 However, we skip all this if the message results from calling
3619 TrackPopupMenu - in fact, we must NOT attempt to send the lisp
3620 thread a message because it is blocked on us at this point. We
3621 set menubar_active before calling TrackPopupMenu to indicate
3622 this (there is no possibility of confusion with real menubar
3625 f
= x_window_to_frame (dpyinfo
, hwnd
);
3627 && (f
->output_data
.w32
->menubar_active
3628 /* We can receive this message even in the absence of a
3629 menubar (ie. when the system menu is activated) - in this
3630 case we do NOT want to forward the message, otherwise it
3631 will cause the menubar to suddenly appear when the user
3632 had requested it to be turned off! */
3633 || f
->output_data
.w32
->menubar_widget
== NULL
))
3637 deferred_msg msg_buf
;
3639 /* Detect if message has already been deferred; in this case
3640 we cannot return any sensible value to ignore this. */
3641 if (find_deferred_msg (hwnd
, msg
) != NULL
)
3644 return send_deferred_msg (&msg_buf
, hwnd
, msg
, wParam
, lParam
);
3647 case WM_EXITMENULOOP
:
3648 f
= x_window_to_frame (dpyinfo
, hwnd
);
3650 /* Indicate that menubar can be modified again. */
3652 f
->output_data
.w32
->menubar_active
= 0;
3656 /* Still not right - can't distinguish between clicks in the
3657 client area of the frame from clicks forwarded from the scroll
3658 bars - may have to hook WM_NCHITTEST to remember the mouse
3659 position and then check if it is in the client area ourselves. */
3660 case WM_MOUSEACTIVATE
:
3661 /* Discard the mouse click that activates a frame, allowing the
3662 user to click anywhere without changing point (or worse!).
3663 Don't eat mouse clicks on scrollbars though!! */
3664 if (LOWORD (lParam
) == HTCLIENT
)
3665 return MA_ACTIVATEANDEAT
;
3670 case WM_ACTIVATEAPP
:
3671 case WM_WINDOWPOSCHANGED
:
3673 /* Inform lisp thread that a frame might have just been obscured
3674 or exposed, so should recheck visibility of all frames. */
3675 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3684 wmsg
.dwModifiers
= w32_get_modifiers ();
3685 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3689 wmsg
.dwModifiers
= w32_get_modifiers ();
3690 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3693 case WM_WINDOWPOSCHANGING
:
3696 LPWINDOWPOS lppos
= (WINDOWPOS
*) lParam
;
3698 wp
.length
= sizeof (WINDOWPLACEMENT
);
3699 GetWindowPlacement (hwnd
, &wp
);
3701 if (wp
.showCmd
!= SW_SHOWMINIMIZED
&& (lppos
->flags
& SWP_NOSIZE
) == 0)
3708 DWORD internal_border
;
3709 DWORD scrollbar_extra
;
3712 wp
.length
= sizeof(wp
);
3713 GetWindowRect (hwnd
, &wr
);
3717 font_width
= GetWindowLong (hwnd
, WND_FONTWIDTH_INDEX
);
3718 line_height
= GetWindowLong (hwnd
, WND_LINEHEIGHT_INDEX
);
3719 internal_border
= GetWindowLong (hwnd
, WND_BORDER_INDEX
);
3720 scrollbar_extra
= GetWindowLong (hwnd
, WND_SCROLLBAR_INDEX
);
3724 memset (&rect
, 0, sizeof (rect
));
3725 AdjustWindowRect (&rect
, GetWindowLong (hwnd
, GWL_STYLE
),
3726 GetMenu (hwnd
) != NULL
);
3728 /* Force width and height of client area to be exact
3729 multiples of the character cell dimensions. */
3730 wdiff
= (lppos
->cx
- (rect
.right
- rect
.left
)
3731 - 2 * internal_border
- scrollbar_extra
)
3733 hdiff
= (lppos
->cy
- (rect
.bottom
- rect
.top
)
3734 - 2 * internal_border
)
3739 /* For right/bottom sizing we can just fix the sizes.
3740 However for top/left sizing we will need to fix the X
3741 and Y positions as well. */
3746 if (wp
.showCmd
!= SW_SHOWMAXIMIZED
3747 && (lppos
->flags
& SWP_NOMOVE
) == 0)
3749 if (lppos
->x
!= wr
.left
|| lppos
->y
!= wr
.top
)
3756 lppos
->flags
|= SWP_NOMOVE
;
3767 case WM_EMACS_CREATESCROLLBAR
:
3768 return (LRESULT
) w32_createscrollbar ((struct frame
*) wParam
,
3769 (struct scroll_bar
*) lParam
);
3771 case WM_EMACS_SHOWWINDOW
:
3772 return ShowWindow ((HWND
) wParam
, (WPARAM
) lParam
);
3774 case WM_EMACS_SETWINDOWPOS
:
3776 WINDOWPOS
* pos
= (WINDOWPOS
*) wParam
;
3777 return SetWindowPos (hwnd
, pos
->hwndInsertAfter
,
3778 pos
->x
, pos
->y
, pos
->cx
, pos
->cy
, pos
->flags
);
3781 case WM_EMACS_DESTROYWINDOW
:
3782 return DestroyWindow ((HWND
) wParam
);
3784 case WM_EMACS_TRACKPOPUPMENU
:
3789 pos
= (POINT
*)lParam
;
3790 flags
= TPM_CENTERALIGN
;
3791 if (button_state
& LMOUSE
)
3792 flags
|= TPM_LEFTBUTTON
;
3793 else if (button_state
& RMOUSE
)
3794 flags
|= TPM_RIGHTBUTTON
;
3796 /* Use menubar_active to indicate that WM_INITMENU is from
3797 TrackPopupMenu below, and should be ignored. */
3798 f
= x_window_to_frame (dpyinfo
, hwnd
);
3800 f
->output_data
.w32
->menubar_active
= 1;
3802 if (TrackPopupMenu ((HMENU
)wParam
, flags
, pos
->x
, pos
->y
,
3806 /* Eat any mouse messages during popupmenu */
3807 while (PeekMessage (&amsg
, hwnd
, WM_MOUSEFIRST
, WM_MOUSELAST
,
3809 /* Get the menu selection, if any */
3810 if (PeekMessage (&amsg
, hwnd
, WM_COMMAND
, WM_COMMAND
, PM_REMOVE
))
3812 retval
= LOWORD (amsg
.wParam
);
3820 /* Remember we did a SetCapture on the initial mouse down
3821 event, but window focus will usually have changed to the
3822 popup menu before we released the mouse button. For
3823 safety, we make sure the capture is cancelled now. */
3836 return DefWindowProc (hwnd
, msg
, wParam
, lParam
);
3840 /* The most common default return code for handled messages is 0. */
3845 my_create_window (f
)
3850 if (!PostThreadMessage (dwWindowsThreadId
, WM_EMACS_CREATEWINDOW
, (WPARAM
)f
, 0))
3852 GetMessage (&msg
, NULL
, WM_EMACS_DONE
, WM_EMACS_DONE
);
3855 /* Create and set up the w32 window for frame F. */
3858 w32_window (f
, window_prompting
, minibuffer_only
)
3860 long window_prompting
;
3861 int minibuffer_only
;
3865 /* Use the resource name as the top-level window name
3866 for looking up resources. Make a non-Lisp copy
3867 for the window manager, so GC relocation won't bother it.
3869 Elsewhere we specify the window name for the window manager. */
3872 char *str
= (char *) XSTRING (Vx_resource_name
)->data
;
3873 f
->namebuf
= (char *) xmalloc (strlen (str
) + 1);
3874 strcpy (f
->namebuf
, str
);
3877 my_create_window (f
);
3879 validate_x_resource_name ();
3881 /* x_set_name normally ignores requests to set the name if the
3882 requested name is the same as the current name. This is the one
3883 place where that assumption isn't correct; f->name is set, but
3884 the server hasn't been told. */
3887 int explicit = f
->explicit_name
;
3889 f
->explicit_name
= 0;
3892 x_set_name (f
, name
, explicit);
3897 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
3898 initialize_frame_menubar (f
);
3900 if (FRAME_W32_WINDOW (f
) == 0)
3901 error ("Unable to create window");
3904 /* Handle the icon stuff for this window. Perhaps later we might
3905 want an x_set_icon_position which can be called interactively as
3913 Lisp_Object icon_x
, icon_y
;
3915 /* Set the position of the icon. Note that Windows 95 groups all
3916 icons in the tray. */
3917 icon_x
= x_get_arg (parms
, Qicon_left
, 0, 0, number
);
3918 icon_y
= x_get_arg (parms
, Qicon_top
, 0, 0, number
);
3919 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
3921 CHECK_NUMBER (icon_x
, 0);
3922 CHECK_NUMBER (icon_y
, 0);
3924 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
3925 error ("Both left and top icon corners of icon must be specified");
3929 if (! EQ (icon_x
, Qunbound
))
3930 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
3933 /* Start up iconic or window? */
3934 x_wm_set_window_state
3935 (f
, (EQ (x_get_arg (parms
, Qvisibility
, 0, 0, symbol
), Qicon
)
3939 x_text_icon (f
, (char *) XSTRING ((!NILP (f
->icon_name
)
3947 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
3949 "Make a new window, which is called a \"frame\" in Emacs terms.\n\
3950 Returns an Emacs frame object.\n\
3951 ALIST is an alist of frame parameters.\n\
3952 If the parameters specify that the frame should not have a minibuffer,\n\
3953 and do not specify a specific minibuffer window to use,\n\
3954 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
3955 be shared by the new frame.\n\
3957 This function is an internal primitive--use `make-frame' instead.")
3962 Lisp_Object frame
, tem
;
3964 int minibuffer_only
= 0;
3965 long window_prompting
= 0;
3967 int count
= specpdl_ptr
- specpdl
;
3968 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3969 Lisp_Object display
;
3970 struct w32_display_info
*dpyinfo
;
3974 /* Use this general default value to start with
3975 until we know if this frame has a specified name. */
3976 Vx_resource_name
= Vinvocation_name
;
3978 display
= x_get_arg (parms
, Qdisplay
, 0, 0, string
);
3979 if (EQ (display
, Qunbound
))
3981 dpyinfo
= check_x_display_info (display
);
3983 kb
= dpyinfo
->kboard
;
3985 kb
= &the_only_kboard
;
3988 name
= x_get_arg (parms
, Qname
, "name", "Name", string
);
3990 && ! EQ (name
, Qunbound
)
3992 error ("Invalid frame name--not a string or nil");
3995 Vx_resource_name
= name
;
3997 /* See if parent window is specified. */
3998 parent
= x_get_arg (parms
, Qparent_id
, NULL
, NULL
, number
);
3999 if (EQ (parent
, Qunbound
))
4001 if (! NILP (parent
))
4002 CHECK_NUMBER (parent
, 0);
4004 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
4005 /* No need to protect DISPLAY because that's not used after passing
4006 it to make_frame_without_minibuffer. */
4008 GCPRO4 (parms
, parent
, name
, frame
);
4009 tem
= x_get_arg (parms
, Qminibuffer
, 0, 0, symbol
);
4010 if (EQ (tem
, Qnone
) || NILP (tem
))
4011 f
= make_frame_without_minibuffer (Qnil
, kb
, display
);
4012 else if (EQ (tem
, Qonly
))
4014 f
= make_minibuffer_frame ();
4015 minibuffer_only
= 1;
4017 else if (WINDOWP (tem
))
4018 f
= make_frame_without_minibuffer (tem
, kb
, display
);
4022 XSETFRAME (frame
, f
);
4024 /* Note that Windows does support scroll bars. */
4025 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
4026 /* By default, make scrollbars the system standard width. */
4027 f
->scroll_bar_pixel_width
= GetSystemMetrics (SM_CXVSCROLL
);
4029 f
->output_method
= output_w32
;
4030 f
->output_data
.w32
= (struct w32_output
*) xmalloc (sizeof (struct w32_output
));
4031 bzero (f
->output_data
.w32
, sizeof (struct w32_output
));
4034 = x_get_arg (parms
, Qicon_name
, "iconName", "Title", string
);
4035 if (! STRINGP (f
->icon_name
))
4036 f
->icon_name
= Qnil
;
4038 /* FRAME_W32_DISPLAY_INFO (f) = dpyinfo; */
4040 FRAME_KBOARD (f
) = kb
;
4043 /* Specify the parent under which to make this window. */
4047 f
->output_data
.w32
->parent_desc
= (Window
) parent
;
4048 f
->output_data
.w32
->explicit_parent
= 1;
4052 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
4053 f
->output_data
.w32
->explicit_parent
= 0;
4056 /* Note that the frame has no physical cursor right now. */
4057 f
->phys_cursor_x
= -1;
4059 /* Set the name; the functions to which we pass f expect the name to
4061 if (EQ (name
, Qunbound
) || NILP (name
))
4063 f
->name
= build_string (dpyinfo
->w32_id_name
);
4064 f
->explicit_name
= 0;
4069 f
->explicit_name
= 1;
4070 /* use the frame's title when getting resources for this frame. */
4071 specbind (Qx_resource_name
, name
);
4074 /* Extract the window parameters from the supplied values
4075 that are needed to determine window geometry. */
4079 font
= x_get_arg (parms
, Qfont
, "font", "Font", string
);
4081 /* First, try whatever font the caller has specified. */
4083 font
= x_new_font (f
, XSTRING (font
)->data
);
4084 /* Try out a font which we hope has bold and italic variations. */
4085 if (!STRINGP (font
))
4086 font
= x_new_font (f
, "-*-Courier New-normal-r-*-*-13-97-*-*-c-*-*-ansi-");
4087 if (! STRINGP (font
))
4088 font
= x_new_font (f
, "-*-Courier-normal-r-*-*-13-97-*-*-c-*-*-ansi-");
4089 /* If those didn't work, look for something which will at least work. */
4090 if (! STRINGP (font
))
4091 font
= x_new_font (f
, "-*-Fixedsys-normal-r-*-*-13-97-*-*-c-*-*-ansi-");
4093 if (! STRINGP (font
))
4094 font
= build_string ("Fixedsys");
4096 x_default_parameter (f
, parms
, Qfont
, font
,
4097 "font", "Font", string
);
4100 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
4101 "borderwidth", "BorderWidth", number
);
4102 /* This defaults to 2 in order to match xterm. We recognize either
4103 internalBorderWidth or internalBorder (which is what xterm calls
4105 if (NILP (Fassq (Qinternal_border_width
, parms
)))
4109 value
= x_get_arg (parms
, Qinternal_border_width
,
4110 "internalBorder", "BorderWidth", number
);
4111 if (! EQ (value
, Qunbound
))
4112 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
4115 /* Default internalBorderWidth to 0 on Windows to match other programs. */
4116 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (0),
4117 "internalBorderWidth", "BorderWidth", number
);
4118 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qt
,
4119 "verticalScrollBars", "ScrollBars", boolean
);
4121 /* Also do the stuff which must be set before the window exists. */
4122 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
4123 "foreground", "Foreground", string
);
4124 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
4125 "background", "Background", string
);
4126 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
4127 "pointerColor", "Foreground", string
);
4128 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
4129 "cursorColor", "Foreground", string
);
4130 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
4131 "borderColor", "BorderColor", string
);
4133 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (1),
4134 "menuBar", "MenuBar", number
);
4135 x_default_parameter (f
, parms
, Qscroll_bar_width
, Qnil
,
4136 "scrollBarWidth", "ScrollBarWidth", number
);
4137 x_default_parameter (f
, parms
, Qbuffer_predicate
, Qnil
,
4138 "bufferPredicate", "BufferPredicate", symbol
);
4139 x_default_parameter (f
, parms
, Qtitle
, Qnil
,
4140 "title", "Title", string
);
4142 f
->output_data
.w32
->dwStyle
= WS_OVERLAPPEDWINDOW
;
4143 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
4144 window_prompting
= x_figure_window_size (f
, parms
);
4146 if (window_prompting
& XNegative
)
4148 if (window_prompting
& YNegative
)
4149 f
->output_data
.w32
->win_gravity
= SouthEastGravity
;
4151 f
->output_data
.w32
->win_gravity
= NorthEastGravity
;
4155 if (window_prompting
& YNegative
)
4156 f
->output_data
.w32
->win_gravity
= SouthWestGravity
;
4158 f
->output_data
.w32
->win_gravity
= NorthWestGravity
;
4161 f
->output_data
.w32
->size_hint_flags
= window_prompting
;
4163 w32_window (f
, window_prompting
, minibuffer_only
);
4165 init_frame_faces (f
);
4167 /* We need to do this after creating the window, so that the
4168 icon-creation functions can say whose icon they're describing. */
4169 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
4170 "bitmapIcon", "BitmapIcon", symbol
);
4172 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
4173 "autoRaise", "AutoRaiseLower", boolean
);
4174 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
4175 "autoLower", "AutoRaiseLower", boolean
);
4176 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
4177 "cursorType", "CursorType", symbol
);
4179 /* Dimensions, especially f->height, must be done via change_frame_size.
4180 Change will not be effected unless different from the current
4185 SET_FRAME_WIDTH (f
, 0);
4186 change_frame_size (f
, height
, width
, 1, 0);
4188 /* Tell the server what size and position, etc, we want,
4189 and how badly we want them. */
4191 x_wm_set_size_hint (f
, window_prompting
, 0);
4194 tem
= x_get_arg (parms
, Qunsplittable
, 0, 0, boolean
);
4195 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
4199 /* It is now ok to make the frame official
4200 even if we get an error below.
4201 And the frame needs to be on Vframe_list
4202 or making it visible won't work. */
4203 Vframe_list
= Fcons (frame
, Vframe_list
);
4205 /* Now that the frame is official, it counts as a reference to
4207 FRAME_W32_DISPLAY_INFO (f
)->reference_count
++;
4209 /* Make the window appear on the frame and enable display,
4210 unless the caller says not to. However, with explicit parent,
4211 Emacs cannot control visibility, so don't try. */
4212 if (! f
->output_data
.w32
->explicit_parent
)
4214 Lisp_Object visibility
;
4216 visibility
= x_get_arg (parms
, Qvisibility
, 0, 0, symbol
);
4217 if (EQ (visibility
, Qunbound
))
4220 if (EQ (visibility
, Qicon
))
4221 x_iconify_frame (f
);
4222 else if (! NILP (visibility
))
4223 x_make_frame_visible (f
);
4225 /* Must have been Qnil. */
4229 return unbind_to (count
, frame
);
4232 /* FRAME is used only to get a handle on the X display. We don't pass the
4233 display info directly because we're called from frame.c, which doesn't
4234 know about that structure. */
4236 x_get_focus_frame (frame
)
4237 struct frame
*frame
;
4239 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (frame
);
4241 if (! dpyinfo
->w32_focus_frame
)
4244 XSETFRAME (xfocus
, dpyinfo
->w32_focus_frame
);
4248 DEFUN ("w32-focus-frame", Fw32_focus_frame
, Sw32_focus_frame
, 1, 1, 0,
4249 "Give FRAME input focus, raising to foreground if necessary.")
4253 x_focus_on_frame (check_x_frame (frame
));
4259 w32_load_font (dpyinfo
,name
)
4260 struct w32_display_info
*dpyinfo
;
4263 XFontStruct
* font
= NULL
;
4269 if (!name
|| !x_to_w32_font (name
, &lf
))
4272 font
= (XFontStruct
*) xmalloc (sizeof (XFontStruct
));
4274 if (!font
) return (NULL
);
4278 font
->hfont
= CreateFontIndirect (&lf
);
4281 if (font
->hfont
== NULL
)
4290 hdc
= GetDC (dpyinfo
->root_window
);
4291 oldobj
= SelectObject (hdc
, font
->hfont
);
4292 ok
= GetTextMetrics (hdc
, &font
->tm
);
4293 SelectObject (hdc
, oldobj
);
4294 ReleaseDC (dpyinfo
->root_window
, hdc
);
4299 if (ok
) return (font
);
4301 w32_unload_font (dpyinfo
, font
);
4306 w32_unload_font (dpyinfo
, font
)
4307 struct w32_display_info
*dpyinfo
;
4312 if (font
->hfont
) DeleteObject(font
->hfont
);
4317 /* The font conversion stuff between x and w32 */
4319 /* X font string is as follows (from faces.el)
4323 * (weight "\\(bold\\|demibold\\|medium\\)") ; 1
4324 * (weight\? "\\([^-]*\\)") ; 1
4325 * (slant "\\([ior]\\)") ; 2
4326 * (slant\? "\\([^-]?\\)") ; 2
4327 * (swidth "\\([^-]*\\)") ; 3
4328 * (adstyle "[^-]*") ; 4
4329 * (pixelsize "[0-9]+")
4330 * (pointsize "[0-9][0-9]+")
4331 * (resx "[0-9][0-9]+")
4332 * (resy "[0-9][0-9]+")
4333 * (spacing "[cmp?*]")
4334 * (avgwidth "[0-9]+")
4335 * (registry "[^-]+")
4336 * (encoding "[^-]+")
4338 * (setq x-font-regexp
4339 * (concat "\\`\\*?[-?*]"
4340 * foundry - family - weight\? - slant\? - swidth - adstyle -
4341 * pixelsize - pointsize - resx - resy - spacing - registry -
4342 * encoding "[-?*]\\*?\\'"
4344 * (setq x-font-regexp-head
4345 * (concat "\\`[-?*]" foundry - family - weight\? - slant\?
4346 * "\\([-*?]\\|\\'\\)"))
4347 * (setq x-font-regexp-slant (concat - slant -))
4348 * (setq x-font-regexp-weight (concat - weight -))
4352 #define FONT_START "[-?]"
4353 #define FONT_FOUNDRY "[^-]+"
4354 #define FONT_FAMILY "\\([^-]+\\)" /* 1 */
4355 #define FONT_WEIGHT "\\(bold\\|demibold\\|medium\\)" /* 2 */
4356 #define FONT_WEIGHT_Q "\\([^-]*\\)" /* 2 */
4357 #define FONT_SLANT "\\([ior]\\)" /* 3 */
4358 #define FONT_SLANT_Q "\\([^-]?\\)" /* 3 */
4359 #define FONT_SWIDTH "\\([^-]*\\)" /* 4 */
4360 #define FONT_ADSTYLE "[^-]*"
4361 #define FONT_PIXELSIZE "[^-]*"
4362 #define FONT_POINTSIZE "\\([0-9][0-9]+\\|\\*\\)" /* 5 */
4363 #define FONT_RESX "[0-9][0-9]+"
4364 #define FONT_RESY "[0-9][0-9]+"
4365 #define FONT_SPACING "[cmp?*]"
4366 #define FONT_AVGWIDTH "[0-9]+"
4367 #define FONT_REGISTRY "[^-]+"
4368 #define FONT_ENCODING "[^-]+"
4370 #define FONT_REGEXP ("\\`\\*?[-?*]" \
4377 FONT_PIXELSIZE "-" \
4378 FONT_POINTSIZE "-" \
4381 #define FONT_REGEXP_HEAD ("\\`[-?*]" \
4386 "\\([-*?]\\|\\'\\)")
4388 #define FONT_REGEXP_SLANT "-" FONT_SLANT "-"
4389 #define FONT_REGEXP_WEIGHT "-" FONT_WEIGHT "-"
4392 x_to_w32_weight (lpw
)
4395 if (!lpw
) return (FW_DONTCARE
);
4397 if (stricmp (lpw
,"heavy") == 0) return FW_HEAVY
;
4398 else if (stricmp (lpw
,"extrabold") == 0) return FW_EXTRABOLD
;
4399 else if (stricmp (lpw
,"bold") == 0) return FW_BOLD
;
4400 else if (stricmp (lpw
,"demibold") == 0) return FW_SEMIBOLD
;
4401 else if (stricmp (lpw
,"semibold") == 0) return FW_SEMIBOLD
;
4402 else if (stricmp (lpw
,"medium") == 0) return FW_MEDIUM
;
4403 else if (stricmp (lpw
,"normal") == 0) return FW_NORMAL
;
4404 else if (stricmp (lpw
,"light") == 0) return FW_LIGHT
;
4405 else if (stricmp (lpw
,"extralight") == 0) return FW_EXTRALIGHT
;
4406 else if (stricmp (lpw
,"thin") == 0) return FW_THIN
;
4413 w32_to_x_weight (fnweight
)
4416 if (fnweight
>= FW_HEAVY
) return "heavy";
4417 if (fnweight
>= FW_EXTRABOLD
) return "extrabold";
4418 if (fnweight
>= FW_BOLD
) return "bold";
4419 if (fnweight
>= FW_SEMIBOLD
) return "semibold";
4420 if (fnweight
>= FW_MEDIUM
) return "medium";
4421 if (fnweight
>= FW_NORMAL
) return "normal";
4422 if (fnweight
>= FW_LIGHT
) return "light";
4423 if (fnweight
>= FW_EXTRALIGHT
) return "extralight";
4424 if (fnweight
>= FW_THIN
) return "thin";
4430 x_to_w32_charset (lpcs
)
4433 if (!lpcs
) return (0);
4435 if (stricmp (lpcs
,"ansi") == 0) return ANSI_CHARSET
;
4436 else if (stricmp (lpcs
,"iso8859-1") == 0) return ANSI_CHARSET
;
4437 else if (stricmp (lpcs
,"iso8859") == 0) return ANSI_CHARSET
;
4438 else if (stricmp (lpcs
,"oem") == 0) return OEM_CHARSET
;
4439 #ifdef UNICODE_CHARSET
4440 else if (stricmp (lpcs
,"unicode") == 0) return UNICODE_CHARSET
;
4441 else if (stricmp (lpcs
,"iso10646") == 0) return UNICODE_CHARSET
;
4443 else if (lpcs
[0] == '#') return atoi (lpcs
+ 1);
4445 return DEFAULT_CHARSET
;
4449 w32_to_x_charset (fncharset
)
4452 static char buf
[16];
4456 case ANSI_CHARSET
: return "ansi";
4457 case OEM_CHARSET
: return "oem";
4458 case SYMBOL_CHARSET
: return "symbol";
4459 #ifdef UNICODE_CHARSET
4460 case UNICODE_CHARSET
: return "unicode";
4463 /* Encode numerical value of unknown charset. */
4464 sprintf (buf
, "#%u", fncharset
);
4469 w32_to_x_font (lplogfont
, lpxstr
, len
)
4470 LOGFONT
* lplogfont
;
4474 char height_pixels
[8];
4476 char width_pixels
[8];
4478 if (!lpxstr
) abort ();
4483 if (lplogfont
->lfHeight
)
4485 sprintf (height_pixels
, "%u", abs (lplogfont
->lfHeight
));
4486 sprintf (height_dpi
, "%u",
4487 (abs (lplogfont
->lfHeight
) * 720) / one_w32_display_info
.height_in
);
4491 strcpy (height_pixels
, "*");
4492 strcpy (height_dpi
, "*");
4494 if (lplogfont
->lfWidth
)
4495 sprintf (width_pixels
, "%u", lplogfont
->lfWidth
* 10);
4497 strcpy (width_pixels
, "*");
4499 _snprintf (lpxstr
, len
- 1,
4500 "-*-%s-%s-%c-*-*-%s-%s-*-*-%c-%s-*-%s-",
4501 lplogfont
->lfFaceName
,
4502 w32_to_x_weight (lplogfont
->lfWeight
),
4503 lplogfont
->lfItalic
?'i':'r',
4506 ((lplogfont
->lfPitchAndFamily
& 0x3) == VARIABLE_PITCH
) ? 'p' : 'c',
4508 w32_to_x_charset (lplogfont
->lfCharSet
)
4511 lpxstr
[len
- 1] = 0; /* just to be sure */
4516 x_to_w32_font (lpxstr
, lplogfont
)
4518 LOGFONT
* lplogfont
;
4520 if (!lplogfont
) return (FALSE
);
4522 memset (lplogfont
, 0, sizeof (*lplogfont
));
4525 lplogfont
->lfOutPrecision
= OUT_DEFAULT_PRECIS
;
4526 lplogfont
->lfClipPrecision
= CLIP_DEFAULT_PRECIS
;
4527 lplogfont
->lfQuality
= DEFAULT_QUALITY
;
4529 /* go for maximum quality */
4530 lplogfont
->lfOutPrecision
= OUT_STROKE_PRECIS
;
4531 lplogfont
->lfClipPrecision
= CLIP_STROKE_PRECIS
;
4532 lplogfont
->lfQuality
= PROOF_QUALITY
;
4538 /* Provide a simple escape mechanism for specifying Windows font names
4539 * directly -- if font spec does not beginning with '-', assume this
4541 * "<font name>[:height in pixels[:width in pixels[:weight]]]"
4547 char name
[50], weight
[20], slant
, pitch
, pixels
[10], height
[10], width
[10], remainder
[20];
4550 fields
= sscanf (lpxstr
,
4551 "-%*[^-]-%49[^-]-%19[^-]-%c-%*[^-]-%*[^-]-%9[^-]-%9[^-]-%*[^-]-%*[^-]-%c-%9[^-]-%19s",
4552 name
, weight
, &slant
, pixels
, height
, &pitch
, width
, remainder
);
4554 if (fields
== EOF
) return (FALSE
);
4556 if (fields
> 0 && name
[0] != '*')
4558 strncpy (lplogfont
->lfFaceName
,name
, LF_FACESIZE
);
4559 lplogfont
->lfFaceName
[LF_FACESIZE
-1] = 0;
4563 lplogfont
->lfFaceName
[0] = 0;
4568 lplogfont
->lfWeight
= x_to_w32_weight ((fields
> 0 ? weight
: ""));
4572 if (!NILP (Vw32_enable_italics
))
4573 lplogfont
->lfItalic
= (fields
> 0 && slant
== 'i');
4577 if (fields
> 0 && pixels
[0] != '*')
4578 lplogfont
->lfHeight
= atoi (pixels
);
4582 if (fields
> 0 && lplogfont
->lfHeight
== 0 && height
[0] != '*')
4583 lplogfont
->lfHeight
= (atoi (height
)
4584 * one_w32_display_info
.height_in
) / 720;
4588 lplogfont
->lfPitchAndFamily
=
4589 (fields
> 0 && pitch
== 'p') ? VARIABLE_PITCH
: FIXED_PITCH
;
4593 if (fields
> 0 && width
[0] != '*')
4594 lplogfont
->lfWidth
= atoi (width
) / 10;
4598 /* Not all font specs include the registry field, so we allow for an
4599 optional registry field before the encoding when parsing
4600 remainder. Also we strip the trailing '-' if present. */
4602 int len
= strlen (remainder
);
4603 if (len
> 0 && remainder
[len
-1] == '-')
4604 remainder
[len
-1] = 0;
4606 encoding
= remainder
;
4607 if (strncmp (encoding
, "*-", 2) == 0)
4609 lplogfont
->lfCharSet
= x_to_w32_charset (fields
> 0 ? encoding
: "");
4614 char name
[100], height
[10], width
[10], weight
[20];
4616 fields
= sscanf (lpxstr
,
4617 "%99[^:]:%9[^:]:%9[^:]:%19s",
4618 name
, height
, width
, weight
);
4620 if (fields
== EOF
) return (FALSE
);
4624 strncpy (lplogfont
->lfFaceName
,name
, LF_FACESIZE
);
4625 lplogfont
->lfFaceName
[LF_FACESIZE
-1] = 0;
4629 lplogfont
->lfFaceName
[0] = 0;
4635 lplogfont
->lfHeight
= atoi (height
);
4640 lplogfont
->lfWidth
= atoi (width
);
4644 lplogfont
->lfWeight
= x_to_w32_weight ((fields
> 0 ? weight
: ""));
4647 /* This makes TrueType fonts work better. */
4648 lplogfont
->lfHeight
= - abs (lplogfont
->lfHeight
);
4654 w32_font_match (lpszfont1
, lpszfont2
)
4658 char * s1
= lpszfont1
, *e1
;
4659 char * s2
= lpszfont2
, *e2
;
4661 if (s1
== NULL
|| s2
== NULL
) return (FALSE
);
4663 if (*s1
== '-') s1
++;
4664 if (*s2
== '-') s2
++;
4670 e1
= strchr (s1
, '-');
4671 e2
= strchr (s2
, '-');
4673 if (e1
== NULL
|| e2
== NULL
) return (TRUE
);
4678 if (*s1
!= '*' && *s2
!= '*'
4679 && (len1
!= len2
|| strnicmp (s1
, s2
, len1
) != 0))
4687 typedef struct enumfont_t
4692 XFontStruct
*size_ref
;
4693 Lisp_Object
*pattern
;
4699 enum_font_cb2 (lplf
, lptm
, FontType
, lpef
)
4701 NEWTEXTMETRIC
* lptm
;
4705 if (lplf
->elfLogFont
.lfStrikeOut
|| lplf
->elfLogFont
.lfUnderline
)
4708 /* if (!lpef->size_ref || lptm->tmMaxCharWidth == FONT_WIDTH (lpef->size_ref)) */
4712 if (!NILP (*(lpef
->pattern
)) && FontType
== TRUETYPE_FONTTYPE
)
4714 lplf
->elfLogFont
.lfHeight
= lpef
->logfont
.lfHeight
;
4715 lplf
->elfLogFont
.lfWidth
= lpef
->logfont
.lfWidth
;
4718 if (!w32_to_x_font (lplf
, buf
, 100)) return (0);
4720 if (NILP (*(lpef
->pattern
)) || w32_font_match (buf
, XSTRING (*(lpef
->pattern
))->data
))
4722 *lpef
->tail
= Fcons (build_string (buf
), Qnil
);
4723 lpef
->tail
= &XCONS (*lpef
->tail
)->cdr
;
4732 enum_font_cb1 (lplf
, lptm
, FontType
, lpef
)
4734 NEWTEXTMETRIC
* lptm
;
4738 return EnumFontFamilies (lpef
->hdc
,
4739 lplf
->elfLogFont
.lfFaceName
,
4740 (FONTENUMPROC
) enum_font_cb2
,
4745 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 3, 0,
4746 "Return a list of the names of available fonts matching PATTERN.\n\
4747 If optional arguments FACE and FRAME are specified, return only fonts\n\
4748 the same size as FACE on FRAME.\n\
4750 PATTERN is a string, perhaps with wildcard characters;\n\
4751 the * character matches any substring, and\n\
4752 the ? character matches any single character.\n\
4753 PATTERN is case-insensitive.\n\
4754 FACE is a face name--a symbol.\n\
4756 The return value is a list of strings, suitable as arguments to\n\
4759 Fonts Emacs can't use (i.e. proportional fonts) may or may not be excluded\n\
4760 even if they match PATTERN and FACE.")
4761 (pattern
, face
, frame
)
4762 Lisp_Object pattern
, face
, frame
;
4767 XFontStruct
*size_ref
;
4768 Lisp_Object namelist
;
4773 CHECK_STRING (pattern
, 0);
4775 CHECK_SYMBOL (face
, 1);
4777 f
= check_x_frame (frame
);
4779 /* Determine the width standard for comparison with the fonts we find. */
4787 /* Don't die if we get called with a terminal frame. */
4788 if (! FRAME_W32_P (f
))
4789 error ("non-w32 frame used in `x-list-fonts'");
4791 face_id
= face_name_id_number (f
, face
);
4793 if (face_id
< 0 || face_id
>= FRAME_N_PARAM_FACES (f
)
4794 || FRAME_PARAM_FACES (f
) [face_id
] == 0)
4795 size_ref
= f
->output_data
.w32
->font
;
4798 size_ref
= FRAME_PARAM_FACES (f
) [face_id
]->font
;
4799 if (size_ref
== (XFontStruct
*) (~0))
4800 size_ref
= f
->output_data
.w32
->font
;
4804 /* See if we cached the result for this particular query. */
4805 list
= Fassoc (pattern
,
4806 XCONS (FRAME_W32_DISPLAY_INFO (f
)->name_list_element
)->cdr
);
4808 /* We have info in the cache for this PATTERN. */
4811 Lisp_Object tem
, newlist
;
4813 /* We have info about this pattern. */
4814 list
= XCONS (list
)->cdr
;
4821 /* Filter the cached info and return just the fonts that match FACE. */
4823 for (tem
= list
; CONSP (tem
); tem
= XCONS (tem
)->cdr
)
4825 XFontStruct
*thisinfo
;
4827 thisinfo
= w32_load_font (FRAME_W32_DISPLAY_INFO (f
), XSTRING (XCONS (tem
)->car
)->data
);
4829 if (thisinfo
&& same_size_fonts (thisinfo
, size_ref
))
4830 newlist
= Fcons (XCONS (tem
)->car
, newlist
);
4832 w32_unload_font (FRAME_W32_DISPLAY_INFO (f
), thisinfo
);
4843 ef
.pattern
= &pattern
;
4844 ef
.tail
= ef
.head
= &namelist
;
4846 x_to_w32_font (STRINGP (pattern
) ? XSTRING (pattern
)->data
: NULL
, &ef
.logfont
);
4849 ef
.hdc
= GetDC (FRAME_W32_WINDOW (f
));
4851 EnumFontFamilies (ef
.hdc
, NULL
, (FONTENUMPROC
) enum_font_cb1
, (LPARAM
)&ef
);
4853 ReleaseDC (FRAME_W32_WINDOW (f
), ef
.hdc
);
4863 /* Make a list of all the fonts we got back.
4864 Store that in the font cache for the display. */
4865 XCONS (FRAME_W32_DISPLAY_INFO (f
)->name_list_element
)->cdr
4866 = Fcons (Fcons (pattern
, namelist
),
4867 XCONS (FRAME_W32_DISPLAY_INFO (f
)->name_list_element
)->cdr
);
4869 /* Make a list of the fonts that have the right width. */
4872 for (i
= 0; i
< ef
.numFonts
; i
++)
4880 XFontStruct
*thisinfo
;
4883 thisinfo
= w32_load_font (FRAME_W32_DISPLAY_INFO (f
), XSTRING (Fcar (cur
))->data
);
4885 keeper
= thisinfo
&& same_size_fonts (thisinfo
, size_ref
);
4887 w32_unload_font (FRAME_W32_DISPLAY_INFO (f
), thisinfo
);
4892 list
= Fcons (build_string (XSTRING (Fcar (cur
))->data
), list
);
4896 list
= Fnreverse (list
);
4902 DEFUN ("x-color-defined-p", Fx_color_defined_p
, Sx_color_defined_p
, 1, 2, 0,
4903 "Return non-nil if color COLOR is supported on frame FRAME.\n\
4904 If FRAME is omitted or nil, use the selected frame.")
4906 Lisp_Object color
, frame
;
4909 FRAME_PTR f
= check_x_frame (frame
);
4911 CHECK_STRING (color
, 1);
4913 if (defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
4919 DEFUN ("x-color-values", Fx_color_values
, Sx_color_values
, 1, 2, 0,
4920 "Return a description of the color named COLOR on frame FRAME.\n\
4921 The value is a list of integer RGB values--(RED GREEN BLUE).\n\
4922 These values appear to range from 0 to 65280 or 65535, depending\n\
4923 on the system; white is (65280 65280 65280) or (65535 65535 65535).\n\
4924 If FRAME is omitted or nil, use the selected frame.")
4926 Lisp_Object color
, frame
;
4929 FRAME_PTR f
= check_x_frame (frame
);
4931 CHECK_STRING (color
, 1);
4933 if (defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
4937 rgb
[0] = make_number ((GetRValue (foo
) << 8) | GetRValue (foo
));
4938 rgb
[1] = make_number ((GetGValue (foo
) << 8) | GetGValue (foo
));
4939 rgb
[2] = make_number ((GetBValue (foo
) << 8) | GetBValue (foo
));
4940 return Flist (3, rgb
);
4946 DEFUN ("x-display-color-p", Fx_display_color_p
, Sx_display_color_p
, 0, 1, 0,
4947 "Return t if the X display supports color.\n\
4948 The optional argument DISPLAY specifies which display to ask about.\n\
4949 DISPLAY should be either a frame or a display name (a string).\n\
4950 If omitted or nil, that stands for the selected frame's display.")
4952 Lisp_Object display
;
4954 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
4956 if ((dpyinfo
->n_planes
* dpyinfo
->n_cbits
) <= 2)
4962 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
, Sx_display_grayscale_p
,
4964 "Return t if the X display supports shades of gray.\n\
4965 Note that color displays do support shades of gray.\n\
4966 The optional argument DISPLAY specifies which display to ask about.\n\
4967 DISPLAY should be either a frame or a display name (a string).\n\
4968 If omitted or nil, that stands for the selected frame's display.")
4970 Lisp_Object display
;
4972 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
4974 if ((dpyinfo
->n_planes
* dpyinfo
->n_cbits
) <= 1)
4980 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
4982 "Returns the width in pixels of the X display DISPLAY.\n\
4983 The optional argument DISPLAY specifies which display to ask about.\n\
4984 DISPLAY should be either a frame or a display name (a string).\n\
4985 If omitted or nil, that stands for the selected frame's display.")
4987 Lisp_Object display
;
4989 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
4991 return make_number (dpyinfo
->width
);
4994 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
4995 Sx_display_pixel_height
, 0, 1, 0,
4996 "Returns the height in pixels of the X display DISPLAY.\n\
4997 The optional argument DISPLAY specifies which display to ask about.\n\
4998 DISPLAY should be either a frame or a display name (a string).\n\
4999 If omitted or nil, that stands for the selected frame's display.")
5001 Lisp_Object display
;
5003 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
5005 return make_number (dpyinfo
->height
);
5008 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
5010 "Returns the number of bitplanes of the display DISPLAY.\n\
5011 The optional argument DISPLAY specifies which display to ask about.\n\
5012 DISPLAY should be either a frame or a display name (a string).\n\
5013 If omitted or nil, that stands for the selected frame's display.")
5015 Lisp_Object display
;
5017 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
5019 return make_number (dpyinfo
->n_planes
* dpyinfo
->n_cbits
);
5022 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
5024 "Returns the number of color cells of the display DISPLAY.\n\
5025 The optional argument DISPLAY specifies which display to ask about.\n\
5026 DISPLAY should be either a frame or a display name (a string).\n\
5027 If omitted or nil, that stands for the selected frame's display.")
5029 Lisp_Object display
;
5031 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
5035 hdc
= GetDC (dpyinfo
->root_window
);
5036 if (dpyinfo
->has_palette
)
5037 cap
= GetDeviceCaps (hdc
,SIZEPALETTE
);
5039 cap
= GetDeviceCaps (hdc
,NUMCOLORS
);
5041 ReleaseDC (dpyinfo
->root_window
, hdc
);
5043 return make_number (cap
);
5046 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
5047 Sx_server_max_request_size
,
5049 "Returns the maximum request size of the server of display DISPLAY.\n\
5050 The optional argument DISPLAY specifies which display to ask about.\n\
5051 DISPLAY should be either a frame or a display name (a string).\n\
5052 If omitted or nil, that stands for the selected frame's display.")
5054 Lisp_Object display
;
5056 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
5058 return make_number (1);
5061 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
5062 "Returns the vendor ID string of the W32 system (Microsoft).\n\
5063 The optional argument DISPLAY specifies which display to ask about.\n\
5064 DISPLAY should be either a frame or a display name (a string).\n\
5065 If omitted or nil, that stands for the selected frame's display.")
5067 Lisp_Object display
;
5069 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
5070 char *vendor
= "Microsoft Corp.";
5072 if (! vendor
) vendor
= "";
5073 return build_string (vendor
);
5076 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
5077 "Returns the version numbers of the server of display DISPLAY.\n\
5078 The value is a list of three integers: the major and minor\n\
5079 version numbers, and the vendor-specific release\n\
5080 number. See also the function `x-server-vendor'.\n\n\
5081 The optional argument DISPLAY specifies which display to ask about.\n\
5082 DISPLAY should be either a frame or a display name (a string).\n\
5083 If omitted or nil, that stands for the selected frame's display.")
5085 Lisp_Object display
;
5087 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
5089 return Fcons (make_number (w32_major_version
),
5090 Fcons (make_number (w32_minor_version
), Qnil
));
5093 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
5094 "Returns the number of screens on the server of display DISPLAY.\n\
5095 The optional argument DISPLAY specifies which display to ask about.\n\
5096 DISPLAY should be either a frame or a display name (a string).\n\
5097 If omitted or nil, that stands for the selected frame's display.")
5099 Lisp_Object display
;
5101 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
5103 return make_number (1);
5106 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
5107 "Returns the height in millimeters of the X display DISPLAY.\n\
5108 The optional argument DISPLAY specifies which display to ask about.\n\
5109 DISPLAY should be either a frame or a display name (a string).\n\
5110 If omitted or nil, that stands for the selected frame's display.")
5112 Lisp_Object display
;
5114 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
5118 hdc
= GetDC (dpyinfo
->root_window
);
5120 cap
= GetDeviceCaps (hdc
, VERTSIZE
);
5122 ReleaseDC (dpyinfo
->root_window
, hdc
);
5124 return make_number (cap
);
5127 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
5128 "Returns the width in millimeters of the X display DISPLAY.\n\
5129 The optional argument DISPLAY specifies which display to ask about.\n\
5130 DISPLAY should be either a frame or a display name (a string).\n\
5131 If omitted or nil, that stands for the selected frame's display.")
5133 Lisp_Object display
;
5135 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
5140 hdc
= GetDC (dpyinfo
->root_window
);
5142 cap
= GetDeviceCaps (hdc
, HORZSIZE
);
5144 ReleaseDC (dpyinfo
->root_window
, hdc
);
5146 return make_number (cap
);
5149 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
5150 Sx_display_backing_store
, 0, 1, 0,
5151 "Returns an indication of whether display DISPLAY does backing store.\n\
5152 The value may be `always', `when-mapped', or `not-useful'.\n\
5153 The optional argument DISPLAY specifies which display to ask about.\n\
5154 DISPLAY should be either a frame or a display name (a string).\n\
5155 If omitted or nil, that stands for the selected frame's display.")
5157 Lisp_Object display
;
5159 return intern ("not-useful");
5162 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
5163 Sx_display_visual_class
, 0, 1, 0,
5164 "Returns the visual class of the display DISPLAY.\n\
5165 The value is one of the symbols `static-gray', `gray-scale',\n\
5166 `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
5167 The optional argument DISPLAY specifies which display to ask about.\n\
5168 DISPLAY should be either a frame or a display name (a string).\n\
5169 If omitted or nil, that stands for the selected frame's display.")
5171 Lisp_Object display
;
5173 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
5176 switch (dpyinfo
->visual
->class)
5178 case StaticGray
: return (intern ("static-gray"));
5179 case GrayScale
: return (intern ("gray-scale"));
5180 case StaticColor
: return (intern ("static-color"));
5181 case PseudoColor
: return (intern ("pseudo-color"));
5182 case TrueColor
: return (intern ("true-color"));
5183 case DirectColor
: return (intern ("direct-color"));
5185 error ("Display has an unknown visual class");
5189 error ("Display has an unknown visual class");
5192 DEFUN ("x-display-save-under", Fx_display_save_under
,
5193 Sx_display_save_under
, 0, 1, 0,
5194 "Returns t if the display DISPLAY supports the save-under feature.\n\
5195 The optional argument DISPLAY specifies which display to ask about.\n\
5196 DISPLAY should be either a frame or a display name (a string).\n\
5197 If omitted or nil, that stands for the selected frame's display.")
5199 Lisp_Object display
;
5201 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
5208 register struct frame
*f
;
5210 return PIXEL_WIDTH (f
);
5215 register struct frame
*f
;
5217 return PIXEL_HEIGHT (f
);
5222 register struct frame
*f
;
5224 return FONT_WIDTH (f
->output_data
.w32
->font
);
5229 register struct frame
*f
;
5231 return f
->output_data
.w32
->line_height
;
5235 x_screen_planes (frame
)
5238 return (FRAME_W32_DISPLAY_INFO (XFRAME (frame
))->n_planes
*
5239 FRAME_W32_DISPLAY_INFO (XFRAME (frame
))->n_cbits
);
5242 /* Return the display structure for the display named NAME.
5243 Open a new connection if necessary. */
5245 struct w32_display_info
*
5246 x_display_info_for_name (name
)
5250 struct w32_display_info
*dpyinfo
;
5252 CHECK_STRING (name
, 0);
5254 for (dpyinfo
= &one_w32_display_info
, names
= w32_display_name_list
;
5256 dpyinfo
= dpyinfo
->next
, names
= XCONS (names
)->cdr
)
5259 tem
= Fstring_equal (XCONS (XCONS (names
)->car
)->car
, name
);
5264 /* Use this general default value to start with. */
5265 Vx_resource_name
= Vinvocation_name
;
5267 validate_x_resource_name ();
5269 dpyinfo
= w32_term_init (name
, (unsigned char *)0,
5270 (char *) XSTRING (Vx_resource_name
)->data
);
5273 error ("Cannot connect to server %s", XSTRING (name
)->data
);
5276 XSETFASTINT (Vwindow_system_version
, 3);
5281 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
5282 1, 3, 0, "Open a connection to a server.\n\
5283 DISPLAY is the name of the display to connect to.\n\
5284 Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
5285 If the optional third arg MUST-SUCCEED is non-nil,\n\
5286 terminate Emacs if we can't open the connection.")
5287 (display
, xrm_string
, must_succeed
)
5288 Lisp_Object display
, xrm_string
, must_succeed
;
5290 unsigned int n_planes
;
5291 unsigned char *xrm_option
;
5292 struct w32_display_info
*dpyinfo
;
5294 CHECK_STRING (display
, 0);
5295 if (! NILP (xrm_string
))
5296 CHECK_STRING (xrm_string
, 1);
5298 if (! EQ (Vwindow_system
, intern ("w32")))
5299 error ("Not using Microsoft Windows");
5301 /* Allow color mapping to be defined externally; first look in user's
5302 HOME directory, then in Emacs etc dir for a file called rgb.txt. */
5304 Lisp_Object color_file
;
5305 struct gcpro gcpro1
;
5307 color_file
= build_string("~/rgb.txt");
5309 GCPRO1 (color_file
);
5311 if (NILP (Ffile_readable_p (color_file
)))
5313 Fexpand_file_name (build_string ("rgb.txt"),
5314 Fsymbol_value (intern ("data-directory")));
5316 Vw32_color_map
= Fw32_load_color_file (color_file
);
5320 if (NILP (Vw32_color_map
))
5321 Vw32_color_map
= Fw32_default_color_map ();
5323 if (! NILP (xrm_string
))
5324 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
5326 xrm_option
= (unsigned char *) 0;
5328 /* Use this general default value to start with. */
5329 /* First remove .exe suffix from invocation-name - it looks ugly. */
5331 char basename
[ MAX_PATH
], *str
;
5333 strcpy (basename
, XSTRING (Vinvocation_name
)->data
);
5334 str
= strrchr (basename
, '.');
5336 Vinvocation_name
= build_string (basename
);
5338 Vx_resource_name
= Vinvocation_name
;
5340 validate_x_resource_name ();
5342 /* This is what opens the connection and sets x_current_display.
5343 This also initializes many symbols, such as those used for input. */
5344 dpyinfo
= w32_term_init (display
, xrm_option
,
5345 (char *) XSTRING (Vx_resource_name
)->data
);
5349 if (!NILP (must_succeed
))
5350 fatal ("Cannot connect to server %s.\n",
5351 XSTRING (display
)->data
);
5353 error ("Cannot connect to server %s", XSTRING (display
)->data
);
5358 XSETFASTINT (Vwindow_system_version
, 3);
5362 DEFUN ("x-close-connection", Fx_close_connection
,
5363 Sx_close_connection
, 1, 1, 0,
5364 "Close the connection to DISPLAY's server.\n\
5365 For DISPLAY, specify either a frame or a display name (a string).\n\
5366 If DISPLAY is nil, that stands for the selected frame's display.")
5368 Lisp_Object display
;
5370 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
5371 struct w32_display_info
*tail
;
5374 if (dpyinfo
->reference_count
> 0)
5375 error ("Display still has frames on it");
5378 /* Free the fonts in the font table. */
5379 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
5381 if (dpyinfo
->font_table
[i
].name
)
5382 free (dpyinfo
->font_table
[i
].name
);
5383 /* Don't free the full_name string;
5384 it is always shared with something else. */
5385 w32_unload_font (dpyinfo
, dpyinfo
->font_table
[i
].font
);
5387 x_destroy_all_bitmaps (dpyinfo
);
5389 x_delete_display (dpyinfo
);
5395 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
5396 "Return the list of display names that Emacs has connections to.")
5399 Lisp_Object tail
, result
;
5402 for (tail
= w32_display_name_list
; ! NILP (tail
); tail
= XCONS (tail
)->cdr
)
5403 result
= Fcons (XCONS (XCONS (tail
)->car
)->car
, result
);
5408 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
5409 "If ON is non-nil, report errors as soon as the erring request is made.\n\
5410 If ON is nil, allow buffering of requests.\n\
5411 This is a noop on W32 systems.\n\
5412 The optional second argument DISPLAY specifies which display to act on.\n\
5413 DISPLAY should be either a frame or a display name (a string).\n\
5414 If DISPLAY is omitted or nil, that stands for the selected frame's display.")
5416 Lisp_Object display
, on
;
5418 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
5424 /* These are the w32 specialized functions */
5426 DEFUN ("w32-select-font", Fw32_select_font
, Sw32_select_font
, 0, 1, 0,
5427 "This will display the W32 font dialog and return an X font string corresponding to the selection.")
5431 FRAME_PTR f
= check_x_frame (frame
);
5436 bzero (&cf
, sizeof (cf
));
5438 cf
.lStructSize
= sizeof (cf
);
5439 cf
.hwndOwner
= FRAME_W32_WINDOW (f
);
5440 cf
.Flags
= CF_FIXEDPITCHONLY
| CF_FORCEFONTEXIST
| CF_SCREENFONTS
;
5443 if (!ChooseFont (&cf
) || !w32_to_x_font (&lf
, buf
, 100))
5446 return build_string (buf
);
5449 DEFUN ("w32-send-sys-command", Fw32_send_sys_command
, Sw32_send_sys_command
, 1, 2, 0,
5450 "Send frame a Windows WM_SYSCOMMAND message of type COMMAND.\n\
5451 Some useful values for command are 0xf030 to maximise frame (0xf020\n\
5452 to minimize), 0xf120 to restore frame to original size, and 0xf100\n\
5453 to activate the menubar for keyboard access. 0xf140 activates the\n\
5454 screen saver if defined.\n\
5456 If optional parameter FRAME is not specified, use selected frame.")
5458 Lisp_Object command
, frame
;
5461 FRAME_PTR f
= check_x_frame (frame
);
5463 CHECK_NUMBER (command
, 0);
5465 PostMessage (FRAME_W32_WINDOW (f
), WM_SYSCOMMAND
, XINT (command
), 0);
5473 /* This is zero if not using MS-Windows. */
5476 /* The section below is built by the lisp expression at the top of the file,
5477 just above where these variables are declared. */
5478 /*&&& init symbols here &&&*/
5479 Qauto_raise
= intern ("auto-raise");
5480 staticpro (&Qauto_raise
);
5481 Qauto_lower
= intern ("auto-lower");
5482 staticpro (&Qauto_lower
);
5483 Qbackground_color
= intern ("background-color");
5484 staticpro (&Qbackground_color
);
5485 Qbar
= intern ("bar");
5487 Qborder_color
= intern ("border-color");
5488 staticpro (&Qborder_color
);
5489 Qborder_width
= intern ("border-width");
5490 staticpro (&Qborder_width
);
5491 Qbox
= intern ("box");
5493 Qcursor_color
= intern ("cursor-color");
5494 staticpro (&Qcursor_color
);
5495 Qcursor_type
= intern ("cursor-type");
5496 staticpro (&Qcursor_type
);
5497 Qforeground_color
= intern ("foreground-color");
5498 staticpro (&Qforeground_color
);
5499 Qgeometry
= intern ("geometry");
5500 staticpro (&Qgeometry
);
5501 Qicon_left
= intern ("icon-left");
5502 staticpro (&Qicon_left
);
5503 Qicon_top
= intern ("icon-top");
5504 staticpro (&Qicon_top
);
5505 Qicon_type
= intern ("icon-type");
5506 staticpro (&Qicon_type
);
5507 Qicon_name
= intern ("icon-name");
5508 staticpro (&Qicon_name
);
5509 Qinternal_border_width
= intern ("internal-border-width");
5510 staticpro (&Qinternal_border_width
);
5511 Qleft
= intern ("left");
5513 Qright
= intern ("right");
5514 staticpro (&Qright
);
5515 Qmouse_color
= intern ("mouse-color");
5516 staticpro (&Qmouse_color
);
5517 Qnone
= intern ("none");
5519 Qparent_id
= intern ("parent-id");
5520 staticpro (&Qparent_id
);
5521 Qscroll_bar_width
= intern ("scroll-bar-width");
5522 staticpro (&Qscroll_bar_width
);
5523 Qsuppress_icon
= intern ("suppress-icon");
5524 staticpro (&Qsuppress_icon
);
5525 Qtop
= intern ("top");
5527 Qundefined_color
= intern ("undefined-color");
5528 staticpro (&Qundefined_color
);
5529 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
5530 staticpro (&Qvertical_scroll_bars
);
5531 Qvisibility
= intern ("visibility");
5532 staticpro (&Qvisibility
);
5533 Qwindow_id
= intern ("window-id");
5534 staticpro (&Qwindow_id
);
5535 Qx_frame_parameter
= intern ("x-frame-parameter");
5536 staticpro (&Qx_frame_parameter
);
5537 Qx_resource_name
= intern ("x-resource-name");
5538 staticpro (&Qx_resource_name
);
5539 Quser_position
= intern ("user-position");
5540 staticpro (&Quser_position
);
5541 Quser_size
= intern ("user-size");
5542 staticpro (&Quser_size
);
5543 Qdisplay
= intern ("display");
5544 staticpro (&Qdisplay
);
5545 /* This is the end of symbol initialization. */
5547 Fput (Qundefined_color
, Qerror_conditions
,
5548 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
5549 Fput (Qundefined_color
, Qerror_message
,
5550 build_string ("Undefined color"));
5552 DEFVAR_LISP ("w32-color-map", &Vw32_color_map
,
5553 "A array of color name mappings for windows.");
5554 Vw32_color_map
= Qnil
;
5556 DEFVAR_LISP ("w32-pass-alt-to-system", &Vw32_pass_alt_to_system
,
5557 "Non-nil if alt key presses are passed on to Windows.\n\
5558 When non-nil, for example, alt pressed and released and then space will\n\
5559 open the System menu. When nil, Emacs silently swallows alt key events.");
5560 Vw32_pass_alt_to_system
= Qnil
;
5562 DEFVAR_LISP ("w32-alt-is-meta", &Vw32_alt_is_meta
,
5563 "Non-nil if the alt key is to be considered the same as the meta key.\n\
5564 When nil, Emacs will translate the alt key to the Alt modifier, and not Meta.");
5565 Vw32_alt_is_meta
= Qt
;
5567 DEFVAR_LISP ("w32-pass-optional-keys-to-system",
5568 &Vw32_pass_optional_keys_to_system
,
5569 "Non-nil if the 'optional' keys (left window, right window,\n\
5570 and application keys) are passed on to Windows.");
5571 Vw32_pass_optional_keys_to_system
= Qnil
;
5573 DEFVAR_LISP ("w32-enable-italics", &Vw32_enable_italics
,
5574 "Non-nil enables selection of artificially italicized fonts.");
5575 Vw32_enable_italics
= Qnil
;
5577 DEFVAR_LISP ("w32-enable-palette", &Vw32_enable_palette
,
5578 "Non-nil enables Windows palette management to map colors exactly.");
5579 Vw32_enable_palette
= Qt
;
5581 DEFVAR_INT ("w32-mouse-button-tolerance",
5582 &Vw32_mouse_button_tolerance
,
5583 "Analogue of double click interval for faking middle mouse events.\n\
5584 The value is the minimum time in milliseconds that must elapse between\n\
5585 left/right button down events before they are considered distinct events.\n\
5586 If both mouse buttons are depressed within this interval, a middle mouse\n\
5587 button down event is generated instead.");
5588 XSETINT (Vw32_mouse_button_tolerance
, GetDoubleClickTime () / 2);
5590 DEFVAR_INT ("w32-mouse-move-interval",
5591 &Vw32_mouse_move_interval
,
5592 "Minimum interval between mouse move events.\n\
5593 The value is the minimum time in milliseconds that must elapse between\n\
5594 successive mouse move (or scroll bar drag) events before they are\n\
5595 reported as lisp events.");
5596 XSETINT (Vw32_mouse_move_interval
, 50);
5598 init_x_parm_symbols ();
5600 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path
,
5601 "List of directories to search for bitmap files for w32.");
5602 Vx_bitmap_file_path
= decode_env_path ((char *) 0, "PATH");
5604 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
5605 "The shape of the pointer when over text.\n\
5606 Changing the value does not affect existing frames\n\
5607 unless you set the mouse color.");
5608 Vx_pointer_shape
= Qnil
;
5610 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
5611 "The name Emacs uses to look up resources; for internal use only.\n\
5612 `x-get-resource' uses this as the first component of the instance name\n\
5613 when requesting resource values.\n\
5614 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
5615 was invoked, or to the value specified with the `-name' or `-rn'\n\
5616 switches, if present.");
5617 Vx_resource_name
= Qnil
;
5619 Vx_nontext_pointer_shape
= Qnil
;
5621 Vx_mode_pointer_shape
= Qnil
;
5623 DEFVAR_INT ("x-sensitive-text-pointer-shape",
5624 &Vx_sensitive_text_pointer_shape
,
5625 "The shape of the pointer when over mouse-sensitive text.\n\
5626 This variable takes effect when you create a new frame\n\
5627 or when you set the mouse color.");
5628 Vx_sensitive_text_pointer_shape
= Qnil
;
5630 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
5631 "A string indicating the foreground color of the cursor box.");
5632 Vx_cursor_fore_pixel
= Qnil
;
5634 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
5635 "Non-nil if no window manager is in use.\n\
5636 Emacs doesn't try to figure this out; this is always nil\n\
5637 unless you set it to something else.");
5638 /* We don't have any way to find this out, so set it to nil
5639 and maybe the user would like to set it to t. */
5640 Vx_no_window_manager
= Qnil
;
5642 defsubr (&Sx_get_resource
);
5643 defsubr (&Sx_list_fonts
);
5644 defsubr (&Sx_display_color_p
);
5645 defsubr (&Sx_display_grayscale_p
);
5646 defsubr (&Sx_color_defined_p
);
5647 defsubr (&Sx_color_values
);
5648 defsubr (&Sx_server_max_request_size
);
5649 defsubr (&Sx_server_vendor
);
5650 defsubr (&Sx_server_version
);
5651 defsubr (&Sx_display_pixel_width
);
5652 defsubr (&Sx_display_pixel_height
);
5653 defsubr (&Sx_display_mm_width
);
5654 defsubr (&Sx_display_mm_height
);
5655 defsubr (&Sx_display_screens
);
5656 defsubr (&Sx_display_planes
);
5657 defsubr (&Sx_display_color_cells
);
5658 defsubr (&Sx_display_visual_class
);
5659 defsubr (&Sx_display_backing_store
);
5660 defsubr (&Sx_display_save_under
);
5661 defsubr (&Sx_parse_geometry
);
5662 defsubr (&Sx_create_frame
);
5663 defsubr (&Sx_open_connection
);
5664 defsubr (&Sx_close_connection
);
5665 defsubr (&Sx_display_list
);
5666 defsubr (&Sx_synchronize
);
5668 /* W32 specific functions */
5670 defsubr (&Sw32_focus_frame
);
5671 defsubr (&Sw32_select_font
);
5672 defsubr (&Sw32_define_rgb_color
);
5673 defsubr (&Sw32_default_color_map
);
5674 defsubr (&Sw32_load_color_file
);
5675 defsubr (&Sw32_send_sys_command
);
5684 button
= MessageBox (NULL
,
5685 "A fatal error has occurred!\n\n"
5686 "Select Abort to exit, Retry to debug, Ignore to continue",
5687 "Emacs Abort Dialog",
5688 MB_ICONEXCLAMATION
| MB_TASKMODAL
5689 | MB_SETFOREGROUND
| MB_ABORTRETRYIGNORE
);