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
2782 /* Synchronize modifier state with what is reported with the current
2783 keystroke. Even if we cannot distinguish between left and right
2784 modifier keys, we know that, if no modifiers are set, then neither
2785 the left or right modifier should be set. */
2789 if (!modifiers_recorded
)
2792 if (!(GetKeyState (VK_CONTROL
) & 0x8000))
2793 modifiers
[EMACS_RCONTROL
] = modifiers
[EMACS_LCONTROL
] = 0;
2795 if (!(GetKeyState (VK_MENU
) & 0x8000))
2796 modifiers
[EMACS_RMENU
] = modifiers
[EMACS_LMENU
] = 0;
2800 modifier_set (int vkey
)
2802 if (vkey
== VK_CAPITAL
)
2803 return (GetKeyState (vkey
) & 0x1);
2804 if (!modifiers_recorded
)
2805 return (GetKeyState (vkey
) & 0x8000);
2810 return modifiers
[EMACS_LCONTROL
];
2812 return modifiers
[EMACS_RCONTROL
];
2814 return modifiers
[EMACS_LMENU
];
2816 return modifiers
[EMACS_RMENU
];
2820 return (GetKeyState (vkey
) & 0x8000);
2823 /* We map the VK_* modifiers into console modifier constants
2824 so that we can use the same routines to handle both console
2825 and window input. */
2828 construct_modifiers (unsigned int wparam
, unsigned int lparam
)
2832 if (wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
)
2833 mods
= GetLastError ();
2836 mods
|= (modifier_set (VK_SHIFT
)) ? SHIFT_PRESSED
: 0;
2837 mods
|= (modifier_set (VK_CAPITAL
)) ? CAPSLOCK_ON
: 0;
2838 mods
|= (modifier_set (VK_LCONTROL
)) ? LEFT_CTRL_PRESSED
: 0;
2839 mods
|= (modifier_set (VK_RCONTROL
)) ? RIGHT_CTRL_PRESSED
: 0;
2840 mods
|= (modifier_set (VK_LMENU
)) ? LEFT_ALT_PRESSED
: 0;
2841 mods
|= (modifier_set (VK_RMENU
)) ? RIGHT_ALT_PRESSED
: 0;
2847 map_keypad_keys (unsigned int wparam
, unsigned int lparam
)
2849 unsigned int extended
= (lparam
& 0x1000000L
);
2851 if (wparam
< VK_CLEAR
|| wparam
> VK_DELETE
)
2854 if (wparam
== VK_RETURN
)
2855 return (extended
? VK_NUMPAD_ENTER
: VK_RETURN
);
2857 if (wparam
>= VK_PRIOR
&& wparam
<= VK_DOWN
)
2858 return (!extended
? (VK_NUMPAD_PRIOR
+ (wparam
- VK_PRIOR
)) : wparam
);
2860 if (wparam
== VK_INSERT
|| wparam
== VK_DELETE
)
2861 return (!extended
? (VK_NUMPAD_INSERT
+ (wparam
- VK_INSERT
)) : wparam
);
2863 if (wparam
== VK_CLEAR
)
2864 return (!extended
? VK_NUMPAD_CLEAR
: wparam
);
2869 /* Main message dispatch loop. */
2877 /* Ensure our message queue is created */
2879 PeekMessage (&msg
, NULL
, 0, 0, PM_NOREMOVE
);
2881 PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
, 0, 0);
2883 while (GetMessage (&msg
, NULL
, 0, 0))
2885 if (msg
.hwnd
== NULL
)
2887 switch (msg
.message
)
2889 case WM_EMACS_CREATEWINDOW
:
2890 win32_createwindow ((struct frame
*) msg
.wParam
);
2891 PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
, 0, 0);
2893 case WM_EMACS_CREATESCROLLBAR
:
2895 HWND hwnd
= win32_createscrollbar ((struct frame
*) msg
.wParam
,
2896 (struct scroll_bar
*) msg
.lParam
);
2897 PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
, (WPARAM
)hwnd
, 0);
2906 DispatchMessage (&msg
);
2913 /* Main window procedure */
2915 extern char *lispy_function_keys
[];
2918 win32_wnd_proc (hwnd
, msg
, wParam
, lParam
)
2926 struct win32_display_info
*dpyinfo
= &one_win32_display_info
;
2928 int windows_translate
;
2934 GetUpdateRect (hwnd
, &wmsg
.rect
, FALSE
);
2936 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
2938 case WM_PALETTECHANGED
:
2939 /* ignore our own changes */
2940 if ((HWND
)wParam
!= hwnd
)
2942 /* simply notify main thread it may need to update frames */
2943 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
2948 PAINTSTRUCT paintStruct
;
2951 BeginPaint (hwnd
, &paintStruct
);
2952 wmsg
.rect
= paintStruct
.rcPaint
;
2953 EndPaint (hwnd
, &paintStruct
);
2956 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
2963 record_keyup (wParam
, lParam
);
2968 /* Synchronize modifiers with current keystroke. */
2971 record_keydown (wParam
, lParam
);
2973 wParam
= map_keypad_keys (wParam
, lParam
);
2975 windows_translate
= 0;
2980 /* More support for these keys will likely be necessary. */
2981 if (!NILP (Vwin32_pass_optional_keys_to_system
))
2982 windows_translate
= 1;
2985 if (NILP (Vwin32_pass_alt_to_system
))
2987 windows_translate
= 1;
2994 windows_translate
= 1;
2997 /* If not defined as a function key, change it to a WM_CHAR message. */
2998 if (lispy_function_keys
[wParam
] == 0)
3003 if (windows_translate
)
3005 MSG winmsg
= { hwnd
, msg
, wParam
, lParam
, 0, {0,0} };
3007 winmsg
.time
= GetMessageTime ();
3008 TranslateMessage (&winmsg
);
3016 wmsg
.dwModifiers
= construct_modifiers (wParam
, lParam
);
3019 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3022 /* Detect quit_char and set quit-flag directly. Note that we dow
3023 this *after* posting the message to ensure the main thread will
3024 be woken up if blocked in sys_select(). */
3027 if (isalpha (c
) && (wmsg
.dwModifiers
== LEFT_CTRL_PRESSED
3028 || wmsg
.dwModifiers
== RIGHT_CTRL_PRESSED
))
3029 c
= make_ctrl_char (c
) & 0377;
3038 /* Simulate middle mouse button events when left and right buttons
3039 are used together, but only if user has two button mouse. */
3040 case WM_LBUTTONDOWN
:
3041 case WM_RBUTTONDOWN
:
3042 if (XINT (Vwin32_num_mouse_buttons
) == 3)
3043 goto handle_plain_button
;
3046 int this = (msg
== WM_LBUTTONDOWN
) ? LMOUSE
: RMOUSE
;
3047 int other
= (msg
== WM_LBUTTONDOWN
) ? RMOUSE
: LMOUSE
;
3049 if (button_state
& this)
3052 if (button_state
== 0)
3055 button_state
|= this;
3057 if (button_state
& other
)
3059 if (mouse_button_timer
)
3061 KillTimer (hwnd
, mouse_button_timer
);
3062 mouse_button_timer
= 0;
3064 /* Generate middle mouse event instead. */
3065 msg
= WM_MBUTTONDOWN
;
3066 button_state
|= MMOUSE
;
3068 else if (button_state
& MMOUSE
)
3070 /* Ignore button event if we've already generated a
3071 middle mouse down event. This happens if the
3072 user releases and press one of the two buttons
3073 after we've faked a middle mouse event. */
3078 /* Flush out saved message. */
3079 post_msg (&saved_mouse_button_msg
);
3081 wmsg
.dwModifiers
= win32_get_modifiers ();
3082 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3084 /* Clear message buffer. */
3085 saved_mouse_button_msg
.msg
.hwnd
= 0;
3089 /* Hold onto message for now. */
3090 mouse_button_timer
=
3091 SetTimer (hwnd
, MOUSE_BUTTON_ID
, XINT (Vwin32_mouse_button_tolerance
), NULL
);
3092 saved_mouse_button_msg
.msg
.hwnd
= hwnd
;
3093 saved_mouse_button_msg
.msg
.message
= msg
;
3094 saved_mouse_button_msg
.msg
.wParam
= wParam
;
3095 saved_mouse_button_msg
.msg
.lParam
= lParam
;
3096 saved_mouse_button_msg
.msg
.time
= GetMessageTime ();
3097 saved_mouse_button_msg
.dwModifiers
= win32_get_modifiers ();
3104 if (XINT (Vwin32_num_mouse_buttons
) == 3)
3105 goto handle_plain_button
;
3108 int this = (msg
== WM_LBUTTONUP
) ? LMOUSE
: RMOUSE
;
3109 int other
= (msg
== WM_LBUTTONUP
) ? RMOUSE
: LMOUSE
;
3111 if ((button_state
& this) == 0)
3114 button_state
&= ~this;
3116 if (button_state
& MMOUSE
)
3118 /* Only generate event when second button is released. */
3119 if ((button_state
& other
) == 0)
3122 button_state
&= ~MMOUSE
;
3124 if (button_state
) abort ();
3131 /* Flush out saved message if necessary. */
3132 if (saved_mouse_button_msg
.msg
.hwnd
)
3134 post_msg (&saved_mouse_button_msg
);
3137 wmsg
.dwModifiers
= win32_get_modifiers ();
3138 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3140 /* Always clear message buffer and cancel timer. */
3141 saved_mouse_button_msg
.msg
.hwnd
= 0;
3142 KillTimer (hwnd
, mouse_button_timer
);
3143 mouse_button_timer
= 0;
3145 if (button_state
== 0)
3150 case WM_MBUTTONDOWN
:
3152 handle_plain_button
:
3156 if (parse_button (msg
, NULL
, &up
))
3158 if (up
) ReleaseCapture ();
3159 else SetCapture (hwnd
);
3163 wmsg
.dwModifiers
= win32_get_modifiers ();
3164 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3169 if (XINT (Vwin32_mouse_move_interval
) <= 0
3170 || (msg
== WM_MOUSEMOVE
&& button_state
== 0))
3172 wmsg
.dwModifiers
= win32_get_modifiers ();
3173 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3177 /* Hang onto mouse move and scroll messages for a bit, to avoid
3178 sending such events to Emacs faster than it can process them.
3179 If we get more events before the timer from the first message
3180 expires, we just replace the first message. */
3182 if (saved_mouse_move_msg
.msg
.hwnd
== 0)
3184 SetTimer (hwnd
, MOUSE_MOVE_ID
, XINT (Vwin32_mouse_move_interval
), NULL
);
3186 /* Hold onto message for now. */
3187 saved_mouse_move_msg
.msg
.hwnd
= hwnd
;
3188 saved_mouse_move_msg
.msg
.message
= msg
;
3189 saved_mouse_move_msg
.msg
.wParam
= wParam
;
3190 saved_mouse_move_msg
.msg
.lParam
= lParam
;
3191 saved_mouse_move_msg
.msg
.time
= GetMessageTime ();
3192 saved_mouse_move_msg
.dwModifiers
= win32_get_modifiers ();
3197 /* Flush out saved messages if necessary. */
3198 if (wParam
== mouse_button_timer
)
3200 if (saved_mouse_button_msg
.msg
.hwnd
)
3202 post_msg (&saved_mouse_button_msg
);
3203 saved_mouse_button_msg
.msg
.hwnd
= 0;
3205 KillTimer (hwnd
, mouse_button_timer
);
3206 mouse_button_timer
= 0;
3208 else if (wParam
== mouse_move_timer
)
3210 if (saved_mouse_move_msg
.msg
.hwnd
)
3212 post_msg (&saved_mouse_move_msg
);
3213 saved_mouse_move_msg
.msg
.hwnd
= 0;
3215 KillTimer (hwnd
, mouse_move_timer
);
3216 mouse_move_timer
= 0;
3221 /* Windows doesn't send us focus messages when putting up and
3222 taking down a system popup dialog as for Ctrl-Alt-Del on Win95.
3223 The only indication we get that something happened is receiving
3224 this message afterwards. So this is a good time to reset our
3225 keyboard modifiers' state. */
3236 wmsg
.dwModifiers
= win32_get_modifiers ();
3237 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3241 wmsg
.dwModifiers
= win32_get_modifiers ();
3242 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3245 case WM_WINDOWPOSCHANGING
:
3248 LPWINDOWPOS lppos
= (WINDOWPOS
*) lParam
;
3250 GetWindowPlacement (hwnd
, &wp
);
3252 if (wp
.showCmd
!= SW_SHOWMINIMIZED
&& ! (lppos
->flags
& SWP_NOSIZE
))
3261 wp
.length
= sizeof(wp
);
3262 GetWindowRect (hwnd
, &wr
);
3266 dwXUnits
= GetWindowLong (hwnd
, WND_X_UNITS_INDEX
);
3267 dwYUnits
= GetWindowLong (hwnd
, WND_Y_UNITS_INDEX
);
3271 memset (&rect
, 0, sizeof (rect
));
3272 AdjustWindowRect (&rect
, GetWindowLong (hwnd
, GWL_STYLE
),
3273 GetMenu (hwnd
) != NULL
);
3275 /* All windows have an extra pixel so subtract 1 */
3277 wdiff
= (lppos
->cx
- (rect
.right
- rect
.left
) - 0) % dwXUnits
;
3278 hdiff
= (lppos
->cy
- (rect
.bottom
- rect
.top
) - 0) % dwYUnits
;
3282 /* For right/bottom sizing we can just fix the sizes.
3283 However for top/left sizing we will need to fix the X
3284 and Y positions as well. */
3289 if (wp
.showCmd
!= SW_SHOWMAXIMIZED
3290 && ! (lppos
->flags
& SWP_NOMOVE
))
3292 if (lppos
->x
!= wr
.left
|| lppos
->y
!= wr
.top
)
3299 lppos
->flags
|= SWP_NOMOVE
;
3308 if (ret
== 0) return (0);
3311 case WM_EMACS_SHOWWINDOW
:
3312 return ShowWindow (hwnd
, wParam
);
3313 case WM_EMACS_SETWINDOWPOS
:
3315 Win32WindowPos
* pos
= (Win32WindowPos
*) wParam
;
3316 return SetWindowPos (hwnd
, pos
->hwndAfter
,
3317 pos
->x
, pos
->y
, pos
->cx
, pos
->cy
, pos
->flags
);
3319 case WM_EMACS_DESTROYWINDOW
:
3320 DestroyWindow ((HWND
) wParam
);
3324 return DefWindowProc (hwnd
, msg
, wParam
, lParam
);
3331 my_create_window (f
)
3336 PostThreadMessage (dwWinThreadId
, WM_EMACS_CREATEWINDOW
, (WPARAM
)f
, 0);
3337 GetMessage (&msg
, NULL
, WM_EMACS_DONE
, WM_EMACS_DONE
);
3340 /* Create and set up the win32 window for frame F. */
3343 win32_window (f
, window_prompting
, minibuffer_only
)
3345 long window_prompting
;
3346 int minibuffer_only
;
3350 /* Use the resource name as the top-level window name
3351 for looking up resources. Make a non-Lisp copy
3352 for the window manager, so GC relocation won't bother it.
3354 Elsewhere we specify the window name for the window manager. */
3357 char *str
= (char *) XSTRING (Vx_resource_name
)->data
;
3358 f
->namebuf
= (char *) xmalloc (strlen (str
) + 1);
3359 strcpy (f
->namebuf
, str
);
3362 my_create_window (f
);
3364 validate_x_resource_name ();
3366 /* x_set_name normally ignores requests to set the name if the
3367 requested name is the same as the current name. This is the one
3368 place where that assumption isn't correct; f->name is set, but
3369 the server hasn't been told. */
3372 int explicit = f
->explicit_name
;
3374 f
->explicit_name
= 0;
3377 x_set_name (f
, name
, explicit);
3382 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
3383 initialize_frame_menubar (f
);
3385 if (FRAME_WIN32_WINDOW (f
) == 0)
3386 error ("Unable to create window");
3389 /* Handle the icon stuff for this window. Perhaps later we might
3390 want an x_set_icon_position which can be called interactively as
3398 Lisp_Object icon_x
, icon_y
;
3400 /* Set the position of the icon. Note that win95 groups all
3401 icons in the tray. */
3402 icon_x
= x_get_arg (parms
, Qicon_left
, 0, 0, number
);
3403 icon_y
= x_get_arg (parms
, Qicon_top
, 0, 0, number
);
3404 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
3406 CHECK_NUMBER (icon_x
, 0);
3407 CHECK_NUMBER (icon_y
, 0);
3409 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
3410 error ("Both left and top icon corners of icon must be specified");
3414 if (! EQ (icon_x
, Qunbound
))
3415 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
3420 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
3422 "Make a new window, which is called a \"frame\" in Emacs terms.\n\
3423 Returns an Emacs frame object.\n\
3424 ALIST is an alist of frame parameters.\n\
3425 If the parameters specify that the frame should not have a minibuffer,\n\
3426 and do not specify a specific minibuffer window to use,\n\
3427 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
3428 be shared by the new frame.\n\
3430 This function is an internal primitive--use `make-frame' instead.")
3435 Lisp_Object frame
, tem
;
3437 int minibuffer_only
= 0;
3438 long window_prompting
= 0;
3440 int count
= specpdl_ptr
- specpdl
;
3441 struct gcpro gcpro1
;
3442 Lisp_Object display
;
3443 struct win32_display_info
*dpyinfo
;
3447 /* Use this general default value to start with
3448 until we know if this frame has a specified name. */
3449 Vx_resource_name
= Vinvocation_name
;
3451 display
= x_get_arg (parms
, Qdisplay
, 0, 0, string
);
3452 if (EQ (display
, Qunbound
))
3454 dpyinfo
= check_x_display_info (display
);
3456 kb
= dpyinfo
->kboard
;
3458 kb
= &the_only_kboard
;
3461 name
= x_get_arg (parms
, Qname
, "title", "Title", string
);
3463 && ! EQ (name
, Qunbound
)
3465 error ("Invalid frame name--not a string or nil");
3468 Vx_resource_name
= name
;
3470 /* See if parent window is specified. */
3471 parent
= x_get_arg (parms
, Qparent_id
, NULL
, NULL
, number
);
3472 if (EQ (parent
, Qunbound
))
3474 if (! NILP (parent
))
3475 CHECK_NUMBER (parent
, 0);
3477 tem
= x_get_arg (parms
, Qminibuffer
, 0, 0, symbol
);
3478 if (EQ (tem
, Qnone
) || NILP (tem
))
3479 f
= make_frame_without_minibuffer (Qnil
, kb
, display
);
3480 else if (EQ (tem
, Qonly
))
3482 f
= make_minibuffer_frame ();
3483 minibuffer_only
= 1;
3485 else if (WINDOWP (tem
))
3486 f
= make_frame_without_minibuffer (tem
, kb
, display
);
3490 /* Note that Windows does support scroll bars. */
3491 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
3492 /* By default, make scrollbars the system standard width. */
3493 f
->scroll_bar_pixel_width
= GetSystemMetrics (SM_CXVSCROLL
);
3495 XSETFRAME (frame
, f
);
3498 f
->output_method
= output_win32
;
3499 f
->output_data
.win32
= (struct win32_output
*) xmalloc (sizeof (struct win32_output
));
3500 bzero (f
->output_data
.win32
, sizeof (struct win32_output
));
3502 /* FRAME_WIN32_DISPLAY_INFO (f) = dpyinfo; */
3504 FRAME_KBOARD (f
) = kb
;
3507 /* Specify the parent under which to make this window. */
3511 f
->output_data
.win32
->parent_desc
= (Window
) parent
;
3512 f
->output_data
.win32
->explicit_parent
= 1;
3516 f
->output_data
.win32
->parent_desc
= FRAME_WIN32_DISPLAY_INFO (f
)->root_window
;
3517 f
->output_data
.win32
->explicit_parent
= 0;
3520 /* Note that the frame has no physical cursor right now. */
3521 f
->phys_cursor_x
= -1;
3523 /* Set the name; the functions to which we pass f expect the name to
3525 if (EQ (name
, Qunbound
) || NILP (name
))
3527 f
->name
= build_string (dpyinfo
->win32_id_name
);
3528 f
->explicit_name
= 0;
3533 f
->explicit_name
= 1;
3534 /* use the frame's title when getting resources for this frame. */
3535 specbind (Qx_resource_name
, name
);
3538 /* Extract the window parameters from the supplied values
3539 that are needed to determine window geometry. */
3543 font
= x_get_arg (parms
, Qfont
, "font", "Font", string
);
3545 /* First, try whatever font the caller has specified. */
3547 font
= x_new_font (f
, XSTRING (font
)->data
);
3549 /* Try out a font which we hope has bold and italic variations. */
3550 if (!STRINGP (font
))
3551 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3552 if (! STRINGP (font
))
3553 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3554 if (! STRINGP (font
))
3555 /* This was formerly the first thing tried, but it finds too many fonts
3556 and takes too long. */
3557 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
3558 /* If those didn't work, look for something which will at least work. */
3559 if (! STRINGP (font
))
3560 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
3561 if (! STRINGP (font
))
3562 font
= x_new_font (f
, "-*-system-medium-r-normal-*-*-200-*-*-c-120-*-*");
3564 if (! STRINGP (font
))
3565 font
= x_new_font (f
, "-*-Fixedsys-*-r-*-*-12-90-*-*-c-*-*-*");
3567 if (! STRINGP (font
))
3568 font
= build_string ("-*-system");
3570 x_default_parameter (f
, parms
, Qfont
, font
,
3571 "font", "Font", string
);
3574 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
3575 "borderwidth", "BorderWidth", number
);
3576 /* This defaults to 2 in order to match xterm. We recognize either
3577 internalBorderWidth or internalBorder (which is what xterm calls
3579 if (NILP (Fassq (Qinternal_border_width
, parms
)))
3583 value
= x_get_arg (parms
, Qinternal_border_width
,
3584 "internalBorder", "BorderWidth", number
);
3585 if (! EQ (value
, Qunbound
))
3586 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
3589 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (0),
3590 "internalBorderWidth", "BorderWidth", number
);
3591 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qt
,
3592 "verticalScrollBars", "ScrollBars", boolean
);
3594 /* Also do the stuff which must be set before the window exists. */
3595 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
3596 "foreground", "Foreground", string
);
3597 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
3598 "background", "Background", string
);
3599 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
3600 "pointerColor", "Foreground", string
);
3601 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
3602 "cursorColor", "Foreground", string
);
3603 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
3604 "borderColor", "BorderColor", string
);
3606 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (1),
3607 "menuBar", "MenuBar", number
);
3608 x_default_parameter (f
, parms
, Qscroll_bar_width
, Qnil
,
3609 "scrollBarWidth", "ScrollBarWidth", number
);
3611 f
->output_data
.win32
->dwStyle
= WS_OVERLAPPEDWINDOW
;
3612 f
->output_data
.win32
->parent_desc
= FRAME_WIN32_DISPLAY_INFO (f
)->root_window
;
3613 window_prompting
= x_figure_window_size (f
, parms
);
3615 if (window_prompting
& XNegative
)
3617 if (window_prompting
& YNegative
)
3618 f
->output_data
.win32
->win_gravity
= SouthEastGravity
;
3620 f
->output_data
.win32
->win_gravity
= NorthEastGravity
;
3624 if (window_prompting
& YNegative
)
3625 f
->output_data
.win32
->win_gravity
= SouthWestGravity
;
3627 f
->output_data
.win32
->win_gravity
= NorthWestGravity
;
3630 f
->output_data
.win32
->size_hint_flags
= window_prompting
;
3632 win32_window (f
, window_prompting
, minibuffer_only
);
3634 init_frame_faces (f
);
3636 /* We need to do this after creating the window, so that the
3637 icon-creation functions can say whose icon they're describing. */
3638 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
3639 "bitmapIcon", "BitmapIcon", symbol
);
3641 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
3642 "autoRaise", "AutoRaiseLower", boolean
);
3643 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
3644 "autoLower", "AutoRaiseLower", boolean
);
3645 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
3646 "cursorType", "CursorType", symbol
);
3648 /* Dimensions, especially f->height, must be done via change_frame_size.
3649 Change will not be effected unless different from the current
3653 f
->height
= f
->width
= 0;
3654 change_frame_size (f
, height
, width
, 1, 0);
3656 /* Tell the server what size and position, etc, we want,
3657 and how badly we want them. */
3659 x_wm_set_size_hint (f
, window_prompting
, 0);
3662 tem
= x_get_arg (parms
, Qunsplittable
, 0, 0, boolean
);
3663 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
3667 /* It is now ok to make the frame official
3668 even if we get an error below.
3669 And the frame needs to be on Vframe_list
3670 or making it visible won't work. */
3671 Vframe_list
= Fcons (frame
, Vframe_list
);
3673 /* Now that the frame is official, it counts as a reference to
3675 FRAME_WIN32_DISPLAY_INFO (f
)->reference_count
++;
3677 /* Make the window appear on the frame and enable display,
3678 unless the caller says not to. However, with explicit parent,
3679 Emacs cannot control visibility, so don't try. */
3680 if (! f
->output_data
.win32
->explicit_parent
)
3682 Lisp_Object visibility
;
3684 visibility
= x_get_arg (parms
, Qvisibility
, 0, 0, symbol
);
3685 if (EQ (visibility
, Qunbound
))
3688 if (EQ (visibility
, Qicon
))
3689 x_iconify_frame (f
);
3690 else if (! NILP (visibility
))
3691 x_make_frame_visible (f
);
3693 /* Must have been Qnil. */
3697 return unbind_to (count
, frame
);
3700 /* FRAME is used only to get a handle on the X display. We don't pass the
3701 display info directly because we're called from frame.c, which doesn't
3702 know about that structure. */
3704 x_get_focus_frame (frame
)
3705 struct frame
*frame
;
3707 struct win32_display_info
*dpyinfo
= FRAME_WIN32_DISPLAY_INFO (frame
);
3709 if (! dpyinfo
->win32_focus_frame
)
3712 XSETFRAME (xfocus
, dpyinfo
->win32_focus_frame
);
3716 DEFUN ("focus-frame", Ffocus_frame
, Sfocus_frame
, 1, 1, 0,
3717 "This function is obsolete, and does nothing.")
3724 DEFUN ("unfocus-frame", Funfocus_frame
, Sunfocus_frame
, 0, 0, 0,
3725 "This function is obsolete, and does nothing.")
3732 win32_load_font (dpyinfo
,name
)
3733 struct win32_display_info
*dpyinfo
;
3736 XFontStruct
* font
= NULL
;
3742 if (!name
|| !x_to_win32_font (name
, &lf
))
3745 font
= (XFontStruct
*) xmalloc (sizeof (XFontStruct
));
3747 if (!font
) return (NULL
);
3751 font
->hfont
= CreateFontIndirect (&lf
);
3754 if (font
->hfont
== NULL
)
3763 hdc
= GetDC (dpyinfo
->root_window
);
3764 oldobj
= SelectObject (hdc
, font
->hfont
);
3765 ok
= GetTextMetrics (hdc
, &font
->tm
);
3766 SelectObject (hdc
, oldobj
);
3767 ReleaseDC (dpyinfo
->root_window
, hdc
);
3772 if (ok
) return (font
);
3774 win32_unload_font (dpyinfo
, font
);
3779 win32_unload_font (dpyinfo
, font
)
3780 struct win32_display_info
*dpyinfo
;
3785 if (font
->hfont
) DeleteObject(font
->hfont
);
3790 /* The font conversion stuff between x and win32 */
3792 /* X font string is as follows (from faces.el)
3796 * (weight "\\(bold\\|demibold\\|medium\\)") ; 1
3797 * (weight\? "\\([^-]*\\)") ; 1
3798 * (slant "\\([ior]\\)") ; 2
3799 * (slant\? "\\([^-]?\\)") ; 2
3800 * (swidth "\\([^-]*\\)") ; 3
3801 * (adstyle "[^-]*") ; 4
3802 * (pixelsize "[0-9]+")
3803 * (pointsize "[0-9][0-9]+")
3804 * (resx "[0-9][0-9]+")
3805 * (resy "[0-9][0-9]+")
3806 * (spacing "[cmp?*]")
3807 * (avgwidth "[0-9]+")
3808 * (registry "[^-]+")
3809 * (encoding "[^-]+")
3811 * (setq x-font-regexp
3812 * (concat "\\`\\*?[-?*]"
3813 * foundry - family - weight\? - slant\? - swidth - adstyle -
3814 * pixelsize - pointsize - resx - resy - spacing - registry -
3815 * encoding "[-?*]\\*?\\'"
3817 * (setq x-font-regexp-head
3818 * (concat "\\`[-?*]" foundry - family - weight\? - slant\?
3819 * "\\([-*?]\\|\\'\\)"))
3820 * (setq x-font-regexp-slant (concat - slant -))
3821 * (setq x-font-regexp-weight (concat - weight -))
3825 #define FONT_START "[-?]"
3826 #define FONT_FOUNDRY "[^-]+"
3827 #define FONT_FAMILY "\\([^-]+\\)" /* 1 */
3828 #define FONT_WEIGHT "\\(bold\\|demibold\\|medium\\)" /* 2 */
3829 #define FONT_WEIGHT_Q "\\([^-]*\\)" /* 2 */
3830 #define FONT_SLANT "\\([ior]\\)" /* 3 */
3831 #define FONT_SLANT_Q "\\([^-]?\\)" /* 3 */
3832 #define FONT_SWIDTH "\\([^-]*\\)" /* 4 */
3833 #define FONT_ADSTYLE "[^-]*"
3834 #define FONT_PIXELSIZE "[^-]*"
3835 #define FONT_POINTSIZE "\\([0-9][0-9]+\\|\\*\\)" /* 5 */
3836 #define FONT_RESX "[0-9][0-9]+"
3837 #define FONT_RESY "[0-9][0-9]+"
3838 #define FONT_SPACING "[cmp?*]"
3839 #define FONT_AVGWIDTH "[0-9]+"
3840 #define FONT_REGISTRY "[^-]+"
3841 #define FONT_ENCODING "[^-]+"
3843 #define FONT_REGEXP ("\\`\\*?[-?*]" \
3850 FONT_PIXELSIZE "-" \
3851 FONT_POINTSIZE "-" \
3854 #define FONT_REGEXP_HEAD ("\\`[-?*]" \
3859 "\\([-*?]\\|\\'\\)")
3861 #define FONT_REGEXP_SLANT "-" FONT_SLANT "-"
3862 #define FONT_REGEXP_WEIGHT "-" FONT_WEIGHT "-"
3865 x_to_win32_weight (lpw
)
3868 if (!lpw
) return (FW_DONTCARE
);
3870 if (stricmp (lpw
,"heavy") == 0) return FW_HEAVY
;
3871 else if (stricmp (lpw
,"extrabold") == 0) return FW_EXTRABOLD
;
3872 else if (stricmp (lpw
,"bold") == 0) return FW_BOLD
;
3873 else if (stricmp (lpw
,"demibold") == 0) return FW_SEMIBOLD
;
3874 else if (stricmp (lpw
,"medium") == 0) return FW_MEDIUM
;
3875 else if (stricmp (lpw
,"normal") == 0) return FW_NORMAL
;
3876 else if (stricmp (lpw
,"light") == 0) return FW_LIGHT
;
3877 else if (stricmp (lpw
,"extralight") == 0) return FW_EXTRALIGHT
;
3878 else if (stricmp (lpw
,"thin") == 0) return FW_THIN
;
3885 win32_to_x_weight (fnweight
)
3888 if (fnweight
>= FW_HEAVY
) return "heavy";
3889 if (fnweight
>= FW_EXTRABOLD
) return "extrabold";
3890 if (fnweight
>= FW_BOLD
) return "bold";
3891 if (fnweight
>= FW_SEMIBOLD
) return "semibold";
3892 if (fnweight
>= FW_MEDIUM
) return "medium";
3893 if (fnweight
>= FW_NORMAL
) return "normal";
3894 if (fnweight
>= FW_LIGHT
) return "light";
3895 if (fnweight
>= FW_EXTRALIGHT
) return "extralight";
3896 if (fnweight
>= FW_THIN
) return "thin";
3902 x_to_win32_charset (lpcs
)
3905 if (!lpcs
) return (0);
3907 if (stricmp (lpcs
,"ansi") == 0) return ANSI_CHARSET
;
3908 else if (stricmp (lpcs
,"iso8859-1") == 0) return ANSI_CHARSET
;
3909 else if (stricmp (lpcs
,"iso8859") == 0) return ANSI_CHARSET
;
3910 else if (stricmp (lpcs
,"oem") == 0) return OEM_CHARSET
;
3911 #ifdef UNICODE_CHARSET
3912 else if (stricmp (lpcs
,"unicode") == 0) return UNICODE_CHARSET
;
3913 else if (stricmp (lpcs
,"iso10646") == 0) return UNICODE_CHARSET
;
3920 win32_to_x_charset (fncharset
)
3925 case ANSI_CHARSET
: return "ansi";
3926 case OEM_CHARSET
: return "oem";
3927 case SYMBOL_CHARSET
: return "symbol";
3928 #ifdef UNICODE_CHARSET
3929 case UNICODE_CHARSET
: return "unicode";
3936 win32_to_x_font (lplogfont
, lpxstr
, len
)
3937 LOGFONT
* lplogfont
;
3941 char height_pixels
[8];
3943 char width_pixels
[8];
3945 if (!lpxstr
) abort ();
3950 if (lplogfont
->lfHeight
)
3952 sprintf (height_pixels
, "%u", abs (lplogfont
->lfHeight
));
3953 sprintf (height_dpi
, "%u",
3954 (abs (lplogfont
->lfHeight
) * 720) / one_win32_display_info
.height_in
);
3958 strcpy (height_pixels
, "*");
3959 strcpy (height_dpi
, "*");
3961 if (lplogfont
->lfWidth
)
3962 sprintf (width_pixels
, "%u", lplogfont
->lfWidth
* 10);
3964 strcpy (width_pixels
, "*");
3966 _snprintf (lpxstr
, len
- 1,
3967 "-*-%s-%s-%c-*-*-%s-%s-*-*-%c-%s-*-%s-",
3968 lplogfont
->lfFaceName
,
3969 win32_to_x_weight (lplogfont
->lfWeight
),
3970 lplogfont
->lfItalic
?'i':'r',
3973 ((lplogfont
->lfPitchAndFamily
& 0x3) == VARIABLE_PITCH
) ? 'p' : 'c',
3975 win32_to_x_charset (lplogfont
->lfCharSet
)
3978 lpxstr
[len
- 1] = 0; /* just to be sure */
3983 x_to_win32_font (lpxstr
, lplogfont
)
3985 LOGFONT
* lplogfont
;
3987 if (!lplogfont
) return (FALSE
);
3989 memset (lplogfont
, 0, sizeof (*lplogfont
));
3992 lplogfont
->lfOutPrecision
= OUT_DEFAULT_PRECIS
;
3993 lplogfont
->lfClipPrecision
= CLIP_DEFAULT_PRECIS
;
3994 lplogfont
->lfQuality
= DEFAULT_QUALITY
;
3996 /* go for maximum quality */
3997 lplogfont
->lfOutPrecision
= OUT_STROKE_PRECIS
;
3998 lplogfont
->lfClipPrecision
= CLIP_STROKE_PRECIS
;
3999 lplogfont
->lfQuality
= PROOF_QUALITY
;
4005 /* Provide a simple escape mechanism for specifying Windows font names
4006 * directly -- if font spec does not beginning with '-', assume this
4008 * "<font name>[:height in pixels[:width in pixels[:weight]]]"
4014 char name
[50], weight
[20], slant
, pitch
, pixels
[10], height
[10], width
[10], remainder
[20];
4017 fields
= sscanf (lpxstr
,
4018 "-%*[^-]-%49[^-]-%19[^-]-%c-%*[^-]-%*[^-]-%9[^-]-%9[^-]-%*[^-]-%*[^-]-%c-%9[^-]-%19s",
4019 name
, weight
, &slant
, pixels
, height
, &pitch
, width
, remainder
);
4021 if (fields
== EOF
) return (FALSE
);
4023 if (fields
> 0 && name
[0] != '*')
4025 strncpy (lplogfont
->lfFaceName
,name
, LF_FACESIZE
);
4026 lplogfont
->lfFaceName
[LF_FACESIZE
-1] = 0;
4030 lplogfont
->lfFaceName
[0] = 0;
4035 lplogfont
->lfWeight
= x_to_win32_weight ((fields
> 0 ? weight
: ""));
4039 if (!NILP (Vwin32_enable_italics
))
4040 lplogfont
->lfItalic
= (fields
> 0 && slant
== 'i');
4044 if (fields
> 0 && pixels
[0] != '*')
4045 lplogfont
->lfHeight
= atoi (pixels
);
4049 if (fields
> 0 && lplogfont
->lfHeight
== 0 && height
[0] != '*')
4050 lplogfont
->lfHeight
= (atoi (height
)
4051 * one_win32_display_info
.height_in
) / 720;
4055 lplogfont
->lfPitchAndFamily
=
4056 (fields
> 0 && pitch
== 'p') ? VARIABLE_PITCH
: FIXED_PITCH
;
4060 if (fields
> 0 && width
[0] != '*')
4061 lplogfont
->lfWidth
= atoi (width
) / 10;
4065 /* Not all font specs include the registry field, so we allow for an
4066 optional registry field before the encoding when parsing
4067 remainder. Also we strip the trailing '-' if present. */
4069 int len
= strlen (remainder
);
4070 if (len
> 0 && remainder
[len
-1] == '-')
4071 remainder
[len
-1] = 0;
4073 encoding
= remainder
;
4074 if (strncmp (encoding
, "*-", 2) == 0)
4076 lplogfont
->lfCharSet
= x_to_win32_charset (fields
> 0 ? encoding
: "");
4081 char name
[100], height
[10], width
[10], weight
[20];
4083 fields
= sscanf (lpxstr
,
4084 "%99[^:]:%9[^:]:%9[^:]:%19s",
4085 name
, height
, width
, weight
);
4087 if (fields
== EOF
) return (FALSE
);
4091 strncpy (lplogfont
->lfFaceName
,name
, LF_FACESIZE
);
4092 lplogfont
->lfFaceName
[LF_FACESIZE
-1] = 0;
4096 lplogfont
->lfFaceName
[0] = 0;
4102 lplogfont
->lfHeight
= atoi (height
);
4107 lplogfont
->lfWidth
= atoi (width
);
4111 lplogfont
->lfWeight
= x_to_win32_weight ((fields
> 0 ? weight
: ""));
4114 /* This makes TrueType fonts work better. */
4115 lplogfont
->lfHeight
= - abs (lplogfont
->lfHeight
);
4121 win32_font_match (lpszfont1
, lpszfont2
)
4125 char * s1
= lpszfont1
, *e1
;
4126 char * s2
= lpszfont2
, *e2
;
4128 if (s1
== NULL
|| s2
== NULL
) return (FALSE
);
4130 if (*s1
== '-') s1
++;
4131 if (*s2
== '-') s2
++;
4137 e1
= strchr (s1
, '-');
4138 e2
= strchr (s2
, '-');
4140 if (e1
== NULL
|| e2
== NULL
) return (TRUE
);
4145 if (*s1
!= '*' && *s2
!= '*'
4146 && (len1
!= len2
|| strnicmp (s1
, s2
, len1
) != 0))
4154 typedef struct enumfont_t
4159 XFontStruct
*size_ref
;
4160 Lisp_Object
*pattern
;
4166 enum_font_cb2 (lplf
, lptm
, FontType
, lpef
)
4168 NEWTEXTMETRIC
* lptm
;
4172 if (lplf
->elfLogFont
.lfStrikeOut
|| lplf
->elfLogFont
.lfUnderline
4173 || (lplf
->elfLogFont
.lfCharSet
!= ANSI_CHARSET
&& lplf
->elfLogFont
.lfCharSet
!= OEM_CHARSET
))
4176 /* if (!lpef->size_ref || lptm->tmMaxCharWidth == FONT_WIDTH (lpef->size_ref)) */
4180 if (!NILP (*(lpef
->pattern
)) && FontType
== TRUETYPE_FONTTYPE
)
4182 lplf
->elfLogFont
.lfHeight
= lpef
->logfont
.lfHeight
;
4183 lplf
->elfLogFont
.lfWidth
= lpef
->logfont
.lfWidth
;
4186 if (!win32_to_x_font (lplf
, buf
, 100)) return (0);
4188 if (NILP (*(lpef
->pattern
)) || win32_font_match (buf
, XSTRING (*(lpef
->pattern
))->data
))
4190 *lpef
->tail
= Fcons (build_string (buf
), Qnil
);
4191 lpef
->tail
= &XCONS (*lpef
->tail
)->cdr
;
4200 enum_font_cb1 (lplf
, lptm
, FontType
, lpef
)
4202 NEWTEXTMETRIC
* lptm
;
4206 return EnumFontFamilies (lpef
->hdc
,
4207 lplf
->elfLogFont
.lfFaceName
,
4208 (FONTENUMPROC
) enum_font_cb2
,
4213 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 3, 0,
4214 "Return a list of the names of available fonts matching PATTERN.\n\
4215 If optional arguments FACE and FRAME are specified, return only fonts\n\
4216 the same size as FACE on FRAME.\n\
4218 PATTERN is a string, perhaps with wildcard characters;\n\
4219 the * character matches any substring, and\n\
4220 the ? character matches any single character.\n\
4221 PATTERN is case-insensitive.\n\
4222 FACE is a face name--a symbol.\n\
4224 The return value is a list of strings, suitable as arguments to\n\
4227 Fonts Emacs can't use (i.e. proportional fonts) may or may not be excluded\n\
4228 even if they match PATTERN and FACE.")
4229 (pattern
, face
, frame
)
4230 Lisp_Object pattern
, face
, frame
;
4235 XFontStruct
*size_ref
;
4236 Lisp_Object namelist
;
4241 CHECK_STRING (pattern
, 0);
4243 CHECK_SYMBOL (face
, 1);
4245 f
= check_x_frame (frame
);
4247 /* Determine the width standard for comparison with the fonts we find. */
4255 /* Don't die if we get called with a terminal frame. */
4256 if (! FRAME_WIN32_P (f
))
4257 error ("non-win32 frame used in `x-list-fonts'");
4259 face_id
= face_name_id_number (f
, face
);
4261 if (face_id
< 0 || face_id
>= FRAME_N_PARAM_FACES (f
)
4262 || FRAME_PARAM_FACES (f
) [face_id
] == 0)
4263 size_ref
= f
->output_data
.win32
->font
;
4266 size_ref
= FRAME_PARAM_FACES (f
) [face_id
]->font
;
4267 if (size_ref
== (XFontStruct
*) (~0))
4268 size_ref
= f
->output_data
.win32
->font
;
4272 /* See if we cached the result for this particular query. */
4273 list
= Fassoc (pattern
,
4274 XCONS (FRAME_WIN32_DISPLAY_INFO (f
)->name_list_element
)->cdr
);
4276 /* We have info in the cache for this PATTERN. */
4279 Lisp_Object tem
, newlist
;
4281 /* We have info about this pattern. */
4282 list
= XCONS (list
)->cdr
;
4289 /* Filter the cached info and return just the fonts that match FACE. */
4291 for (tem
= list
; CONSP (tem
); tem
= XCONS (tem
)->cdr
)
4293 XFontStruct
*thisinfo
;
4295 thisinfo
= win32_load_font (FRAME_WIN32_DISPLAY_INFO (f
), XSTRING (XCONS (tem
)->car
)->data
);
4297 if (thisinfo
&& same_size_fonts (thisinfo
, size_ref
))
4298 newlist
= Fcons (XCONS (tem
)->car
, newlist
);
4300 win32_unload_font (FRAME_WIN32_DISPLAY_INFO (f
), thisinfo
);
4311 ef
.pattern
= &pattern
;
4312 ef
.tail
= ef
.head
= &namelist
;
4314 x_to_win32_font (STRINGP (pattern
) ? XSTRING (pattern
)->data
: NULL
, &ef
.logfont
);
4317 ef
.hdc
= GetDC (FRAME_WIN32_WINDOW (f
));
4319 EnumFontFamilies (ef
.hdc
, NULL
, (FONTENUMPROC
) enum_font_cb1
, (LPARAM
)&ef
);
4321 ReleaseDC (FRAME_WIN32_WINDOW (f
), ef
.hdc
);
4331 /* Make a list of all the fonts we got back.
4332 Store that in the font cache for the display. */
4333 XCONS (FRAME_WIN32_DISPLAY_INFO (f
)->name_list_element
)->cdr
4334 = Fcons (Fcons (pattern
, namelist
),
4335 XCONS (FRAME_WIN32_DISPLAY_INFO (f
)->name_list_element
)->cdr
);
4337 /* Make a list of the fonts that have the right width. */
4340 for (i
= 0; i
< ef
.numFonts
; i
++)
4348 XFontStruct
*thisinfo
;
4351 thisinfo
= win32_load_font (FRAME_WIN32_DISPLAY_INFO (f
), XSTRING (Fcar (cur
))->data
);
4353 keeper
= thisinfo
&& same_size_fonts (thisinfo
, size_ref
);
4355 win32_unload_font (FRAME_WIN32_DISPLAY_INFO (f
), thisinfo
);
4360 list
= Fcons (build_string (XSTRING (Fcar (cur
))->data
), list
);
4364 list
= Fnreverse (list
);
4370 DEFUN ("x-color-defined-p", Fx_color_defined_p
, Sx_color_defined_p
, 1, 2, 0,
4371 "Return non-nil if color COLOR is supported on frame FRAME.\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))
4387 DEFUN ("x-color-values", Fx_color_values
, Sx_color_values
, 1, 2, 0,
4388 "Return a description of the color named COLOR on frame FRAME.\n\
4389 The value is a list of integer RGB values--(RED GREEN BLUE).\n\
4390 These values appear to range from 0 to 65280 or 65535, depending\n\
4391 on the system; white is (65280 65280 65280) or (65535 65535 65535).\n\
4392 If FRAME is omitted or nil, use the selected frame.")
4394 Lisp_Object color
, frame
;
4397 FRAME_PTR f
= check_x_frame (frame
);
4399 CHECK_STRING (color
, 1);
4401 if (defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
4405 rgb
[0] = make_number (GetRValue (foo
));
4406 rgb
[1] = make_number (GetGValue (foo
));
4407 rgb
[2] = make_number (GetBValue (foo
));
4408 return Flist (3, rgb
);
4414 DEFUN ("x-display-color-p", Fx_display_color_p
, Sx_display_color_p
, 0, 1, 0,
4415 "Return t if the X display supports color.\n\
4416 The optional argument DISPLAY specifies which display to ask about.\n\
4417 DISPLAY should be either a frame or a display name (a string).\n\
4418 If omitted or nil, that stands for the selected frame's display.")
4420 Lisp_Object display
;
4422 struct win32_display_info
*dpyinfo
= check_x_display_info (display
);
4424 if ((dpyinfo
->n_planes
* dpyinfo
->n_cbits
) <= 2)
4430 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
, Sx_display_grayscale_p
,
4432 "Return t if the X display supports shades of gray.\n\
4433 Note that color displays do support shades of gray.\n\
4434 The optional argument DISPLAY specifies which display to ask about.\n\
4435 DISPLAY should be either a frame or a display name (a string).\n\
4436 If omitted or nil, that stands for the selected frame's display.")
4438 Lisp_Object display
;
4440 struct win32_display_info
*dpyinfo
= check_x_display_info (display
);
4442 if ((dpyinfo
->n_planes
* dpyinfo
->n_cbits
) <= 1)
4448 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
4450 "Returns the width in pixels of the X display DISPLAY.\n\
4451 The optional argument DISPLAY specifies which display to ask about.\n\
4452 DISPLAY should be either a frame or a display name (a string).\n\
4453 If omitted or nil, that stands for the selected frame's display.")
4455 Lisp_Object display
;
4457 struct win32_display_info
*dpyinfo
= check_x_display_info (display
);
4459 return make_number (dpyinfo
->width
);
4462 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
4463 Sx_display_pixel_height
, 0, 1, 0,
4464 "Returns the height in pixels of the X display DISPLAY.\n\
4465 The optional argument DISPLAY specifies which display to ask about.\n\
4466 DISPLAY should be either a frame or a display name (a string).\n\
4467 If omitted or nil, that stands for the selected frame's display.")
4469 Lisp_Object display
;
4471 struct win32_display_info
*dpyinfo
= check_x_display_info (display
);
4473 return make_number (dpyinfo
->height
);
4476 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
4478 "Returns the number of bitplanes of the display DISPLAY.\n\
4479 The optional argument DISPLAY specifies which display to ask about.\n\
4480 DISPLAY should be either a frame or a display name (a string).\n\
4481 If omitted or nil, that stands for the selected frame's display.")
4483 Lisp_Object display
;
4485 struct win32_display_info
*dpyinfo
= check_x_display_info (display
);
4487 return make_number (dpyinfo
->n_planes
* dpyinfo
->n_cbits
);
4490 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
4492 "Returns the number of color cells of the display DISPLAY.\n\
4493 The optional argument DISPLAY specifies which display to ask about.\n\
4494 DISPLAY should be either a frame or a display name (a string).\n\
4495 If omitted or nil, that stands for the selected frame's display.")
4497 Lisp_Object display
;
4499 struct win32_display_info
*dpyinfo
= check_x_display_info (display
);
4503 hdc
= GetDC (dpyinfo
->root_window
);
4504 if (dpyinfo
->has_palette
)
4505 cap
= GetDeviceCaps (hdc
,SIZEPALETTE
);
4507 cap
= GetDeviceCaps (hdc
,NUMCOLORS
);
4509 ReleaseDC (dpyinfo
->root_window
, hdc
);
4511 return make_number (cap
);
4514 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
4515 Sx_server_max_request_size
,
4517 "Returns the maximum request size of the server of display DISPLAY.\n\
4518 The optional argument DISPLAY specifies which display to ask about.\n\
4519 DISPLAY should be either a frame or a display name (a string).\n\
4520 If omitted or nil, that stands for the selected frame's display.")
4522 Lisp_Object display
;
4524 struct win32_display_info
*dpyinfo
= check_x_display_info (display
);
4526 return make_number (1);
4529 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
4530 "Returns the vendor ID string of the Win32 system (Microsoft).\n\
4531 The optional argument DISPLAY specifies which display to ask about.\n\
4532 DISPLAY should be either a frame or a display name (a string).\n\
4533 If omitted or nil, that stands for the selected frame's display.")
4535 Lisp_Object display
;
4537 struct win32_display_info
*dpyinfo
= check_x_display_info (display
);
4538 char *vendor
= "Microsoft Corp.";
4540 if (! vendor
) vendor
= "";
4541 return build_string (vendor
);
4544 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
4545 "Returns the version numbers of the server of display DISPLAY.\n\
4546 The value is a list of three integers: the major and minor\n\
4547 version numbers, and the vendor-specific release\n\
4548 number. See also the function `x-server-vendor'.\n\n\
4549 The optional argument DISPLAY specifies which display to ask about.\n\
4550 DISPLAY should be either a frame or a display name (a string).\n\
4551 If omitted or nil, that stands for the selected frame's display.")
4553 Lisp_Object display
;
4555 struct win32_display_info
*dpyinfo
= check_x_display_info (display
);
4557 return Fcons (make_number (nt_major_version
),
4558 Fcons (make_number (nt_minor_version
), Qnil
));
4561 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
4562 "Returns the number of screens on the server of display DISPLAY.\n\
4563 The optional argument DISPLAY specifies which display to ask about.\n\
4564 DISPLAY should be either a frame or a display name (a string).\n\
4565 If omitted or nil, that stands for the selected frame's display.")
4567 Lisp_Object display
;
4569 struct win32_display_info
*dpyinfo
= check_x_display_info (display
);
4571 return make_number (1);
4574 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
4575 "Returns the height in millimeters of the X display DISPLAY.\n\
4576 The optional argument DISPLAY specifies which display to ask about.\n\
4577 DISPLAY should be either a frame or a display name (a string).\n\
4578 If omitted or nil, that stands for the selected frame's display.")
4580 Lisp_Object display
;
4582 struct win32_display_info
*dpyinfo
= check_x_display_info (display
);
4586 hdc
= GetDC (dpyinfo
->root_window
);
4588 cap
= GetDeviceCaps (hdc
, VERTSIZE
);
4590 ReleaseDC (dpyinfo
->root_window
, hdc
);
4592 return make_number (cap
);
4595 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
4596 "Returns the width in millimeters of the X display DISPLAY.\n\
4597 The optional argument DISPLAY specifies which display to ask about.\n\
4598 DISPLAY should be either a frame or a display name (a string).\n\
4599 If omitted or nil, that stands for the selected frame's display.")
4601 Lisp_Object display
;
4603 struct win32_display_info
*dpyinfo
= check_x_display_info (display
);
4608 hdc
= GetDC (dpyinfo
->root_window
);
4610 cap
= GetDeviceCaps (hdc
, HORZSIZE
);
4612 ReleaseDC (dpyinfo
->root_window
, hdc
);
4614 return make_number (cap
);
4617 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
4618 Sx_display_backing_store
, 0, 1, 0,
4619 "Returns an indication of whether display DISPLAY does backing store.\n\
4620 The value may be `always', `when-mapped', or `not-useful'.\n\
4621 The optional argument DISPLAY specifies which display to ask about.\n\
4622 DISPLAY should be either a frame or a display name (a string).\n\
4623 If omitted or nil, that stands for the selected frame's display.")
4625 Lisp_Object display
;
4627 return intern ("not-useful");
4630 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
4631 Sx_display_visual_class
, 0, 1, 0,
4632 "Returns the visual class of the display DISPLAY.\n\
4633 The value is one of the symbols `static-gray', `gray-scale',\n\
4634 `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
4635 The optional argument DISPLAY specifies which display to ask about.\n\
4636 DISPLAY should be either a frame or a display name (a string).\n\
4637 If omitted or nil, that stands for the selected frame's display.")
4639 Lisp_Object display
;
4641 struct win32_display_info
*dpyinfo
= check_x_display_info (display
);
4644 switch (dpyinfo
->visual
->class)
4646 case StaticGray
: return (intern ("static-gray"));
4647 case GrayScale
: return (intern ("gray-scale"));
4648 case StaticColor
: return (intern ("static-color"));
4649 case PseudoColor
: return (intern ("pseudo-color"));
4650 case TrueColor
: return (intern ("true-color"));
4651 case DirectColor
: return (intern ("direct-color"));
4653 error ("Display has an unknown visual class");
4657 error ("Display has an unknown visual class");
4660 DEFUN ("x-display-save-under", Fx_display_save_under
,
4661 Sx_display_save_under
, 0, 1, 0,
4662 "Returns t if the display DISPLAY supports the save-under feature.\n\
4663 The optional argument DISPLAY specifies which display to ask about.\n\
4664 DISPLAY should be either a frame or a display name (a string).\n\
4665 If omitted or nil, that stands for the selected frame's display.")
4667 Lisp_Object display
;
4669 struct win32_display_info
*dpyinfo
= check_x_display_info (display
);
4676 register struct frame
*f
;
4678 return PIXEL_WIDTH (f
);
4683 register struct frame
*f
;
4685 return PIXEL_HEIGHT (f
);
4690 register struct frame
*f
;
4692 return FONT_WIDTH (f
->output_data
.win32
->font
);
4697 register struct frame
*f
;
4699 return f
->output_data
.win32
->line_height
;
4703 x_screen_planes (frame
)
4706 return (FRAME_WIN32_DISPLAY_INFO (XFRAME (frame
))->n_planes
*
4707 FRAME_WIN32_DISPLAY_INFO (XFRAME (frame
))->n_cbits
);
4710 /* Return the display structure for the display named NAME.
4711 Open a new connection if necessary. */
4713 struct win32_display_info
*
4714 x_display_info_for_name (name
)
4718 struct win32_display_info
*dpyinfo
;
4720 CHECK_STRING (name
, 0);
4722 for (dpyinfo
= &one_win32_display_info
, names
= win32_display_name_list
;
4724 dpyinfo
= dpyinfo
->next
, names
= XCONS (names
)->cdr
)
4727 tem
= Fstring_equal (XCONS (XCONS (names
)->car
)->car
, name
);
4732 /* Use this general default value to start with. */
4733 Vx_resource_name
= Vinvocation_name
;
4735 validate_x_resource_name ();
4737 dpyinfo
= win32_term_init (name
, (unsigned char *)0,
4738 (char *) XSTRING (Vx_resource_name
)->data
);
4741 error ("Cannot connect to server %s", XSTRING (name
)->data
);
4743 XSETFASTINT (Vwindow_system_version
, 3);
4748 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
4749 1, 3, 0, "Open a connection to a server.\n\
4750 DISPLAY is the name of the display to connect to.\n\
4751 Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
4752 If the optional third arg MUST-SUCCEED is non-nil,\n\
4753 terminate Emacs if we can't open the connection.")
4754 (display
, xrm_string
, must_succeed
)
4755 Lisp_Object display
, xrm_string
, must_succeed
;
4757 unsigned int n_planes
;
4758 unsigned char *xrm_option
;
4759 struct win32_display_info
*dpyinfo
;
4761 CHECK_STRING (display
, 0);
4762 if (! NILP (xrm_string
))
4763 CHECK_STRING (xrm_string
, 1);
4765 /* Allow color mapping to be defined externally; first look in user's
4766 HOME directory, then in Emacs etc dir for a file called rgb.txt. */
4768 Lisp_Object color_file
;
4769 struct gcpro gcpro1
;
4771 color_file
= build_string("~/rgb.txt");
4773 GCPRO1 (color_file
);
4775 if (NILP (Ffile_readable_p (color_file
)))
4777 Fexpand_file_name (build_string ("rgb.txt"),
4778 Fsymbol_value (intern ("data-directory")));
4780 Vwin32_color_map
= Fwin32_load_color_file (color_file
);
4784 if (NILP (Vwin32_color_map
))
4785 Vwin32_color_map
= Fwin32_default_color_map ();
4787 if (! NILP (xrm_string
))
4788 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
4790 xrm_option
= (unsigned char *) 0;
4792 /* Use this general default value to start with. */
4793 /* First remove .exe suffix from invocation-name - it looks ugly. */
4795 char basename
[ MAX_PATH
], *str
;
4797 strcpy (basename
, XSTRING (Vinvocation_name
)->data
);
4798 str
= strrchr (basename
, '.');
4800 Vinvocation_name
= build_string (basename
);
4802 Vx_resource_name
= Vinvocation_name
;
4804 validate_x_resource_name ();
4806 /* This is what opens the connection and sets x_current_display.
4807 This also initializes many symbols, such as those used for input. */
4808 dpyinfo
= win32_term_init (display
, xrm_option
,
4809 (char *) XSTRING (Vx_resource_name
)->data
);
4813 if (!NILP (must_succeed
))
4814 fatal ("Cannot connect to server %s.\n",
4815 XSTRING (display
)->data
);
4817 error ("Cannot connect to server %s", XSTRING (display
)->data
);
4820 XSETFASTINT (Vwindow_system_version
, 3);
4824 DEFUN ("x-close-connection", Fx_close_connection
,
4825 Sx_close_connection
, 1, 1, 0,
4826 "Close the connection to DISPLAY's server.\n\
4827 For DISPLAY, specify either a frame or a display name (a string).\n\
4828 If DISPLAY is nil, that stands for the selected frame's display.")
4830 Lisp_Object display
;
4832 struct win32_display_info
*dpyinfo
= check_x_display_info (display
);
4833 struct win32_display_info
*tail
;
4836 if (dpyinfo
->reference_count
> 0)
4837 error ("Display still has frames on it");
4840 /* Free the fonts in the font table. */
4841 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
4843 if (dpyinfo
->font_table
[i
].name
)
4844 free (dpyinfo
->font_table
[i
].name
);
4845 /* Don't free the full_name string;
4846 it is always shared with something else. */
4847 win32_unload_font (dpyinfo
, dpyinfo
->font_table
[i
].font
);
4849 x_destroy_all_bitmaps (dpyinfo
);
4851 x_delete_display (dpyinfo
);
4857 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
4858 "Return the list of display names that Emacs has connections to.")
4861 Lisp_Object tail
, result
;
4864 for (tail
= win32_display_name_list
; ! NILP (tail
); tail
= XCONS (tail
)->cdr
)
4865 result
= Fcons (XCONS (XCONS (tail
)->car
)->car
, result
);
4870 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
4871 "If ON is non-nil, report errors as soon as the erring request is made.\n\
4872 If ON is nil, allow buffering of requests.\n\
4873 This is a noop on Win32 systems.\n\
4874 The optional second argument DISPLAY specifies which display to act on.\n\
4875 DISPLAY should be either a frame or a display name (a string).\n\
4876 If DISPLAY is omitted or nil, that stands for the selected frame's display.")
4878 Lisp_Object display
, on
;
4880 struct win32_display_info
*dpyinfo
= check_x_display_info (display
);
4886 /* These are the win32 specialized functions */
4888 DEFUN ("win32-select-font", Fwin32_select_font
, Swin32_select_font
, 0, 1, 0,
4889 "This will display the Win32 font dialog and return an X font string corresponding to the selection.")
4893 FRAME_PTR f
= check_x_frame (frame
);
4898 bzero (&cf
, sizeof (cf
));
4900 cf
.lStructSize
= sizeof (cf
);
4901 cf
.hwndOwner
= FRAME_WIN32_WINDOW (f
);
4902 cf
.Flags
= CF_FIXEDPITCHONLY
| CF_FORCEFONTEXIST
| CF_SCREENFONTS
;
4905 if (!ChooseFont (&cf
) || !win32_to_x_font (&lf
, buf
, 100))
4908 return build_string (buf
);
4914 /* The section below is built by the lisp expression at the top of the file,
4915 just above where these variables are declared. */
4916 /*&&& init symbols here &&&*/
4917 Qauto_raise
= intern ("auto-raise");
4918 staticpro (&Qauto_raise
);
4919 Qauto_lower
= intern ("auto-lower");
4920 staticpro (&Qauto_lower
);
4921 Qbackground_color
= intern ("background-color");
4922 staticpro (&Qbackground_color
);
4923 Qbar
= intern ("bar");
4925 Qborder_color
= intern ("border-color");
4926 staticpro (&Qborder_color
);
4927 Qborder_width
= intern ("border-width");
4928 staticpro (&Qborder_width
);
4929 Qbox
= intern ("box");
4931 Qcursor_color
= intern ("cursor-color");
4932 staticpro (&Qcursor_color
);
4933 Qcursor_type
= intern ("cursor-type");
4934 staticpro (&Qcursor_type
);
4935 Qfont
= intern ("font");
4937 Qforeground_color
= intern ("foreground-color");
4938 staticpro (&Qforeground_color
);
4939 Qgeometry
= intern ("geometry");
4940 staticpro (&Qgeometry
);
4941 Qicon_left
= intern ("icon-left");
4942 staticpro (&Qicon_left
);
4943 Qicon_top
= intern ("icon-top");
4944 staticpro (&Qicon_top
);
4945 Qicon_type
= intern ("icon-type");
4946 staticpro (&Qicon_type
);
4947 Qicon_name
= intern ("icon-name");
4948 staticpro (&Qicon_name
);
4949 Qinternal_border_width
= intern ("internal-border-width");
4950 staticpro (&Qinternal_border_width
);
4951 Qleft
= intern ("left");
4953 Qmouse_color
= intern ("mouse-color");
4954 staticpro (&Qmouse_color
);
4955 Qnone
= intern ("none");
4957 Qparent_id
= intern ("parent-id");
4958 staticpro (&Qparent_id
);
4959 Qscroll_bar_width
= intern ("scroll-bar-width");
4960 staticpro (&Qscroll_bar_width
);
4961 Qsuppress_icon
= intern ("suppress-icon");
4962 staticpro (&Qsuppress_icon
);
4963 Qtop
= intern ("top");
4965 Qundefined_color
= intern ("undefined-color");
4966 staticpro (&Qundefined_color
);
4967 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
4968 staticpro (&Qvertical_scroll_bars
);
4969 Qvisibility
= intern ("visibility");
4970 staticpro (&Qvisibility
);
4971 Qwindow_id
= intern ("window-id");
4972 staticpro (&Qwindow_id
);
4973 Qx_frame_parameter
= intern ("x-frame-parameter");
4974 staticpro (&Qx_frame_parameter
);
4975 Qx_resource_name
= intern ("x-resource-name");
4976 staticpro (&Qx_resource_name
);
4977 Quser_position
= intern ("user-position");
4978 staticpro (&Quser_position
);
4979 Quser_size
= intern ("user-size");
4980 staticpro (&Quser_size
);
4981 Qdisplay
= intern ("display");
4982 staticpro (&Qdisplay
);
4983 /* This is the end of symbol initialization. */
4985 Fput (Qundefined_color
, Qerror_conditions
,
4986 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
4987 Fput (Qundefined_color
, Qerror_message
,
4988 build_string ("Undefined color"));
4990 DEFVAR_LISP ("win32-color-map", &Vwin32_color_map
,
4991 "A array of color name mappings for windows.");
4992 Vwin32_color_map
= Qnil
;
4994 DEFVAR_LISP ("win32-pass-alt-to-system", &Vwin32_pass_alt_to_system
,
4995 "Non-nil if alt key presses are passed on to Windows.\n\
4996 When non-nil, for example, alt pressed and released and then space will\n\
4997 open the System menu. When nil, Emacs silently swallows alt key events.");
4998 Vwin32_pass_alt_to_system
= Qnil
;
5000 DEFVAR_LISP ("win32-pass-optional-keys-to-system",
5001 &Vwin32_pass_optional_keys_to_system
,
5002 "Non-nil if the 'optional' keys (left window, right window,\n\
5003 and application keys) are passed on to Windows.");
5004 Vwin32_pass_optional_keys_to_system
= Qnil
;
5006 DEFVAR_LISP ("win32-enable-italics", &Vwin32_enable_italics
,
5007 "Non-nil enables selection of artificially italicized fonts.");
5008 Vwin32_enable_italics
= Qnil
;
5010 DEFVAR_LISP ("win32-enable-palette", &Vwin32_enable_palette
,
5011 "Non-nil enables Windows palette management to map colors exactly.");
5012 Vwin32_enable_palette
= Qt
;
5014 DEFVAR_INT ("win32-mouse-button-tolerance",
5015 &Vwin32_mouse_button_tolerance
,
5016 "Analogue of double click interval for faking middle mouse events.\n\
5017 The value is the minimum time in milliseconds that must elapse between\n\
5018 left/right button down events before they are considered distinct events.\n\
5019 If both mouse buttons are depressed within this interval, a middle mouse\n\
5020 button down event is generated instead.");
5021 XSETINT (Vwin32_mouse_button_tolerance
, GetDoubleClickTime () / 2);
5023 DEFVAR_INT ("win32-mouse-move-interval",
5024 &Vwin32_mouse_move_interval
,
5025 "Minimum interval between mouse move events.\n\
5026 The value is the minimum time in milliseconds that must elapse between\n\
5027 successive mouse move (or scroll bar drag) events before they are\n\
5028 reported as lisp events.");
5029 XSETINT (Vwin32_mouse_move_interval
, 50);
5031 init_x_parm_symbols ();
5033 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path
,
5034 "List of directories to search for bitmap files for win32.");
5035 Vx_bitmap_file_path
= decode_env_path ((char *) 0, "PATH");
5037 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
5038 "The shape of the pointer when over text.\n\
5039 Changing the value does not affect existing frames\n\
5040 unless you set the mouse color.");
5041 Vx_pointer_shape
= Qnil
;
5043 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
5044 "The name Emacs uses to look up resources; for internal use only.\n\
5045 `x-get-resource' uses this as the first component of the instance name\n\
5046 when requesting resource values.\n\
5047 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
5048 was invoked, or to the value specified with the `-name' or `-rn'\n\
5049 switches, if present.");
5050 Vx_resource_name
= Qnil
;
5052 Vx_nontext_pointer_shape
= Qnil
;
5054 Vx_mode_pointer_shape
= Qnil
;
5056 DEFVAR_INT ("x-sensitive-text-pointer-shape",
5057 &Vx_sensitive_text_pointer_shape
,
5058 "The shape of the pointer when over mouse-sensitive text.\n\
5059 This variable takes effect when you create a new frame\n\
5060 or when you set the mouse color.");
5061 Vx_sensitive_text_pointer_shape
= Qnil
;
5063 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
5064 "A string indicating the foreground color of the cursor box.");
5065 Vx_cursor_fore_pixel
= Qnil
;
5067 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
5068 "Non-nil if no window manager is in use.\n\
5069 Emacs doesn't try to figure this out; this is always nil\n\
5070 unless you set it to something else.");
5071 /* We don't have any way to find this out, so set it to nil
5072 and maybe the user would like to set it to t. */
5073 Vx_no_window_manager
= Qnil
;
5075 defsubr (&Sx_get_resource
);
5076 defsubr (&Sx_list_fonts
);
5077 defsubr (&Sx_display_color_p
);
5078 defsubr (&Sx_display_grayscale_p
);
5079 defsubr (&Sx_color_defined_p
);
5080 defsubr (&Sx_color_values
);
5081 defsubr (&Sx_server_max_request_size
);
5082 defsubr (&Sx_server_vendor
);
5083 defsubr (&Sx_server_version
);
5084 defsubr (&Sx_display_pixel_width
);
5085 defsubr (&Sx_display_pixel_height
);
5086 defsubr (&Sx_display_mm_width
);
5087 defsubr (&Sx_display_mm_height
);
5088 defsubr (&Sx_display_screens
);
5089 defsubr (&Sx_display_planes
);
5090 defsubr (&Sx_display_color_cells
);
5091 defsubr (&Sx_display_visual_class
);
5092 defsubr (&Sx_display_backing_store
);
5093 defsubr (&Sx_display_save_under
);
5094 defsubr (&Sx_parse_geometry
);
5095 defsubr (&Sx_create_frame
);
5096 defsubr (&Sfocus_frame
);
5097 defsubr (&Sunfocus_frame
);
5098 defsubr (&Sx_open_connection
);
5099 defsubr (&Sx_close_connection
);
5100 defsubr (&Sx_display_list
);
5101 defsubr (&Sx_synchronize
);
5103 /* Win32 specific functions */
5105 defsubr (&Swin32_select_font
);
5106 defsubr (&Swin32_define_rgb_color
);
5107 defsubr (&Swin32_default_color_map
);
5108 defsubr (&Swin32_load_color_file
);
5117 button
= MessageBox (NULL
,
5118 "A fatal error has occurred!\n\n"
5119 "Select Abort to exit, Retry to debug, Ignore to continue",
5120 "Emacs Abort Dialog",
5121 MB_ICONEXCLAMATION
| MB_TASKMODAL
5122 | MB_SETFOREGROUND
| MB_ABORTRETRYIGNORE
);