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 Win32Msg wmsg
= saved_mouse_msg
;
2848 my_post_msg (&wmsg
, wmsg
.msg
.hwnd
, wmsg
.msg
.message
,
2849 wmsg
.msg
.wParam
, wmsg
.msg
.lParam
);
2850 saved_mouse_msg
.msg
.hwnd
= 0;
2854 case WM_EMACS_CREATEWINDOW
:
2855 win32_createwindow ((struct frame
*) msg
.wParam
);
2856 PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
, 0, 0);
2858 case WM_EMACS_CREATESCROLLBAR
:
2860 HWND hwnd
= win32_createscrollbar ((struct frame
*) msg
.wParam
,
2861 (struct scroll_bar
*) msg
.lParam
);
2862 PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
, (WPARAM
)hwnd
, 0);
2871 DispatchMessage (&msg
);
2878 /* Main window procedure */
2880 extern char *lispy_function_keys
[];
2883 win32_wnd_proc (hwnd
, msg
, wParam
, lParam
)
2891 struct win32_display_info
*dpyinfo
= &one_win32_display_info
;
2898 GetUpdateRect (hwnd
, &wmsg
.rect
, FALSE
);
2900 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
2902 case WM_PALETTECHANGED
:
2903 /* ignore our own changes */
2904 if ((HWND
)wParam
!= hwnd
)
2906 /* simply notify main thread it may need to update frames */
2907 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
2912 PAINTSTRUCT paintStruct
;
2915 BeginPaint (hwnd
, &paintStruct
);
2916 wmsg
.rect
= paintStruct
.rcPaint
;
2917 EndPaint (hwnd
, &paintStruct
);
2920 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
2927 record_keyup (wParam
, lParam
);
2932 record_keydown (wParam
, lParam
);
2934 wParam
= map_keypad_keys (wParam
, lParam
);
2940 /* More support for these keys will likely be necessary. */
2941 if (!NILP (Vwin32_pass_optional_keys_to_system
))
2945 if (NILP (Vwin32_pass_alt_to_system
))
2952 /* Pass on to Windows. */
2955 /* If not defined as a function key, change it to a WM_CHAR message. */
2956 if (lispy_function_keys
[wParam
] == 0)
2965 wmsg
.dwModifiers
= construct_modifiers (wParam
, lParam
);
2968 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
2970 /* Detect quit_char and set quit-flag directly. Note that we dow
2971 this *after* posting the message to ensure the main thread will
2972 be woken up if blocked in sys_select(). */
2975 if (isalpha (c
) && (wmsg
.dwModifiers
== LEFT_CTRL_PRESSED
2976 || wmsg
.dwModifiers
== RIGHT_CTRL_PRESSED
))
2977 c
= make_ctrl_char (c
) & 0377;
2984 /* Simulate middle mouse button events when left and right buttons
2985 are used together, but only if user has two button mouse. */
2986 case WM_LBUTTONDOWN
:
2987 case WM_RBUTTONDOWN
:
2988 if (XINT (Vwin32_num_mouse_buttons
) == 3)
2989 goto handle_plain_button
;
2992 int this = (msg
== WM_LBUTTONDOWN
) ? LMOUSE
: RMOUSE
;
2993 int other
= (msg
== WM_LBUTTONDOWN
) ? RMOUSE
: LMOUSE
;
2995 if (button_state
& this) abort ();
2997 if (button_state
== 0)
3000 button_state
|= this;
3002 if (button_state
& other
)
3006 KillTimer (NULL
, timer_id
);
3009 /* Generate middle mouse event instead. */
3010 msg
= WM_MBUTTONDOWN
;
3011 button_state
|= MMOUSE
;
3013 else if (button_state
& MMOUSE
)
3015 /* Ignore button event if we've already generated a
3016 middle mouse down event. This happens if the
3017 user releases and press one of the two buttons
3018 after we've faked a middle mouse event. */
3023 /* Flush out saved message. */
3024 wmsg
= saved_mouse_msg
;
3025 my_post_msg (&wmsg
, wmsg
.msg
.hwnd
, wmsg
.msg
.message
,
3026 wmsg
.msg
.wParam
, wmsg
.msg
.lParam
);
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) abort ();
3060 button_state
&= ~this;
3062 if (button_state
& MMOUSE
)
3064 /* Only generate event when second button is released. */
3065 if ((button_state
& other
) == 0)
3068 button_state
&= ~MMOUSE
;
3070 if (button_state
) abort ();
3077 /* Flush out saved message if necessary. */
3078 if (saved_mouse_msg
.msg
.hwnd
)
3080 wmsg
= saved_mouse_msg
;
3081 my_post_msg (&wmsg
, wmsg
.msg
.hwnd
, wmsg
.msg
.message
,
3082 wmsg
.msg
.wParam
, wmsg
.msg
.lParam
);
3085 wmsg
.dwModifiers
= win32_get_modifiers ();
3086 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3088 /* Always clear message buffer and cancel timer. */
3089 saved_mouse_msg
.msg
.hwnd
= 0;
3090 KillTimer (NULL
, timer_id
);
3093 if (button_state
== 0)
3098 case WM_MBUTTONDOWN
:
3100 handle_plain_button
:
3104 if (parse_button (msg
, NULL
, &up
))
3106 if (up
) ReleaseCapture ();
3107 else SetCapture (hwnd
);
3111 wmsg
.dwModifiers
= win32_get_modifiers ();
3112 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3117 /* Flush out saved message if necessary. */
3118 if (saved_mouse_msg
.msg
.hwnd
)
3120 wmsg
= saved_mouse_msg
;
3121 my_post_msg (&wmsg
, wmsg
.msg
.hwnd
, wmsg
.msg
.message
,
3122 wmsg
.msg
.wParam
, wmsg
.msg
.lParam
);
3124 wmsg
.dwModifiers
= win32_get_modifiers ();
3125 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3127 /* Always clear message buffer and cancel timer. */
3128 saved_mouse_msg
.msg
.hwnd
= 0;
3129 KillTimer (NULL
, timer_id
);
3144 wmsg
.dwModifiers
= win32_get_modifiers ();
3145 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3149 wmsg
.dwModifiers
= win32_get_modifiers ();
3150 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3153 case WM_WINDOWPOSCHANGING
:
3156 LPWINDOWPOS lppos
= (WINDOWPOS
*) lParam
;
3158 GetWindowPlacement (hwnd
, &wp
);
3160 if (wp
.showCmd
!= SW_SHOWMINIMIZED
&& ! (lppos
->flags
& SWP_NOSIZE
))
3169 wp
.length
= sizeof(wp
);
3170 GetWindowRect (hwnd
, &wr
);
3174 dwXUnits
= GetWindowLong (hwnd
, WND_X_UNITS_INDEX
);
3175 dwYUnits
= GetWindowLong (hwnd
, WND_Y_UNITS_INDEX
);
3179 memset (&rect
, 0, sizeof (rect
));
3180 AdjustWindowRect (&rect
, GetWindowLong (hwnd
, GWL_STYLE
),
3181 GetMenu (hwnd
) != NULL
);
3183 /* All windows have an extra pixel so subtract 1 */
3185 wdiff
= (lppos
->cx
- (rect
.right
- rect
.left
) - 0) % dwXUnits
;
3186 hdiff
= (lppos
->cy
- (rect
.bottom
- rect
.top
) - 0) % dwYUnits
;
3190 /* For right/bottom sizing we can just fix the sizes.
3191 However for top/left sizing we will need to fix the X
3192 and Y positions as well. */
3197 if (wp
.showCmd
!= SW_SHOWMAXIMIZED
3198 && ! (lppos
->flags
& SWP_NOMOVE
))
3200 if (lppos
->x
!= wr
.left
|| lppos
->y
!= wr
.top
)
3207 lppos
->flags
|= SWP_NOMOVE
;
3216 if (ret
== 0) return (0);
3219 case WM_EMACS_SHOWWINDOW
:
3220 return ShowWindow (hwnd
, wParam
);
3221 case WM_EMACS_SETWINDOWPOS
:
3223 Win32WindowPos
* pos
= (Win32WindowPos
*) wParam
;
3224 return SetWindowPos (hwnd
, pos
->hwndAfter
,
3225 pos
->x
, pos
->y
, pos
->cx
, pos
->cy
, pos
->flags
);
3227 case WM_EMACS_DESTROYWINDOW
:
3228 DestroyWindow ((HWND
) wParam
);
3232 return DefWindowProc (hwnd
, msg
, wParam
, lParam
);
3239 my_create_window (f
)
3244 PostThreadMessage (dwWinThreadId
, WM_EMACS_CREATEWINDOW
, (WPARAM
)f
, 0);
3245 GetMessage (&msg
, NULL
, WM_EMACS_DONE
, WM_EMACS_DONE
);
3248 /* Create and set up the win32 window for frame F. */
3251 win32_window (f
, window_prompting
, minibuffer_only
)
3253 long window_prompting
;
3254 int minibuffer_only
;
3258 /* Use the resource name as the top-level window name
3259 for looking up resources. Make a non-Lisp copy
3260 for the window manager, so GC relocation won't bother it.
3262 Elsewhere we specify the window name for the window manager. */
3265 char *str
= (char *) XSTRING (Vx_resource_name
)->data
;
3266 f
->namebuf
= (char *) xmalloc (strlen (str
) + 1);
3267 strcpy (f
->namebuf
, str
);
3270 my_create_window (f
);
3272 validate_x_resource_name ();
3274 /* x_set_name normally ignores requests to set the name if the
3275 requested name is the same as the current name. This is the one
3276 place where that assumption isn't correct; f->name is set, but
3277 the server hasn't been told. */
3280 int explicit = f
->explicit_name
;
3282 f
->explicit_name
= 0;
3285 x_set_name (f
, name
, explicit);
3290 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
3291 initialize_frame_menubar (f
);
3293 if (FRAME_WIN32_WINDOW (f
) == 0)
3294 error ("Unable to create window");
3297 /* Handle the icon stuff for this window. Perhaps later we might
3298 want an x_set_icon_position which can be called interactively as
3306 Lisp_Object icon_x
, icon_y
;
3308 /* Set the position of the icon. Note that win95 groups all
3309 icons in the tray. */
3310 icon_x
= x_get_arg (parms
, Qicon_left
, 0, 0, number
);
3311 icon_y
= x_get_arg (parms
, Qicon_top
, 0, 0, number
);
3312 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
3314 CHECK_NUMBER (icon_x
, 0);
3315 CHECK_NUMBER (icon_y
, 0);
3317 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
3318 error ("Both left and top icon corners of icon must be specified");
3322 if (! EQ (icon_x
, Qunbound
))
3323 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
3328 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
3330 "Make a new window, which is called a \"frame\" in Emacs terms.\n\
3331 Returns an Emacs frame object.\n\
3332 ALIST is an alist of frame parameters.\n\
3333 If the parameters specify that the frame should not have a minibuffer,\n\
3334 and do not specify a specific minibuffer window to use,\n\
3335 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
3336 be shared by the new frame.\n\
3338 This function is an internal primitive--use `make-frame' instead.")
3343 Lisp_Object frame
, tem
;
3345 int minibuffer_only
= 0;
3346 long window_prompting
= 0;
3348 int count
= specpdl_ptr
- specpdl
;
3349 struct gcpro gcpro1
;
3350 Lisp_Object display
;
3351 struct win32_display_info
*dpyinfo
;
3355 /* Use this general default value to start with
3356 until we know if this frame has a specified name. */
3357 Vx_resource_name
= Vinvocation_name
;
3359 display
= x_get_arg (parms
, Qdisplay
, 0, 0, string
);
3360 if (EQ (display
, Qunbound
))
3362 dpyinfo
= check_x_display_info (display
);
3364 kb
= dpyinfo
->kboard
;
3366 kb
= &the_only_kboard
;
3369 name
= x_get_arg (parms
, Qname
, "title", "Title", string
);
3371 && ! EQ (name
, Qunbound
)
3373 error ("Invalid frame name--not a string or nil");
3376 Vx_resource_name
= name
;
3378 /* See if parent window is specified. */
3379 parent
= x_get_arg (parms
, Qparent_id
, NULL
, NULL
, number
);
3380 if (EQ (parent
, Qunbound
))
3382 if (! NILP (parent
))
3383 CHECK_NUMBER (parent
, 0);
3385 tem
= x_get_arg (parms
, Qminibuffer
, 0, 0, symbol
);
3386 if (EQ (tem
, Qnone
) || NILP (tem
))
3387 f
= make_frame_without_minibuffer (Qnil
, kb
, display
);
3388 else if (EQ (tem
, Qonly
))
3390 f
= make_minibuffer_frame ();
3391 minibuffer_only
= 1;
3393 else if (WINDOWP (tem
))
3394 f
= make_frame_without_minibuffer (tem
, kb
, display
);
3398 /* Note that Windows does support scroll bars. */
3399 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
3400 /* By default, make scrollbars the system standard width. */
3401 f
->scroll_bar_pixel_width
= GetSystemMetrics (SM_CXVSCROLL
);
3403 XSETFRAME (frame
, f
);
3406 f
->output_method
= output_win32
;
3407 f
->output_data
.win32
= (struct win32_output
*) xmalloc (sizeof (struct win32_output
));
3408 bzero (f
->output_data
.win32
, sizeof (struct win32_output
));
3410 /* FRAME_WIN32_DISPLAY_INFO (f) = dpyinfo; */
3412 FRAME_KBOARD (f
) = kb
;
3415 /* Specify the parent under which to make this window. */
3419 f
->output_data
.win32
->parent_desc
= (Window
) parent
;
3420 f
->output_data
.win32
->explicit_parent
= 1;
3424 f
->output_data
.win32
->parent_desc
= FRAME_WIN32_DISPLAY_INFO (f
)->root_window
;
3425 f
->output_data
.win32
->explicit_parent
= 0;
3428 /* Note that the frame has no physical cursor right now. */
3429 f
->phys_cursor_x
= -1;
3431 /* Set the name; the functions to which we pass f expect the name to
3433 if (EQ (name
, Qunbound
) || NILP (name
))
3435 f
->name
= build_string (dpyinfo
->win32_id_name
);
3436 f
->explicit_name
= 0;
3441 f
->explicit_name
= 1;
3442 /* use the frame's title when getting resources for this frame. */
3443 specbind (Qx_resource_name
, name
);
3446 /* Extract the window parameters from the supplied values
3447 that are needed to determine window geometry. */
3451 font
= x_get_arg (parms
, Qfont
, "font", "Font", string
);
3453 /* First, try whatever font the caller has specified. */
3455 font
= x_new_font (f
, XSTRING (font
)->data
);
3457 /* Try out a font which we hope has bold and italic variations. */
3458 if (!STRINGP (font
))
3459 font
= x_new_font (f
, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3460 if (! STRINGP (font
))
3461 font
= x_new_font (f
, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3462 if (! STRINGP (font
))
3463 /* This was formerly the first thing tried, but it finds too many fonts
3464 and takes too long. */
3465 font
= x_new_font (f
, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
3466 /* If those didn't work, look for something which will at least work. */
3467 if (! STRINGP (font
))
3468 font
= x_new_font (f
, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
3469 if (! STRINGP (font
))
3470 font
= x_new_font (f
, "-*-system-medium-r-normal-*-*-200-*-*-c-120-*-*");
3472 if (! STRINGP (font
))
3473 font
= x_new_font (f
, "-*-Fixedsys-*-r-*-*-12-90-*-*-c-*-*-*");
3475 if (! STRINGP (font
))
3476 font
= build_string ("-*-system");
3478 x_default_parameter (f
, parms
, Qfont
, font
,
3479 "font", "Font", string
);
3482 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
3483 "borderwidth", "BorderWidth", number
);
3484 /* This defaults to 2 in order to match xterm. We recognize either
3485 internalBorderWidth or internalBorder (which is what xterm calls
3487 if (NILP (Fassq (Qinternal_border_width
, parms
)))
3491 value
= x_get_arg (parms
, Qinternal_border_width
,
3492 "internalBorder", "BorderWidth", number
);
3493 if (! EQ (value
, Qunbound
))
3494 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
3497 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (0),
3498 "internalBorderWidth", "BorderWidth", number
);
3499 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qt
,
3500 "verticalScrollBars", "ScrollBars", boolean
);
3502 /* Also do the stuff which must be set before the window exists. */
3503 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
3504 "foreground", "Foreground", string
);
3505 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
3506 "background", "Background", string
);
3507 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
3508 "pointerColor", "Foreground", string
);
3509 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
3510 "cursorColor", "Foreground", string
);
3511 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
3512 "borderColor", "BorderColor", string
);
3514 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (1),
3515 "menuBar", "MenuBar", number
);
3516 x_default_parameter (f
, parms
, Qscroll_bar_width
, Qnil
,
3517 "scrollBarWidth", "ScrollBarWidth", number
);
3519 f
->output_data
.win32
->dwStyle
= WS_OVERLAPPEDWINDOW
;
3520 f
->output_data
.win32
->parent_desc
= FRAME_WIN32_DISPLAY_INFO (f
)->root_window
;
3521 window_prompting
= x_figure_window_size (f
, parms
);
3523 if (window_prompting
& XNegative
)
3525 if (window_prompting
& YNegative
)
3526 f
->output_data
.win32
->win_gravity
= SouthEastGravity
;
3528 f
->output_data
.win32
->win_gravity
= NorthEastGravity
;
3532 if (window_prompting
& YNegative
)
3533 f
->output_data
.win32
->win_gravity
= SouthWestGravity
;
3535 f
->output_data
.win32
->win_gravity
= NorthWestGravity
;
3538 f
->output_data
.win32
->size_hint_flags
= window_prompting
;
3540 win32_window (f
, window_prompting
, minibuffer_only
);
3542 init_frame_faces (f
);
3544 /* We need to do this after creating the window, so that the
3545 icon-creation functions can say whose icon they're describing. */
3546 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
3547 "bitmapIcon", "BitmapIcon", symbol
);
3549 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
3550 "autoRaise", "AutoRaiseLower", boolean
);
3551 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
3552 "autoLower", "AutoRaiseLower", boolean
);
3553 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
3554 "cursorType", "CursorType", symbol
);
3556 /* Dimensions, especially f->height, must be done via change_frame_size.
3557 Change will not be effected unless different from the current
3561 f
->height
= f
->width
= 0;
3562 change_frame_size (f
, height
, width
, 1, 0);
3564 /* Tell the server what size and position, etc, we want,
3565 and how badly we want them. */
3567 x_wm_set_size_hint (f
, window_prompting
, 0);
3570 tem
= x_get_arg (parms
, Qunsplittable
, 0, 0, boolean
);
3571 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
3575 /* It is now ok to make the frame official
3576 even if we get an error below.
3577 And the frame needs to be on Vframe_list
3578 or making it visible won't work. */
3579 Vframe_list
= Fcons (frame
, Vframe_list
);
3581 /* Now that the frame is official, it counts as a reference to
3583 FRAME_WIN32_DISPLAY_INFO (f
)->reference_count
++;
3585 /* Make the window appear on the frame and enable display,
3586 unless the caller says not to. However, with explicit parent,
3587 Emacs cannot control visibility, so don't try. */
3588 if (! f
->output_data
.win32
->explicit_parent
)
3590 Lisp_Object visibility
;
3592 visibility
= x_get_arg (parms
, Qvisibility
, 0, 0, symbol
);
3593 if (EQ (visibility
, Qunbound
))
3596 if (EQ (visibility
, Qicon
))
3597 x_iconify_frame (f
);
3598 else if (! NILP (visibility
))
3599 x_make_frame_visible (f
);
3601 /* Must have been Qnil. */
3605 return unbind_to (count
, frame
);
3608 /* FRAME is used only to get a handle on the X display. We don't pass the
3609 display info directly because we're called from frame.c, which doesn't
3610 know about that structure. */
3612 x_get_focus_frame (frame
)
3613 struct frame
*frame
;
3615 struct win32_display_info
*dpyinfo
= FRAME_WIN32_DISPLAY_INFO (frame
);
3617 if (! dpyinfo
->win32_focus_frame
)
3620 XSETFRAME (xfocus
, dpyinfo
->win32_focus_frame
);
3624 DEFUN ("focus-frame", Ffocus_frame
, Sfocus_frame
, 1, 1, 0,
3625 "This function is obsolete, and does nothing.")
3632 DEFUN ("unfocus-frame", Funfocus_frame
, Sunfocus_frame
, 0, 0, 0,
3633 "This function is obsolete, and does nothing.")
3640 win32_load_font (dpyinfo
,name
)
3641 struct win32_display_info
*dpyinfo
;
3644 XFontStruct
* font
= NULL
;
3650 if (!name
|| !x_to_win32_font (name
, &lf
))
3653 font
= (XFontStruct
*) xmalloc (sizeof (XFontStruct
));
3655 if (!font
) return (NULL
);
3659 font
->hfont
= CreateFontIndirect (&lf
);
3662 if (font
->hfont
== NULL
)
3671 hdc
= GetDC (dpyinfo
->root_window
);
3672 oldobj
= SelectObject (hdc
, font
->hfont
);
3673 ok
= GetTextMetrics (hdc
, &font
->tm
);
3674 SelectObject (hdc
, oldobj
);
3675 ReleaseDC (dpyinfo
->root_window
, hdc
);
3680 if (ok
) return (font
);
3682 win32_unload_font (dpyinfo
, font
);
3687 win32_unload_font (dpyinfo
, font
)
3688 struct win32_display_info
*dpyinfo
;
3693 if (font
->hfont
) DeleteObject(font
->hfont
);
3698 /* The font conversion stuff between x and win32 */
3700 /* X font string is as follows (from faces.el)
3704 * (weight "\\(bold\\|demibold\\|medium\\)") ; 1
3705 * (weight\? "\\([^-]*\\)") ; 1
3706 * (slant "\\([ior]\\)") ; 2
3707 * (slant\? "\\([^-]?\\)") ; 2
3708 * (swidth "\\([^-]*\\)") ; 3
3709 * (adstyle "[^-]*") ; 4
3710 * (pixelsize "[0-9]+")
3711 * (pointsize "[0-9][0-9]+")
3712 * (resx "[0-9][0-9]+")
3713 * (resy "[0-9][0-9]+")
3714 * (spacing "[cmp?*]")
3715 * (avgwidth "[0-9]+")
3716 * (registry "[^-]+")
3717 * (encoding "[^-]+")
3719 * (setq x-font-regexp
3720 * (concat "\\`\\*?[-?*]"
3721 * foundry - family - weight\? - slant\? - swidth - adstyle -
3722 * pixelsize - pointsize - resx - resy - spacing - registry -
3723 * encoding "[-?*]\\*?\\'"
3725 * (setq x-font-regexp-head
3726 * (concat "\\`[-?*]" foundry - family - weight\? - slant\?
3727 * "\\([-*?]\\|\\'\\)"))
3728 * (setq x-font-regexp-slant (concat - slant -))
3729 * (setq x-font-regexp-weight (concat - weight -))
3733 #define FONT_START "[-?]"
3734 #define FONT_FOUNDRY "[^-]+"
3735 #define FONT_FAMILY "\\([^-]+\\)" /* 1 */
3736 #define FONT_WEIGHT "\\(bold\\|demibold\\|medium\\)" /* 2 */
3737 #define FONT_WEIGHT_Q "\\([^-]*\\)" /* 2 */
3738 #define FONT_SLANT "\\([ior]\\)" /* 3 */
3739 #define FONT_SLANT_Q "\\([^-]?\\)" /* 3 */
3740 #define FONT_SWIDTH "\\([^-]*\\)" /* 4 */
3741 #define FONT_ADSTYLE "[^-]*"
3742 #define FONT_PIXELSIZE "[^-]*"
3743 #define FONT_POINTSIZE "\\([0-9][0-9]+\\|\\*\\)" /* 5 */
3744 #define FONT_RESX "[0-9][0-9]+"
3745 #define FONT_RESY "[0-9][0-9]+"
3746 #define FONT_SPACING "[cmp?*]"
3747 #define FONT_AVGWIDTH "[0-9]+"
3748 #define FONT_REGISTRY "[^-]+"
3749 #define FONT_ENCODING "[^-]+"
3751 #define FONT_REGEXP ("\\`\\*?[-?*]" \
3758 FONT_PIXELSIZE "-" \
3759 FONT_POINTSIZE "-" \
3762 #define FONT_REGEXP_HEAD ("\\`[-?*]" \
3767 "\\([-*?]\\|\\'\\)")
3769 #define FONT_REGEXP_SLANT "-" FONT_SLANT "-"
3770 #define FONT_REGEXP_WEIGHT "-" FONT_WEIGHT "-"
3773 x_to_win32_weight (lpw
)
3776 if (!lpw
) return (FW_DONTCARE
);
3778 if (stricmp (lpw
,"heavy") == 0) return FW_HEAVY
;
3779 else if (stricmp (lpw
,"extrabold") == 0) return FW_EXTRABOLD
;
3780 else if (stricmp (lpw
,"bold") == 0) return FW_BOLD
;
3781 else if (stricmp (lpw
,"demibold") == 0) return FW_SEMIBOLD
;
3782 else if (stricmp (lpw
,"medium") == 0) return FW_MEDIUM
;
3783 else if (stricmp (lpw
,"normal") == 0) return FW_NORMAL
;
3784 else if (stricmp (lpw
,"light") == 0) return FW_LIGHT
;
3785 else if (stricmp (lpw
,"extralight") == 0) return FW_EXTRALIGHT
;
3786 else if (stricmp (lpw
,"thin") == 0) return FW_THIN
;
3793 win32_to_x_weight (fnweight
)
3796 if (fnweight
>= FW_HEAVY
) return "heavy";
3797 if (fnweight
>= FW_EXTRABOLD
) return "extrabold";
3798 if (fnweight
>= FW_BOLD
) return "bold";
3799 if (fnweight
>= FW_SEMIBOLD
) return "semibold";
3800 if (fnweight
>= FW_MEDIUM
) return "medium";
3801 if (fnweight
>= FW_NORMAL
) return "normal";
3802 if (fnweight
>= FW_LIGHT
) return "light";
3803 if (fnweight
>= FW_EXTRALIGHT
) return "extralight";
3804 if (fnweight
>= FW_THIN
) return "thin";
3810 x_to_win32_charset (lpcs
)
3813 if (!lpcs
) return (0);
3815 if (stricmp (lpcs
,"ansi") == 0) return ANSI_CHARSET
;
3816 else if (stricmp (lpcs
,"iso8859-1") == 0) return ANSI_CHARSET
;
3817 else if (stricmp (lpcs
,"iso8859") == 0) return ANSI_CHARSET
;
3818 else if (stricmp (lpcs
,"oem") == 0) return OEM_CHARSET
;
3819 #ifdef UNICODE_CHARSET
3820 else if (stricmp (lpcs
,"unicode") == 0) return UNICODE_CHARSET
;
3821 else if (stricmp (lpcs
,"iso10646") == 0) return UNICODE_CHARSET
;
3828 win32_to_x_charset (fncharset
)
3833 case ANSI_CHARSET
: return "ansi";
3834 case OEM_CHARSET
: return "oem";
3835 case SYMBOL_CHARSET
: return "symbol";
3836 #ifdef UNICODE_CHARSET
3837 case UNICODE_CHARSET
: return "unicode";
3844 win32_to_x_font (lplogfont
, lpxstr
, len
)
3845 LOGFONT
* lplogfont
;
3849 if (!lpxstr
) return (FALSE
);
3853 _snprintf (lpxstr
, len
- 1,
3854 "-*-%s-%s-%c-*-*-%d-%d-*-*-%c-%d-*-%s-",
3855 lplogfont
->lfFaceName
,
3856 win32_to_x_weight (lplogfont
->lfWeight
),
3857 lplogfont
->lfItalic
?'i':'r',
3858 abs (lplogfont
->lfHeight
),
3859 (abs (lplogfont
->lfHeight
) * 720) / one_win32_display_info
.height_in
,
3860 ((lplogfont
->lfPitchAndFamily
& 0x3) == VARIABLE_PITCH
) ? 'p' : 'c',
3861 lplogfont
->lfWidth
* 10,
3862 win32_to_x_charset (lplogfont
->lfCharSet
)
3867 strncpy (lpxstr
,"-*-*-*-*-*-*-*-*-*-*-*-*-*-*-", len
- 1);
3870 lpxstr
[len
- 1] = 0; /* just to be sure */
3875 x_to_win32_font (lpxstr
, lplogfont
)
3877 LOGFONT
* lplogfont
;
3879 if (!lplogfont
) return (FALSE
);
3881 memset (lplogfont
, 0, sizeof (*lplogfont
));
3884 lplogfont
->lfOutPrecision
= OUT_DEFAULT_PRECIS
;
3885 lplogfont
->lfClipPrecision
= CLIP_DEFAULT_PRECIS
;
3886 lplogfont
->lfQuality
= DEFAULT_QUALITY
;
3888 /* go for maximum quality */
3889 lplogfont
->lfOutPrecision
= OUT_STROKE_PRECIS
;
3890 lplogfont
->lfClipPrecision
= CLIP_STROKE_PRECIS
;
3891 lplogfont
->lfQuality
= PROOF_QUALITY
;
3897 /* Provide a simple escape mechanism for specifying Windows font names
3898 * directly -- if font spec does not beginning with '-', assume this
3900 * "<font name>[:height in pixels[:width in pixels[:weight]]]"
3906 char name
[50], weight
[20], slant
, pitch
, pixels
[10], height
[10], width
[10], remainder
[20];
3909 fields
= sscanf (lpxstr
,
3910 "-%*[^-]-%49[^-]-%19[^-]-%c-%*[^-]-%*[^-]-%9[^-]-%9[^-]-%*[^-]-%*[^-]-%c-%9[^-]-%19s",
3911 name
, weight
, &slant
, pixels
, height
, &pitch
, width
, remainder
);
3913 if (fields
== EOF
) return (FALSE
);
3915 if (fields
> 0 && name
[0] != '*')
3917 strncpy (lplogfont
->lfFaceName
,name
, LF_FACESIZE
);
3918 lplogfont
->lfFaceName
[LF_FACESIZE
-1] = 0;
3922 lplogfont
->lfFaceName
[0] = 0;
3927 lplogfont
->lfWeight
= x_to_win32_weight ((fields
> 0 ? weight
: ""));
3931 if (!NILP (Vwin32_enable_italics
))
3932 lplogfont
->lfItalic
= (fields
> 0 && slant
== 'i');
3936 if (fields
> 0 && pixels
[0] != '*')
3937 lplogfont
->lfHeight
= atoi (pixels
);
3941 if (fields
> 0 && lplogfont
->lfHeight
== 0 && height
[0] != '*')
3942 lplogfont
->lfHeight
= (atoi (height
)
3943 * one_win32_display_info
.height_in
) / 720;
3947 lplogfont
->lfPitchAndFamily
=
3948 (fields
> 0 && pitch
== 'p') ? VARIABLE_PITCH
: FIXED_PITCH
;
3952 if (fields
> 0 && width
[0] != '*')
3953 lplogfont
->lfWidth
= atoi (width
) / 10;
3957 /* Not all font specs include the registry field, so we allow for an
3958 optional registry field before the encoding when parsing
3959 remainder. Also we strip the trailing '-' if present. */
3961 int len
= strlen (remainder
);
3962 if (len
> 0 && remainder
[len
-1] == '-')
3963 remainder
[len
-1] = 0;
3965 encoding
= remainder
;
3966 if (strncmp (encoding
, "*-", 2) == 0)
3968 lplogfont
->lfCharSet
= x_to_win32_charset (fields
> 0 ? encoding
: "");
3973 char name
[100], height
[10], width
[10], weight
[20];
3975 fields
= sscanf (lpxstr
,
3976 "%99[^:]:%9[^:]:%9[^:]:%19s",
3977 name
, height
, width
, weight
);
3979 if (fields
== EOF
) return (FALSE
);
3983 strncpy (lplogfont
->lfFaceName
,name
, LF_FACESIZE
);
3984 lplogfont
->lfFaceName
[LF_FACESIZE
-1] = 0;
3988 lplogfont
->lfFaceName
[0] = 0;
3994 lplogfont
->lfHeight
= atoi (height
);
3999 lplogfont
->lfWidth
= atoi (width
);
4003 lplogfont
->lfWeight
= x_to_win32_weight ((fields
> 0 ? weight
: ""));
4006 /* This makes TrueType fonts work better. */
4007 lplogfont
->lfHeight
= - abs (lplogfont
->lfHeight
);
4013 win32_font_match (lpszfont1
, lpszfont2
)
4017 char * s1
= lpszfont1
, *e1
;
4018 char * s2
= lpszfont2
, *e2
;
4020 if (s1
== NULL
|| s2
== NULL
) return (FALSE
);
4022 if (*s1
== '-') s1
++;
4023 if (*s2
== '-') s2
++;
4029 e1
= strchr (s1
, '-');
4030 e2
= strchr (s2
, '-');
4032 if (e1
== NULL
|| e2
== NULL
) return (TRUE
);
4037 if (*s1
!= '*' && *s2
!= '*'
4038 && (len1
!= len2
|| strnicmp (s1
, s2
, len1
) != 0))
4046 typedef struct enumfont_t
4050 XFontStruct
*size_ref
;
4051 Lisp_Object
*pattern
;
4057 enum_font_cb2 (lplf
, lptm
, FontType
, lpef
)
4059 NEWTEXTMETRIC
* lptm
;
4063 if (lplf
->elfLogFont
.lfStrikeOut
|| lplf
->elfLogFont
.lfUnderline
4064 || (lplf
->elfLogFont
.lfCharSet
!= ANSI_CHARSET
&& lplf
->elfLogFont
.lfCharSet
!= OEM_CHARSET
))
4067 /* if (!lpef->size_ref || lptm->tmMaxCharWidth == FONT_WIDTH (lpef->size_ref)) */
4071 if (!win32_to_x_font (lplf
, buf
, 100)) return (0);
4073 if (NILP (*(lpef
->pattern
)) || win32_font_match (buf
, XSTRING (*(lpef
->pattern
))->data
))
4075 *lpef
->tail
= Fcons (build_string (buf
), Qnil
);
4076 lpef
->tail
= &XCONS (*lpef
->tail
)->cdr
;
4085 enum_font_cb1 (lplf
, lptm
, FontType
, lpef
)
4087 NEWTEXTMETRIC
* lptm
;
4091 return EnumFontFamilies (lpef
->hdc
,
4092 lplf
->elfLogFont
.lfFaceName
,
4093 (FONTENUMPROC
) enum_font_cb2
,
4098 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 3, 0,
4099 "Return a list of the names of available fonts matching PATTERN.\n\
4100 If optional arguments FACE and FRAME are specified, return only fonts\n\
4101 the same size as FACE on FRAME.\n\
4103 PATTERN is a string, perhaps with wildcard characters;\n\
4104 the * character matches any substring, and\n\
4105 the ? character matches any single character.\n\
4106 PATTERN is case-insensitive.\n\
4107 FACE is a face name--a symbol.\n\
4109 The return value is a list of strings, suitable as arguments to\n\
4112 Fonts Emacs can't use (i.e. proportional fonts) may or may not be excluded\n\
4113 even if they match PATTERN and FACE.")
4114 (pattern
, face
, frame
)
4115 Lisp_Object pattern
, face
, frame
;
4120 XFontStruct
*size_ref
;
4121 Lisp_Object namelist
;
4126 CHECK_STRING (pattern
, 0);
4128 CHECK_SYMBOL (face
, 1);
4130 f
= check_x_frame (frame
);
4132 /* Determine the width standard for comparison with the fonts we find. */
4140 /* Don't die if we get called with a terminal frame. */
4141 if (! FRAME_WIN32_P (f
))
4142 error ("non-win32 frame used in `x-list-fonts'");
4144 face_id
= face_name_id_number (f
, face
);
4146 if (face_id
< 0 || face_id
>= FRAME_N_PARAM_FACES (f
)
4147 || FRAME_PARAM_FACES (f
) [face_id
] == 0)
4148 size_ref
= f
->output_data
.win32
->font
;
4151 size_ref
= FRAME_PARAM_FACES (f
) [face_id
]->font
;
4152 if (size_ref
== (XFontStruct
*) (~0))
4153 size_ref
= f
->output_data
.win32
->font
;
4157 /* See if we cached the result for this particular query. */
4158 list
= Fassoc (pattern
,
4159 XCONS (FRAME_WIN32_DISPLAY_INFO (f
)->name_list_element
)->cdr
);
4161 /* We have info in the cache for this PATTERN. */
4164 Lisp_Object tem
, newlist
;
4166 /* We have info about this pattern. */
4167 list
= XCONS (list
)->cdr
;
4174 /* Filter the cached info and return just the fonts that match FACE. */
4176 for (tem
= list
; CONSP (tem
); tem
= XCONS (tem
)->cdr
)
4178 XFontStruct
*thisinfo
;
4180 thisinfo
= win32_load_font (FRAME_WIN32_DISPLAY_INFO (f
), XSTRING (XCONS (tem
)->car
)->data
);
4182 if (thisinfo
&& same_size_fonts (thisinfo
, size_ref
))
4183 newlist
= Fcons (XCONS (tem
)->car
, newlist
);
4185 win32_unload_font (FRAME_WIN32_DISPLAY_INFO (f
), thisinfo
);
4196 ef
.pattern
= &pattern
;
4197 ef
.tail
= ef
.head
= &namelist
;
4201 ef
.hdc
= GetDC (FRAME_WIN32_WINDOW (f
));
4203 EnumFontFamilies (ef
.hdc
, NULL
, (FONTENUMPROC
) enum_font_cb1
, (LPARAM
)&ef
);
4205 ReleaseDC (FRAME_WIN32_WINDOW (f
), ef
.hdc
);
4215 /* Make a list of all the fonts we got back.
4216 Store that in the font cache for the display. */
4217 XCONS (FRAME_WIN32_DISPLAY_INFO (f
)->name_list_element
)->cdr
4218 = Fcons (Fcons (pattern
, namelist
),
4219 XCONS (FRAME_WIN32_DISPLAY_INFO (f
)->name_list_element
)->cdr
);
4221 /* Make a list of the fonts that have the right width. */
4224 for (i
= 0; i
< ef
.numFonts
; i
++)
4232 XFontStruct
*thisinfo
;
4235 thisinfo
= win32_load_font (FRAME_WIN32_DISPLAY_INFO (f
), XSTRING (Fcar (cur
))->data
);
4237 keeper
= thisinfo
&& same_size_fonts (thisinfo
, size_ref
);
4239 win32_unload_font (FRAME_WIN32_DISPLAY_INFO (f
), thisinfo
);
4244 list
= Fcons (build_string (XSTRING (Fcar (cur
))->data
), list
);
4248 list
= Fnreverse (list
);
4254 DEFUN ("x-color-defined-p", Fx_color_defined_p
, Sx_color_defined_p
, 1, 2, 0,
4255 "Return non-nil if color COLOR is supported on frame FRAME.\n\
4256 If FRAME is omitted or nil, use the selected frame.")
4258 Lisp_Object color
, frame
;
4261 FRAME_PTR f
= check_x_frame (frame
);
4263 CHECK_STRING (color
, 1);
4265 if (defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
4271 DEFUN ("x-color-values", Fx_color_values
, Sx_color_values
, 1, 2, 0,
4272 "Return a description of the color named COLOR on frame FRAME.\n\
4273 The value is a list of integer RGB values--(RED GREEN BLUE).\n\
4274 These values appear to range from 0 to 65280 or 65535, depending\n\
4275 on the system; white is (65280 65280 65280) or (65535 65535 65535).\n\
4276 If FRAME is omitted or nil, use the selected frame.")
4278 Lisp_Object color
, frame
;
4281 FRAME_PTR f
= check_x_frame (frame
);
4283 CHECK_STRING (color
, 1);
4285 if (defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
4289 rgb
[0] = make_number (GetRValue (foo
));
4290 rgb
[1] = make_number (GetGValue (foo
));
4291 rgb
[2] = make_number (GetBValue (foo
));
4292 return Flist (3, rgb
);
4298 DEFUN ("x-display-color-p", Fx_display_color_p
, Sx_display_color_p
, 0, 1, 0,
4299 "Return t if the X display supports color.\n\
4300 The optional argument DISPLAY specifies which display to ask about.\n\
4301 DISPLAY should be either a frame or a display name (a string).\n\
4302 If omitted or nil, that stands for the selected frame's display.")
4304 Lisp_Object display
;
4306 struct win32_display_info
*dpyinfo
= check_x_display_info (display
);
4308 if ((dpyinfo
->n_planes
* dpyinfo
->n_cbits
) <= 2)
4314 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
, Sx_display_grayscale_p
,
4316 "Return t if the X display supports shades of gray.\n\
4317 Note that color displays do support shades of gray.\n\
4318 The optional argument DISPLAY specifies which display to ask about.\n\
4319 DISPLAY should be either a frame or a display name (a string).\n\
4320 If omitted or nil, that stands for the selected frame's display.")
4322 Lisp_Object display
;
4324 struct win32_display_info
*dpyinfo
= check_x_display_info (display
);
4326 if ((dpyinfo
->n_planes
* dpyinfo
->n_cbits
) <= 1)
4332 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
4334 "Returns the width in pixels of the X display DISPLAY.\n\
4335 The optional argument DISPLAY specifies which display to ask about.\n\
4336 DISPLAY should be either a frame or a display name (a string).\n\
4337 If omitted or nil, that stands for the selected frame's display.")
4339 Lisp_Object display
;
4341 struct win32_display_info
*dpyinfo
= check_x_display_info (display
);
4343 return make_number (dpyinfo
->width
);
4346 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
4347 Sx_display_pixel_height
, 0, 1, 0,
4348 "Returns the height in pixels of the X display DISPLAY.\n\
4349 The optional argument DISPLAY specifies which display to ask about.\n\
4350 DISPLAY should be either a frame or a display name (a string).\n\
4351 If omitted or nil, that stands for the selected frame's display.")
4353 Lisp_Object display
;
4355 struct win32_display_info
*dpyinfo
= check_x_display_info (display
);
4357 return make_number (dpyinfo
->height
);
4360 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
4362 "Returns the number of bitplanes of the display DISPLAY.\n\
4363 The optional argument DISPLAY specifies which display to ask about.\n\
4364 DISPLAY should be either a frame or a display name (a string).\n\
4365 If omitted or nil, that stands for the selected frame's display.")
4367 Lisp_Object display
;
4369 struct win32_display_info
*dpyinfo
= check_x_display_info (display
);
4371 return make_number (dpyinfo
->n_planes
* dpyinfo
->n_cbits
);
4374 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
4376 "Returns the number of color cells of the display DISPLAY.\n\
4377 The optional argument DISPLAY specifies which display to ask about.\n\
4378 DISPLAY should be either a frame or a display name (a string).\n\
4379 If omitted or nil, that stands for the selected frame's display.")
4381 Lisp_Object display
;
4383 struct win32_display_info
*dpyinfo
= check_x_display_info (display
);
4387 hdc
= GetDC (dpyinfo
->root_window
);
4388 if (dpyinfo
->has_palette
)
4389 cap
= GetDeviceCaps (hdc
,SIZEPALETTE
);
4391 cap
= GetDeviceCaps (hdc
,NUMCOLORS
);
4393 ReleaseDC (dpyinfo
->root_window
, hdc
);
4395 return make_number (cap
);
4398 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
4399 Sx_server_max_request_size
,
4401 "Returns the maximum request size of the server of display DISPLAY.\n\
4402 The optional argument DISPLAY specifies which display to ask about.\n\
4403 DISPLAY should be either a frame or a display name (a string).\n\
4404 If omitted or nil, that stands for the selected frame's display.")
4406 Lisp_Object display
;
4408 struct win32_display_info
*dpyinfo
= check_x_display_info (display
);
4410 return make_number (1);
4413 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
4414 "Returns the vendor ID string of the Win32 system (Microsoft).\n\
4415 The optional argument DISPLAY specifies which display to ask about.\n\
4416 DISPLAY should be either a frame or a display name (a string).\n\
4417 If omitted or nil, that stands for the selected frame's display.")
4419 Lisp_Object display
;
4421 struct win32_display_info
*dpyinfo
= check_x_display_info (display
);
4422 char *vendor
= "Microsoft Corp.";
4424 if (! vendor
) vendor
= "";
4425 return build_string (vendor
);
4428 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
4429 "Returns the version numbers of the server of display DISPLAY.\n\
4430 The value is a list of three integers: the major and minor\n\
4431 version numbers, and the vendor-specific release\n\
4432 number. See also the function `x-server-vendor'.\n\n\
4433 The optional argument DISPLAY specifies which display to ask about.\n\
4434 DISPLAY should be either a frame or a display name (a string).\n\
4435 If omitted or nil, that stands for the selected frame's display.")
4437 Lisp_Object display
;
4439 struct win32_display_info
*dpyinfo
= check_x_display_info (display
);
4441 return Fcons (make_number (nt_major_version
),
4442 Fcons (make_number (nt_minor_version
), Qnil
));
4445 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
4446 "Returns the number of screens on the server of display DISPLAY.\n\
4447 The optional argument DISPLAY specifies which display to ask about.\n\
4448 DISPLAY should be either a frame or a display name (a string).\n\
4449 If omitted or nil, that stands for the selected frame's display.")
4451 Lisp_Object display
;
4453 struct win32_display_info
*dpyinfo
= check_x_display_info (display
);
4455 return make_number (1);
4458 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
4459 "Returns the height in millimeters of the X display DISPLAY.\n\
4460 The optional argument DISPLAY specifies which display to ask about.\n\
4461 DISPLAY should be either a frame or a display name (a string).\n\
4462 If omitted or nil, that stands for the selected frame's display.")
4464 Lisp_Object display
;
4466 struct win32_display_info
*dpyinfo
= check_x_display_info (display
);
4470 hdc
= GetDC (dpyinfo
->root_window
);
4472 cap
= GetDeviceCaps (hdc
, VERTSIZE
);
4474 ReleaseDC (dpyinfo
->root_window
, hdc
);
4476 return make_number (cap
);
4479 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
4480 "Returns the width in millimeters of the X display DISPLAY.\n\
4481 The optional argument DISPLAY specifies which display to ask about.\n\
4482 DISPLAY should be either a frame or a display name (a string).\n\
4483 If omitted or nil, that stands for the selected frame's display.")
4485 Lisp_Object display
;
4487 struct win32_display_info
*dpyinfo
= check_x_display_info (display
);
4492 hdc
= GetDC (dpyinfo
->root_window
);
4494 cap
= GetDeviceCaps (hdc
, HORZSIZE
);
4496 ReleaseDC (dpyinfo
->root_window
, hdc
);
4498 return make_number (cap
);
4501 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
4502 Sx_display_backing_store
, 0, 1, 0,
4503 "Returns an indication of whether display DISPLAY does backing store.\n\
4504 The value may be `always', `when-mapped', or `not-useful'.\n\
4505 The optional argument DISPLAY specifies which display to ask about.\n\
4506 DISPLAY should be either a frame or a display name (a string).\n\
4507 If omitted or nil, that stands for the selected frame's display.")
4509 Lisp_Object display
;
4511 return intern ("not-useful");
4514 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
4515 Sx_display_visual_class
, 0, 1, 0,
4516 "Returns the visual class of the display DISPLAY.\n\
4517 The value is one of the symbols `static-gray', `gray-scale',\n\
4518 `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
4519 The optional argument DISPLAY specifies which display to ask about.\n\
4520 DISPLAY should be either a frame or a display name (a string).\n\
4521 If omitted or nil, that stands for the selected frame's display.")
4523 Lisp_Object display
;
4525 struct win32_display_info
*dpyinfo
= check_x_display_info (display
);
4528 switch (dpyinfo
->visual
->class)
4530 case StaticGray
: return (intern ("static-gray"));
4531 case GrayScale
: return (intern ("gray-scale"));
4532 case StaticColor
: return (intern ("static-color"));
4533 case PseudoColor
: return (intern ("pseudo-color"));
4534 case TrueColor
: return (intern ("true-color"));
4535 case DirectColor
: return (intern ("direct-color"));
4537 error ("Display has an unknown visual class");
4541 error ("Display has an unknown visual class");
4544 DEFUN ("x-display-save-under", Fx_display_save_under
,
4545 Sx_display_save_under
, 0, 1, 0,
4546 "Returns t if the display DISPLAY supports the save-under feature.\n\
4547 The optional argument DISPLAY specifies which display to ask about.\n\
4548 DISPLAY should be either a frame or a display name (a string).\n\
4549 If omitted or nil, that stands for the selected frame's display.")
4551 Lisp_Object display
;
4553 struct win32_display_info
*dpyinfo
= check_x_display_info (display
);
4560 register struct frame
*f
;
4562 return PIXEL_WIDTH (f
);
4567 register struct frame
*f
;
4569 return PIXEL_HEIGHT (f
);
4574 register struct frame
*f
;
4576 return FONT_WIDTH (f
->output_data
.win32
->font
);
4581 register struct frame
*f
;
4583 return f
->output_data
.win32
->line_height
;
4587 x_screen_planes (frame
)
4590 return (FRAME_WIN32_DISPLAY_INFO (XFRAME (frame
))->n_planes
*
4591 FRAME_WIN32_DISPLAY_INFO (XFRAME (frame
))->n_cbits
);
4594 /* Return the display structure for the display named NAME.
4595 Open a new connection if necessary. */
4597 struct win32_display_info
*
4598 x_display_info_for_name (name
)
4602 struct win32_display_info
*dpyinfo
;
4604 CHECK_STRING (name
, 0);
4606 for (dpyinfo
= &one_win32_display_info
, names
= win32_display_name_list
;
4608 dpyinfo
= dpyinfo
->next
, names
= XCONS (names
)->cdr
)
4611 tem
= Fstring_equal (XCONS (XCONS (names
)->car
)->car
, name
);
4616 /* Use this general default value to start with. */
4617 Vx_resource_name
= Vinvocation_name
;
4619 validate_x_resource_name ();
4621 dpyinfo
= win32_term_init (name
, (unsigned char *)0,
4622 (char *) XSTRING (Vx_resource_name
)->data
);
4625 error ("Cannot connect to server %s", XSTRING (name
)->data
);
4627 XSETFASTINT (Vwindow_system_version
, 3);
4632 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
4633 1, 3, 0, "Open a connection to a server.\n\
4634 DISPLAY is the name of the display to connect to.\n\
4635 Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
4636 If the optional third arg MUST-SUCCEED is non-nil,\n\
4637 terminate Emacs if we can't open the connection.")
4638 (display
, xrm_string
, must_succeed
)
4639 Lisp_Object display
, xrm_string
, must_succeed
;
4641 unsigned int n_planes
;
4642 unsigned char *xrm_option
;
4643 struct win32_display_info
*dpyinfo
;
4645 CHECK_STRING (display
, 0);
4646 if (! NILP (xrm_string
))
4647 CHECK_STRING (xrm_string
, 1);
4649 /* Allow color mapping to be defined externally; first look in user's
4650 HOME directory, then in Emacs etc dir for a file called rgb.txt. */
4652 Lisp_Object color_file
;
4653 struct gcpro gcpro1
;
4655 color_file
= build_string("~/rgb.txt");
4657 GCPRO1 (color_file
);
4659 if (NILP (Ffile_readable_p (color_file
)))
4661 Fexpand_file_name (build_string ("rgb.txt"),
4662 Fsymbol_value (intern ("data-directory")));
4664 Vwin32_color_map
= Fwin32_load_color_file (color_file
);
4668 if (NILP (Vwin32_color_map
))
4669 Vwin32_color_map
= Fwin32_default_color_map ();
4671 if (! NILP (xrm_string
))
4672 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
4674 xrm_option
= (unsigned char *) 0;
4676 /* Use this general default value to start with. */
4677 /* First remove .exe suffix from invocation-name - it looks ugly. */
4679 char basename
[ MAX_PATH
], *str
;
4681 strcpy (basename
, XSTRING (Vinvocation_name
)->data
);
4682 str
= strrchr (basename
, '.');
4684 Vinvocation_name
= build_string (basename
);
4686 Vx_resource_name
= Vinvocation_name
;
4688 validate_x_resource_name ();
4690 /* This is what opens the connection and sets x_current_display.
4691 This also initializes many symbols, such as those used for input. */
4692 dpyinfo
= win32_term_init (display
, xrm_option
,
4693 (char *) XSTRING (Vx_resource_name
)->data
);
4697 if (!NILP (must_succeed
))
4698 fatal ("Cannot connect to server %s.\n",
4699 XSTRING (display
)->data
);
4701 error ("Cannot connect to server %s", XSTRING (display
)->data
);
4704 XSETFASTINT (Vwindow_system_version
, 3);
4708 DEFUN ("x-close-connection", Fx_close_connection
,
4709 Sx_close_connection
, 1, 1, 0,
4710 "Close the connection to DISPLAY's server.\n\
4711 For DISPLAY, specify either a frame or a display name (a string).\n\
4712 If DISPLAY is nil, that stands for the selected frame's display.")
4714 Lisp_Object display
;
4716 struct win32_display_info
*dpyinfo
= check_x_display_info (display
);
4717 struct win32_display_info
*tail
;
4720 if (dpyinfo
->reference_count
> 0)
4721 error ("Display still has frames on it");
4724 /* Free the fonts in the font table. */
4725 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
4727 if (dpyinfo
->font_table
[i
].name
)
4728 free (dpyinfo
->font_table
[i
].name
);
4729 /* Don't free the full_name string;
4730 it is always shared with something else. */
4731 win32_unload_font (dpyinfo
, dpyinfo
->font_table
[i
].font
);
4733 x_destroy_all_bitmaps (dpyinfo
);
4735 x_delete_display (dpyinfo
);
4741 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
4742 "Return the list of display names that Emacs has connections to.")
4745 Lisp_Object tail
, result
;
4748 for (tail
= win32_display_name_list
; ! NILP (tail
); tail
= XCONS (tail
)->cdr
)
4749 result
= Fcons (XCONS (XCONS (tail
)->car
)->car
, result
);
4754 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
4755 "If ON is non-nil, report errors as soon as the erring request is made.\n\
4756 If ON is nil, allow buffering of requests.\n\
4757 This is a noop on Win32 systems.\n\
4758 The optional second argument DISPLAY specifies which display to act on.\n\
4759 DISPLAY should be either a frame or a display name (a string).\n\
4760 If DISPLAY is omitted or nil, that stands for the selected frame's display.")
4762 Lisp_Object display
, on
;
4764 struct win32_display_info
*dpyinfo
= check_x_display_info (display
);
4770 /* These are the win32 specialized functions */
4772 DEFUN ("win32-select-font", Fwin32_select_font
, Swin32_select_font
, 0, 1, 0,
4773 "This will display the Win32 font dialog and return an X font string corresponding to the selection.")
4777 FRAME_PTR f
= check_x_frame (frame
);
4782 bzero (&cf
, sizeof (cf
));
4784 cf
.lStructSize
= sizeof (cf
);
4785 cf
.hwndOwner
= FRAME_WIN32_WINDOW (f
);
4786 cf
.Flags
= CF_FIXEDPITCHONLY
| CF_FORCEFONTEXIST
| CF_SCREENFONTS
;
4789 if (!ChooseFont (&cf
) || !win32_to_x_font (&lf
, buf
, 100))
4792 return build_string (buf
);
4798 /* The section below is built by the lisp expression at the top of the file,
4799 just above where these variables are declared. */
4800 /*&&& init symbols here &&&*/
4801 Qauto_raise
= intern ("auto-raise");
4802 staticpro (&Qauto_raise
);
4803 Qauto_lower
= intern ("auto-lower");
4804 staticpro (&Qauto_lower
);
4805 Qbackground_color
= intern ("background-color");
4806 staticpro (&Qbackground_color
);
4807 Qbar
= intern ("bar");
4809 Qborder_color
= intern ("border-color");
4810 staticpro (&Qborder_color
);
4811 Qborder_width
= intern ("border-width");
4812 staticpro (&Qborder_width
);
4813 Qbox
= intern ("box");
4815 Qcursor_color
= intern ("cursor-color");
4816 staticpro (&Qcursor_color
);
4817 Qcursor_type
= intern ("cursor-type");
4818 staticpro (&Qcursor_type
);
4819 Qfont
= intern ("font");
4821 Qforeground_color
= intern ("foreground-color");
4822 staticpro (&Qforeground_color
);
4823 Qgeometry
= intern ("geometry");
4824 staticpro (&Qgeometry
);
4825 Qicon_left
= intern ("icon-left");
4826 staticpro (&Qicon_left
);
4827 Qicon_top
= intern ("icon-top");
4828 staticpro (&Qicon_top
);
4829 Qicon_type
= intern ("icon-type");
4830 staticpro (&Qicon_type
);
4831 Qicon_name
= intern ("icon-name");
4832 staticpro (&Qicon_name
);
4833 Qinternal_border_width
= intern ("internal-border-width");
4834 staticpro (&Qinternal_border_width
);
4835 Qleft
= intern ("left");
4837 Qmouse_color
= intern ("mouse-color");
4838 staticpro (&Qmouse_color
);
4839 Qnone
= intern ("none");
4841 Qparent_id
= intern ("parent-id");
4842 staticpro (&Qparent_id
);
4843 Qscroll_bar_width
= intern ("scroll-bar-width");
4844 staticpro (&Qscroll_bar_width
);
4845 Qsuppress_icon
= intern ("suppress-icon");
4846 staticpro (&Qsuppress_icon
);
4847 Qtop
= intern ("top");
4849 Qundefined_color
= intern ("undefined-color");
4850 staticpro (&Qundefined_color
);
4851 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
4852 staticpro (&Qvertical_scroll_bars
);
4853 Qvisibility
= intern ("visibility");
4854 staticpro (&Qvisibility
);
4855 Qwindow_id
= intern ("window-id");
4856 staticpro (&Qwindow_id
);
4857 Qx_frame_parameter
= intern ("x-frame-parameter");
4858 staticpro (&Qx_frame_parameter
);
4859 Qx_resource_name
= intern ("x-resource-name");
4860 staticpro (&Qx_resource_name
);
4861 Quser_position
= intern ("user-position");
4862 staticpro (&Quser_position
);
4863 Quser_size
= intern ("user-size");
4864 staticpro (&Quser_size
);
4865 Qdisplay
= intern ("display");
4866 staticpro (&Qdisplay
);
4867 /* This is the end of symbol initialization. */
4869 Fput (Qundefined_color
, Qerror_conditions
,
4870 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
4871 Fput (Qundefined_color
, Qerror_message
,
4872 build_string ("Undefined color"));
4874 DEFVAR_LISP ("win32-color-map", &Vwin32_color_map
,
4875 "A array of color name mappings for windows.");
4876 Vwin32_color_map
= Qnil
;
4878 DEFVAR_LISP ("win32-pass-alt-to-system", &Vwin32_pass_alt_to_system
,
4879 "Non-nil if alt key presses are passed on to Windows.\n\
4880 When non-nil, for example, alt pressed and released and then space will\n\
4881 open the System menu. When nil, Emacs silently swallows alt key events.");
4882 Vwin32_pass_alt_to_system
= Qnil
;
4884 DEFVAR_LISP ("win32-pass-optional-keys-to-system",
4885 &Vwin32_pass_optional_keys_to_system
,
4886 "Non-nil if the 'optional' keys (left window, right window,\n\
4887 and application keys) are passed on to Windows.");
4888 Vwin32_pass_optional_keys_to_system
= Qnil
;
4890 DEFVAR_LISP ("win32-enable-italics", &Vwin32_enable_italics
,
4891 "Non-nil enables selection of artificially italicized fonts.");
4892 Vwin32_enable_italics
= Qnil
;
4894 DEFVAR_LISP ("win32-enable-palette", &Vwin32_enable_palette
,
4895 "Non-nil enables Windows palette management to map colors exactly.");
4896 Vwin32_enable_palette
= Qt
;
4898 DEFVAR_INT ("win32-mouse-button-tolerance",
4899 &Vwin32_mouse_button_tolerance
,
4900 "Analogue of double click interval for faking middle mouse events.\n\
4901 The value is the minimum time in milliseconds that must elapse between\n\
4902 left/right button down events before they are considered distinct events.\n\
4903 If both mouse buttons are depressed within this interval, a middle mouse\n\
4904 button down event is generated instead.");
4905 XSETINT (Vwin32_mouse_button_tolerance
, GetDoubleClickTime () / 2);
4907 init_x_parm_symbols ();
4909 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path
,
4910 "List of directories to search for bitmap files for win32.");
4911 Vx_bitmap_file_path
= decode_env_path ((char *) 0, "PATH");
4913 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
4914 "The shape of the pointer when over text.\n\
4915 Changing the value does not affect existing frames\n\
4916 unless you set the mouse color.");
4917 Vx_pointer_shape
= Qnil
;
4919 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
4920 "The name Emacs uses to look up resources; for internal use only.\n\
4921 `x-get-resource' uses this as the first component of the instance name\n\
4922 when requesting resource values.\n\
4923 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
4924 was invoked, or to the value specified with the `-name' or `-rn'\n\
4925 switches, if present.");
4926 Vx_resource_name
= Qnil
;
4928 Vx_nontext_pointer_shape
= Qnil
;
4930 Vx_mode_pointer_shape
= Qnil
;
4932 DEFVAR_INT ("x-sensitive-text-pointer-shape",
4933 &Vx_sensitive_text_pointer_shape
,
4934 "The shape of the pointer when over mouse-sensitive text.\n\
4935 This variable takes effect when you create a new frame\n\
4936 or when you set the mouse color.");
4937 Vx_sensitive_text_pointer_shape
= Qnil
;
4939 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
4940 "A string indicating the foreground color of the cursor box.");
4941 Vx_cursor_fore_pixel
= Qnil
;
4943 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
4944 "Non-nil if no window manager is in use.\n\
4945 Emacs doesn't try to figure this out; this is always nil\n\
4946 unless you set it to something else.");
4947 /* We don't have any way to find this out, so set it to nil
4948 and maybe the user would like to set it to t. */
4949 Vx_no_window_manager
= Qnil
;
4951 defsubr (&Sx_get_resource
);
4952 defsubr (&Sx_list_fonts
);
4953 defsubr (&Sx_display_color_p
);
4954 defsubr (&Sx_display_grayscale_p
);
4955 defsubr (&Sx_color_defined_p
);
4956 defsubr (&Sx_color_values
);
4957 defsubr (&Sx_server_max_request_size
);
4958 defsubr (&Sx_server_vendor
);
4959 defsubr (&Sx_server_version
);
4960 defsubr (&Sx_display_pixel_width
);
4961 defsubr (&Sx_display_pixel_height
);
4962 defsubr (&Sx_display_mm_width
);
4963 defsubr (&Sx_display_mm_height
);
4964 defsubr (&Sx_display_screens
);
4965 defsubr (&Sx_display_planes
);
4966 defsubr (&Sx_display_color_cells
);
4967 defsubr (&Sx_display_visual_class
);
4968 defsubr (&Sx_display_backing_store
);
4969 defsubr (&Sx_display_save_under
);
4970 defsubr (&Sx_parse_geometry
);
4971 defsubr (&Sx_create_frame
);
4972 defsubr (&Sfocus_frame
);
4973 defsubr (&Sunfocus_frame
);
4974 defsubr (&Sx_open_connection
);
4975 defsubr (&Sx_close_connection
);
4976 defsubr (&Sx_display_list
);
4977 defsubr (&Sx_synchronize
);
4979 /* Win32 specific functions */
4981 defsubr (&Swin32_select_font
);
4982 defsubr (&Swin32_define_rgb_color
);
4983 defsubr (&Swin32_default_color_map
);
4984 defsubr (&Swin32_load_color_file
);
4993 button
= MessageBox (NULL
,
4994 "A fatal error has occurred!\n\n"
4995 "Select Abort to exit, Retry to debug, Ignore to continue",
4996 "Emacs Abort Dialog",
4997 MB_ICONEXCLAMATION
| MB_TASKMODAL
4998 | MB_SETFOREGROUND
| MB_ABORTRETRYIGNORE
);