1 /* Functions for the Win32 window system.
2 Copyright (C) 1989, 92, 93, 94, 95, 1996 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
21 /* Added by Kevin Gallo */
32 #include "dispextern.h"
34 #include "blockinput.h"
37 #include "termhooks.h"
42 extern void free_frame_menubar ();
43 extern struct scroll_bar
*x_window_to_scroll_bar ();
46 /* The colormap for converting color names to RGB values */
47 Lisp_Object Vwin32_color_map
;
49 /* Non nil if alt key presses are passed on to Windows. */
50 Lisp_Object Vwin32_pass_alt_to_system
;
52 /* Non nil if left window, right window, and application key events
53 are passed on to Windows. */
54 Lisp_Object Vwin32_pass_optional_keys_to_system
;
56 /* Switch to control whether we inhibit requests for italicised fonts (which
57 are synthesized, look ugly, and are trashed by cursor movement under NT). */
58 Lisp_Object Vwin32_enable_italics
;
60 /* Enable palette management. */
61 Lisp_Object Vwin32_enable_palette
;
63 /* Control how close left/right button down events must be to
64 be converted to a middle button down event. */
65 Lisp_Object Vwin32_mouse_button_tolerance
;
67 /* Minimum interval between mouse movement (and scroll bar drag)
68 events that are passed on to the event loop. */
69 Lisp_Object Vwin32_mouse_move_interval
;
71 /* The name we're using in resource queries. */
72 Lisp_Object Vx_resource_name
;
74 /* Non nil if no window manager is in use. */
75 Lisp_Object Vx_no_window_manager
;
77 /* The background and shape of the mouse pointer, and shape when not
78 over text or in the modeline. */
79 Lisp_Object Vx_pointer_shape
, Vx_nontext_pointer_shape
, Vx_mode_pointer_shape
;
80 /* The shape when over mouse-sensitive text. */
81 Lisp_Object Vx_sensitive_text_pointer_shape
;
83 /* Color of chars displayed in cursor box. */
84 Lisp_Object Vx_cursor_fore_pixel
;
86 /* Search path for bitmap files. */
87 Lisp_Object Vx_bitmap_file_path
;
89 /* Evaluate this expression to rebuild the section of syms_of_w32fns
90 that initializes and staticpros the symbols declared below. Note
91 that Emacs 18 has a bug that keeps C-x C-e from being able to
92 evaluate this expression.
95 ;; Accumulate a list of the symbols we want to initialize from the
96 ;; declarations at the top of the file.
97 (goto-char (point-min))
98 (search-forward "/\*&&& symbols declared here &&&*\/\n")
100 (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)")
102 (cons (buffer-substring (match-beginning 1) (match-end 1))
105 (setq symbol-list (nreverse symbol-list))
106 ;; Delete the section of syms_of_... where we initialize the symbols.
107 (search-forward "\n /\*&&& init symbols here &&&*\/\n")
108 (let ((start (point)))
109 (while (looking-at "^ Q")
111 (kill-region start (point)))
112 ;; Write a new symbol initialization section.
114 (insert (format " %s = intern (\"" (car symbol-list)))
115 (let ((start (point)))
116 (insert (substring (car symbol-list) 1))
117 (subst-char-in-region start (point) ?_ ?-))
118 (insert (format "\");\n staticpro (&%s);\n" (car symbol-list)))
119 (setq symbol-list (cdr symbol-list)))))
123 /*&&& symbols declared here &&&*/
124 Lisp_Object Qauto_raise
;
125 Lisp_Object Qauto_lower
;
126 Lisp_Object Qbackground_color
;
128 Lisp_Object Qborder_color
;
129 Lisp_Object Qborder_width
;
131 Lisp_Object Qcursor_color
;
132 Lisp_Object Qcursor_type
;
134 Lisp_Object Qforeground_color
;
135 Lisp_Object Qgeometry
;
136 Lisp_Object Qicon_left
;
137 Lisp_Object Qicon_top
;
138 Lisp_Object Qicon_type
;
139 Lisp_Object Qicon_name
;
140 Lisp_Object Qinternal_border_width
;
142 Lisp_Object Qmouse_color
;
144 Lisp_Object Qparent_id
;
145 Lisp_Object Qscroll_bar_width
;
146 Lisp_Object Qsuppress_icon
;
148 Lisp_Object Qundefined_color
;
149 Lisp_Object Qvertical_scroll_bars
;
150 Lisp_Object Qvisibility
;
151 Lisp_Object Qwindow_id
;
152 Lisp_Object Qx_frame_parameter
;
153 Lisp_Object Qx_resource_name
;
154 Lisp_Object Quser_position
;
155 Lisp_Object Quser_size
;
156 Lisp_Object Qdisplay
;
158 /* State variables for emulating a three button mouse. */
163 static int button_state
= 0;
164 static Win32Msg saved_mouse_button_msg
;
165 static unsigned mouse_button_timer
; /* non-zero when timer is active */
166 static Win32Msg saved_mouse_move_msg
;
167 static unsigned mouse_move_timer
;
169 #define MOUSE_BUTTON_ID 1
170 #define MOUSE_MOVE_ID 2
172 /* The below are defined in frame.c. */
173 extern Lisp_Object Qheight
, Qminibuffer
, Qname
, Qonly
, Qwidth
;
174 extern Lisp_Object Qunsplittable
, Qmenu_bar_lines
;
176 extern Lisp_Object Vwindow_system_version
;
178 extern Lisp_Object last_mouse_scroll_bar
;
179 extern int last_mouse_scroll_bar_pos
;
181 /* From win32term.c. */
182 extern Lisp_Object Vwin32_num_mouse_buttons
;
184 Time last_mouse_movement_time
;
187 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
188 and checking validity for Win32. */
191 check_x_frame (frame
)
200 CHECK_LIVE_FRAME (frame
, 0);
203 if (! FRAME_WIN32_P (f
))
204 error ("non-win32 frame used");
208 /* Let the user specify an display with a frame.
209 nil stands for the selected frame--or, if that is not a win32 frame,
210 the first display on the list. */
212 static struct win32_display_info
*
213 check_x_display_info (frame
)
218 if (FRAME_WIN32_P (selected_frame
))
219 return FRAME_WIN32_DISPLAY_INFO (selected_frame
);
221 return &one_win32_display_info
;
223 else if (STRINGP (frame
))
224 return x_display_info_for_name (frame
);
229 CHECK_LIVE_FRAME (frame
, 0);
231 if (! FRAME_WIN32_P (f
))
232 error ("non-win32 frame used");
233 return FRAME_WIN32_DISPLAY_INFO (f
);
237 /* Return the Emacs frame-object corresponding to an win32 window.
238 It could be the frame's main window or an icon window. */
240 /* This function can be called during GC, so use GC_xxx type test macros. */
243 x_window_to_frame (dpyinfo
, wdesc
)
244 struct win32_display_info
*dpyinfo
;
247 Lisp_Object tail
, frame
;
250 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
252 frame
= XCONS (tail
)->car
;
253 if (!GC_FRAMEP (frame
))
256 if (f
->output_data
.nothing
== 1
257 || FRAME_WIN32_DISPLAY_INFO (f
) != dpyinfo
)
259 if (FRAME_WIN32_WINDOW (f
) == wdesc
)
267 /* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
268 id, which is just an int that this section returns. Bitmaps are
269 reference counted so they can be shared among frames.
271 Bitmap indices are guaranteed to be > 0, so a negative number can
272 be used to indicate no bitmap.
274 If you use x_create_bitmap_from_data, then you must keep track of
275 the bitmaps yourself. That is, creating a bitmap from the same
276 data more than once will not be caught. */
279 /* Functions to access the contents of a bitmap, given an id. */
282 x_bitmap_height (f
, id
)
286 return FRAME_WIN32_DISPLAY_INFO (f
)->bitmaps
[id
- 1].height
;
290 x_bitmap_width (f
, id
)
294 return FRAME_WIN32_DISPLAY_INFO (f
)->bitmaps
[id
- 1].width
;
298 x_bitmap_pixmap (f
, id
)
302 return (int) FRAME_WIN32_DISPLAY_INFO (f
)->bitmaps
[id
- 1].pixmap
;
306 /* Allocate a new bitmap record. Returns index of new record. */
309 x_allocate_bitmap_record (f
)
312 struct win32_display_info
*dpyinfo
= FRAME_WIN32_DISPLAY_INFO (f
);
315 if (dpyinfo
->bitmaps
== NULL
)
317 dpyinfo
->bitmaps_size
= 10;
319 = (struct win32_bitmap_record
*) xmalloc (dpyinfo
->bitmaps_size
* sizeof (struct win32_bitmap_record
));
320 dpyinfo
->bitmaps_last
= 1;
324 if (dpyinfo
->bitmaps_last
< dpyinfo
->bitmaps_size
)
325 return ++dpyinfo
->bitmaps_last
;
327 for (i
= 0; i
< dpyinfo
->bitmaps_size
; ++i
)
328 if (dpyinfo
->bitmaps
[i
].refcount
== 0)
331 dpyinfo
->bitmaps_size
*= 2;
333 = (struct win32_bitmap_record
*) xrealloc (dpyinfo
->bitmaps
,
334 dpyinfo
->bitmaps_size
* sizeof (struct win32_bitmap_record
));
335 return ++dpyinfo
->bitmaps_last
;
338 /* Add one reference to the reference count of the bitmap with id ID. */
341 x_reference_bitmap (f
, id
)
345 ++FRAME_WIN32_DISPLAY_INFO (f
)->bitmaps
[id
- 1].refcount
;
348 /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
351 x_create_bitmap_from_data (f
, bits
, width
, height
)
354 unsigned int width
, height
;
356 struct win32_display_info
*dpyinfo
= FRAME_WIN32_DISPLAY_INFO (f
);
360 bitmap
= CreateBitmap (width
, height
,
361 FRAME_WIN32_DISPLAY_INFO (XFRAME (frame
))->n_planes
,
362 FRAME_WIN32_DISPLAY_INFO (XFRAME (frame
))->n_cbits
,
368 id
= x_allocate_bitmap_record (f
);
369 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
370 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
371 dpyinfo
->bitmaps
[id
- 1].hinst
= NULL
;
372 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
373 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
374 dpyinfo
->bitmaps
[id
- 1].height
= height
;
375 dpyinfo
->bitmaps
[id
- 1].width
= width
;
380 /* Create bitmap from file FILE for frame F. */
383 x_create_bitmap_from_file (f
, file
)
389 struct win32_display_info
*dpyinfo
= FRAME_WIN32_DISPLAY_INFO (f
);
390 unsigned int width
, height
;
392 int xhot
, yhot
, result
, id
;
398 /* Look for an existing bitmap with the same name. */
399 for (id
= 0; id
< dpyinfo
->bitmaps_last
; ++id
)
401 if (dpyinfo
->bitmaps
[id
].refcount
402 && dpyinfo
->bitmaps
[id
].file
403 && !strcmp (dpyinfo
->bitmaps
[id
].file
, (char *) XSTRING (file
)->data
))
405 ++dpyinfo
->bitmaps
[id
].refcount
;
410 /* Search bitmap-file-path for the file, if appropriate. */
411 fd
= openp (Vx_bitmap_file_path
, file
, "", &found
, 0);
416 filename
= (char *) XSTRING (found
)->data
;
418 hinst
= LoadLibraryEx (filename
, NULL
, LOAD_LIBRARY_AS_DATAFILE
);
424 result
= XReadBitmapFile (FRAME_WIN32_DISPLAY (f
), FRAME_WIN32_WINDOW (f
),
425 filename
, &width
, &height
, &bitmap
, &xhot
, &yhot
);
426 if (result
!= BitmapSuccess
)
429 id
= x_allocate_bitmap_record (f
);
430 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
431 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
432 dpyinfo
->bitmaps
[id
- 1].file
= (char *) xmalloc (XSTRING (file
)->size
+ 1);
433 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
434 dpyinfo
->bitmaps
[id
- 1].height
= height
;
435 dpyinfo
->bitmaps
[id
- 1].width
= width
;
436 strcpy (dpyinfo
->bitmaps
[id
- 1].file
, XSTRING (file
)->data
);
442 /* Remove reference to bitmap with id number ID. */
445 x_destroy_bitmap (f
, id
)
449 struct win32_display_info
*dpyinfo
= FRAME_WIN32_DISPLAY_INFO (f
);
453 --dpyinfo
->bitmaps
[id
- 1].refcount
;
454 if (dpyinfo
->bitmaps
[id
- 1].refcount
== 0)
457 DeleteObject (dpyinfo
->bitmaps
[id
- 1].pixmap
);
458 if (dpyinfo
->bitmaps
[id
- 1].file
)
460 free (dpyinfo
->bitmaps
[id
- 1].file
);
461 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
468 /* Free all the bitmaps for the display specified by DPYINFO. */
471 x_destroy_all_bitmaps (dpyinfo
)
472 struct win32_display_info
*dpyinfo
;
475 for (i
= 0; i
< dpyinfo
->bitmaps_last
; i
++)
476 if (dpyinfo
->bitmaps
[i
].refcount
> 0)
478 DeleteObject (dpyinfo
->bitmaps
[i
].pixmap
);
479 if (dpyinfo
->bitmaps
[i
].file
)
480 free (dpyinfo
->bitmaps
[i
].file
);
482 dpyinfo
->bitmaps_last
= 0;
485 /* Connect the frame-parameter names for Win32 frames
486 to the ways of passing the parameter values to the window system.
488 The name of a parameter, as a Lisp symbol,
489 has an `x-frame-parameter' property which is an integer in Lisp
490 but can be interpreted as an `enum x_frame_parm' in C. */
494 X_PARM_FOREGROUND_COLOR
,
495 X_PARM_BACKGROUND_COLOR
,
502 X_PARM_INTERNAL_BORDER_WIDTH
,
506 X_PARM_VERT_SCROLL_BAR
,
508 X_PARM_MENU_BAR_LINES
512 struct x_frame_parm_table
515 void (*setter
)( /* struct frame *frame, Lisp_Object val, oldval */ );
518 void x_set_foreground_color ();
519 void x_set_background_color ();
520 void x_set_mouse_color ();
521 void x_set_cursor_color ();
522 void x_set_border_color ();
523 void x_set_cursor_type ();
524 void x_set_icon_type ();
525 void x_set_icon_name ();
527 void x_set_border_width ();
528 void x_set_internal_border_width ();
529 void x_explicitly_set_name ();
530 void x_set_autoraise ();
531 void x_set_autolower ();
532 void x_set_vertical_scroll_bars ();
533 void x_set_visibility ();
534 void x_set_menu_bar_lines ();
535 void x_set_scroll_bar_width ();
536 void x_set_unsplittable ();
538 static struct x_frame_parm_table x_frame_parms
[] =
540 "foreground-color", x_set_foreground_color
,
541 "background-color", x_set_background_color
,
542 "mouse-color", x_set_mouse_color
,
543 "cursor-color", x_set_cursor_color
,
544 "border-color", x_set_border_color
,
545 "cursor-type", x_set_cursor_type
,
546 "icon-type", x_set_icon_type
,
547 "icon-name", x_set_icon_name
,
549 "border-width", x_set_border_width
,
550 "internal-border-width", x_set_internal_border_width
,
551 "name", x_explicitly_set_name
,
552 "auto-raise", x_set_autoraise
,
553 "auto-lower", x_set_autolower
,
554 "vertical-scroll-bars", x_set_vertical_scroll_bars
,
555 "visibility", x_set_visibility
,
556 "menu-bar-lines", x_set_menu_bar_lines
,
557 "scroll-bar-width", x_set_scroll_bar_width
,
558 "unsplittable", x_set_unsplittable
,
561 /* Attach the `x-frame-parameter' properties to
562 the Lisp symbol names of parameters relevant to Win32. */
564 init_x_parm_symbols ()
568 for (i
= 0; i
< sizeof (x_frame_parms
) / sizeof (x_frame_parms
[0]); i
++)
569 Fput (intern (x_frame_parms
[i
].name
), Qx_frame_parameter
,
573 /* Change the parameters of FRAME as specified by ALIST.
574 If a parameter is not specially recognized, do nothing;
575 otherwise call the `x_set_...' function for that parameter. */
578 x_set_frame_parameters (f
, alist
)
584 /* If both of these parameters are present, it's more efficient to
585 set them both at once. So we wait until we've looked at the
586 entire list before we set them. */
587 Lisp_Object width
, height
;
590 Lisp_Object left
, top
;
592 /* Same with these. */
593 Lisp_Object icon_left
, icon_top
;
595 /* Record in these vectors all the parms specified. */
599 int left_no_change
= 0, top_no_change
= 0;
600 int icon_left_no_change
= 0, icon_top_no_change
= 0;
603 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
606 parms
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
607 values
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
609 /* Extract parm names and values into those vectors. */
612 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
614 Lisp_Object elt
, prop
, val
;
617 parms
[i
] = Fcar (elt
);
618 values
[i
] = Fcdr (elt
);
622 width
= height
= top
= left
= Qunbound
;
623 icon_left
= icon_top
= Qunbound
;
625 /* Now process them in reverse of specified order. */
626 for (i
--; i
>= 0; i
--)
628 Lisp_Object prop
, val
;
633 if (EQ (prop
, Qwidth
))
635 else if (EQ (prop
, Qheight
))
637 else if (EQ (prop
, Qtop
))
639 else if (EQ (prop
, Qleft
))
641 else if (EQ (prop
, Qicon_top
))
643 else if (EQ (prop
, Qicon_left
))
647 register Lisp_Object param_index
, old_value
;
649 param_index
= Fget (prop
, Qx_frame_parameter
);
650 old_value
= get_frame_param (f
, prop
);
651 store_frame_param (f
, prop
, val
);
652 if (NATNUMP (param_index
)
653 && (XFASTINT (param_index
)
654 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
655 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
659 /* Don't die if just one of these was set. */
660 if (EQ (left
, Qunbound
))
663 if (f
->output_data
.win32
->left_pos
< 0)
664 left
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.win32
->left_pos
), Qnil
));
666 XSETINT (left
, f
->output_data
.win32
->left_pos
);
668 if (EQ (top
, Qunbound
))
671 if (f
->output_data
.win32
->top_pos
< 0)
672 top
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.win32
->top_pos
), Qnil
));
674 XSETINT (top
, f
->output_data
.win32
->top_pos
);
677 /* If one of the icon positions was not set, preserve or default it. */
678 if (EQ (icon_left
, Qunbound
) || ! INTEGERP (icon_left
))
680 icon_left_no_change
= 1;
681 icon_left
= Fcdr (Fassq (Qicon_left
, f
->param_alist
));
682 if (NILP (icon_left
))
683 XSETINT (icon_left
, 0);
685 if (EQ (icon_top
, Qunbound
) || ! INTEGERP (icon_top
))
687 icon_top_no_change
= 1;
688 icon_top
= Fcdr (Fassq (Qicon_top
, f
->param_alist
));
690 XSETINT (icon_top
, 0);
693 /* Don't die if just one of these was set. */
694 if (EQ (width
, Qunbound
))
695 XSETINT (width
, FRAME_WIDTH (f
));
696 if (EQ (height
, Qunbound
))
697 XSETINT (height
, FRAME_HEIGHT (f
));
699 /* Don't set these parameters unless they've been explicitly
700 specified. The window might be mapped or resized while we're in
701 this function, and we don't want to override that unless the lisp
702 code has asked for it.
704 Don't set these parameters unless they actually differ from the
705 window's current parameters; the window may not actually exist
710 check_frame_size (f
, &height
, &width
);
712 XSETFRAME (frame
, f
);
714 if ((NUMBERP (width
) && XINT (width
) != FRAME_WIDTH (f
))
715 || (NUMBERP (height
) && XINT (height
) != FRAME_HEIGHT (f
)))
716 Fset_frame_size (frame
, width
, height
);
718 if ((!NILP (left
) || !NILP (top
))
719 && ! (left_no_change
&& top_no_change
)
720 && ! (NUMBERP (left
) && XINT (left
) == f
->output_data
.win32
->left_pos
721 && NUMBERP (top
) && XINT (top
) == f
->output_data
.win32
->top_pos
))
726 /* Record the signs. */
727 f
->output_data
.win32
->size_hint_flags
&= ~ (XNegative
| YNegative
);
728 if (EQ (left
, Qminus
))
729 f
->output_data
.win32
->size_hint_flags
|= XNegative
;
730 else if (INTEGERP (left
))
732 leftpos
= XINT (left
);
734 f
->output_data
.win32
->size_hint_flags
|= XNegative
;
736 else if (CONSP (left
) && EQ (XCONS (left
)->car
, Qminus
)
737 && CONSP (XCONS (left
)->cdr
)
738 && INTEGERP (XCONS (XCONS (left
)->cdr
)->car
))
740 leftpos
= - XINT (XCONS (XCONS (left
)->cdr
)->car
);
741 f
->output_data
.win32
->size_hint_flags
|= XNegative
;
743 else if (CONSP (left
) && EQ (XCONS (left
)->car
, Qplus
)
744 && CONSP (XCONS (left
)->cdr
)
745 && INTEGERP (XCONS (XCONS (left
)->cdr
)->car
))
747 leftpos
= XINT (XCONS (XCONS (left
)->cdr
)->car
);
750 if (EQ (top
, Qminus
))
751 f
->output_data
.win32
->size_hint_flags
|= YNegative
;
752 else if (INTEGERP (top
))
756 f
->output_data
.win32
->size_hint_flags
|= YNegative
;
758 else if (CONSP (top
) && EQ (XCONS (top
)->car
, Qminus
)
759 && CONSP (XCONS (top
)->cdr
)
760 && INTEGERP (XCONS (XCONS (top
)->cdr
)->car
))
762 toppos
= - XINT (XCONS (XCONS (top
)->cdr
)->car
);
763 f
->output_data
.win32
->size_hint_flags
|= YNegative
;
765 else if (CONSP (top
) && EQ (XCONS (top
)->car
, Qplus
)
766 && CONSP (XCONS (top
)->cdr
)
767 && INTEGERP (XCONS (XCONS (top
)->cdr
)->car
))
769 toppos
= XINT (XCONS (XCONS (top
)->cdr
)->car
);
773 /* Store the numeric value of the position. */
774 f
->output_data
.win32
->top_pos
= toppos
;
775 f
->output_data
.win32
->left_pos
= leftpos
;
777 f
->output_data
.win32
->win_gravity
= NorthWestGravity
;
779 /* Actually set that position, and convert to absolute. */
780 x_set_offset (f
, leftpos
, toppos
, -1);
783 if ((!NILP (icon_left
) || !NILP (icon_top
))
784 && ! (icon_left_no_change
&& icon_top_no_change
))
785 x_wm_set_icon_position (f
, XINT (icon_left
), XINT (icon_top
));
789 /* Store the screen positions of frame F into XPTR and YPTR.
790 These are the positions of the containing window manager window,
791 not Emacs's own window. */
794 x_real_positions (f
, xptr
, yptr
)
803 GetClientRect(FRAME_WIN32_WINDOW(f
), &rect
);
804 AdjustWindowRect(&rect
, f
->output_data
.win32
->dwStyle
, FRAME_EXTERNAL_MENU_BAR(f
));
810 ClientToScreen (FRAME_WIN32_WINDOW(f
), &pt
);
816 /* Insert a description of internally-recorded parameters of frame X
817 into the parameter alist *ALISTPTR that is to be given to the user.
818 Only parameters that are specific to Win32
819 and whose values are not correctly recorded in the frame's
820 param_alist need to be considered here. */
822 x_report_frame_params (f
, alistptr
)
824 Lisp_Object
*alistptr
;
829 /* Represent negative positions (off the top or left screen edge)
830 in a way that Fmodify_frame_parameters will understand correctly. */
831 XSETINT (tem
, f
->output_data
.win32
->left_pos
);
832 if (f
->output_data
.win32
->left_pos
>= 0)
833 store_in_alist (alistptr
, Qleft
, tem
);
835 store_in_alist (alistptr
, Qleft
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
837 XSETINT (tem
, f
->output_data
.win32
->top_pos
);
838 if (f
->output_data
.win32
->top_pos
>= 0)
839 store_in_alist (alistptr
, Qtop
, tem
);
841 store_in_alist (alistptr
, Qtop
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
843 store_in_alist (alistptr
, Qborder_width
,
844 make_number (f
->output_data
.win32
->border_width
));
845 store_in_alist (alistptr
, Qinternal_border_width
,
846 make_number (f
->output_data
.win32
->internal_border_width
));
847 sprintf (buf
, "%ld", (long) FRAME_WIN32_WINDOW (f
));
848 store_in_alist (alistptr
, Qwindow_id
,
850 store_in_alist (alistptr
, Qicon_name
, f
->icon_name
);
851 FRAME_SAMPLE_VISIBILITY (f
);
852 store_in_alist (alistptr
, Qvisibility
,
853 (FRAME_VISIBLE_P (f
) ? Qt
854 : FRAME_ICONIFIED_P (f
) ? Qicon
: Qnil
));
855 store_in_alist (alistptr
, Qdisplay
,
856 XCONS (FRAME_WIN32_DISPLAY_INFO (f
)->name_list_element
)->car
);
860 DEFUN ("win32-define-rgb-color", Fwin32_define_rgb_color
, Swin32_define_rgb_color
, 4, 4, 0,
861 "Convert RGB numbers to a windows color reference and associate with NAME (a string).\n\
862 This adds or updates a named color to win32-color-map, making it available for use.\n\
863 The original entry's RGB ref is returned, or nil if the entry is new.")
864 (red
, green
, blue
, name
)
865 Lisp_Object red
, green
, blue
, name
;
868 Lisp_Object oldrgb
= Qnil
;
871 CHECK_NUMBER (red
, 0);
872 CHECK_NUMBER (green
, 0);
873 CHECK_NUMBER (blue
, 0);
874 CHECK_STRING (name
, 0);
876 XSET (rgb
, Lisp_Int
, RGB(XUINT (red
), XUINT (green
), XUINT (blue
)));
880 /* replace existing entry in win32-color-map or add new entry. */
881 entry
= Fassoc (name
, Vwin32_color_map
);
884 entry
= Fcons (name
, rgb
);
885 Vwin32_color_map
= Fcons (entry
, Vwin32_color_map
);
889 oldrgb
= Fcdr (entry
);
890 Fsetcdr (entry
, rgb
);
898 DEFUN ("win32-load-color-file", Fwin32_load_color_file
, Swin32_load_color_file
, 1, 1, 0,
899 "Create an alist of color entries from an external file (ie. rgb.txt).\n\
900 Assign this value to win32-color-map to replace the existing color map.\n\
902 The file should define one named RGB color per line like so:\
904 where R,G,B are numbers between 0 and 255 and name is an arbitrary string.")
906 Lisp_Object filename
;
909 Lisp_Object cmap
= Qnil
;
912 CHECK_STRING (filename
, 0);
913 abspath
= Fexpand_file_name (filename
, Qnil
);
915 fp
= fopen (XSTRING (filename
)->data
, "rt");
919 int red
, green
, blue
;
924 while (fgets (buf
, sizeof (buf
), fp
) != NULL
) {
925 if (sscanf (buf
, "%u %u %u %n", &red
, &green
, &blue
, &num
) == 3)
927 char *name
= buf
+ num
;
928 num
= strlen (name
) - 1;
929 if (name
[num
] == '\n')
931 cmap
= Fcons (Fcons (build_string (name
),
932 make_number (RGB (red
, green
, blue
))),
944 /* The default colors for the win32 color map */
945 typedef struct colormap_t
951 colormap_t win32_color_map
[] =
953 {"snow" , PALETTERGB (255,250,250)},
954 {"ghost white" , PALETTERGB (248,248,255)},
955 {"GhostWhite" , PALETTERGB (248,248,255)},
956 {"white smoke" , PALETTERGB (245,245,245)},
957 {"WhiteSmoke" , PALETTERGB (245,245,245)},
958 {"gainsboro" , PALETTERGB (220,220,220)},
959 {"floral white" , PALETTERGB (255,250,240)},
960 {"FloralWhite" , PALETTERGB (255,250,240)},
961 {"old lace" , PALETTERGB (253,245,230)},
962 {"OldLace" , PALETTERGB (253,245,230)},
963 {"linen" , PALETTERGB (250,240,230)},
964 {"antique white" , PALETTERGB (250,235,215)},
965 {"AntiqueWhite" , PALETTERGB (250,235,215)},
966 {"papaya whip" , PALETTERGB (255,239,213)},
967 {"PapayaWhip" , PALETTERGB (255,239,213)},
968 {"blanched almond" , PALETTERGB (255,235,205)},
969 {"BlanchedAlmond" , PALETTERGB (255,235,205)},
970 {"bisque" , PALETTERGB (255,228,196)},
971 {"peach puff" , PALETTERGB (255,218,185)},
972 {"PeachPuff" , PALETTERGB (255,218,185)},
973 {"navajo white" , PALETTERGB (255,222,173)},
974 {"NavajoWhite" , PALETTERGB (255,222,173)},
975 {"moccasin" , PALETTERGB (255,228,181)},
976 {"cornsilk" , PALETTERGB (255,248,220)},
977 {"ivory" , PALETTERGB (255,255,240)},
978 {"lemon chiffon" , PALETTERGB (255,250,205)},
979 {"LemonChiffon" , PALETTERGB (255,250,205)},
980 {"seashell" , PALETTERGB (255,245,238)},
981 {"honeydew" , PALETTERGB (240,255,240)},
982 {"mint cream" , PALETTERGB (245,255,250)},
983 {"MintCream" , PALETTERGB (245,255,250)},
984 {"azure" , PALETTERGB (240,255,255)},
985 {"alice blue" , PALETTERGB (240,248,255)},
986 {"AliceBlue" , PALETTERGB (240,248,255)},
987 {"lavender" , PALETTERGB (230,230,250)},
988 {"lavender blush" , PALETTERGB (255,240,245)},
989 {"LavenderBlush" , PALETTERGB (255,240,245)},
990 {"misty rose" , PALETTERGB (255,228,225)},
991 {"MistyRose" , PALETTERGB (255,228,225)},
992 {"white" , PALETTERGB (255,255,255)},
993 {"black" , PALETTERGB ( 0, 0, 0)},
994 {"dark slate gray" , PALETTERGB ( 47, 79, 79)},
995 {"DarkSlateGray" , PALETTERGB ( 47, 79, 79)},
996 {"dark slate grey" , PALETTERGB ( 47, 79, 79)},
997 {"DarkSlateGrey" , PALETTERGB ( 47, 79, 79)},
998 {"dim gray" , PALETTERGB (105,105,105)},
999 {"DimGray" , PALETTERGB (105,105,105)},
1000 {"dim grey" , PALETTERGB (105,105,105)},
1001 {"DimGrey" , PALETTERGB (105,105,105)},
1002 {"slate gray" , PALETTERGB (112,128,144)},
1003 {"SlateGray" , PALETTERGB (112,128,144)},
1004 {"slate grey" , PALETTERGB (112,128,144)},
1005 {"SlateGrey" , PALETTERGB (112,128,144)},
1006 {"light slate gray" , PALETTERGB (119,136,153)},
1007 {"LightSlateGray" , PALETTERGB (119,136,153)},
1008 {"light slate grey" , PALETTERGB (119,136,153)},
1009 {"LightSlateGrey" , PALETTERGB (119,136,153)},
1010 {"gray" , PALETTERGB (190,190,190)},
1011 {"grey" , PALETTERGB (190,190,190)},
1012 {"light grey" , PALETTERGB (211,211,211)},
1013 {"LightGrey" , PALETTERGB (211,211,211)},
1014 {"light gray" , PALETTERGB (211,211,211)},
1015 {"LightGray" , PALETTERGB (211,211,211)},
1016 {"midnight blue" , PALETTERGB ( 25, 25,112)},
1017 {"MidnightBlue" , PALETTERGB ( 25, 25,112)},
1018 {"navy" , PALETTERGB ( 0, 0,128)},
1019 {"navy blue" , PALETTERGB ( 0, 0,128)},
1020 {"NavyBlue" , PALETTERGB ( 0, 0,128)},
1021 {"cornflower blue" , PALETTERGB (100,149,237)},
1022 {"CornflowerBlue" , PALETTERGB (100,149,237)},
1023 {"dark slate blue" , PALETTERGB ( 72, 61,139)},
1024 {"DarkSlateBlue" , PALETTERGB ( 72, 61,139)},
1025 {"slate blue" , PALETTERGB (106, 90,205)},
1026 {"SlateBlue" , PALETTERGB (106, 90,205)},
1027 {"medium slate blue" , PALETTERGB (123,104,238)},
1028 {"MediumSlateBlue" , PALETTERGB (123,104,238)},
1029 {"light slate blue" , PALETTERGB (132,112,255)},
1030 {"LightSlateBlue" , PALETTERGB (132,112,255)},
1031 {"medium blue" , PALETTERGB ( 0, 0,205)},
1032 {"MediumBlue" , PALETTERGB ( 0, 0,205)},
1033 {"royal blue" , PALETTERGB ( 65,105,225)},
1034 {"RoyalBlue" , PALETTERGB ( 65,105,225)},
1035 {"blue" , PALETTERGB ( 0, 0,255)},
1036 {"dodger blue" , PALETTERGB ( 30,144,255)},
1037 {"DodgerBlue" , PALETTERGB ( 30,144,255)},
1038 {"deep sky blue" , PALETTERGB ( 0,191,255)},
1039 {"DeepSkyBlue" , PALETTERGB ( 0,191,255)},
1040 {"sky blue" , PALETTERGB (135,206,235)},
1041 {"SkyBlue" , PALETTERGB (135,206,235)},
1042 {"light sky blue" , PALETTERGB (135,206,250)},
1043 {"LightSkyBlue" , PALETTERGB (135,206,250)},
1044 {"steel blue" , PALETTERGB ( 70,130,180)},
1045 {"SteelBlue" , PALETTERGB ( 70,130,180)},
1046 {"light steel blue" , PALETTERGB (176,196,222)},
1047 {"LightSteelBlue" , PALETTERGB (176,196,222)},
1048 {"light blue" , PALETTERGB (173,216,230)},
1049 {"LightBlue" , PALETTERGB (173,216,230)},
1050 {"powder blue" , PALETTERGB (176,224,230)},
1051 {"PowderBlue" , PALETTERGB (176,224,230)},
1052 {"pale turquoise" , PALETTERGB (175,238,238)},
1053 {"PaleTurquoise" , PALETTERGB (175,238,238)},
1054 {"dark turquoise" , PALETTERGB ( 0,206,209)},
1055 {"DarkTurquoise" , PALETTERGB ( 0,206,209)},
1056 {"medium turquoise" , PALETTERGB ( 72,209,204)},
1057 {"MediumTurquoise" , PALETTERGB ( 72,209,204)},
1058 {"turquoise" , PALETTERGB ( 64,224,208)},
1059 {"cyan" , PALETTERGB ( 0,255,255)},
1060 {"light cyan" , PALETTERGB (224,255,255)},
1061 {"LightCyan" , PALETTERGB (224,255,255)},
1062 {"cadet blue" , PALETTERGB ( 95,158,160)},
1063 {"CadetBlue" , PALETTERGB ( 95,158,160)},
1064 {"medium aquamarine" , PALETTERGB (102,205,170)},
1065 {"MediumAquamarine" , PALETTERGB (102,205,170)},
1066 {"aquamarine" , PALETTERGB (127,255,212)},
1067 {"dark green" , PALETTERGB ( 0,100, 0)},
1068 {"DarkGreen" , PALETTERGB ( 0,100, 0)},
1069 {"dark olive green" , PALETTERGB ( 85,107, 47)},
1070 {"DarkOliveGreen" , PALETTERGB ( 85,107, 47)},
1071 {"dark sea green" , PALETTERGB (143,188,143)},
1072 {"DarkSeaGreen" , PALETTERGB (143,188,143)},
1073 {"sea green" , PALETTERGB ( 46,139, 87)},
1074 {"SeaGreen" , PALETTERGB ( 46,139, 87)},
1075 {"medium sea green" , PALETTERGB ( 60,179,113)},
1076 {"MediumSeaGreen" , PALETTERGB ( 60,179,113)},
1077 {"light sea green" , PALETTERGB ( 32,178,170)},
1078 {"LightSeaGreen" , PALETTERGB ( 32,178,170)},
1079 {"pale green" , PALETTERGB (152,251,152)},
1080 {"PaleGreen" , PALETTERGB (152,251,152)},
1081 {"spring green" , PALETTERGB ( 0,255,127)},
1082 {"SpringGreen" , PALETTERGB ( 0,255,127)},
1083 {"lawn green" , PALETTERGB (124,252, 0)},
1084 {"LawnGreen" , PALETTERGB (124,252, 0)},
1085 {"green" , PALETTERGB ( 0,255, 0)},
1086 {"chartreuse" , PALETTERGB (127,255, 0)},
1087 {"medium spring green" , PALETTERGB ( 0,250,154)},
1088 {"MediumSpringGreen" , PALETTERGB ( 0,250,154)},
1089 {"green yellow" , PALETTERGB (173,255, 47)},
1090 {"GreenYellow" , PALETTERGB (173,255, 47)},
1091 {"lime green" , PALETTERGB ( 50,205, 50)},
1092 {"LimeGreen" , PALETTERGB ( 50,205, 50)},
1093 {"yellow green" , PALETTERGB (154,205, 50)},
1094 {"YellowGreen" , PALETTERGB (154,205, 50)},
1095 {"forest green" , PALETTERGB ( 34,139, 34)},
1096 {"ForestGreen" , PALETTERGB ( 34,139, 34)},
1097 {"olive drab" , PALETTERGB (107,142, 35)},
1098 {"OliveDrab" , PALETTERGB (107,142, 35)},
1099 {"dark khaki" , PALETTERGB (189,183,107)},
1100 {"DarkKhaki" , PALETTERGB (189,183,107)},
1101 {"khaki" , PALETTERGB (240,230,140)},
1102 {"pale goldenrod" , PALETTERGB (238,232,170)},
1103 {"PaleGoldenrod" , PALETTERGB (238,232,170)},
1104 {"light goldenrod yellow" , PALETTERGB (250,250,210)},
1105 {"LightGoldenrodYellow" , PALETTERGB (250,250,210)},
1106 {"light yellow" , PALETTERGB (255,255,224)},
1107 {"LightYellow" , PALETTERGB (255,255,224)},
1108 {"yellow" , PALETTERGB (255,255, 0)},
1109 {"gold" , PALETTERGB (255,215, 0)},
1110 {"light goldenrod" , PALETTERGB (238,221,130)},
1111 {"LightGoldenrod" , PALETTERGB (238,221,130)},
1112 {"goldenrod" , PALETTERGB (218,165, 32)},
1113 {"dark goldenrod" , PALETTERGB (184,134, 11)},
1114 {"DarkGoldenrod" , PALETTERGB (184,134, 11)},
1115 {"rosy brown" , PALETTERGB (188,143,143)},
1116 {"RosyBrown" , PALETTERGB (188,143,143)},
1117 {"indian red" , PALETTERGB (205, 92, 92)},
1118 {"IndianRed" , PALETTERGB (205, 92, 92)},
1119 {"saddle brown" , PALETTERGB (139, 69, 19)},
1120 {"SaddleBrown" , PALETTERGB (139, 69, 19)},
1121 {"sienna" , PALETTERGB (160, 82, 45)},
1122 {"peru" , PALETTERGB (205,133, 63)},
1123 {"burlywood" , PALETTERGB (222,184,135)},
1124 {"beige" , PALETTERGB (245,245,220)},
1125 {"wheat" , PALETTERGB (245,222,179)},
1126 {"sandy brown" , PALETTERGB (244,164, 96)},
1127 {"SandyBrown" , PALETTERGB (244,164, 96)},
1128 {"tan" , PALETTERGB (210,180,140)},
1129 {"chocolate" , PALETTERGB (210,105, 30)},
1130 {"firebrick" , PALETTERGB (178,34, 34)},
1131 {"brown" , PALETTERGB (165,42, 42)},
1132 {"dark salmon" , PALETTERGB (233,150,122)},
1133 {"DarkSalmon" , PALETTERGB (233,150,122)},
1134 {"salmon" , PALETTERGB (250,128,114)},
1135 {"light salmon" , PALETTERGB (255,160,122)},
1136 {"LightSalmon" , PALETTERGB (255,160,122)},
1137 {"orange" , PALETTERGB (255,165, 0)},
1138 {"dark orange" , PALETTERGB (255,140, 0)},
1139 {"DarkOrange" , PALETTERGB (255,140, 0)},
1140 {"coral" , PALETTERGB (255,127, 80)},
1141 {"light coral" , PALETTERGB (240,128,128)},
1142 {"LightCoral" , PALETTERGB (240,128,128)},
1143 {"tomato" , PALETTERGB (255, 99, 71)},
1144 {"orange red" , PALETTERGB (255, 69, 0)},
1145 {"OrangeRed" , PALETTERGB (255, 69, 0)},
1146 {"red" , PALETTERGB (255, 0, 0)},
1147 {"hot pink" , PALETTERGB (255,105,180)},
1148 {"HotPink" , PALETTERGB (255,105,180)},
1149 {"deep pink" , PALETTERGB (255, 20,147)},
1150 {"DeepPink" , PALETTERGB (255, 20,147)},
1151 {"pink" , PALETTERGB (255,192,203)},
1152 {"light pink" , PALETTERGB (255,182,193)},
1153 {"LightPink" , PALETTERGB (255,182,193)},
1154 {"pale violet red" , PALETTERGB (219,112,147)},
1155 {"PaleVioletRed" , PALETTERGB (219,112,147)},
1156 {"maroon" , PALETTERGB (176, 48, 96)},
1157 {"medium violet red" , PALETTERGB (199, 21,133)},
1158 {"MediumVioletRed" , PALETTERGB (199, 21,133)},
1159 {"violet red" , PALETTERGB (208, 32,144)},
1160 {"VioletRed" , PALETTERGB (208, 32,144)},
1161 {"magenta" , PALETTERGB (255, 0,255)},
1162 {"violet" , PALETTERGB (238,130,238)},
1163 {"plum" , PALETTERGB (221,160,221)},
1164 {"orchid" , PALETTERGB (218,112,214)},
1165 {"medium orchid" , PALETTERGB (186, 85,211)},
1166 {"MediumOrchid" , PALETTERGB (186, 85,211)},
1167 {"dark orchid" , PALETTERGB (153, 50,204)},
1168 {"DarkOrchid" , PALETTERGB (153, 50,204)},
1169 {"dark violet" , PALETTERGB (148, 0,211)},
1170 {"DarkViolet" , PALETTERGB (148, 0,211)},
1171 {"blue violet" , PALETTERGB (138, 43,226)},
1172 {"BlueViolet" , PALETTERGB (138, 43,226)},
1173 {"purple" , PALETTERGB (160, 32,240)},
1174 {"medium purple" , PALETTERGB (147,112,219)},
1175 {"MediumPurple" , PALETTERGB (147,112,219)},
1176 {"thistle" , PALETTERGB (216,191,216)},
1177 {"gray0" , PALETTERGB ( 0, 0, 0)},
1178 {"grey0" , PALETTERGB ( 0, 0, 0)},
1179 {"dark grey" , PALETTERGB (169,169,169)},
1180 {"DarkGrey" , PALETTERGB (169,169,169)},
1181 {"dark gray" , PALETTERGB (169,169,169)},
1182 {"DarkGray" , PALETTERGB (169,169,169)},
1183 {"dark blue" , PALETTERGB ( 0, 0,139)},
1184 {"DarkBlue" , PALETTERGB ( 0, 0,139)},
1185 {"dark cyan" , PALETTERGB ( 0,139,139)},
1186 {"DarkCyan" , PALETTERGB ( 0,139,139)},
1187 {"dark magenta" , PALETTERGB (139, 0,139)},
1188 {"DarkMagenta" , PALETTERGB (139, 0,139)},
1189 {"dark red" , PALETTERGB (139, 0, 0)},
1190 {"DarkRed" , PALETTERGB (139, 0, 0)},
1191 {"light green" , PALETTERGB (144,238,144)},
1192 {"LightGreen" , PALETTERGB (144,238,144)},
1195 DEFUN ("win32-default-color-map", Fwin32_default_color_map
, Swin32_default_color_map
,
1196 0, 0, 0, "Return the default color map.")
1200 colormap_t
*pc
= win32_color_map
;
1207 for (i
= 0; i
< sizeof (win32_color_map
) / sizeof (win32_color_map
[0]);
1209 cmap
= Fcons (Fcons (build_string (pc
->name
),
1210 make_number (pc
->colorref
)),
1219 win32_to_x_color (rgb
)
1224 CHECK_NUMBER (rgb
, 0);
1228 color
= Frassq (rgb
, Vwin32_color_map
);
1233 return (Fcar (color
));
1239 x_to_win32_color (colorname
)
1242 register Lisp_Object tail
, ret
= Qnil
;
1246 for (tail
= Vwin32_color_map
; !NILP (tail
); tail
= Fcdr (tail
))
1248 register Lisp_Object elt
, tem
;
1251 if (!CONSP (elt
)) continue;
1255 if (lstrcmpi (XSTRING (tem
)->data
, colorname
) == 0)
1257 ret
= XUINT(Fcdr (elt
));
1271 win32_regenerate_palette (FRAME_PTR f
)
1273 struct win32_palette_entry
* list
;
1274 LOGPALETTE
* log_palette
;
1275 HPALETTE new_palette
;
1278 /* don't bother trying to create palette if not supported */
1279 if (! FRAME_WIN32_DISPLAY_INFO (f
)->has_palette
)
1282 log_palette
= (LOGPALETTE
*)
1283 alloca (sizeof (LOGPALETTE
) +
1284 FRAME_WIN32_DISPLAY_INFO (f
)->num_colors
* sizeof (PALETTEENTRY
));
1285 log_palette
->palVersion
= 0x300;
1286 log_palette
->palNumEntries
= FRAME_WIN32_DISPLAY_INFO (f
)->num_colors
;
1288 list
= FRAME_WIN32_DISPLAY_INFO (f
)->color_list
;
1290 i
< FRAME_WIN32_DISPLAY_INFO (f
)->num_colors
;
1291 i
++, list
= list
->next
)
1292 log_palette
->palPalEntry
[i
] = list
->entry
;
1294 new_palette
= CreatePalette (log_palette
);
1298 if (FRAME_WIN32_DISPLAY_INFO (f
)->palette
)
1299 DeleteObject (FRAME_WIN32_DISPLAY_INFO (f
)->palette
);
1300 FRAME_WIN32_DISPLAY_INFO (f
)->palette
= new_palette
;
1302 /* Realize display palette and garbage all frames. */
1303 release_frame_dc (f
, get_frame_dc (f
));
1308 #define WIN32_COLOR(pe) RGB (pe.peRed, pe.peGreen, pe.peBlue)
1309 #define SET_WIN32_COLOR(pe, color) \
1312 pe.peRed = GetRValue (color); \
1313 pe.peGreen = GetGValue (color); \
1314 pe.peBlue = GetBValue (color); \
1319 /* Keep these around in case we ever want to track color usage. */
1321 win32_map_color (FRAME_PTR f
, COLORREF color
)
1323 struct win32_palette_entry
* list
= FRAME_WIN32_DISPLAY_INFO (f
)->color_list
;
1325 if (NILP (Vwin32_enable_palette
))
1328 /* check if color is already mapped */
1331 if (WIN32_COLOR (list
->entry
) == color
)
1339 /* not already mapped, so add to list and recreate Windows palette */
1340 list
= (struct win32_palette_entry
*)
1341 xmalloc (sizeof (struct win32_palette_entry
));
1342 SET_WIN32_COLOR (list
->entry
, color
);
1344 list
->next
= FRAME_WIN32_DISPLAY_INFO (f
)->color_list
;
1345 FRAME_WIN32_DISPLAY_INFO (f
)->color_list
= list
;
1346 FRAME_WIN32_DISPLAY_INFO (f
)->num_colors
++;
1348 /* set flag that palette must be regenerated */
1349 FRAME_WIN32_DISPLAY_INFO (f
)->regen_palette
= TRUE
;
1353 win32_unmap_color (FRAME_PTR f
, COLORREF color
)
1355 struct win32_palette_entry
* list
= FRAME_WIN32_DISPLAY_INFO (f
)->color_list
;
1356 struct win32_palette_entry
**prev
= &FRAME_WIN32_DISPLAY_INFO (f
)->color_list
;
1358 if (NILP (Vwin32_enable_palette
))
1361 /* check if color is already mapped */
1364 if (WIN32_COLOR (list
->entry
) == color
)
1366 if (--list
->refcount
== 0)
1370 FRAME_WIN32_DISPLAY_INFO (f
)->num_colors
--;
1380 /* set flag that palette must be regenerated */
1381 FRAME_WIN32_DISPLAY_INFO (f
)->regen_palette
= TRUE
;
1385 /* Decide if color named COLOR is valid for the display associated with
1386 the selected frame; if so, return the rgb values in COLOR_DEF.
1387 If ALLOC is nonzero, allocate a new colormap cell. */
1390 defined_color (f
, color
, color_def
, alloc
)
1393 COLORREF
*color_def
;
1396 register Lisp_Object tem
;
1398 tem
= x_to_win32_color (color
);
1402 if (!NILP (Vwin32_enable_palette
))
1404 struct win32_palette_entry
* entry
=
1405 FRAME_WIN32_DISPLAY_INFO (f
)->color_list
;
1406 struct win32_palette_entry
** prev
=
1407 &FRAME_WIN32_DISPLAY_INFO (f
)->color_list
;
1409 /* check if color is already mapped */
1412 if (WIN32_COLOR (entry
->entry
) == XUINT (tem
))
1414 prev
= &entry
->next
;
1415 entry
= entry
->next
;
1418 if (entry
== NULL
&& alloc
)
1420 /* not already mapped, so add to list */
1421 entry
= (struct win32_palette_entry
*)
1422 xmalloc (sizeof (struct win32_palette_entry
));
1423 SET_WIN32_COLOR (entry
->entry
, XUINT (tem
));
1426 FRAME_WIN32_DISPLAY_INFO (f
)->num_colors
++;
1428 /* set flag that palette must be regenerated */
1429 FRAME_WIN32_DISPLAY_INFO (f
)->regen_palette
= TRUE
;
1432 /* Ensure COLORREF value is snapped to nearest color in (default)
1433 palette by simulating the PALETTERGB macro. This works whether
1434 or not the display device has a palette. */
1435 *color_def
= XUINT (tem
) | 0x2000000;
1444 /* Given a string ARG naming a color, compute a pixel value from it
1445 suitable for screen F.
1446 If F is not a color screen, return DEF (default) regardless of what
1450 x_decode_color (f
, arg
, def
)
1457 CHECK_STRING (arg
, 0);
1459 if (strcmp (XSTRING (arg
)->data
, "black") == 0)
1460 return BLACK_PIX_DEFAULT (f
);
1461 else if (strcmp (XSTRING (arg
)->data
, "white") == 0)
1462 return WHITE_PIX_DEFAULT (f
);
1464 if ((FRAME_WIN32_DISPLAY_INFO (f
)->n_planes
* FRAME_WIN32_DISPLAY_INFO (f
)->n_cbits
) == 1)
1467 /* defined_color is responsible for coping with failures
1468 by looking for a near-miss. */
1469 if (defined_color (f
, XSTRING (arg
)->data
, &cdef
, 1))
1472 /* defined_color failed; return an ultimate default. */
1476 /* Functions called only from `x_set_frame_param'
1477 to set individual parameters.
1479 If FRAME_WIN32_WINDOW (f) is 0,
1480 the frame is being created and its window does not exist yet.
1481 In that case, just record the parameter's new value
1482 in the standard place; do not attempt to change the window. */
1485 x_set_foreground_color (f
, arg
, oldval
)
1487 Lisp_Object arg
, oldval
;
1489 f
->output_data
.win32
->foreground_pixel
1490 = x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1492 if (FRAME_WIN32_WINDOW (f
) != 0)
1494 recompute_basic_faces (f
);
1495 if (FRAME_VISIBLE_P (f
))
1501 x_set_background_color (f
, arg
, oldval
)
1503 Lisp_Object arg
, oldval
;
1508 f
->output_data
.win32
->background_pixel
1509 = x_decode_color (f
, arg
, WHITE_PIX_DEFAULT (f
));
1511 if (FRAME_WIN32_WINDOW (f
) != 0)
1513 SetWindowLong (FRAME_WIN32_WINDOW (f
), WND_BACKGROUND_INDEX
, f
->output_data
.win32
->background_pixel
);
1515 recompute_basic_faces (f
);
1517 if (FRAME_VISIBLE_P (f
))
1523 x_set_mouse_color (f
, arg
, oldval
)
1525 Lisp_Object arg
, oldval
;
1528 Cursor cursor
, nontext_cursor
, mode_cursor
, cross_cursor
;
1532 if (!EQ (Qnil
, arg
))
1533 f
->output_data
.win32
->mouse_pixel
1534 = x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1535 mask_color
= f
->output_data
.win32
->background_pixel
;
1536 /* No invisible pointers. */
1537 if (mask_color
== f
->output_data
.win32
->mouse_pixel
1538 && mask_color
== f
->output_data
.win32
->background_pixel
)
1539 f
->output_data
.win32
->mouse_pixel
= f
->output_data
.win32
->foreground_pixel
;
1544 /* It's not okay to crash if the user selects a screwy cursor. */
1545 x_catch_errors (FRAME_WIN32_DISPLAY (f
));
1547 if (!EQ (Qnil
, Vx_pointer_shape
))
1549 CHECK_NUMBER (Vx_pointer_shape
, 0);
1550 cursor
= XCreateFontCursor (FRAME_WIN32_DISPLAY (f
), XINT (Vx_pointer_shape
));
1553 cursor
= XCreateFontCursor (FRAME_WIN32_DISPLAY (f
), XC_xterm
);
1554 x_check_errors (FRAME_WIN32_DISPLAY (f
), "bad text pointer cursor: %s");
1556 if (!EQ (Qnil
, Vx_nontext_pointer_shape
))
1558 CHECK_NUMBER (Vx_nontext_pointer_shape
, 0);
1559 nontext_cursor
= XCreateFontCursor (FRAME_WIN32_DISPLAY (f
),
1560 XINT (Vx_nontext_pointer_shape
));
1563 nontext_cursor
= XCreateFontCursor (FRAME_WIN32_DISPLAY (f
), XC_left_ptr
);
1564 x_check_errors (FRAME_WIN32_DISPLAY (f
), "bad nontext pointer cursor: %s");
1566 if (!EQ (Qnil
, Vx_mode_pointer_shape
))
1568 CHECK_NUMBER (Vx_mode_pointer_shape
, 0);
1569 mode_cursor
= XCreateFontCursor (FRAME_WIN32_DISPLAY (f
),
1570 XINT (Vx_mode_pointer_shape
));
1573 mode_cursor
= XCreateFontCursor (FRAME_WIN32_DISPLAY (f
), XC_xterm
);
1574 x_check_errors (FRAME_WIN32_DISPLAY (f
), "bad modeline pointer cursor: %s");
1576 if (!EQ (Qnil
, Vx_sensitive_text_pointer_shape
))
1578 CHECK_NUMBER (Vx_sensitive_text_pointer_shape
, 0);
1580 = XCreateFontCursor (FRAME_WIN32_DISPLAY (f
),
1581 XINT (Vx_sensitive_text_pointer_shape
));
1584 cross_cursor
= XCreateFontCursor (FRAME_WIN32_DISPLAY (f
), XC_crosshair
);
1586 /* Check and report errors with the above calls. */
1587 x_check_errors (FRAME_WIN32_DISPLAY (f
), "can't set cursor shape: %s");
1588 x_uncatch_errors (FRAME_WIN32_DISPLAY (f
));
1591 XColor fore_color
, back_color
;
1593 fore_color
.pixel
= f
->output_data
.win32
->mouse_pixel
;
1594 back_color
.pixel
= mask_color
;
1595 XQueryColor (FRAME_WIN32_DISPLAY (f
),
1596 DefaultColormap (FRAME_WIN32_DISPLAY (f
),
1597 DefaultScreen (FRAME_WIN32_DISPLAY (f
))),
1599 XQueryColor (FRAME_WIN32_DISPLAY (f
),
1600 DefaultColormap (FRAME_WIN32_DISPLAY (f
),
1601 DefaultScreen (FRAME_WIN32_DISPLAY (f
))),
1603 XRecolorCursor (FRAME_WIN32_DISPLAY (f
), cursor
,
1604 &fore_color
, &back_color
);
1605 XRecolorCursor (FRAME_WIN32_DISPLAY (f
), nontext_cursor
,
1606 &fore_color
, &back_color
);
1607 XRecolorCursor (FRAME_WIN32_DISPLAY (f
), mode_cursor
,
1608 &fore_color
, &back_color
);
1609 XRecolorCursor (FRAME_WIN32_DISPLAY (f
), cross_cursor
,
1610 &fore_color
, &back_color
);
1613 if (FRAME_WIN32_WINDOW (f
) != 0)
1615 XDefineCursor (FRAME_WIN32_DISPLAY (f
), FRAME_WIN32_WINDOW (f
), cursor
);
1618 if (cursor
!= f
->output_data
.win32
->text_cursor
&& f
->output_data
.win32
->text_cursor
!= 0)
1619 XFreeCursor (FRAME_WIN32_DISPLAY (f
), f
->output_data
.win32
->text_cursor
);
1620 f
->output_data
.win32
->text_cursor
= cursor
;
1622 if (nontext_cursor
!= f
->output_data
.win32
->nontext_cursor
1623 && f
->output_data
.win32
->nontext_cursor
!= 0)
1624 XFreeCursor (FRAME_WIN32_DISPLAY (f
), f
->output_data
.win32
->nontext_cursor
);
1625 f
->output_data
.win32
->nontext_cursor
= nontext_cursor
;
1627 if (mode_cursor
!= f
->output_data
.win32
->modeline_cursor
1628 && f
->output_data
.win32
->modeline_cursor
!= 0)
1629 XFreeCursor (FRAME_WIN32_DISPLAY (f
), f
->output_data
.win32
->modeline_cursor
);
1630 f
->output_data
.win32
->modeline_cursor
= mode_cursor
;
1631 if (cross_cursor
!= f
->output_data
.win32
->cross_cursor
1632 && f
->output_data
.win32
->cross_cursor
!= 0)
1633 XFreeCursor (FRAME_WIN32_DISPLAY (f
), f
->output_data
.win32
->cross_cursor
);
1634 f
->output_data
.win32
->cross_cursor
= cross_cursor
;
1636 XFlush (FRAME_WIN32_DISPLAY (f
));
1642 x_set_cursor_color (f
, arg
, oldval
)
1644 Lisp_Object arg
, oldval
;
1646 unsigned long fore_pixel
;
1648 if (!EQ (Vx_cursor_fore_pixel
, Qnil
))
1649 fore_pixel
= x_decode_color (f
, Vx_cursor_fore_pixel
,
1650 WHITE_PIX_DEFAULT (f
));
1652 fore_pixel
= f
->output_data
.win32
->background_pixel
;
1653 f
->output_data
.win32
->cursor_pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1655 /* Make sure that the cursor color differs from the background color. */
1656 if (f
->output_data
.win32
->cursor_pixel
== f
->output_data
.win32
->background_pixel
)
1658 f
->output_data
.win32
->cursor_pixel
= f
->output_data
.win32
->mouse_pixel
;
1659 if (f
->output_data
.win32
->cursor_pixel
== fore_pixel
)
1660 fore_pixel
= f
->output_data
.win32
->background_pixel
;
1662 f
->output_data
.win32
->cursor_foreground_pixel
= fore_pixel
;
1664 if (FRAME_WIN32_WINDOW (f
) != 0)
1666 if (FRAME_VISIBLE_P (f
))
1668 x_display_cursor (f
, 0);
1669 x_display_cursor (f
, 1);
1674 /* Set the border-color of frame F to value described by ARG.
1675 ARG can be a string naming a color.
1676 The border-color is used for the border that is drawn by the server.
1677 Note that this does not fully take effect if done before
1678 F has a window; it must be redone when the window is created. */
1681 x_set_border_color (f
, arg
, oldval
)
1683 Lisp_Object arg
, oldval
;
1688 CHECK_STRING (arg
, 0);
1689 str
= XSTRING (arg
)->data
;
1691 pix
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1693 x_set_border_pixel (f
, pix
);
1696 /* Set the border-color of frame F to pixel value PIX.
1697 Note that this does not fully take effect if done before
1700 x_set_border_pixel (f
, pix
)
1704 f
->output_data
.win32
->border_pixel
= pix
;
1706 if (FRAME_WIN32_WINDOW (f
) != 0 && f
->output_data
.win32
->border_width
> 0)
1708 if (FRAME_VISIBLE_P (f
))
1714 x_set_cursor_type (f
, arg
, oldval
)
1716 Lisp_Object arg
, oldval
;
1720 FRAME_DESIRED_CURSOR (f
) = bar_cursor
;
1721 f
->output_data
.win32
->cursor_width
= 2;
1723 else if (CONSP (arg
) && EQ (XCONS (arg
)->car
, Qbar
)
1724 && INTEGERP (XCONS (arg
)->cdr
))
1726 FRAME_DESIRED_CURSOR (f
) = bar_cursor
;
1727 f
->output_data
.win32
->cursor_width
= XINT (XCONS (arg
)->cdr
);
1730 /* Treat anything unknown as "box cursor".
1731 It was bad to signal an error; people have trouble fixing
1732 .Xdefaults with Emacs, when it has something bad in it. */
1733 FRAME_DESIRED_CURSOR (f
) = filled_box_cursor
;
1735 /* Make sure the cursor gets redrawn. This is overkill, but how
1736 often do people change cursor types? */
1737 update_mode_lines
++;
1741 x_set_icon_type (f
, arg
, oldval
)
1743 Lisp_Object arg
, oldval
;
1751 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1754 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1759 result
= x_text_icon (f
,
1760 (char *) XSTRING ((!NILP (f
->icon_name
)
1764 result
= x_bitmap_icon (f
, arg
);
1769 error ("No icon window available");
1772 /* If the window was unmapped (and its icon was mapped),
1773 the new icon is not mapped, so map the window in its stead. */
1774 if (FRAME_VISIBLE_P (f
))
1776 #ifdef USE_X_TOOLKIT
1777 XtPopup (f
->output_data
.win32
->widget
, XtGrabNone
);
1779 XMapWindow (FRAME_WIN32_DISPLAY (f
), FRAME_WIN32_WINDOW (f
));
1782 XFlush (FRAME_WIN32_DISPLAY (f
));
1787 /* Return non-nil if frame F wants a bitmap icon. */
1795 tem
= assq_no_quit (Qicon_type
, f
->param_alist
);
1797 return XCONS (tem
)->cdr
;
1803 x_set_icon_name (f
, arg
, oldval
)
1805 Lisp_Object arg
, oldval
;
1812 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1815 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1821 if (f
->output_data
.win32
->icon_bitmap
!= 0)
1826 result
= x_text_icon (f
,
1827 (char *) XSTRING ((!NILP (f
->icon_name
)
1834 error ("No icon window available");
1837 /* If the window was unmapped (and its icon was mapped),
1838 the new icon is not mapped, so map the window in its stead. */
1839 if (FRAME_VISIBLE_P (f
))
1841 #ifdef USE_X_TOOLKIT
1842 XtPopup (f
->output_data
.win32
->widget
, XtGrabNone
);
1844 XMapWindow (FRAME_WIN32_DISPLAY (f
), FRAME_WIN32_WINDOW (f
));
1847 XFlush (FRAME_WIN32_DISPLAY (f
));
1852 extern Lisp_Object
x_new_font ();
1855 x_set_font (f
, arg
, oldval
)
1857 Lisp_Object arg
, oldval
;
1861 CHECK_STRING (arg
, 1);
1864 result
= x_new_font (f
, XSTRING (arg
)->data
);
1867 if (EQ (result
, Qnil
))
1868 error ("Font \"%s\" is not defined", XSTRING (arg
)->data
);
1869 else if (EQ (result
, Qt
))
1870 error ("the characters of the given font have varying widths");
1871 else if (STRINGP (result
))
1873 recompute_basic_faces (f
);
1874 store_frame_param (f
, Qfont
, result
);
1881 x_set_border_width (f
, arg
, oldval
)
1883 Lisp_Object arg
, oldval
;
1885 CHECK_NUMBER (arg
, 0);
1887 if (XINT (arg
) == f
->output_data
.win32
->border_width
)
1890 if (FRAME_WIN32_WINDOW (f
) != 0)
1891 error ("Cannot change the border width of a window");
1893 f
->output_data
.win32
->border_width
= XINT (arg
);
1897 x_set_internal_border_width (f
, arg
, oldval
)
1899 Lisp_Object arg
, oldval
;
1902 int old
= f
->output_data
.win32
->internal_border_width
;
1904 CHECK_NUMBER (arg
, 0);
1905 f
->output_data
.win32
->internal_border_width
= XINT (arg
);
1906 if (f
->output_data
.win32
->internal_border_width
< 0)
1907 f
->output_data
.win32
->internal_border_width
= 0;
1909 if (f
->output_data
.win32
->internal_border_width
== old
)
1912 if (FRAME_WIN32_WINDOW (f
) != 0)
1915 x_set_window_size (f
, 0, f
->width
, f
->height
);
1917 SET_FRAME_GARBAGED (f
);
1922 x_set_visibility (f
, value
, oldval
)
1924 Lisp_Object value
, oldval
;
1927 XSETFRAME (frame
, f
);
1930 Fmake_frame_invisible (frame
, Qt
);
1931 else if (EQ (value
, Qicon
))
1932 Ficonify_frame (frame
);
1934 Fmake_frame_visible (frame
);
1938 x_set_menu_bar_lines (f
, value
, oldval
)
1940 Lisp_Object value
, oldval
;
1943 int olines
= FRAME_MENU_BAR_LINES (f
);
1945 /* Right now, menu bars don't work properly in minibuf-only frames;
1946 most of the commands try to apply themselves to the minibuffer
1947 frame itslef, and get an error because you can't switch buffers
1948 in or split the minibuffer window. */
1949 if (FRAME_MINIBUF_ONLY_P (f
))
1952 if (INTEGERP (value
))
1953 nlines
= XINT (value
);
1957 FRAME_MENU_BAR_LINES (f
) = 0;
1959 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
1962 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
1963 free_frame_menubar (f
);
1964 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
1968 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
1971 If EXPLICIT is non-zero, that indicates that lisp code is setting the
1972 name; if NAME is a string, set F's name to NAME and set
1973 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
1975 If EXPLICIT is zero, that indicates that Emacs redisplay code is
1976 suggesting a new name, which lisp code should override; if
1977 F->explicit_name is set, ignore the new name; otherwise, set it. */
1980 x_set_name (f
, name
, explicit)
1985 /* Make sure that requests from lisp code override requests from
1986 Emacs redisplay code. */
1989 /* If we're switching from explicit to implicit, we had better
1990 update the mode lines and thereby update the title. */
1991 if (f
->explicit_name
&& NILP (name
))
1992 update_mode_lines
= 1;
1994 f
->explicit_name
= ! NILP (name
);
1996 else if (f
->explicit_name
)
1999 /* If NAME is nil, set the name to the win32_id_name. */
2002 /* Check for no change needed in this very common case
2003 before we do any consing. */
2004 if (!strcmp (FRAME_WIN32_DISPLAY_INFO (f
)->win32_id_name
,
2005 XSTRING (f
->name
)->data
))
2007 name
= build_string (FRAME_WIN32_DISPLAY_INFO (f
)->win32_id_name
);
2010 CHECK_STRING (name
, 0);
2012 /* Don't change the name if it's already NAME. */
2013 if (! NILP (Fstring_equal (name
, f
->name
)))
2016 if (FRAME_WIN32_WINDOW (f
))
2019 SetWindowText(FRAME_WIN32_WINDOW (f
), XSTRING (name
)->data
);
2026 /* This function should be called when the user's lisp code has
2027 specified a name for the frame; the name will override any set by the
2030 x_explicitly_set_name (f
, arg
, oldval
)
2032 Lisp_Object arg
, oldval
;
2034 x_set_name (f
, arg
, 1);
2037 /* This function should be called by Emacs redisplay code to set the
2038 name; names set this way will never override names set by the user's
2041 x_implicitly_set_name (f
, arg
, oldval
)
2043 Lisp_Object arg
, oldval
;
2045 x_set_name (f
, arg
, 0);
2049 x_set_autoraise (f
, arg
, oldval
)
2051 Lisp_Object arg
, oldval
;
2053 f
->auto_raise
= !EQ (Qnil
, arg
);
2057 x_set_autolower (f
, arg
, oldval
)
2059 Lisp_Object arg
, oldval
;
2061 f
->auto_lower
= !EQ (Qnil
, arg
);
2065 x_set_unsplittable (f
, arg
, oldval
)
2067 Lisp_Object arg
, oldval
;
2069 f
->no_split
= !NILP (arg
);
2073 x_set_vertical_scroll_bars (f
, arg
, oldval
)
2075 Lisp_Object arg
, oldval
;
2077 if (NILP (arg
) != ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
2079 FRAME_HAS_VERTICAL_SCROLL_BARS (f
) = ! NILP (arg
);
2081 /* We set this parameter before creating the window for the
2082 frame, so we can get the geometry right from the start.
2083 However, if the window hasn't been created yet, we shouldn't
2084 call x_set_window_size. */
2085 if (FRAME_WIN32_WINDOW (f
))
2086 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2091 x_set_scroll_bar_width (f
, arg
, oldval
)
2093 Lisp_Object arg
, oldval
;
2097 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = 0;
2098 FRAME_SCROLL_BAR_COLS (f
) = 2;
2100 else if (INTEGERP (arg
) && XINT (arg
) > 0
2101 && XFASTINT (arg
) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f
))
2103 int wid
= FONT_WIDTH (f
->output_data
.win32
->font
);
2104 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = XFASTINT (arg
);
2105 FRAME_SCROLL_BAR_COLS (f
) = (XFASTINT (arg
) + wid
-1) / wid
;
2106 if (FRAME_WIN32_WINDOW (f
))
2107 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2111 /* Subroutines of creating an frame. */
2113 /* Make sure that Vx_resource_name is set to a reasonable value.
2114 Fix it up, or set it to `emacs' if it is too hopeless. */
2117 validate_x_resource_name ()
2120 /* Number of valid characters in the resource name. */
2122 /* Number of invalid characters in the resource name. */
2127 if (STRINGP (Vx_resource_name
))
2129 unsigned char *p
= XSTRING (Vx_resource_name
)->data
;
2132 len
= XSTRING (Vx_resource_name
)->size
;
2134 /* Only letters, digits, - and _ are valid in resource names.
2135 Count the valid characters and count the invalid ones. */
2136 for (i
= 0; i
< len
; i
++)
2139 if (! ((c
>= 'a' && c
<= 'z')
2140 || (c
>= 'A' && c
<= 'Z')
2141 || (c
>= '0' && c
<= '9')
2142 || c
== '-' || c
== '_'))
2149 /* Not a string => completely invalid. */
2150 bad_count
= 5, good_count
= 0;
2152 /* If name is valid already, return. */
2156 /* If name is entirely invalid, or nearly so, use `emacs'. */
2158 || (good_count
== 1 && bad_count
> 0))
2160 Vx_resource_name
= build_string ("emacs");
2164 /* Name is partly valid. Copy it and replace the invalid characters
2165 with underscores. */
2167 Vx_resource_name
= new = Fcopy_sequence (Vx_resource_name
);
2169 for (i
= 0; i
< len
; i
++)
2171 int c
= XSTRING (new)->data
[i
];
2172 if (! ((c
>= 'a' && c
<= 'z')
2173 || (c
>= 'A' && c
<= 'Z')
2174 || (c
>= '0' && c
<= '9')
2175 || c
== '-' || c
== '_'))
2176 XSTRING (new)->data
[i
] = '_';
2181 extern char *x_get_string_resource ();
2183 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
2184 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
2185 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
2186 class, where INSTANCE is the name under which Emacs was invoked, or\n\
2187 the name specified by the `-name' or `-rn' command-line arguments.\n\
2189 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
2190 class, respectively. You must specify both of them or neither.\n\
2191 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
2192 and the class is `Emacs.CLASS.SUBCLASS'.")
2193 (attribute
, class, component
, subclass
)
2194 Lisp_Object attribute
, class, component
, subclass
;
2196 register char *value
;
2200 CHECK_STRING (attribute
, 0);
2201 CHECK_STRING (class, 0);
2203 if (!NILP (component
))
2204 CHECK_STRING (component
, 1);
2205 if (!NILP (subclass
))
2206 CHECK_STRING (subclass
, 2);
2207 if (NILP (component
) != NILP (subclass
))
2208 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2210 validate_x_resource_name ();
2212 /* Allocate space for the components, the dots which separate them,
2213 and the final '\0'. Make them big enough for the worst case. */
2214 name_key
= (char *) alloca (XSTRING (Vx_resource_name
)->size
2215 + (STRINGP (component
)
2216 ? XSTRING (component
)->size
: 0)
2217 + XSTRING (attribute
)->size
2220 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
2221 + XSTRING (class)->size
2222 + (STRINGP (subclass
)
2223 ? XSTRING (subclass
)->size
: 0)
2226 /* Start with emacs.FRAMENAME for the name (the specific one)
2227 and with `Emacs' for the class key (the general one). */
2228 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2229 strcpy (class_key
, EMACS_CLASS
);
2231 strcat (class_key
, ".");
2232 strcat (class_key
, XSTRING (class)->data
);
2234 if (!NILP (component
))
2236 strcat (class_key
, ".");
2237 strcat (class_key
, XSTRING (subclass
)->data
);
2239 strcat (name_key
, ".");
2240 strcat (name_key
, XSTRING (component
)->data
);
2243 strcat (name_key
, ".");
2244 strcat (name_key
, XSTRING (attribute
)->data
);
2246 value
= x_get_string_resource (Qnil
,
2247 name_key
, class_key
);
2249 if (value
!= (char *) 0)
2250 return build_string (value
);
2255 /* Used when C code wants a resource value. */
2258 x_get_resource_string (attribute
, class)
2259 char *attribute
, *class;
2261 register char *value
;
2265 /* Allocate space for the components, the dots which separate them,
2266 and the final '\0'. */
2267 name_key
= (char *) alloca (XSTRING (Vinvocation_name
)->size
2268 + strlen (attribute
) + 2);
2269 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
2270 + strlen (class) + 2);
2272 sprintf (name_key
, "%s.%s",
2273 XSTRING (Vinvocation_name
)->data
,
2275 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
2277 return x_get_string_resource (selected_frame
,
2278 name_key
, class_key
);
2281 /* Types we might convert a resource string into. */
2284 number
, boolean
, string
, symbol
2287 /* Return the value of parameter PARAM.
2289 First search ALIST, then Vdefault_frame_alist, then the X defaults
2290 database, using ATTRIBUTE as the attribute name and CLASS as its class.
2292 Convert the resource to the type specified by desired_type.
2294 If no default is specified, return Qunbound. If you call
2295 x_get_arg, make sure you deal with Qunbound in a reasonable way,
2296 and don't let it get stored in any Lisp-visible variables! */
2299 x_get_arg (alist
, param
, attribute
, class, type
)
2300 Lisp_Object alist
, param
;
2303 enum resource_types type
;
2305 register Lisp_Object tem
;
2307 tem
= Fassq (param
, alist
);
2309 tem
= Fassq (param
, Vdefault_frame_alist
);
2315 tem
= Fx_get_resource (build_string (attribute
),
2316 build_string (class),
2325 return make_number (atoi (XSTRING (tem
)->data
));
2328 tem
= Fdowncase (tem
);
2329 if (!strcmp (XSTRING (tem
)->data
, "on")
2330 || !strcmp (XSTRING (tem
)->data
, "true"))
2339 /* As a special case, we map the values `true' and `on'
2340 to Qt, and `false' and `off' to Qnil. */
2343 lower
= Fdowncase (tem
);
2344 if (!strcmp (XSTRING (lower
)->data
, "on")
2345 || !strcmp (XSTRING (lower
)->data
, "true"))
2347 else if (!strcmp (XSTRING (lower
)->data
, "off")
2348 || !strcmp (XSTRING (lower
)->data
, "false"))
2351 return Fintern (tem
, Qnil
);
2364 /* Record in frame F the specified or default value according to ALIST
2365 of the parameter named PARAM (a Lisp symbol).
2366 If no value is specified for PARAM, look for an X default for XPROP
2367 on the frame named NAME.
2368 If that is not found either, use the value DEFLT. */
2371 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
2378 enum resource_types type
;
2382 tem
= x_get_arg (alist
, prop
, xprop
, xclass
, type
);
2383 if (EQ (tem
, Qunbound
))
2385 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2389 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
2390 "Parse an X-style geometry string STRING.\n\
2391 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
2392 The properties returned may include `top', `left', `height', and `width'.\n\
2393 The value of `left' or `top' may be an integer,\n\
2394 or a list (+ N) meaning N pixels relative to top/left corner,\n\
2395 or a list (- N) meaning -N pixels relative to bottom/right corner.")
2400 unsigned int width
, height
;
2403 CHECK_STRING (string
, 0);
2405 geometry
= XParseGeometry ((char *) XSTRING (string
)->data
,
2406 &x
, &y
, &width
, &height
);
2409 if (geometry
& XValue
)
2411 Lisp_Object element
;
2413 if (x
>= 0 && (geometry
& XNegative
))
2414 element
= Fcons (Qleft
, Fcons (Qminus
, Fcons (make_number (-x
), Qnil
)));
2415 else if (x
< 0 && ! (geometry
& XNegative
))
2416 element
= Fcons (Qleft
, Fcons (Qplus
, Fcons (make_number (x
), Qnil
)));
2418 element
= Fcons (Qleft
, make_number (x
));
2419 result
= Fcons (element
, result
);
2422 if (geometry
& YValue
)
2424 Lisp_Object element
;
2426 if (y
>= 0 && (geometry
& YNegative
))
2427 element
= Fcons (Qtop
, Fcons (Qminus
, Fcons (make_number (-y
), Qnil
)));
2428 else if (y
< 0 && ! (geometry
& YNegative
))
2429 element
= Fcons (Qtop
, Fcons (Qplus
, Fcons (make_number (y
), Qnil
)));
2431 element
= Fcons (Qtop
, make_number (y
));
2432 result
= Fcons (element
, result
);
2435 if (geometry
& WidthValue
)
2436 result
= Fcons (Fcons (Qwidth
, make_number (width
)), result
);
2437 if (geometry
& HeightValue
)
2438 result
= Fcons (Fcons (Qheight
, make_number (height
)), result
);
2443 /* Calculate the desired size and position of this window,
2444 and return the flags saying which aspects were specified.
2446 This function does not make the coordinates positive. */
2448 #define DEFAULT_ROWS 40
2449 #define DEFAULT_COLS 80
2452 x_figure_window_size (f
, parms
)
2456 register Lisp_Object tem0
, tem1
, tem2
;
2457 int height
, width
, left
, top
;
2458 register int geometry
;
2459 long window_prompting
= 0;
2461 /* Default values if we fall through.
2462 Actually, if that happens we should get
2463 window manager prompting. */
2464 f
->width
= DEFAULT_COLS
;
2465 f
->height
= DEFAULT_ROWS
;
2466 /* Window managers expect that if program-specified
2467 positions are not (0,0), they're intentional, not defaults. */
2468 f
->output_data
.win32
->top_pos
= 0;
2469 f
->output_data
.win32
->left_pos
= 0;
2471 tem0
= x_get_arg (parms
, Qheight
, 0, 0, number
);
2472 tem1
= x_get_arg (parms
, Qwidth
, 0, 0, number
);
2473 tem2
= x_get_arg (parms
, Quser_size
, 0, 0, number
);
2474 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
2476 if (!EQ (tem0
, Qunbound
))
2478 CHECK_NUMBER (tem0
, 0);
2479 f
->height
= XINT (tem0
);
2481 if (!EQ (tem1
, Qunbound
))
2483 CHECK_NUMBER (tem1
, 0);
2484 f
->width
= XINT (tem1
);
2486 if (!NILP (tem2
) && !EQ (tem2
, Qunbound
))
2487 window_prompting
|= USSize
;
2489 window_prompting
|= PSize
;
2492 f
->output_data
.win32
->vertical_scroll_bar_extra
2493 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
2495 : FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) > 0
2496 ? FRAME_SCROLL_BAR_PIXEL_WIDTH (f
)
2497 : (FRAME_SCROLL_BAR_COLS (f
) * FONT_WIDTH (f
->output_data
.win32
->font
)));
2498 f
->output_data
.win32
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
2499 f
->output_data
.win32
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
2501 tem0
= x_get_arg (parms
, Qtop
, 0, 0, number
);
2502 tem1
= x_get_arg (parms
, Qleft
, 0, 0, number
);
2503 tem2
= x_get_arg (parms
, Quser_position
, 0, 0, number
);
2504 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
2506 if (EQ (tem0
, Qminus
))
2508 f
->output_data
.win32
->top_pos
= 0;
2509 window_prompting
|= YNegative
;
2511 else if (CONSP (tem0
) && EQ (XCONS (tem0
)->car
, Qminus
)
2512 && CONSP (XCONS (tem0
)->cdr
)
2513 && INTEGERP (XCONS (XCONS (tem0
)->cdr
)->car
))
2515 f
->output_data
.win32
->top_pos
= - XINT (XCONS (XCONS (tem0
)->cdr
)->car
);
2516 window_prompting
|= YNegative
;
2518 else if (CONSP (tem0
) && EQ (XCONS (tem0
)->car
, Qplus
)
2519 && CONSP (XCONS (tem0
)->cdr
)
2520 && INTEGERP (XCONS (XCONS (tem0
)->cdr
)->car
))
2522 f
->output_data
.win32
->top_pos
= XINT (XCONS (XCONS (tem0
)->cdr
)->car
);
2524 else if (EQ (tem0
, Qunbound
))
2525 f
->output_data
.win32
->top_pos
= 0;
2528 CHECK_NUMBER (tem0
, 0);
2529 f
->output_data
.win32
->top_pos
= XINT (tem0
);
2530 if (f
->output_data
.win32
->top_pos
< 0)
2531 window_prompting
|= YNegative
;
2534 if (EQ (tem1
, Qminus
))
2536 f
->output_data
.win32
->left_pos
= 0;
2537 window_prompting
|= XNegative
;
2539 else if (CONSP (tem1
) && EQ (XCONS (tem1
)->car
, Qminus
)
2540 && CONSP (XCONS (tem1
)->cdr
)
2541 && INTEGERP (XCONS (XCONS (tem1
)->cdr
)->car
))
2543 f
->output_data
.win32
->left_pos
= - XINT (XCONS (XCONS (tem1
)->cdr
)->car
);
2544 window_prompting
|= XNegative
;
2546 else if (CONSP (tem1
) && EQ (XCONS (tem1
)->car
, Qplus
)
2547 && CONSP (XCONS (tem1
)->cdr
)
2548 && INTEGERP (XCONS (XCONS (tem1
)->cdr
)->car
))
2550 f
->output_data
.win32
->left_pos
= XINT (XCONS (XCONS (tem1
)->cdr
)->car
);
2552 else if (EQ (tem1
, Qunbound
))
2553 f
->output_data
.win32
->left_pos
= 0;
2556 CHECK_NUMBER (tem1
, 0);
2557 f
->output_data
.win32
->left_pos
= XINT (tem1
);
2558 if (f
->output_data
.win32
->left_pos
< 0)
2559 window_prompting
|= XNegative
;
2562 if (!NILP (tem2
) && ! EQ (tem2
, Qunbound
))
2563 window_prompting
|= USPosition
;
2565 window_prompting
|= PPosition
;
2568 return window_prompting
;
2573 extern LRESULT CALLBACK
win32_wnd_proc ();
2576 win32_init_class (hinst
)
2581 wc
.style
= CS_HREDRAW
| CS_VREDRAW
;
2582 wc
.lpfnWndProc
= (WNDPROC
) win32_wnd_proc
;
2584 wc
.cbWndExtra
= WND_EXTRA_BYTES
;
2585 wc
.hInstance
= hinst
;
2586 wc
.hIcon
= LoadIcon (hinst
, EMACS_CLASS
);
2587 wc
.hCursor
= LoadCursor (NULL
, IDC_ARROW
);
2588 wc
.hbrBackground
= NULL
; // GetStockObject (WHITE_BRUSH);
2589 wc
.lpszMenuName
= NULL
;
2590 wc
.lpszClassName
= EMACS_CLASS
;
2592 return (RegisterClass (&wc
));
2596 win32_createscrollbar (f
, bar
)
2598 struct scroll_bar
* bar
;
2600 return (CreateWindow ("SCROLLBAR", "", SBS_VERT
| WS_CHILD
| WS_VISIBLE
,
2601 /* Position and size of scroll bar. */
2602 XINT(bar
->left
), XINT(bar
->top
),
2603 XINT(bar
->width
), XINT(bar
->height
),
2604 FRAME_WIN32_WINDOW (f
),
2611 win32_createwindow (f
)
2616 /* Do first time app init */
2620 win32_init_class (hinst
);
2623 FRAME_WIN32_WINDOW (f
) = hwnd
= CreateWindow (EMACS_CLASS
,
2625 f
->output_data
.win32
->dwStyle
| WS_CLIPCHILDREN
,
2626 f
->output_data
.win32
->left_pos
,
2627 f
->output_data
.win32
->top_pos
,
2637 SetWindowLong (hwnd
, WND_X_UNITS_INDEX
, FONT_WIDTH (f
->output_data
.win32
->font
));
2638 SetWindowLong (hwnd
, WND_Y_UNITS_INDEX
, f
->output_data
.win32
->line_height
);
2639 SetWindowLong (hwnd
, WND_BACKGROUND_INDEX
, f
->output_data
.win32
->background_pixel
);
2641 /* Do this to discard the default setting specified by our parent. */
2642 ShowWindow (hwnd
, SW_HIDE
);
2646 /* Convert between the modifier bits Win32 uses and the modifier bits
2649 win32_get_modifiers ()
2651 return (((GetKeyState (VK_SHIFT
)&0x8000) ? shift_modifier
: 0) |
2652 ((GetKeyState (VK_CONTROL
)&0x8000) ? ctrl_modifier
: 0) |
2653 ((GetKeyState (VK_MENU
)&0x8000) ? meta_modifier
: 0));
2657 my_post_msg (wmsg
, hwnd
, msg
, wParam
, lParam
)
2664 wmsg
->msg
.hwnd
= hwnd
;
2665 wmsg
->msg
.message
= msg
;
2666 wmsg
->msg
.wParam
= wParam
;
2667 wmsg
->msg
.lParam
= lParam
;
2668 wmsg
->msg
.time
= GetMessageTime ();
2673 /* GetKeyState and MapVirtualKey on Win95 do not actually distinguish
2674 between left and right keys as advertised. We test for this
2675 support dynamically, and set a flag when the support is absent. If
2676 absent, we keep track of the left and right control and alt keys
2677 ourselves. This is particularly necessary on keyboards that rely
2678 upon the AltGr key, which is represented as having the left control
2679 and right alt keys pressed. For these keyboards, we need to know
2680 when the left alt key has been pressed in addition to the AltGr key
2681 so that we can properly support M-AltGr-key sequences (such as M-@
2682 on Swedish keyboards). */
2684 #define EMACS_LCONTROL 0
2685 #define EMACS_RCONTROL 1
2686 #define EMACS_LMENU 2
2687 #define EMACS_RMENU 3
2689 static int modifiers
[4];
2690 static int modifiers_recorded
;
2691 static int modifier_key_support_tested
;
2694 test_modifier_support (unsigned int wparam
)
2698 if (wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
)
2700 if (wparam
== VK_CONTROL
)
2710 if (!(GetKeyState (l
) & 0x8000) && !(GetKeyState (r
) & 0x8000))
2711 modifiers_recorded
= 1;
2713 modifiers_recorded
= 0;
2714 modifier_key_support_tested
= 1;
2718 record_keydown (unsigned int wparam
, unsigned int lparam
)
2722 if (!modifier_key_support_tested
)
2723 test_modifier_support (wparam
);
2725 if ((wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
) || !modifiers_recorded
)
2728 if (wparam
== VK_CONTROL
)
2729 i
= (lparam
& 0x1000000) ? EMACS_RCONTROL
: EMACS_LCONTROL
;
2731 i
= (lparam
& 0x1000000) ? EMACS_RMENU
: EMACS_LMENU
;
2737 record_keyup (unsigned int wparam
, unsigned int lparam
)
2741 if ((wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
) || !modifiers_recorded
)
2744 if (wparam
== VK_CONTROL
)
2745 i
= (lparam
& 0x1000000) ? EMACS_RCONTROL
: EMACS_LCONTROL
;
2747 i
= (lparam
& 0x1000000) ? EMACS_RMENU
: EMACS_LMENU
;
2752 /* Emacs can lose focus while a modifier key has been pressed. When
2753 it regains focus, be conservative and clear all modifiers since
2754 we cannot reconstruct the left and right modifier state. */
2760 if (!modifiers_recorded
)
2763 ctrl
= GetAsyncKeyState (VK_CONTROL
);
2764 alt
= GetAsyncKeyState (VK_MENU
);
2766 if (ctrl
== 0 || alt
== 0)
2767 /* Emacs doesn't have keyboard focus. Do nothing. */
2770 if (!(ctrl
& 0x08000))
2771 /* Clear any recorded control modifier state. */
2772 modifiers
[EMACS_RCONTROL
] = modifiers
[EMACS_LCONTROL
] = 0;
2774 if (!(alt
& 0x08000))
2775 /* Clear any recorded alt modifier state. */
2776 modifiers
[EMACS_RMENU
] = modifiers
[EMACS_LMENU
] = 0;
2778 /* Otherwise, leave the modifier state as it was when Emacs lost
2783 modifier_set (int vkey
)
2785 if (vkey
== VK_CAPITAL
)
2786 return (GetKeyState (vkey
) & 0x1);
2787 if (!modifiers_recorded
)
2788 return (GetKeyState (vkey
) & 0x8000);
2793 return modifiers
[EMACS_LCONTROL
];
2795 return modifiers
[EMACS_RCONTROL
];
2797 return modifiers
[EMACS_LMENU
];
2799 return modifiers
[EMACS_RMENU
];
2803 return (GetKeyState (vkey
) & 0x8000);
2806 /* We map the VK_* modifiers into console modifier constants
2807 so that we can use the same routines to handle both console
2808 and window input. */
2811 construct_modifiers (unsigned int wparam
, unsigned int lparam
)
2815 if (wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
)
2816 mods
= GetLastError ();
2819 mods
|= (modifier_set (VK_SHIFT
)) ? SHIFT_PRESSED
: 0;
2820 mods
|= (modifier_set (VK_CAPITAL
)) ? CAPSLOCK_ON
: 0;
2821 mods
|= (modifier_set (VK_LCONTROL
)) ? LEFT_CTRL_PRESSED
: 0;
2822 mods
|= (modifier_set (VK_RCONTROL
)) ? RIGHT_CTRL_PRESSED
: 0;
2823 mods
|= (modifier_set (VK_LMENU
)) ? LEFT_ALT_PRESSED
: 0;
2824 mods
|= (modifier_set (VK_RMENU
)) ? RIGHT_ALT_PRESSED
: 0;
2830 map_keypad_keys (unsigned int wparam
, unsigned int lparam
)
2832 unsigned int extended
= (lparam
& 0x1000000L
);
2834 if (wparam
< VK_CLEAR
|| wparam
> VK_DELETE
)
2837 if (wparam
== VK_RETURN
)
2838 return (extended
? VK_NUMPAD_ENTER
: VK_RETURN
);
2840 if (wparam
>= VK_PRIOR
&& wparam
<= VK_DOWN
)
2841 return (!extended
? (VK_NUMPAD_PRIOR
+ (wparam
- VK_PRIOR
)) : wparam
);
2843 if (wparam
== VK_INSERT
|| wparam
== VK_DELETE
)
2844 return (!extended
? (VK_NUMPAD_INSERT
+ (wparam
- VK_INSERT
)) : wparam
);
2846 if (wparam
== VK_CLEAR
)
2847 return (!extended
? VK_NUMPAD_CLEAR
: wparam
);
2852 /* Main message dispatch loop. */
2860 /* Ensure our message queue is created */
2862 PeekMessage (&msg
, NULL
, 0, 0, PM_NOREMOVE
);
2864 PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
, 0, 0);
2866 while (GetMessage (&msg
, NULL
, 0, 0))
2868 if (msg
.hwnd
== NULL
)
2870 switch (msg
.message
)
2872 case WM_EMACS_CREATEWINDOW
:
2873 win32_createwindow ((struct frame
*) msg
.wParam
);
2874 PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
, 0, 0);
2876 case WM_EMACS_CREATESCROLLBAR
:
2878 HWND hwnd
= win32_createscrollbar ((struct frame
*) msg
.wParam
,
2879 (struct scroll_bar
*) msg
.lParam
);
2880 PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
, (WPARAM
)hwnd
, 0);
2889 DispatchMessage (&msg
);
2896 /* Main window procedure */
2898 extern char *lispy_function_keys
[];
2901 win32_wnd_proc (hwnd
, msg
, wParam
, lParam
)
2909 struct win32_display_info
*dpyinfo
= &one_win32_display_info
;
2911 int windows_translate
;
2917 GetUpdateRect (hwnd
, &wmsg
.rect
, FALSE
);
2919 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
2921 case WM_PALETTECHANGED
:
2922 /* ignore our own changes */
2923 if ((HWND
)wParam
!= hwnd
)
2925 /* simply notify main thread it may need to update frames */
2926 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
2931 PAINTSTRUCT paintStruct
;
2934 BeginPaint (hwnd
, &paintStruct
);
2935 wmsg
.rect
= paintStruct
.rcPaint
;
2936 EndPaint (hwnd
, &paintStruct
);
2939 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
2946 record_keyup (wParam
, lParam
);
2951 record_keydown (wParam
, lParam
);
2953 wParam
= map_keypad_keys (wParam
, lParam
);
2955 windows_translate
= 0;
2960 /* More support for these keys will likely be necessary. */
2961 if (!NILP (Vwin32_pass_optional_keys_to_system
))
2962 windows_translate
= 1;
2965 if (NILP (Vwin32_pass_alt_to_system
))
2967 windows_translate
= 1;
2974 windows_translate
= 1;
2977 /* If not defined as a function key, change it to a WM_CHAR message. */
2978 if (lispy_function_keys
[wParam
] == 0)
2983 if (windows_translate
)
2985 MSG winmsg
= { hwnd
, msg
, wParam
, lParam
, 0, {0,0} };
2987 winmsg
.time
= GetMessageTime ();
2988 TranslateMessage (&winmsg
);
2996 wmsg
.dwModifiers
= construct_modifiers (wParam
, lParam
);
2999 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3002 /* Detect quit_char and set quit-flag directly. Note that we dow
3003 this *after* posting the message to ensure the main thread will
3004 be woken up if blocked in sys_select(). */
3007 if (isalpha (c
) && (wmsg
.dwModifiers
== LEFT_CTRL_PRESSED
3008 || wmsg
.dwModifiers
== RIGHT_CTRL_PRESSED
))
3009 c
= make_ctrl_char (c
) & 0377;
3018 /* Simulate middle mouse button events when left and right buttons
3019 are used together, but only if user has two button mouse. */
3020 case WM_LBUTTONDOWN
:
3021 case WM_RBUTTONDOWN
:
3022 if (XINT (Vwin32_num_mouse_buttons
) == 3)
3023 goto handle_plain_button
;
3026 int this = (msg
== WM_LBUTTONDOWN
) ? LMOUSE
: RMOUSE
;
3027 int other
= (msg
== WM_LBUTTONDOWN
) ? RMOUSE
: LMOUSE
;
3029 if (button_state
& this)
3032 if (button_state
== 0)
3035 button_state
|= this;
3037 if (button_state
& other
)
3039 if (mouse_button_timer
)
3041 KillTimer (hwnd
, mouse_button_timer
);
3042 mouse_button_timer
= 0;
3044 /* Generate middle mouse event instead. */
3045 msg
= WM_MBUTTONDOWN
;
3046 button_state
|= MMOUSE
;
3048 else if (button_state
& MMOUSE
)
3050 /* Ignore button event if we've already generated a
3051 middle mouse down event. This happens if the
3052 user releases and press one of the two buttons
3053 after we've faked a middle mouse event. */
3058 /* Flush out saved message. */
3059 post_msg (&saved_mouse_button_msg
);
3061 wmsg
.dwModifiers
= win32_get_modifiers ();
3062 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3064 /* Clear message buffer. */
3065 saved_mouse_button_msg
.msg
.hwnd
= 0;
3069 /* Hold onto message for now. */
3070 mouse_button_timer
=
3071 SetTimer (hwnd
, MOUSE_BUTTON_ID
, XINT (Vwin32_mouse_button_tolerance
), NULL
);
3072 saved_mouse_button_msg
.msg
.hwnd
= hwnd
;
3073 saved_mouse_button_msg
.msg
.message
= msg
;
3074 saved_mouse_button_msg
.msg
.wParam
= wParam
;
3075 saved_mouse_button_msg
.msg
.lParam
= lParam
;
3076 saved_mouse_button_msg
.msg
.time
= GetMessageTime ();
3077 saved_mouse_button_msg
.dwModifiers
= win32_get_modifiers ();
3084 if (XINT (Vwin32_num_mouse_buttons
) == 3)
3085 goto handle_plain_button
;
3088 int this = (msg
== WM_LBUTTONUP
) ? LMOUSE
: RMOUSE
;
3089 int other
= (msg
== WM_LBUTTONUP
) ? RMOUSE
: LMOUSE
;
3091 if ((button_state
& this) == 0)
3094 button_state
&= ~this;
3096 if (button_state
& MMOUSE
)
3098 /* Only generate event when second button is released. */
3099 if ((button_state
& other
) == 0)
3102 button_state
&= ~MMOUSE
;
3104 if (button_state
) abort ();
3111 /* Flush out saved message if necessary. */
3112 if (saved_mouse_button_msg
.msg
.hwnd
)
3114 post_msg (&saved_mouse_button_msg
);
3117 wmsg
.dwModifiers
= win32_get_modifiers ();
3118 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3120 /* Always clear message buffer and cancel timer. */
3121 saved_mouse_button_msg
.msg
.hwnd
= 0;
3122 KillTimer (hwnd
, mouse_button_timer
);
3123 mouse_button_timer
= 0;
3125 if (button_state
== 0)
3130 case WM_MBUTTONDOWN
:
3132 handle_plain_button
:
3136 if (parse_button (msg
, NULL
, &up
))
3138 if (up
) ReleaseCapture ();
3139 else SetCapture (hwnd
);
3143 wmsg
.dwModifiers
= win32_get_modifiers ();
3144 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3149 if (XINT (Vwin32_mouse_move_interval
) <= 0
3150 || (msg
== WM_MOUSEMOVE
&& button_state
== 0))
3152 wmsg
.dwModifiers
= win32_get_modifiers ();
3153 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3157 /* Hang onto mouse move and scroll messages for a bit, to avoid
3158 sending such events to Emacs faster than it can process them.
3159 If we get more events before the timer from the first message
3160 expires, we just replace the first message. */
3162 if (saved_mouse_move_msg
.msg
.hwnd
== 0)
3164 SetTimer (hwnd
, MOUSE_MOVE_ID
, XINT (Vwin32_mouse_move_interval
), NULL
);
3166 /* Hold onto message for now. */
3167 saved_mouse_move_msg
.msg
.hwnd
= hwnd
;
3168 saved_mouse_move_msg
.msg
.message
= msg
;
3169 saved_mouse_move_msg
.msg
.wParam
= wParam
;
3170 saved_mouse_move_msg
.msg
.lParam
= lParam
;
3171 saved_mouse_move_msg
.msg
.time
= GetMessageTime ();
3172 saved_mouse_move_msg
.dwModifiers
= win32_get_modifiers ();
3177 /* Flush out saved messages if necessary. */
3178 if (wParam
== mouse_button_timer
)
3180 if (saved_mouse_button_msg
.msg
.hwnd
)
3182 post_msg (&saved_mouse_button_msg
);
3183 saved_mouse_button_msg
.msg
.hwnd
= 0;
3185 KillTimer (hwnd
, mouse_button_timer
);
3186 mouse_button_timer
= 0;
3188 else if (wParam
== mouse_move_timer
)
3190 if (saved_mouse_move_msg
.msg
.hwnd
)
3192 post_msg (&saved_mouse_move_msg
);
3193 saved_mouse_move_msg
.msg
.hwnd
= 0;
3195 KillTimer (hwnd
, mouse_move_timer
);
3196 mouse_move_timer
= 0;
3201 /* Windows doesn't send us focus messages when putting up and
3202 taking down a system popup dialog as for Ctrl-Alt-Del on Win95.
3203 The only indication we get that something happened is receiving
3204 this message afterwards. So this is a good time to reset our
3205 keyboard modifiers' state. */
3216 wmsg
.dwModifiers
= win32_get_modifiers ();
3217 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3221 wmsg
.dwModifiers
= win32_get_modifiers ();
3222 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3225 case WM_WINDOWPOSCHANGING
:
3228 LPWINDOWPOS lppos
= (WINDOWPOS
*) lParam
;
3230 GetWindowPlacement (hwnd
, &wp
);
3232 if (wp
.showCmd
!= SW_SHOWMINIMIZED
&& ! (lppos
->flags
& SWP_NOSIZE
))
3241 wp
.length
= sizeof(wp
);
3242 GetWindowRect (hwnd
, &wr
);
3246 dwXUnits
= GetWindowLong (hwnd
, WND_X_UNITS_INDEX
);
3247 dwYUnits
= GetWindowLong (hwnd
, WND_Y_UNITS_INDEX
);
3251 memset (&rect
, 0, sizeof (rect
));
3252 AdjustWindowRect (&rect
, GetWindowLong (hwnd
, GWL_STYLE
),
3253 GetMenu (hwnd
) != NULL
);
3255 /* All windows have an extra pixel so subtract 1 */
3257 wdiff
= (lppos
->cx
- (rect
.right
- rect
.left
) - 0) % dwXUnits
;
3258 hdiff
= (lppos
->cy
- (rect
.bottom
- rect
.top
) - 0) % dwYUnits
;
3262 /* For right/bottom sizing we can just fix the sizes.
3263 However for top/left sizing we will need to fix the X
3264 and Y positions as well. */
3269 if (wp
.showCmd
!= SW_SHOWMAXIMIZED
3270 && ! (lppos
->flags
& SWP_NOMOVE
))
3272 if (lppos
->x
!= wr
.left
|| lppos
->y
!= wr
.top
)
3279 lppos
->flags
|= SWP_NOMOVE
;
3288 if (ret
== 0) return (0);
3291 case WM_EMACS_SHOWWINDOW
:
3292 return ShowWindow (hwnd
, wParam
);
3293 case WM_EMACS_SETWINDOWPOS
:
3295 Win32WindowPos
* pos
= (Win32WindowPos
*) wParam
;
3296 return SetWindowPos (hwnd
, pos
->hwndAfter
,
3297 pos
->x
, pos
->y
, pos
->cx
, pos
->cy
, pos
->flags
);
3299 case WM_EMACS_DESTROYWINDOW
:
3300 DestroyWindow ((HWND
) wParam
);
3304 return DefWindowProc (hwnd
, msg
, wParam
, lParam
);
3311 my_create_window (f
)
3316 PostThreadMessage (dwWinThreadId
, WM_EMACS_CREATEWINDOW
, (WPARAM
)f
, 0);
3317 GetMessage (&msg
, NULL
, WM_EMACS_DONE
, WM_EMACS_DONE
);
3320 /* Create and set up the win32 window for frame F. */
3323 win32_window (f
, window_prompting
, minibuffer_only
)
3325 long window_prompting
;
3326 int minibuffer_only
;
3330 /* Use the resource name as the top-level window name
3331 for looking up resources. Make a non-Lisp copy
3332 for the window manager, so GC relocation won't bother it.
3334 Elsewhere we specify the window name for the window manager. */
3337 char *str
= (char *) XSTRING (Vx_resource_name
)->data
;
3338 f
->namebuf
= (char *) xmalloc (strlen (str
) + 1);
3339 strcpy (f
->namebuf
, str
);
3342 my_create_window (f
);
3344 validate_x_resource_name ();
3346 /* x_set_name normally ignores requests to set the name if the
3347 requested name is the same as the current name. This is the one
3348 place where that assumption isn't correct; f->name is set, but
3349 the server hasn't been told. */
3352 int explicit = f
->explicit_name
;
3354 f
->explicit_name
= 0;
3357 x_set_name (f
, name
, explicit);
3362 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
3363 initialize_frame_menubar (f
);
3365 if (FRAME_WIN32_WINDOW (f
) == 0)
3366 error ("Unable to create window");
3369 /* Handle the icon stuff for this window. Perhaps later we might
3370 want an x_set_icon_position which can be called interactively as
3378 Lisp_Object icon_x
, icon_y
;
3380 /* Set the position of the icon. Note that win95 groups all
3381 icons in the tray. */
3382 icon_x
= x_get_arg (parms
, Qicon_left
, 0, 0, number
);
3383 icon_y
= x_get_arg (parms
, Qicon_top
, 0, 0, number
);
3384 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
3386 CHECK_NUMBER (icon_x
, 0);
3387 CHECK_NUMBER (icon_y
, 0);
3389 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
3390 error ("Both left and top icon corners of icon must be specified");
3394 if (! EQ (icon_x
, Qunbound
))
3395 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
3400 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
3402 "Make a new window, which is called a \"frame\" in Emacs terms.\n\
3403 Returns an Emacs frame object.\n\
3404 ALIST is an alist of frame parameters.\n\
3405 If the parameters specify that the frame should not have a minibuffer,\n\
3406 and do not specify a specific minibuffer window to use,\n\
3407 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
3408 be shared by the new frame.\n\
3410 This function is an internal primitive--use `make-frame' instead.")
3415 Lisp_Object frame
, tem
;
3417 int minibuffer_only
= 0;
3418 long window_prompting
= 0;
3420 int count
= specpdl_ptr
- specpdl
;
3421 struct gcpro gcpro1
;
3422 Lisp_Object display
;
3423 struct win32_display_info
*dpyinfo
;
3427 /* Use this general default value to start with
3428 until we know if this frame has a specified name. */
3429 Vx_resource_name
= Vinvocation_name
;
3431 display
= x_get_arg (parms
, Qdisplay
, 0, 0, string
);
3432 if (EQ (display
, Qunbound
))
3434 dpyinfo
= check_x_display_info (display
);
3436 kb
= dpyinfo
->kboard
;
3438 kb
= &the_only_kboard
;
3441 name
= x_get_arg (parms
, Qname
, "title", "Title", string
);
3443 && ! EQ (name
, Qunbound
)
3445 error ("Invalid frame name--not a string or nil");
3448 Vx_resource_name
= name
;
3450 /* See if parent window is specified. */
3451 parent
= x_get_arg (parms
, Qparent_id
, NULL
, NULL
, number
);
3452 if (EQ (parent
, Qunbound
))
3454 if (! NILP (parent
))
3455 CHECK_NUMBER (parent
, 0);
3457 tem
= x_get_arg (parms
, Qminibuffer
, 0, 0, symbol
);
3458 if (EQ (tem
, Qnone
) || NILP (tem
))
3459 f
= make_frame_without_minibuffer (Qnil
, kb
, display
);
3460 else if (EQ (tem
, Qonly
))
3462 f
= make_minibuffer_frame ();
3463 minibuffer_only
= 1;
3465 else if (WINDOWP (tem
))
3466 f
= make_frame_without_minibuffer (tem
, kb
, display
);
3470 /* Note that Windows does support scroll bars. */
3471 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
3472 /* By default, make scrollbars the system standard width. */
3473 f
->scroll_bar_pixel_width
= GetSystemMetrics (SM_CXVSCROLL
);
3475 XSETFRAME (frame
, f
);
3478 f
->output_method
= output_win32
;
3479 f
->output_data
.win32
= (struct win32_output
*) xmalloc (sizeof (struct win32_output
));
3480 bzero (f
->output_data
.win32
, sizeof (struct win32_output
));
3482 /* FRAME_WIN32_DISPLAY_INFO (f) = dpyinfo; */
3484 FRAME_KBOARD (f
) = kb
;
3487 /* Specify the parent under which to make this window. */
3491 f
->output_data
.win32
->parent_desc
= (Window
) parent
;
3492 f
->output_data
.win32
->explicit_parent
= 1;
3496 f
->output_data
.win32
->parent_desc
= FRAME_WIN32_DISPLAY_INFO (f
)->root_window
;
3497 f
->output_data
.win32
->explicit_parent
= 0;
3500 /* Note that the frame has no physical cursor right now. */
3501 f
->phys_cursor_x
= -1;
3503 /* Set the name; the functions to which we pass f expect the name to
3505 if (EQ (name
, Qunbound
) || NILP (name
))
3507 f
->name
= build_string (dpyinfo
->win32_id_name
);
3508 f
->explicit_name
= 0;
3513 f
->explicit_name
= 1;
3514 /* use the frame's title when getting resources for this frame. */
3515 specbind (Qx_resource_name
, name
);
3518 /* Extract the window parameters from the supplied values
3519 that are needed to determine window geometry. */
3523 font
= x_get_arg (parms
, Qfont
, "font", "Font", string
);
3525 /* First, try whatever font the caller has specified. */
3527 font
= x_new_font (f
, XSTRING (font
)->data
);
3529 /* Try out a font which we hope has bold and italic variations. */
3530 if (!STRINGP (font
))
3531 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3532 if (! STRINGP (font
))
3533 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3534 if (! STRINGP (font
))
3535 /* This was formerly the first thing tried, but it finds too many fonts
3536 and takes too long. */
3537 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
3538 /* If those didn't work, look for something which will at least work. */
3539 if (! STRINGP (font
))
3540 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
3541 if (! STRINGP (font
))
3542 font
= x_new_font (f
, "-*-system-medium-r-normal-*-*-200-*-*-c-120-*-*");
3544 if (! STRINGP (font
))
3545 font
= x_new_font (f
, "-*-Fixedsys-*-r-*-*-12-90-*-*-c-*-*-*");
3547 if (! STRINGP (font
))
3548 font
= build_string ("-*-system");
3550 x_default_parameter (f
, parms
, Qfont
, font
,
3551 "font", "Font", string
);
3554 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
3555 "borderwidth", "BorderWidth", number
);
3556 /* This defaults to 2 in order to match xterm. We recognize either
3557 internalBorderWidth or internalBorder (which is what xterm calls
3559 if (NILP (Fassq (Qinternal_border_width
, parms
)))
3563 value
= x_get_arg (parms
, Qinternal_border_width
,
3564 "internalBorder", "BorderWidth", number
);
3565 if (! EQ (value
, Qunbound
))
3566 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
3569 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (0),
3570 "internalBorderWidth", "BorderWidth", number
);
3571 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qt
,
3572 "verticalScrollBars", "ScrollBars", boolean
);
3574 /* Also do the stuff which must be set before the window exists. */
3575 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
3576 "foreground", "Foreground", string
);
3577 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
3578 "background", "Background", string
);
3579 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
3580 "pointerColor", "Foreground", string
);
3581 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
3582 "cursorColor", "Foreground", string
);
3583 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
3584 "borderColor", "BorderColor", string
);
3586 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (1),
3587 "menuBar", "MenuBar", number
);
3588 x_default_parameter (f
, parms
, Qscroll_bar_width
, Qnil
,
3589 "scrollBarWidth", "ScrollBarWidth", number
);
3591 f
->output_data
.win32
->dwStyle
= WS_OVERLAPPEDWINDOW
;
3592 f
->output_data
.win32
->parent_desc
= FRAME_WIN32_DISPLAY_INFO (f
)->root_window
;
3593 window_prompting
= x_figure_window_size (f
, parms
);
3595 if (window_prompting
& XNegative
)
3597 if (window_prompting
& YNegative
)
3598 f
->output_data
.win32
->win_gravity
= SouthEastGravity
;
3600 f
->output_data
.win32
->win_gravity
= NorthEastGravity
;
3604 if (window_prompting
& YNegative
)
3605 f
->output_data
.win32
->win_gravity
= SouthWestGravity
;
3607 f
->output_data
.win32
->win_gravity
= NorthWestGravity
;
3610 f
->output_data
.win32
->size_hint_flags
= window_prompting
;
3612 win32_window (f
, window_prompting
, minibuffer_only
);
3614 init_frame_faces (f
);
3616 /* We need to do this after creating the window, so that the
3617 icon-creation functions can say whose icon they're describing. */
3618 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
3619 "bitmapIcon", "BitmapIcon", symbol
);
3621 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
3622 "autoRaise", "AutoRaiseLower", boolean
);
3623 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
3624 "autoLower", "AutoRaiseLower", boolean
);
3625 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
3626 "cursorType", "CursorType", symbol
);
3628 /* Dimensions, especially f->height, must be done via change_frame_size.
3629 Change will not be effected unless different from the current
3633 f
->height
= f
->width
= 0;
3634 change_frame_size (f
, height
, width
, 1, 0);
3636 /* Tell the server what size and position, etc, we want,
3637 and how badly we want them. */
3639 x_wm_set_size_hint (f
, window_prompting
, 0);
3642 tem
= x_get_arg (parms
, Qunsplittable
, 0, 0, boolean
);
3643 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
3647 /* It is now ok to make the frame official
3648 even if we get an error below.
3649 And the frame needs to be on Vframe_list
3650 or making it visible won't work. */
3651 Vframe_list
= Fcons (frame
, Vframe_list
);
3653 /* Now that the frame is official, it counts as a reference to
3655 FRAME_WIN32_DISPLAY_INFO (f
)->reference_count
++;
3657 /* Make the window appear on the frame and enable display,
3658 unless the caller says not to. However, with explicit parent,
3659 Emacs cannot control visibility, so don't try. */
3660 if (! f
->output_data
.win32
->explicit_parent
)
3662 Lisp_Object visibility
;
3664 visibility
= x_get_arg (parms
, Qvisibility
, 0, 0, symbol
);
3665 if (EQ (visibility
, Qunbound
))
3668 if (EQ (visibility
, Qicon
))
3669 x_iconify_frame (f
);
3670 else if (! NILP (visibility
))
3671 x_make_frame_visible (f
);
3673 /* Must have been Qnil. */
3677 return unbind_to (count
, frame
);
3680 /* FRAME is used only to get a handle on the X display. We don't pass the
3681 display info directly because we're called from frame.c, which doesn't
3682 know about that structure. */
3684 x_get_focus_frame (frame
)
3685 struct frame
*frame
;
3687 struct win32_display_info
*dpyinfo
= FRAME_WIN32_DISPLAY_INFO (frame
);
3689 if (! dpyinfo
->win32_focus_frame
)
3692 XSETFRAME (xfocus
, dpyinfo
->win32_focus_frame
);
3696 DEFUN ("focus-frame", Ffocus_frame
, Sfocus_frame
, 1, 1, 0,
3697 "This function is obsolete, and does nothing.")
3704 DEFUN ("unfocus-frame", Funfocus_frame
, Sunfocus_frame
, 0, 0, 0,
3705 "This function is obsolete, and does nothing.")
3712 win32_load_font (dpyinfo
,name
)
3713 struct win32_display_info
*dpyinfo
;
3716 XFontStruct
* font
= NULL
;
3722 if (!name
|| !x_to_win32_font (name
, &lf
))
3725 font
= (XFontStruct
*) xmalloc (sizeof (XFontStruct
));
3727 if (!font
) return (NULL
);
3731 font
->hfont
= CreateFontIndirect (&lf
);
3734 if (font
->hfont
== NULL
)
3743 hdc
= GetDC (dpyinfo
->root_window
);
3744 oldobj
= SelectObject (hdc
, font
->hfont
);
3745 ok
= GetTextMetrics (hdc
, &font
->tm
);
3746 SelectObject (hdc
, oldobj
);
3747 ReleaseDC (dpyinfo
->root_window
, hdc
);
3752 if (ok
) return (font
);
3754 win32_unload_font (dpyinfo
, font
);
3759 win32_unload_font (dpyinfo
, font
)
3760 struct win32_display_info
*dpyinfo
;
3765 if (font
->hfont
) DeleteObject(font
->hfont
);
3770 /* The font conversion stuff between x and win32 */
3772 /* X font string is as follows (from faces.el)
3776 * (weight "\\(bold\\|demibold\\|medium\\)") ; 1
3777 * (weight\? "\\([^-]*\\)") ; 1
3778 * (slant "\\([ior]\\)") ; 2
3779 * (slant\? "\\([^-]?\\)") ; 2
3780 * (swidth "\\([^-]*\\)") ; 3
3781 * (adstyle "[^-]*") ; 4
3782 * (pixelsize "[0-9]+")
3783 * (pointsize "[0-9][0-9]+")
3784 * (resx "[0-9][0-9]+")
3785 * (resy "[0-9][0-9]+")
3786 * (spacing "[cmp?*]")
3787 * (avgwidth "[0-9]+")
3788 * (registry "[^-]+")
3789 * (encoding "[^-]+")
3791 * (setq x-font-regexp
3792 * (concat "\\`\\*?[-?*]"
3793 * foundry - family - weight\? - slant\? - swidth - adstyle -
3794 * pixelsize - pointsize - resx - resy - spacing - registry -
3795 * encoding "[-?*]\\*?\\'"
3797 * (setq x-font-regexp-head
3798 * (concat "\\`[-?*]" foundry - family - weight\? - slant\?
3799 * "\\([-*?]\\|\\'\\)"))
3800 * (setq x-font-regexp-slant (concat - slant -))
3801 * (setq x-font-regexp-weight (concat - weight -))
3805 #define FONT_START "[-?]"
3806 #define FONT_FOUNDRY "[^-]+"
3807 #define FONT_FAMILY "\\([^-]+\\)" /* 1 */
3808 #define FONT_WEIGHT "\\(bold\\|demibold\\|medium\\)" /* 2 */
3809 #define FONT_WEIGHT_Q "\\([^-]*\\)" /* 2 */
3810 #define FONT_SLANT "\\([ior]\\)" /* 3 */
3811 #define FONT_SLANT_Q "\\([^-]?\\)" /* 3 */
3812 #define FONT_SWIDTH "\\([^-]*\\)" /* 4 */
3813 #define FONT_ADSTYLE "[^-]*"
3814 #define FONT_PIXELSIZE "[^-]*"
3815 #define FONT_POINTSIZE "\\([0-9][0-9]+\\|\\*\\)" /* 5 */
3816 #define FONT_RESX "[0-9][0-9]+"
3817 #define FONT_RESY "[0-9][0-9]+"
3818 #define FONT_SPACING "[cmp?*]"
3819 #define FONT_AVGWIDTH "[0-9]+"
3820 #define FONT_REGISTRY "[^-]+"
3821 #define FONT_ENCODING "[^-]+"
3823 #define FONT_REGEXP ("\\`\\*?[-?*]" \
3830 FONT_PIXELSIZE "-" \
3831 FONT_POINTSIZE "-" \
3834 #define FONT_REGEXP_HEAD ("\\`[-?*]" \
3839 "\\([-*?]\\|\\'\\)")
3841 #define FONT_REGEXP_SLANT "-" FONT_SLANT "-"
3842 #define FONT_REGEXP_WEIGHT "-" FONT_WEIGHT "-"
3845 x_to_win32_weight (lpw
)
3848 if (!lpw
) return (FW_DONTCARE
);
3850 if (stricmp (lpw
,"heavy") == 0) return FW_HEAVY
;
3851 else if (stricmp (lpw
,"extrabold") == 0) return FW_EXTRABOLD
;
3852 else if (stricmp (lpw
,"bold") == 0) return FW_BOLD
;
3853 else if (stricmp (lpw
,"demibold") == 0) return FW_SEMIBOLD
;
3854 else if (stricmp (lpw
,"medium") == 0) return FW_MEDIUM
;
3855 else if (stricmp (lpw
,"normal") == 0) return FW_NORMAL
;
3856 else if (stricmp (lpw
,"light") == 0) return FW_LIGHT
;
3857 else if (stricmp (lpw
,"extralight") == 0) return FW_EXTRALIGHT
;
3858 else if (stricmp (lpw
,"thin") == 0) return FW_THIN
;
3865 win32_to_x_weight (fnweight
)
3868 if (fnweight
>= FW_HEAVY
) return "heavy";
3869 if (fnweight
>= FW_EXTRABOLD
) return "extrabold";
3870 if (fnweight
>= FW_BOLD
) return "bold";
3871 if (fnweight
>= FW_SEMIBOLD
) return "semibold";
3872 if (fnweight
>= FW_MEDIUM
) return "medium";
3873 if (fnweight
>= FW_NORMAL
) return "normal";
3874 if (fnweight
>= FW_LIGHT
) return "light";
3875 if (fnweight
>= FW_EXTRALIGHT
) return "extralight";
3876 if (fnweight
>= FW_THIN
) return "thin";
3882 x_to_win32_charset (lpcs
)
3885 if (!lpcs
) return (0);
3887 if (stricmp (lpcs
,"ansi") == 0) return ANSI_CHARSET
;
3888 else if (stricmp (lpcs
,"iso8859-1") == 0) return ANSI_CHARSET
;
3889 else if (stricmp (lpcs
,"iso8859") == 0) return ANSI_CHARSET
;
3890 else if (stricmp (lpcs
,"oem") == 0) return OEM_CHARSET
;
3891 #ifdef UNICODE_CHARSET
3892 else if (stricmp (lpcs
,"unicode") == 0) return UNICODE_CHARSET
;
3893 else if (stricmp (lpcs
,"iso10646") == 0) return UNICODE_CHARSET
;
3900 win32_to_x_charset (fncharset
)
3905 case ANSI_CHARSET
: return "ansi";
3906 case OEM_CHARSET
: return "oem";
3907 case SYMBOL_CHARSET
: return "symbol";
3908 #ifdef UNICODE_CHARSET
3909 case UNICODE_CHARSET
: return "unicode";
3916 win32_to_x_font (lplogfont
, lpxstr
, len
)
3917 LOGFONT
* lplogfont
;
3921 char height_pixels
[8];
3923 char width_pixels
[8];
3925 if (!lpxstr
) abort ();
3930 if (lplogfont
->lfHeight
)
3932 sprintf (height_pixels
, "%u", abs (lplogfont
->lfHeight
));
3933 sprintf (height_dpi
, "%u",
3934 (abs (lplogfont
->lfHeight
) * 720) / one_win32_display_info
.height_in
);
3938 strcpy (height_pixels
, "*");
3939 strcpy (height_dpi
, "*");
3941 if (lplogfont
->lfWidth
)
3942 sprintf (width_pixels
, "%u", lplogfont
->lfWidth
* 10);
3944 strcpy (width_pixels
, "*");
3946 _snprintf (lpxstr
, len
- 1,
3947 "-*-%s-%s-%c-*-*-%s-%s-*-*-%c-%s-*-%s-",
3948 lplogfont
->lfFaceName
,
3949 win32_to_x_weight (lplogfont
->lfWeight
),
3950 lplogfont
->lfItalic
?'i':'r',
3953 ((lplogfont
->lfPitchAndFamily
& 0x3) == VARIABLE_PITCH
) ? 'p' : 'c',
3955 win32_to_x_charset (lplogfont
->lfCharSet
)
3958 lpxstr
[len
- 1] = 0; /* just to be sure */
3963 x_to_win32_font (lpxstr
, lplogfont
)
3965 LOGFONT
* lplogfont
;
3967 if (!lplogfont
) return (FALSE
);
3969 memset (lplogfont
, 0, sizeof (*lplogfont
));
3972 lplogfont
->lfOutPrecision
= OUT_DEFAULT_PRECIS
;
3973 lplogfont
->lfClipPrecision
= CLIP_DEFAULT_PRECIS
;
3974 lplogfont
->lfQuality
= DEFAULT_QUALITY
;
3976 /* go for maximum quality */
3977 lplogfont
->lfOutPrecision
= OUT_STROKE_PRECIS
;
3978 lplogfont
->lfClipPrecision
= CLIP_STROKE_PRECIS
;
3979 lplogfont
->lfQuality
= PROOF_QUALITY
;
3985 /* Provide a simple escape mechanism for specifying Windows font names
3986 * directly -- if font spec does not beginning with '-', assume this
3988 * "<font name>[:height in pixels[:width in pixels[:weight]]]"
3994 char name
[50], weight
[20], slant
, pitch
, pixels
[10], height
[10], width
[10], remainder
[20];
3997 fields
= sscanf (lpxstr
,
3998 "-%*[^-]-%49[^-]-%19[^-]-%c-%*[^-]-%*[^-]-%9[^-]-%9[^-]-%*[^-]-%*[^-]-%c-%9[^-]-%19s",
3999 name
, weight
, &slant
, pixels
, height
, &pitch
, width
, remainder
);
4001 if (fields
== EOF
) return (FALSE
);
4003 if (fields
> 0 && name
[0] != '*')
4005 strncpy (lplogfont
->lfFaceName
,name
, LF_FACESIZE
);
4006 lplogfont
->lfFaceName
[LF_FACESIZE
-1] = 0;
4010 lplogfont
->lfFaceName
[0] = 0;
4015 lplogfont
->lfWeight
= x_to_win32_weight ((fields
> 0 ? weight
: ""));
4019 if (!NILP (Vwin32_enable_italics
))
4020 lplogfont
->lfItalic
= (fields
> 0 && slant
== 'i');
4024 if (fields
> 0 && pixels
[0] != '*')
4025 lplogfont
->lfHeight
= atoi (pixels
);
4029 if (fields
> 0 && lplogfont
->lfHeight
== 0 && height
[0] != '*')
4030 lplogfont
->lfHeight
= (atoi (height
)
4031 * one_win32_display_info
.height_in
) / 720;
4035 lplogfont
->lfPitchAndFamily
=
4036 (fields
> 0 && pitch
== 'p') ? VARIABLE_PITCH
: FIXED_PITCH
;
4040 if (fields
> 0 && width
[0] != '*')
4041 lplogfont
->lfWidth
= atoi (width
) / 10;
4045 /* Not all font specs include the registry field, so we allow for an
4046 optional registry field before the encoding when parsing
4047 remainder. Also we strip the trailing '-' if present. */
4049 int len
= strlen (remainder
);
4050 if (len
> 0 && remainder
[len
-1] == '-')
4051 remainder
[len
-1] = 0;
4053 encoding
= remainder
;
4054 if (strncmp (encoding
, "*-", 2) == 0)
4056 lplogfont
->lfCharSet
= x_to_win32_charset (fields
> 0 ? encoding
: "");
4061 char name
[100], height
[10], width
[10], weight
[20];
4063 fields
= sscanf (lpxstr
,
4064 "%99[^:]:%9[^:]:%9[^:]:%19s",
4065 name
, height
, width
, weight
);
4067 if (fields
== EOF
) return (FALSE
);
4071 strncpy (lplogfont
->lfFaceName
,name
, LF_FACESIZE
);
4072 lplogfont
->lfFaceName
[LF_FACESIZE
-1] = 0;
4076 lplogfont
->lfFaceName
[0] = 0;
4082 lplogfont
->lfHeight
= atoi (height
);
4087 lplogfont
->lfWidth
= atoi (width
);
4091 lplogfont
->lfWeight
= x_to_win32_weight ((fields
> 0 ? weight
: ""));
4094 /* This makes TrueType fonts work better. */
4095 lplogfont
->lfHeight
= - abs (lplogfont
->lfHeight
);
4101 win32_font_match (lpszfont1
, lpszfont2
)
4105 char * s1
= lpszfont1
, *e1
;
4106 char * s2
= lpszfont2
, *e2
;
4108 if (s1
== NULL
|| s2
== NULL
) return (FALSE
);
4110 if (*s1
== '-') s1
++;
4111 if (*s2
== '-') s2
++;
4117 e1
= strchr (s1
, '-');
4118 e2
= strchr (s2
, '-');
4120 if (e1
== NULL
|| e2
== NULL
) return (TRUE
);
4125 if (*s1
!= '*' && *s2
!= '*'
4126 && (len1
!= len2
|| strnicmp (s1
, s2
, len1
) != 0))
4134 typedef struct enumfont_t
4139 XFontStruct
*size_ref
;
4140 Lisp_Object
*pattern
;
4146 enum_font_cb2 (lplf
, lptm
, FontType
, lpef
)
4148 NEWTEXTMETRIC
* lptm
;
4152 if (lplf
->elfLogFont
.lfStrikeOut
|| lplf
->elfLogFont
.lfUnderline
4153 || (lplf
->elfLogFont
.lfCharSet
!= ANSI_CHARSET
&& lplf
->elfLogFont
.lfCharSet
!= OEM_CHARSET
))
4156 /* if (!lpef->size_ref || lptm->tmMaxCharWidth == FONT_WIDTH (lpef->size_ref)) */
4160 if (!NILP (*(lpef
->pattern
)) && FontType
== TRUETYPE_FONTTYPE
)
4162 lplf
->elfLogFont
.lfHeight
= lpef
->logfont
.lfHeight
;
4163 lplf
->elfLogFont
.lfWidth
= lpef
->logfont
.lfWidth
;
4166 if (!win32_to_x_font (lplf
, buf
, 100)) return (0);
4168 if (NILP (*(lpef
->pattern
)) || win32_font_match (buf
, XSTRING (*(lpef
->pattern
))->data
))
4170 *lpef
->tail
= Fcons (build_string (buf
), Qnil
);
4171 lpef
->tail
= &XCONS (*lpef
->tail
)->cdr
;
4180 enum_font_cb1 (lplf
, lptm
, FontType
, lpef
)
4182 NEWTEXTMETRIC
* lptm
;
4186 return EnumFontFamilies (lpef
->hdc
,
4187 lplf
->elfLogFont
.lfFaceName
,
4188 (FONTENUMPROC
) enum_font_cb2
,
4193 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 3, 0,
4194 "Return a list of the names of available fonts matching PATTERN.\n\
4195 If optional arguments FACE and FRAME are specified, return only fonts\n\
4196 the same size as FACE on FRAME.\n\
4198 PATTERN is a string, perhaps with wildcard characters;\n\
4199 the * character matches any substring, and\n\
4200 the ? character matches any single character.\n\
4201 PATTERN is case-insensitive.\n\
4202 FACE is a face name--a symbol.\n\
4204 The return value is a list of strings, suitable as arguments to\n\
4207 Fonts Emacs can't use (i.e. proportional fonts) may or may not be excluded\n\
4208 even if they match PATTERN and FACE.")
4209 (pattern
, face
, frame
)
4210 Lisp_Object pattern
, face
, frame
;
4215 XFontStruct
*size_ref
;
4216 Lisp_Object namelist
;
4221 CHECK_STRING (pattern
, 0);
4223 CHECK_SYMBOL (face
, 1);
4225 f
= check_x_frame (frame
);
4227 /* Determine the width standard for comparison with the fonts we find. */
4235 /* Don't die if we get called with a terminal frame. */
4236 if (! FRAME_WIN32_P (f
))
4237 error ("non-win32 frame used in `x-list-fonts'");
4239 face_id
= face_name_id_number (f
, face
);
4241 if (face_id
< 0 || face_id
>= FRAME_N_PARAM_FACES (f
)
4242 || FRAME_PARAM_FACES (f
) [face_id
] == 0)
4243 size_ref
= f
->output_data
.win32
->font
;
4246 size_ref
= FRAME_PARAM_FACES (f
) [face_id
]->font
;
4247 if (size_ref
== (XFontStruct
*) (~0))
4248 size_ref
= f
->output_data
.win32
->font
;
4252 /* See if we cached the result for this particular query. */
4253 list
= Fassoc (pattern
,
4254 XCONS (FRAME_WIN32_DISPLAY_INFO (f
)->name_list_element
)->cdr
);
4256 /* We have info in the cache for this PATTERN. */
4259 Lisp_Object tem
, newlist
;
4261 /* We have info about this pattern. */
4262 list
= XCONS (list
)->cdr
;
4269 /* Filter the cached info and return just the fonts that match FACE. */
4271 for (tem
= list
; CONSP (tem
); tem
= XCONS (tem
)->cdr
)
4273 XFontStruct
*thisinfo
;
4275 thisinfo
= win32_load_font (FRAME_WIN32_DISPLAY_INFO (f
), XSTRING (XCONS (tem
)->car
)->data
);
4277 if (thisinfo
&& same_size_fonts (thisinfo
, size_ref
))
4278 newlist
= Fcons (XCONS (tem
)->car
, newlist
);
4280 win32_unload_font (FRAME_WIN32_DISPLAY_INFO (f
), thisinfo
);
4291 ef
.pattern
= &pattern
;
4292 ef
.tail
= ef
.head
= &namelist
;
4294 x_to_win32_font (STRINGP (pattern
) ? XSTRING (pattern
)->data
: NULL
, &ef
.logfont
);
4297 ef
.hdc
= GetDC (FRAME_WIN32_WINDOW (f
));
4299 EnumFontFamilies (ef
.hdc
, NULL
, (FONTENUMPROC
) enum_font_cb1
, (LPARAM
)&ef
);
4301 ReleaseDC (FRAME_WIN32_WINDOW (f
), ef
.hdc
);
4311 /* Make a list of all the fonts we got back.
4312 Store that in the font cache for the display. */
4313 XCONS (FRAME_WIN32_DISPLAY_INFO (f
)->name_list_element
)->cdr
4314 = Fcons (Fcons (pattern
, namelist
),
4315 XCONS (FRAME_WIN32_DISPLAY_INFO (f
)->name_list_element
)->cdr
);
4317 /* Make a list of the fonts that have the right width. */
4320 for (i
= 0; i
< ef
.numFonts
; i
++)
4328 XFontStruct
*thisinfo
;
4331 thisinfo
= win32_load_font (FRAME_WIN32_DISPLAY_INFO (f
), XSTRING (Fcar (cur
))->data
);
4333 keeper
= thisinfo
&& same_size_fonts (thisinfo
, size_ref
);
4335 win32_unload_font (FRAME_WIN32_DISPLAY_INFO (f
), thisinfo
);
4340 list
= Fcons (build_string (XSTRING (Fcar (cur
))->data
), list
);
4344 list
= Fnreverse (list
);
4350 DEFUN ("x-color-defined-p", Fx_color_defined_p
, Sx_color_defined_p
, 1, 2, 0,
4351 "Return non-nil if color COLOR is supported on frame FRAME.\n\
4352 If FRAME is omitted or nil, use the selected frame.")
4354 Lisp_Object color
, frame
;
4357 FRAME_PTR f
= check_x_frame (frame
);
4359 CHECK_STRING (color
, 1);
4361 if (defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
4367 DEFUN ("x-color-values", Fx_color_values
, Sx_color_values
, 1, 2, 0,
4368 "Return a description of the color named COLOR on frame FRAME.\n\
4369 The value is a list of integer RGB values--(RED GREEN BLUE).\n\
4370 These values appear to range from 0 to 65280 or 65535, depending\n\
4371 on the system; white is (65280 65280 65280) or (65535 65535 65535).\n\
4372 If FRAME is omitted or nil, use the selected frame.")
4374 Lisp_Object color
, frame
;
4377 FRAME_PTR f
= check_x_frame (frame
);
4379 CHECK_STRING (color
, 1);
4381 if (defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
4385 rgb
[0] = make_number (GetRValue (foo
));
4386 rgb
[1] = make_number (GetGValue (foo
));
4387 rgb
[2] = make_number (GetBValue (foo
));
4388 return Flist (3, rgb
);
4394 DEFUN ("x-display-color-p", Fx_display_color_p
, Sx_display_color_p
, 0, 1, 0,
4395 "Return t if the X display supports color.\n\
4396 The optional argument DISPLAY specifies which display to ask about.\n\
4397 DISPLAY should be either a frame or a display name (a string).\n\
4398 If omitted or nil, that stands for the selected frame's display.")
4400 Lisp_Object display
;
4402 struct win32_display_info
*dpyinfo
= check_x_display_info (display
);
4404 if ((dpyinfo
->n_planes
* dpyinfo
->n_cbits
) <= 2)
4410 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
, Sx_display_grayscale_p
,
4412 "Return t if the X display supports shades of gray.\n\
4413 Note that color displays do support shades of gray.\n\
4414 The optional argument DISPLAY specifies which display to ask about.\n\
4415 DISPLAY should be either a frame or a display name (a string).\n\
4416 If omitted or nil, that stands for the selected frame's display.")
4418 Lisp_Object display
;
4420 struct win32_display_info
*dpyinfo
= check_x_display_info (display
);
4422 if ((dpyinfo
->n_planes
* dpyinfo
->n_cbits
) <= 1)
4428 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
4430 "Returns the width in pixels of the X display DISPLAY.\n\
4431 The optional argument DISPLAY specifies which display to ask about.\n\
4432 DISPLAY should be either a frame or a display name (a string).\n\
4433 If omitted or nil, that stands for the selected frame's display.")
4435 Lisp_Object display
;
4437 struct win32_display_info
*dpyinfo
= check_x_display_info (display
);
4439 return make_number (dpyinfo
->width
);
4442 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
4443 Sx_display_pixel_height
, 0, 1, 0,
4444 "Returns the height in pixels of the X display DISPLAY.\n\
4445 The optional argument DISPLAY specifies which display to ask about.\n\
4446 DISPLAY should be either a frame or a display name (a string).\n\
4447 If omitted or nil, that stands for the selected frame's display.")
4449 Lisp_Object display
;
4451 struct win32_display_info
*dpyinfo
= check_x_display_info (display
);
4453 return make_number (dpyinfo
->height
);
4456 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
4458 "Returns the number of bitplanes of the display DISPLAY.\n\
4459 The optional argument DISPLAY specifies which display to ask about.\n\
4460 DISPLAY should be either a frame or a display name (a string).\n\
4461 If omitted or nil, that stands for the selected frame's display.")
4463 Lisp_Object display
;
4465 struct win32_display_info
*dpyinfo
= check_x_display_info (display
);
4467 return make_number (dpyinfo
->n_planes
* dpyinfo
->n_cbits
);
4470 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
4472 "Returns the number of color cells of the display DISPLAY.\n\
4473 The optional argument DISPLAY specifies which display to ask about.\n\
4474 DISPLAY should be either a frame or a display name (a string).\n\
4475 If omitted or nil, that stands for the selected frame's display.")
4477 Lisp_Object display
;
4479 struct win32_display_info
*dpyinfo
= check_x_display_info (display
);
4483 hdc
= GetDC (dpyinfo
->root_window
);
4484 if (dpyinfo
->has_palette
)
4485 cap
= GetDeviceCaps (hdc
,SIZEPALETTE
);
4487 cap
= GetDeviceCaps (hdc
,NUMCOLORS
);
4489 ReleaseDC (dpyinfo
->root_window
, hdc
);
4491 return make_number (cap
);
4494 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
4495 Sx_server_max_request_size
,
4497 "Returns the maximum request size of the server of display DISPLAY.\n\
4498 The optional argument DISPLAY specifies which display to ask about.\n\
4499 DISPLAY should be either a frame or a display name (a string).\n\
4500 If omitted or nil, that stands for the selected frame's display.")
4502 Lisp_Object display
;
4504 struct win32_display_info
*dpyinfo
= check_x_display_info (display
);
4506 return make_number (1);
4509 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
4510 "Returns the vendor ID string of the Win32 system (Microsoft).\n\
4511 The optional argument DISPLAY specifies which display to ask about.\n\
4512 DISPLAY should be either a frame or a display name (a string).\n\
4513 If omitted or nil, that stands for the selected frame's display.")
4515 Lisp_Object display
;
4517 struct win32_display_info
*dpyinfo
= check_x_display_info (display
);
4518 char *vendor
= "Microsoft Corp.";
4520 if (! vendor
) vendor
= "";
4521 return build_string (vendor
);
4524 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
4525 "Returns the version numbers of the server of display DISPLAY.\n\
4526 The value is a list of three integers: the major and minor\n\
4527 version numbers, and the vendor-specific release\n\
4528 number. See also the function `x-server-vendor'.\n\n\
4529 The optional argument DISPLAY specifies which display to ask about.\n\
4530 DISPLAY should be either a frame or a display name (a string).\n\
4531 If omitted or nil, that stands for the selected frame's display.")
4533 Lisp_Object display
;
4535 struct win32_display_info
*dpyinfo
= check_x_display_info (display
);
4537 return Fcons (make_number (nt_major_version
),
4538 Fcons (make_number (nt_minor_version
), Qnil
));
4541 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
4542 "Returns the number of screens on the server of display DISPLAY.\n\
4543 The optional argument DISPLAY specifies which display to ask about.\n\
4544 DISPLAY should be either a frame or a display name (a string).\n\
4545 If omitted or nil, that stands for the selected frame's display.")
4547 Lisp_Object display
;
4549 struct win32_display_info
*dpyinfo
= check_x_display_info (display
);
4551 return make_number (1);
4554 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
4555 "Returns the height in millimeters of the X display DISPLAY.\n\
4556 The optional argument DISPLAY specifies which display to ask about.\n\
4557 DISPLAY should be either a frame or a display name (a string).\n\
4558 If omitted or nil, that stands for the selected frame's display.")
4560 Lisp_Object display
;
4562 struct win32_display_info
*dpyinfo
= check_x_display_info (display
);
4566 hdc
= GetDC (dpyinfo
->root_window
);
4568 cap
= GetDeviceCaps (hdc
, VERTSIZE
);
4570 ReleaseDC (dpyinfo
->root_window
, hdc
);
4572 return make_number (cap
);
4575 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
4576 "Returns the width in millimeters of the X display DISPLAY.\n\
4577 The optional argument DISPLAY specifies which display to ask about.\n\
4578 DISPLAY should be either a frame or a display name (a string).\n\
4579 If omitted or nil, that stands for the selected frame's display.")
4581 Lisp_Object display
;
4583 struct win32_display_info
*dpyinfo
= check_x_display_info (display
);
4588 hdc
= GetDC (dpyinfo
->root_window
);
4590 cap
= GetDeviceCaps (hdc
, HORZSIZE
);
4592 ReleaseDC (dpyinfo
->root_window
, hdc
);
4594 return make_number (cap
);
4597 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
4598 Sx_display_backing_store
, 0, 1, 0,
4599 "Returns an indication of whether display DISPLAY does backing store.\n\
4600 The value may be `always', `when-mapped', or `not-useful'.\n\
4601 The optional argument DISPLAY specifies which display to ask about.\n\
4602 DISPLAY should be either a frame or a display name (a string).\n\
4603 If omitted or nil, that stands for the selected frame's display.")
4605 Lisp_Object display
;
4607 return intern ("not-useful");
4610 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
4611 Sx_display_visual_class
, 0, 1, 0,
4612 "Returns the visual class of the display DISPLAY.\n\
4613 The value is one of the symbols `static-gray', `gray-scale',\n\
4614 `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
4615 The optional argument DISPLAY specifies which display to ask about.\n\
4616 DISPLAY should be either a frame or a display name (a string).\n\
4617 If omitted or nil, that stands for the selected frame's display.")
4619 Lisp_Object display
;
4621 struct win32_display_info
*dpyinfo
= check_x_display_info (display
);
4624 switch (dpyinfo
->visual
->class)
4626 case StaticGray
: return (intern ("static-gray"));
4627 case GrayScale
: return (intern ("gray-scale"));
4628 case StaticColor
: return (intern ("static-color"));
4629 case PseudoColor
: return (intern ("pseudo-color"));
4630 case TrueColor
: return (intern ("true-color"));
4631 case DirectColor
: return (intern ("direct-color"));
4633 error ("Display has an unknown visual class");
4637 error ("Display has an unknown visual class");
4640 DEFUN ("x-display-save-under", Fx_display_save_under
,
4641 Sx_display_save_under
, 0, 1, 0,
4642 "Returns t if the display DISPLAY supports the save-under feature.\n\
4643 The optional argument DISPLAY specifies which display to ask about.\n\
4644 DISPLAY should be either a frame or a display name (a string).\n\
4645 If omitted or nil, that stands for the selected frame's display.")
4647 Lisp_Object display
;
4649 struct win32_display_info
*dpyinfo
= check_x_display_info (display
);
4656 register struct frame
*f
;
4658 return PIXEL_WIDTH (f
);
4663 register struct frame
*f
;
4665 return PIXEL_HEIGHT (f
);
4670 register struct frame
*f
;
4672 return FONT_WIDTH (f
->output_data
.win32
->font
);
4677 register struct frame
*f
;
4679 return f
->output_data
.win32
->line_height
;
4683 x_screen_planes (frame
)
4686 return (FRAME_WIN32_DISPLAY_INFO (XFRAME (frame
))->n_planes
*
4687 FRAME_WIN32_DISPLAY_INFO (XFRAME (frame
))->n_cbits
);
4690 /* Return the display structure for the display named NAME.
4691 Open a new connection if necessary. */
4693 struct win32_display_info
*
4694 x_display_info_for_name (name
)
4698 struct win32_display_info
*dpyinfo
;
4700 CHECK_STRING (name
, 0);
4702 for (dpyinfo
= &one_win32_display_info
, names
= win32_display_name_list
;
4704 dpyinfo
= dpyinfo
->next
, names
= XCONS (names
)->cdr
)
4707 tem
= Fstring_equal (XCONS (XCONS (names
)->car
)->car
, name
);
4712 /* Use this general default value to start with. */
4713 Vx_resource_name
= Vinvocation_name
;
4715 validate_x_resource_name ();
4717 dpyinfo
= win32_term_init (name
, (unsigned char *)0,
4718 (char *) XSTRING (Vx_resource_name
)->data
);
4721 error ("Cannot connect to server %s", XSTRING (name
)->data
);
4723 XSETFASTINT (Vwindow_system_version
, 3);
4728 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
4729 1, 3, 0, "Open a connection to a server.\n\
4730 DISPLAY is the name of the display to connect to.\n\
4731 Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
4732 If the optional third arg MUST-SUCCEED is non-nil,\n\
4733 terminate Emacs if we can't open the connection.")
4734 (display
, xrm_string
, must_succeed
)
4735 Lisp_Object display
, xrm_string
, must_succeed
;
4737 unsigned int n_planes
;
4738 unsigned char *xrm_option
;
4739 struct win32_display_info
*dpyinfo
;
4741 CHECK_STRING (display
, 0);
4742 if (! NILP (xrm_string
))
4743 CHECK_STRING (xrm_string
, 1);
4745 /* Allow color mapping to be defined externally; first look in user's
4746 HOME directory, then in Emacs etc dir for a file called rgb.txt. */
4748 Lisp_Object color_file
;
4749 struct gcpro gcpro1
;
4751 color_file
= build_string("~/rgb.txt");
4753 GCPRO1 (color_file
);
4755 if (NILP (Ffile_readable_p (color_file
)))
4757 Fexpand_file_name (build_string ("rgb.txt"),
4758 Fsymbol_value (intern ("data-directory")));
4760 Vwin32_color_map
= Fwin32_load_color_file (color_file
);
4764 if (NILP (Vwin32_color_map
))
4765 Vwin32_color_map
= Fwin32_default_color_map ();
4767 if (! NILP (xrm_string
))
4768 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
4770 xrm_option
= (unsigned char *) 0;
4772 /* Use this general default value to start with. */
4773 /* First remove .exe suffix from invocation-name - it looks ugly. */
4775 char basename
[ MAX_PATH
], *str
;
4777 strcpy (basename
, XSTRING (Vinvocation_name
)->data
);
4778 str
= strrchr (basename
, '.');
4780 Vinvocation_name
= build_string (basename
);
4782 Vx_resource_name
= Vinvocation_name
;
4784 validate_x_resource_name ();
4786 /* This is what opens the connection and sets x_current_display.
4787 This also initializes many symbols, such as those used for input. */
4788 dpyinfo
= win32_term_init (display
, xrm_option
,
4789 (char *) XSTRING (Vx_resource_name
)->data
);
4793 if (!NILP (must_succeed
))
4794 fatal ("Cannot connect to server %s.\n",
4795 XSTRING (display
)->data
);
4797 error ("Cannot connect to server %s", XSTRING (display
)->data
);
4800 XSETFASTINT (Vwindow_system_version
, 3);
4804 DEFUN ("x-close-connection", Fx_close_connection
,
4805 Sx_close_connection
, 1, 1, 0,
4806 "Close the connection to DISPLAY's server.\n\
4807 For DISPLAY, specify either a frame or a display name (a string).\n\
4808 If DISPLAY is nil, that stands for the selected frame's display.")
4810 Lisp_Object display
;
4812 struct win32_display_info
*dpyinfo
= check_x_display_info (display
);
4813 struct win32_display_info
*tail
;
4816 if (dpyinfo
->reference_count
> 0)
4817 error ("Display still has frames on it");
4820 /* Free the fonts in the font table. */
4821 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
4823 if (dpyinfo
->font_table
[i
].name
)
4824 free (dpyinfo
->font_table
[i
].name
);
4825 /* Don't free the full_name string;
4826 it is always shared with something else. */
4827 win32_unload_font (dpyinfo
, dpyinfo
->font_table
[i
].font
);
4829 x_destroy_all_bitmaps (dpyinfo
);
4831 x_delete_display (dpyinfo
);
4837 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
4838 "Return the list of display names that Emacs has connections to.")
4841 Lisp_Object tail
, result
;
4844 for (tail
= win32_display_name_list
; ! NILP (tail
); tail
= XCONS (tail
)->cdr
)
4845 result
= Fcons (XCONS (XCONS (tail
)->car
)->car
, result
);
4850 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
4851 "If ON is non-nil, report errors as soon as the erring request is made.\n\
4852 If ON is nil, allow buffering of requests.\n\
4853 This is a noop on Win32 systems.\n\
4854 The optional second argument DISPLAY specifies which display to act on.\n\
4855 DISPLAY should be either a frame or a display name (a string).\n\
4856 If DISPLAY is omitted or nil, that stands for the selected frame's display.")
4858 Lisp_Object display
, on
;
4860 struct win32_display_info
*dpyinfo
= check_x_display_info (display
);
4866 /* These are the win32 specialized functions */
4868 DEFUN ("win32-select-font", Fwin32_select_font
, Swin32_select_font
, 0, 1, 0,
4869 "This will display the Win32 font dialog and return an X font string corresponding to the selection.")
4873 FRAME_PTR f
= check_x_frame (frame
);
4878 bzero (&cf
, sizeof (cf
));
4880 cf
.lStructSize
= sizeof (cf
);
4881 cf
.hwndOwner
= FRAME_WIN32_WINDOW (f
);
4882 cf
.Flags
= CF_FIXEDPITCHONLY
| CF_FORCEFONTEXIST
| CF_SCREENFONTS
;
4885 if (!ChooseFont (&cf
) || !win32_to_x_font (&lf
, buf
, 100))
4888 return build_string (buf
);
4894 /* The section below is built by the lisp expression at the top of the file,
4895 just above where these variables are declared. */
4896 /*&&& init symbols here &&&*/
4897 Qauto_raise
= intern ("auto-raise");
4898 staticpro (&Qauto_raise
);
4899 Qauto_lower
= intern ("auto-lower");
4900 staticpro (&Qauto_lower
);
4901 Qbackground_color
= intern ("background-color");
4902 staticpro (&Qbackground_color
);
4903 Qbar
= intern ("bar");
4905 Qborder_color
= intern ("border-color");
4906 staticpro (&Qborder_color
);
4907 Qborder_width
= intern ("border-width");
4908 staticpro (&Qborder_width
);
4909 Qbox
= intern ("box");
4911 Qcursor_color
= intern ("cursor-color");
4912 staticpro (&Qcursor_color
);
4913 Qcursor_type
= intern ("cursor-type");
4914 staticpro (&Qcursor_type
);
4915 Qfont
= intern ("font");
4917 Qforeground_color
= intern ("foreground-color");
4918 staticpro (&Qforeground_color
);
4919 Qgeometry
= intern ("geometry");
4920 staticpro (&Qgeometry
);
4921 Qicon_left
= intern ("icon-left");
4922 staticpro (&Qicon_left
);
4923 Qicon_top
= intern ("icon-top");
4924 staticpro (&Qicon_top
);
4925 Qicon_type
= intern ("icon-type");
4926 staticpro (&Qicon_type
);
4927 Qicon_name
= intern ("icon-name");
4928 staticpro (&Qicon_name
);
4929 Qinternal_border_width
= intern ("internal-border-width");
4930 staticpro (&Qinternal_border_width
);
4931 Qleft
= intern ("left");
4933 Qmouse_color
= intern ("mouse-color");
4934 staticpro (&Qmouse_color
);
4935 Qnone
= intern ("none");
4937 Qparent_id
= intern ("parent-id");
4938 staticpro (&Qparent_id
);
4939 Qscroll_bar_width
= intern ("scroll-bar-width");
4940 staticpro (&Qscroll_bar_width
);
4941 Qsuppress_icon
= intern ("suppress-icon");
4942 staticpro (&Qsuppress_icon
);
4943 Qtop
= intern ("top");
4945 Qundefined_color
= intern ("undefined-color");
4946 staticpro (&Qundefined_color
);
4947 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
4948 staticpro (&Qvertical_scroll_bars
);
4949 Qvisibility
= intern ("visibility");
4950 staticpro (&Qvisibility
);
4951 Qwindow_id
= intern ("window-id");
4952 staticpro (&Qwindow_id
);
4953 Qx_frame_parameter
= intern ("x-frame-parameter");
4954 staticpro (&Qx_frame_parameter
);
4955 Qx_resource_name
= intern ("x-resource-name");
4956 staticpro (&Qx_resource_name
);
4957 Quser_position
= intern ("user-position");
4958 staticpro (&Quser_position
);
4959 Quser_size
= intern ("user-size");
4960 staticpro (&Quser_size
);
4961 Qdisplay
= intern ("display");
4962 staticpro (&Qdisplay
);
4963 /* This is the end of symbol initialization. */
4965 Fput (Qundefined_color
, Qerror_conditions
,
4966 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
4967 Fput (Qundefined_color
, Qerror_message
,
4968 build_string ("Undefined color"));
4970 DEFVAR_LISP ("win32-color-map", &Vwin32_color_map
,
4971 "A array of color name mappings for windows.");
4972 Vwin32_color_map
= Qnil
;
4974 DEFVAR_LISP ("win32-pass-alt-to-system", &Vwin32_pass_alt_to_system
,
4975 "Non-nil if alt key presses are passed on to Windows.\n\
4976 When non-nil, for example, alt pressed and released and then space will\n\
4977 open the System menu. When nil, Emacs silently swallows alt key events.");
4978 Vwin32_pass_alt_to_system
= Qnil
;
4980 DEFVAR_LISP ("win32-pass-optional-keys-to-system",
4981 &Vwin32_pass_optional_keys_to_system
,
4982 "Non-nil if the 'optional' keys (left window, right window,\n\
4983 and application keys) are passed on to Windows.");
4984 Vwin32_pass_optional_keys_to_system
= Qnil
;
4986 DEFVAR_LISP ("win32-enable-italics", &Vwin32_enable_italics
,
4987 "Non-nil enables selection of artificially italicized fonts.");
4988 Vwin32_enable_italics
= Qnil
;
4990 DEFVAR_LISP ("win32-enable-palette", &Vwin32_enable_palette
,
4991 "Non-nil enables Windows palette management to map colors exactly.");
4992 Vwin32_enable_palette
= Qt
;
4994 DEFVAR_INT ("win32-mouse-button-tolerance",
4995 &Vwin32_mouse_button_tolerance
,
4996 "Analogue of double click interval for faking middle mouse events.\n\
4997 The value is the minimum time in milliseconds that must elapse between\n\
4998 left/right button down events before they are considered distinct events.\n\
4999 If both mouse buttons are depressed within this interval, a middle mouse\n\
5000 button down event is generated instead.");
5001 XSETINT (Vwin32_mouse_button_tolerance
, GetDoubleClickTime () / 2);
5003 DEFVAR_INT ("win32-mouse-move-interval",
5004 &Vwin32_mouse_move_interval
,
5005 "Minimum interval between mouse move events.\n\
5006 The value is the minimum time in milliseconds that must elapse between\n\
5007 successive mouse move (or scroll bar drag) events before they are\n\
5008 reported as lisp events.");
5009 XSETINT (Vwin32_mouse_move_interval
, 50);
5011 init_x_parm_symbols ();
5013 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path
,
5014 "List of directories to search for bitmap files for win32.");
5015 Vx_bitmap_file_path
= decode_env_path ((char *) 0, "PATH");
5017 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
5018 "The shape of the pointer when over text.\n\
5019 Changing the value does not affect existing frames\n\
5020 unless you set the mouse color.");
5021 Vx_pointer_shape
= Qnil
;
5023 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
5024 "The name Emacs uses to look up resources; for internal use only.\n\
5025 `x-get-resource' uses this as the first component of the instance name\n\
5026 when requesting resource values.\n\
5027 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
5028 was invoked, or to the value specified with the `-name' or `-rn'\n\
5029 switches, if present.");
5030 Vx_resource_name
= Qnil
;
5032 Vx_nontext_pointer_shape
= Qnil
;
5034 Vx_mode_pointer_shape
= Qnil
;
5036 DEFVAR_INT ("x-sensitive-text-pointer-shape",
5037 &Vx_sensitive_text_pointer_shape
,
5038 "The shape of the pointer when over mouse-sensitive text.\n\
5039 This variable takes effect when you create a new frame\n\
5040 or when you set the mouse color.");
5041 Vx_sensitive_text_pointer_shape
= Qnil
;
5043 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
5044 "A string indicating the foreground color of the cursor box.");
5045 Vx_cursor_fore_pixel
= Qnil
;
5047 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
5048 "Non-nil if no window manager is in use.\n\
5049 Emacs doesn't try to figure this out; this is always nil\n\
5050 unless you set it to something else.");
5051 /* We don't have any way to find this out, so set it to nil
5052 and maybe the user would like to set it to t. */
5053 Vx_no_window_manager
= Qnil
;
5055 defsubr (&Sx_get_resource
);
5056 defsubr (&Sx_list_fonts
);
5057 defsubr (&Sx_display_color_p
);
5058 defsubr (&Sx_display_grayscale_p
);
5059 defsubr (&Sx_color_defined_p
);
5060 defsubr (&Sx_color_values
);
5061 defsubr (&Sx_server_max_request_size
);
5062 defsubr (&Sx_server_vendor
);
5063 defsubr (&Sx_server_version
);
5064 defsubr (&Sx_display_pixel_width
);
5065 defsubr (&Sx_display_pixel_height
);
5066 defsubr (&Sx_display_mm_width
);
5067 defsubr (&Sx_display_mm_height
);
5068 defsubr (&Sx_display_screens
);
5069 defsubr (&Sx_display_planes
);
5070 defsubr (&Sx_display_color_cells
);
5071 defsubr (&Sx_display_visual_class
);
5072 defsubr (&Sx_display_backing_store
);
5073 defsubr (&Sx_display_save_under
);
5074 defsubr (&Sx_parse_geometry
);
5075 defsubr (&Sx_create_frame
);
5076 defsubr (&Sfocus_frame
);
5077 defsubr (&Sunfocus_frame
);
5078 defsubr (&Sx_open_connection
);
5079 defsubr (&Sx_close_connection
);
5080 defsubr (&Sx_display_list
);
5081 defsubr (&Sx_synchronize
);
5083 /* Win32 specific functions */
5085 defsubr (&Swin32_select_font
);
5086 defsubr (&Swin32_define_rgb_color
);
5087 defsubr (&Swin32_default_color_map
);
5088 defsubr (&Swin32_load_color_file
);
5097 button
= MessageBox (NULL
,
5098 "A fatal error has occurred!\n\n"
5099 "Select Abort to exit, Retry to debug, Ignore to continue",
5100 "Emacs Abort Dialog",
5101 MB_ICONEXCLAMATION
| MB_TASKMODAL
5102 | MB_SETFOREGROUND
| MB_ABORTRETRYIGNORE
);