1 /* Functions for the Win32 window system.
2 Copyright (C) 1989, 1992, 1993, 1994, 1995 Free Software Foundation.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
21 /* Added by Kevin Gallo */
32 #include "dispextern.h"
34 #include "blockinput.h"
37 #include "termhooks.h"
42 extern void free_frame_menubar ();
43 extern struct scroll_bar
*x_window_to_scroll_bar ();
46 /* The colormap for converting color names to RGB values */
47 Lisp_Object Vwin32_color_map
;
49 /* Non nil if alt key presses are passed on to Windows. */
50 Lisp_Object Vwin32_pass_alt_to_system
;
52 /* Non nil if left window, right window, and application key events
53 are passed on to Windows. */
54 Lisp_Object Vwin32_pass_optional_keys_to_system
;
56 /* Switch to control whether we inhibit requests for italicised fonts (which
57 are synthesized, look ugly, and are trashed by cursor movement under NT). */
58 Lisp_Object Vwin32_enable_italics
;
60 /* Enable palette management. */
61 Lisp_Object Vwin32_enable_palette
;
63 /* Control how close left/right button down events must be to
64 be converted to a middle button down event. */
65 Lisp_Object Vwin32_mouse_button_tolerance
;
67 /* The name we're using in resource queries. */
68 Lisp_Object Vx_resource_name
;
70 /* Non nil if no window manager is in use. */
71 Lisp_Object Vx_no_window_manager
;
73 /* The background and shape of the mouse pointer, and shape when not
74 over text or in the modeline. */
75 Lisp_Object Vx_pointer_shape
, Vx_nontext_pointer_shape
, Vx_mode_pointer_shape
;
76 /* The shape when over mouse-sensitive text. */
77 Lisp_Object Vx_sensitive_text_pointer_shape
;
79 /* Color of chars displayed in cursor box. */
80 Lisp_Object Vx_cursor_fore_pixel
;
82 /* Search path for bitmap files. */
83 Lisp_Object Vx_bitmap_file_path
;
85 /* Evaluate this expression to rebuild the section of syms_of_w32fns
86 that initializes and staticpros the symbols declared below. Note
87 that Emacs 18 has a bug that keeps C-x C-e from being able to
88 evaluate this expression.
91 ;; Accumulate a list of the symbols we want to initialize from the
92 ;; declarations at the top of the file.
93 (goto-char (point-min))
94 (search-forward "/\*&&& symbols declared here &&&*\/\n")
96 (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)")
98 (cons (buffer-substring (match-beginning 1) (match-end 1))
101 (setq symbol-list (nreverse symbol-list))
102 ;; Delete the section of syms_of_... where we initialize the symbols.
103 (search-forward "\n /\*&&& init symbols here &&&*\/\n")
104 (let ((start (point)))
105 (while (looking-at "^ Q")
107 (kill-region start (point)))
108 ;; Write a new symbol initialization section.
110 (insert (format " %s = intern (\"" (car symbol-list)))
111 (let ((start (point)))
112 (insert (substring (car symbol-list) 1))
113 (subst-char-in-region start (point) ?_ ?-))
114 (insert (format "\");\n staticpro (&%s);\n" (car symbol-list)))
115 (setq symbol-list (cdr symbol-list)))))
119 /*&&& symbols declared here &&&*/
120 Lisp_Object Qauto_raise
;
121 Lisp_Object Qauto_lower
;
122 Lisp_Object Qbackground_color
;
124 Lisp_Object Qborder_color
;
125 Lisp_Object Qborder_width
;
127 Lisp_Object Qcursor_color
;
128 Lisp_Object Qcursor_type
;
130 Lisp_Object Qforeground_color
;
131 Lisp_Object Qgeometry
;
132 Lisp_Object Qicon_left
;
133 Lisp_Object Qicon_top
;
134 Lisp_Object Qicon_type
;
135 Lisp_Object Qicon_name
;
136 Lisp_Object Qinternal_border_width
;
138 Lisp_Object Qmouse_color
;
140 Lisp_Object Qparent_id
;
141 Lisp_Object Qscroll_bar_width
;
142 Lisp_Object Qsuppress_icon
;
144 Lisp_Object Qundefined_color
;
145 Lisp_Object Qvertical_scroll_bars
;
146 Lisp_Object Qvisibility
;
147 Lisp_Object Qwindow_id
;
148 Lisp_Object Qx_frame_parameter
;
149 Lisp_Object Qx_resource_name
;
150 Lisp_Object Quser_position
;
151 Lisp_Object Quser_size
;
152 Lisp_Object Qdisplay
;
154 /* State variables for emulating a three button mouse. */
159 static int button_state
= 0;
160 static Win32Msg saved_mouse_msg
;
161 static unsigned timer_id
; /* non-zero when timer is active */
163 /* The below are defined in frame.c. */
164 extern Lisp_Object Qheight
, Qminibuffer
, Qname
, Qonly
, Qwidth
;
165 extern Lisp_Object Qunsplittable
, Qmenu_bar_lines
;
167 extern Lisp_Object Vwindow_system_version
;
169 extern Lisp_Object last_mouse_scroll_bar
;
170 extern int last_mouse_scroll_bar_pos
;
172 /* From win32term.c. */
173 extern Lisp_Object Vwin32_num_mouse_buttons
;
175 Time last_mouse_movement_time
;
178 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
179 and checking validity for Win32. */
182 check_x_frame (frame
)
191 CHECK_LIVE_FRAME (frame
, 0);
194 if (! FRAME_WIN32_P (f
))
195 error ("non-win32 frame used");
199 /* Let the user specify an display with a frame.
200 nil stands for the selected frame--or, if that is not a win32 frame,
201 the first display on the list. */
203 static struct win32_display_info
*
204 check_x_display_info (frame
)
209 if (FRAME_WIN32_P (selected_frame
))
210 return FRAME_WIN32_DISPLAY_INFO (selected_frame
);
212 return &one_win32_display_info
;
214 else if (STRINGP (frame
))
215 return x_display_info_for_name (frame
);
220 CHECK_LIVE_FRAME (frame
, 0);
222 if (! FRAME_WIN32_P (f
))
223 error ("non-win32 frame used");
224 return FRAME_WIN32_DISPLAY_INFO (f
);
228 /* Return the Emacs frame-object corresponding to an win32 window.
229 It could be the frame's main window or an icon window. */
231 /* This function can be called during GC, so use GC_xxx type test macros. */
234 x_window_to_frame (dpyinfo
, wdesc
)
235 struct win32_display_info
*dpyinfo
;
238 Lisp_Object tail
, frame
;
241 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
243 frame
= XCONS (tail
)->car
;
244 if (!GC_FRAMEP (frame
))
247 if (f
->output_data
.nothing
== 1
248 || FRAME_WIN32_DISPLAY_INFO (f
) != dpyinfo
)
250 if (FRAME_WIN32_WINDOW (f
) == wdesc
)
258 /* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
259 id, which is just an int that this section returns. Bitmaps are
260 reference counted so they can be shared among frames.
262 Bitmap indices are guaranteed to be > 0, so a negative number can
263 be used to indicate no bitmap.
265 If you use x_create_bitmap_from_data, then you must keep track of
266 the bitmaps yourself. That is, creating a bitmap from the same
267 data more than once will not be caught. */
270 /* Functions to access the contents of a bitmap, given an id. */
273 x_bitmap_height (f
, id
)
277 return FRAME_WIN32_DISPLAY_INFO (f
)->bitmaps
[id
- 1].height
;
281 x_bitmap_width (f
, id
)
285 return FRAME_WIN32_DISPLAY_INFO (f
)->bitmaps
[id
- 1].width
;
289 x_bitmap_pixmap (f
, id
)
293 return (int) FRAME_WIN32_DISPLAY_INFO (f
)->bitmaps
[id
- 1].pixmap
;
297 /* Allocate a new bitmap record. Returns index of new record. */
300 x_allocate_bitmap_record (f
)
303 struct win32_display_info
*dpyinfo
= FRAME_WIN32_DISPLAY_INFO (f
);
306 if (dpyinfo
->bitmaps
== NULL
)
308 dpyinfo
->bitmaps_size
= 10;
310 = (struct win32_bitmap_record
*) xmalloc (dpyinfo
->bitmaps_size
* sizeof (struct win32_bitmap_record
));
311 dpyinfo
->bitmaps_last
= 1;
315 if (dpyinfo
->bitmaps_last
< dpyinfo
->bitmaps_size
)
316 return ++dpyinfo
->bitmaps_last
;
318 for (i
= 0; i
< dpyinfo
->bitmaps_size
; ++i
)
319 if (dpyinfo
->bitmaps
[i
].refcount
== 0)
322 dpyinfo
->bitmaps_size
*= 2;
324 = (struct win32_bitmap_record
*) xrealloc (dpyinfo
->bitmaps
,
325 dpyinfo
->bitmaps_size
* sizeof (struct win32_bitmap_record
));
326 return ++dpyinfo
->bitmaps_last
;
329 /* Add one reference to the reference count of the bitmap with id ID. */
332 x_reference_bitmap (f
, id
)
336 ++FRAME_WIN32_DISPLAY_INFO (f
)->bitmaps
[id
- 1].refcount
;
339 /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
342 x_create_bitmap_from_data (f
, bits
, width
, height
)
345 unsigned int width
, height
;
347 struct win32_display_info
*dpyinfo
= FRAME_WIN32_DISPLAY_INFO (f
);
351 bitmap
= CreateBitmap (width
, height
,
352 FRAME_WIN32_DISPLAY_INFO (XFRAME (frame
))->n_planes
,
353 FRAME_WIN32_DISPLAY_INFO (XFRAME (frame
))->n_cbits
,
359 id
= x_allocate_bitmap_record (f
);
360 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
361 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
362 dpyinfo
->bitmaps
[id
- 1].hinst
= NULL
;
363 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
364 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
365 dpyinfo
->bitmaps
[id
- 1].height
= height
;
366 dpyinfo
->bitmaps
[id
- 1].width
= width
;
371 /* Create bitmap from file FILE for frame F. */
374 x_create_bitmap_from_file (f
, file
)
380 struct win32_display_info
*dpyinfo
= FRAME_WIN32_DISPLAY_INFO (f
);
381 unsigned int width
, height
;
383 int xhot
, yhot
, result
, id
;
389 /* Look for an existing bitmap with the same name. */
390 for (id
= 0; id
< dpyinfo
->bitmaps_last
; ++id
)
392 if (dpyinfo
->bitmaps
[id
].refcount
393 && dpyinfo
->bitmaps
[id
].file
394 && !strcmp (dpyinfo
->bitmaps
[id
].file
, (char *) XSTRING (file
)->data
))
396 ++dpyinfo
->bitmaps
[id
].refcount
;
401 /* Search bitmap-file-path for the file, if appropriate. */
402 fd
= openp (Vx_bitmap_file_path
, file
, "", &found
, 0);
407 filename
= (char *) XSTRING (found
)->data
;
409 hinst
= LoadLibraryEx (filename
, NULL
, LOAD_LIBRARY_AS_DATAFILE
);
415 result
= XReadBitmapFile (FRAME_WIN32_DISPLAY (f
), FRAME_WIN32_WINDOW (f
),
416 filename
, &width
, &height
, &bitmap
, &xhot
, &yhot
);
417 if (result
!= BitmapSuccess
)
420 id
= x_allocate_bitmap_record (f
);
421 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
422 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
423 dpyinfo
->bitmaps
[id
- 1].file
= (char *) xmalloc (XSTRING (file
)->size
+ 1);
424 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
425 dpyinfo
->bitmaps
[id
- 1].height
= height
;
426 dpyinfo
->bitmaps
[id
- 1].width
= width
;
427 strcpy (dpyinfo
->bitmaps
[id
- 1].file
, XSTRING (file
)->data
);
433 /* Remove reference to bitmap with id number ID. */
436 x_destroy_bitmap (f
, id
)
440 struct win32_display_info
*dpyinfo
= FRAME_WIN32_DISPLAY_INFO (f
);
444 --dpyinfo
->bitmaps
[id
- 1].refcount
;
445 if (dpyinfo
->bitmaps
[id
- 1].refcount
== 0)
448 DeleteObject (dpyinfo
->bitmaps
[id
- 1].pixmap
);
449 if (dpyinfo
->bitmaps
[id
- 1].file
)
451 free (dpyinfo
->bitmaps
[id
- 1].file
);
452 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
459 /* Free all the bitmaps for the display specified by DPYINFO. */
462 x_destroy_all_bitmaps (dpyinfo
)
463 struct win32_display_info
*dpyinfo
;
466 for (i
= 0; i
< dpyinfo
->bitmaps_last
; i
++)
467 if (dpyinfo
->bitmaps
[i
].refcount
> 0)
469 DeleteObject (dpyinfo
->bitmaps
[i
].pixmap
);
470 if (dpyinfo
->bitmaps
[i
].file
)
471 free (dpyinfo
->bitmaps
[i
].file
);
473 dpyinfo
->bitmaps_last
= 0;
476 /* Connect the frame-parameter names for Win32 frames
477 to the ways of passing the parameter values to the window system.
479 The name of a parameter, as a Lisp symbol,
480 has an `x-frame-parameter' property which is an integer in Lisp
481 but can be interpreted as an `enum x_frame_parm' in C. */
485 X_PARM_FOREGROUND_COLOR
,
486 X_PARM_BACKGROUND_COLOR
,
493 X_PARM_INTERNAL_BORDER_WIDTH
,
497 X_PARM_VERT_SCROLL_BAR
,
499 X_PARM_MENU_BAR_LINES
503 struct x_frame_parm_table
506 void (*setter
)( /* struct frame *frame, Lisp_Object val, oldval */ );
509 void x_set_foreground_color ();
510 void x_set_background_color ();
511 void x_set_mouse_color ();
512 void x_set_cursor_color ();
513 void x_set_border_color ();
514 void x_set_cursor_type ();
515 void x_set_icon_type ();
516 void x_set_icon_name ();
518 void x_set_border_width ();
519 void x_set_internal_border_width ();
520 void x_explicitly_set_name ();
521 void x_set_autoraise ();
522 void x_set_autolower ();
523 void x_set_vertical_scroll_bars ();
524 void x_set_visibility ();
525 void x_set_menu_bar_lines ();
526 void x_set_scroll_bar_width ();
527 void x_set_unsplittable ();
529 static struct x_frame_parm_table x_frame_parms
[] =
531 "foreground-color", x_set_foreground_color
,
532 "background-color", x_set_background_color
,
533 "mouse-color", x_set_mouse_color
,
534 "cursor-color", x_set_cursor_color
,
535 "border-color", x_set_border_color
,
536 "cursor-type", x_set_cursor_type
,
537 "icon-type", x_set_icon_type
,
538 "icon-name", x_set_icon_name
,
540 "border-width", x_set_border_width
,
541 "internal-border-width", x_set_internal_border_width
,
542 "name", x_explicitly_set_name
,
543 "auto-raise", x_set_autoraise
,
544 "auto-lower", x_set_autolower
,
545 "vertical-scroll-bars", x_set_vertical_scroll_bars
,
546 "visibility", x_set_visibility
,
547 "menu-bar-lines", x_set_menu_bar_lines
,
548 "scroll-bar-width", x_set_scroll_bar_width
,
549 "unsplittable", x_set_unsplittable
,
552 /* Attach the `x-frame-parameter' properties to
553 the Lisp symbol names of parameters relevant to Win32. */
555 init_x_parm_symbols ()
559 for (i
= 0; i
< sizeof (x_frame_parms
) / sizeof (x_frame_parms
[0]); i
++)
560 Fput (intern (x_frame_parms
[i
].name
), Qx_frame_parameter
,
564 /* Change the parameters of FRAME as specified by ALIST.
565 If a parameter is not specially recognized, do nothing;
566 otherwise call the `x_set_...' function for that parameter. */
569 x_set_frame_parameters (f
, alist
)
575 /* If both of these parameters are present, it's more efficient to
576 set them both at once. So we wait until we've looked at the
577 entire list before we set them. */
578 Lisp_Object width
, height
;
581 Lisp_Object left
, top
;
583 /* Same with these. */
584 Lisp_Object icon_left
, icon_top
;
586 /* Record in these vectors all the parms specified. */
590 int left_no_change
= 0, top_no_change
= 0;
591 int icon_left_no_change
= 0, icon_top_no_change
= 0;
594 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
597 parms
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
598 values
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
600 /* Extract parm names and values into those vectors. */
603 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
605 Lisp_Object elt
, prop
, val
;
608 parms
[i
] = Fcar (elt
);
609 values
[i
] = Fcdr (elt
);
613 width
= height
= top
= left
= Qunbound
;
614 icon_left
= icon_top
= Qunbound
;
616 /* Now process them in reverse of specified order. */
617 for (i
--; i
>= 0; i
--)
619 Lisp_Object prop
, val
;
624 if (EQ (prop
, Qwidth
))
626 else if (EQ (prop
, Qheight
))
628 else if (EQ (prop
, Qtop
))
630 else if (EQ (prop
, Qleft
))
632 else if (EQ (prop
, Qicon_top
))
634 else if (EQ (prop
, Qicon_left
))
638 register Lisp_Object param_index
, old_value
;
640 param_index
= Fget (prop
, Qx_frame_parameter
);
641 old_value
= get_frame_param (f
, prop
);
642 store_frame_param (f
, prop
, val
);
643 if (NATNUMP (param_index
)
644 && (XFASTINT (param_index
)
645 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
646 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
650 /* Don't die if just one of these was set. */
651 if (EQ (left
, Qunbound
))
654 if (f
->output_data
.win32
->left_pos
< 0)
655 left
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.win32
->left_pos
), Qnil
));
657 XSETINT (left
, f
->output_data
.win32
->left_pos
);
659 if (EQ (top
, Qunbound
))
662 if (f
->output_data
.win32
->top_pos
< 0)
663 top
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.win32
->top_pos
), Qnil
));
665 XSETINT (top
, f
->output_data
.win32
->top_pos
);
668 /* If one of the icon positions was not set, preserve or default it. */
669 if (EQ (icon_left
, Qunbound
) || ! INTEGERP (icon_left
))
671 icon_left_no_change
= 1;
672 icon_left
= Fcdr (Fassq (Qicon_left
, f
->param_alist
));
673 if (NILP (icon_left
))
674 XSETINT (icon_left
, 0);
676 if (EQ (icon_top
, Qunbound
) || ! INTEGERP (icon_top
))
678 icon_top_no_change
= 1;
679 icon_top
= Fcdr (Fassq (Qicon_top
, f
->param_alist
));
681 XSETINT (icon_top
, 0);
684 /* Don't die if just one of these was set. */
685 if (EQ (width
, Qunbound
))
686 XSETINT (width
, FRAME_WIDTH (f
));
687 if (EQ (height
, Qunbound
))
688 XSETINT (height
, FRAME_HEIGHT (f
));
690 /* Don't set these parameters unless they've been explicitly
691 specified. The window might be mapped or resized while we're in
692 this function, and we don't want to override that unless the lisp
693 code has asked for it.
695 Don't set these parameters unless they actually differ from the
696 window's current parameters; the window may not actually exist
701 check_frame_size (f
, &height
, &width
);
703 XSETFRAME (frame
, f
);
705 if ((NUMBERP (width
) && XINT (width
) != FRAME_WIDTH (f
))
706 || (NUMBERP (height
) && XINT (height
) != FRAME_HEIGHT (f
)))
707 Fset_frame_size (frame
, width
, height
);
709 if ((!NILP (left
) || !NILP (top
))
710 && ! (left_no_change
&& top_no_change
)
711 && ! (NUMBERP (left
) && XINT (left
) == f
->output_data
.win32
->left_pos
712 && NUMBERP (top
) && XINT (top
) == f
->output_data
.win32
->top_pos
))
717 /* Record the signs. */
718 f
->output_data
.win32
->size_hint_flags
&= ~ (XNegative
| YNegative
);
719 if (EQ (left
, Qminus
))
720 f
->output_data
.win32
->size_hint_flags
|= XNegative
;
721 else if (INTEGERP (left
))
723 leftpos
= XINT (left
);
725 f
->output_data
.win32
->size_hint_flags
|= XNegative
;
727 else if (CONSP (left
) && EQ (XCONS (left
)->car
, Qminus
)
728 && CONSP (XCONS (left
)->cdr
)
729 && INTEGERP (XCONS (XCONS (left
)->cdr
)->car
))
731 leftpos
= - XINT (XCONS (XCONS (left
)->cdr
)->car
);
732 f
->output_data
.win32
->size_hint_flags
|= XNegative
;
734 else if (CONSP (left
) && EQ (XCONS (left
)->car
, Qplus
)
735 && CONSP (XCONS (left
)->cdr
)
736 && INTEGERP (XCONS (XCONS (left
)->cdr
)->car
))
738 leftpos
= XINT (XCONS (XCONS (left
)->cdr
)->car
);
741 if (EQ (top
, Qminus
))
742 f
->output_data
.win32
->size_hint_flags
|= YNegative
;
743 else if (INTEGERP (top
))
747 f
->output_data
.win32
->size_hint_flags
|= YNegative
;
749 else if (CONSP (top
) && EQ (XCONS (top
)->car
, Qminus
)
750 && CONSP (XCONS (top
)->cdr
)
751 && INTEGERP (XCONS (XCONS (top
)->cdr
)->car
))
753 toppos
= - XINT (XCONS (XCONS (top
)->cdr
)->car
);
754 f
->output_data
.win32
->size_hint_flags
|= YNegative
;
756 else if (CONSP (top
) && EQ (XCONS (top
)->car
, Qplus
)
757 && CONSP (XCONS (top
)->cdr
)
758 && INTEGERP (XCONS (XCONS (top
)->cdr
)->car
))
760 toppos
= XINT (XCONS (XCONS (top
)->cdr
)->car
);
764 /* Store the numeric value of the position. */
765 f
->output_data
.win32
->top_pos
= toppos
;
766 f
->output_data
.win32
->left_pos
= leftpos
;
768 f
->output_data
.win32
->win_gravity
= NorthWestGravity
;
770 /* Actually set that position, and convert to absolute. */
771 x_set_offset (f
, leftpos
, toppos
, -1);
774 if ((!NILP (icon_left
) || !NILP (icon_top
))
775 && ! (icon_left_no_change
&& icon_top_no_change
))
776 x_wm_set_icon_position (f
, XINT (icon_left
), XINT (icon_top
));
780 /* Store the screen positions of frame F into XPTR and YPTR.
781 These are the positions of the containing window manager window,
782 not Emacs's own window. */
785 x_real_positions (f
, xptr
, yptr
)
794 GetClientRect(FRAME_WIN32_WINDOW(f
), &rect
);
795 AdjustWindowRect(&rect
, f
->output_data
.win32
->dwStyle
, FRAME_EXTERNAL_MENU_BAR(f
));
801 ClientToScreen (FRAME_WIN32_WINDOW(f
), &pt
);
807 /* Insert a description of internally-recorded parameters of frame X
808 into the parameter alist *ALISTPTR that is to be given to the user.
809 Only parameters that are specific to Win32
810 and whose values are not correctly recorded in the frame's
811 param_alist need to be considered here. */
813 x_report_frame_params (f
, alistptr
)
815 Lisp_Object
*alistptr
;
820 /* Represent negative positions (off the top or left screen edge)
821 in a way that Fmodify_frame_parameters will understand correctly. */
822 XSETINT (tem
, f
->output_data
.win32
->left_pos
);
823 if (f
->output_data
.win32
->left_pos
>= 0)
824 store_in_alist (alistptr
, Qleft
, tem
);
826 store_in_alist (alistptr
, Qleft
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
828 XSETINT (tem
, f
->output_data
.win32
->top_pos
);
829 if (f
->output_data
.win32
->top_pos
>= 0)
830 store_in_alist (alistptr
, Qtop
, tem
);
832 store_in_alist (alistptr
, Qtop
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
834 store_in_alist (alistptr
, Qborder_width
,
835 make_number (f
->output_data
.win32
->border_width
));
836 store_in_alist (alistptr
, Qinternal_border_width
,
837 make_number (f
->output_data
.win32
->internal_border_width
));
838 sprintf (buf
, "%ld", (long) FRAME_WIN32_WINDOW (f
));
839 store_in_alist (alistptr
, Qwindow_id
,
841 store_in_alist (alistptr
, Qicon_name
, f
->icon_name
);
842 FRAME_SAMPLE_VISIBILITY (f
);
843 store_in_alist (alistptr
, Qvisibility
,
844 (FRAME_VISIBLE_P (f
) ? Qt
845 : FRAME_ICONIFIED_P (f
) ? Qicon
: Qnil
));
846 store_in_alist (alistptr
, Qdisplay
,
847 XCONS (FRAME_WIN32_DISPLAY_INFO (f
)->name_list_element
)->car
);
851 DEFUN ("win32-define-rgb-color", Fwin32_define_rgb_color
, Swin32_define_rgb_color
, 4, 4, 0,
852 "Convert RGB numbers to a windows color reference and associate with NAME (a string).\n\
853 This adds or updates a named color to win32-color-map, making it available for use.\n\
854 The original entry's RGB ref is returned, or nil if the entry is new.")
855 (red
, green
, blue
, name
)
856 Lisp_Object red
, green
, blue
, name
;
859 Lisp_Object oldrgb
= Qnil
;
862 CHECK_NUMBER (red
, 0);
863 CHECK_NUMBER (green
, 0);
864 CHECK_NUMBER (blue
, 0);
865 CHECK_STRING (name
, 0);
867 XSET (rgb
, Lisp_Int
, RGB(XUINT (red
), XUINT (green
), XUINT (blue
)));
871 /* replace existing entry in win32-color-map or add new entry. */
872 entry
= Fassoc (name
, Vwin32_color_map
);
875 entry
= Fcons (name
, rgb
);
876 Vwin32_color_map
= Fcons (entry
, Vwin32_color_map
);
880 oldrgb
= Fcdr (entry
);
881 Fsetcdr (entry
, rgb
);
889 DEFUN ("win32-load-color-file", Fwin32_load_color_file
, Swin32_load_color_file
, 1, 1, 0,
890 "Create an alist of color entries from an external file (ie. rgb.txt).\n\
891 Assign this value to win32-color-map to replace the existing color map.\n\
893 The file should define one named RGB color per line like so:\
895 where R,G,B are numbers between 0 and 255 and name is an arbitrary string.")
897 Lisp_Object filename
;
900 Lisp_Object cmap
= Qnil
;
903 CHECK_STRING (filename
, 0);
904 abspath
= Fexpand_file_name (filename
, Qnil
);
906 fp
= fopen (XSTRING (filename
)->data
, "rt");
910 int red
, green
, blue
;
915 while (fgets (buf
, sizeof (buf
), fp
) != NULL
) {
916 if (sscanf (buf
, "%u %u %u %n", &red
, &green
, &blue
, &num
) == 3)
918 char *name
= buf
+ num
;
919 num
= strlen (name
) - 1;
920 if (name
[num
] == '\n')
922 cmap
= Fcons (Fcons (build_string (name
),
923 make_number (RGB (red
, green
, blue
))),
935 /* The default colors for the win32 color map */
936 typedef struct colormap_t
942 colormap_t win32_color_map
[] =
944 {"snow" , PALETTERGB (255,250,250)},
945 {"ghost white" , PALETTERGB (248,248,255)},
946 {"GhostWhite" , PALETTERGB (248,248,255)},
947 {"white smoke" , PALETTERGB (245,245,245)},
948 {"WhiteSmoke" , PALETTERGB (245,245,245)},
949 {"gainsboro" , PALETTERGB (220,220,220)},
950 {"floral white" , PALETTERGB (255,250,240)},
951 {"FloralWhite" , PALETTERGB (255,250,240)},
952 {"old lace" , PALETTERGB (253,245,230)},
953 {"OldLace" , PALETTERGB (253,245,230)},
954 {"linen" , PALETTERGB (250,240,230)},
955 {"antique white" , PALETTERGB (250,235,215)},
956 {"AntiqueWhite" , PALETTERGB (250,235,215)},
957 {"papaya whip" , PALETTERGB (255,239,213)},
958 {"PapayaWhip" , PALETTERGB (255,239,213)},
959 {"blanched almond" , PALETTERGB (255,235,205)},
960 {"BlanchedAlmond" , PALETTERGB (255,235,205)},
961 {"bisque" , PALETTERGB (255,228,196)},
962 {"peach puff" , PALETTERGB (255,218,185)},
963 {"PeachPuff" , PALETTERGB (255,218,185)},
964 {"navajo white" , PALETTERGB (255,222,173)},
965 {"NavajoWhite" , PALETTERGB (255,222,173)},
966 {"moccasin" , PALETTERGB (255,228,181)},
967 {"cornsilk" , PALETTERGB (255,248,220)},
968 {"ivory" , PALETTERGB (255,255,240)},
969 {"lemon chiffon" , PALETTERGB (255,250,205)},
970 {"LemonChiffon" , PALETTERGB (255,250,205)},
971 {"seashell" , PALETTERGB (255,245,238)},
972 {"honeydew" , PALETTERGB (240,255,240)},
973 {"mint cream" , PALETTERGB (245,255,250)},
974 {"MintCream" , PALETTERGB (245,255,250)},
975 {"azure" , PALETTERGB (240,255,255)},
976 {"alice blue" , PALETTERGB (240,248,255)},
977 {"AliceBlue" , PALETTERGB (240,248,255)},
978 {"lavender" , PALETTERGB (230,230,250)},
979 {"lavender blush" , PALETTERGB (255,240,245)},
980 {"LavenderBlush" , PALETTERGB (255,240,245)},
981 {"misty rose" , PALETTERGB (255,228,225)},
982 {"MistyRose" , PALETTERGB (255,228,225)},
983 {"white" , PALETTERGB (255,255,255)},
984 {"black" , PALETTERGB ( 0, 0, 0)},
985 {"dark slate gray" , PALETTERGB ( 47, 79, 79)},
986 {"DarkSlateGray" , PALETTERGB ( 47, 79, 79)},
987 {"dark slate grey" , PALETTERGB ( 47, 79, 79)},
988 {"DarkSlateGrey" , PALETTERGB ( 47, 79, 79)},
989 {"dim gray" , PALETTERGB (105,105,105)},
990 {"DimGray" , PALETTERGB (105,105,105)},
991 {"dim grey" , PALETTERGB (105,105,105)},
992 {"DimGrey" , PALETTERGB (105,105,105)},
993 {"slate gray" , PALETTERGB (112,128,144)},
994 {"SlateGray" , PALETTERGB (112,128,144)},
995 {"slate grey" , PALETTERGB (112,128,144)},
996 {"SlateGrey" , PALETTERGB (112,128,144)},
997 {"light slate gray" , PALETTERGB (119,136,153)},
998 {"LightSlateGray" , PALETTERGB (119,136,153)},
999 {"light slate grey" , PALETTERGB (119,136,153)},
1000 {"LightSlateGrey" , PALETTERGB (119,136,153)},
1001 {"gray" , PALETTERGB (190,190,190)},
1002 {"grey" , PALETTERGB (190,190,190)},
1003 {"light grey" , PALETTERGB (211,211,211)},
1004 {"LightGrey" , PALETTERGB (211,211,211)},
1005 {"light gray" , PALETTERGB (211,211,211)},
1006 {"LightGray" , PALETTERGB (211,211,211)},
1007 {"midnight blue" , PALETTERGB ( 25, 25,112)},
1008 {"MidnightBlue" , PALETTERGB ( 25, 25,112)},
1009 {"navy" , PALETTERGB ( 0, 0,128)},
1010 {"navy blue" , PALETTERGB ( 0, 0,128)},
1011 {"NavyBlue" , PALETTERGB ( 0, 0,128)},
1012 {"cornflower blue" , PALETTERGB (100,149,237)},
1013 {"CornflowerBlue" , PALETTERGB (100,149,237)},
1014 {"dark slate blue" , PALETTERGB ( 72, 61,139)},
1015 {"DarkSlateBlue" , PALETTERGB ( 72, 61,139)},
1016 {"slate blue" , PALETTERGB (106, 90,205)},
1017 {"SlateBlue" , PALETTERGB (106, 90,205)},
1018 {"medium slate blue" , PALETTERGB (123,104,238)},
1019 {"MediumSlateBlue" , PALETTERGB (123,104,238)},
1020 {"light slate blue" , PALETTERGB (132,112,255)},
1021 {"LightSlateBlue" , PALETTERGB (132,112,255)},
1022 {"medium blue" , PALETTERGB ( 0, 0,205)},
1023 {"MediumBlue" , PALETTERGB ( 0, 0,205)},
1024 {"royal blue" , PALETTERGB ( 65,105,225)},
1025 {"RoyalBlue" , PALETTERGB ( 65,105,225)},
1026 {"blue" , PALETTERGB ( 0, 0,255)},
1027 {"dodger blue" , PALETTERGB ( 30,144,255)},
1028 {"DodgerBlue" , PALETTERGB ( 30,144,255)},
1029 {"deep sky blue" , PALETTERGB ( 0,191,255)},
1030 {"DeepSkyBlue" , PALETTERGB ( 0,191,255)},
1031 {"sky blue" , PALETTERGB (135,206,235)},
1032 {"SkyBlue" , PALETTERGB (135,206,235)},
1033 {"light sky blue" , PALETTERGB (135,206,250)},
1034 {"LightSkyBlue" , PALETTERGB (135,206,250)},
1035 {"steel blue" , PALETTERGB ( 70,130,180)},
1036 {"SteelBlue" , PALETTERGB ( 70,130,180)},
1037 {"light steel blue" , PALETTERGB (176,196,222)},
1038 {"LightSteelBlue" , PALETTERGB (176,196,222)},
1039 {"light blue" , PALETTERGB (173,216,230)},
1040 {"LightBlue" , PALETTERGB (173,216,230)},
1041 {"powder blue" , PALETTERGB (176,224,230)},
1042 {"PowderBlue" , PALETTERGB (176,224,230)},
1043 {"pale turquoise" , PALETTERGB (175,238,238)},
1044 {"PaleTurquoise" , PALETTERGB (175,238,238)},
1045 {"dark turquoise" , PALETTERGB ( 0,206,209)},
1046 {"DarkTurquoise" , PALETTERGB ( 0,206,209)},
1047 {"medium turquoise" , PALETTERGB ( 72,209,204)},
1048 {"MediumTurquoise" , PALETTERGB ( 72,209,204)},
1049 {"turquoise" , PALETTERGB ( 64,224,208)},
1050 {"cyan" , PALETTERGB ( 0,255,255)},
1051 {"light cyan" , PALETTERGB (224,255,255)},
1052 {"LightCyan" , PALETTERGB (224,255,255)},
1053 {"cadet blue" , PALETTERGB ( 95,158,160)},
1054 {"CadetBlue" , PALETTERGB ( 95,158,160)},
1055 {"medium aquamarine" , PALETTERGB (102,205,170)},
1056 {"MediumAquamarine" , PALETTERGB (102,205,170)},
1057 {"aquamarine" , PALETTERGB (127,255,212)},
1058 {"dark green" , PALETTERGB ( 0,100, 0)},
1059 {"DarkGreen" , PALETTERGB ( 0,100, 0)},
1060 {"dark olive green" , PALETTERGB ( 85,107, 47)},
1061 {"DarkOliveGreen" , PALETTERGB ( 85,107, 47)},
1062 {"dark sea green" , PALETTERGB (143,188,143)},
1063 {"DarkSeaGreen" , PALETTERGB (143,188,143)},
1064 {"sea green" , PALETTERGB ( 46,139, 87)},
1065 {"SeaGreen" , PALETTERGB ( 46,139, 87)},
1066 {"medium sea green" , PALETTERGB ( 60,179,113)},
1067 {"MediumSeaGreen" , PALETTERGB ( 60,179,113)},
1068 {"light sea green" , PALETTERGB ( 32,178,170)},
1069 {"LightSeaGreen" , PALETTERGB ( 32,178,170)},
1070 {"pale green" , PALETTERGB (152,251,152)},
1071 {"PaleGreen" , PALETTERGB (152,251,152)},
1072 {"spring green" , PALETTERGB ( 0,255,127)},
1073 {"SpringGreen" , PALETTERGB ( 0,255,127)},
1074 {"lawn green" , PALETTERGB (124,252, 0)},
1075 {"LawnGreen" , PALETTERGB (124,252, 0)},
1076 {"green" , PALETTERGB ( 0,255, 0)},
1077 {"chartreuse" , PALETTERGB (127,255, 0)},
1078 {"medium spring green" , PALETTERGB ( 0,250,154)},
1079 {"MediumSpringGreen" , PALETTERGB ( 0,250,154)},
1080 {"green yellow" , PALETTERGB (173,255, 47)},
1081 {"GreenYellow" , PALETTERGB (173,255, 47)},
1082 {"lime green" , PALETTERGB ( 50,205, 50)},
1083 {"LimeGreen" , PALETTERGB ( 50,205, 50)},
1084 {"yellow green" , PALETTERGB (154,205, 50)},
1085 {"YellowGreen" , PALETTERGB (154,205, 50)},
1086 {"forest green" , PALETTERGB ( 34,139, 34)},
1087 {"ForestGreen" , PALETTERGB ( 34,139, 34)},
1088 {"olive drab" , PALETTERGB (107,142, 35)},
1089 {"OliveDrab" , PALETTERGB (107,142, 35)},
1090 {"dark khaki" , PALETTERGB (189,183,107)},
1091 {"DarkKhaki" , PALETTERGB (189,183,107)},
1092 {"khaki" , PALETTERGB (240,230,140)},
1093 {"pale goldenrod" , PALETTERGB (238,232,170)},
1094 {"PaleGoldenrod" , PALETTERGB (238,232,170)},
1095 {"light goldenrod yellow" , PALETTERGB (250,250,210)},
1096 {"LightGoldenrodYellow" , PALETTERGB (250,250,210)},
1097 {"light yellow" , PALETTERGB (255,255,224)},
1098 {"LightYellow" , PALETTERGB (255,255,224)},
1099 {"yellow" , PALETTERGB (255,255, 0)},
1100 {"gold" , PALETTERGB (255,215, 0)},
1101 {"light goldenrod" , PALETTERGB (238,221,130)},
1102 {"LightGoldenrod" , PALETTERGB (238,221,130)},
1103 {"goldenrod" , PALETTERGB (218,165, 32)},
1104 {"dark goldenrod" , PALETTERGB (184,134, 11)},
1105 {"DarkGoldenrod" , PALETTERGB (184,134, 11)},
1106 {"rosy brown" , PALETTERGB (188,143,143)},
1107 {"RosyBrown" , PALETTERGB (188,143,143)},
1108 {"indian red" , PALETTERGB (205, 92, 92)},
1109 {"IndianRed" , PALETTERGB (205, 92, 92)},
1110 {"saddle brown" , PALETTERGB (139, 69, 19)},
1111 {"SaddleBrown" , PALETTERGB (139, 69, 19)},
1112 {"sienna" , PALETTERGB (160, 82, 45)},
1113 {"peru" , PALETTERGB (205,133, 63)},
1114 {"burlywood" , PALETTERGB (222,184,135)},
1115 {"beige" , PALETTERGB (245,245,220)},
1116 {"wheat" , PALETTERGB (245,222,179)},
1117 {"sandy brown" , PALETTERGB (244,164, 96)},
1118 {"SandyBrown" , PALETTERGB (244,164, 96)},
1119 {"tan" , PALETTERGB (210,180,140)},
1120 {"chocolate" , PALETTERGB (210,105, 30)},
1121 {"firebrick" , PALETTERGB (178,34, 34)},
1122 {"brown" , PALETTERGB (165,42, 42)},
1123 {"dark salmon" , PALETTERGB (233,150,122)},
1124 {"DarkSalmon" , PALETTERGB (233,150,122)},
1125 {"salmon" , PALETTERGB (250,128,114)},
1126 {"light salmon" , PALETTERGB (255,160,122)},
1127 {"LightSalmon" , PALETTERGB (255,160,122)},
1128 {"orange" , PALETTERGB (255,165, 0)},
1129 {"dark orange" , PALETTERGB (255,140, 0)},
1130 {"DarkOrange" , PALETTERGB (255,140, 0)},
1131 {"coral" , PALETTERGB (255,127, 80)},
1132 {"light coral" , PALETTERGB (240,128,128)},
1133 {"LightCoral" , PALETTERGB (240,128,128)},
1134 {"tomato" , PALETTERGB (255, 99, 71)},
1135 {"orange red" , PALETTERGB (255, 69, 0)},
1136 {"OrangeRed" , PALETTERGB (255, 69, 0)},
1137 {"red" , PALETTERGB (255, 0, 0)},
1138 {"hot pink" , PALETTERGB (255,105,180)},
1139 {"HotPink" , PALETTERGB (255,105,180)},
1140 {"deep pink" , PALETTERGB (255, 20,147)},
1141 {"DeepPink" , PALETTERGB (255, 20,147)},
1142 {"pink" , PALETTERGB (255,192,203)},
1143 {"light pink" , PALETTERGB (255,182,193)},
1144 {"LightPink" , PALETTERGB (255,182,193)},
1145 {"pale violet red" , PALETTERGB (219,112,147)},
1146 {"PaleVioletRed" , PALETTERGB (219,112,147)},
1147 {"maroon" , PALETTERGB (176, 48, 96)},
1148 {"medium violet red" , PALETTERGB (199, 21,133)},
1149 {"MediumVioletRed" , PALETTERGB (199, 21,133)},
1150 {"violet red" , PALETTERGB (208, 32,144)},
1151 {"VioletRed" , PALETTERGB (208, 32,144)},
1152 {"magenta" , PALETTERGB (255, 0,255)},
1153 {"violet" , PALETTERGB (238,130,238)},
1154 {"plum" , PALETTERGB (221,160,221)},
1155 {"orchid" , PALETTERGB (218,112,214)},
1156 {"medium orchid" , PALETTERGB (186, 85,211)},
1157 {"MediumOrchid" , PALETTERGB (186, 85,211)},
1158 {"dark orchid" , PALETTERGB (153, 50,204)},
1159 {"DarkOrchid" , PALETTERGB (153, 50,204)},
1160 {"dark violet" , PALETTERGB (148, 0,211)},
1161 {"DarkViolet" , PALETTERGB (148, 0,211)},
1162 {"blue violet" , PALETTERGB (138, 43,226)},
1163 {"BlueViolet" , PALETTERGB (138, 43,226)},
1164 {"purple" , PALETTERGB (160, 32,240)},
1165 {"medium purple" , PALETTERGB (147,112,219)},
1166 {"MediumPurple" , PALETTERGB (147,112,219)},
1167 {"thistle" , PALETTERGB (216,191,216)},
1168 {"gray0" , PALETTERGB ( 0, 0, 0)},
1169 {"grey0" , PALETTERGB ( 0, 0, 0)},
1170 {"dark grey" , PALETTERGB (169,169,169)},
1171 {"DarkGrey" , PALETTERGB (169,169,169)},
1172 {"dark gray" , PALETTERGB (169,169,169)},
1173 {"DarkGray" , PALETTERGB (169,169,169)},
1174 {"dark blue" , PALETTERGB ( 0, 0,139)},
1175 {"DarkBlue" , PALETTERGB ( 0, 0,139)},
1176 {"dark cyan" , PALETTERGB ( 0,139,139)},
1177 {"DarkCyan" , PALETTERGB ( 0,139,139)},
1178 {"dark magenta" , PALETTERGB (139, 0,139)},
1179 {"DarkMagenta" , PALETTERGB (139, 0,139)},
1180 {"dark red" , PALETTERGB (139, 0, 0)},
1181 {"DarkRed" , PALETTERGB (139, 0, 0)},
1182 {"light green" , PALETTERGB (144,238,144)},
1183 {"LightGreen" , PALETTERGB (144,238,144)},
1186 DEFUN ("win32-default-color-map", Fwin32_default_color_map
, Swin32_default_color_map
,
1187 0, 0, 0, "Return the default color map.")
1191 colormap_t
*pc
= win32_color_map
;
1198 for (i
= 0; i
< sizeof (win32_color_map
) / sizeof (win32_color_map
[0]);
1200 cmap
= Fcons (Fcons (build_string (pc
->name
),
1201 make_number (pc
->colorref
)),
1210 win32_to_x_color (rgb
)
1215 CHECK_NUMBER (rgb
, 0);
1219 color
= Frassq (rgb
, Vwin32_color_map
);
1224 return (Fcar (color
));
1230 x_to_win32_color (colorname
)
1233 register Lisp_Object tail
, ret
= Qnil
;
1237 for (tail
= Vwin32_color_map
; !NILP (tail
); tail
= Fcdr (tail
))
1239 register Lisp_Object elt
, tem
;
1242 if (!CONSP (elt
)) continue;
1246 if (lstrcmpi (XSTRING (tem
)->data
, colorname
) == 0)
1248 ret
= XUINT(Fcdr (elt
));
1262 win32_regenerate_palette (FRAME_PTR f
)
1264 struct win32_palette_entry
* list
;
1265 LOGPALETTE
* log_palette
;
1266 HPALETTE new_palette
;
1269 /* don't bother trying to create palette if not supported */
1270 if (! FRAME_WIN32_DISPLAY_INFO (f
)->has_palette
)
1273 log_palette
= (LOGPALETTE
*)
1274 alloca (sizeof (LOGPALETTE
) +
1275 FRAME_WIN32_DISPLAY_INFO (f
)->num_colors
* sizeof (PALETTEENTRY
));
1276 log_palette
->palVersion
= 0x300;
1277 log_palette
->palNumEntries
= FRAME_WIN32_DISPLAY_INFO (f
)->num_colors
;
1279 list
= FRAME_WIN32_DISPLAY_INFO (f
)->color_list
;
1281 i
< FRAME_WIN32_DISPLAY_INFO (f
)->num_colors
;
1282 i
++, list
= list
->next
)
1283 log_palette
->palPalEntry
[i
] = list
->entry
;
1285 new_palette
= CreatePalette (log_palette
);
1289 if (FRAME_WIN32_DISPLAY_INFO (f
)->palette
)
1290 DeleteObject (FRAME_WIN32_DISPLAY_INFO (f
)->palette
);
1291 FRAME_WIN32_DISPLAY_INFO (f
)->palette
= new_palette
;
1293 /* Realize display palette and garbage all frames. */
1294 release_frame_dc (f
, get_frame_dc (f
));
1299 #define WIN32_COLOR(pe) RGB (pe.peRed, pe.peGreen, pe.peBlue)
1300 #define SET_WIN32_COLOR(pe, color) \
1303 pe.peRed = GetRValue (color); \
1304 pe.peGreen = GetGValue (color); \
1305 pe.peBlue = GetBValue (color); \
1310 /* Keep these around in case we ever want to track color usage. */
1312 win32_map_color (FRAME_PTR f
, COLORREF color
)
1314 struct win32_palette_entry
* list
= FRAME_WIN32_DISPLAY_INFO (f
)->color_list
;
1316 if (NILP (Vwin32_enable_palette
))
1319 /* check if color is already mapped */
1322 if (WIN32_COLOR (list
->entry
) == color
)
1330 /* not already mapped, so add to list and recreate Windows palette */
1331 list
= (struct win32_palette_entry
*)
1332 xmalloc (sizeof (struct win32_palette_entry
));
1333 SET_WIN32_COLOR (list
->entry
, color
);
1335 list
->next
= FRAME_WIN32_DISPLAY_INFO (f
)->color_list
;
1336 FRAME_WIN32_DISPLAY_INFO (f
)->color_list
= list
;
1337 FRAME_WIN32_DISPLAY_INFO (f
)->num_colors
++;
1339 /* set flag that palette must be regenerated */
1340 FRAME_WIN32_DISPLAY_INFO (f
)->regen_palette
= TRUE
;
1344 win32_unmap_color (FRAME_PTR f
, COLORREF color
)
1346 struct win32_palette_entry
* list
= FRAME_WIN32_DISPLAY_INFO (f
)->color_list
;
1347 struct win32_palette_entry
**prev
= &FRAME_WIN32_DISPLAY_INFO (f
)->color_list
;
1349 if (NILP (Vwin32_enable_palette
))
1352 /* check if color is already mapped */
1355 if (WIN32_COLOR (list
->entry
) == color
)
1357 if (--list
->refcount
== 0)
1361 FRAME_WIN32_DISPLAY_INFO (f
)->num_colors
--;
1371 /* set flag that palette must be regenerated */
1372 FRAME_WIN32_DISPLAY_INFO (f
)->regen_palette
= TRUE
;
1376 /* Decide if color named COLOR is valid for the display associated with
1377 the selected frame; if so, return the rgb values in COLOR_DEF.
1378 If ALLOC is nonzero, allocate a new colormap cell. */
1381 defined_color (f
, color
, color_def
, alloc
)
1384 COLORREF
*color_def
;
1387 register Lisp_Object tem
;
1389 tem
= x_to_win32_color (color
);
1393 if (!NILP (Vwin32_enable_palette
))
1395 struct win32_palette_entry
* entry
=
1396 FRAME_WIN32_DISPLAY_INFO (f
)->color_list
;
1397 struct win32_palette_entry
** prev
=
1398 &FRAME_WIN32_DISPLAY_INFO (f
)->color_list
;
1400 /* check if color is already mapped */
1403 if (WIN32_COLOR (entry
->entry
) == XUINT (tem
))
1405 prev
= &entry
->next
;
1406 entry
= entry
->next
;
1409 if (entry
== NULL
&& alloc
)
1411 /* not already mapped, so add to list */
1412 entry
= (struct win32_palette_entry
*)
1413 xmalloc (sizeof (struct win32_palette_entry
));
1414 SET_WIN32_COLOR (entry
->entry
, XUINT (tem
));
1417 FRAME_WIN32_DISPLAY_INFO (f
)->num_colors
++;
1419 /* set flag that palette must be regenerated */
1420 FRAME_WIN32_DISPLAY_INFO (f
)->regen_palette
= TRUE
;
1423 /* Ensure COLORREF value is snapped to nearest color in (default)
1424 palette by simulating the PALETTERGB macro. This works whether
1425 or not the display device has a palette. */
1426 *color_def
= XUINT (tem
) | 0x2000000;
1435 /* Given a string ARG naming a color, compute a pixel value from it
1436 suitable for screen F.
1437 If F is not a color screen, return DEF (default) regardless of what
1441 x_decode_color (f
, arg
, def
)
1448 CHECK_STRING (arg
, 0);
1450 if (strcmp (XSTRING (arg
)->data
, "black") == 0)
1451 return BLACK_PIX_DEFAULT (f
);
1452 else if (strcmp (XSTRING (arg
)->data
, "white") == 0)
1453 return WHITE_PIX_DEFAULT (f
);
1455 if ((FRAME_WIN32_DISPLAY_INFO (f
)->n_planes
* FRAME_WIN32_DISPLAY_INFO (f
)->n_cbits
) == 1)
1458 /* defined_color is responsible for coping with failures
1459 by looking for a near-miss. */
1460 if (defined_color (f
, XSTRING (arg
)->data
, &cdef
, 1))
1463 /* defined_color failed; return an ultimate default. */
1467 /* Functions called only from `x_set_frame_param'
1468 to set individual parameters.
1470 If FRAME_WIN32_WINDOW (f) is 0,
1471 the frame is being created and its window does not exist yet.
1472 In that case, just record the parameter's new value
1473 in the standard place; do not attempt to change the window. */
1476 x_set_foreground_color (f
, arg
, oldval
)
1478 Lisp_Object arg
, oldval
;
1480 f
->output_data
.win32
->foreground_pixel
1481 = x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1483 if (FRAME_WIN32_WINDOW (f
) != 0)
1485 recompute_basic_faces (f
);
1486 if (FRAME_VISIBLE_P (f
))
1492 x_set_background_color (f
, arg
, oldval
)
1494 Lisp_Object arg
, oldval
;
1499 f
->output_data
.win32
->background_pixel
1500 = x_decode_color (f
, arg
, WHITE_PIX_DEFAULT (f
));
1502 if (FRAME_WIN32_WINDOW (f
) != 0)
1504 SetWindowLong (FRAME_WIN32_WINDOW (f
), WND_BACKGROUND_INDEX
, f
->output_data
.win32
->background_pixel
);
1506 recompute_basic_faces (f
);
1508 if (FRAME_VISIBLE_P (f
))
1514 x_set_mouse_color (f
, arg
, oldval
)
1516 Lisp_Object arg
, oldval
;
1519 Cursor cursor
, nontext_cursor
, mode_cursor
, cross_cursor
;
1523 if (!EQ (Qnil
, arg
))
1524 f
->output_data
.win32
->mouse_pixel
1525 = x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1526 mask_color
= f
->output_data
.win32
->background_pixel
;
1527 /* No invisible pointers. */
1528 if (mask_color
== f
->output_data
.win32
->mouse_pixel
1529 && mask_color
== f
->output_data
.win32
->background_pixel
)
1530 f
->output_data
.win32
->mouse_pixel
= f
->output_data
.win32
->foreground_pixel
;
1535 /* It's not okay to crash if the user selects a screwy cursor. */
1536 x_catch_errors (FRAME_WIN32_DISPLAY (f
));
1538 if (!EQ (Qnil
, Vx_pointer_shape
))
1540 CHECK_NUMBER (Vx_pointer_shape
, 0);
1541 cursor
= XCreateFontCursor (FRAME_WIN32_DISPLAY (f
), XINT (Vx_pointer_shape
));
1544 cursor
= XCreateFontCursor (FRAME_WIN32_DISPLAY (f
), XC_xterm
);
1545 x_check_errors (FRAME_WIN32_DISPLAY (f
), "bad text pointer cursor: %s");
1547 if (!EQ (Qnil
, Vx_nontext_pointer_shape
))
1549 CHECK_NUMBER (Vx_nontext_pointer_shape
, 0);
1550 nontext_cursor
= XCreateFontCursor (FRAME_WIN32_DISPLAY (f
),
1551 XINT (Vx_nontext_pointer_shape
));
1554 nontext_cursor
= XCreateFontCursor (FRAME_WIN32_DISPLAY (f
), XC_left_ptr
);
1555 x_check_errors (FRAME_WIN32_DISPLAY (f
), "bad nontext pointer cursor: %s");
1557 if (!EQ (Qnil
, Vx_mode_pointer_shape
))
1559 CHECK_NUMBER (Vx_mode_pointer_shape
, 0);
1560 mode_cursor
= XCreateFontCursor (FRAME_WIN32_DISPLAY (f
),
1561 XINT (Vx_mode_pointer_shape
));
1564 mode_cursor
= XCreateFontCursor (FRAME_WIN32_DISPLAY (f
), XC_xterm
);
1565 x_check_errors (FRAME_WIN32_DISPLAY (f
), "bad modeline pointer cursor: %s");
1567 if (!EQ (Qnil
, Vx_sensitive_text_pointer_shape
))
1569 CHECK_NUMBER (Vx_sensitive_text_pointer_shape
, 0);
1571 = XCreateFontCursor (FRAME_WIN32_DISPLAY (f
),
1572 XINT (Vx_sensitive_text_pointer_shape
));
1575 cross_cursor
= XCreateFontCursor (FRAME_WIN32_DISPLAY (f
), XC_crosshair
);
1577 /* Check and report errors with the above calls. */
1578 x_check_errors (FRAME_WIN32_DISPLAY (f
), "can't set cursor shape: %s");
1579 x_uncatch_errors (FRAME_WIN32_DISPLAY (f
));
1582 XColor fore_color
, back_color
;
1584 fore_color
.pixel
= f
->output_data
.win32
->mouse_pixel
;
1585 back_color
.pixel
= mask_color
;
1586 XQueryColor (FRAME_WIN32_DISPLAY (f
),
1587 DefaultColormap (FRAME_WIN32_DISPLAY (f
),
1588 DefaultScreen (FRAME_WIN32_DISPLAY (f
))),
1590 XQueryColor (FRAME_WIN32_DISPLAY (f
),
1591 DefaultColormap (FRAME_WIN32_DISPLAY (f
),
1592 DefaultScreen (FRAME_WIN32_DISPLAY (f
))),
1594 XRecolorCursor (FRAME_WIN32_DISPLAY (f
), cursor
,
1595 &fore_color
, &back_color
);
1596 XRecolorCursor (FRAME_WIN32_DISPLAY (f
), nontext_cursor
,
1597 &fore_color
, &back_color
);
1598 XRecolorCursor (FRAME_WIN32_DISPLAY (f
), mode_cursor
,
1599 &fore_color
, &back_color
);
1600 XRecolorCursor (FRAME_WIN32_DISPLAY (f
), cross_cursor
,
1601 &fore_color
, &back_color
);
1604 if (FRAME_WIN32_WINDOW (f
) != 0)
1606 XDefineCursor (FRAME_WIN32_DISPLAY (f
), FRAME_WIN32_WINDOW (f
), cursor
);
1609 if (cursor
!= f
->output_data
.win32
->text_cursor
&& f
->output_data
.win32
->text_cursor
!= 0)
1610 XFreeCursor (FRAME_WIN32_DISPLAY (f
), f
->output_data
.win32
->text_cursor
);
1611 f
->output_data
.win32
->text_cursor
= cursor
;
1613 if (nontext_cursor
!= f
->output_data
.win32
->nontext_cursor
1614 && f
->output_data
.win32
->nontext_cursor
!= 0)
1615 XFreeCursor (FRAME_WIN32_DISPLAY (f
), f
->output_data
.win32
->nontext_cursor
);
1616 f
->output_data
.win32
->nontext_cursor
= nontext_cursor
;
1618 if (mode_cursor
!= f
->output_data
.win32
->modeline_cursor
1619 && f
->output_data
.win32
->modeline_cursor
!= 0)
1620 XFreeCursor (FRAME_WIN32_DISPLAY (f
), f
->output_data
.win32
->modeline_cursor
);
1621 f
->output_data
.win32
->modeline_cursor
= mode_cursor
;
1622 if (cross_cursor
!= f
->output_data
.win32
->cross_cursor
1623 && f
->output_data
.win32
->cross_cursor
!= 0)
1624 XFreeCursor (FRAME_WIN32_DISPLAY (f
), f
->output_data
.win32
->cross_cursor
);
1625 f
->output_data
.win32
->cross_cursor
= cross_cursor
;
1627 XFlush (FRAME_WIN32_DISPLAY (f
));
1633 x_set_cursor_color (f
, arg
, oldval
)
1635 Lisp_Object arg
, oldval
;
1637 unsigned long fore_pixel
;
1639 if (!EQ (Vx_cursor_fore_pixel
, Qnil
))
1640 fore_pixel
= x_decode_color (f
, Vx_cursor_fore_pixel
,
1641 WHITE_PIX_DEFAULT (f
));
1643 fore_pixel
= f
->output_data
.win32
->background_pixel
;
1644 f
->output_data
.win32
->cursor_pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1646 /* Make sure that the cursor color differs from the background color. */
1647 if (f
->output_data
.win32
->cursor_pixel
== f
->output_data
.win32
->background_pixel
)
1649 f
->output_data
.win32
->cursor_pixel
= f
->output_data
.win32
->mouse_pixel
;
1650 if (f
->output_data
.win32
->cursor_pixel
== fore_pixel
)
1651 fore_pixel
= f
->output_data
.win32
->background_pixel
;
1653 f
->output_data
.win32
->cursor_foreground_pixel
= fore_pixel
;
1655 if (FRAME_WIN32_WINDOW (f
) != 0)
1657 if (FRAME_VISIBLE_P (f
))
1659 x_display_cursor (f
, 0);
1660 x_display_cursor (f
, 1);
1665 /* Set the border-color of frame F to value described by ARG.
1666 ARG can be a string naming a color.
1667 The border-color is used for the border that is drawn by the server.
1668 Note that this does not fully take effect if done before
1669 F has a window; it must be redone when the window is created. */
1672 x_set_border_color (f
, arg
, oldval
)
1674 Lisp_Object arg
, oldval
;
1679 CHECK_STRING (arg
, 0);
1680 str
= XSTRING (arg
)->data
;
1682 pix
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1684 x_set_border_pixel (f
, pix
);
1687 /* Set the border-color of frame F to pixel value PIX.
1688 Note that this does not fully take effect if done before
1691 x_set_border_pixel (f
, pix
)
1695 f
->output_data
.win32
->border_pixel
= pix
;
1697 if (FRAME_WIN32_WINDOW (f
) != 0 && f
->output_data
.win32
->border_width
> 0)
1699 if (FRAME_VISIBLE_P (f
))
1705 x_set_cursor_type (f
, arg
, oldval
)
1707 Lisp_Object arg
, oldval
;
1711 FRAME_DESIRED_CURSOR (f
) = bar_cursor
;
1712 f
->output_data
.win32
->cursor_width
= 2;
1714 else if (CONSP (arg
) && EQ (XCONS (arg
)->car
, Qbar
)
1715 && INTEGERP (XCONS (arg
)->cdr
))
1717 FRAME_DESIRED_CURSOR (f
) = bar_cursor
;
1718 f
->output_data
.win32
->cursor_width
= XINT (XCONS (arg
)->cdr
);
1721 /* Treat anything unknown as "box cursor".
1722 It was bad to signal an error; people have trouble fixing
1723 .Xdefaults with Emacs, when it has something bad in it. */
1724 FRAME_DESIRED_CURSOR (f
) = filled_box_cursor
;
1726 /* Make sure the cursor gets redrawn. This is overkill, but how
1727 often do people change cursor types? */
1728 update_mode_lines
++;
1732 x_set_icon_type (f
, arg
, oldval
)
1734 Lisp_Object arg
, oldval
;
1742 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1745 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1750 result
= x_text_icon (f
,
1751 (char *) XSTRING ((!NILP (f
->icon_name
)
1755 result
= x_bitmap_icon (f
, arg
);
1760 error ("No icon window available");
1763 /* If the window was unmapped (and its icon was mapped),
1764 the new icon is not mapped, so map the window in its stead. */
1765 if (FRAME_VISIBLE_P (f
))
1767 #ifdef USE_X_TOOLKIT
1768 XtPopup (f
->output_data
.win32
->widget
, XtGrabNone
);
1770 XMapWindow (FRAME_WIN32_DISPLAY (f
), FRAME_WIN32_WINDOW (f
));
1773 XFlush (FRAME_WIN32_DISPLAY (f
));
1778 /* Return non-nil if frame F wants a bitmap icon. */
1786 tem
= assq_no_quit (Qicon_type
, f
->param_alist
);
1788 return XCONS (tem
)->cdr
;
1794 x_set_icon_name (f
, arg
, oldval
)
1796 Lisp_Object arg
, oldval
;
1803 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
1806 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
1812 if (f
->output_data
.win32
->icon_bitmap
!= 0)
1817 result
= x_text_icon (f
,
1818 (char *) XSTRING ((!NILP (f
->icon_name
)
1825 error ("No icon window available");
1828 /* If the window was unmapped (and its icon was mapped),
1829 the new icon is not mapped, so map the window in its stead. */
1830 if (FRAME_VISIBLE_P (f
))
1832 #ifdef USE_X_TOOLKIT
1833 XtPopup (f
->output_data
.win32
->widget
, XtGrabNone
);
1835 XMapWindow (FRAME_WIN32_DISPLAY (f
), FRAME_WIN32_WINDOW (f
));
1838 XFlush (FRAME_WIN32_DISPLAY (f
));
1843 extern Lisp_Object
x_new_font ();
1846 x_set_font (f
, arg
, oldval
)
1848 Lisp_Object arg
, oldval
;
1852 CHECK_STRING (arg
, 1);
1855 result
= x_new_font (f
, XSTRING (arg
)->data
);
1858 if (EQ (result
, Qnil
))
1859 error ("Font \"%s\" is not defined", XSTRING (arg
)->data
);
1860 else if (EQ (result
, Qt
))
1861 error ("the characters of the given font have varying widths");
1862 else if (STRINGP (result
))
1864 recompute_basic_faces (f
);
1865 store_frame_param (f
, Qfont
, result
);
1872 x_set_border_width (f
, arg
, oldval
)
1874 Lisp_Object arg
, oldval
;
1876 CHECK_NUMBER (arg
, 0);
1878 if (XINT (arg
) == f
->output_data
.win32
->border_width
)
1881 if (FRAME_WIN32_WINDOW (f
) != 0)
1882 error ("Cannot change the border width of a window");
1884 f
->output_data
.win32
->border_width
= XINT (arg
);
1888 x_set_internal_border_width (f
, arg
, oldval
)
1890 Lisp_Object arg
, oldval
;
1893 int old
= f
->output_data
.win32
->internal_border_width
;
1895 CHECK_NUMBER (arg
, 0);
1896 f
->output_data
.win32
->internal_border_width
= XINT (arg
);
1897 if (f
->output_data
.win32
->internal_border_width
< 0)
1898 f
->output_data
.win32
->internal_border_width
= 0;
1900 if (f
->output_data
.win32
->internal_border_width
== old
)
1903 if (FRAME_WIN32_WINDOW (f
) != 0)
1906 x_set_window_size (f
, 0, f
->width
, f
->height
);
1908 SET_FRAME_GARBAGED (f
);
1913 x_set_visibility (f
, value
, oldval
)
1915 Lisp_Object value
, oldval
;
1918 XSETFRAME (frame
, f
);
1921 Fmake_frame_invisible (frame
, Qt
);
1922 else if (EQ (value
, Qicon
))
1923 Ficonify_frame (frame
);
1925 Fmake_frame_visible (frame
);
1929 x_set_menu_bar_lines (f
, value
, oldval
)
1931 Lisp_Object value
, oldval
;
1934 int olines
= FRAME_MENU_BAR_LINES (f
);
1936 /* Right now, menu bars don't work properly in minibuf-only frames;
1937 most of the commands try to apply themselves to the minibuffer
1938 frame itslef, and get an error because you can't switch buffers
1939 in or split the minibuffer window. */
1940 if (FRAME_MINIBUF_ONLY_P (f
))
1943 if (INTEGERP (value
))
1944 nlines
= XINT (value
);
1948 FRAME_MENU_BAR_LINES (f
) = 0;
1950 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
1953 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
1954 free_frame_menubar (f
);
1955 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
1959 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
1962 If EXPLICIT is non-zero, that indicates that lisp code is setting the
1963 name; if NAME is a string, set F's name to NAME and set
1964 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
1966 If EXPLICIT is zero, that indicates that Emacs redisplay code is
1967 suggesting a new name, which lisp code should override; if
1968 F->explicit_name is set, ignore the new name; otherwise, set it. */
1971 x_set_name (f
, name
, explicit)
1976 /* Make sure that requests from lisp code override requests from
1977 Emacs redisplay code. */
1980 /* If we're switching from explicit to implicit, we had better
1981 update the mode lines and thereby update the title. */
1982 if (f
->explicit_name
&& NILP (name
))
1983 update_mode_lines
= 1;
1985 f
->explicit_name
= ! NILP (name
);
1987 else if (f
->explicit_name
)
1990 /* If NAME is nil, set the name to the win32_id_name. */
1993 /* Check for no change needed in this very common case
1994 before we do any consing. */
1995 if (!strcmp (FRAME_WIN32_DISPLAY_INFO (f
)->win32_id_name
,
1996 XSTRING (f
->name
)->data
))
1998 name
= build_string (FRAME_WIN32_DISPLAY_INFO (f
)->win32_id_name
);
2001 CHECK_STRING (name
, 0);
2003 /* Don't change the name if it's already NAME. */
2004 if (! NILP (Fstring_equal (name
, f
->name
)))
2007 if (FRAME_WIN32_WINDOW (f
))
2010 SetWindowText(FRAME_WIN32_WINDOW (f
), XSTRING (name
)->data
);
2017 /* This function should be called when the user's lisp code has
2018 specified a name for the frame; the name will override any set by the
2021 x_explicitly_set_name (f
, arg
, oldval
)
2023 Lisp_Object arg
, oldval
;
2025 x_set_name (f
, arg
, 1);
2028 /* This function should be called by Emacs redisplay code to set the
2029 name; names set this way will never override names set by the user's
2032 x_implicitly_set_name (f
, arg
, oldval
)
2034 Lisp_Object arg
, oldval
;
2036 x_set_name (f
, arg
, 0);
2040 x_set_autoraise (f
, arg
, oldval
)
2042 Lisp_Object arg
, oldval
;
2044 f
->auto_raise
= !EQ (Qnil
, arg
);
2048 x_set_autolower (f
, arg
, oldval
)
2050 Lisp_Object arg
, oldval
;
2052 f
->auto_lower
= !EQ (Qnil
, arg
);
2056 x_set_unsplittable (f
, arg
, oldval
)
2058 Lisp_Object arg
, oldval
;
2060 f
->no_split
= !NILP (arg
);
2064 x_set_vertical_scroll_bars (f
, arg
, oldval
)
2066 Lisp_Object arg
, oldval
;
2068 if (NILP (arg
) != ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
2070 FRAME_HAS_VERTICAL_SCROLL_BARS (f
) = ! NILP (arg
);
2072 /* We set this parameter before creating the window for the
2073 frame, so we can get the geometry right from the start.
2074 However, if the window hasn't been created yet, we shouldn't
2075 call x_set_window_size. */
2076 if (FRAME_WIN32_WINDOW (f
))
2077 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2082 x_set_scroll_bar_width (f
, arg
, oldval
)
2084 Lisp_Object arg
, oldval
;
2088 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = 0;
2089 FRAME_SCROLL_BAR_COLS (f
) = 2;
2091 else if (INTEGERP (arg
) && XINT (arg
) > 0
2092 && XFASTINT (arg
) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f
))
2094 int wid
= FONT_WIDTH (f
->output_data
.win32
->font
);
2095 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = XFASTINT (arg
);
2096 FRAME_SCROLL_BAR_COLS (f
) = (XFASTINT (arg
) + wid
-1) / wid
;
2097 if (FRAME_WIN32_WINDOW (f
))
2098 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2102 /* Subroutines of creating an frame. */
2104 /* Make sure that Vx_resource_name is set to a reasonable value.
2105 Fix it up, or set it to `emacs' if it is too hopeless. */
2108 validate_x_resource_name ()
2111 /* Number of valid characters in the resource name. */
2113 /* Number of invalid characters in the resource name. */
2118 if (STRINGP (Vx_resource_name
))
2120 unsigned char *p
= XSTRING (Vx_resource_name
)->data
;
2123 len
= XSTRING (Vx_resource_name
)->size
;
2125 /* Only letters, digits, - and _ are valid in resource names.
2126 Count the valid characters and count the invalid ones. */
2127 for (i
= 0; i
< len
; i
++)
2130 if (! ((c
>= 'a' && c
<= 'z')
2131 || (c
>= 'A' && c
<= 'Z')
2132 || (c
>= '0' && c
<= '9')
2133 || c
== '-' || c
== '_'))
2140 /* Not a string => completely invalid. */
2141 bad_count
= 5, good_count
= 0;
2143 /* If name is valid already, return. */
2147 /* If name is entirely invalid, or nearly so, use `emacs'. */
2149 || (good_count
== 1 && bad_count
> 0))
2151 Vx_resource_name
= build_string ("emacs");
2155 /* Name is partly valid. Copy it and replace the invalid characters
2156 with underscores. */
2158 Vx_resource_name
= new = Fcopy_sequence (Vx_resource_name
);
2160 for (i
= 0; i
< len
; i
++)
2162 int c
= XSTRING (new)->data
[i
];
2163 if (! ((c
>= 'a' && c
<= 'z')
2164 || (c
>= 'A' && c
<= 'Z')
2165 || (c
>= '0' && c
<= '9')
2166 || c
== '-' || c
== '_'))
2167 XSTRING (new)->data
[i
] = '_';
2172 extern char *x_get_string_resource ();
2174 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
2175 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
2176 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
2177 class, where INSTANCE is the name under which Emacs was invoked, or\n\
2178 the name specified by the `-name' or `-rn' command-line arguments.\n\
2180 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
2181 class, respectively. You must specify both of them or neither.\n\
2182 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
2183 and the class is `Emacs.CLASS.SUBCLASS'.")
2184 (attribute
, class, component
, subclass
)
2185 Lisp_Object attribute
, class, component
, subclass
;
2187 register char *value
;
2191 CHECK_STRING (attribute
, 0);
2192 CHECK_STRING (class, 0);
2194 if (!NILP (component
))
2195 CHECK_STRING (component
, 1);
2196 if (!NILP (subclass
))
2197 CHECK_STRING (subclass
, 2);
2198 if (NILP (component
) != NILP (subclass
))
2199 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2201 validate_x_resource_name ();
2203 /* Allocate space for the components, the dots which separate them,
2204 and the final '\0'. Make them big enough for the worst case. */
2205 name_key
= (char *) alloca (XSTRING (Vx_resource_name
)->size
2206 + (STRINGP (component
)
2207 ? XSTRING (component
)->size
: 0)
2208 + XSTRING (attribute
)->size
2211 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
2212 + XSTRING (class)->size
2213 + (STRINGP (subclass
)
2214 ? XSTRING (subclass
)->size
: 0)
2217 /* Start with emacs.FRAMENAME for the name (the specific one)
2218 and with `Emacs' for the class key (the general one). */
2219 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2220 strcpy (class_key
, EMACS_CLASS
);
2222 strcat (class_key
, ".");
2223 strcat (class_key
, XSTRING (class)->data
);
2225 if (!NILP (component
))
2227 strcat (class_key
, ".");
2228 strcat (class_key
, XSTRING (subclass
)->data
);
2230 strcat (name_key
, ".");
2231 strcat (name_key
, XSTRING (component
)->data
);
2234 strcat (name_key
, ".");
2235 strcat (name_key
, XSTRING (attribute
)->data
);
2237 value
= x_get_string_resource (Qnil
,
2238 name_key
, class_key
);
2240 if (value
!= (char *) 0)
2241 return build_string (value
);
2246 /* Used when C code wants a resource value. */
2249 x_get_resource_string (attribute
, class)
2250 char *attribute
, *class;
2252 register char *value
;
2256 /* Allocate space for the components, the dots which separate them,
2257 and the final '\0'. */
2258 name_key
= (char *) alloca (XSTRING (Vinvocation_name
)->size
2259 + strlen (attribute
) + 2);
2260 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
2261 + strlen (class) + 2);
2263 sprintf (name_key
, "%s.%s",
2264 XSTRING (Vinvocation_name
)->data
,
2266 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
2268 return x_get_string_resource (selected_frame
,
2269 name_key
, class_key
);
2272 /* Types we might convert a resource string into. */
2275 number
, boolean
, string
, symbol
2278 /* Return the value of parameter PARAM.
2280 First search ALIST, then Vdefault_frame_alist, then the X defaults
2281 database, using ATTRIBUTE as the attribute name and CLASS as its class.
2283 Convert the resource to the type specified by desired_type.
2285 If no default is specified, return Qunbound. If you call
2286 x_get_arg, make sure you deal with Qunbound in a reasonable way,
2287 and don't let it get stored in any Lisp-visible variables! */
2290 x_get_arg (alist
, param
, attribute
, class, type
)
2291 Lisp_Object alist
, param
;
2294 enum resource_types type
;
2296 register Lisp_Object tem
;
2298 tem
= Fassq (param
, alist
);
2300 tem
= Fassq (param
, Vdefault_frame_alist
);
2306 tem
= Fx_get_resource (build_string (attribute
),
2307 build_string (class),
2316 return make_number (atoi (XSTRING (tem
)->data
));
2319 tem
= Fdowncase (tem
);
2320 if (!strcmp (XSTRING (tem
)->data
, "on")
2321 || !strcmp (XSTRING (tem
)->data
, "true"))
2330 /* As a special case, we map the values `true' and `on'
2331 to Qt, and `false' and `off' to Qnil. */
2334 lower
= Fdowncase (tem
);
2335 if (!strcmp (XSTRING (lower
)->data
, "on")
2336 || !strcmp (XSTRING (lower
)->data
, "true"))
2338 else if (!strcmp (XSTRING (lower
)->data
, "off")
2339 || !strcmp (XSTRING (lower
)->data
, "false"))
2342 return Fintern (tem
, Qnil
);
2355 /* Record in frame F the specified or default value according to ALIST
2356 of the parameter named PARAM (a Lisp symbol).
2357 If no value is specified for PARAM, look for an X default for XPROP
2358 on the frame named NAME.
2359 If that is not found either, use the value DEFLT. */
2362 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
2369 enum resource_types type
;
2373 tem
= x_get_arg (alist
, prop
, xprop
, xclass
, type
);
2374 if (EQ (tem
, Qunbound
))
2376 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2380 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
2381 "Parse an X-style geometry string STRING.\n\
2382 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
2383 The properties returned may include `top', `left', `height', and `width'.\n\
2384 The value of `left' or `top' may be an integer,\n\
2385 or a list (+ N) meaning N pixels relative to top/left corner,\n\
2386 or a list (- N) meaning -N pixels relative to bottom/right corner.")
2391 unsigned int width
, height
;
2394 CHECK_STRING (string
, 0);
2396 geometry
= XParseGeometry ((char *) XSTRING (string
)->data
,
2397 &x
, &y
, &width
, &height
);
2400 if (geometry
& XValue
)
2402 Lisp_Object element
;
2404 if (x
>= 0 && (geometry
& XNegative
))
2405 element
= Fcons (Qleft
, Fcons (Qminus
, Fcons (make_number (-x
), Qnil
)));
2406 else if (x
< 0 && ! (geometry
& XNegative
))
2407 element
= Fcons (Qleft
, Fcons (Qplus
, Fcons (make_number (x
), Qnil
)));
2409 element
= Fcons (Qleft
, make_number (x
));
2410 result
= Fcons (element
, result
);
2413 if (geometry
& YValue
)
2415 Lisp_Object element
;
2417 if (y
>= 0 && (geometry
& YNegative
))
2418 element
= Fcons (Qtop
, Fcons (Qminus
, Fcons (make_number (-y
), Qnil
)));
2419 else if (y
< 0 && ! (geometry
& YNegative
))
2420 element
= Fcons (Qtop
, Fcons (Qplus
, Fcons (make_number (y
), Qnil
)));
2422 element
= Fcons (Qtop
, make_number (y
));
2423 result
= Fcons (element
, result
);
2426 if (geometry
& WidthValue
)
2427 result
= Fcons (Fcons (Qwidth
, make_number (width
)), result
);
2428 if (geometry
& HeightValue
)
2429 result
= Fcons (Fcons (Qheight
, make_number (height
)), result
);
2434 /* Calculate the desired size and position of this window,
2435 and return the flags saying which aspects were specified.
2437 This function does not make the coordinates positive. */
2439 #define DEFAULT_ROWS 40
2440 #define DEFAULT_COLS 80
2443 x_figure_window_size (f
, parms
)
2447 register Lisp_Object tem0
, tem1
, tem2
;
2448 int height
, width
, left
, top
;
2449 register int geometry
;
2450 long window_prompting
= 0;
2452 /* Default values if we fall through.
2453 Actually, if that happens we should get
2454 window manager prompting. */
2455 f
->width
= DEFAULT_COLS
;
2456 f
->height
= DEFAULT_ROWS
;
2457 /* Window managers expect that if program-specified
2458 positions are not (0,0), they're intentional, not defaults. */
2459 f
->output_data
.win32
->top_pos
= 0;
2460 f
->output_data
.win32
->left_pos
= 0;
2462 tem0
= x_get_arg (parms
, Qheight
, 0, 0, number
);
2463 tem1
= x_get_arg (parms
, Qwidth
, 0, 0, number
);
2464 tem2
= x_get_arg (parms
, Quser_size
, 0, 0, number
);
2465 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
2467 if (!EQ (tem0
, Qunbound
))
2469 CHECK_NUMBER (tem0
, 0);
2470 f
->height
= XINT (tem0
);
2472 if (!EQ (tem1
, Qunbound
))
2474 CHECK_NUMBER (tem1
, 0);
2475 f
->width
= XINT (tem1
);
2477 if (!NILP (tem2
) && !EQ (tem2
, Qunbound
))
2478 window_prompting
|= USSize
;
2480 window_prompting
|= PSize
;
2483 f
->output_data
.win32
->vertical_scroll_bar_extra
2484 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
2486 : FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) > 0
2487 ? FRAME_SCROLL_BAR_PIXEL_WIDTH (f
)
2488 : (FRAME_SCROLL_BAR_COLS (f
) * FONT_WIDTH (f
->output_data
.win32
->font
)));
2489 f
->output_data
.win32
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
2490 f
->output_data
.win32
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
2492 tem0
= x_get_arg (parms
, Qtop
, 0, 0, number
);
2493 tem1
= x_get_arg (parms
, Qleft
, 0, 0, number
);
2494 tem2
= x_get_arg (parms
, Quser_position
, 0, 0, number
);
2495 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
2497 if (EQ (tem0
, Qminus
))
2499 f
->output_data
.win32
->top_pos
= 0;
2500 window_prompting
|= YNegative
;
2502 else if (CONSP (tem0
) && EQ (XCONS (tem0
)->car
, Qminus
)
2503 && CONSP (XCONS (tem0
)->cdr
)
2504 && INTEGERP (XCONS (XCONS (tem0
)->cdr
)->car
))
2506 f
->output_data
.win32
->top_pos
= - XINT (XCONS (XCONS (tem0
)->cdr
)->car
);
2507 window_prompting
|= YNegative
;
2509 else if (CONSP (tem0
) && EQ (XCONS (tem0
)->car
, Qplus
)
2510 && CONSP (XCONS (tem0
)->cdr
)
2511 && INTEGERP (XCONS (XCONS (tem0
)->cdr
)->car
))
2513 f
->output_data
.win32
->top_pos
= XINT (XCONS (XCONS (tem0
)->cdr
)->car
);
2515 else if (EQ (tem0
, Qunbound
))
2516 f
->output_data
.win32
->top_pos
= 0;
2519 CHECK_NUMBER (tem0
, 0);
2520 f
->output_data
.win32
->top_pos
= XINT (tem0
);
2521 if (f
->output_data
.win32
->top_pos
< 0)
2522 window_prompting
|= YNegative
;
2525 if (EQ (tem1
, Qminus
))
2527 f
->output_data
.win32
->left_pos
= 0;
2528 window_prompting
|= XNegative
;
2530 else if (CONSP (tem1
) && EQ (XCONS (tem1
)->car
, Qminus
)
2531 && CONSP (XCONS (tem1
)->cdr
)
2532 && INTEGERP (XCONS (XCONS (tem1
)->cdr
)->car
))
2534 f
->output_data
.win32
->left_pos
= - XINT (XCONS (XCONS (tem1
)->cdr
)->car
);
2535 window_prompting
|= XNegative
;
2537 else if (CONSP (tem1
) && EQ (XCONS (tem1
)->car
, Qplus
)
2538 && CONSP (XCONS (tem1
)->cdr
)
2539 && INTEGERP (XCONS (XCONS (tem1
)->cdr
)->car
))
2541 f
->output_data
.win32
->left_pos
= XINT (XCONS (XCONS (tem1
)->cdr
)->car
);
2543 else if (EQ (tem1
, Qunbound
))
2544 f
->output_data
.win32
->left_pos
= 0;
2547 CHECK_NUMBER (tem1
, 0);
2548 f
->output_data
.win32
->left_pos
= XINT (tem1
);
2549 if (f
->output_data
.win32
->left_pos
< 0)
2550 window_prompting
|= XNegative
;
2553 if (!NILP (tem2
) && ! EQ (tem2
, Qunbound
))
2554 window_prompting
|= USPosition
;
2556 window_prompting
|= PPosition
;
2559 return window_prompting
;
2564 extern LRESULT CALLBACK
win32_wnd_proc ();
2567 win32_init_class (hinst
)
2572 wc
.style
= CS_HREDRAW
| CS_VREDRAW
;
2573 wc
.lpfnWndProc
= (WNDPROC
) win32_wnd_proc
;
2575 wc
.cbWndExtra
= WND_EXTRA_BYTES
;
2576 wc
.hInstance
= hinst
;
2577 wc
.hIcon
= LoadIcon (hinst
, EMACS_CLASS
);
2578 wc
.hCursor
= LoadCursor (NULL
, IDC_ARROW
);
2579 wc
.hbrBackground
= NULL
; // GetStockObject (WHITE_BRUSH);
2580 wc
.lpszMenuName
= NULL
;
2581 wc
.lpszClassName
= EMACS_CLASS
;
2583 return (RegisterClass (&wc
));
2587 win32_createscrollbar (f
, bar
)
2589 struct scroll_bar
* bar
;
2591 return (CreateWindow ("SCROLLBAR", "", SBS_VERT
| WS_CHILD
| WS_VISIBLE
,
2592 /* Position and size of scroll bar. */
2593 XINT(bar
->left
), XINT(bar
->top
),
2594 XINT(bar
->width
), XINT(bar
->height
),
2595 FRAME_WIN32_WINDOW (f
),
2602 win32_createwindow (f
)
2607 /* Do first time app init */
2611 win32_init_class (hinst
);
2614 FRAME_WIN32_WINDOW (f
) = hwnd
= CreateWindow (EMACS_CLASS
,
2616 f
->output_data
.win32
->dwStyle
| WS_CLIPCHILDREN
,
2617 f
->output_data
.win32
->left_pos
,
2618 f
->output_data
.win32
->top_pos
,
2628 SetWindowLong (hwnd
, WND_X_UNITS_INDEX
, FONT_WIDTH (f
->output_data
.win32
->font
));
2629 SetWindowLong (hwnd
, WND_Y_UNITS_INDEX
, f
->output_data
.win32
->line_height
);
2630 SetWindowLong (hwnd
, WND_BACKGROUND_INDEX
, f
->output_data
.win32
->background_pixel
);
2632 /* Do this to discard the default setting specified by our parent. */
2633 ShowWindow (hwnd
, SW_HIDE
);
2637 /* Convert between the modifier bits Win32 uses and the modifier bits
2640 win32_get_modifiers ()
2642 return (((GetKeyState (VK_SHIFT
)&0x8000) ? shift_modifier
: 0) |
2643 ((GetKeyState (VK_CONTROL
)&0x8000) ? ctrl_modifier
: 0) |
2644 ((GetKeyState (VK_MENU
)&0x8000) ? meta_modifier
: 0));
2648 my_post_msg (wmsg
, hwnd
, msg
, wParam
, lParam
)
2655 wmsg
->msg
.hwnd
= hwnd
;
2656 wmsg
->msg
.message
= msg
;
2657 wmsg
->msg
.wParam
= wParam
;
2658 wmsg
->msg
.lParam
= lParam
;
2659 wmsg
->msg
.time
= GetMessageTime ();
2664 /* GetKeyState and MapVirtualKey on Win95 do not actually distinguish
2665 between left and right keys as advertised. We test for this
2666 support dynamically, and set a flag when the support is absent. If
2667 absent, we keep track of the left and right control and alt keys
2668 ourselves. This is particularly necessary on keyboards that rely
2669 upon the AltGr key, which is represented as having the left control
2670 and right alt keys pressed. For these keyboards, we need to know
2671 when the left alt key has been pressed in addition to the AltGr key
2672 so that we can properly support M-AltGr-key sequences (such as M-@
2673 on Swedish keyboards). */
2675 #define EMACS_LCONTROL 0
2676 #define EMACS_RCONTROL 1
2677 #define EMACS_LMENU 2
2678 #define EMACS_RMENU 3
2680 static int modifiers
[4];
2681 static int modifiers_recorded
;
2682 static int modifier_key_support_tested
;
2685 test_modifier_support (unsigned int wparam
)
2689 if (wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
)
2691 if (wparam
== VK_CONTROL
)
2701 if (!(GetKeyState (l
) & 0x8000) && !(GetKeyState (r
) & 0x8000))
2702 modifiers_recorded
= 1;
2704 modifiers_recorded
= 0;
2705 modifier_key_support_tested
= 1;
2709 record_keydown (unsigned int wparam
, unsigned int lparam
)
2713 if (!modifier_key_support_tested
)
2714 test_modifier_support (wparam
);
2716 if ((wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
) || !modifiers_recorded
)
2719 if (wparam
== VK_CONTROL
)
2720 i
= (lparam
& 0x1000000) ? EMACS_RCONTROL
: EMACS_LCONTROL
;
2722 i
= (lparam
& 0x1000000) ? EMACS_RMENU
: EMACS_LMENU
;
2728 record_keyup (unsigned int wparam
, unsigned int lparam
)
2732 if ((wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
) || !modifiers_recorded
)
2735 if (wparam
== VK_CONTROL
)
2736 i
= (lparam
& 0x1000000) ? EMACS_RCONTROL
: EMACS_LCONTROL
;
2738 i
= (lparam
& 0x1000000) ? EMACS_RMENU
: EMACS_LMENU
;
2743 /* Emacs can lose focus while a modifier key has been pressed. When
2744 it regains focus, be conservative and clear all modifiers since
2745 we cannot reconstruct the left and right modifier state. */
2749 if (!modifiers_recorded
)
2751 bzero (modifiers
, sizeof (modifiers
));
2755 modifier_set (int vkey
)
2757 if (!modifiers_recorded
)
2758 return (GetKeyState (vkey
) & 0x8000);
2763 return modifiers
[EMACS_LCONTROL
];
2765 return modifiers
[EMACS_RCONTROL
];
2767 return modifiers
[EMACS_LMENU
];
2769 return modifiers
[EMACS_RMENU
];
2771 return (GetKeyState (vkey
) & 0x1);
2775 return (GetKeyState (vkey
) & 0x8000);
2778 /* We map the VK_* modifiers into console modifier constants
2779 so that we can use the same routines to handle both console
2780 and window input. */
2783 construct_modifiers (unsigned int wparam
, unsigned int lparam
)
2787 if (wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
)
2788 mods
= GetLastError ();
2791 mods
|= (modifier_set (VK_SHIFT
)) ? SHIFT_PRESSED
: 0;
2792 mods
|= (modifier_set (VK_CAPITAL
)) ? CAPSLOCK_ON
: 0;
2793 mods
|= (modifier_set (VK_LCONTROL
)) ? LEFT_CTRL_PRESSED
: 0;
2794 mods
|= (modifier_set (VK_RCONTROL
)) ? RIGHT_CTRL_PRESSED
: 0;
2795 mods
|= (modifier_set (VK_LMENU
)) ? LEFT_ALT_PRESSED
: 0;
2796 mods
|= (modifier_set (VK_RMENU
)) ? RIGHT_ALT_PRESSED
: 0;
2802 map_keypad_keys (unsigned int wparam
, unsigned int lparam
)
2804 unsigned int extended
= (lparam
& 0x1000000L
);
2806 if (wparam
< VK_CLEAR
|| wparam
> VK_DELETE
)
2809 if (wparam
== VK_RETURN
)
2810 return (extended
? VK_NUMPAD_ENTER
: VK_RETURN
);
2812 if (wparam
>= VK_PRIOR
&& wparam
<= VK_DOWN
)
2813 return (!extended
? (VK_NUMPAD_PRIOR
+ (wparam
- VK_PRIOR
)) : wparam
);
2815 if (wparam
== VK_INSERT
|| wparam
== VK_DELETE
)
2816 return (!extended
? (VK_NUMPAD_INSERT
+ (wparam
- VK_INSERT
)) : wparam
);
2818 if (wparam
== VK_CLEAR
)
2819 return (!extended
? VK_NUMPAD_CLEAR
: wparam
);
2824 /* Main message dispatch loop. */
2832 /* Ensure our message queue is created */
2834 PeekMessage (&msg
, NULL
, 0, 0, PM_NOREMOVE
);
2836 PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
, 0, 0);
2838 while (GetMessage (&msg
, NULL
, 0, 0))
2840 if (msg
.hwnd
== NULL
)
2842 switch (msg
.message
)
2845 if (saved_mouse_msg
.msg
.hwnd
)
2847 post_msg (&saved_mouse_msg
);
2848 saved_mouse_msg
.msg
.hwnd
= 0;
2852 case WM_EMACS_CREATEWINDOW
:
2853 win32_createwindow ((struct frame
*) msg
.wParam
);
2854 PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
, 0, 0);
2856 case WM_EMACS_CREATESCROLLBAR
:
2858 HWND hwnd
= win32_createscrollbar ((struct frame
*) msg
.wParam
,
2859 (struct scroll_bar
*) msg
.lParam
);
2860 PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
, (WPARAM
)hwnd
, 0);
2869 DispatchMessage (&msg
);
2876 /* Main window procedure */
2878 extern char *lispy_function_keys
[];
2881 win32_wnd_proc (hwnd
, msg
, wParam
, lParam
)
2889 struct win32_display_info
*dpyinfo
= &one_win32_display_info
;
2896 GetUpdateRect (hwnd
, &wmsg
.rect
, FALSE
);
2898 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
2900 case WM_PALETTECHANGED
:
2901 /* ignore our own changes */
2902 if ((HWND
)wParam
!= hwnd
)
2904 /* simply notify main thread it may need to update frames */
2905 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
2910 PAINTSTRUCT paintStruct
;
2913 BeginPaint (hwnd
, &paintStruct
);
2914 wmsg
.rect
= paintStruct
.rcPaint
;
2915 EndPaint (hwnd
, &paintStruct
);
2918 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
2925 record_keyup (wParam
, lParam
);
2930 record_keydown (wParam
, lParam
);
2932 wParam
= map_keypad_keys (wParam
, lParam
);
2938 /* More support for these keys will likely be necessary. */
2939 if (!NILP (Vwin32_pass_optional_keys_to_system
))
2943 if (NILP (Vwin32_pass_alt_to_system
))
2950 /* Pass on to Windows. */
2953 /* If not defined as a function key, change it to a WM_CHAR message. */
2954 if (lispy_function_keys
[wParam
] == 0)
2963 wmsg
.dwModifiers
= construct_modifiers (wParam
, lParam
);
2966 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
2969 /* Detect quit_char and set quit-flag directly. Note that we dow
2970 this *after* posting the message to ensure the main thread will
2971 be woken up if blocked in sys_select(). */
2974 if (isalpha (c
) && (wmsg
.dwModifiers
== LEFT_CTRL_PRESSED
2975 || wmsg
.dwModifiers
== RIGHT_CTRL_PRESSED
))
2976 c
= make_ctrl_char (c
) & 0377;
2985 /* Simulate middle mouse button events when left and right buttons
2986 are used together, but only if user has two button mouse. */
2987 case WM_LBUTTONDOWN
:
2988 case WM_RBUTTONDOWN
:
2989 if (XINT (Vwin32_num_mouse_buttons
) == 3)
2990 goto handle_plain_button
;
2993 int this = (msg
== WM_LBUTTONDOWN
) ? LMOUSE
: RMOUSE
;
2994 int other
= (msg
== WM_LBUTTONDOWN
) ? RMOUSE
: LMOUSE
;
2996 if (button_state
& this)
2999 if (button_state
== 0)
3002 button_state
|= this;
3004 if (button_state
& other
)
3008 KillTimer (NULL
, timer_id
);
3011 /* Generate middle mouse event instead. */
3012 msg
= WM_MBUTTONDOWN
;
3013 button_state
|= MMOUSE
;
3015 else if (button_state
& MMOUSE
)
3017 /* Ignore button event if we've already generated a
3018 middle mouse down event. This happens if the
3019 user releases and press one of the two buttons
3020 after we've faked a middle mouse event. */
3025 /* Flush out saved message. */
3026 post_msg (&saved_mouse_msg
);
3028 wmsg
.dwModifiers
= win32_get_modifiers ();
3029 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3031 /* Clear message buffer. */
3032 saved_mouse_msg
.msg
.hwnd
= 0;
3036 /* Hold onto message for now. */
3038 SetTimer (NULL
, 0, XINT (Vwin32_mouse_button_tolerance
), NULL
);
3039 saved_mouse_msg
.msg
.hwnd
= hwnd
;
3040 saved_mouse_msg
.msg
.message
= msg
;
3041 saved_mouse_msg
.msg
.wParam
= wParam
;
3042 saved_mouse_msg
.msg
.lParam
= lParam
;
3043 saved_mouse_msg
.msg
.time
= GetMessageTime ();
3044 saved_mouse_msg
.dwModifiers
= win32_get_modifiers ();
3051 if (XINT (Vwin32_num_mouse_buttons
) == 3)
3052 goto handle_plain_button
;
3055 int this = (msg
== WM_LBUTTONUP
) ? LMOUSE
: RMOUSE
;
3056 int other
= (msg
== WM_LBUTTONUP
) ? RMOUSE
: LMOUSE
;
3058 if ((button_state
& this) == 0)
3061 button_state
&= ~this;
3063 if (button_state
& MMOUSE
)
3065 /* Only generate event when second button is released. */
3066 if ((button_state
& other
) == 0)
3069 button_state
&= ~MMOUSE
;
3071 if (button_state
) abort ();
3078 /* Flush out saved message if necessary. */
3079 if (saved_mouse_msg
.msg
.hwnd
)
3081 post_msg (&saved_mouse_msg
);
3084 wmsg
.dwModifiers
= win32_get_modifiers ();
3085 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3087 /* Always clear message buffer and cancel timer. */
3088 saved_mouse_msg
.msg
.hwnd
= 0;
3089 KillTimer (NULL
, timer_id
);
3092 if (button_state
== 0)
3097 case WM_MBUTTONDOWN
:
3099 handle_plain_button
:
3103 if (parse_button (msg
, NULL
, &up
))
3105 if (up
) ReleaseCapture ();
3106 else SetCapture (hwnd
);
3110 wmsg
.dwModifiers
= win32_get_modifiers ();
3111 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3116 /* Flush out saved message if necessary. */
3117 if (saved_mouse_msg
.msg
.hwnd
)
3119 wmsg
= saved_mouse_msg
;
3120 my_post_msg (&wmsg
, wmsg
.msg
.hwnd
, wmsg
.msg
.message
,
3121 wmsg
.msg
.wParam
, wmsg
.msg
.lParam
);
3123 wmsg
.dwModifiers
= win32_get_modifiers ();
3124 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3126 /* Always clear message buffer and cancel timer. */
3127 saved_mouse_msg
.msg
.hwnd
= 0;
3128 KillTimer (NULL
, timer_id
);
3143 wmsg
.dwModifiers
= win32_get_modifiers ();
3144 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3148 wmsg
.dwModifiers
= win32_get_modifiers ();
3149 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3152 case WM_WINDOWPOSCHANGING
:
3155 LPWINDOWPOS lppos
= (WINDOWPOS
*) lParam
;
3157 GetWindowPlacement (hwnd
, &wp
);
3159 if (wp
.showCmd
!= SW_SHOWMINIMIZED
&& ! (lppos
->flags
& SWP_NOSIZE
))
3168 wp
.length
= sizeof(wp
);
3169 GetWindowRect (hwnd
, &wr
);
3173 dwXUnits
= GetWindowLong (hwnd
, WND_X_UNITS_INDEX
);
3174 dwYUnits
= GetWindowLong (hwnd
, WND_Y_UNITS_INDEX
);
3178 memset (&rect
, 0, sizeof (rect
));
3179 AdjustWindowRect (&rect
, GetWindowLong (hwnd
, GWL_STYLE
),
3180 GetMenu (hwnd
) != NULL
);
3182 /* All windows have an extra pixel so subtract 1 */
3184 wdiff
= (lppos
->cx
- (rect
.right
- rect
.left
) - 0) % dwXUnits
;
3185 hdiff
= (lppos
->cy
- (rect
.bottom
- rect
.top
) - 0) % dwYUnits
;
3189 /* For right/bottom sizing we can just fix the sizes.
3190 However for top/left sizing we will need to fix the X
3191 and Y positions as well. */
3196 if (wp
.showCmd
!= SW_SHOWMAXIMIZED
3197 && ! (lppos
->flags
& SWP_NOMOVE
))
3199 if (lppos
->x
!= wr
.left
|| lppos
->y
!= wr
.top
)
3206 lppos
->flags
|= SWP_NOMOVE
;
3215 if (ret
== 0) return (0);
3218 case WM_EMACS_SHOWWINDOW
:
3219 return ShowWindow (hwnd
, wParam
);
3220 case WM_EMACS_SETWINDOWPOS
:
3222 Win32WindowPos
* pos
= (Win32WindowPos
*) wParam
;
3223 return SetWindowPos (hwnd
, pos
->hwndAfter
,
3224 pos
->x
, pos
->y
, pos
->cx
, pos
->cy
, pos
->flags
);
3226 case WM_EMACS_DESTROYWINDOW
:
3227 DestroyWindow ((HWND
) wParam
);
3231 return DefWindowProc (hwnd
, msg
, wParam
, lParam
);
3238 my_create_window (f
)
3243 PostThreadMessage (dwWinThreadId
, WM_EMACS_CREATEWINDOW
, (WPARAM
)f
, 0);
3244 GetMessage (&msg
, NULL
, WM_EMACS_DONE
, WM_EMACS_DONE
);
3247 /* Create and set up the win32 window for frame F. */
3250 win32_window (f
, window_prompting
, minibuffer_only
)
3252 long window_prompting
;
3253 int minibuffer_only
;
3257 /* Use the resource name as the top-level window name
3258 for looking up resources. Make a non-Lisp copy
3259 for the window manager, so GC relocation won't bother it.
3261 Elsewhere we specify the window name for the window manager. */
3264 char *str
= (char *) XSTRING (Vx_resource_name
)->data
;
3265 f
->namebuf
= (char *) xmalloc (strlen (str
) + 1);
3266 strcpy (f
->namebuf
, str
);
3269 my_create_window (f
);
3271 validate_x_resource_name ();
3273 /* x_set_name normally ignores requests to set the name if the
3274 requested name is the same as the current name. This is the one
3275 place where that assumption isn't correct; f->name is set, but
3276 the server hasn't been told. */
3279 int explicit = f
->explicit_name
;
3281 f
->explicit_name
= 0;
3284 x_set_name (f
, name
, explicit);
3289 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
3290 initialize_frame_menubar (f
);
3292 if (FRAME_WIN32_WINDOW (f
) == 0)
3293 error ("Unable to create window");
3296 /* Handle the icon stuff for this window. Perhaps later we might
3297 want an x_set_icon_position which can be called interactively as
3305 Lisp_Object icon_x
, icon_y
;
3307 /* Set the position of the icon. Note that win95 groups all
3308 icons in the tray. */
3309 icon_x
= x_get_arg (parms
, Qicon_left
, 0, 0, number
);
3310 icon_y
= x_get_arg (parms
, Qicon_top
, 0, 0, number
);
3311 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
3313 CHECK_NUMBER (icon_x
, 0);
3314 CHECK_NUMBER (icon_y
, 0);
3316 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
3317 error ("Both left and top icon corners of icon must be specified");
3321 if (! EQ (icon_x
, Qunbound
))
3322 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
3327 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
3329 "Make a new window, which is called a \"frame\" in Emacs terms.\n\
3330 Returns an Emacs frame object.\n\
3331 ALIST is an alist of frame parameters.\n\
3332 If the parameters specify that the frame should not have a minibuffer,\n\
3333 and do not specify a specific minibuffer window to use,\n\
3334 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
3335 be shared by the new frame.\n\
3337 This function is an internal primitive--use `make-frame' instead.")
3342 Lisp_Object frame
, tem
;
3344 int minibuffer_only
= 0;
3345 long window_prompting
= 0;
3347 int count
= specpdl_ptr
- specpdl
;
3348 struct gcpro gcpro1
;
3349 Lisp_Object display
;
3350 struct win32_display_info
*dpyinfo
;
3354 /* Use this general default value to start with
3355 until we know if this frame has a specified name. */
3356 Vx_resource_name
= Vinvocation_name
;
3358 display
= x_get_arg (parms
, Qdisplay
, 0, 0, string
);
3359 if (EQ (display
, Qunbound
))
3361 dpyinfo
= check_x_display_info (display
);
3363 kb
= dpyinfo
->kboard
;
3365 kb
= &the_only_kboard
;
3368 name
= x_get_arg (parms
, Qname
, "title", "Title", string
);
3370 && ! EQ (name
, Qunbound
)
3372 error ("Invalid frame name--not a string or nil");
3375 Vx_resource_name
= name
;
3377 /* See if parent window is specified. */
3378 parent
= x_get_arg (parms
, Qparent_id
, NULL
, NULL
, number
);
3379 if (EQ (parent
, Qunbound
))
3381 if (! NILP (parent
))
3382 CHECK_NUMBER (parent
, 0);
3384 tem
= x_get_arg (parms
, Qminibuffer
, 0, 0, symbol
);
3385 if (EQ (tem
, Qnone
) || NILP (tem
))
3386 f
= make_frame_without_minibuffer (Qnil
, kb
, display
);
3387 else if (EQ (tem
, Qonly
))
3389 f
= make_minibuffer_frame ();
3390 minibuffer_only
= 1;
3392 else if (WINDOWP (tem
))
3393 f
= make_frame_without_minibuffer (tem
, kb
, display
);
3397 /* Note that Windows does support scroll bars. */
3398 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
3399 /* By default, make scrollbars the system standard width. */
3400 f
->scroll_bar_pixel_width
= GetSystemMetrics (SM_CXVSCROLL
);
3402 XSETFRAME (frame
, f
);
3405 f
->output_method
= output_win32
;
3406 f
->output_data
.win32
= (struct win32_output
*) xmalloc (sizeof (struct win32_output
));
3407 bzero (f
->output_data
.win32
, sizeof (struct win32_output
));
3409 /* FRAME_WIN32_DISPLAY_INFO (f) = dpyinfo; */
3411 FRAME_KBOARD (f
) = kb
;
3414 /* Specify the parent under which to make this window. */
3418 f
->output_data
.win32
->parent_desc
= (Window
) parent
;
3419 f
->output_data
.win32
->explicit_parent
= 1;
3423 f
->output_data
.win32
->parent_desc
= FRAME_WIN32_DISPLAY_INFO (f
)->root_window
;
3424 f
->output_data
.win32
->explicit_parent
= 0;
3427 /* Note that the frame has no physical cursor right now. */
3428 f
->phys_cursor_x
= -1;
3430 /* Set the name; the functions to which we pass f expect the name to
3432 if (EQ (name
, Qunbound
) || NILP (name
))
3434 f
->name
= build_string (dpyinfo
->win32_id_name
);
3435 f
->explicit_name
= 0;
3440 f
->explicit_name
= 1;
3441 /* use the frame's title when getting resources for this frame. */
3442 specbind (Qx_resource_name
, name
);
3445 /* Extract the window parameters from the supplied values
3446 that are needed to determine window geometry. */
3450 font
= x_get_arg (parms
, Qfont
, "font", "Font", string
);
3452 /* First, try whatever font the caller has specified. */
3454 font
= x_new_font (f
, XSTRING (font
)->data
);
3456 /* Try out a font which we hope has bold and italic variations. */
3457 if (!STRINGP (font
))
3458 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3459 if (! STRINGP (font
))
3460 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3461 if (! STRINGP (font
))
3462 /* This was formerly the first thing tried, but it finds too many fonts
3463 and takes too long. */
3464 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
3465 /* If those didn't work, look for something which will at least work. */
3466 if (! STRINGP (font
))
3467 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
3468 if (! STRINGP (font
))
3469 font
= x_new_font (f
, "-*-system-medium-r-normal-*-*-200-*-*-c-120-*-*");
3471 if (! STRINGP (font
))
3472 font
= x_new_font (f
, "-*-Fixedsys-*-r-*-*-12-90-*-*-c-*-*-*");
3474 if (! STRINGP (font
))
3475 font
= build_string ("-*-system");
3477 x_default_parameter (f
, parms
, Qfont
, font
,
3478 "font", "Font", string
);
3481 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
3482 "borderwidth", "BorderWidth", number
);
3483 /* This defaults to 2 in order to match xterm. We recognize either
3484 internalBorderWidth or internalBorder (which is what xterm calls
3486 if (NILP (Fassq (Qinternal_border_width
, parms
)))
3490 value
= x_get_arg (parms
, Qinternal_border_width
,
3491 "internalBorder", "BorderWidth", number
);
3492 if (! EQ (value
, Qunbound
))
3493 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
3496 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (0),
3497 "internalBorderWidth", "BorderWidth", number
);
3498 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qt
,
3499 "verticalScrollBars", "ScrollBars", boolean
);
3501 /* Also do the stuff which must be set before the window exists. */
3502 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
3503 "foreground", "Foreground", string
);
3504 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
3505 "background", "Background", string
);
3506 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
3507 "pointerColor", "Foreground", string
);
3508 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
3509 "cursorColor", "Foreground", string
);
3510 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
3511 "borderColor", "BorderColor", string
);
3513 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (1),
3514 "menuBar", "MenuBar", number
);
3515 x_default_parameter (f
, parms
, Qscroll_bar_width
, Qnil
,
3516 "scrollBarWidth", "ScrollBarWidth", number
);
3518 f
->output_data
.win32
->dwStyle
= WS_OVERLAPPEDWINDOW
;
3519 f
->output_data
.win32
->parent_desc
= FRAME_WIN32_DISPLAY_INFO (f
)->root_window
;
3520 window_prompting
= x_figure_window_size (f
, parms
);
3522 if (window_prompting
& XNegative
)
3524 if (window_prompting
& YNegative
)
3525 f
->output_data
.win32
->win_gravity
= SouthEastGravity
;
3527 f
->output_data
.win32
->win_gravity
= NorthEastGravity
;
3531 if (window_prompting
& YNegative
)
3532 f
->output_data
.win32
->win_gravity
= SouthWestGravity
;
3534 f
->output_data
.win32
->win_gravity
= NorthWestGravity
;
3537 f
->output_data
.win32
->size_hint_flags
= window_prompting
;
3539 win32_window (f
, window_prompting
, minibuffer_only
);
3541 init_frame_faces (f
);
3543 /* We need to do this after creating the window, so that the
3544 icon-creation functions can say whose icon they're describing. */
3545 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
3546 "bitmapIcon", "BitmapIcon", symbol
);
3548 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
3549 "autoRaise", "AutoRaiseLower", boolean
);
3550 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
3551 "autoLower", "AutoRaiseLower", boolean
);
3552 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
3553 "cursorType", "CursorType", symbol
);
3555 /* Dimensions, especially f->height, must be done via change_frame_size.
3556 Change will not be effected unless different from the current
3560 f
->height
= f
->width
= 0;
3561 change_frame_size (f
, height
, width
, 1, 0);
3563 /* Tell the server what size and position, etc, we want,
3564 and how badly we want them. */
3566 x_wm_set_size_hint (f
, window_prompting
, 0);
3569 tem
= x_get_arg (parms
, Qunsplittable
, 0, 0, boolean
);
3570 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
3574 /* It is now ok to make the frame official
3575 even if we get an error below.
3576 And the frame needs to be on Vframe_list
3577 or making it visible won't work. */
3578 Vframe_list
= Fcons (frame
, Vframe_list
);
3580 /* Now that the frame is official, it counts as a reference to
3582 FRAME_WIN32_DISPLAY_INFO (f
)->reference_count
++;
3584 /* Make the window appear on the frame and enable display,
3585 unless the caller says not to. However, with explicit parent,
3586 Emacs cannot control visibility, so don't try. */
3587 if (! f
->output_data
.win32
->explicit_parent
)
3589 Lisp_Object visibility
;
3591 visibility
= x_get_arg (parms
, Qvisibility
, 0, 0, symbol
);
3592 if (EQ (visibility
, Qunbound
))
3595 if (EQ (visibility
, Qicon
))
3596 x_iconify_frame (f
);
3597 else if (! NILP (visibility
))
3598 x_make_frame_visible (f
);
3600 /* Must have been Qnil. */
3604 return unbind_to (count
, frame
);
3607 /* FRAME is used only to get a handle on the X display. We don't pass the
3608 display info directly because we're called from frame.c, which doesn't
3609 know about that structure. */
3611 x_get_focus_frame (frame
)
3612 struct frame
*frame
;
3614 struct win32_display_info
*dpyinfo
= FRAME_WIN32_DISPLAY_INFO (frame
);
3616 if (! dpyinfo
->win32_focus_frame
)
3619 XSETFRAME (xfocus
, dpyinfo
->win32_focus_frame
);
3623 DEFUN ("focus-frame", Ffocus_frame
, Sfocus_frame
, 1, 1, 0,
3624 "This function is obsolete, and does nothing.")
3631 DEFUN ("unfocus-frame", Funfocus_frame
, Sunfocus_frame
, 0, 0, 0,
3632 "This function is obsolete, and does nothing.")
3639 win32_load_font (dpyinfo
,name
)
3640 struct win32_display_info
*dpyinfo
;
3643 XFontStruct
* font
= NULL
;
3649 if (!name
|| !x_to_win32_font (name
, &lf
))
3652 font
= (XFontStruct
*) xmalloc (sizeof (XFontStruct
));
3654 if (!font
) return (NULL
);
3658 font
->hfont
= CreateFontIndirect (&lf
);
3661 if (font
->hfont
== NULL
)
3670 hdc
= GetDC (dpyinfo
->root_window
);
3671 oldobj
= SelectObject (hdc
, font
->hfont
);
3672 ok
= GetTextMetrics (hdc
, &font
->tm
);
3673 SelectObject (hdc
, oldobj
);
3674 ReleaseDC (dpyinfo
->root_window
, hdc
);
3679 if (ok
) return (font
);
3681 win32_unload_font (dpyinfo
, font
);
3686 win32_unload_font (dpyinfo
, font
)
3687 struct win32_display_info
*dpyinfo
;
3692 if (font
->hfont
) DeleteObject(font
->hfont
);
3697 /* The font conversion stuff between x and win32 */
3699 /* X font string is as follows (from faces.el)
3703 * (weight "\\(bold\\|demibold\\|medium\\)") ; 1
3704 * (weight\? "\\([^-]*\\)") ; 1
3705 * (slant "\\([ior]\\)") ; 2
3706 * (slant\? "\\([^-]?\\)") ; 2
3707 * (swidth "\\([^-]*\\)") ; 3
3708 * (adstyle "[^-]*") ; 4
3709 * (pixelsize "[0-9]+")
3710 * (pointsize "[0-9][0-9]+")
3711 * (resx "[0-9][0-9]+")
3712 * (resy "[0-9][0-9]+")
3713 * (spacing "[cmp?*]")
3714 * (avgwidth "[0-9]+")
3715 * (registry "[^-]+")
3716 * (encoding "[^-]+")
3718 * (setq x-font-regexp
3719 * (concat "\\`\\*?[-?*]"
3720 * foundry - family - weight\? - slant\? - swidth - adstyle -
3721 * pixelsize - pointsize - resx - resy - spacing - registry -
3722 * encoding "[-?*]\\*?\\'"
3724 * (setq x-font-regexp-head
3725 * (concat "\\`[-?*]" foundry - family - weight\? - slant\?
3726 * "\\([-*?]\\|\\'\\)"))
3727 * (setq x-font-regexp-slant (concat - slant -))
3728 * (setq x-font-regexp-weight (concat - weight -))
3732 #define FONT_START "[-?]"
3733 #define FONT_FOUNDRY "[^-]+"
3734 #define FONT_FAMILY "\\([^-]+\\)" /* 1 */
3735 #define FONT_WEIGHT "\\(bold\\|demibold\\|medium\\)" /* 2 */
3736 #define FONT_WEIGHT_Q "\\([^-]*\\)" /* 2 */
3737 #define FONT_SLANT "\\([ior]\\)" /* 3 */
3738 #define FONT_SLANT_Q "\\([^-]?\\)" /* 3 */
3739 #define FONT_SWIDTH "\\([^-]*\\)" /* 4 */
3740 #define FONT_ADSTYLE "[^-]*"
3741 #define FONT_PIXELSIZE "[^-]*"
3742 #define FONT_POINTSIZE "\\([0-9][0-9]+\\|\\*\\)" /* 5 */
3743 #define FONT_RESX "[0-9][0-9]+"
3744 #define FONT_RESY "[0-9][0-9]+"
3745 #define FONT_SPACING "[cmp?*]"
3746 #define FONT_AVGWIDTH "[0-9]+"
3747 #define FONT_REGISTRY "[^-]+"
3748 #define FONT_ENCODING "[^-]+"
3750 #define FONT_REGEXP ("\\`\\*?[-?*]" \
3757 FONT_PIXELSIZE "-" \
3758 FONT_POINTSIZE "-" \
3761 #define FONT_REGEXP_HEAD ("\\`[-?*]" \
3766 "\\([-*?]\\|\\'\\)")
3768 #define FONT_REGEXP_SLANT "-" FONT_SLANT "-"
3769 #define FONT_REGEXP_WEIGHT "-" FONT_WEIGHT "-"
3772 x_to_win32_weight (lpw
)
3775 if (!lpw
) return (FW_DONTCARE
);
3777 if (stricmp (lpw
,"heavy") == 0) return FW_HEAVY
;
3778 else if (stricmp (lpw
,"extrabold") == 0) return FW_EXTRABOLD
;
3779 else if (stricmp (lpw
,"bold") == 0) return FW_BOLD
;
3780 else if (stricmp (lpw
,"demibold") == 0) return FW_SEMIBOLD
;
3781 else if (stricmp (lpw
,"medium") == 0) return FW_MEDIUM
;
3782 else if (stricmp (lpw
,"normal") == 0) return FW_NORMAL
;
3783 else if (stricmp (lpw
,"light") == 0) return FW_LIGHT
;
3784 else if (stricmp (lpw
,"extralight") == 0) return FW_EXTRALIGHT
;
3785 else if (stricmp (lpw
,"thin") == 0) return FW_THIN
;
3792 win32_to_x_weight (fnweight
)
3795 if (fnweight
>= FW_HEAVY
) return "heavy";
3796 if (fnweight
>= FW_EXTRABOLD
) return "extrabold";
3797 if (fnweight
>= FW_BOLD
) return "bold";
3798 if (fnweight
>= FW_SEMIBOLD
) return "semibold";
3799 if (fnweight
>= FW_MEDIUM
) return "medium";
3800 if (fnweight
>= FW_NORMAL
) return "normal";
3801 if (fnweight
>= FW_LIGHT
) return "light";
3802 if (fnweight
>= FW_EXTRALIGHT
) return "extralight";
3803 if (fnweight
>= FW_THIN
) return "thin";
3809 x_to_win32_charset (lpcs
)
3812 if (!lpcs
) return (0);
3814 if (stricmp (lpcs
,"ansi") == 0) return ANSI_CHARSET
;
3815 else if (stricmp (lpcs
,"iso8859-1") == 0) return ANSI_CHARSET
;
3816 else if (stricmp (lpcs
,"iso8859") == 0) return ANSI_CHARSET
;
3817 else if (stricmp (lpcs
,"oem") == 0) return OEM_CHARSET
;
3818 #ifdef UNICODE_CHARSET
3819 else if (stricmp (lpcs
,"unicode") == 0) return UNICODE_CHARSET
;
3820 else if (stricmp (lpcs
,"iso10646") == 0) return UNICODE_CHARSET
;
3827 win32_to_x_charset (fncharset
)
3832 case ANSI_CHARSET
: return "ansi";
3833 case OEM_CHARSET
: return "oem";
3834 case SYMBOL_CHARSET
: return "symbol";
3835 #ifdef UNICODE_CHARSET
3836 case UNICODE_CHARSET
: return "unicode";
3843 win32_to_x_font (lplogfont
, lpxstr
, len
)
3844 LOGFONT
* lplogfont
;
3848 char height_pixels
[8];
3850 char width_pixels
[8];
3852 if (!lpxstr
) abort ();
3857 if (lplogfont
->lfHeight
)
3859 sprintf (height_pixels
, "%u", abs (lplogfont
->lfHeight
));
3860 sprintf (height_dpi
, "%u",
3861 (abs (lplogfont
->lfHeight
) * 720) / one_win32_display_info
.height_in
);
3865 strcpy (height_pixels
, "*");
3866 strcpy (height_dpi
, "*");
3868 if (lplogfont
->lfWidth
)
3869 sprintf (width_pixels
, "%u", lplogfont
->lfWidth
* 10);
3871 strcpy (width_pixels
, "*");
3873 _snprintf (lpxstr
, len
- 1,
3874 "-*-%s-%s-%c-*-*-%s-%s-*-*-%c-%s-*-%s-",
3875 lplogfont
->lfFaceName
,
3876 win32_to_x_weight (lplogfont
->lfWeight
),
3877 lplogfont
->lfItalic
?'i':'r',
3880 ((lplogfont
->lfPitchAndFamily
& 0x3) == VARIABLE_PITCH
) ? 'p' : 'c',
3882 win32_to_x_charset (lplogfont
->lfCharSet
)
3885 lpxstr
[len
- 1] = 0; /* just to be sure */
3890 x_to_win32_font (lpxstr
, lplogfont
)
3892 LOGFONT
* lplogfont
;
3894 if (!lplogfont
) return (FALSE
);
3896 memset (lplogfont
, 0, sizeof (*lplogfont
));
3899 lplogfont
->lfOutPrecision
= OUT_DEFAULT_PRECIS
;
3900 lplogfont
->lfClipPrecision
= CLIP_DEFAULT_PRECIS
;
3901 lplogfont
->lfQuality
= DEFAULT_QUALITY
;
3903 /* go for maximum quality */
3904 lplogfont
->lfOutPrecision
= OUT_STROKE_PRECIS
;
3905 lplogfont
->lfClipPrecision
= CLIP_STROKE_PRECIS
;
3906 lplogfont
->lfQuality
= PROOF_QUALITY
;
3912 /* Provide a simple escape mechanism for specifying Windows font names
3913 * directly -- if font spec does not beginning with '-', assume this
3915 * "<font name>[:height in pixels[:width in pixels[:weight]]]"
3921 char name
[50], weight
[20], slant
, pitch
, pixels
[10], height
[10], width
[10], remainder
[20];
3924 fields
= sscanf (lpxstr
,
3925 "-%*[^-]-%49[^-]-%19[^-]-%c-%*[^-]-%*[^-]-%9[^-]-%9[^-]-%*[^-]-%*[^-]-%c-%9[^-]-%19s",
3926 name
, weight
, &slant
, pixels
, height
, &pitch
, width
, remainder
);
3928 if (fields
== EOF
) return (FALSE
);
3930 if (fields
> 0 && name
[0] != '*')
3932 strncpy (lplogfont
->lfFaceName
,name
, LF_FACESIZE
);
3933 lplogfont
->lfFaceName
[LF_FACESIZE
-1] = 0;
3937 lplogfont
->lfFaceName
[0] = 0;
3942 lplogfont
->lfWeight
= x_to_win32_weight ((fields
> 0 ? weight
: ""));
3946 if (!NILP (Vwin32_enable_italics
))
3947 lplogfont
->lfItalic
= (fields
> 0 && slant
== 'i');
3951 if (fields
> 0 && pixels
[0] != '*')
3952 lplogfont
->lfHeight
= atoi (pixels
);
3956 if (fields
> 0 && lplogfont
->lfHeight
== 0 && height
[0] != '*')
3957 lplogfont
->lfHeight
= (atoi (height
)
3958 * one_win32_display_info
.height_in
) / 720;
3962 lplogfont
->lfPitchAndFamily
=
3963 (fields
> 0 && pitch
== 'p') ? VARIABLE_PITCH
: FIXED_PITCH
;
3967 if (fields
> 0 && width
[0] != '*')
3968 lplogfont
->lfWidth
= atoi (width
) / 10;
3972 /* Not all font specs include the registry field, so we allow for an
3973 optional registry field before the encoding when parsing
3974 remainder. Also we strip the trailing '-' if present. */
3976 int len
= strlen (remainder
);
3977 if (len
> 0 && remainder
[len
-1] == '-')
3978 remainder
[len
-1] = 0;
3980 encoding
= remainder
;
3981 if (strncmp (encoding
, "*-", 2) == 0)
3983 lplogfont
->lfCharSet
= x_to_win32_charset (fields
> 0 ? encoding
: "");
3988 char name
[100], height
[10], width
[10], weight
[20];
3990 fields
= sscanf (lpxstr
,
3991 "%99[^:]:%9[^:]:%9[^:]:%19s",
3992 name
, height
, width
, weight
);
3994 if (fields
== EOF
) return (FALSE
);
3998 strncpy (lplogfont
->lfFaceName
,name
, LF_FACESIZE
);
3999 lplogfont
->lfFaceName
[LF_FACESIZE
-1] = 0;
4003 lplogfont
->lfFaceName
[0] = 0;
4009 lplogfont
->lfHeight
= atoi (height
);
4014 lplogfont
->lfWidth
= atoi (width
);
4018 lplogfont
->lfWeight
= x_to_win32_weight ((fields
> 0 ? weight
: ""));
4021 /* This makes TrueType fonts work better. */
4022 lplogfont
->lfHeight
= - abs (lplogfont
->lfHeight
);
4028 win32_font_match (lpszfont1
, lpszfont2
)
4032 char * s1
= lpszfont1
, *e1
;
4033 char * s2
= lpszfont2
, *e2
;
4035 if (s1
== NULL
|| s2
== NULL
) return (FALSE
);
4037 if (*s1
== '-') s1
++;
4038 if (*s2
== '-') s2
++;
4044 e1
= strchr (s1
, '-');
4045 e2
= strchr (s2
, '-');
4047 if (e1
== NULL
|| e2
== NULL
) return (TRUE
);
4052 if (*s1
!= '*' && *s2
!= '*'
4053 && (len1
!= len2
|| strnicmp (s1
, s2
, len1
) != 0))
4061 typedef struct enumfont_t
4066 XFontStruct
*size_ref
;
4067 Lisp_Object
*pattern
;
4073 enum_font_cb2 (lplf
, lptm
, FontType
, lpef
)
4075 NEWTEXTMETRIC
* lptm
;
4079 if (lplf
->elfLogFont
.lfStrikeOut
|| lplf
->elfLogFont
.lfUnderline
4080 || (lplf
->elfLogFont
.lfCharSet
!= ANSI_CHARSET
&& lplf
->elfLogFont
.lfCharSet
!= OEM_CHARSET
))
4083 /* if (!lpef->size_ref || lptm->tmMaxCharWidth == FONT_WIDTH (lpef->size_ref)) */
4087 if (!NILP (*(lpef
->pattern
)) && FontType
== TRUETYPE_FONTTYPE
)
4089 lplf
->elfLogFont
.lfHeight
= lpef
->logfont
.lfHeight
;
4090 lplf
->elfLogFont
.lfWidth
= lpef
->logfont
.lfWidth
;
4093 if (!win32_to_x_font (lplf
, buf
, 100)) return (0);
4095 if (NILP (*(lpef
->pattern
)) || win32_font_match (buf
, XSTRING (*(lpef
->pattern
))->data
))
4097 *lpef
->tail
= Fcons (build_string (buf
), Qnil
);
4098 lpef
->tail
= &XCONS (*lpef
->tail
)->cdr
;
4107 enum_font_cb1 (lplf
, lptm
, FontType
, lpef
)
4109 NEWTEXTMETRIC
* lptm
;
4113 return EnumFontFamilies (lpef
->hdc
,
4114 lplf
->elfLogFont
.lfFaceName
,
4115 (FONTENUMPROC
) enum_font_cb2
,
4120 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 3, 0,
4121 "Return a list of the names of available fonts matching PATTERN.\n\
4122 If optional arguments FACE and FRAME are specified, return only fonts\n\
4123 the same size as FACE on FRAME.\n\
4125 PATTERN is a string, perhaps with wildcard characters;\n\
4126 the * character matches any substring, and\n\
4127 the ? character matches any single character.\n\
4128 PATTERN is case-insensitive.\n\
4129 FACE is a face name--a symbol.\n\
4131 The return value is a list of strings, suitable as arguments to\n\
4134 Fonts Emacs can't use (i.e. proportional fonts) may or may not be excluded\n\
4135 even if they match PATTERN and FACE.")
4136 (pattern
, face
, frame
)
4137 Lisp_Object pattern
, face
, frame
;
4142 XFontStruct
*size_ref
;
4143 Lisp_Object namelist
;
4148 CHECK_STRING (pattern
, 0);
4150 CHECK_SYMBOL (face
, 1);
4152 f
= check_x_frame (frame
);
4154 /* Determine the width standard for comparison with the fonts we find. */
4162 /* Don't die if we get called with a terminal frame. */
4163 if (! FRAME_WIN32_P (f
))
4164 error ("non-win32 frame used in `x-list-fonts'");
4166 face_id
= face_name_id_number (f
, face
);
4168 if (face_id
< 0 || face_id
>= FRAME_N_PARAM_FACES (f
)
4169 || FRAME_PARAM_FACES (f
) [face_id
] == 0)
4170 size_ref
= f
->output_data
.win32
->font
;
4173 size_ref
= FRAME_PARAM_FACES (f
) [face_id
]->font
;
4174 if (size_ref
== (XFontStruct
*) (~0))
4175 size_ref
= f
->output_data
.win32
->font
;
4179 /* See if we cached the result for this particular query. */
4180 list
= Fassoc (pattern
,
4181 XCONS (FRAME_WIN32_DISPLAY_INFO (f
)->name_list_element
)->cdr
);
4183 /* We have info in the cache for this PATTERN. */
4186 Lisp_Object tem
, newlist
;
4188 /* We have info about this pattern. */
4189 list
= XCONS (list
)->cdr
;
4196 /* Filter the cached info and return just the fonts that match FACE. */
4198 for (tem
= list
; CONSP (tem
); tem
= XCONS (tem
)->cdr
)
4200 XFontStruct
*thisinfo
;
4202 thisinfo
= win32_load_font (FRAME_WIN32_DISPLAY_INFO (f
), XSTRING (XCONS (tem
)->car
)->data
);
4204 if (thisinfo
&& same_size_fonts (thisinfo
, size_ref
))
4205 newlist
= Fcons (XCONS (tem
)->car
, newlist
);
4207 win32_unload_font (FRAME_WIN32_DISPLAY_INFO (f
), thisinfo
);
4218 ef
.pattern
= &pattern
;
4219 ef
.tail
= ef
.head
= &namelist
;
4221 x_to_win32_font (STRINGP (pattern
) ? XSTRING (pattern
)->data
: NULL
, &ef
.logfont
);
4224 ef
.hdc
= GetDC (FRAME_WIN32_WINDOW (f
));
4226 EnumFontFamilies (ef
.hdc
, NULL
, (FONTENUMPROC
) enum_font_cb1
, (LPARAM
)&ef
);
4228 ReleaseDC (FRAME_WIN32_WINDOW (f
), ef
.hdc
);
4238 /* Make a list of all the fonts we got back.
4239 Store that in the font cache for the display. */
4240 XCONS (FRAME_WIN32_DISPLAY_INFO (f
)->name_list_element
)->cdr
4241 = Fcons (Fcons (pattern
, namelist
),
4242 XCONS (FRAME_WIN32_DISPLAY_INFO (f
)->name_list_element
)->cdr
);
4244 /* Make a list of the fonts that have the right width. */
4247 for (i
= 0; i
< ef
.numFonts
; i
++)
4255 XFontStruct
*thisinfo
;
4258 thisinfo
= win32_load_font (FRAME_WIN32_DISPLAY_INFO (f
), XSTRING (Fcar (cur
))->data
);
4260 keeper
= thisinfo
&& same_size_fonts (thisinfo
, size_ref
);
4262 win32_unload_font (FRAME_WIN32_DISPLAY_INFO (f
), thisinfo
);
4267 list
= Fcons (build_string (XSTRING (Fcar (cur
))->data
), list
);
4271 list
= Fnreverse (list
);
4277 DEFUN ("x-color-defined-p", Fx_color_defined_p
, Sx_color_defined_p
, 1, 2, 0,
4278 "Return non-nil if color COLOR is supported on frame FRAME.\n\
4279 If FRAME is omitted or nil, use the selected frame.")
4281 Lisp_Object color
, frame
;
4284 FRAME_PTR f
= check_x_frame (frame
);
4286 CHECK_STRING (color
, 1);
4288 if (defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
4294 DEFUN ("x-color-values", Fx_color_values
, Sx_color_values
, 1, 2, 0,
4295 "Return a description of the color named COLOR on frame FRAME.\n\
4296 The value is a list of integer RGB values--(RED GREEN BLUE).\n\
4297 These values appear to range from 0 to 65280 or 65535, depending\n\
4298 on the system; white is (65280 65280 65280) or (65535 65535 65535).\n\
4299 If FRAME is omitted or nil, use the selected frame.")
4301 Lisp_Object color
, frame
;
4304 FRAME_PTR f
= check_x_frame (frame
);
4306 CHECK_STRING (color
, 1);
4308 if (defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
4312 rgb
[0] = make_number (GetRValue (foo
));
4313 rgb
[1] = make_number (GetGValue (foo
));
4314 rgb
[2] = make_number (GetBValue (foo
));
4315 return Flist (3, rgb
);
4321 DEFUN ("x-display-color-p", Fx_display_color_p
, Sx_display_color_p
, 0, 1, 0,
4322 "Return t if the X display supports color.\n\
4323 The optional argument DISPLAY specifies which display to ask about.\n\
4324 DISPLAY should be either a frame or a display name (a string).\n\
4325 If omitted or nil, that stands for the selected frame's display.")
4327 Lisp_Object display
;
4329 struct win32_display_info
*dpyinfo
= check_x_display_info (display
);
4331 if ((dpyinfo
->n_planes
* dpyinfo
->n_cbits
) <= 2)
4337 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
, Sx_display_grayscale_p
,
4339 "Return t if the X display supports shades of gray.\n\
4340 Note that color displays do support shades of gray.\n\
4341 The optional argument DISPLAY specifies which display to ask about.\n\
4342 DISPLAY should be either a frame or a display name (a string).\n\
4343 If omitted or nil, that stands for the selected frame's display.")
4345 Lisp_Object display
;
4347 struct win32_display_info
*dpyinfo
= check_x_display_info (display
);
4349 if ((dpyinfo
->n_planes
* dpyinfo
->n_cbits
) <= 1)
4355 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
4357 "Returns the width in pixels of the X display DISPLAY.\n\
4358 The optional argument DISPLAY specifies which display to ask about.\n\
4359 DISPLAY should be either a frame or a display name (a string).\n\
4360 If omitted or nil, that stands for the selected frame's display.")
4362 Lisp_Object display
;
4364 struct win32_display_info
*dpyinfo
= check_x_display_info (display
);
4366 return make_number (dpyinfo
->width
);
4369 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
4370 Sx_display_pixel_height
, 0, 1, 0,
4371 "Returns the height in pixels of the X display DISPLAY.\n\
4372 The optional argument DISPLAY specifies which display to ask about.\n\
4373 DISPLAY should be either a frame or a display name (a string).\n\
4374 If omitted or nil, that stands for the selected frame's display.")
4376 Lisp_Object display
;
4378 struct win32_display_info
*dpyinfo
= check_x_display_info (display
);
4380 return make_number (dpyinfo
->height
);
4383 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
4385 "Returns the number of bitplanes of the display DISPLAY.\n\
4386 The optional argument DISPLAY specifies which display to ask about.\n\
4387 DISPLAY should be either a frame or a display name (a string).\n\
4388 If omitted or nil, that stands for the selected frame's display.")
4390 Lisp_Object display
;
4392 struct win32_display_info
*dpyinfo
= check_x_display_info (display
);
4394 return make_number (dpyinfo
->n_planes
* dpyinfo
->n_cbits
);
4397 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
4399 "Returns the number of color cells of the display DISPLAY.\n\
4400 The optional argument DISPLAY specifies which display to ask about.\n\
4401 DISPLAY should be either a frame or a display name (a string).\n\
4402 If omitted or nil, that stands for the selected frame's display.")
4404 Lisp_Object display
;
4406 struct win32_display_info
*dpyinfo
= check_x_display_info (display
);
4410 hdc
= GetDC (dpyinfo
->root_window
);
4411 if (dpyinfo
->has_palette
)
4412 cap
= GetDeviceCaps (hdc
,SIZEPALETTE
);
4414 cap
= GetDeviceCaps (hdc
,NUMCOLORS
);
4416 ReleaseDC (dpyinfo
->root_window
, hdc
);
4418 return make_number (cap
);
4421 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
4422 Sx_server_max_request_size
,
4424 "Returns the maximum request size of the server of display DISPLAY.\n\
4425 The optional argument DISPLAY specifies which display to ask about.\n\
4426 DISPLAY should be either a frame or a display name (a string).\n\
4427 If omitted or nil, that stands for the selected frame's display.")
4429 Lisp_Object display
;
4431 struct win32_display_info
*dpyinfo
= check_x_display_info (display
);
4433 return make_number (1);
4436 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
4437 "Returns the vendor ID string of the Win32 system (Microsoft).\n\
4438 The optional argument DISPLAY specifies which display to ask about.\n\
4439 DISPLAY should be either a frame or a display name (a string).\n\
4440 If omitted or nil, that stands for the selected frame's display.")
4442 Lisp_Object display
;
4444 struct win32_display_info
*dpyinfo
= check_x_display_info (display
);
4445 char *vendor
= "Microsoft Corp.";
4447 if (! vendor
) vendor
= "";
4448 return build_string (vendor
);
4451 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
4452 "Returns the version numbers of the server of display DISPLAY.\n\
4453 The value is a list of three integers: the major and minor\n\
4454 version numbers, and the vendor-specific release\n\
4455 number. See also the function `x-server-vendor'.\n\n\
4456 The optional argument DISPLAY specifies which display to ask about.\n\
4457 DISPLAY should be either a frame or a display name (a string).\n\
4458 If omitted or nil, that stands for the selected frame's display.")
4460 Lisp_Object display
;
4462 struct win32_display_info
*dpyinfo
= check_x_display_info (display
);
4464 return Fcons (make_number (nt_major_version
),
4465 Fcons (make_number (nt_minor_version
), Qnil
));
4468 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
4469 "Returns the number of screens on the server of display DISPLAY.\n\
4470 The optional argument DISPLAY specifies which display to ask about.\n\
4471 DISPLAY should be either a frame or a display name (a string).\n\
4472 If omitted or nil, that stands for the selected frame's display.")
4474 Lisp_Object display
;
4476 struct win32_display_info
*dpyinfo
= check_x_display_info (display
);
4478 return make_number (1);
4481 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
4482 "Returns the height in millimeters of the X display DISPLAY.\n\
4483 The optional argument DISPLAY specifies which display to ask about.\n\
4484 DISPLAY should be either a frame or a display name (a string).\n\
4485 If omitted or nil, that stands for the selected frame's display.")
4487 Lisp_Object display
;
4489 struct win32_display_info
*dpyinfo
= check_x_display_info (display
);
4493 hdc
= GetDC (dpyinfo
->root_window
);
4495 cap
= GetDeviceCaps (hdc
, VERTSIZE
);
4497 ReleaseDC (dpyinfo
->root_window
, hdc
);
4499 return make_number (cap
);
4502 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
4503 "Returns the width in millimeters of the X display DISPLAY.\n\
4504 The optional argument DISPLAY specifies which display to ask about.\n\
4505 DISPLAY should be either a frame or a display name (a string).\n\
4506 If omitted or nil, that stands for the selected frame's display.")
4508 Lisp_Object display
;
4510 struct win32_display_info
*dpyinfo
= check_x_display_info (display
);
4515 hdc
= GetDC (dpyinfo
->root_window
);
4517 cap
= GetDeviceCaps (hdc
, HORZSIZE
);
4519 ReleaseDC (dpyinfo
->root_window
, hdc
);
4521 return make_number (cap
);
4524 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
4525 Sx_display_backing_store
, 0, 1, 0,
4526 "Returns an indication of whether display DISPLAY does backing store.\n\
4527 The value may be `always', `when-mapped', or `not-useful'.\n\
4528 The optional argument DISPLAY specifies which display to ask about.\n\
4529 DISPLAY should be either a frame or a display name (a string).\n\
4530 If omitted or nil, that stands for the selected frame's display.")
4532 Lisp_Object display
;
4534 return intern ("not-useful");
4537 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
4538 Sx_display_visual_class
, 0, 1, 0,
4539 "Returns the visual class of the display DISPLAY.\n\
4540 The value is one of the symbols `static-gray', `gray-scale',\n\
4541 `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
4542 The optional argument DISPLAY specifies which display to ask about.\n\
4543 DISPLAY should be either a frame or a display name (a string).\n\
4544 If omitted or nil, that stands for the selected frame's display.")
4546 Lisp_Object display
;
4548 struct win32_display_info
*dpyinfo
= check_x_display_info (display
);
4551 switch (dpyinfo
->visual
->class)
4553 case StaticGray
: return (intern ("static-gray"));
4554 case GrayScale
: return (intern ("gray-scale"));
4555 case StaticColor
: return (intern ("static-color"));
4556 case PseudoColor
: return (intern ("pseudo-color"));
4557 case TrueColor
: return (intern ("true-color"));
4558 case DirectColor
: return (intern ("direct-color"));
4560 error ("Display has an unknown visual class");
4564 error ("Display has an unknown visual class");
4567 DEFUN ("x-display-save-under", Fx_display_save_under
,
4568 Sx_display_save_under
, 0, 1, 0,
4569 "Returns t if the display DISPLAY supports the save-under feature.\n\
4570 The optional argument DISPLAY specifies which display to ask about.\n\
4571 DISPLAY should be either a frame or a display name (a string).\n\
4572 If omitted or nil, that stands for the selected frame's display.")
4574 Lisp_Object display
;
4576 struct win32_display_info
*dpyinfo
= check_x_display_info (display
);
4583 register struct frame
*f
;
4585 return PIXEL_WIDTH (f
);
4590 register struct frame
*f
;
4592 return PIXEL_HEIGHT (f
);
4597 register struct frame
*f
;
4599 return FONT_WIDTH (f
->output_data
.win32
->font
);
4604 register struct frame
*f
;
4606 return f
->output_data
.win32
->line_height
;
4610 x_screen_planes (frame
)
4613 return (FRAME_WIN32_DISPLAY_INFO (XFRAME (frame
))->n_planes
*
4614 FRAME_WIN32_DISPLAY_INFO (XFRAME (frame
))->n_cbits
);
4617 /* Return the display structure for the display named NAME.
4618 Open a new connection if necessary. */
4620 struct win32_display_info
*
4621 x_display_info_for_name (name
)
4625 struct win32_display_info
*dpyinfo
;
4627 CHECK_STRING (name
, 0);
4629 for (dpyinfo
= &one_win32_display_info
, names
= win32_display_name_list
;
4631 dpyinfo
= dpyinfo
->next
, names
= XCONS (names
)->cdr
)
4634 tem
= Fstring_equal (XCONS (XCONS (names
)->car
)->car
, name
);
4639 /* Use this general default value to start with. */
4640 Vx_resource_name
= Vinvocation_name
;
4642 validate_x_resource_name ();
4644 dpyinfo
= win32_term_init (name
, (unsigned char *)0,
4645 (char *) XSTRING (Vx_resource_name
)->data
);
4648 error ("Cannot connect to server %s", XSTRING (name
)->data
);
4650 XSETFASTINT (Vwindow_system_version
, 3);
4655 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
4656 1, 3, 0, "Open a connection to a server.\n\
4657 DISPLAY is the name of the display to connect to.\n\
4658 Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
4659 If the optional third arg MUST-SUCCEED is non-nil,\n\
4660 terminate Emacs if we can't open the connection.")
4661 (display
, xrm_string
, must_succeed
)
4662 Lisp_Object display
, xrm_string
, must_succeed
;
4664 unsigned int n_planes
;
4665 unsigned char *xrm_option
;
4666 struct win32_display_info
*dpyinfo
;
4668 CHECK_STRING (display
, 0);
4669 if (! NILP (xrm_string
))
4670 CHECK_STRING (xrm_string
, 1);
4672 /* Allow color mapping to be defined externally; first look in user's
4673 HOME directory, then in Emacs etc dir for a file called rgb.txt. */
4675 Lisp_Object color_file
;
4676 struct gcpro gcpro1
;
4678 color_file
= build_string("~/rgb.txt");
4680 GCPRO1 (color_file
);
4682 if (NILP (Ffile_readable_p (color_file
)))
4684 Fexpand_file_name (build_string ("rgb.txt"),
4685 Fsymbol_value (intern ("data-directory")));
4687 Vwin32_color_map
= Fwin32_load_color_file (color_file
);
4691 if (NILP (Vwin32_color_map
))
4692 Vwin32_color_map
= Fwin32_default_color_map ();
4694 if (! NILP (xrm_string
))
4695 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
4697 xrm_option
= (unsigned char *) 0;
4699 /* Use this general default value to start with. */
4700 /* First remove .exe suffix from invocation-name - it looks ugly. */
4702 char basename
[ MAX_PATH
], *str
;
4704 strcpy (basename
, XSTRING (Vinvocation_name
)->data
);
4705 str
= strrchr (basename
, '.');
4707 Vinvocation_name
= build_string (basename
);
4709 Vx_resource_name
= Vinvocation_name
;
4711 validate_x_resource_name ();
4713 /* This is what opens the connection and sets x_current_display.
4714 This also initializes many symbols, such as those used for input. */
4715 dpyinfo
= win32_term_init (display
, xrm_option
,
4716 (char *) XSTRING (Vx_resource_name
)->data
);
4720 if (!NILP (must_succeed
))
4721 fatal ("Cannot connect to server %s.\n",
4722 XSTRING (display
)->data
);
4724 error ("Cannot connect to server %s", XSTRING (display
)->data
);
4727 XSETFASTINT (Vwindow_system_version
, 3);
4731 DEFUN ("x-close-connection", Fx_close_connection
,
4732 Sx_close_connection
, 1, 1, 0,
4733 "Close the connection to DISPLAY's server.\n\
4734 For DISPLAY, specify either a frame or a display name (a string).\n\
4735 If DISPLAY is nil, that stands for the selected frame's display.")
4737 Lisp_Object display
;
4739 struct win32_display_info
*dpyinfo
= check_x_display_info (display
);
4740 struct win32_display_info
*tail
;
4743 if (dpyinfo
->reference_count
> 0)
4744 error ("Display still has frames on it");
4747 /* Free the fonts in the font table. */
4748 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
4750 if (dpyinfo
->font_table
[i
].name
)
4751 free (dpyinfo
->font_table
[i
].name
);
4752 /* Don't free the full_name string;
4753 it is always shared with something else. */
4754 win32_unload_font (dpyinfo
, dpyinfo
->font_table
[i
].font
);
4756 x_destroy_all_bitmaps (dpyinfo
);
4758 x_delete_display (dpyinfo
);
4764 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
4765 "Return the list of display names that Emacs has connections to.")
4768 Lisp_Object tail
, result
;
4771 for (tail
= win32_display_name_list
; ! NILP (tail
); tail
= XCONS (tail
)->cdr
)
4772 result
= Fcons (XCONS (XCONS (tail
)->car
)->car
, result
);
4777 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
4778 "If ON is non-nil, report errors as soon as the erring request is made.\n\
4779 If ON is nil, allow buffering of requests.\n\
4780 This is a noop on Win32 systems.\n\
4781 The optional second argument DISPLAY specifies which display to act on.\n\
4782 DISPLAY should be either a frame or a display name (a string).\n\
4783 If DISPLAY is omitted or nil, that stands for the selected frame's display.")
4785 Lisp_Object display
, on
;
4787 struct win32_display_info
*dpyinfo
= check_x_display_info (display
);
4793 /* These are the win32 specialized functions */
4795 DEFUN ("win32-select-font", Fwin32_select_font
, Swin32_select_font
, 0, 1, 0,
4796 "This will display the Win32 font dialog and return an X font string corresponding to the selection.")
4800 FRAME_PTR f
= check_x_frame (frame
);
4805 bzero (&cf
, sizeof (cf
));
4807 cf
.lStructSize
= sizeof (cf
);
4808 cf
.hwndOwner
= FRAME_WIN32_WINDOW (f
);
4809 cf
.Flags
= CF_FIXEDPITCHONLY
| CF_FORCEFONTEXIST
| CF_SCREENFONTS
;
4812 if (!ChooseFont (&cf
) || !win32_to_x_font (&lf
, buf
, 100))
4815 return build_string (buf
);
4821 /* The section below is built by the lisp expression at the top of the file,
4822 just above where these variables are declared. */
4823 /*&&& init symbols here &&&*/
4824 Qauto_raise
= intern ("auto-raise");
4825 staticpro (&Qauto_raise
);
4826 Qauto_lower
= intern ("auto-lower");
4827 staticpro (&Qauto_lower
);
4828 Qbackground_color
= intern ("background-color");
4829 staticpro (&Qbackground_color
);
4830 Qbar
= intern ("bar");
4832 Qborder_color
= intern ("border-color");
4833 staticpro (&Qborder_color
);
4834 Qborder_width
= intern ("border-width");
4835 staticpro (&Qborder_width
);
4836 Qbox
= intern ("box");
4838 Qcursor_color
= intern ("cursor-color");
4839 staticpro (&Qcursor_color
);
4840 Qcursor_type
= intern ("cursor-type");
4841 staticpro (&Qcursor_type
);
4842 Qfont
= intern ("font");
4844 Qforeground_color
= intern ("foreground-color");
4845 staticpro (&Qforeground_color
);
4846 Qgeometry
= intern ("geometry");
4847 staticpro (&Qgeometry
);
4848 Qicon_left
= intern ("icon-left");
4849 staticpro (&Qicon_left
);
4850 Qicon_top
= intern ("icon-top");
4851 staticpro (&Qicon_top
);
4852 Qicon_type
= intern ("icon-type");
4853 staticpro (&Qicon_type
);
4854 Qicon_name
= intern ("icon-name");
4855 staticpro (&Qicon_name
);
4856 Qinternal_border_width
= intern ("internal-border-width");
4857 staticpro (&Qinternal_border_width
);
4858 Qleft
= intern ("left");
4860 Qmouse_color
= intern ("mouse-color");
4861 staticpro (&Qmouse_color
);
4862 Qnone
= intern ("none");
4864 Qparent_id
= intern ("parent-id");
4865 staticpro (&Qparent_id
);
4866 Qscroll_bar_width
= intern ("scroll-bar-width");
4867 staticpro (&Qscroll_bar_width
);
4868 Qsuppress_icon
= intern ("suppress-icon");
4869 staticpro (&Qsuppress_icon
);
4870 Qtop
= intern ("top");
4872 Qundefined_color
= intern ("undefined-color");
4873 staticpro (&Qundefined_color
);
4874 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
4875 staticpro (&Qvertical_scroll_bars
);
4876 Qvisibility
= intern ("visibility");
4877 staticpro (&Qvisibility
);
4878 Qwindow_id
= intern ("window-id");
4879 staticpro (&Qwindow_id
);
4880 Qx_frame_parameter
= intern ("x-frame-parameter");
4881 staticpro (&Qx_frame_parameter
);
4882 Qx_resource_name
= intern ("x-resource-name");
4883 staticpro (&Qx_resource_name
);
4884 Quser_position
= intern ("user-position");
4885 staticpro (&Quser_position
);
4886 Quser_size
= intern ("user-size");
4887 staticpro (&Quser_size
);
4888 Qdisplay
= intern ("display");
4889 staticpro (&Qdisplay
);
4890 /* This is the end of symbol initialization. */
4892 Fput (Qundefined_color
, Qerror_conditions
,
4893 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
4894 Fput (Qundefined_color
, Qerror_message
,
4895 build_string ("Undefined color"));
4897 DEFVAR_LISP ("win32-color-map", &Vwin32_color_map
,
4898 "A array of color name mappings for windows.");
4899 Vwin32_color_map
= Qnil
;
4901 DEFVAR_LISP ("win32-pass-alt-to-system", &Vwin32_pass_alt_to_system
,
4902 "Non-nil if alt key presses are passed on to Windows.\n\
4903 When non-nil, for example, alt pressed and released and then space will\n\
4904 open the System menu. When nil, Emacs silently swallows alt key events.");
4905 Vwin32_pass_alt_to_system
= Qnil
;
4907 DEFVAR_LISP ("win32-pass-optional-keys-to-system",
4908 &Vwin32_pass_optional_keys_to_system
,
4909 "Non-nil if the 'optional' keys (left window, right window,\n\
4910 and application keys) are passed on to Windows.");
4911 Vwin32_pass_optional_keys_to_system
= Qnil
;
4913 DEFVAR_LISP ("win32-enable-italics", &Vwin32_enable_italics
,
4914 "Non-nil enables selection of artificially italicized fonts.");
4915 Vwin32_enable_italics
= Qnil
;
4917 DEFVAR_LISP ("win32-enable-palette", &Vwin32_enable_palette
,
4918 "Non-nil enables Windows palette management to map colors exactly.");
4919 Vwin32_enable_palette
= Qt
;
4921 DEFVAR_INT ("win32-mouse-button-tolerance",
4922 &Vwin32_mouse_button_tolerance
,
4923 "Analogue of double click interval for faking middle mouse events.\n\
4924 The value is the minimum time in milliseconds that must elapse between\n\
4925 left/right button down events before they are considered distinct events.\n\
4926 If both mouse buttons are depressed within this interval, a middle mouse\n\
4927 button down event is generated instead.");
4928 XSETINT (Vwin32_mouse_button_tolerance
, GetDoubleClickTime () / 2);
4930 init_x_parm_symbols ();
4932 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path
,
4933 "List of directories to search for bitmap files for win32.");
4934 Vx_bitmap_file_path
= decode_env_path ((char *) 0, "PATH");
4936 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
4937 "The shape of the pointer when over text.\n\
4938 Changing the value does not affect existing frames\n\
4939 unless you set the mouse color.");
4940 Vx_pointer_shape
= Qnil
;
4942 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
4943 "The name Emacs uses to look up resources; for internal use only.\n\
4944 `x-get-resource' uses this as the first component of the instance name\n\
4945 when requesting resource values.\n\
4946 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
4947 was invoked, or to the value specified with the `-name' or `-rn'\n\
4948 switches, if present.");
4949 Vx_resource_name
= Qnil
;
4951 Vx_nontext_pointer_shape
= Qnil
;
4953 Vx_mode_pointer_shape
= Qnil
;
4955 DEFVAR_INT ("x-sensitive-text-pointer-shape",
4956 &Vx_sensitive_text_pointer_shape
,
4957 "The shape of the pointer when over mouse-sensitive text.\n\
4958 This variable takes effect when you create a new frame\n\
4959 or when you set the mouse color.");
4960 Vx_sensitive_text_pointer_shape
= Qnil
;
4962 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
4963 "A string indicating the foreground color of the cursor box.");
4964 Vx_cursor_fore_pixel
= Qnil
;
4966 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
4967 "Non-nil if no window manager is in use.\n\
4968 Emacs doesn't try to figure this out; this is always nil\n\
4969 unless you set it to something else.");
4970 /* We don't have any way to find this out, so set it to nil
4971 and maybe the user would like to set it to t. */
4972 Vx_no_window_manager
= Qnil
;
4974 defsubr (&Sx_get_resource
);
4975 defsubr (&Sx_list_fonts
);
4976 defsubr (&Sx_display_color_p
);
4977 defsubr (&Sx_display_grayscale_p
);
4978 defsubr (&Sx_color_defined_p
);
4979 defsubr (&Sx_color_values
);
4980 defsubr (&Sx_server_max_request_size
);
4981 defsubr (&Sx_server_vendor
);
4982 defsubr (&Sx_server_version
);
4983 defsubr (&Sx_display_pixel_width
);
4984 defsubr (&Sx_display_pixel_height
);
4985 defsubr (&Sx_display_mm_width
);
4986 defsubr (&Sx_display_mm_height
);
4987 defsubr (&Sx_display_screens
);
4988 defsubr (&Sx_display_planes
);
4989 defsubr (&Sx_display_color_cells
);
4990 defsubr (&Sx_display_visual_class
);
4991 defsubr (&Sx_display_backing_store
);
4992 defsubr (&Sx_display_save_under
);
4993 defsubr (&Sx_parse_geometry
);
4994 defsubr (&Sx_create_frame
);
4995 defsubr (&Sfocus_frame
);
4996 defsubr (&Sunfocus_frame
);
4997 defsubr (&Sx_open_connection
);
4998 defsubr (&Sx_close_connection
);
4999 defsubr (&Sx_display_list
);
5000 defsubr (&Sx_synchronize
);
5002 /* Win32 specific functions */
5004 defsubr (&Swin32_select_font
);
5005 defsubr (&Swin32_define_rgb_color
);
5006 defsubr (&Swin32_default_color_map
);
5007 defsubr (&Swin32_load_color_file
);
5016 button
= MessageBox (NULL
,
5017 "A fatal error has occurred!\n\n"
5018 "Select Abort to exit, Retry to debug, Ignore to continue",
5019 "Emacs Abort Dialog",
5020 MB_ICONEXCLAMATION
| MB_TASKMODAL
5021 | MB_SETFOREGROUND
| MB_ABORTRETRYIGNORE
);