1 /* Graphical user interface functions for the Microsoft W32 API.
2 Copyright (C) 1989, 92, 93, 94, 95, 1996 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
21 /* Added by Kevin Gallo */
35 #include "dispextern.h"
37 #include "blockinput.h"
40 #include "termhooks.h"
46 extern void free_frame_menubar ();
47 extern struct scroll_bar
*x_window_to_scroll_bar ();
50 /* The colormap for converting color names to RGB values */
51 Lisp_Object Vw32_color_map
;
53 /* Non nil if alt key presses are passed on to Windows. */
54 Lisp_Object Vw32_pass_alt_to_system
;
56 /* Non nil if alt key is translated to meta_modifier, nil if it is translated
58 Lisp_Object Vw32_alt_is_meta
;
60 /* Non nil if left window, right window, and application key events
61 are passed on to Windows. */
62 Lisp_Object Vw32_pass_optional_keys_to_system
;
64 /* Switch to control whether we inhibit requests for italicised fonts (which
65 are synthesized, look ugly, and are trashed by cursor movement under NT). */
66 Lisp_Object Vw32_enable_italics
;
68 /* Enable palette management. */
69 Lisp_Object Vw32_enable_palette
;
71 /* Control how close left/right button down events must be to
72 be converted to a middle button down event. */
73 Lisp_Object Vw32_mouse_button_tolerance
;
75 /* Minimum interval between mouse movement (and scroll bar drag)
76 events that are passed on to the event loop. */
77 Lisp_Object Vw32_mouse_move_interval
;
79 /* The name we're using in resource queries. */
80 Lisp_Object Vx_resource_name
;
82 /* Non nil if no window manager is in use. */
83 Lisp_Object Vx_no_window_manager
;
85 /* The background and shape of the mouse pointer, and shape when not
86 over text or in the modeline. */
87 Lisp_Object Vx_pointer_shape
, Vx_nontext_pointer_shape
, Vx_mode_pointer_shape
;
88 /* The shape when over mouse-sensitive text. */
89 Lisp_Object Vx_sensitive_text_pointer_shape
;
91 /* Color of chars displayed in cursor box. */
92 Lisp_Object Vx_cursor_fore_pixel
;
94 /* Nonzero if using Windows. */
95 static int w32_in_use
;
97 /* Search path for bitmap files. */
98 Lisp_Object Vx_bitmap_file_path
;
100 /* Evaluate this expression to rebuild the section of syms_of_w32fns
101 that initializes and staticpros the symbols declared below. Note
102 that Emacs 18 has a bug that keeps C-x C-e from being able to
103 evaluate this expression.
106 ;; Accumulate a list of the symbols we want to initialize from the
107 ;; declarations at the top of the file.
108 (goto-char (point-min))
109 (search-forward "/\*&&& symbols declared here &&&*\/\n")
111 (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)")
113 (cons (buffer-substring (match-beginning 1) (match-end 1))
116 (setq symbol-list (nreverse symbol-list))
117 ;; Delete the section of syms_of_... where we initialize the symbols.
118 (search-forward "\n /\*&&& init symbols here &&&*\/\n")
119 (let ((start (point)))
120 (while (looking-at "^ Q")
122 (kill-region start (point)))
123 ;; Write a new symbol initialization section.
125 (insert (format " %s = intern (\"" (car symbol-list)))
126 (let ((start (point)))
127 (insert (substring (car symbol-list) 1))
128 (subst-char-in-region start (point) ?_ ?-))
129 (insert (format "\");\n staticpro (&%s);\n" (car symbol-list)))
130 (setq symbol-list (cdr symbol-list)))))
134 /*&&& symbols declared here &&&*/
135 Lisp_Object Qauto_raise
;
136 Lisp_Object Qauto_lower
;
137 Lisp_Object Qbackground_color
;
139 Lisp_Object Qborder_color
;
140 Lisp_Object Qborder_width
;
142 Lisp_Object Qcursor_color
;
143 Lisp_Object Qcursor_type
;
144 Lisp_Object Qforeground_color
;
145 Lisp_Object Qgeometry
;
146 Lisp_Object Qicon_left
;
147 Lisp_Object Qicon_top
;
148 Lisp_Object Qicon_type
;
149 Lisp_Object Qicon_name
;
150 Lisp_Object Qinternal_border_width
;
153 Lisp_Object Qmouse_color
;
155 Lisp_Object Qparent_id
;
156 Lisp_Object Qscroll_bar_width
;
157 Lisp_Object Qsuppress_icon
;
159 Lisp_Object Qundefined_color
;
160 Lisp_Object Qvertical_scroll_bars
;
161 Lisp_Object Qvisibility
;
162 Lisp_Object Qwindow_id
;
163 Lisp_Object Qx_frame_parameter
;
164 Lisp_Object Qx_resource_name
;
165 Lisp_Object Quser_position
;
166 Lisp_Object Quser_size
;
167 Lisp_Object Qdisplay
;
169 /* State variables for emulating a three button mouse. */
174 static int button_state
= 0;
175 static W32Msg saved_mouse_button_msg
;
176 static unsigned mouse_button_timer
; /* non-zero when timer is active */
177 static W32Msg saved_mouse_move_msg
;
178 static unsigned mouse_move_timer
;
180 /* W95 mousewheel handler */
181 unsigned int msh_mousewheel
= 0;
183 #define MOUSE_BUTTON_ID 1
184 #define MOUSE_MOVE_ID 2
186 /* The below are defined in frame.c. */
187 extern Lisp_Object Qheight
, Qminibuffer
, Qname
, Qonly
, Qwidth
;
188 extern Lisp_Object Qunsplittable
, Qmenu_bar_lines
, Qbuffer_predicate
, Qtitle
;
190 extern Lisp_Object Vwindow_system_version
;
192 Lisp_Object Qface_set_after_frame_default
;
194 extern Lisp_Object last_mouse_scroll_bar
;
195 extern int last_mouse_scroll_bar_pos
;
197 /* From w32term.c. */
198 extern Lisp_Object Vw32_num_mouse_buttons
;
201 /* Error if we are not connected to MS-Windows. */
206 error ("MS-Windows not in use or not initialized");
209 /* Nonzero if we can use mouse menus.
210 You should not call this unless HAVE_MENUS is defined. */
218 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
219 and checking validity for W32. */
222 check_x_frame (frame
)
231 CHECK_LIVE_FRAME (frame
, 0);
234 if (! FRAME_W32_P (f
))
235 error ("non-w32 frame used");
239 /* Let the user specify an display with a frame.
240 nil stands for the selected frame--or, if that is not a w32 frame,
241 the first display on the list. */
243 static struct w32_display_info
*
244 check_x_display_info (frame
)
249 if (FRAME_W32_P (selected_frame
))
250 return FRAME_W32_DISPLAY_INFO (selected_frame
);
252 return &one_w32_display_info
;
254 else if (STRINGP (frame
))
255 return x_display_info_for_name (frame
);
260 CHECK_LIVE_FRAME (frame
, 0);
262 if (! FRAME_W32_P (f
))
263 error ("non-w32 frame used");
264 return FRAME_W32_DISPLAY_INFO (f
);
268 /* Return the Emacs frame-object corresponding to an w32 window.
269 It could be the frame's main window or an icon window. */
271 /* This function can be called during GC, so use GC_xxx type test macros. */
274 x_window_to_frame (dpyinfo
, wdesc
)
275 struct w32_display_info
*dpyinfo
;
278 Lisp_Object tail
, frame
;
281 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
283 frame
= XCONS (tail
)->car
;
284 if (!GC_FRAMEP (frame
))
287 if (f
->output_data
.nothing
== 1
288 || FRAME_W32_DISPLAY_INFO (f
) != dpyinfo
)
290 if (FRAME_W32_WINDOW (f
) == wdesc
)
298 /* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
299 id, which is just an int that this section returns. Bitmaps are
300 reference counted so they can be shared among frames.
302 Bitmap indices are guaranteed to be > 0, so a negative number can
303 be used to indicate no bitmap.
305 If you use x_create_bitmap_from_data, then you must keep track of
306 the bitmaps yourself. That is, creating a bitmap from the same
307 data more than once will not be caught. */
310 /* Functions to access the contents of a bitmap, given an id. */
313 x_bitmap_height (f
, id
)
317 return FRAME_W32_DISPLAY_INFO (f
)->bitmaps
[id
- 1].height
;
321 x_bitmap_width (f
, id
)
325 return FRAME_W32_DISPLAY_INFO (f
)->bitmaps
[id
- 1].width
;
329 x_bitmap_pixmap (f
, id
)
333 return (int) FRAME_W32_DISPLAY_INFO (f
)->bitmaps
[id
- 1].pixmap
;
337 /* Allocate a new bitmap record. Returns index of new record. */
340 x_allocate_bitmap_record (f
)
343 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
346 if (dpyinfo
->bitmaps
== NULL
)
348 dpyinfo
->bitmaps_size
= 10;
350 = (struct w32_bitmap_record
*) xmalloc (dpyinfo
->bitmaps_size
* sizeof (struct w32_bitmap_record
));
351 dpyinfo
->bitmaps_last
= 1;
355 if (dpyinfo
->bitmaps_last
< dpyinfo
->bitmaps_size
)
356 return ++dpyinfo
->bitmaps_last
;
358 for (i
= 0; i
< dpyinfo
->bitmaps_size
; ++i
)
359 if (dpyinfo
->bitmaps
[i
].refcount
== 0)
362 dpyinfo
->bitmaps_size
*= 2;
364 = (struct w32_bitmap_record
*) xrealloc (dpyinfo
->bitmaps
,
365 dpyinfo
->bitmaps_size
* sizeof (struct w32_bitmap_record
));
366 return ++dpyinfo
->bitmaps_last
;
369 /* Add one reference to the reference count of the bitmap with id ID. */
372 x_reference_bitmap (f
, id
)
376 ++FRAME_W32_DISPLAY_INFO (f
)->bitmaps
[id
- 1].refcount
;
379 /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
382 x_create_bitmap_from_data (f
, bits
, width
, height
)
385 unsigned int width
, height
;
387 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
391 bitmap
= CreateBitmap (width
, height
,
392 FRAME_W32_DISPLAY_INFO (XFRAME (frame
))->n_planes
,
393 FRAME_W32_DISPLAY_INFO (XFRAME (frame
))->n_cbits
,
399 id
= x_allocate_bitmap_record (f
);
400 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
401 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
402 dpyinfo
->bitmaps
[id
- 1].hinst
= NULL
;
403 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
404 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
405 dpyinfo
->bitmaps
[id
- 1].height
= height
;
406 dpyinfo
->bitmaps
[id
- 1].width
= width
;
411 /* Create bitmap from file FILE for frame F. */
414 x_create_bitmap_from_file (f
, file
)
420 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
421 unsigned int width
, height
;
423 int xhot
, yhot
, result
, id
;
429 /* Look for an existing bitmap with the same name. */
430 for (id
= 0; id
< dpyinfo
->bitmaps_last
; ++id
)
432 if (dpyinfo
->bitmaps
[id
].refcount
433 && dpyinfo
->bitmaps
[id
].file
434 && !strcmp (dpyinfo
->bitmaps
[id
].file
, (char *) XSTRING (file
)->data
))
436 ++dpyinfo
->bitmaps
[id
].refcount
;
441 /* Search bitmap-file-path for the file, if appropriate. */
442 fd
= openp (Vx_bitmap_file_path
, file
, "", &found
, 0);
447 filename
= (char *) XSTRING (found
)->data
;
449 hinst
= LoadLibraryEx (filename
, NULL
, LOAD_LIBRARY_AS_DATAFILE
);
455 result
= XReadBitmapFile (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
456 filename
, &width
, &height
, &bitmap
, &xhot
, &yhot
);
457 if (result
!= BitmapSuccess
)
460 id
= x_allocate_bitmap_record (f
);
461 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
462 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
463 dpyinfo
->bitmaps
[id
- 1].file
= (char *) xmalloc (XSTRING (file
)->size
+ 1);
464 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
465 dpyinfo
->bitmaps
[id
- 1].height
= height
;
466 dpyinfo
->bitmaps
[id
- 1].width
= width
;
467 strcpy (dpyinfo
->bitmaps
[id
- 1].file
, XSTRING (file
)->data
);
473 /* Remove reference to bitmap with id number ID. */
476 x_destroy_bitmap (f
, id
)
480 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
484 --dpyinfo
->bitmaps
[id
- 1].refcount
;
485 if (dpyinfo
->bitmaps
[id
- 1].refcount
== 0)
488 DeleteObject (dpyinfo
->bitmaps
[id
- 1].pixmap
);
489 if (dpyinfo
->bitmaps
[id
- 1].file
)
491 free (dpyinfo
->bitmaps
[id
- 1].file
);
492 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
499 /* Free all the bitmaps for the display specified by DPYINFO. */
502 x_destroy_all_bitmaps (dpyinfo
)
503 struct w32_display_info
*dpyinfo
;
506 for (i
= 0; i
< dpyinfo
->bitmaps_last
; i
++)
507 if (dpyinfo
->bitmaps
[i
].refcount
> 0)
509 DeleteObject (dpyinfo
->bitmaps
[i
].pixmap
);
510 if (dpyinfo
->bitmaps
[i
].file
)
511 free (dpyinfo
->bitmaps
[i
].file
);
513 dpyinfo
->bitmaps_last
= 0;
516 /* Connect the frame-parameter names for W32 frames
517 to the ways of passing the parameter values to the window system.
519 The name of a parameter, as a Lisp symbol,
520 has an `x-frame-parameter' property which is an integer in Lisp
521 but can be interpreted as an `enum x_frame_parm' in C. */
525 X_PARM_FOREGROUND_COLOR
,
526 X_PARM_BACKGROUND_COLOR
,
533 X_PARM_INTERNAL_BORDER_WIDTH
,
537 X_PARM_VERT_SCROLL_BAR
,
539 X_PARM_MENU_BAR_LINES
543 struct x_frame_parm_table
546 void (*setter
)( /* struct frame *frame, Lisp_Object val, oldval */ );
549 void x_set_foreground_color ();
550 void x_set_background_color ();
551 void x_set_mouse_color ();
552 void x_set_cursor_color ();
553 void x_set_border_color ();
554 void x_set_cursor_type ();
555 void x_set_icon_type ();
556 void x_set_icon_name ();
558 void x_set_border_width ();
559 void x_set_internal_border_width ();
560 void x_explicitly_set_name ();
561 void x_set_autoraise ();
562 void x_set_autolower ();
563 void x_set_vertical_scroll_bars ();
564 void x_set_visibility ();
565 void x_set_menu_bar_lines ();
566 void x_set_scroll_bar_width ();
568 void x_set_unsplittable ();
570 static struct x_frame_parm_table x_frame_parms
[] =
572 "auto-raise", x_set_autoraise
,
573 "auto-lower", x_set_autolower
,
574 "background-color", x_set_background_color
,
575 "border-color", x_set_border_color
,
576 "border-width", x_set_border_width
,
577 "cursor-color", x_set_cursor_color
,
578 "cursor-type", x_set_cursor_type
,
580 "foreground-color", x_set_foreground_color
,
581 "icon-name", x_set_icon_name
,
582 "icon-type", x_set_icon_type
,
583 "internal-border-width", x_set_internal_border_width
,
584 "menu-bar-lines", x_set_menu_bar_lines
,
585 "mouse-color", x_set_mouse_color
,
586 "name", x_explicitly_set_name
,
587 "scroll-bar-width", x_set_scroll_bar_width
,
588 "title", x_set_title
,
589 "unsplittable", x_set_unsplittable
,
590 "vertical-scroll-bars", x_set_vertical_scroll_bars
,
591 "visibility", x_set_visibility
,
594 /* Attach the `x-frame-parameter' properties to
595 the Lisp symbol names of parameters relevant to W32. */
597 init_x_parm_symbols ()
601 for (i
= 0; i
< sizeof (x_frame_parms
) / sizeof (x_frame_parms
[0]); i
++)
602 Fput (intern (x_frame_parms
[i
].name
), Qx_frame_parameter
,
606 /* Change the parameters of FRAME as specified by ALIST.
607 If a parameter is not specially recognized, do nothing;
608 otherwise call the `x_set_...' function for that parameter. */
611 x_set_frame_parameters (f
, alist
)
617 /* If both of these parameters are present, it's more efficient to
618 set them both at once. So we wait until we've looked at the
619 entire list before we set them. */
623 Lisp_Object left
, top
;
625 /* Same with these. */
626 Lisp_Object icon_left
, icon_top
;
628 /* Record in these vectors all the parms specified. */
632 int left_no_change
= 0, top_no_change
= 0;
633 int icon_left_no_change
= 0, icon_top_no_change
= 0;
636 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
639 parms
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
640 values
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
642 /* Extract parm names and values into those vectors. */
645 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
647 Lisp_Object elt
, prop
, val
;
650 parms
[i
] = Fcar (elt
);
651 values
[i
] = Fcdr (elt
);
655 top
= left
= Qunbound
;
656 icon_left
= icon_top
= Qunbound
;
658 /* Provide default values for HEIGHT and WIDTH. */
659 width
= FRAME_WIDTH (f
);
660 height
= FRAME_HEIGHT (f
);
662 /* Now process them in reverse of specified order. */
663 for (i
--; i
>= 0; i
--)
665 Lisp_Object prop
, val
;
670 if (EQ (prop
, Qwidth
) && NUMBERP (val
))
671 width
= XFASTINT (val
);
672 else if (EQ (prop
, Qheight
) && NUMBERP (val
))
673 height
= XFASTINT (val
);
674 else if (EQ (prop
, Qtop
))
676 else if (EQ (prop
, Qleft
))
678 else if (EQ (prop
, Qicon_top
))
680 else if (EQ (prop
, Qicon_left
))
684 register Lisp_Object param_index
, old_value
;
686 param_index
= Fget (prop
, Qx_frame_parameter
);
687 old_value
= get_frame_param (f
, prop
);
688 store_frame_param (f
, prop
, val
);
689 if (NATNUMP (param_index
)
690 && (XFASTINT (param_index
)
691 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
692 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
696 /* Don't die if just one of these was set. */
697 if (EQ (left
, Qunbound
))
700 if (f
->output_data
.w32
->left_pos
< 0)
701 left
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.w32
->left_pos
), Qnil
));
703 XSETINT (left
, f
->output_data
.w32
->left_pos
);
705 if (EQ (top
, Qunbound
))
708 if (f
->output_data
.w32
->top_pos
< 0)
709 top
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.w32
->top_pos
), Qnil
));
711 XSETINT (top
, f
->output_data
.w32
->top_pos
);
714 /* If one of the icon positions was not set, preserve or default it. */
715 if (EQ (icon_left
, Qunbound
) || ! INTEGERP (icon_left
))
717 icon_left_no_change
= 1;
718 icon_left
= Fcdr (Fassq (Qicon_left
, f
->param_alist
));
719 if (NILP (icon_left
))
720 XSETINT (icon_left
, 0);
722 if (EQ (icon_top
, Qunbound
) || ! INTEGERP (icon_top
))
724 icon_top_no_change
= 1;
725 icon_top
= Fcdr (Fassq (Qicon_top
, f
->param_alist
));
727 XSETINT (icon_top
, 0);
730 /* Don't set these parameters unless they've been explicitly
731 specified. The window might be mapped or resized while we're in
732 this function, and we don't want to override that unless the lisp
733 code has asked for it.
735 Don't set these parameters unless they actually differ from the
736 window's current parameters; the window may not actually exist
741 check_frame_size (f
, &height
, &width
);
743 XSETFRAME (frame
, f
);
745 if (XINT (width
) != FRAME_WIDTH (f
)
746 || XINT (height
) != FRAME_HEIGHT (f
))
747 Fset_frame_size (frame
, make_number (width
), make_number (height
));
749 if ((!NILP (left
) || !NILP (top
))
750 && ! (left_no_change
&& top_no_change
)
751 && ! (NUMBERP (left
) && XINT (left
) == f
->output_data
.w32
->left_pos
752 && NUMBERP (top
) && XINT (top
) == f
->output_data
.w32
->top_pos
))
757 /* Record the signs. */
758 f
->output_data
.w32
->size_hint_flags
&= ~ (XNegative
| YNegative
);
759 if (EQ (left
, Qminus
))
760 f
->output_data
.w32
->size_hint_flags
|= XNegative
;
761 else if (INTEGERP (left
))
763 leftpos
= XINT (left
);
765 f
->output_data
.w32
->size_hint_flags
|= XNegative
;
767 else if (CONSP (left
) && EQ (XCONS (left
)->car
, Qminus
)
768 && CONSP (XCONS (left
)->cdr
)
769 && INTEGERP (XCONS (XCONS (left
)->cdr
)->car
))
771 leftpos
= - XINT (XCONS (XCONS (left
)->cdr
)->car
);
772 f
->output_data
.w32
->size_hint_flags
|= XNegative
;
774 else if (CONSP (left
) && EQ (XCONS (left
)->car
, Qplus
)
775 && CONSP (XCONS (left
)->cdr
)
776 && INTEGERP (XCONS (XCONS (left
)->cdr
)->car
))
778 leftpos
= XINT (XCONS (XCONS (left
)->cdr
)->car
);
781 if (EQ (top
, Qminus
))
782 f
->output_data
.w32
->size_hint_flags
|= YNegative
;
783 else if (INTEGERP (top
))
787 f
->output_data
.w32
->size_hint_flags
|= YNegative
;
789 else if (CONSP (top
) && EQ (XCONS (top
)->car
, Qminus
)
790 && CONSP (XCONS (top
)->cdr
)
791 && INTEGERP (XCONS (XCONS (top
)->cdr
)->car
))
793 toppos
= - XINT (XCONS (XCONS (top
)->cdr
)->car
);
794 f
->output_data
.w32
->size_hint_flags
|= YNegative
;
796 else if (CONSP (top
) && EQ (XCONS (top
)->car
, Qplus
)
797 && CONSP (XCONS (top
)->cdr
)
798 && INTEGERP (XCONS (XCONS (top
)->cdr
)->car
))
800 toppos
= XINT (XCONS (XCONS (top
)->cdr
)->car
);
804 /* Store the numeric value of the position. */
805 f
->output_data
.w32
->top_pos
= toppos
;
806 f
->output_data
.w32
->left_pos
= leftpos
;
808 f
->output_data
.w32
->win_gravity
= NorthWestGravity
;
810 /* Actually set that position, and convert to absolute. */
811 x_set_offset (f
, leftpos
, toppos
, -1);
814 if ((!NILP (icon_left
) || !NILP (icon_top
))
815 && ! (icon_left_no_change
&& icon_top_no_change
))
816 x_wm_set_icon_position (f
, XINT (icon_left
), XINT (icon_top
));
820 /* Store the screen positions of frame F into XPTR and YPTR.
821 These are the positions of the containing window manager window,
822 not Emacs's own window. */
825 x_real_positions (f
, xptr
, yptr
)
834 GetClientRect(FRAME_W32_WINDOW(f
), &rect
);
835 AdjustWindowRect(&rect
, f
->output_data
.w32
->dwStyle
, FRAME_EXTERNAL_MENU_BAR(f
));
841 ClientToScreen (FRAME_W32_WINDOW(f
), &pt
);
847 /* Insert a description of internally-recorded parameters of frame X
848 into the parameter alist *ALISTPTR that is to be given to the user.
849 Only parameters that are specific to W32
850 and whose values are not correctly recorded in the frame's
851 param_alist need to be considered here. */
853 x_report_frame_params (f
, alistptr
)
855 Lisp_Object
*alistptr
;
860 /* Represent negative positions (off the top or left screen edge)
861 in a way that Fmodify_frame_parameters will understand correctly. */
862 XSETINT (tem
, f
->output_data
.w32
->left_pos
);
863 if (f
->output_data
.w32
->left_pos
>= 0)
864 store_in_alist (alistptr
, Qleft
, tem
);
866 store_in_alist (alistptr
, Qleft
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
868 XSETINT (tem
, f
->output_data
.w32
->top_pos
);
869 if (f
->output_data
.w32
->top_pos
>= 0)
870 store_in_alist (alistptr
, Qtop
, tem
);
872 store_in_alist (alistptr
, Qtop
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
874 store_in_alist (alistptr
, Qborder_width
,
875 make_number (f
->output_data
.w32
->border_width
));
876 store_in_alist (alistptr
, Qinternal_border_width
,
877 make_number (f
->output_data
.w32
->internal_border_width
));
878 sprintf (buf
, "%ld", (long) FRAME_W32_WINDOW (f
));
879 store_in_alist (alistptr
, Qwindow_id
,
881 store_in_alist (alistptr
, Qicon_name
, f
->icon_name
);
882 FRAME_SAMPLE_VISIBILITY (f
);
883 store_in_alist (alistptr
, Qvisibility
,
884 (FRAME_VISIBLE_P (f
) ? Qt
885 : FRAME_ICONIFIED_P (f
) ? Qicon
: Qnil
));
886 store_in_alist (alistptr
, Qdisplay
,
887 XCONS (FRAME_W32_DISPLAY_INFO (f
)->name_list_element
)->car
);
891 DEFUN ("w32-define-rgb-color", Fw32_define_rgb_color
, Sw32_define_rgb_color
, 4, 4, 0,
892 "Convert RGB numbers to a windows color reference and associate with NAME (a string).\n\
893 This adds or updates a named color to w32-color-map, making it available for use.\n\
894 The original entry's RGB ref is returned, or nil if the entry is new.")
895 (red
, green
, blue
, name
)
896 Lisp_Object red
, green
, blue
, name
;
899 Lisp_Object oldrgb
= Qnil
;
902 CHECK_NUMBER (red
, 0);
903 CHECK_NUMBER (green
, 0);
904 CHECK_NUMBER (blue
, 0);
905 CHECK_STRING (name
, 0);
907 XSET (rgb
, Lisp_Int
, RGB(XUINT (red
), XUINT (green
), XUINT (blue
)));
911 /* replace existing entry in w32-color-map or add new entry. */
912 entry
= Fassoc (name
, Vw32_color_map
);
915 entry
= Fcons (name
, rgb
);
916 Vw32_color_map
= Fcons (entry
, Vw32_color_map
);
920 oldrgb
= Fcdr (entry
);
921 Fsetcdr (entry
, rgb
);
929 DEFUN ("w32-load-color-file", Fw32_load_color_file
, Sw32_load_color_file
, 1, 1, 0,
930 "Create an alist of color entries from an external file (ie. rgb.txt).\n\
931 Assign this value to w32-color-map to replace the existing color map.\n\
933 The file should define one named RGB color per line like so:\
935 where R,G,B are numbers between 0 and 255 and name is an arbitrary string.")
937 Lisp_Object filename
;
940 Lisp_Object cmap
= Qnil
;
943 CHECK_STRING (filename
, 0);
944 abspath
= Fexpand_file_name (filename
, Qnil
);
946 fp
= fopen (XSTRING (filename
)->data
, "rt");
950 int red
, green
, blue
;
955 while (fgets (buf
, sizeof (buf
), fp
) != NULL
) {
956 if (sscanf (buf
, "%u %u %u %n", &red
, &green
, &blue
, &num
) == 3)
958 char *name
= buf
+ num
;
959 num
= strlen (name
) - 1;
960 if (name
[num
] == '\n')
962 cmap
= Fcons (Fcons (build_string (name
),
963 make_number (RGB (red
, green
, blue
))),
975 /* The default colors for the w32 color map */
976 typedef struct colormap_t
982 colormap_t w32_color_map
[] =
984 {"snow" , PALETTERGB (255,250,250)},
985 {"ghost white" , PALETTERGB (248,248,255)},
986 {"GhostWhite" , PALETTERGB (248,248,255)},
987 {"white smoke" , PALETTERGB (245,245,245)},
988 {"WhiteSmoke" , PALETTERGB (245,245,245)},
989 {"gainsboro" , PALETTERGB (220,220,220)},
990 {"floral white" , PALETTERGB (255,250,240)},
991 {"FloralWhite" , PALETTERGB (255,250,240)},
992 {"old lace" , PALETTERGB (253,245,230)},
993 {"OldLace" , PALETTERGB (253,245,230)},
994 {"linen" , PALETTERGB (250,240,230)},
995 {"antique white" , PALETTERGB (250,235,215)},
996 {"AntiqueWhite" , PALETTERGB (250,235,215)},
997 {"papaya whip" , PALETTERGB (255,239,213)},
998 {"PapayaWhip" , PALETTERGB (255,239,213)},
999 {"blanched almond" , PALETTERGB (255,235,205)},
1000 {"BlanchedAlmond" , PALETTERGB (255,235,205)},
1001 {"bisque" , PALETTERGB (255,228,196)},
1002 {"peach puff" , PALETTERGB (255,218,185)},
1003 {"PeachPuff" , PALETTERGB (255,218,185)},
1004 {"navajo white" , PALETTERGB (255,222,173)},
1005 {"NavajoWhite" , PALETTERGB (255,222,173)},
1006 {"moccasin" , PALETTERGB (255,228,181)},
1007 {"cornsilk" , PALETTERGB (255,248,220)},
1008 {"ivory" , PALETTERGB (255,255,240)},
1009 {"lemon chiffon" , PALETTERGB (255,250,205)},
1010 {"LemonChiffon" , PALETTERGB (255,250,205)},
1011 {"seashell" , PALETTERGB (255,245,238)},
1012 {"honeydew" , PALETTERGB (240,255,240)},
1013 {"mint cream" , PALETTERGB (245,255,250)},
1014 {"MintCream" , PALETTERGB (245,255,250)},
1015 {"azure" , PALETTERGB (240,255,255)},
1016 {"alice blue" , PALETTERGB (240,248,255)},
1017 {"AliceBlue" , PALETTERGB (240,248,255)},
1018 {"lavender" , PALETTERGB (230,230,250)},
1019 {"lavender blush" , PALETTERGB (255,240,245)},
1020 {"LavenderBlush" , PALETTERGB (255,240,245)},
1021 {"misty rose" , PALETTERGB (255,228,225)},
1022 {"MistyRose" , PALETTERGB (255,228,225)},
1023 {"white" , PALETTERGB (255,255,255)},
1024 {"black" , PALETTERGB ( 0, 0, 0)},
1025 {"dark slate gray" , PALETTERGB ( 47, 79, 79)},
1026 {"DarkSlateGray" , PALETTERGB ( 47, 79, 79)},
1027 {"dark slate grey" , PALETTERGB ( 47, 79, 79)},
1028 {"DarkSlateGrey" , PALETTERGB ( 47, 79, 79)},
1029 {"dim gray" , PALETTERGB (105,105,105)},
1030 {"DimGray" , PALETTERGB (105,105,105)},
1031 {"dim grey" , PALETTERGB (105,105,105)},
1032 {"DimGrey" , PALETTERGB (105,105,105)},
1033 {"slate gray" , PALETTERGB (112,128,144)},
1034 {"SlateGray" , PALETTERGB (112,128,144)},
1035 {"slate grey" , PALETTERGB (112,128,144)},
1036 {"SlateGrey" , PALETTERGB (112,128,144)},
1037 {"light slate gray" , PALETTERGB (119,136,153)},
1038 {"LightSlateGray" , PALETTERGB (119,136,153)},
1039 {"light slate grey" , PALETTERGB (119,136,153)},
1040 {"LightSlateGrey" , PALETTERGB (119,136,153)},
1041 {"gray" , PALETTERGB (190,190,190)},
1042 {"grey" , PALETTERGB (190,190,190)},
1043 {"light grey" , PALETTERGB (211,211,211)},
1044 {"LightGrey" , PALETTERGB (211,211,211)},
1045 {"light gray" , PALETTERGB (211,211,211)},
1046 {"LightGray" , PALETTERGB (211,211,211)},
1047 {"midnight blue" , PALETTERGB ( 25, 25,112)},
1048 {"MidnightBlue" , PALETTERGB ( 25, 25,112)},
1049 {"navy" , PALETTERGB ( 0, 0,128)},
1050 {"navy blue" , PALETTERGB ( 0, 0,128)},
1051 {"NavyBlue" , PALETTERGB ( 0, 0,128)},
1052 {"cornflower blue" , PALETTERGB (100,149,237)},
1053 {"CornflowerBlue" , PALETTERGB (100,149,237)},
1054 {"dark slate blue" , PALETTERGB ( 72, 61,139)},
1055 {"DarkSlateBlue" , PALETTERGB ( 72, 61,139)},
1056 {"slate blue" , PALETTERGB (106, 90,205)},
1057 {"SlateBlue" , PALETTERGB (106, 90,205)},
1058 {"medium slate blue" , PALETTERGB (123,104,238)},
1059 {"MediumSlateBlue" , PALETTERGB (123,104,238)},
1060 {"light slate blue" , PALETTERGB (132,112,255)},
1061 {"LightSlateBlue" , PALETTERGB (132,112,255)},
1062 {"medium blue" , PALETTERGB ( 0, 0,205)},
1063 {"MediumBlue" , PALETTERGB ( 0, 0,205)},
1064 {"royal blue" , PALETTERGB ( 65,105,225)},
1065 {"RoyalBlue" , PALETTERGB ( 65,105,225)},
1066 {"blue" , PALETTERGB ( 0, 0,255)},
1067 {"dodger blue" , PALETTERGB ( 30,144,255)},
1068 {"DodgerBlue" , PALETTERGB ( 30,144,255)},
1069 {"deep sky blue" , PALETTERGB ( 0,191,255)},
1070 {"DeepSkyBlue" , PALETTERGB ( 0,191,255)},
1071 {"sky blue" , PALETTERGB (135,206,235)},
1072 {"SkyBlue" , PALETTERGB (135,206,235)},
1073 {"light sky blue" , PALETTERGB (135,206,250)},
1074 {"LightSkyBlue" , PALETTERGB (135,206,250)},
1075 {"steel blue" , PALETTERGB ( 70,130,180)},
1076 {"SteelBlue" , PALETTERGB ( 70,130,180)},
1077 {"light steel blue" , PALETTERGB (176,196,222)},
1078 {"LightSteelBlue" , PALETTERGB (176,196,222)},
1079 {"light blue" , PALETTERGB (173,216,230)},
1080 {"LightBlue" , PALETTERGB (173,216,230)},
1081 {"powder blue" , PALETTERGB (176,224,230)},
1082 {"PowderBlue" , PALETTERGB (176,224,230)},
1083 {"pale turquoise" , PALETTERGB (175,238,238)},
1084 {"PaleTurquoise" , PALETTERGB (175,238,238)},
1085 {"dark turquoise" , PALETTERGB ( 0,206,209)},
1086 {"DarkTurquoise" , PALETTERGB ( 0,206,209)},
1087 {"medium turquoise" , PALETTERGB ( 72,209,204)},
1088 {"MediumTurquoise" , PALETTERGB ( 72,209,204)},
1089 {"turquoise" , PALETTERGB ( 64,224,208)},
1090 {"cyan" , PALETTERGB ( 0,255,255)},
1091 {"light cyan" , PALETTERGB (224,255,255)},
1092 {"LightCyan" , PALETTERGB (224,255,255)},
1093 {"cadet blue" , PALETTERGB ( 95,158,160)},
1094 {"CadetBlue" , PALETTERGB ( 95,158,160)},
1095 {"medium aquamarine" , PALETTERGB (102,205,170)},
1096 {"MediumAquamarine" , PALETTERGB (102,205,170)},
1097 {"aquamarine" , PALETTERGB (127,255,212)},
1098 {"dark green" , PALETTERGB ( 0,100, 0)},
1099 {"DarkGreen" , PALETTERGB ( 0,100, 0)},
1100 {"dark olive green" , PALETTERGB ( 85,107, 47)},
1101 {"DarkOliveGreen" , PALETTERGB ( 85,107, 47)},
1102 {"dark sea green" , PALETTERGB (143,188,143)},
1103 {"DarkSeaGreen" , PALETTERGB (143,188,143)},
1104 {"sea green" , PALETTERGB ( 46,139, 87)},
1105 {"SeaGreen" , PALETTERGB ( 46,139, 87)},
1106 {"medium sea green" , PALETTERGB ( 60,179,113)},
1107 {"MediumSeaGreen" , PALETTERGB ( 60,179,113)},
1108 {"light sea green" , PALETTERGB ( 32,178,170)},
1109 {"LightSeaGreen" , PALETTERGB ( 32,178,170)},
1110 {"pale green" , PALETTERGB (152,251,152)},
1111 {"PaleGreen" , PALETTERGB (152,251,152)},
1112 {"spring green" , PALETTERGB ( 0,255,127)},
1113 {"SpringGreen" , PALETTERGB ( 0,255,127)},
1114 {"lawn green" , PALETTERGB (124,252, 0)},
1115 {"LawnGreen" , PALETTERGB (124,252, 0)},
1116 {"green" , PALETTERGB ( 0,255, 0)},
1117 {"chartreuse" , PALETTERGB (127,255, 0)},
1118 {"medium spring green" , PALETTERGB ( 0,250,154)},
1119 {"MediumSpringGreen" , PALETTERGB ( 0,250,154)},
1120 {"green yellow" , PALETTERGB (173,255, 47)},
1121 {"GreenYellow" , PALETTERGB (173,255, 47)},
1122 {"lime green" , PALETTERGB ( 50,205, 50)},
1123 {"LimeGreen" , PALETTERGB ( 50,205, 50)},
1124 {"yellow green" , PALETTERGB (154,205, 50)},
1125 {"YellowGreen" , PALETTERGB (154,205, 50)},
1126 {"forest green" , PALETTERGB ( 34,139, 34)},
1127 {"ForestGreen" , PALETTERGB ( 34,139, 34)},
1128 {"olive drab" , PALETTERGB (107,142, 35)},
1129 {"OliveDrab" , PALETTERGB (107,142, 35)},
1130 {"dark khaki" , PALETTERGB (189,183,107)},
1131 {"DarkKhaki" , PALETTERGB (189,183,107)},
1132 {"khaki" , PALETTERGB (240,230,140)},
1133 {"pale goldenrod" , PALETTERGB (238,232,170)},
1134 {"PaleGoldenrod" , PALETTERGB (238,232,170)},
1135 {"light goldenrod yellow" , PALETTERGB (250,250,210)},
1136 {"LightGoldenrodYellow" , PALETTERGB (250,250,210)},
1137 {"light yellow" , PALETTERGB (255,255,224)},
1138 {"LightYellow" , PALETTERGB (255,255,224)},
1139 {"yellow" , PALETTERGB (255,255, 0)},
1140 {"gold" , PALETTERGB (255,215, 0)},
1141 {"light goldenrod" , PALETTERGB (238,221,130)},
1142 {"LightGoldenrod" , PALETTERGB (238,221,130)},
1143 {"goldenrod" , PALETTERGB (218,165, 32)},
1144 {"dark goldenrod" , PALETTERGB (184,134, 11)},
1145 {"DarkGoldenrod" , PALETTERGB (184,134, 11)},
1146 {"rosy brown" , PALETTERGB (188,143,143)},
1147 {"RosyBrown" , PALETTERGB (188,143,143)},
1148 {"indian red" , PALETTERGB (205, 92, 92)},
1149 {"IndianRed" , PALETTERGB (205, 92, 92)},
1150 {"saddle brown" , PALETTERGB (139, 69, 19)},
1151 {"SaddleBrown" , PALETTERGB (139, 69, 19)},
1152 {"sienna" , PALETTERGB (160, 82, 45)},
1153 {"peru" , PALETTERGB (205,133, 63)},
1154 {"burlywood" , PALETTERGB (222,184,135)},
1155 {"beige" , PALETTERGB (245,245,220)},
1156 {"wheat" , PALETTERGB (245,222,179)},
1157 {"sandy brown" , PALETTERGB (244,164, 96)},
1158 {"SandyBrown" , PALETTERGB (244,164, 96)},
1159 {"tan" , PALETTERGB (210,180,140)},
1160 {"chocolate" , PALETTERGB (210,105, 30)},
1161 {"firebrick" , PALETTERGB (178,34, 34)},
1162 {"brown" , PALETTERGB (165,42, 42)},
1163 {"dark salmon" , PALETTERGB (233,150,122)},
1164 {"DarkSalmon" , PALETTERGB (233,150,122)},
1165 {"salmon" , PALETTERGB (250,128,114)},
1166 {"light salmon" , PALETTERGB (255,160,122)},
1167 {"LightSalmon" , PALETTERGB (255,160,122)},
1168 {"orange" , PALETTERGB (255,165, 0)},
1169 {"dark orange" , PALETTERGB (255,140, 0)},
1170 {"DarkOrange" , PALETTERGB (255,140, 0)},
1171 {"coral" , PALETTERGB (255,127, 80)},
1172 {"light coral" , PALETTERGB (240,128,128)},
1173 {"LightCoral" , PALETTERGB (240,128,128)},
1174 {"tomato" , PALETTERGB (255, 99, 71)},
1175 {"orange red" , PALETTERGB (255, 69, 0)},
1176 {"OrangeRed" , PALETTERGB (255, 69, 0)},
1177 {"red" , PALETTERGB (255, 0, 0)},
1178 {"hot pink" , PALETTERGB (255,105,180)},
1179 {"HotPink" , PALETTERGB (255,105,180)},
1180 {"deep pink" , PALETTERGB (255, 20,147)},
1181 {"DeepPink" , PALETTERGB (255, 20,147)},
1182 {"pink" , PALETTERGB (255,192,203)},
1183 {"light pink" , PALETTERGB (255,182,193)},
1184 {"LightPink" , PALETTERGB (255,182,193)},
1185 {"pale violet red" , PALETTERGB (219,112,147)},
1186 {"PaleVioletRed" , PALETTERGB (219,112,147)},
1187 {"maroon" , PALETTERGB (176, 48, 96)},
1188 {"medium violet red" , PALETTERGB (199, 21,133)},
1189 {"MediumVioletRed" , PALETTERGB (199, 21,133)},
1190 {"violet red" , PALETTERGB (208, 32,144)},
1191 {"VioletRed" , PALETTERGB (208, 32,144)},
1192 {"magenta" , PALETTERGB (255, 0,255)},
1193 {"violet" , PALETTERGB (238,130,238)},
1194 {"plum" , PALETTERGB (221,160,221)},
1195 {"orchid" , PALETTERGB (218,112,214)},
1196 {"medium orchid" , PALETTERGB (186, 85,211)},
1197 {"MediumOrchid" , PALETTERGB (186, 85,211)},
1198 {"dark orchid" , PALETTERGB (153, 50,204)},
1199 {"DarkOrchid" , PALETTERGB (153, 50,204)},
1200 {"dark violet" , PALETTERGB (148, 0,211)},
1201 {"DarkViolet" , PALETTERGB (148, 0,211)},
1202 {"blue violet" , PALETTERGB (138, 43,226)},
1203 {"BlueViolet" , PALETTERGB (138, 43,226)},
1204 {"purple" , PALETTERGB (160, 32,240)},
1205 {"medium purple" , PALETTERGB (147,112,219)},
1206 {"MediumPurple" , PALETTERGB (147,112,219)},
1207 {"thistle" , PALETTERGB (216,191,216)},
1208 {"gray0" , PALETTERGB ( 0, 0, 0)},
1209 {"grey0" , PALETTERGB ( 0, 0, 0)},
1210 {"dark grey" , PALETTERGB (169,169,169)},
1211 {"DarkGrey" , PALETTERGB (169,169,169)},
1212 {"dark gray" , PALETTERGB (169,169,169)},
1213 {"DarkGray" , PALETTERGB (169,169,169)},
1214 {"dark blue" , PALETTERGB ( 0, 0,139)},
1215 {"DarkBlue" , PALETTERGB ( 0, 0,139)},
1216 {"dark cyan" , PALETTERGB ( 0,139,139)},
1217 {"DarkCyan" , PALETTERGB ( 0,139,139)},
1218 {"dark magenta" , PALETTERGB (139, 0,139)},
1219 {"DarkMagenta" , PALETTERGB (139, 0,139)},
1220 {"dark red" , PALETTERGB (139, 0, 0)},
1221 {"DarkRed" , PALETTERGB (139, 0, 0)},
1222 {"light green" , PALETTERGB (144,238,144)},
1223 {"LightGreen" , PALETTERGB (144,238,144)},
1226 DEFUN ("w32-default-color-map", Fw32_default_color_map
, Sw32_default_color_map
,
1227 0, 0, 0, "Return the default color map.")
1231 colormap_t
*pc
= w32_color_map
;
1238 for (i
= 0; i
< sizeof (w32_color_map
) / sizeof (w32_color_map
[0]);
1240 cmap
= Fcons (Fcons (build_string (pc
->name
),
1241 make_number (pc
->colorref
)),
1250 w32_to_x_color (rgb
)
1255 CHECK_NUMBER (rgb
, 0);
1259 color
= Frassq (rgb
, Vw32_color_map
);
1264 return (Fcar (color
));
1270 x_to_w32_color (colorname
)
1273 register Lisp_Object tail
, ret
= Qnil
;
1277 if (colorname
[0] == '#')
1279 /* Could be an old-style RGB Device specification. */
1282 color
= colorname
+ 1;
1284 size
= strlen(color
);
1285 if (size
== 3 || size
== 6 || size
== 9 || size
== 12)
1293 for (i
= 0; i
< 3; i
++)
1297 unsigned long value
;
1299 /* The check for 'x' in the following conditional takes into
1300 account the fact that strtol allows a "0x" in front of
1301 our numbers, and we don't. */
1302 if (!isxdigit(color
[0]) || color
[1] == 'x')
1306 value
= strtoul(color
, &end
, 16);
1308 if (errno
== ERANGE
|| end
- color
!= size
)
1313 value
= value
* 0x10;
1324 colorval
|= (value
<< pos
);
1335 else if (strnicmp(colorname
, "rgb:", 4) == 0)
1343 color
= colorname
+ 4;
1344 for (i
= 0; i
< 3; i
++)
1347 unsigned long value
;
1349 /* The check for 'x' in the following conditional takes into
1350 account the fact that strtol allows a "0x" in front of
1351 our numbers, and we don't. */
1352 if (!isxdigit(color
[0]) || color
[1] == 'x')
1354 value
= strtoul(color
, &end
, 16);
1355 if (errno
== ERANGE
)
1357 switch (end
- color
)
1360 value
= value
* 0x10 + value
;
1373 if (value
== ULONG_MAX
)
1375 colorval
|= (value
<< pos
);
1389 else if (strnicmp(colorname
, "rgbi:", 5) == 0)
1391 /* This is an RGB Intensity specification. */
1398 color
= colorname
+ 5;
1399 for (i
= 0; i
< 3; i
++)
1405 value
= strtod(color
, &end
);
1406 if (errno
== ERANGE
)
1408 if (value
< 0.0 || value
> 1.0)
1410 val
= (UINT
)(0x100 * value
);
1411 /* We used 0x100 instead of 0xFF to give an continuous
1412 range between 0.0 and 1.0 inclusive. The next statement
1413 fixes the 1.0 case. */
1416 colorval
|= (val
<< pos
);
1430 /* I am not going to attempt to handle any of the CIE color schemes
1431 or TekHVC, since I don't know the algorithms for conversion to
1434 for (tail
= Vw32_color_map
; !NILP (tail
); tail
= Fcdr (tail
))
1436 register Lisp_Object elt
, tem
;
1439 if (!CONSP (elt
)) continue;
1443 if (lstrcmpi (XSTRING (tem
)->data
, colorname
) == 0)
1445 ret
= XUINT(Fcdr (elt
));
1459 w32_regenerate_palette (FRAME_PTR f
)
1461 struct w32_palette_entry
* list
;
1462 LOGPALETTE
* log_palette
;
1463 HPALETTE new_palette
;
1466 /* don't bother trying to create palette if not supported */
1467 if (! FRAME_W32_DISPLAY_INFO (f
)->has_palette
)
1470 log_palette
= (LOGPALETTE
*)
1471 alloca (sizeof (LOGPALETTE
) +
1472 FRAME_W32_DISPLAY_INFO (f
)->num_colors
* sizeof (PALETTEENTRY
));
1473 log_palette
->palVersion
= 0x300;
1474 log_palette
->palNumEntries
= FRAME_W32_DISPLAY_INFO (f
)->num_colors
;
1476 list
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1478 i
< FRAME_W32_DISPLAY_INFO (f
)->num_colors
;
1479 i
++, list
= list
->next
)
1480 log_palette
->palPalEntry
[i
] = list
->entry
;
1482 new_palette
= CreatePalette (log_palette
);
1486 if (FRAME_W32_DISPLAY_INFO (f
)->palette
)
1487 DeleteObject (FRAME_W32_DISPLAY_INFO (f
)->palette
);
1488 FRAME_W32_DISPLAY_INFO (f
)->palette
= new_palette
;
1490 /* Realize display palette and garbage all frames. */
1491 release_frame_dc (f
, get_frame_dc (f
));
1496 #define W32_COLOR(pe) RGB (pe.peRed, pe.peGreen, pe.peBlue)
1497 #define SET_W32_COLOR(pe, color) \
1500 pe.peRed = GetRValue (color); \
1501 pe.peGreen = GetGValue (color); \
1502 pe.peBlue = GetBValue (color); \
1507 /* Keep these around in case we ever want to track color usage. */
1509 w32_map_color (FRAME_PTR f
, COLORREF color
)
1511 struct w32_palette_entry
* list
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1513 if (NILP (Vw32_enable_palette
))
1516 /* check if color is already mapped */
1519 if (W32_COLOR (list
->entry
) == color
)
1527 /* not already mapped, so add to list and recreate Windows palette */
1528 list
= (struct w32_palette_entry
*)
1529 xmalloc (sizeof (struct w32_palette_entry
));
1530 SET_W32_COLOR (list
->entry
, color
);
1532 list
->next
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1533 FRAME_W32_DISPLAY_INFO (f
)->color_list
= list
;
1534 FRAME_W32_DISPLAY_INFO (f
)->num_colors
++;
1536 /* set flag that palette must be regenerated */
1537 FRAME_W32_DISPLAY_INFO (f
)->regen_palette
= TRUE
;
1541 w32_unmap_color (FRAME_PTR f
, COLORREF color
)
1543 struct w32_palette_entry
* list
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1544 struct w32_palette_entry
**prev
= &FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1546 if (NILP (Vw32_enable_palette
))
1549 /* check if color is already mapped */
1552 if (W32_COLOR (list
->entry
) == color
)
1554 if (--list
->refcount
== 0)
1558 FRAME_W32_DISPLAY_INFO (f
)->num_colors
--;
1568 /* set flag that palette must be regenerated */
1569 FRAME_W32_DISPLAY_INFO (f
)->regen_palette
= TRUE
;
1573 /* Decide if color named COLOR is valid for the display associated with
1574 the selected frame; if so, return the rgb values in COLOR_DEF.
1575 If ALLOC is nonzero, allocate a new colormap cell. */
1578 defined_color (f
, color
, color_def
, alloc
)
1581 COLORREF
*color_def
;
1584 register Lisp_Object tem
;
1586 tem
= x_to_w32_color (color
);
1590 if (!NILP (Vw32_enable_palette
))
1592 struct w32_palette_entry
* entry
=
1593 FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1594 struct w32_palette_entry
** prev
=
1595 &FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1597 /* check if color is already mapped */
1600 if (W32_COLOR (entry
->entry
) == XUINT (tem
))
1602 prev
= &entry
->next
;
1603 entry
= entry
->next
;
1606 if (entry
== NULL
&& alloc
)
1608 /* not already mapped, so add to list */
1609 entry
= (struct w32_palette_entry
*)
1610 xmalloc (sizeof (struct w32_palette_entry
));
1611 SET_W32_COLOR (entry
->entry
, XUINT (tem
));
1614 FRAME_W32_DISPLAY_INFO (f
)->num_colors
++;
1616 /* set flag that palette must be regenerated */
1617 FRAME_W32_DISPLAY_INFO (f
)->regen_palette
= TRUE
;
1620 /* Ensure COLORREF value is snapped to nearest color in (default)
1621 palette by simulating the PALETTERGB macro. This works whether
1622 or not the display device has a palette. */
1623 *color_def
= XUINT (tem
) | 0x2000000;
1632 /* Given a string ARG naming a color, compute a pixel value from it
1633 suitable for screen F.
1634 If F is not a color screen, return DEF (default) regardless of what
1638 x_decode_color (f
, arg
, def
)
1645 CHECK_STRING (arg
, 0);
1647 if (strcmp (XSTRING (arg
)->data
, "black") == 0)
1648 return BLACK_PIX_DEFAULT (f
);
1649 else if (strcmp (XSTRING (arg
)->data
, "white") == 0)
1650 return WHITE_PIX_DEFAULT (f
);
1652 if ((FRAME_W32_DISPLAY_INFO (f
)->n_planes
* FRAME_W32_DISPLAY_INFO (f
)->n_cbits
) == 1)
1655 /* defined_color is responsible for coping with failures
1656 by looking for a near-miss. */
1657 if (defined_color (f
, XSTRING (arg
)->data
, &cdef
, 1))
1660 /* defined_color failed; return an ultimate default. */
1664 /* Functions called only from `x_set_frame_param'
1665 to set individual parameters.
1667 If FRAME_W32_WINDOW (f) is 0,
1668 the frame is being created and its window does not exist yet.
1669 In that case, just record the parameter's new value
1670 in the standard place; do not attempt to change the window. */
1673 x_set_foreground_color (f
, arg
, oldval
)
1675 Lisp_Object arg
, oldval
;
1677 f
->output_data
.w32
->foreground_pixel
1678 = x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1680 if (FRAME_W32_WINDOW (f
) != 0)
1682 recompute_basic_faces (f
);
1683 if (FRAME_VISIBLE_P (f
))
1689 x_set_background_color (f
, arg
, oldval
)
1691 Lisp_Object arg
, oldval
;
1696 f
->output_data
.w32
->background_pixel
1697 = x_decode_color (f
, arg
, WHITE_PIX_DEFAULT (f
));
1699 if (FRAME_W32_WINDOW (f
) != 0)
1701 SetWindowLong (FRAME_W32_WINDOW (f
), WND_BACKGROUND_INDEX
, f
->output_data
.w32
->background_pixel
);
1703 recompute_basic_faces (f
);
1705 if (FRAME_VISIBLE_P (f
))
1711 x_set_mouse_color (f
, arg
, oldval
)
1713 Lisp_Object arg
, oldval
;
1716 Cursor cursor
, nontext_cursor
, mode_cursor
, cross_cursor
;
1721 if (!EQ (Qnil
, arg
))
1722 f
->output_data
.w32
->mouse_pixel
1723 = x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1724 mask_color
= f
->output_data
.w32
->background_pixel
;
1725 /* No invisible pointers. */
1726 if (mask_color
== f
->output_data
.w32
->mouse_pixel
1727 && mask_color
== f
->output_data
.w32
->background_pixel
)
1728 f
->output_data
.w32
->mouse_pixel
= f
->output_data
.w32
->foreground_pixel
;
1733 /* It's not okay to crash if the user selects a screwy cursor. */
1734 count
= x_catch_errors (FRAME_W32_DISPLAY (f
));
1736 if (!EQ (Qnil
, Vx_pointer_shape
))
1738 CHECK_NUMBER (Vx_pointer_shape
, 0);
1739 cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XINT (Vx_pointer_shape
));
1742 cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_xterm
);
1743 x_check_errors (FRAME_W32_DISPLAY (f
), "bad text pointer cursor: %s");
1745 if (!EQ (Qnil
, Vx_nontext_pointer_shape
))
1747 CHECK_NUMBER (Vx_nontext_pointer_shape
, 0);
1748 nontext_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
),
1749 XINT (Vx_nontext_pointer_shape
));
1752 nontext_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_left_ptr
);
1753 x_check_errors (FRAME_W32_DISPLAY (f
), "bad nontext pointer cursor: %s");
1755 if (!EQ (Qnil
, Vx_mode_pointer_shape
))
1757 CHECK_NUMBER (Vx_mode_pointer_shape
, 0);
1758 mode_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
),
1759 XINT (Vx_mode_pointer_shape
));
1762 mode_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_xterm
);
1763 x_check_errors (FRAME_W32_DISPLAY (f
), "bad modeline pointer cursor: %s");
1765 if (!EQ (Qnil
, Vx_sensitive_text_pointer_shape
))
1767 CHECK_NUMBER (Vx_sensitive_text_pointer_shape
, 0);
1769 = XCreateFontCursor (FRAME_W32_DISPLAY (f
),
1770 XINT (Vx_sensitive_text_pointer_shape
));
1773 cross_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_crosshair
);
1775 /* Check and report errors with the above calls. */
1776 x_check_errors (FRAME_W32_DISPLAY (f
), "can't set cursor shape: %s");
1777 x_uncatch_errors (FRAME_W32_DISPLAY (f
), count
);
1780 XColor fore_color
, back_color
;
1782 fore_color
.pixel
= f
->output_data
.w32
->mouse_pixel
;
1783 back_color
.pixel
= mask_color
;
1784 XQueryColor (FRAME_W32_DISPLAY (f
),
1785 DefaultColormap (FRAME_W32_DISPLAY (f
),
1786 DefaultScreen (FRAME_W32_DISPLAY (f
))),
1788 XQueryColor (FRAME_W32_DISPLAY (f
),
1789 DefaultColormap (FRAME_W32_DISPLAY (f
),
1790 DefaultScreen (FRAME_W32_DISPLAY (f
))),
1792 XRecolorCursor (FRAME_W32_DISPLAY (f
), cursor
,
1793 &fore_color
, &back_color
);
1794 XRecolorCursor (FRAME_W32_DISPLAY (f
), nontext_cursor
,
1795 &fore_color
, &back_color
);
1796 XRecolorCursor (FRAME_W32_DISPLAY (f
), mode_cursor
,
1797 &fore_color
, &back_color
);
1798 XRecolorCursor (FRAME_W32_DISPLAY (f
), cross_cursor
,
1799 &fore_color
, &back_color
);
1802 if (FRAME_W32_WINDOW (f
) != 0)
1804 XDefineCursor (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
), cursor
);
1807 if (cursor
!= f
->output_data
.w32
->text_cursor
&& f
->output_data
.w32
->text_cursor
!= 0)
1808 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->text_cursor
);
1809 f
->output_data
.w32
->text_cursor
= cursor
;
1811 if (nontext_cursor
!= f
->output_data
.w32
->nontext_cursor
1812 && f
->output_data
.w32
->nontext_cursor
!= 0)
1813 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->nontext_cursor
);
1814 f
->output_data
.w32
->nontext_cursor
= nontext_cursor
;
1816 if (mode_cursor
!= f
->output_data
.w32
->modeline_cursor
1817 && f
->output_data
.w32
->modeline_cursor
!= 0)
1818 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->modeline_cursor
);
1819 f
->output_data
.w32
->modeline_cursor
= mode_cursor
;
1820 if (cross_cursor
!= f
->output_data
.w32
->cross_cursor
1821 && f
->output_data
.w32
->cross_cursor
!= 0)
1822 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->cross_cursor
);
1823 f
->output_data
.w32
->cross_cursor
= cross_cursor
;
1825 XFlush (FRAME_W32_DISPLAY (f
));
1831 x_set_cursor_color (f
, arg
, oldval
)
1833 Lisp_Object arg
, oldval
;
1835 unsigned long fore_pixel
;
1837 if (!EQ (Vx_cursor_fore_pixel
, Qnil
))
1838 fore_pixel
= x_decode_color (f
, Vx_cursor_fore_pixel
,
1839 WHITE_PIX_DEFAULT (f
));
1841 fore_pixel
= f
->output_data
.w32
->background_pixel
;
1842 f
->output_data
.w32
->cursor_pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1844 /* Make sure that the cursor color differs from the background color. */
1845 if (f
->output_data
.w32
->cursor_pixel
== f
->output_data
.w32
->background_pixel
)
1847 f
->output_data
.w32
->cursor_pixel
= f
->output_data
.w32
->mouse_pixel
;
1848 if (f
->output_data
.w32
->cursor_pixel
== fore_pixel
)
1849 fore_pixel
= f
->output_data
.w32
->background_pixel
;
1851 f
->output_data
.w32
->cursor_foreground_pixel
= fore_pixel
;
1853 if (FRAME_W32_WINDOW (f
) != 0)
1855 if (FRAME_VISIBLE_P (f
))
1857 x_display_cursor (f
, 0);
1858 x_display_cursor (f
, 1);
1863 /* Set the border-color of frame F to value described by ARG.
1864 ARG can be a string naming a color.
1865 The border-color is used for the border that is drawn by the server.
1866 Note that this does not fully take effect if done before
1867 F has a window; it must be redone when the window is created. */
1870 x_set_border_color (f
, arg
, oldval
)
1872 Lisp_Object arg
, oldval
;
1877 CHECK_STRING (arg
, 0);
1878 str
= XSTRING (arg
)->data
;
1880 pix
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1882 x_set_border_pixel (f
, pix
);
1885 /* Set the border-color of frame F to pixel value PIX.
1886 Note that this does not fully take effect if done before
1889 x_set_border_pixel (f
, pix
)
1893 f
->output_data
.w32
->border_pixel
= pix
;
1895 if (FRAME_W32_WINDOW (f
) != 0 && f
->output_data
.w32
->border_width
> 0)
1897 if (FRAME_VISIBLE_P (f
))
1903 x_set_cursor_type (f
, arg
, oldval
)
1905 Lisp_Object arg
, oldval
;
1909 FRAME_DESIRED_CURSOR (f
) = bar_cursor
;
1910 f
->output_data
.w32
->cursor_width
= 2;
1912 else if (CONSP (arg
) && EQ (XCONS (arg
)->car
, Qbar
)
1913 && INTEGERP (XCONS (arg
)->cdr
))
1915 FRAME_DESIRED_CURSOR (f
) = bar_cursor
;
1916 f
->output_data
.w32
->cursor_width
= XINT (XCONS (arg
)->cdr
);
1919 /* Treat anything unknown as "box cursor".
1920 It was bad to signal an error; people have trouble fixing
1921 .Xdefaults with Emacs, when it has something bad in it. */
1922 FRAME_DESIRED_CURSOR (f
) = filled_box_cursor
;
1924 /* Make sure the cursor gets redrawn. This is overkill, but how
1925 often do people change cursor types? */
1926 update_mode_lines
++;
1930 x_set_icon_type (f
, arg
, oldval
)
1932 Lisp_Object arg
, oldval
;
1940 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1943 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1948 result
= x_text_icon (f
,
1949 (char *) XSTRING ((!NILP (f
->icon_name
)
1953 result
= x_bitmap_icon (f
, arg
);
1958 error ("No icon window available");
1961 /* If the window was unmapped (and its icon was mapped),
1962 the new icon is not mapped, so map the window in its stead. */
1963 if (FRAME_VISIBLE_P (f
))
1965 #ifdef USE_X_TOOLKIT
1966 XtPopup (f
->output_data
.w32
->widget
, XtGrabNone
);
1968 XMapWindow (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
));
1971 XFlush (FRAME_W32_DISPLAY (f
));
1976 /* Return non-nil if frame F wants a bitmap icon. */
1984 tem
= assq_no_quit (Qicon_type
, f
->param_alist
);
1986 return XCONS (tem
)->cdr
;
1992 x_set_icon_name (f
, arg
, oldval
)
1994 Lisp_Object arg
, oldval
;
2001 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
2004 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
2010 if (f
->output_data
.w32
->icon_bitmap
!= 0)
2015 result
= x_text_icon (f
,
2016 (char *) XSTRING ((!NILP (f
->icon_name
)
2025 error ("No icon window available");
2028 /* If the window was unmapped (and its icon was mapped),
2029 the new icon is not mapped, so map the window in its stead. */
2030 if (FRAME_VISIBLE_P (f
))
2032 #ifdef USE_X_TOOLKIT
2033 XtPopup (f
->output_data
.w32
->widget
, XtGrabNone
);
2035 XMapWindow (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
));
2038 XFlush (FRAME_W32_DISPLAY (f
));
2043 extern Lisp_Object
x_new_font ();
2046 x_set_font (f
, arg
, oldval
)
2048 Lisp_Object arg
, oldval
;
2053 CHECK_STRING (arg
, 1);
2056 result
= x_new_font (f
, XSTRING (arg
)->data
);
2059 if (EQ (result
, Qnil
))
2060 error ("Font \"%s\" is not defined", XSTRING (arg
)->data
);
2061 else if (EQ (result
, Qt
))
2062 error ("the characters of the given font have varying widths");
2063 else if (STRINGP (result
))
2065 recompute_basic_faces (f
);
2066 store_frame_param (f
, Qfont
, result
);
2071 XSETFRAME (frame
, f
);
2072 call1 (Qface_set_after_frame_default
, frame
);
2076 x_set_border_width (f
, arg
, oldval
)
2078 Lisp_Object arg
, oldval
;
2080 CHECK_NUMBER (arg
, 0);
2082 if (XINT (arg
) == f
->output_data
.w32
->border_width
)
2085 if (FRAME_W32_WINDOW (f
) != 0)
2086 error ("Cannot change the border width of a window");
2088 f
->output_data
.w32
->border_width
= XINT (arg
);
2092 x_set_internal_border_width (f
, arg
, oldval
)
2094 Lisp_Object arg
, oldval
;
2097 int old
= f
->output_data
.w32
->internal_border_width
;
2099 CHECK_NUMBER (arg
, 0);
2100 f
->output_data
.w32
->internal_border_width
= XINT (arg
);
2101 if (f
->output_data
.w32
->internal_border_width
< 0)
2102 f
->output_data
.w32
->internal_border_width
= 0;
2104 if (f
->output_data
.w32
->internal_border_width
== old
)
2107 if (FRAME_W32_WINDOW (f
) != 0)
2110 x_set_window_size (f
, 0, f
->width
, f
->height
);
2112 SET_FRAME_GARBAGED (f
);
2117 x_set_visibility (f
, value
, oldval
)
2119 Lisp_Object value
, oldval
;
2122 XSETFRAME (frame
, f
);
2125 Fmake_frame_invisible (frame
, Qt
);
2126 else if (EQ (value
, Qicon
))
2127 Ficonify_frame (frame
);
2129 Fmake_frame_visible (frame
);
2133 x_set_menu_bar_lines (f
, value
, oldval
)
2135 Lisp_Object value
, oldval
;
2138 int olines
= FRAME_MENU_BAR_LINES (f
);
2140 /* Right now, menu bars don't work properly in minibuf-only frames;
2141 most of the commands try to apply themselves to the minibuffer
2142 frame itslef, and get an error because you can't switch buffers
2143 in or split the minibuffer window. */
2144 if (FRAME_MINIBUF_ONLY_P (f
))
2147 if (INTEGERP (value
))
2148 nlines
= XINT (value
);
2152 FRAME_MENU_BAR_LINES (f
) = 0;
2154 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
2157 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
2158 free_frame_menubar (f
);
2159 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
2161 /* Adjust the frame size so that the client (text) dimensions
2162 remain the same. This depends on FRAME_EXTERNAL_MENU_BAR being
2164 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2168 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
2171 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2172 name; if NAME is a string, set F's name to NAME and set
2173 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2175 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2176 suggesting a new name, which lisp code should override; if
2177 F->explicit_name is set, ignore the new name; otherwise, set it. */
2180 x_set_name (f
, name
, explicit)
2185 /* Make sure that requests from lisp code override requests from
2186 Emacs redisplay code. */
2189 /* If we're switching from explicit to implicit, we had better
2190 update the mode lines and thereby update the title. */
2191 if (f
->explicit_name
&& NILP (name
))
2192 update_mode_lines
= 1;
2194 f
->explicit_name
= ! NILP (name
);
2196 else if (f
->explicit_name
)
2199 /* If NAME is nil, set the name to the w32_id_name. */
2202 /* Check for no change needed in this very common case
2203 before we do any consing. */
2204 if (!strcmp (FRAME_W32_DISPLAY_INFO (f
)->w32_id_name
,
2205 XSTRING (f
->name
)->data
))
2207 name
= build_string (FRAME_W32_DISPLAY_INFO (f
)->w32_id_name
);
2210 CHECK_STRING (name
, 0);
2212 /* Don't change the name if it's already NAME. */
2213 if (! NILP (Fstring_equal (name
, f
->name
)))
2218 /* For setting the frame title, the title parameter should override
2219 the name parameter. */
2220 if (! NILP (f
->title
))
2223 if (FRAME_W32_WINDOW (f
))
2226 SetWindowText(FRAME_W32_WINDOW (f
), XSTRING (name
)->data
);
2231 /* This function should be called when the user's lisp code has
2232 specified a name for the frame; the name will override any set by the
2235 x_explicitly_set_name (f
, arg
, oldval
)
2237 Lisp_Object arg
, oldval
;
2239 x_set_name (f
, arg
, 1);
2242 /* This function should be called by Emacs redisplay code to set the
2243 name; names set this way will never override names set by the user's
2246 x_implicitly_set_name (f
, arg
, oldval
)
2248 Lisp_Object arg
, oldval
;
2250 x_set_name (f
, arg
, 0);
2253 /* Change the title of frame F to NAME.
2254 If NAME is nil, use the frame name as the title.
2256 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2257 name; if NAME is a string, set F's name to NAME and set
2258 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2260 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2261 suggesting a new name, which lisp code should override; if
2262 F->explicit_name is set, ignore the new name; otherwise, set it. */
2265 x_set_title (f
, name
)
2269 /* Don't change the title if it's already NAME. */
2270 if (EQ (name
, f
->title
))
2273 update_mode_lines
= 1;
2280 if (FRAME_W32_WINDOW (f
))
2283 SetWindowText(FRAME_W32_WINDOW (f
), XSTRING (name
)->data
);
2289 x_set_autoraise (f
, arg
, oldval
)
2291 Lisp_Object arg
, oldval
;
2293 f
->auto_raise
= !EQ (Qnil
, arg
);
2297 x_set_autolower (f
, arg
, oldval
)
2299 Lisp_Object arg
, oldval
;
2301 f
->auto_lower
= !EQ (Qnil
, arg
);
2305 x_set_unsplittable (f
, arg
, oldval
)
2307 Lisp_Object arg
, oldval
;
2309 f
->no_split
= !NILP (arg
);
2313 x_set_vertical_scroll_bars (f
, arg
, oldval
)
2315 Lisp_Object arg
, oldval
;
2317 if ((EQ (arg
, Qleft
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f
))
2318 || (EQ (arg
, Qright
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f
))
2319 || (NILP (arg
) && FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
2320 || (!NILP (arg
) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
)))
2322 FRAME_VERTICAL_SCROLL_BAR_TYPE (f
) = NILP (arg
) ?
2323 vertical_scroll_bar_none
:
2324 /* Put scroll bars on the right by default, as is conventional
2327 ? vertical_scroll_bar_left
2328 : vertical_scroll_bar_right
;
2330 /* We set this parameter before creating the window for the
2331 frame, so we can get the geometry right from the start.
2332 However, if the window hasn't been created yet, we shouldn't
2333 call x_set_window_size. */
2334 if (FRAME_W32_WINDOW (f
))
2335 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2340 x_set_scroll_bar_width (f
, arg
, oldval
)
2342 Lisp_Object arg
, oldval
;
2346 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = 0;
2347 FRAME_SCROLL_BAR_COLS (f
) = 2;
2349 else if (INTEGERP (arg
) && XINT (arg
) > 0
2350 && XFASTINT (arg
) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f
))
2352 int wid
= FONT_WIDTH (f
->output_data
.w32
->font
);
2353 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = XFASTINT (arg
);
2354 FRAME_SCROLL_BAR_COLS (f
) = (XFASTINT (arg
) + wid
-1) / wid
;
2355 if (FRAME_W32_WINDOW (f
))
2356 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2360 /* Subroutines of creating an frame. */
2362 /* Make sure that Vx_resource_name is set to a reasonable value.
2363 Fix it up, or set it to `emacs' if it is too hopeless. */
2366 validate_x_resource_name ()
2369 /* Number of valid characters in the resource name. */
2371 /* Number of invalid characters in the resource name. */
2376 if (STRINGP (Vx_resource_name
))
2378 unsigned char *p
= XSTRING (Vx_resource_name
)->data
;
2381 len
= XSTRING (Vx_resource_name
)->size
;
2383 /* Only letters, digits, - and _ are valid in resource names.
2384 Count the valid characters and count the invalid ones. */
2385 for (i
= 0; i
< len
; i
++)
2388 if (! ((c
>= 'a' && c
<= 'z')
2389 || (c
>= 'A' && c
<= 'Z')
2390 || (c
>= '0' && c
<= '9')
2391 || c
== '-' || c
== '_'))
2398 /* Not a string => completely invalid. */
2399 bad_count
= 5, good_count
= 0;
2401 /* If name is valid already, return. */
2405 /* If name is entirely invalid, or nearly so, use `emacs'. */
2407 || (good_count
== 1 && bad_count
> 0))
2409 Vx_resource_name
= build_string ("emacs");
2413 /* Name is partly valid. Copy it and replace the invalid characters
2414 with underscores. */
2416 Vx_resource_name
= new = Fcopy_sequence (Vx_resource_name
);
2418 for (i
= 0; i
< len
; i
++)
2420 int c
= XSTRING (new)->data
[i
];
2421 if (! ((c
>= 'a' && c
<= 'z')
2422 || (c
>= 'A' && c
<= 'Z')
2423 || (c
>= '0' && c
<= '9')
2424 || c
== '-' || c
== '_'))
2425 XSTRING (new)->data
[i
] = '_';
2430 extern char *x_get_string_resource ();
2432 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
2433 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
2434 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
2435 class, where INSTANCE is the name under which Emacs was invoked, or\n\
2436 the name specified by the `-name' or `-rn' command-line arguments.\n\
2438 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
2439 class, respectively. You must specify both of them or neither.\n\
2440 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
2441 and the class is `Emacs.CLASS.SUBCLASS'.")
2442 (attribute
, class, component
, subclass
)
2443 Lisp_Object attribute
, class, component
, subclass
;
2445 register char *value
;
2449 CHECK_STRING (attribute
, 0);
2450 CHECK_STRING (class, 0);
2452 if (!NILP (component
))
2453 CHECK_STRING (component
, 1);
2454 if (!NILP (subclass
))
2455 CHECK_STRING (subclass
, 2);
2456 if (NILP (component
) != NILP (subclass
))
2457 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2459 validate_x_resource_name ();
2461 /* Allocate space for the components, the dots which separate them,
2462 and the final '\0'. Make them big enough for the worst case. */
2463 name_key
= (char *) alloca (XSTRING (Vx_resource_name
)->size
2464 + (STRINGP (component
)
2465 ? XSTRING (component
)->size
: 0)
2466 + XSTRING (attribute
)->size
2469 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
2470 + XSTRING (class)->size
2471 + (STRINGP (subclass
)
2472 ? XSTRING (subclass
)->size
: 0)
2475 /* Start with emacs.FRAMENAME for the name (the specific one)
2476 and with `Emacs' for the class key (the general one). */
2477 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2478 strcpy (class_key
, EMACS_CLASS
);
2480 strcat (class_key
, ".");
2481 strcat (class_key
, XSTRING (class)->data
);
2483 if (!NILP (component
))
2485 strcat (class_key
, ".");
2486 strcat (class_key
, XSTRING (subclass
)->data
);
2488 strcat (name_key
, ".");
2489 strcat (name_key
, XSTRING (component
)->data
);
2492 strcat (name_key
, ".");
2493 strcat (name_key
, XSTRING (attribute
)->data
);
2495 value
= x_get_string_resource (Qnil
,
2496 name_key
, class_key
);
2498 if (value
!= (char *) 0)
2499 return build_string (value
);
2504 /* Used when C code wants a resource value. */
2507 x_get_resource_string (attribute
, class)
2508 char *attribute
, *class;
2510 register char *value
;
2514 /* Allocate space for the components, the dots which separate them,
2515 and the final '\0'. */
2516 name_key
= (char *) alloca (XSTRING (Vinvocation_name
)->size
2517 + strlen (attribute
) + 2);
2518 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
2519 + strlen (class) + 2);
2521 sprintf (name_key
, "%s.%s",
2522 XSTRING (Vinvocation_name
)->data
,
2524 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
2526 return x_get_string_resource (selected_frame
,
2527 name_key
, class_key
);
2530 /* Types we might convert a resource string into. */
2533 number
, boolean
, string
, symbol
2536 /* Return the value of parameter PARAM.
2538 First search ALIST, then Vdefault_frame_alist, then the X defaults
2539 database, using ATTRIBUTE as the attribute name and CLASS as its class.
2541 Convert the resource to the type specified by desired_type.
2543 If no default is specified, return Qunbound. If you call
2544 x_get_arg, make sure you deal with Qunbound in a reasonable way,
2545 and don't let it get stored in any Lisp-visible variables! */
2548 x_get_arg (alist
, param
, attribute
, class, type
)
2549 Lisp_Object alist
, param
;
2552 enum resource_types type
;
2554 register Lisp_Object tem
;
2556 tem
= Fassq (param
, alist
);
2558 tem
= Fassq (param
, Vdefault_frame_alist
);
2564 tem
= Fx_get_resource (build_string (attribute
),
2565 build_string (class),
2574 return make_number (atoi (XSTRING (tem
)->data
));
2577 tem
= Fdowncase (tem
);
2578 if (!strcmp (XSTRING (tem
)->data
, "on")
2579 || !strcmp (XSTRING (tem
)->data
, "true"))
2588 /* As a special case, we map the values `true' and `on'
2589 to Qt, and `false' and `off' to Qnil. */
2592 lower
= Fdowncase (tem
);
2593 if (!strcmp (XSTRING (lower
)->data
, "on")
2594 || !strcmp (XSTRING (lower
)->data
, "true"))
2596 else if (!strcmp (XSTRING (lower
)->data
, "off")
2597 || !strcmp (XSTRING (lower
)->data
, "false"))
2600 return Fintern (tem
, Qnil
);
2613 /* Record in frame F the specified or default value according to ALIST
2614 of the parameter named PARAM (a Lisp symbol).
2615 If no value is specified for PARAM, look for an X default for XPROP
2616 on the frame named NAME.
2617 If that is not found either, use the value DEFLT. */
2620 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
2627 enum resource_types type
;
2631 tem
= x_get_arg (alist
, prop
, xprop
, xclass
, type
);
2632 if (EQ (tem
, Qunbound
))
2634 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2638 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
2639 "Parse an X-style geometry string STRING.\n\
2640 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
2641 The properties returned may include `top', `left', `height', and `width'.\n\
2642 The value of `left' or `top' may be an integer,\n\
2643 or a list (+ N) meaning N pixels relative to top/left corner,\n\
2644 or a list (- N) meaning -N pixels relative to bottom/right corner.")
2649 unsigned int width
, height
;
2652 CHECK_STRING (string
, 0);
2654 geometry
= XParseGeometry ((char *) XSTRING (string
)->data
,
2655 &x
, &y
, &width
, &height
);
2658 if (geometry
& XValue
)
2660 Lisp_Object element
;
2662 if (x
>= 0 && (geometry
& XNegative
))
2663 element
= Fcons (Qleft
, Fcons (Qminus
, Fcons (make_number (-x
), Qnil
)));
2664 else if (x
< 0 && ! (geometry
& XNegative
))
2665 element
= Fcons (Qleft
, Fcons (Qplus
, Fcons (make_number (x
), Qnil
)));
2667 element
= Fcons (Qleft
, make_number (x
));
2668 result
= Fcons (element
, result
);
2671 if (geometry
& YValue
)
2673 Lisp_Object element
;
2675 if (y
>= 0 && (geometry
& YNegative
))
2676 element
= Fcons (Qtop
, Fcons (Qminus
, Fcons (make_number (-y
), Qnil
)));
2677 else if (y
< 0 && ! (geometry
& YNegative
))
2678 element
= Fcons (Qtop
, Fcons (Qplus
, Fcons (make_number (y
), Qnil
)));
2680 element
= Fcons (Qtop
, make_number (y
));
2681 result
= Fcons (element
, result
);
2684 if (geometry
& WidthValue
)
2685 result
= Fcons (Fcons (Qwidth
, make_number (width
)), result
);
2686 if (geometry
& HeightValue
)
2687 result
= Fcons (Fcons (Qheight
, make_number (height
)), result
);
2692 /* Calculate the desired size and position of this window,
2693 and return the flags saying which aspects were specified.
2695 This function does not make the coordinates positive. */
2697 #define DEFAULT_ROWS 40
2698 #define DEFAULT_COLS 80
2701 x_figure_window_size (f
, parms
)
2705 register Lisp_Object tem0
, tem1
, tem2
;
2706 int height
, width
, left
, top
;
2707 register int geometry
;
2708 long window_prompting
= 0;
2710 /* Default values if we fall through.
2711 Actually, if that happens we should get
2712 window manager prompting. */
2713 SET_FRAME_WIDTH (f
, DEFAULT_COLS
);
2714 f
->height
= DEFAULT_ROWS
;
2715 /* Window managers expect that if program-specified
2716 positions are not (0,0), they're intentional, not defaults. */
2717 f
->output_data
.w32
->top_pos
= 0;
2718 f
->output_data
.w32
->left_pos
= 0;
2720 tem0
= x_get_arg (parms
, Qheight
, 0, 0, number
);
2721 tem1
= x_get_arg (parms
, Qwidth
, 0, 0, number
);
2722 tem2
= x_get_arg (parms
, Quser_size
, 0, 0, number
);
2723 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
2725 if (!EQ (tem0
, Qunbound
))
2727 CHECK_NUMBER (tem0
, 0);
2728 f
->height
= XINT (tem0
);
2730 if (!EQ (tem1
, Qunbound
))
2732 CHECK_NUMBER (tem1
, 0);
2733 SET_FRAME_WIDTH (f
, XINT (tem1
));
2735 if (!NILP (tem2
) && !EQ (tem2
, Qunbound
))
2736 window_prompting
|= USSize
;
2738 window_prompting
|= PSize
;
2741 f
->output_data
.w32
->vertical_scroll_bar_extra
2742 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
2744 : FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) > 0
2745 ? FRAME_SCROLL_BAR_PIXEL_WIDTH (f
)
2746 : (FRAME_SCROLL_BAR_COLS (f
) * FONT_WIDTH (f
->output_data
.w32
->font
)));
2747 f
->output_data
.w32
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
2748 f
->output_data
.w32
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
2750 tem0
= x_get_arg (parms
, Qtop
, 0, 0, number
);
2751 tem1
= x_get_arg (parms
, Qleft
, 0, 0, number
);
2752 tem2
= x_get_arg (parms
, Quser_position
, 0, 0, number
);
2753 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
2755 if (EQ (tem0
, Qminus
))
2757 f
->output_data
.w32
->top_pos
= 0;
2758 window_prompting
|= YNegative
;
2760 else if (CONSP (tem0
) && EQ (XCONS (tem0
)->car
, Qminus
)
2761 && CONSP (XCONS (tem0
)->cdr
)
2762 && INTEGERP (XCONS (XCONS (tem0
)->cdr
)->car
))
2764 f
->output_data
.w32
->top_pos
= - XINT (XCONS (XCONS (tem0
)->cdr
)->car
);
2765 window_prompting
|= YNegative
;
2767 else if (CONSP (tem0
) && EQ (XCONS (tem0
)->car
, Qplus
)
2768 && CONSP (XCONS (tem0
)->cdr
)
2769 && INTEGERP (XCONS (XCONS (tem0
)->cdr
)->car
))
2771 f
->output_data
.w32
->top_pos
= XINT (XCONS (XCONS (tem0
)->cdr
)->car
);
2773 else if (EQ (tem0
, Qunbound
))
2774 f
->output_data
.w32
->top_pos
= 0;
2777 CHECK_NUMBER (tem0
, 0);
2778 f
->output_data
.w32
->top_pos
= XINT (tem0
);
2779 if (f
->output_data
.w32
->top_pos
< 0)
2780 window_prompting
|= YNegative
;
2783 if (EQ (tem1
, Qminus
))
2785 f
->output_data
.w32
->left_pos
= 0;
2786 window_prompting
|= XNegative
;
2788 else if (CONSP (tem1
) && EQ (XCONS (tem1
)->car
, Qminus
)
2789 && CONSP (XCONS (tem1
)->cdr
)
2790 && INTEGERP (XCONS (XCONS (tem1
)->cdr
)->car
))
2792 f
->output_data
.w32
->left_pos
= - XINT (XCONS (XCONS (tem1
)->cdr
)->car
);
2793 window_prompting
|= XNegative
;
2795 else if (CONSP (tem1
) && EQ (XCONS (tem1
)->car
, Qplus
)
2796 && CONSP (XCONS (tem1
)->cdr
)
2797 && INTEGERP (XCONS (XCONS (tem1
)->cdr
)->car
))
2799 f
->output_data
.w32
->left_pos
= XINT (XCONS (XCONS (tem1
)->cdr
)->car
);
2801 else if (EQ (tem1
, Qunbound
))
2802 f
->output_data
.w32
->left_pos
= 0;
2805 CHECK_NUMBER (tem1
, 0);
2806 f
->output_data
.w32
->left_pos
= XINT (tem1
);
2807 if (f
->output_data
.w32
->left_pos
< 0)
2808 window_prompting
|= XNegative
;
2811 if (!NILP (tem2
) && ! EQ (tem2
, Qunbound
))
2812 window_prompting
|= USPosition
;
2814 window_prompting
|= PPosition
;
2817 return window_prompting
;
2822 extern LRESULT CALLBACK
w32_wnd_proc ();
2825 w32_init_class (hinst
)
2830 wc
.style
= CS_HREDRAW
| CS_VREDRAW
;
2831 wc
.lpfnWndProc
= (WNDPROC
) w32_wnd_proc
;
2833 wc
.cbWndExtra
= WND_EXTRA_BYTES
;
2834 wc
.hInstance
= hinst
;
2835 wc
.hIcon
= LoadIcon (hinst
, EMACS_CLASS
);
2836 wc
.hCursor
= LoadCursor (NULL
, IDC_ARROW
);
2837 wc
.hbrBackground
= NULL
; // GetStockObject (WHITE_BRUSH);
2838 wc
.lpszMenuName
= NULL
;
2839 wc
.lpszClassName
= EMACS_CLASS
;
2841 return (RegisterClass (&wc
));
2845 w32_createscrollbar (f
, bar
)
2847 struct scroll_bar
* bar
;
2849 return (CreateWindow ("SCROLLBAR", "", SBS_VERT
| WS_CHILD
| WS_VISIBLE
,
2850 /* Position and size of scroll bar. */
2851 XINT(bar
->left
), XINT(bar
->top
),
2852 XINT(bar
->width
), XINT(bar
->height
),
2853 FRAME_W32_WINDOW (f
),
2860 w32_createwindow (f
)
2866 rect
.left
= rect
.top
= 0;
2867 rect
.right
= PIXEL_WIDTH (f
);
2868 rect
.bottom
= PIXEL_HEIGHT (f
);
2870 AdjustWindowRect (&rect
, f
->output_data
.w32
->dwStyle
,
2871 FRAME_EXTERNAL_MENU_BAR (f
));
2873 /* Do first time app init */
2877 w32_init_class (hinst
);
2880 FRAME_W32_WINDOW (f
) = hwnd
2881 = CreateWindow (EMACS_CLASS
,
2883 f
->output_data
.w32
->dwStyle
| WS_CLIPCHILDREN
,
2884 f
->output_data
.w32
->left_pos
,
2885 f
->output_data
.w32
->top_pos
,
2886 rect
.right
- rect
.left
,
2887 rect
.bottom
- rect
.top
,
2895 SetWindowLong (hwnd
, WND_FONTWIDTH_INDEX
, FONT_WIDTH (f
->output_data
.w32
->font
));
2896 SetWindowLong (hwnd
, WND_LINEHEIGHT_INDEX
, f
->output_data
.w32
->line_height
);
2897 SetWindowLong (hwnd
, WND_BORDER_INDEX
, f
->output_data
.w32
->internal_border_width
);
2898 SetWindowLong (hwnd
, WND_SCROLLBAR_INDEX
, f
->output_data
.w32
->vertical_scroll_bar_extra
);
2899 SetWindowLong (hwnd
, WND_BACKGROUND_INDEX
, f
->output_data
.w32
->background_pixel
);
2901 /* Enable drag-n-drop. */
2902 DragAcceptFiles (hwnd
, TRUE
);
2904 /* Do this to discard the default setting specified by our parent. */
2905 ShowWindow (hwnd
, SW_HIDE
);
2909 /* Convert between the modifier bits W32 uses and the modifier bits
2912 w32_get_modifiers ()
2914 return (((GetKeyState (VK_SHIFT
)&0x8000) ? shift_modifier
: 0) |
2915 ((GetKeyState (VK_CONTROL
)&0x8000) ? ctrl_modifier
: 0) |
2916 ((GetKeyState (VK_MENU
)&0x8000) ?
2917 ((NILP (Vw32_alt_is_meta
)) ? alt_modifier
: meta_modifier
) : 0));
2921 my_post_msg (wmsg
, hwnd
, msg
, wParam
, lParam
)
2928 wmsg
->msg
.hwnd
= hwnd
;
2929 wmsg
->msg
.message
= msg
;
2930 wmsg
->msg
.wParam
= wParam
;
2931 wmsg
->msg
.lParam
= lParam
;
2932 wmsg
->msg
.time
= GetMessageTime ();
2937 /* GetKeyState and MapVirtualKey on Windows 95 do not actually distinguish
2938 between left and right keys as advertised. We test for this
2939 support dynamically, and set a flag when the support is absent. If
2940 absent, we keep track of the left and right control and alt keys
2941 ourselves. This is particularly necessary on keyboards that rely
2942 upon the AltGr key, which is represented as having the left control
2943 and right alt keys pressed. For these keyboards, we need to know
2944 when the left alt key has been pressed in addition to the AltGr key
2945 so that we can properly support M-AltGr-key sequences (such as M-@
2946 on Swedish keyboards). */
2948 #define EMACS_LCONTROL 0
2949 #define EMACS_RCONTROL 1
2950 #define EMACS_LMENU 2
2951 #define EMACS_RMENU 3
2953 static int modifiers
[4];
2954 static int modifiers_recorded
;
2955 static int modifier_key_support_tested
;
2958 test_modifier_support (unsigned int wparam
)
2962 if (wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
)
2964 if (wparam
== VK_CONTROL
)
2974 if (!(GetKeyState (l
) & 0x8000) && !(GetKeyState (r
) & 0x8000))
2975 modifiers_recorded
= 1;
2977 modifiers_recorded
= 0;
2978 modifier_key_support_tested
= 1;
2982 record_keydown (unsigned int wparam
, unsigned int lparam
)
2986 if (!modifier_key_support_tested
)
2987 test_modifier_support (wparam
);
2989 if ((wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
) || !modifiers_recorded
)
2992 if (wparam
== VK_CONTROL
)
2993 i
= (lparam
& 0x1000000) ? EMACS_RCONTROL
: EMACS_LCONTROL
;
2995 i
= (lparam
& 0x1000000) ? EMACS_RMENU
: EMACS_LMENU
;
3001 record_keyup (unsigned int wparam
, unsigned int lparam
)
3005 if ((wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
) || !modifiers_recorded
)
3008 if (wparam
== VK_CONTROL
)
3009 i
= (lparam
& 0x1000000) ? EMACS_RCONTROL
: EMACS_LCONTROL
;
3011 i
= (lparam
& 0x1000000) ? EMACS_RMENU
: EMACS_LMENU
;
3016 /* Emacs can lose focus while a modifier key has been pressed. When
3017 it regains focus, be conservative and clear all modifiers since
3018 we cannot reconstruct the left and right modifier state. */
3024 if (!modifiers_recorded
)
3027 ctrl
= GetAsyncKeyState (VK_CONTROL
);
3028 alt
= GetAsyncKeyState (VK_MENU
);
3030 if (ctrl
== 0 || alt
== 0)
3031 /* Emacs doesn't have keyboard focus. Do nothing. */
3034 if (!(ctrl
& 0x08000))
3035 /* Clear any recorded control modifier state. */
3036 modifiers
[EMACS_RCONTROL
] = modifiers
[EMACS_LCONTROL
] = 0;
3038 if (!(alt
& 0x08000))
3039 /* Clear any recorded alt modifier state. */
3040 modifiers
[EMACS_RMENU
] = modifiers
[EMACS_LMENU
] = 0;
3042 /* Otherwise, leave the modifier state as it was when Emacs lost
3046 /* Synchronize modifier state with what is reported with the current
3047 keystroke. Even if we cannot distinguish between left and right
3048 modifier keys, we know that, if no modifiers are set, then neither
3049 the left or right modifier should be set. */
3053 if (!modifiers_recorded
)
3056 if (!(GetKeyState (VK_CONTROL
) & 0x8000))
3057 modifiers
[EMACS_RCONTROL
] = modifiers
[EMACS_LCONTROL
] = 0;
3059 if (!(GetKeyState (VK_MENU
) & 0x8000))
3060 modifiers
[EMACS_RMENU
] = modifiers
[EMACS_LMENU
] = 0;
3064 modifier_set (int vkey
)
3066 if (vkey
== VK_CAPITAL
)
3067 return (GetKeyState (vkey
) & 0x1);
3068 if (!modifiers_recorded
)
3069 return (GetKeyState (vkey
) & 0x8000);
3074 return modifiers
[EMACS_LCONTROL
];
3076 return modifiers
[EMACS_RCONTROL
];
3078 return modifiers
[EMACS_LMENU
];
3080 return modifiers
[EMACS_RMENU
];
3084 return (GetKeyState (vkey
) & 0x8000);
3087 /* We map the VK_* modifiers into console modifier constants
3088 so that we can use the same routines to handle both console
3089 and window input. */
3092 construct_modifiers (unsigned int wparam
, unsigned int lparam
)
3096 if (wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
)
3097 mods
= GetLastError ();
3100 mods
|= (modifier_set (VK_SHIFT
)) ? SHIFT_PRESSED
: 0;
3101 mods
|= (modifier_set (VK_CAPITAL
)) ? CAPSLOCK_ON
: 0;
3102 mods
|= (modifier_set (VK_LCONTROL
)) ? LEFT_CTRL_PRESSED
: 0;
3103 mods
|= (modifier_set (VK_RCONTROL
)) ? RIGHT_CTRL_PRESSED
: 0;
3104 mods
|= (modifier_set (VK_LMENU
)) ? LEFT_ALT_PRESSED
: 0;
3105 mods
|= (modifier_set (VK_RMENU
)) ? RIGHT_ALT_PRESSED
: 0;
3111 map_keypad_keys (unsigned int wparam
, unsigned int lparam
)
3113 unsigned int extended
= (lparam
& 0x1000000L
);
3115 if (wparam
< VK_CLEAR
|| wparam
> VK_DELETE
)
3118 if (wparam
== VK_RETURN
)
3119 return (extended
? VK_NUMPAD_ENTER
: VK_RETURN
);
3121 if (wparam
>= VK_PRIOR
&& wparam
<= VK_DOWN
)
3122 return (!extended
? (VK_NUMPAD_PRIOR
+ (wparam
- VK_PRIOR
)) : wparam
);
3124 if (wparam
== VK_INSERT
|| wparam
== VK_DELETE
)
3125 return (!extended
? (VK_NUMPAD_INSERT
+ (wparam
- VK_INSERT
)) : wparam
);
3127 if (wparam
== VK_CLEAR
)
3128 return (!extended
? VK_NUMPAD_CLEAR
: wparam
);
3133 /* Main message dispatch loop. */
3136 w32_msg_pump (deferred_msg
* msg_buf
)
3140 msh_mousewheel
= RegisterWindowMessage (MSH_MOUSEWHEEL
);
3142 while (GetMessage (&msg
, NULL
, 0, 0))
3144 if (msg
.hwnd
== NULL
)
3146 switch (msg
.message
)
3148 case WM_EMACS_CREATEWINDOW
:
3149 w32_createwindow ((struct frame
*) msg
.wParam
);
3150 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
, 0, 0))
3153 case WM_EMACS_SETLOCALE
:
3154 SetThreadLocale (msg
.wParam
);
3155 /* Reply is not expected. */
3158 /* No need to be so draconian! */
3160 DebPrint (("msg %x not expected by w32_msg_pump\n", msg
.message
));
3165 DispatchMessage (&msg
);
3168 /* Exit nested loop when our deferred message has completed. */
3169 if (msg_buf
->completed
)
3174 deferred_msg
* deferred_msg_head
;
3176 static deferred_msg
*
3177 find_deferred_msg (HWND hwnd
, UINT msg
)
3179 deferred_msg
* item
;
3181 /* Don't actually need synchronization for read access, since
3182 modification of single pointer is always atomic. */
3183 /* enter_crit (); */
3185 for (item
= deferred_msg_head
; item
!= NULL
; item
= item
->next
)
3186 if (item
->w32msg
.msg
.hwnd
== hwnd
3187 && item
->w32msg
.msg
.message
== msg
)
3190 /* leave_crit (); */
3196 send_deferred_msg (deferred_msg
* msg_buf
,
3202 /* Only input thread can send deferred messages. */
3203 if (GetCurrentThreadId () != dwWindowsThreadId
)
3206 /* It is an error to send a message that is already deferred. */
3207 if (find_deferred_msg (hwnd
, msg
) != NULL
)
3210 /* Enforced synchronization is not needed because this is the only
3211 function that alters deferred_msg_head, and the following critical
3212 section is guaranteed to only be serially reentered (since only the
3213 input thread can call us). */
3215 /* enter_crit (); */
3217 msg_buf
->completed
= 0;
3218 msg_buf
->next
= deferred_msg_head
;
3219 deferred_msg_head
= msg_buf
;
3220 my_post_msg (&msg_buf
->w32msg
, hwnd
, msg
, wParam
, lParam
);
3222 /* leave_crit (); */
3224 /* Start a new nested message loop to process other messages until
3225 this one is completed. */
3226 w32_msg_pump (msg_buf
);
3228 deferred_msg_head
= msg_buf
->next
;
3230 return msg_buf
->result
;
3234 complete_deferred_msg (HWND hwnd
, UINT msg
, LRESULT result
)
3236 deferred_msg
* msg_buf
= find_deferred_msg (hwnd
, msg
);
3238 if (msg_buf
== NULL
)
3241 msg_buf
->result
= result
;
3242 msg_buf
->completed
= 1;
3244 /* Ensure input thread is woken so it notices the completion. */
3245 PostThreadMessage (dwWindowsThreadId
, WM_NULL
, 0, 0);
3254 deferred_msg dummy_buf
;
3256 /* Ensure our message queue is created */
3258 PeekMessage (&msg
, NULL
, 0, 0, PM_NOREMOVE
);
3260 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
, 0, 0))
3263 memset (&dummy_buf
, 0, sizeof (dummy_buf
));
3264 dummy_buf
.w32msg
.msg
.hwnd
= NULL
;
3265 dummy_buf
.w32msg
.msg
.message
= WM_NULL
;
3267 /* This is the inital message loop which should only exit when the
3268 application quits. */
3269 w32_msg_pump (&dummy_buf
);
3274 /* Main window procedure */
3276 extern char *lispy_function_keys
[];
3279 w32_wnd_proc (hwnd
, msg
, wParam
, lParam
)
3286 struct w32_display_info
*dpyinfo
= &one_w32_display_info
;
3288 int windows_translate
;
3290 /* Note that it is okay to call x_window_to_frame, even though we are
3291 not running in the main lisp thread, because frame deletion
3292 requires the lisp thread to synchronize with this thread. Thus, if
3293 a frame struct is returned, it can be used without concern that the
3294 lisp thread might make it disappear while we are using it.
3296 NB. Walking the frame list in this thread is safe (as long as
3297 writes of Lisp_Object slots are atomic, which they are on Windows).
3298 Although delete-frame can destructively modify the frame list while
3299 we are walking it, a garbage collection cannot occur until after
3300 delete-frame has synchronized with this thread.
3302 It is also safe to use functions that make GDI calls, such as
3303 w32_clear_rect, because these functions must obtain a DC handle
3304 from the frame struct using get_frame_dc which is thread-aware. */
3309 f
= x_window_to_frame (dpyinfo
, hwnd
);
3312 GetUpdateRect (hwnd
, &wmsg
.rect
, FALSE
);
3313 w32_clear_rect (f
, NULL
, &wmsg
.rect
);
3316 case WM_PALETTECHANGED
:
3317 /* ignore our own changes */
3318 if ((HWND
)wParam
!= hwnd
)
3320 f
= x_window_to_frame (dpyinfo
, hwnd
);
3322 /* get_frame_dc will realize our palette and force all
3323 frames to be redrawn if needed. */
3324 release_frame_dc (f
, get_frame_dc (f
));
3329 PAINTSTRUCT paintStruct
;
3332 BeginPaint (hwnd
, &paintStruct
);
3333 wmsg
.rect
= paintStruct
.rcPaint
;
3334 EndPaint (hwnd
, &paintStruct
);
3337 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3344 record_keyup (wParam
, lParam
);
3349 /* Synchronize modifiers with current keystroke. */
3352 record_keydown (wParam
, lParam
);
3354 wParam
= map_keypad_keys (wParam
, lParam
);
3356 windows_translate
= 0;
3361 /* More support for these keys will likely be necessary. */
3362 if (!NILP (Vw32_pass_optional_keys_to_system
))
3363 windows_translate
= 1;
3366 if (NILP (Vw32_pass_alt_to_system
))
3368 windows_translate
= 1;
3375 windows_translate
= 1;
3378 /* If not defined as a function key, change it to a WM_CHAR message. */
3379 if (lispy_function_keys
[wParam
] == 0)
3384 if (windows_translate
)
3386 MSG windows_msg
= { hwnd
, msg
, wParam
, lParam
, 0, {0,0} };
3388 windows_msg
.time
= GetMessageTime ();
3389 TranslateMessage (&windows_msg
);
3397 wmsg
.dwModifiers
= construct_modifiers (wParam
, lParam
);
3400 /* Detect quit_char and set quit-flag directly. Note that we
3401 still need to post a message to ensure the main thread will be
3402 woken up if blocked in sys_select(), but we do NOT want to post
3403 the quit_char message itself (because it will usually be as if
3404 the user had typed quit_char twice). Instead, we post a dummy
3405 message that has no particular effect. */
3408 if (isalpha (c
) && (wmsg
.dwModifiers
== LEFT_CTRL_PRESSED
3409 || wmsg
.dwModifiers
== RIGHT_CTRL_PRESSED
))
3410 c
= make_ctrl_char (c
) & 0377;
3415 /* The choice of message is somewhat arbitrary, as long as
3416 the main thread handler just ignores it. */
3419 /* Interrupt any blocking system calls. */
3425 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3429 /* Simulate middle mouse button events when left and right buttons
3430 are used together, but only if user has two button mouse. */
3431 case WM_LBUTTONDOWN
:
3432 case WM_RBUTTONDOWN
:
3433 if (XINT (Vw32_num_mouse_buttons
) == 3)
3434 goto handle_plain_button
;
3437 int this = (msg
== WM_LBUTTONDOWN
) ? LMOUSE
: RMOUSE
;
3438 int other
= (msg
== WM_LBUTTONDOWN
) ? RMOUSE
: LMOUSE
;
3440 if (button_state
& this)
3443 if (button_state
== 0)
3446 button_state
|= this;
3448 if (button_state
& other
)
3450 if (mouse_button_timer
)
3452 KillTimer (hwnd
, mouse_button_timer
);
3453 mouse_button_timer
= 0;
3455 /* Generate middle mouse event instead. */
3456 msg
= WM_MBUTTONDOWN
;
3457 button_state
|= MMOUSE
;
3459 else if (button_state
& MMOUSE
)
3461 /* Ignore button event if we've already generated a
3462 middle mouse down event. This happens if the
3463 user releases and press one of the two buttons
3464 after we've faked a middle mouse event. */
3469 /* Flush out saved message. */
3470 post_msg (&saved_mouse_button_msg
);
3472 wmsg
.dwModifiers
= w32_get_modifiers ();
3473 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3475 /* Clear message buffer. */
3476 saved_mouse_button_msg
.msg
.hwnd
= 0;
3480 /* Hold onto message for now. */
3481 mouse_button_timer
=
3482 SetTimer (hwnd
, MOUSE_BUTTON_ID
, XINT (Vw32_mouse_button_tolerance
), NULL
);
3483 saved_mouse_button_msg
.msg
.hwnd
= hwnd
;
3484 saved_mouse_button_msg
.msg
.message
= msg
;
3485 saved_mouse_button_msg
.msg
.wParam
= wParam
;
3486 saved_mouse_button_msg
.msg
.lParam
= lParam
;
3487 saved_mouse_button_msg
.msg
.time
= GetMessageTime ();
3488 saved_mouse_button_msg
.dwModifiers
= w32_get_modifiers ();
3495 if (XINT (Vw32_num_mouse_buttons
) == 3)
3496 goto handle_plain_button
;
3499 int this = (msg
== WM_LBUTTONUP
) ? LMOUSE
: RMOUSE
;
3500 int other
= (msg
== WM_LBUTTONUP
) ? RMOUSE
: LMOUSE
;
3502 if ((button_state
& this) == 0)
3505 button_state
&= ~this;
3507 if (button_state
& MMOUSE
)
3509 /* Only generate event when second button is released. */
3510 if ((button_state
& other
) == 0)
3513 button_state
&= ~MMOUSE
;
3515 if (button_state
) abort ();
3522 /* Flush out saved message if necessary. */
3523 if (saved_mouse_button_msg
.msg
.hwnd
)
3525 post_msg (&saved_mouse_button_msg
);
3528 wmsg
.dwModifiers
= w32_get_modifiers ();
3529 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3531 /* Always clear message buffer and cancel timer. */
3532 saved_mouse_button_msg
.msg
.hwnd
= 0;
3533 KillTimer (hwnd
, mouse_button_timer
);
3534 mouse_button_timer
= 0;
3536 if (button_state
== 0)
3541 case WM_MBUTTONDOWN
:
3543 handle_plain_button
:
3548 if (parse_button (msg
, &button
, &up
))
3550 if (up
) ReleaseCapture ();
3551 else SetCapture (hwnd
);
3552 button
= (button
== 0) ? LMOUSE
:
3553 ((button
== 1) ? MMOUSE
: RMOUSE
);
3555 button_state
&= ~button
;
3557 button_state
|= button
;
3561 wmsg
.dwModifiers
= w32_get_modifiers ();
3562 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3567 if (XINT (Vw32_mouse_move_interval
) <= 0
3568 || (msg
== WM_MOUSEMOVE
&& button_state
== 0))
3570 wmsg
.dwModifiers
= w32_get_modifiers ();
3571 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3575 /* Hang onto mouse move and scroll messages for a bit, to avoid
3576 sending such events to Emacs faster than it can process them.
3577 If we get more events before the timer from the first message
3578 expires, we just replace the first message. */
3580 if (saved_mouse_move_msg
.msg
.hwnd
== 0)
3582 SetTimer (hwnd
, MOUSE_MOVE_ID
, XINT (Vw32_mouse_move_interval
), NULL
);
3584 /* Hold onto message for now. */
3585 saved_mouse_move_msg
.msg
.hwnd
= hwnd
;
3586 saved_mouse_move_msg
.msg
.message
= msg
;
3587 saved_mouse_move_msg
.msg
.wParam
= wParam
;
3588 saved_mouse_move_msg
.msg
.lParam
= lParam
;
3589 saved_mouse_move_msg
.msg
.time
= GetMessageTime ();
3590 saved_mouse_move_msg
.dwModifiers
= w32_get_modifiers ();
3595 wmsg
.dwModifiers
= w32_get_modifiers ();
3596 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3600 wmsg
.dwModifiers
= w32_get_modifiers ();
3601 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3605 /* Flush out saved messages if necessary. */
3606 if (wParam
== mouse_button_timer
)
3608 if (saved_mouse_button_msg
.msg
.hwnd
)
3610 post_msg (&saved_mouse_button_msg
);
3611 saved_mouse_button_msg
.msg
.hwnd
= 0;
3613 KillTimer (hwnd
, mouse_button_timer
);
3614 mouse_button_timer
= 0;
3616 else if (wParam
== mouse_move_timer
)
3618 if (saved_mouse_move_msg
.msg
.hwnd
)
3620 post_msg (&saved_mouse_move_msg
);
3621 saved_mouse_move_msg
.msg
.hwnd
= 0;
3623 KillTimer (hwnd
, mouse_move_timer
);
3624 mouse_move_timer
= 0;
3629 /* Windows doesn't send us focus messages when putting up and
3630 taking down a system popup dialog as for Ctrl-Alt-Del on Windows 95.
3631 The only indication we get that something happened is receiving
3632 this message afterwards. So this is a good time to reset our
3633 keyboard modifiers' state. */
3638 /* We must ensure menu bar is fully constructed and up to date
3639 before allowing user interaction with it. To achieve this
3640 we send this message to the lisp thread and wait for a
3641 reply (whose value is not actually needed) to indicate that
3642 the menu bar is now ready for use, so we can now return.
3644 To remain responsive in the meantime, we enter a nested message
3645 loop that can process all other messages.
3647 However, we skip all this if the message results from calling
3648 TrackPopupMenu - in fact, we must NOT attempt to send the lisp
3649 thread a message because it is blocked on us at this point. We
3650 set menubar_active before calling TrackPopupMenu to indicate
3651 this (there is no possibility of confusion with real menubar
3654 f
= x_window_to_frame (dpyinfo
, hwnd
);
3656 && (f
->output_data
.w32
->menubar_active
3657 /* We can receive this message even in the absence of a
3658 menubar (ie. when the system menu is activated) - in this
3659 case we do NOT want to forward the message, otherwise it
3660 will cause the menubar to suddenly appear when the user
3661 had requested it to be turned off! */
3662 || f
->output_data
.w32
->menubar_widget
== NULL
))
3666 deferred_msg msg_buf
;
3668 /* Detect if message has already been deferred; in this case
3669 we cannot return any sensible value to ignore this. */
3670 if (find_deferred_msg (hwnd
, msg
) != NULL
)
3673 return send_deferred_msg (&msg_buf
, hwnd
, msg
, wParam
, lParam
);
3676 case WM_EXITMENULOOP
:
3677 f
= x_window_to_frame (dpyinfo
, hwnd
);
3679 /* Indicate that menubar can be modified again. */
3681 f
->output_data
.w32
->menubar_active
= 0;
3684 case WM_MEASUREITEM
:
3685 f
= x_window_to_frame (dpyinfo
, hwnd
);
3688 MEASUREITEMSTRUCT
* pMis
= (MEASUREITEMSTRUCT
*) lParam
;
3690 if (pMis
->CtlType
== ODT_MENU
)
3692 /* Work out dimensions for popup menu titles. */
3693 char * title
= (char *) pMis
->itemData
;
3694 HDC hdc
= GetDC (hwnd
);
3695 HFONT menu_font
= GetCurrentObject (hdc
, OBJ_FONT
);
3696 LOGFONT menu_logfont
;
3700 GetObject (menu_font
, sizeof (menu_logfont
), &menu_logfont
);
3701 menu_logfont
.lfWeight
= FW_BOLD
;
3702 menu_font
= CreateFontIndirect (&menu_logfont
);
3703 old_font
= SelectObject (hdc
, menu_font
);
3705 GetTextExtentPoint32 (hdc
, title
, strlen (title
), &size
);
3706 pMis
->itemWidth
= size
.cx
;
3707 pMis
->itemHeight
= GetSystemMetrics (SM_CYMENUSIZE
);
3708 if (pMis
->itemHeight
< size
.cy
)
3709 pMis
->itemHeight
= size
.cy
;
3711 SelectObject (hdc
, old_font
);
3712 DeleteObject (menu_font
);
3713 ReleaseDC (hwnd
, hdc
);
3720 f
= x_window_to_frame (dpyinfo
, hwnd
);
3723 DRAWITEMSTRUCT
* pDis
= (DRAWITEMSTRUCT
*) lParam
;
3725 if (pDis
->CtlType
== ODT_MENU
)
3727 /* Draw popup menu title. */
3728 char * title
= (char *) pDis
->itemData
;
3729 HDC hdc
= pDis
->hDC
;
3730 HFONT menu_font
= GetCurrentObject (hdc
, OBJ_FONT
);
3731 LOGFONT menu_logfont
;
3734 GetObject (menu_font
, sizeof (menu_logfont
), &menu_logfont
);
3735 menu_logfont
.lfWeight
= FW_BOLD
;
3736 menu_font
= CreateFontIndirect (&menu_logfont
);
3737 old_font
= SelectObject (hdc
, menu_font
);
3739 /* Always draw title as if not selected. */
3741 pDis
->rcItem
.left
+ GetSystemMetrics (SM_CXMENUCHECK
),
3743 ETO_OPAQUE
, &pDis
->rcItem
,
3744 title
, strlen (title
), NULL
);
3746 SelectObject (hdc
, old_font
);
3747 DeleteObject (menu_font
);
3754 /* Still not right - can't distinguish between clicks in the
3755 client area of the frame from clicks forwarded from the scroll
3756 bars - may have to hook WM_NCHITTEST to remember the mouse
3757 position and then check if it is in the client area ourselves. */
3758 case WM_MOUSEACTIVATE
:
3759 /* Discard the mouse click that activates a frame, allowing the
3760 user to click anywhere without changing point (or worse!).
3761 Don't eat mouse clicks on scrollbars though!! */
3762 if (LOWORD (lParam
) == HTCLIENT
)
3763 return MA_ACTIVATEANDEAT
;
3768 case WM_ACTIVATEAPP
:
3769 case WM_WINDOWPOSCHANGED
:
3771 /* Inform lisp thread that a frame might have just been obscured
3772 or exposed, so should recheck visibility of all frames. */
3773 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3782 wmsg
.dwModifiers
= w32_get_modifiers ();
3783 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3787 wmsg
.dwModifiers
= w32_get_modifiers ();
3788 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3791 case WM_WINDOWPOSCHANGING
:
3794 LPWINDOWPOS lppos
= (WINDOWPOS
*) lParam
;
3796 wp
.length
= sizeof (WINDOWPLACEMENT
);
3797 GetWindowPlacement (hwnd
, &wp
);
3799 if (wp
.showCmd
!= SW_SHOWMINIMIZED
&& (lppos
->flags
& SWP_NOSIZE
) == 0)
3806 DWORD internal_border
;
3807 DWORD scrollbar_extra
;
3810 wp
.length
= sizeof(wp
);
3811 GetWindowRect (hwnd
, &wr
);
3815 font_width
= GetWindowLong (hwnd
, WND_FONTWIDTH_INDEX
);
3816 line_height
= GetWindowLong (hwnd
, WND_LINEHEIGHT_INDEX
);
3817 internal_border
= GetWindowLong (hwnd
, WND_BORDER_INDEX
);
3818 scrollbar_extra
= GetWindowLong (hwnd
, WND_SCROLLBAR_INDEX
);
3822 memset (&rect
, 0, sizeof (rect
));
3823 AdjustWindowRect (&rect
, GetWindowLong (hwnd
, GWL_STYLE
),
3824 GetMenu (hwnd
) != NULL
);
3826 /* Force width and height of client area to be exact
3827 multiples of the character cell dimensions. */
3828 wdiff
= (lppos
->cx
- (rect
.right
- rect
.left
)
3829 - 2 * internal_border
- scrollbar_extra
)
3831 hdiff
= (lppos
->cy
- (rect
.bottom
- rect
.top
)
3832 - 2 * internal_border
)
3837 /* For right/bottom sizing we can just fix the sizes.
3838 However for top/left sizing we will need to fix the X
3839 and Y positions as well. */
3844 if (wp
.showCmd
!= SW_SHOWMAXIMIZED
3845 && (lppos
->flags
& SWP_NOMOVE
) == 0)
3847 if (lppos
->x
!= wr
.left
|| lppos
->y
!= wr
.top
)
3854 lppos
->flags
|= SWP_NOMOVE
;
3865 case WM_EMACS_CREATESCROLLBAR
:
3866 return (LRESULT
) w32_createscrollbar ((struct frame
*) wParam
,
3867 (struct scroll_bar
*) lParam
);
3869 case WM_EMACS_SHOWWINDOW
:
3870 return ShowWindow ((HWND
) wParam
, (WPARAM
) lParam
);
3872 case WM_EMACS_SETFOREGROUND
:
3873 return SetForegroundWindow ((HWND
) wParam
);
3875 case WM_EMACS_SETWINDOWPOS
:
3877 WINDOWPOS
* pos
= (WINDOWPOS
*) wParam
;
3878 return SetWindowPos (hwnd
, pos
->hwndInsertAfter
,
3879 pos
->x
, pos
->y
, pos
->cx
, pos
->cy
, pos
->flags
);
3882 case WM_EMACS_DESTROYWINDOW
:
3883 DragAcceptFiles ((HWND
) wParam
, FALSE
);
3884 return DestroyWindow ((HWND
) wParam
);
3886 case WM_EMACS_TRACKPOPUPMENU
:
3891 pos
= (POINT
*)lParam
;
3892 flags
= TPM_CENTERALIGN
;
3893 if (button_state
& LMOUSE
)
3894 flags
|= TPM_LEFTBUTTON
;
3895 else if (button_state
& RMOUSE
)
3896 flags
|= TPM_RIGHTBUTTON
;
3898 /* Remember we did a SetCapture on the initial mouse down event,
3899 so for safety, we make sure the capture is cancelled now. */
3902 /* Use menubar_active to indicate that WM_INITMENU is from
3903 TrackPopupMenu below, and should be ignored. */
3904 f
= x_window_to_frame (dpyinfo
, hwnd
);
3906 f
->output_data
.w32
->menubar_active
= 1;
3908 if (TrackPopupMenu ((HMENU
)wParam
, flags
, pos
->x
, pos
->y
,
3912 /* Eat any mouse messages during popupmenu */
3913 while (PeekMessage (&amsg
, hwnd
, WM_MOUSEFIRST
, WM_MOUSELAST
,
3915 /* Get the menu selection, if any */
3916 if (PeekMessage (&amsg
, hwnd
, WM_COMMAND
, WM_COMMAND
, PM_REMOVE
))
3918 retval
= LOWORD (amsg
.wParam
);
3935 /* Check for messages registered at runtime. */
3936 if (msg
== msh_mousewheel
)
3938 wmsg
.dwModifiers
= w32_get_modifiers ();
3939 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3944 return DefWindowProc (hwnd
, msg
, wParam
, lParam
);
3948 /* The most common default return code for handled messages is 0. */
3953 my_create_window (f
)
3958 if (!PostThreadMessage (dwWindowsThreadId
, WM_EMACS_CREATEWINDOW
, (WPARAM
)f
, 0))
3960 GetMessage (&msg
, NULL
, WM_EMACS_DONE
, WM_EMACS_DONE
);
3963 /* Create and set up the w32 window for frame F. */
3966 w32_window (f
, window_prompting
, minibuffer_only
)
3968 long window_prompting
;
3969 int minibuffer_only
;
3973 /* Use the resource name as the top-level window name
3974 for looking up resources. Make a non-Lisp copy
3975 for the window manager, so GC relocation won't bother it.
3977 Elsewhere we specify the window name for the window manager. */
3980 char *str
= (char *) XSTRING (Vx_resource_name
)->data
;
3981 f
->namebuf
= (char *) xmalloc (strlen (str
) + 1);
3982 strcpy (f
->namebuf
, str
);
3985 my_create_window (f
);
3987 validate_x_resource_name ();
3989 /* x_set_name normally ignores requests to set the name if the
3990 requested name is the same as the current name. This is the one
3991 place where that assumption isn't correct; f->name is set, but
3992 the server hasn't been told. */
3995 int explicit = f
->explicit_name
;
3997 f
->explicit_name
= 0;
4000 x_set_name (f
, name
, explicit);
4005 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
4006 initialize_frame_menubar (f
);
4008 if (FRAME_W32_WINDOW (f
) == 0)
4009 error ("Unable to create window");
4012 /* Handle the icon stuff for this window. Perhaps later we might
4013 want an x_set_icon_position which can be called interactively as
4021 Lisp_Object icon_x
, icon_y
;
4023 /* Set the position of the icon. Note that Windows 95 groups all
4024 icons in the tray. */
4025 icon_x
= x_get_arg (parms
, Qicon_left
, 0, 0, number
);
4026 icon_y
= x_get_arg (parms
, Qicon_top
, 0, 0, number
);
4027 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
4029 CHECK_NUMBER (icon_x
, 0);
4030 CHECK_NUMBER (icon_y
, 0);
4032 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
4033 error ("Both left and top icon corners of icon must be specified");
4037 if (! EQ (icon_x
, Qunbound
))
4038 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
4041 /* Start up iconic or window? */
4042 x_wm_set_window_state
4043 (f
, (EQ (x_get_arg (parms
, Qvisibility
, 0, 0, symbol
), Qicon
)
4047 x_text_icon (f
, (char *) XSTRING ((!NILP (f
->icon_name
)
4055 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
4057 "Make a new window, which is called a \"frame\" in Emacs terms.\n\
4058 Returns an Emacs frame object.\n\
4059 ALIST is an alist of frame parameters.\n\
4060 If the parameters specify that the frame should not have a minibuffer,\n\
4061 and do not specify a specific minibuffer window to use,\n\
4062 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
4063 be shared by the new frame.\n\
4065 This function is an internal primitive--use `make-frame' instead.")
4070 Lisp_Object frame
, tem
;
4072 int minibuffer_only
= 0;
4073 long window_prompting
= 0;
4075 int count
= specpdl_ptr
- specpdl
;
4076 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
4077 Lisp_Object display
;
4078 struct w32_display_info
*dpyinfo
;
4082 /* Use this general default value to start with
4083 until we know if this frame has a specified name. */
4084 Vx_resource_name
= Vinvocation_name
;
4086 display
= x_get_arg (parms
, Qdisplay
, 0, 0, string
);
4087 if (EQ (display
, Qunbound
))
4089 dpyinfo
= check_x_display_info (display
);
4091 kb
= dpyinfo
->kboard
;
4093 kb
= &the_only_kboard
;
4096 name
= x_get_arg (parms
, Qname
, "name", "Name", string
);
4098 && ! EQ (name
, Qunbound
)
4100 error ("Invalid frame name--not a string or nil");
4103 Vx_resource_name
= name
;
4105 /* See if parent window is specified. */
4106 parent
= x_get_arg (parms
, Qparent_id
, NULL
, NULL
, number
);
4107 if (EQ (parent
, Qunbound
))
4109 if (! NILP (parent
))
4110 CHECK_NUMBER (parent
, 0);
4112 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
4113 /* No need to protect DISPLAY because that's not used after passing
4114 it to make_frame_without_minibuffer. */
4116 GCPRO4 (parms
, parent
, name
, frame
);
4117 tem
= x_get_arg (parms
, Qminibuffer
, 0, 0, symbol
);
4118 if (EQ (tem
, Qnone
) || NILP (tem
))
4119 f
= make_frame_without_minibuffer (Qnil
, kb
, display
);
4120 else if (EQ (tem
, Qonly
))
4122 f
= make_minibuffer_frame ();
4123 minibuffer_only
= 1;
4125 else if (WINDOWP (tem
))
4126 f
= make_frame_without_minibuffer (tem
, kb
, display
);
4130 XSETFRAME (frame
, f
);
4132 /* Note that Windows does support scroll bars. */
4133 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
4134 /* By default, make scrollbars the system standard width. */
4135 f
->scroll_bar_pixel_width
= GetSystemMetrics (SM_CXVSCROLL
);
4137 f
->output_method
= output_w32
;
4138 f
->output_data
.w32
= (struct w32_output
*) xmalloc (sizeof (struct w32_output
));
4139 bzero (f
->output_data
.w32
, sizeof (struct w32_output
));
4142 = x_get_arg (parms
, Qicon_name
, "iconName", "Title", string
);
4143 if (! STRINGP (f
->icon_name
))
4144 f
->icon_name
= Qnil
;
4146 /* FRAME_W32_DISPLAY_INFO (f) = dpyinfo; */
4148 FRAME_KBOARD (f
) = kb
;
4151 /* Specify the parent under which to make this window. */
4155 f
->output_data
.w32
->parent_desc
= (Window
) parent
;
4156 f
->output_data
.w32
->explicit_parent
= 1;
4160 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
4161 f
->output_data
.w32
->explicit_parent
= 0;
4164 /* Note that the frame has no physical cursor right now. */
4165 f
->phys_cursor_x
= -1;
4167 /* Set the name; the functions to which we pass f expect the name to
4169 if (EQ (name
, Qunbound
) || NILP (name
))
4171 f
->name
= build_string (dpyinfo
->w32_id_name
);
4172 f
->explicit_name
= 0;
4177 f
->explicit_name
= 1;
4178 /* use the frame's title when getting resources for this frame. */
4179 specbind (Qx_resource_name
, name
);
4182 /* Extract the window parameters from the supplied values
4183 that are needed to determine window geometry. */
4187 font
= x_get_arg (parms
, Qfont
, "font", "Font", string
);
4189 /* First, try whatever font the caller has specified. */
4191 font
= x_new_font (f
, XSTRING (font
)->data
);
4192 /* Try out a font which we hope has bold and italic variations. */
4193 if (!STRINGP (font
))
4194 font
= x_new_font (f
, "-*-Courier New-normal-r-*-*-13-97-*-*-c-*-*-ansi-");
4195 if (! STRINGP (font
))
4196 font
= x_new_font (f
, "-*-Courier-normal-r-*-*-13-97-*-*-c-*-*-ansi-");
4197 /* If those didn't work, look for something which will at least work. */
4198 if (! STRINGP (font
))
4199 font
= x_new_font (f
, "-*-Fixedsys-normal-r-*-*-13-97-*-*-c-*-*-ansi-");
4201 if (! STRINGP (font
))
4202 font
= build_string ("Fixedsys");
4204 x_default_parameter (f
, parms
, Qfont
, font
,
4205 "font", "Font", string
);
4208 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
4209 "borderwidth", "BorderWidth", number
);
4210 /* This defaults to 2 in order to match xterm. We recognize either
4211 internalBorderWidth or internalBorder (which is what xterm calls
4213 if (NILP (Fassq (Qinternal_border_width
, parms
)))
4217 value
= x_get_arg (parms
, Qinternal_border_width
,
4218 "internalBorder", "BorderWidth", number
);
4219 if (! EQ (value
, Qunbound
))
4220 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
4223 /* Default internalBorderWidth to 0 on Windows to match other programs. */
4224 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (0),
4225 "internalBorderWidth", "BorderWidth", number
);
4226 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qt
,
4227 "verticalScrollBars", "ScrollBars", boolean
);
4229 /* Also do the stuff which must be set before the window exists. */
4230 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
4231 "foreground", "Foreground", string
);
4232 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
4233 "background", "Background", string
);
4234 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
4235 "pointerColor", "Foreground", string
);
4236 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
4237 "cursorColor", "Foreground", string
);
4238 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
4239 "borderColor", "BorderColor", string
);
4241 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (1),
4242 "menuBar", "MenuBar", number
);
4243 x_default_parameter (f
, parms
, Qscroll_bar_width
, Qnil
,
4244 "scrollBarWidth", "ScrollBarWidth", number
);
4245 x_default_parameter (f
, parms
, Qbuffer_predicate
, Qnil
,
4246 "bufferPredicate", "BufferPredicate", symbol
);
4247 x_default_parameter (f
, parms
, Qtitle
, Qnil
,
4248 "title", "Title", string
);
4250 f
->output_data
.w32
->dwStyle
= WS_OVERLAPPEDWINDOW
;
4251 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
4252 window_prompting
= x_figure_window_size (f
, parms
);
4254 if (window_prompting
& XNegative
)
4256 if (window_prompting
& YNegative
)
4257 f
->output_data
.w32
->win_gravity
= SouthEastGravity
;
4259 f
->output_data
.w32
->win_gravity
= NorthEastGravity
;
4263 if (window_prompting
& YNegative
)
4264 f
->output_data
.w32
->win_gravity
= SouthWestGravity
;
4266 f
->output_data
.w32
->win_gravity
= NorthWestGravity
;
4269 f
->output_data
.w32
->size_hint_flags
= window_prompting
;
4271 w32_window (f
, window_prompting
, minibuffer_only
);
4273 init_frame_faces (f
);
4275 /* We need to do this after creating the window, so that the
4276 icon-creation functions can say whose icon they're describing. */
4277 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
4278 "bitmapIcon", "BitmapIcon", symbol
);
4280 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
4281 "autoRaise", "AutoRaiseLower", boolean
);
4282 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
4283 "autoLower", "AutoRaiseLower", boolean
);
4284 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
4285 "cursorType", "CursorType", symbol
);
4287 /* Dimensions, especially f->height, must be done via change_frame_size.
4288 Change will not be effected unless different from the current
4293 SET_FRAME_WIDTH (f
, 0);
4294 change_frame_size (f
, height
, width
, 1, 0);
4296 /* Tell the server what size and position, etc, we want,
4297 and how badly we want them. */
4299 x_wm_set_size_hint (f
, window_prompting
, 0);
4302 tem
= x_get_arg (parms
, Qunsplittable
, 0, 0, boolean
);
4303 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
4307 /* It is now ok to make the frame official
4308 even if we get an error below.
4309 And the frame needs to be on Vframe_list
4310 or making it visible won't work. */
4311 Vframe_list
= Fcons (frame
, Vframe_list
);
4313 /* Now that the frame is official, it counts as a reference to
4315 FRAME_W32_DISPLAY_INFO (f
)->reference_count
++;
4317 /* Make the window appear on the frame and enable display,
4318 unless the caller says not to. However, with explicit parent,
4319 Emacs cannot control visibility, so don't try. */
4320 if (! f
->output_data
.w32
->explicit_parent
)
4322 Lisp_Object visibility
;
4324 visibility
= x_get_arg (parms
, Qvisibility
, 0, 0, symbol
);
4325 if (EQ (visibility
, Qunbound
))
4328 if (EQ (visibility
, Qicon
))
4329 x_iconify_frame (f
);
4330 else if (! NILP (visibility
))
4331 x_make_frame_visible (f
);
4333 /* Must have been Qnil. */
4337 return unbind_to (count
, frame
);
4340 /* FRAME is used only to get a handle on the X display. We don't pass the
4341 display info directly because we're called from frame.c, which doesn't
4342 know about that structure. */
4344 x_get_focus_frame (frame
)
4345 struct frame
*frame
;
4347 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (frame
);
4349 if (! dpyinfo
->w32_focus_frame
)
4352 XSETFRAME (xfocus
, dpyinfo
->w32_focus_frame
);
4356 DEFUN ("w32-focus-frame", Fw32_focus_frame
, Sw32_focus_frame
, 1, 1, 0,
4357 "Give FRAME input focus, raising to foreground if necessary.")
4361 x_focus_on_frame (check_x_frame (frame
));
4367 w32_load_font (dpyinfo
,name
)
4368 struct w32_display_info
*dpyinfo
;
4371 XFontStruct
* font
= NULL
;
4377 if (!name
|| !x_to_w32_font (name
, &lf
))
4380 font
= (XFontStruct
*) xmalloc (sizeof (XFontStruct
));
4382 if (!font
) return (NULL
);
4386 font
->hfont
= CreateFontIndirect (&lf
);
4389 if (font
->hfont
== NULL
)
4398 hdc
= GetDC (dpyinfo
->root_window
);
4399 oldobj
= SelectObject (hdc
, font
->hfont
);
4400 ok
= GetTextMetrics (hdc
, &font
->tm
);
4401 SelectObject (hdc
, oldobj
);
4402 ReleaseDC (dpyinfo
->root_window
, hdc
);
4407 if (ok
) return (font
);
4409 w32_unload_font (dpyinfo
, font
);
4414 w32_unload_font (dpyinfo
, font
)
4415 struct w32_display_info
*dpyinfo
;
4420 if (font
->hfont
) DeleteObject(font
->hfont
);
4425 /* The font conversion stuff between x and w32 */
4427 /* X font string is as follows (from faces.el)
4431 * (weight "\\(bold\\|demibold\\|medium\\)") ; 1
4432 * (weight\? "\\([^-]*\\)") ; 1
4433 * (slant "\\([ior]\\)") ; 2
4434 * (slant\? "\\([^-]?\\)") ; 2
4435 * (swidth "\\([^-]*\\)") ; 3
4436 * (adstyle "[^-]*") ; 4
4437 * (pixelsize "[0-9]+")
4438 * (pointsize "[0-9][0-9]+")
4439 * (resx "[0-9][0-9]+")
4440 * (resy "[0-9][0-9]+")
4441 * (spacing "[cmp?*]")
4442 * (avgwidth "[0-9]+")
4443 * (registry "[^-]+")
4444 * (encoding "[^-]+")
4446 * (setq x-font-regexp
4447 * (concat "\\`\\*?[-?*]"
4448 * foundry - family - weight\? - slant\? - swidth - adstyle -
4449 * pixelsize - pointsize - resx - resy - spacing - registry -
4450 * encoding "[-?*]\\*?\\'"
4452 * (setq x-font-regexp-head
4453 * (concat "\\`[-?*]" foundry - family - weight\? - slant\?
4454 * "\\([-*?]\\|\\'\\)"))
4455 * (setq x-font-regexp-slant (concat - slant -))
4456 * (setq x-font-regexp-weight (concat - weight -))
4460 #define FONT_START "[-?]"
4461 #define FONT_FOUNDRY "[^-]+"
4462 #define FONT_FAMILY "\\([^-]+\\)" /* 1 */
4463 #define FONT_WEIGHT "\\(bold\\|demibold\\|medium\\)" /* 2 */
4464 #define FONT_WEIGHT_Q "\\([^-]*\\)" /* 2 */
4465 #define FONT_SLANT "\\([ior]\\)" /* 3 */
4466 #define FONT_SLANT_Q "\\([^-]?\\)" /* 3 */
4467 #define FONT_SWIDTH "\\([^-]*\\)" /* 4 */
4468 #define FONT_ADSTYLE "[^-]*"
4469 #define FONT_PIXELSIZE "[^-]*"
4470 #define FONT_POINTSIZE "\\([0-9][0-9]+\\|\\*\\)" /* 5 */
4471 #define FONT_RESX "[0-9][0-9]+"
4472 #define FONT_RESY "[0-9][0-9]+"
4473 #define FONT_SPACING "[cmp?*]"
4474 #define FONT_AVGWIDTH "[0-9]+"
4475 #define FONT_REGISTRY "[^-]+"
4476 #define FONT_ENCODING "[^-]+"
4478 #define FONT_REGEXP ("\\`\\*?[-?*]" \
4485 FONT_PIXELSIZE "-" \
4486 FONT_POINTSIZE "-" \
4489 #define FONT_REGEXP_HEAD ("\\`[-?*]" \
4494 "\\([-*?]\\|\\'\\)")
4496 #define FONT_REGEXP_SLANT "-" FONT_SLANT "-"
4497 #define FONT_REGEXP_WEIGHT "-" FONT_WEIGHT "-"
4500 x_to_w32_weight (lpw
)
4503 if (!lpw
) return (FW_DONTCARE
);
4505 if (stricmp (lpw
,"heavy") == 0) return FW_HEAVY
;
4506 else if (stricmp (lpw
,"extrabold") == 0) return FW_EXTRABOLD
;
4507 else if (stricmp (lpw
,"bold") == 0) return FW_BOLD
;
4508 else if (stricmp (lpw
,"demibold") == 0) return FW_SEMIBOLD
;
4509 else if (stricmp (lpw
,"semibold") == 0) return FW_SEMIBOLD
;
4510 else if (stricmp (lpw
,"medium") == 0) return FW_MEDIUM
;
4511 else if (stricmp (lpw
,"normal") == 0) return FW_NORMAL
;
4512 else if (stricmp (lpw
,"light") == 0) return FW_LIGHT
;
4513 else if (stricmp (lpw
,"extralight") == 0) return FW_EXTRALIGHT
;
4514 else if (stricmp (lpw
,"thin") == 0) return FW_THIN
;
4521 w32_to_x_weight (fnweight
)
4524 if (fnweight
>= FW_HEAVY
) return "heavy";
4525 if (fnweight
>= FW_EXTRABOLD
) return "extrabold";
4526 if (fnweight
>= FW_BOLD
) return "bold";
4527 if (fnweight
>= FW_SEMIBOLD
) return "semibold";
4528 if (fnweight
>= FW_MEDIUM
) return "medium";
4529 if (fnweight
>= FW_NORMAL
) return "normal";
4530 if (fnweight
>= FW_LIGHT
) return "light";
4531 if (fnweight
>= FW_EXTRALIGHT
) return "extralight";
4532 if (fnweight
>= FW_THIN
) return "thin";
4538 x_to_w32_charset (lpcs
)
4541 if (!lpcs
) return (0);
4543 if (stricmp (lpcs
,"ansi") == 0) return ANSI_CHARSET
;
4544 else if (stricmp (lpcs
,"iso8859-1") == 0) return ANSI_CHARSET
;
4545 else if (stricmp (lpcs
,"iso8859") == 0) return ANSI_CHARSET
;
4546 else if (stricmp (lpcs
,"oem") == 0) return OEM_CHARSET
;
4547 #ifdef UNICODE_CHARSET
4548 else if (stricmp (lpcs
,"unicode") == 0) return UNICODE_CHARSET
;
4549 else if (stricmp (lpcs
,"iso10646") == 0) return UNICODE_CHARSET
;
4551 else if (lpcs
[0] == '#') return atoi (lpcs
+ 1);
4553 return DEFAULT_CHARSET
;
4557 w32_to_x_charset (fncharset
)
4560 static char buf
[16];
4564 case ANSI_CHARSET
: return "ansi";
4565 case OEM_CHARSET
: return "oem";
4566 case SYMBOL_CHARSET
: return "symbol";
4567 #ifdef UNICODE_CHARSET
4568 case UNICODE_CHARSET
: return "unicode";
4571 /* Encode numerical value of unknown charset. */
4572 sprintf (buf
, "#%u", fncharset
);
4577 w32_to_x_font (lplogfont
, lpxstr
, len
)
4578 LOGFONT
* lplogfont
;
4582 char height_pixels
[8];
4584 char width_pixels
[8];
4586 if (!lpxstr
) abort ();
4591 if (lplogfont
->lfHeight
)
4593 sprintf (height_pixels
, "%u", abs (lplogfont
->lfHeight
));
4594 sprintf (height_dpi
, "%u",
4595 (abs (lplogfont
->lfHeight
) * 720) / one_w32_display_info
.height_in
);
4599 strcpy (height_pixels
, "*");
4600 strcpy (height_dpi
, "*");
4602 if (lplogfont
->lfWidth
)
4603 sprintf (width_pixels
, "%u", lplogfont
->lfWidth
* 10);
4605 strcpy (width_pixels
, "*");
4607 _snprintf (lpxstr
, len
- 1,
4608 "-*-%s-%s-%c-*-*-%s-%s-*-*-%c-%s-*-%s-",
4609 lplogfont
->lfFaceName
,
4610 w32_to_x_weight (lplogfont
->lfWeight
),
4611 lplogfont
->lfItalic
?'i':'r',
4614 ((lplogfont
->lfPitchAndFamily
& 0x3) == VARIABLE_PITCH
) ? 'p' : 'c',
4616 w32_to_x_charset (lplogfont
->lfCharSet
)
4619 lpxstr
[len
- 1] = 0; /* just to be sure */
4624 x_to_w32_font (lpxstr
, lplogfont
)
4626 LOGFONT
* lplogfont
;
4628 if (!lplogfont
) return (FALSE
);
4630 memset (lplogfont
, 0, sizeof (*lplogfont
));
4633 lplogfont
->lfOutPrecision
= OUT_DEFAULT_PRECIS
;
4634 lplogfont
->lfClipPrecision
= CLIP_DEFAULT_PRECIS
;
4635 lplogfont
->lfQuality
= DEFAULT_QUALITY
;
4637 /* go for maximum quality */
4638 lplogfont
->lfOutPrecision
= OUT_STROKE_PRECIS
;
4639 lplogfont
->lfClipPrecision
= CLIP_STROKE_PRECIS
;
4640 lplogfont
->lfQuality
= PROOF_QUALITY
;
4646 /* Provide a simple escape mechanism for specifying Windows font names
4647 * directly -- if font spec does not beginning with '-', assume this
4649 * "<font name>[:height in pixels[:width in pixels[:weight]]]"
4655 char name
[50], weight
[20], slant
, pitch
, pixels
[10], height
[10], width
[10], remainder
[20];
4658 fields
= sscanf (lpxstr
,
4659 "-%*[^-]-%49[^-]-%19[^-]-%c-%*[^-]-%*[^-]-%9[^-]-%9[^-]-%*[^-]-%*[^-]-%c-%9[^-]-%19s",
4660 name
, weight
, &slant
, pixels
, height
, &pitch
, width
, remainder
);
4662 if (fields
== EOF
) return (FALSE
);
4664 if (fields
> 0 && name
[0] != '*')
4666 strncpy (lplogfont
->lfFaceName
,name
, LF_FACESIZE
);
4667 lplogfont
->lfFaceName
[LF_FACESIZE
-1] = 0;
4671 lplogfont
->lfFaceName
[0] = 0;
4676 lplogfont
->lfWeight
= x_to_w32_weight ((fields
> 0 ? weight
: ""));
4680 if (!NILP (Vw32_enable_italics
))
4681 lplogfont
->lfItalic
= (fields
> 0 && slant
== 'i');
4685 if (fields
> 0 && pixels
[0] != '*')
4686 lplogfont
->lfHeight
= atoi (pixels
);
4690 if (fields
> 0 && lplogfont
->lfHeight
== 0 && height
[0] != '*')
4691 lplogfont
->lfHeight
= (atoi (height
)
4692 * one_w32_display_info
.height_in
) / 720;
4696 lplogfont
->lfPitchAndFamily
=
4697 (fields
> 0 && pitch
== 'p') ? VARIABLE_PITCH
: FIXED_PITCH
;
4701 if (fields
> 0 && width
[0] != '*')
4702 lplogfont
->lfWidth
= atoi (width
) / 10;
4706 /* Not all font specs include the registry field, so we allow for an
4707 optional registry field before the encoding when parsing
4708 remainder. Also we strip the trailing '-' if present. */
4710 int len
= strlen (remainder
);
4711 if (len
> 0 && remainder
[len
-1] == '-')
4712 remainder
[len
-1] = 0;
4714 encoding
= remainder
;
4715 if (strncmp (encoding
, "*-", 2) == 0)
4717 lplogfont
->lfCharSet
= x_to_w32_charset (fields
> 0 ? encoding
: "");
4722 char name
[100], height
[10], width
[10], weight
[20];
4724 fields
= sscanf (lpxstr
,
4725 "%99[^:]:%9[^:]:%9[^:]:%19s",
4726 name
, height
, width
, weight
);
4728 if (fields
== EOF
) return (FALSE
);
4732 strncpy (lplogfont
->lfFaceName
,name
, LF_FACESIZE
);
4733 lplogfont
->lfFaceName
[LF_FACESIZE
-1] = 0;
4737 lplogfont
->lfFaceName
[0] = 0;
4743 lplogfont
->lfHeight
= atoi (height
);
4748 lplogfont
->lfWidth
= atoi (width
);
4752 lplogfont
->lfWeight
= x_to_w32_weight ((fields
> 0 ? weight
: ""));
4755 /* This makes TrueType fonts work better. */
4756 lplogfont
->lfHeight
= - abs (lplogfont
->lfHeight
);
4762 w32_font_match (lpszfont1
, lpszfont2
)
4766 char * s1
= lpszfont1
, *e1
;
4767 char * s2
= lpszfont2
, *e2
;
4769 if (s1
== NULL
|| s2
== NULL
) return (FALSE
);
4771 if (*s1
== '-') s1
++;
4772 if (*s2
== '-') s2
++;
4778 e1
= strchr (s1
, '-');
4779 e2
= strchr (s2
, '-');
4781 if (e1
== NULL
|| e2
== NULL
) return (TRUE
);
4786 if (*s1
!= '*' && *s2
!= '*'
4787 && (len1
!= len2
|| strnicmp (s1
, s2
, len1
) != 0))
4795 typedef struct enumfont_t
4800 XFontStruct
*size_ref
;
4801 Lisp_Object
*pattern
;
4807 enum_font_cb2 (lplf
, lptm
, FontType
, lpef
)
4809 NEWTEXTMETRIC
* lptm
;
4813 if (lplf
->elfLogFont
.lfStrikeOut
|| lplf
->elfLogFont
.lfUnderline
)
4816 /* if (!lpef->size_ref || lptm->tmMaxCharWidth == FONT_WIDTH (lpef->size_ref)) */
4820 if (!NILP (*(lpef
->pattern
)) && FontType
!= RASTER_FONTTYPE
)
4822 lplf
->elfLogFont
.lfHeight
= lpef
->logfont
.lfHeight
;
4823 lplf
->elfLogFont
.lfWidth
= lpef
->logfont
.lfWidth
;
4826 if (!w32_to_x_font (lplf
, buf
, 100)) return (0);
4828 if (NILP (*(lpef
->pattern
)) || w32_font_match (buf
, XSTRING (*(lpef
->pattern
))->data
))
4830 *lpef
->tail
= Fcons (build_string (buf
), Qnil
);
4831 lpef
->tail
= &XCONS (*lpef
->tail
)->cdr
;
4840 enum_font_cb1 (lplf
, lptm
, FontType
, lpef
)
4842 NEWTEXTMETRIC
* lptm
;
4846 return EnumFontFamilies (lpef
->hdc
,
4847 lplf
->elfLogFont
.lfFaceName
,
4848 (FONTENUMPROC
) enum_font_cb2
,
4853 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 4, 0,
4854 "Return a list of the names of available fonts matching PATTERN.\n\
4855 If optional arguments FACE and FRAME are specified, return only fonts\n\
4856 the same size as FACE on FRAME.\n\
4858 PATTERN is a string, perhaps with wildcard characters;\n\
4859 the * character matches any substring, and\n\
4860 the ? character matches any single character.\n\
4861 PATTERN is case-insensitive.\n\
4862 FACE is a face name--a symbol.\n\
4864 The return value is a list of strings, suitable as arguments to\n\
4867 Fonts Emacs can't use (i.e. proportional fonts) may or may not be excluded\n\
4868 even if they match PATTERN and FACE.\n\
4870 The optional fourth argument MAXIMUM sets a limit on how many\n\
4871 fonts to match. The first MAXIMUM fonts are reported.")
4872 (pattern
, face
, frame
, maximum
)
4873 Lisp_Object pattern
, face
, frame
, maximum
;
4878 XFontStruct
*size_ref
;
4879 Lisp_Object namelist
;
4884 CHECK_STRING (pattern
, 0);
4886 CHECK_SYMBOL (face
, 1);
4888 f
= check_x_frame (frame
);
4890 /* Determine the width standard for comparison with the fonts we find. */
4898 /* Don't die if we get called with a terminal frame. */
4899 if (! FRAME_W32_P (f
))
4900 error ("non-w32 frame used in `x-list-fonts'");
4902 face_id
= face_name_id_number (f
, face
);
4904 if (face_id
< 0 || face_id
>= FRAME_N_PARAM_FACES (f
)
4905 || FRAME_PARAM_FACES (f
) [face_id
] == 0)
4906 size_ref
= f
->output_data
.w32
->font
;
4909 size_ref
= FRAME_PARAM_FACES (f
) [face_id
]->font
;
4910 if (size_ref
== (XFontStruct
*) (~0))
4911 size_ref
= f
->output_data
.w32
->font
;
4915 /* See if we cached the result for this particular query. */
4916 list
= Fassoc (pattern
,
4917 XCONS (FRAME_W32_DISPLAY_INFO (f
)->name_list_element
)->cdr
);
4919 /* We have info in the cache for this PATTERN. */
4922 Lisp_Object tem
, newlist
;
4924 /* We have info about this pattern. */
4925 list
= XCONS (list
)->cdr
;
4932 /* Filter the cached info and return just the fonts that match FACE. */
4934 for (tem
= list
; CONSP (tem
); tem
= XCONS (tem
)->cdr
)
4936 XFontStruct
*thisinfo
;
4938 thisinfo
= w32_load_font (FRAME_W32_DISPLAY_INFO (f
), XSTRING (XCONS (tem
)->car
)->data
);
4940 if (thisinfo
&& same_size_fonts (thisinfo
, size_ref
))
4941 newlist
= Fcons (XCONS (tem
)->car
, newlist
);
4943 w32_unload_font (FRAME_W32_DISPLAY_INFO (f
), thisinfo
);
4954 ef
.pattern
= &pattern
;
4955 ef
.tail
= ef
.head
= &namelist
;
4957 x_to_w32_font (STRINGP (pattern
) ? XSTRING (pattern
)->data
: NULL
, &ef
.logfont
);
4960 ef
.hdc
= GetDC (FRAME_W32_WINDOW (f
));
4962 EnumFontFamilies (ef
.hdc
, NULL
, (FONTENUMPROC
) enum_font_cb1
, (LPARAM
)&ef
);
4964 ReleaseDC (FRAME_W32_WINDOW (f
), ef
.hdc
);
4974 /* Make a list of all the fonts we got back.
4975 Store that in the font cache for the display. */
4976 XCONS (FRAME_W32_DISPLAY_INFO (f
)->name_list_element
)->cdr
4977 = Fcons (Fcons (pattern
, namelist
),
4978 XCONS (FRAME_W32_DISPLAY_INFO (f
)->name_list_element
)->cdr
);
4980 /* Make a list of the fonts that have the right width. */
4983 for (i
= 0; i
< ef
.numFonts
; i
++)
4991 XFontStruct
*thisinfo
;
4994 thisinfo
= w32_load_font (FRAME_W32_DISPLAY_INFO (f
), XSTRING (Fcar (cur
))->data
);
4996 keeper
= thisinfo
&& same_size_fonts (thisinfo
, size_ref
);
4998 w32_unload_font (FRAME_W32_DISPLAY_INFO (f
), thisinfo
);
5003 list
= Fcons (build_string (XSTRING (Fcar (cur
))->data
), list
);
5007 list
= Fnreverse (list
);
5013 DEFUN ("x-color-defined-p", Fx_color_defined_p
, Sx_color_defined_p
, 1, 2, 0,
5014 "Return non-nil if color COLOR is supported on frame FRAME.\n\
5015 If FRAME is omitted or nil, use the selected frame.")
5017 Lisp_Object color
, frame
;
5020 FRAME_PTR f
= check_x_frame (frame
);
5022 CHECK_STRING (color
, 1);
5024 if (defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
5030 DEFUN ("x-color-values", Fx_color_values
, Sx_color_values
, 1, 2, 0,
5031 "Return a description of the color named COLOR on frame FRAME.\n\
5032 The value is a list of integer RGB values--(RED GREEN BLUE).\n\
5033 These values appear to range from 0 to 65280 or 65535, depending\n\
5034 on the system; white is (65280 65280 65280) or (65535 65535 65535).\n\
5035 If FRAME is omitted or nil, use the selected frame.")
5037 Lisp_Object color
, frame
;
5040 FRAME_PTR f
= check_x_frame (frame
);
5042 CHECK_STRING (color
, 1);
5044 if (defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
5048 rgb
[0] = make_number ((GetRValue (foo
) << 8) | GetRValue (foo
));
5049 rgb
[1] = make_number ((GetGValue (foo
) << 8) | GetGValue (foo
));
5050 rgb
[2] = make_number ((GetBValue (foo
) << 8) | GetBValue (foo
));
5051 return Flist (3, rgb
);
5057 DEFUN ("x-display-color-p", Fx_display_color_p
, Sx_display_color_p
, 0, 1, 0,
5058 "Return t if the X display supports color.\n\
5059 The optional argument DISPLAY specifies which display to ask about.\n\
5060 DISPLAY should be either a frame or a display name (a string).\n\
5061 If omitted or nil, that stands for the selected frame's display.")
5063 Lisp_Object display
;
5065 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
5067 if ((dpyinfo
->n_planes
* dpyinfo
->n_cbits
) <= 2)
5073 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
, Sx_display_grayscale_p
,
5075 "Return t if the X display supports shades of gray.\n\
5076 Note that color displays do support shades of gray.\n\
5077 The optional argument DISPLAY specifies which display to ask about.\n\
5078 DISPLAY should be either a frame or a display name (a string).\n\
5079 If omitted or nil, that stands for the selected frame's display.")
5081 Lisp_Object display
;
5083 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
5085 if ((dpyinfo
->n_planes
* dpyinfo
->n_cbits
) <= 1)
5091 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
5093 "Returns the width in pixels of the X display DISPLAY.\n\
5094 The optional argument DISPLAY specifies which display to ask about.\n\
5095 DISPLAY should be either a frame or a display name (a string).\n\
5096 If omitted or nil, that stands for the selected frame's display.")
5098 Lisp_Object display
;
5100 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
5102 return make_number (dpyinfo
->width
);
5105 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
5106 Sx_display_pixel_height
, 0, 1, 0,
5107 "Returns the height in pixels of the X display DISPLAY.\n\
5108 The optional argument DISPLAY specifies which display to ask about.\n\
5109 DISPLAY should be either a frame or a display name (a string).\n\
5110 If omitted or nil, that stands for the selected frame's display.")
5112 Lisp_Object display
;
5114 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
5116 return make_number (dpyinfo
->height
);
5119 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
5121 "Returns the number of bitplanes of the display DISPLAY.\n\
5122 The optional argument DISPLAY specifies which display to ask about.\n\
5123 DISPLAY should be either a frame or a display name (a string).\n\
5124 If omitted or nil, that stands for the selected frame's display.")
5126 Lisp_Object display
;
5128 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
5130 return make_number (dpyinfo
->n_planes
* dpyinfo
->n_cbits
);
5133 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
5135 "Returns the number of color cells of the display DISPLAY.\n\
5136 The optional argument DISPLAY specifies which display to ask about.\n\
5137 DISPLAY should be either a frame or a display name (a string).\n\
5138 If omitted or nil, that stands for the selected frame's display.")
5140 Lisp_Object display
;
5142 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
5146 hdc
= GetDC (dpyinfo
->root_window
);
5147 if (dpyinfo
->has_palette
)
5148 cap
= GetDeviceCaps (hdc
,SIZEPALETTE
);
5150 cap
= GetDeviceCaps (hdc
,NUMCOLORS
);
5152 ReleaseDC (dpyinfo
->root_window
, hdc
);
5154 return make_number (cap
);
5157 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
5158 Sx_server_max_request_size
,
5160 "Returns the maximum request size of the server of display DISPLAY.\n\
5161 The optional argument DISPLAY specifies which display to ask about.\n\
5162 DISPLAY should be either a frame or a display name (a string).\n\
5163 If omitted or nil, that stands for the selected frame's display.")
5165 Lisp_Object display
;
5167 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
5169 return make_number (1);
5172 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
5173 "Returns the vendor ID string of the W32 system (Microsoft).\n\
5174 The optional argument DISPLAY specifies which display to ask about.\n\
5175 DISPLAY should be either a frame or a display name (a string).\n\
5176 If omitted or nil, that stands for the selected frame's display.")
5178 Lisp_Object display
;
5180 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
5181 char *vendor
= "Microsoft Corp.";
5183 if (! vendor
) vendor
= "";
5184 return build_string (vendor
);
5187 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
5188 "Returns the version numbers of the server of display DISPLAY.\n\
5189 The value is a list of three integers: the major and minor\n\
5190 version numbers, and the vendor-specific release\n\
5191 number. See also the function `x-server-vendor'.\n\n\
5192 The optional argument DISPLAY specifies which display to ask about.\n\
5193 DISPLAY should be either a frame or a display name (a string).\n\
5194 If omitted or nil, that stands for the selected frame's display.")
5196 Lisp_Object display
;
5198 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
5200 return Fcons (make_number (w32_major_version
),
5201 Fcons (make_number (w32_minor_version
), Qnil
));
5204 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
5205 "Returns the number of screens on the server of display DISPLAY.\n\
5206 The optional argument DISPLAY specifies which display to ask about.\n\
5207 DISPLAY should be either a frame or a display name (a string).\n\
5208 If omitted or nil, that stands for the selected frame's display.")
5210 Lisp_Object display
;
5212 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
5214 return make_number (1);
5217 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
5218 "Returns the height in millimeters of the X display DISPLAY.\n\
5219 The optional argument DISPLAY specifies which display to ask about.\n\
5220 DISPLAY should be either a frame or a display name (a string).\n\
5221 If omitted or nil, that stands for the selected frame's display.")
5223 Lisp_Object display
;
5225 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
5229 hdc
= GetDC (dpyinfo
->root_window
);
5231 cap
= GetDeviceCaps (hdc
, VERTSIZE
);
5233 ReleaseDC (dpyinfo
->root_window
, hdc
);
5235 return make_number (cap
);
5238 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
5239 "Returns the width in millimeters of the X display DISPLAY.\n\
5240 The optional argument DISPLAY specifies which display to ask about.\n\
5241 DISPLAY should be either a frame or a display name (a string).\n\
5242 If omitted or nil, that stands for the selected frame's display.")
5244 Lisp_Object display
;
5246 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
5251 hdc
= GetDC (dpyinfo
->root_window
);
5253 cap
= GetDeviceCaps (hdc
, HORZSIZE
);
5255 ReleaseDC (dpyinfo
->root_window
, hdc
);
5257 return make_number (cap
);
5260 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
5261 Sx_display_backing_store
, 0, 1, 0,
5262 "Returns an indication of whether display DISPLAY does backing store.\n\
5263 The value may be `always', `when-mapped', or `not-useful'.\n\
5264 The optional argument DISPLAY specifies which display to ask about.\n\
5265 DISPLAY should be either a frame or a display name (a string).\n\
5266 If omitted or nil, that stands for the selected frame's display.")
5268 Lisp_Object display
;
5270 return intern ("not-useful");
5273 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
5274 Sx_display_visual_class
, 0, 1, 0,
5275 "Returns the visual class of the display DISPLAY.\n\
5276 The value is one of the symbols `static-gray', `gray-scale',\n\
5277 `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
5278 The optional argument DISPLAY specifies which display to ask about.\n\
5279 DISPLAY should be either a frame or a display name (a string).\n\
5280 If omitted or nil, that stands for the selected frame's display.")
5282 Lisp_Object display
;
5284 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
5287 switch (dpyinfo
->visual
->class)
5289 case StaticGray
: return (intern ("static-gray"));
5290 case GrayScale
: return (intern ("gray-scale"));
5291 case StaticColor
: return (intern ("static-color"));
5292 case PseudoColor
: return (intern ("pseudo-color"));
5293 case TrueColor
: return (intern ("true-color"));
5294 case DirectColor
: return (intern ("direct-color"));
5296 error ("Display has an unknown visual class");
5300 error ("Display has an unknown visual class");
5303 DEFUN ("x-display-save-under", Fx_display_save_under
,
5304 Sx_display_save_under
, 0, 1, 0,
5305 "Returns t if the display DISPLAY supports the save-under feature.\n\
5306 The optional argument DISPLAY specifies which display to ask about.\n\
5307 DISPLAY should be either a frame or a display name (a string).\n\
5308 If omitted or nil, that stands for the selected frame's display.")
5310 Lisp_Object display
;
5312 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
5319 register struct frame
*f
;
5321 return PIXEL_WIDTH (f
);
5326 register struct frame
*f
;
5328 return PIXEL_HEIGHT (f
);
5333 register struct frame
*f
;
5335 return FONT_WIDTH (f
->output_data
.w32
->font
);
5340 register struct frame
*f
;
5342 return f
->output_data
.w32
->line_height
;
5346 x_screen_planes (frame
)
5349 return (FRAME_W32_DISPLAY_INFO (XFRAME (frame
))->n_planes
*
5350 FRAME_W32_DISPLAY_INFO (XFRAME (frame
))->n_cbits
);
5353 /* Return the display structure for the display named NAME.
5354 Open a new connection if necessary. */
5356 struct w32_display_info
*
5357 x_display_info_for_name (name
)
5361 struct w32_display_info
*dpyinfo
;
5363 CHECK_STRING (name
, 0);
5365 for (dpyinfo
= &one_w32_display_info
, names
= w32_display_name_list
;
5367 dpyinfo
= dpyinfo
->next
, names
= XCONS (names
)->cdr
)
5370 tem
= Fstring_equal (XCONS (XCONS (names
)->car
)->car
, name
);
5375 /* Use this general default value to start with. */
5376 Vx_resource_name
= Vinvocation_name
;
5378 validate_x_resource_name ();
5380 dpyinfo
= w32_term_init (name
, (unsigned char *)0,
5381 (char *) XSTRING (Vx_resource_name
)->data
);
5384 error ("Cannot connect to server %s", XSTRING (name
)->data
);
5387 XSETFASTINT (Vwindow_system_version
, 3);
5392 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
5393 1, 3, 0, "Open a connection to a server.\n\
5394 DISPLAY is the name of the display to connect to.\n\
5395 Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
5396 If the optional third arg MUST-SUCCEED is non-nil,\n\
5397 terminate Emacs if we can't open the connection.")
5398 (display
, xrm_string
, must_succeed
)
5399 Lisp_Object display
, xrm_string
, must_succeed
;
5401 unsigned int n_planes
;
5402 unsigned char *xrm_option
;
5403 struct w32_display_info
*dpyinfo
;
5405 CHECK_STRING (display
, 0);
5406 if (! NILP (xrm_string
))
5407 CHECK_STRING (xrm_string
, 1);
5409 if (! EQ (Vwindow_system
, intern ("w32")))
5410 error ("Not using Microsoft Windows");
5412 /* Allow color mapping to be defined externally; first look in user's
5413 HOME directory, then in Emacs etc dir for a file called rgb.txt. */
5415 Lisp_Object color_file
;
5416 struct gcpro gcpro1
;
5418 color_file
= build_string("~/rgb.txt");
5420 GCPRO1 (color_file
);
5422 if (NILP (Ffile_readable_p (color_file
)))
5424 Fexpand_file_name (build_string ("rgb.txt"),
5425 Fsymbol_value (intern ("data-directory")));
5427 Vw32_color_map
= Fw32_load_color_file (color_file
);
5431 if (NILP (Vw32_color_map
))
5432 Vw32_color_map
= Fw32_default_color_map ();
5434 if (! NILP (xrm_string
))
5435 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
5437 xrm_option
= (unsigned char *) 0;
5439 /* Use this general default value to start with. */
5440 /* First remove .exe suffix from invocation-name - it looks ugly. */
5442 char basename
[ MAX_PATH
], *str
;
5444 strcpy (basename
, XSTRING (Vinvocation_name
)->data
);
5445 str
= strrchr (basename
, '.');
5447 Vinvocation_name
= build_string (basename
);
5449 Vx_resource_name
= Vinvocation_name
;
5451 validate_x_resource_name ();
5453 /* This is what opens the connection and sets x_current_display.
5454 This also initializes many symbols, such as those used for input. */
5455 dpyinfo
= w32_term_init (display
, xrm_option
,
5456 (char *) XSTRING (Vx_resource_name
)->data
);
5460 if (!NILP (must_succeed
))
5461 fatal ("Cannot connect to server %s.\n",
5462 XSTRING (display
)->data
);
5464 error ("Cannot connect to server %s", XSTRING (display
)->data
);
5469 XSETFASTINT (Vwindow_system_version
, 3);
5473 DEFUN ("x-close-connection", Fx_close_connection
,
5474 Sx_close_connection
, 1, 1, 0,
5475 "Close the connection to DISPLAY's server.\n\
5476 For DISPLAY, specify either a frame or a display name (a string).\n\
5477 If DISPLAY is nil, that stands for the selected frame's display.")
5479 Lisp_Object display
;
5481 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
5482 struct w32_display_info
*tail
;
5485 if (dpyinfo
->reference_count
> 0)
5486 error ("Display still has frames on it");
5489 /* Free the fonts in the font table. */
5490 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
5492 if (dpyinfo
->font_table
[i
].name
)
5493 free (dpyinfo
->font_table
[i
].name
);
5494 /* Don't free the full_name string;
5495 it is always shared with something else. */
5496 w32_unload_font (dpyinfo
, dpyinfo
->font_table
[i
].font
);
5498 x_destroy_all_bitmaps (dpyinfo
);
5500 x_delete_display (dpyinfo
);
5506 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
5507 "Return the list of display names that Emacs has connections to.")
5510 Lisp_Object tail
, result
;
5513 for (tail
= w32_display_name_list
; ! NILP (tail
); tail
= XCONS (tail
)->cdr
)
5514 result
= Fcons (XCONS (XCONS (tail
)->car
)->car
, result
);
5519 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
5520 "If ON is non-nil, report errors as soon as the erring request is made.\n\
5521 If ON is nil, allow buffering of requests.\n\
5522 This is a noop on W32 systems.\n\
5523 The optional second argument DISPLAY specifies which display to act on.\n\
5524 DISPLAY should be either a frame or a display name (a string).\n\
5525 If DISPLAY is omitted or nil, that stands for the selected frame's display.")
5527 Lisp_Object display
, on
;
5529 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
5535 /* These are the w32 specialized functions */
5537 DEFUN ("w32-select-font", Fw32_select_font
, Sw32_select_font
, 0, 1, 0,
5538 "This will display the W32 font dialog and return an X font string corresponding to the selection.")
5542 FRAME_PTR f
= check_x_frame (frame
);
5547 bzero (&cf
, sizeof (cf
));
5549 cf
.lStructSize
= sizeof (cf
);
5550 cf
.hwndOwner
= FRAME_W32_WINDOW (f
);
5551 cf
.Flags
= CF_FIXEDPITCHONLY
| CF_FORCEFONTEXIST
| CF_SCREENFONTS
;
5554 if (!ChooseFont (&cf
) || !w32_to_x_font (&lf
, buf
, 100))
5557 return build_string (buf
);
5560 DEFUN ("w32-send-sys-command", Fw32_send_sys_command
, Sw32_send_sys_command
, 1, 2, 0,
5561 "Send frame a Windows WM_SYSCOMMAND message of type COMMAND.\n\
5562 Some useful values for command are 0xf030 to maximise frame (0xf020\n\
5563 to minimize), 0xf120 to restore frame to original size, and 0xf100\n\
5564 to activate the menubar for keyboard access. 0xf140 activates the\n\
5565 screen saver if defined.\n\
5567 If optional parameter FRAME is not specified, use selected frame.")
5569 Lisp_Object command
, frame
;
5572 FRAME_PTR f
= check_x_frame (frame
);
5574 CHECK_NUMBER (command
, 0);
5576 PostMessage (FRAME_W32_WINDOW (f
), WM_SYSCOMMAND
, XINT (command
), 0);
5584 /* This is zero if not using MS-Windows. */
5587 /* The section below is built by the lisp expression at the top of the file,
5588 just above where these variables are declared. */
5589 /*&&& init symbols here &&&*/
5590 Qauto_raise
= intern ("auto-raise");
5591 staticpro (&Qauto_raise
);
5592 Qauto_lower
= intern ("auto-lower");
5593 staticpro (&Qauto_lower
);
5594 Qbackground_color
= intern ("background-color");
5595 staticpro (&Qbackground_color
);
5596 Qbar
= intern ("bar");
5598 Qborder_color
= intern ("border-color");
5599 staticpro (&Qborder_color
);
5600 Qborder_width
= intern ("border-width");
5601 staticpro (&Qborder_width
);
5602 Qbox
= intern ("box");
5604 Qcursor_color
= intern ("cursor-color");
5605 staticpro (&Qcursor_color
);
5606 Qcursor_type
= intern ("cursor-type");
5607 staticpro (&Qcursor_type
);
5608 Qforeground_color
= intern ("foreground-color");
5609 staticpro (&Qforeground_color
);
5610 Qgeometry
= intern ("geometry");
5611 staticpro (&Qgeometry
);
5612 Qicon_left
= intern ("icon-left");
5613 staticpro (&Qicon_left
);
5614 Qicon_top
= intern ("icon-top");
5615 staticpro (&Qicon_top
);
5616 Qicon_type
= intern ("icon-type");
5617 staticpro (&Qicon_type
);
5618 Qicon_name
= intern ("icon-name");
5619 staticpro (&Qicon_name
);
5620 Qinternal_border_width
= intern ("internal-border-width");
5621 staticpro (&Qinternal_border_width
);
5622 Qleft
= intern ("left");
5624 Qright
= intern ("right");
5625 staticpro (&Qright
);
5626 Qmouse_color
= intern ("mouse-color");
5627 staticpro (&Qmouse_color
);
5628 Qnone
= intern ("none");
5630 Qparent_id
= intern ("parent-id");
5631 staticpro (&Qparent_id
);
5632 Qscroll_bar_width
= intern ("scroll-bar-width");
5633 staticpro (&Qscroll_bar_width
);
5634 Qsuppress_icon
= intern ("suppress-icon");
5635 staticpro (&Qsuppress_icon
);
5636 Qtop
= intern ("top");
5638 Qundefined_color
= intern ("undefined-color");
5639 staticpro (&Qundefined_color
);
5640 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
5641 staticpro (&Qvertical_scroll_bars
);
5642 Qvisibility
= intern ("visibility");
5643 staticpro (&Qvisibility
);
5644 Qwindow_id
= intern ("window-id");
5645 staticpro (&Qwindow_id
);
5646 Qx_frame_parameter
= intern ("x-frame-parameter");
5647 staticpro (&Qx_frame_parameter
);
5648 Qx_resource_name
= intern ("x-resource-name");
5649 staticpro (&Qx_resource_name
);
5650 Quser_position
= intern ("user-position");
5651 staticpro (&Quser_position
);
5652 Quser_size
= intern ("user-size");
5653 staticpro (&Quser_size
);
5654 Qdisplay
= intern ("display");
5655 staticpro (&Qdisplay
);
5656 /* This is the end of symbol initialization. */
5658 Qface_set_after_frame_default
= intern ("face-set-after-frame-default");
5659 staticpro (&Qface_set_after_frame_default
);
5661 Fput (Qundefined_color
, Qerror_conditions
,
5662 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
5663 Fput (Qundefined_color
, Qerror_message
,
5664 build_string ("Undefined color"));
5666 DEFVAR_LISP ("w32-color-map", &Vw32_color_map
,
5667 "A array of color name mappings for windows.");
5668 Vw32_color_map
= Qnil
;
5670 DEFVAR_LISP ("w32-pass-alt-to-system", &Vw32_pass_alt_to_system
,
5671 "Non-nil if alt key presses are passed on to Windows.\n\
5672 When non-nil, for example, alt pressed and released and then space will\n\
5673 open the System menu. When nil, Emacs silently swallows alt key events.");
5674 Vw32_pass_alt_to_system
= Qnil
;
5676 DEFVAR_LISP ("w32-alt-is-meta", &Vw32_alt_is_meta
,
5677 "Non-nil if the alt key is to be considered the same as the meta key.\n\
5678 When nil, Emacs will translate the alt key to the Alt modifier, and not Meta.");
5679 Vw32_alt_is_meta
= Qt
;
5681 DEFVAR_LISP ("w32-pass-optional-keys-to-system",
5682 &Vw32_pass_optional_keys_to_system
,
5683 "Non-nil if the 'optional' keys (left window, right window,\n\
5684 and application keys) are passed on to Windows.");
5685 Vw32_pass_optional_keys_to_system
= Qnil
;
5687 DEFVAR_LISP ("w32-enable-italics", &Vw32_enable_italics
,
5688 "Non-nil enables selection of artificially italicized fonts.");
5689 Vw32_enable_italics
= Qnil
;
5691 DEFVAR_LISP ("w32-enable-palette", &Vw32_enable_palette
,
5692 "Non-nil enables Windows palette management to map colors exactly.");
5693 Vw32_enable_palette
= Qt
;
5695 DEFVAR_INT ("w32-mouse-button-tolerance",
5696 &Vw32_mouse_button_tolerance
,
5697 "Analogue of double click interval for faking middle mouse events.\n\
5698 The value is the minimum time in milliseconds that must elapse between\n\
5699 left/right button down events before they are considered distinct events.\n\
5700 If both mouse buttons are depressed within this interval, a middle mouse\n\
5701 button down event is generated instead.");
5702 XSETINT (Vw32_mouse_button_tolerance
, GetDoubleClickTime () / 2);
5704 DEFVAR_INT ("w32-mouse-move-interval",
5705 &Vw32_mouse_move_interval
,
5706 "Minimum interval between mouse move events.\n\
5707 The value is the minimum time in milliseconds that must elapse between\n\
5708 successive mouse move (or scroll bar drag) events before they are\n\
5709 reported as lisp events.");
5710 XSETINT (Vw32_mouse_move_interval
, 50);
5712 init_x_parm_symbols ();
5714 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path
,
5715 "List of directories to search for bitmap files for w32.");
5716 Vx_bitmap_file_path
= decode_env_path ((char *) 0, "PATH");
5718 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
5719 "The shape of the pointer when over text.\n\
5720 Changing the value does not affect existing frames\n\
5721 unless you set the mouse color.");
5722 Vx_pointer_shape
= Qnil
;
5724 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
5725 "The name Emacs uses to look up resources; for internal use only.\n\
5726 `x-get-resource' uses this as the first component of the instance name\n\
5727 when requesting resource values.\n\
5728 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
5729 was invoked, or to the value specified with the `-name' or `-rn'\n\
5730 switches, if present.");
5731 Vx_resource_name
= Qnil
;
5733 Vx_nontext_pointer_shape
= Qnil
;
5735 Vx_mode_pointer_shape
= Qnil
;
5737 DEFVAR_INT ("x-sensitive-text-pointer-shape",
5738 &Vx_sensitive_text_pointer_shape
,
5739 "The shape of the pointer when over mouse-sensitive text.\n\
5740 This variable takes effect when you create a new frame\n\
5741 or when you set the mouse color.");
5742 Vx_sensitive_text_pointer_shape
= Qnil
;
5744 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
5745 "A string indicating the foreground color of the cursor box.");
5746 Vx_cursor_fore_pixel
= Qnil
;
5748 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
5749 "Non-nil if no window manager is in use.\n\
5750 Emacs doesn't try to figure this out; this is always nil\n\
5751 unless you set it to something else.");
5752 /* We don't have any way to find this out, so set it to nil
5753 and maybe the user would like to set it to t. */
5754 Vx_no_window_manager
= Qnil
;
5756 defsubr (&Sx_get_resource
);
5757 defsubr (&Sx_list_fonts
);
5758 defsubr (&Sx_display_color_p
);
5759 defsubr (&Sx_display_grayscale_p
);
5760 defsubr (&Sx_color_defined_p
);
5761 defsubr (&Sx_color_values
);
5762 defsubr (&Sx_server_max_request_size
);
5763 defsubr (&Sx_server_vendor
);
5764 defsubr (&Sx_server_version
);
5765 defsubr (&Sx_display_pixel_width
);
5766 defsubr (&Sx_display_pixel_height
);
5767 defsubr (&Sx_display_mm_width
);
5768 defsubr (&Sx_display_mm_height
);
5769 defsubr (&Sx_display_screens
);
5770 defsubr (&Sx_display_planes
);
5771 defsubr (&Sx_display_color_cells
);
5772 defsubr (&Sx_display_visual_class
);
5773 defsubr (&Sx_display_backing_store
);
5774 defsubr (&Sx_display_save_under
);
5775 defsubr (&Sx_parse_geometry
);
5776 defsubr (&Sx_create_frame
);
5777 defsubr (&Sx_open_connection
);
5778 defsubr (&Sx_close_connection
);
5779 defsubr (&Sx_display_list
);
5780 defsubr (&Sx_synchronize
);
5782 /* W32 specific functions */
5784 defsubr (&Sw32_focus_frame
);
5785 defsubr (&Sw32_select_font
);
5786 defsubr (&Sw32_define_rgb_color
);
5787 defsubr (&Sw32_default_color_map
);
5788 defsubr (&Sw32_load_color_file
);
5789 defsubr (&Sw32_send_sys_command
);
5798 button
= MessageBox (NULL
,
5799 "A fatal error has occurred!\n\n"
5800 "Select Abort to exit, Retry to debug, Ignore to continue",
5801 "Emacs Abort Dialog",
5802 MB_ICONEXCLAMATION
| MB_TASKMODAL
5803 | MB_SETFOREGROUND
| MB_ABORTRETRYIGNORE
);