1 /* Graphical user interface functions for the Microsoft W32 API.
2 Copyright (C) 1989, 92, 93, 94, 95, 1996 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
21 /* Added by Kevin Gallo */
37 #include "dispextern.h"
39 #include "blockinput.h"
42 #include "termhooks.h"
49 extern void free_frame_menubar ();
50 extern struct scroll_bar
*x_window_to_scroll_bar ();
51 extern int w32_console_toggle_lock_key (int vk_code
, Lisp_Object new_state
);
54 extern char *lispy_function_keys
[];
56 /* The colormap for converting color names to RGB values */
57 Lisp_Object Vw32_color_map
;
59 /* Non nil if alt key presses are passed on to Windows. */
60 Lisp_Object Vw32_pass_alt_to_system
;
62 /* Non nil if alt key is translated to meta_modifier, nil if it is translated
64 Lisp_Object Vw32_alt_is_meta
;
66 /* Non nil if left window key events are passed on to Windows (this only
67 affects whether "tapping" the key opens the Start menu). */
68 Lisp_Object Vw32_pass_lwindow_to_system
;
70 /* Non nil if right window key events are passed on to Windows (this
71 only affects whether "tapping" the key opens the Start menu). */
72 Lisp_Object Vw32_pass_rwindow_to_system
;
74 /* Virtual key code used to generate "phantom" key presses in order
75 to stop system from acting on Windows key events. */
76 Lisp_Object Vw32_phantom_key_code
;
78 /* Modifier associated with the left "Windows" key, or nil to act as a
80 Lisp_Object Vw32_lwindow_modifier
;
82 /* Modifier associated with the right "Windows" key, or nil to act as a
84 Lisp_Object Vw32_rwindow_modifier
;
86 /* Modifier associated with the "Apps" key, or nil to act as a normal
88 Lisp_Object Vw32_apps_modifier
;
90 /* Value is nil if Num Lock acts as a function key. */
91 Lisp_Object Vw32_enable_num_lock
;
93 /* Value is nil if Caps Lock acts as a function key. */
94 Lisp_Object Vw32_enable_caps_lock
;
96 /* Modifier associated with Scroll Lock, or nil to act as a normal key. */
97 Lisp_Object Vw32_scroll_lock_modifier
;
99 /* Switch to control whether we inhibit requests for italicised fonts (which
100 are synthesized, look ugly, and are trashed by cursor movement under NT). */
101 Lisp_Object Vw32_enable_italics
;
103 /* Enable palette management. */
104 Lisp_Object Vw32_enable_palette
;
106 /* Control how close left/right button down events must be to
107 be converted to a middle button down event. */
108 Lisp_Object Vw32_mouse_button_tolerance
;
110 /* Minimum interval between mouse movement (and scroll bar drag)
111 events that are passed on to the event loop. */
112 Lisp_Object Vw32_mouse_move_interval
;
114 /* The name we're using in resource queries. */
115 Lisp_Object Vx_resource_name
;
117 /* Non nil if no window manager is in use. */
118 Lisp_Object Vx_no_window_manager
;
120 /* The background and shape of the mouse pointer, and shape when not
121 over text or in the modeline. */
122 Lisp_Object Vx_pointer_shape
, Vx_nontext_pointer_shape
, Vx_mode_pointer_shape
;
123 /* The shape when over mouse-sensitive text. */
124 Lisp_Object Vx_sensitive_text_pointer_shape
;
126 /* Color of chars displayed in cursor box. */
127 Lisp_Object Vx_cursor_fore_pixel
;
129 /* Nonzero if using Windows. */
130 static int w32_in_use
;
132 /* Search path for bitmap files. */
133 Lisp_Object Vx_bitmap_file_path
;
135 /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
136 Lisp_Object Vx_pixel_size_width_font_regexp
;
138 /* A flag to control how to display unibyte 8-bit character. */
139 int unibyte_display_via_language_environment
;
141 /* Evaluate this expression to rebuild the section of syms_of_w32fns
142 that initializes and staticpros the symbols declared below. Note
143 that Emacs 18 has a bug that keeps C-x C-e from being able to
144 evaluate this expression.
147 ;; Accumulate a list of the symbols we want to initialize from the
148 ;; declarations at the top of the file.
149 (goto-char (point-min))
150 (search-forward "/\*&&& symbols declared here &&&*\/\n")
152 (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)")
154 (cons (buffer-substring (match-beginning 1) (match-end 1))
157 (setq symbol-list (nreverse symbol-list))
158 ;; Delete the section of syms_of_... where we initialize the symbols.
159 (search-forward "\n /\*&&& init symbols here &&&*\/\n")
160 (let ((start (point)))
161 (while (looking-at "^ Q")
163 (kill-region start (point)))
164 ;; Write a new symbol initialization section.
166 (insert (format " %s = intern (\"" (car symbol-list)))
167 (let ((start (point)))
168 (insert (substring (car symbol-list) 1))
169 (subst-char-in-region start (point) ?_ ?-))
170 (insert (format "\");\n staticpro (&%s);\n" (car symbol-list)))
171 (setq symbol-list (cdr symbol-list)))))
175 /*&&& symbols declared here &&&*/
176 Lisp_Object Qauto_raise
;
177 Lisp_Object Qauto_lower
;
178 Lisp_Object Qbackground_color
;
180 Lisp_Object Qborder_color
;
181 Lisp_Object Qborder_width
;
183 Lisp_Object Qcursor_color
;
184 Lisp_Object Qcursor_type
;
185 Lisp_Object Qforeground_color
;
186 Lisp_Object Qgeometry
;
187 Lisp_Object Qicon_left
;
188 Lisp_Object Qicon_top
;
189 Lisp_Object Qicon_type
;
190 Lisp_Object Qicon_name
;
191 Lisp_Object Qinternal_border_width
;
194 Lisp_Object Qmouse_color
;
196 Lisp_Object Qparent_id
;
197 Lisp_Object Qscroll_bar_width
;
198 Lisp_Object Qsuppress_icon
;
200 Lisp_Object Qundefined_color
;
201 Lisp_Object Qvertical_scroll_bars
;
202 Lisp_Object Qvisibility
;
203 Lisp_Object Qwindow_id
;
204 Lisp_Object Qx_frame_parameter
;
205 Lisp_Object Qx_resource_name
;
206 Lisp_Object Quser_position
;
207 Lisp_Object Quser_size
;
208 Lisp_Object Qdisplay
;
215 Lisp_Object Qcontrol
;
218 /* State variables for emulating a three button mouse. */
223 static int button_state
= 0;
224 static W32Msg saved_mouse_button_msg
;
225 static unsigned mouse_button_timer
; /* non-zero when timer is active */
226 static W32Msg saved_mouse_move_msg
;
227 static unsigned mouse_move_timer
;
229 /* W95 mousewheel handler */
230 unsigned int msh_mousewheel
= 0;
232 #define MOUSE_BUTTON_ID 1
233 #define MOUSE_MOVE_ID 2
235 /* The below are defined in frame.c. */
236 extern Lisp_Object Qheight
, Qminibuffer
, Qname
, Qonly
, Qwidth
;
237 extern Lisp_Object Qunsplittable
, Qmenu_bar_lines
, Qbuffer_predicate
, Qtitle
;
239 extern Lisp_Object Vwindow_system_version
;
241 Lisp_Object Qface_set_after_frame_default
;
243 extern Lisp_Object last_mouse_scroll_bar
;
244 extern int last_mouse_scroll_bar_pos
;
246 /* From w32term.c. */
247 extern Lisp_Object Vw32_num_mouse_buttons
;
248 extern Lisp_Object Vw32_recognize_altgr
;
251 /* Error if we are not connected to MS-Windows. */
256 error ("MS-Windows not in use or not initialized");
259 /* Nonzero if we can use mouse menus.
260 You should not call this unless HAVE_MENUS is defined. */
268 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
269 and checking validity for W32. */
272 check_x_frame (frame
)
281 CHECK_LIVE_FRAME (frame
, 0);
284 if (! FRAME_W32_P (f
))
285 error ("non-w32 frame used");
289 /* Let the user specify an display with a frame.
290 nil stands for the selected frame--or, if that is not a w32 frame,
291 the first display on the list. */
293 static struct w32_display_info
*
294 check_x_display_info (frame
)
299 if (FRAME_W32_P (selected_frame
))
300 return FRAME_W32_DISPLAY_INFO (selected_frame
);
302 return &one_w32_display_info
;
304 else if (STRINGP (frame
))
305 return x_display_info_for_name (frame
);
310 CHECK_LIVE_FRAME (frame
, 0);
312 if (! FRAME_W32_P (f
))
313 error ("non-w32 frame used");
314 return FRAME_W32_DISPLAY_INFO (f
);
318 /* Return the Emacs frame-object corresponding to an w32 window.
319 It could be the frame's main window or an icon window. */
321 /* This function can be called during GC, so use GC_xxx type test macros. */
324 x_window_to_frame (dpyinfo
, wdesc
)
325 struct w32_display_info
*dpyinfo
;
328 Lisp_Object tail
, frame
;
331 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCONS (tail
)->cdr
)
333 frame
= XCONS (tail
)->car
;
334 if (!GC_FRAMEP (frame
))
337 if (f
->output_data
.nothing
== 1
338 || FRAME_W32_DISPLAY_INFO (f
) != dpyinfo
)
340 if (FRAME_W32_WINDOW (f
) == wdesc
)
348 /* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
349 id, which is just an int that this section returns. Bitmaps are
350 reference counted so they can be shared among frames.
352 Bitmap indices are guaranteed to be > 0, so a negative number can
353 be used to indicate no bitmap.
355 If you use x_create_bitmap_from_data, then you must keep track of
356 the bitmaps yourself. That is, creating a bitmap from the same
357 data more than once will not be caught. */
360 /* Functions to access the contents of a bitmap, given an id. */
363 x_bitmap_height (f
, id
)
367 return FRAME_W32_DISPLAY_INFO (f
)->bitmaps
[id
- 1].height
;
371 x_bitmap_width (f
, id
)
375 return FRAME_W32_DISPLAY_INFO (f
)->bitmaps
[id
- 1].width
;
379 x_bitmap_pixmap (f
, id
)
383 return (int) FRAME_W32_DISPLAY_INFO (f
)->bitmaps
[id
- 1].pixmap
;
387 /* Allocate a new bitmap record. Returns index of new record. */
390 x_allocate_bitmap_record (f
)
393 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
396 if (dpyinfo
->bitmaps
== NULL
)
398 dpyinfo
->bitmaps_size
= 10;
400 = (struct w32_bitmap_record
*) xmalloc (dpyinfo
->bitmaps_size
* sizeof (struct w32_bitmap_record
));
401 dpyinfo
->bitmaps_last
= 1;
405 if (dpyinfo
->bitmaps_last
< dpyinfo
->bitmaps_size
)
406 return ++dpyinfo
->bitmaps_last
;
408 for (i
= 0; i
< dpyinfo
->bitmaps_size
; ++i
)
409 if (dpyinfo
->bitmaps
[i
].refcount
== 0)
412 dpyinfo
->bitmaps_size
*= 2;
414 = (struct w32_bitmap_record
*) xrealloc (dpyinfo
->bitmaps
,
415 dpyinfo
->bitmaps_size
* sizeof (struct w32_bitmap_record
));
416 return ++dpyinfo
->bitmaps_last
;
419 /* Add one reference to the reference count of the bitmap with id ID. */
422 x_reference_bitmap (f
, id
)
426 ++FRAME_W32_DISPLAY_INFO (f
)->bitmaps
[id
- 1].refcount
;
429 /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
432 x_create_bitmap_from_data (f
, bits
, width
, height
)
435 unsigned int width
, height
;
437 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
441 bitmap
= CreateBitmap (width
, height
,
442 FRAME_W32_DISPLAY_INFO (XFRAME (frame
))->n_planes
,
443 FRAME_W32_DISPLAY_INFO (XFRAME (frame
))->n_cbits
,
449 id
= x_allocate_bitmap_record (f
);
450 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
451 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
452 dpyinfo
->bitmaps
[id
- 1].hinst
= NULL
;
453 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
454 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
455 dpyinfo
->bitmaps
[id
- 1].height
= height
;
456 dpyinfo
->bitmaps
[id
- 1].width
= width
;
461 /* Create bitmap from file FILE for frame F. */
464 x_create_bitmap_from_file (f
, file
)
470 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
471 unsigned int width
, height
;
473 int xhot
, yhot
, result
, id
;
479 /* Look for an existing bitmap with the same name. */
480 for (id
= 0; id
< dpyinfo
->bitmaps_last
; ++id
)
482 if (dpyinfo
->bitmaps
[id
].refcount
483 && dpyinfo
->bitmaps
[id
].file
484 && !strcmp (dpyinfo
->bitmaps
[id
].file
, (char *) XSTRING (file
)->data
))
486 ++dpyinfo
->bitmaps
[id
].refcount
;
491 /* Search bitmap-file-path for the file, if appropriate. */
492 fd
= openp (Vx_bitmap_file_path
, file
, "", &found
, 0);
495 /* LoadLibraryEx won't handle special files handled by Emacs handler. */
500 filename
= (char *) XSTRING (found
)->data
;
502 hinst
= LoadLibraryEx (filename
, NULL
, LOAD_LIBRARY_AS_DATAFILE
);
508 result
= XReadBitmapFile (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
),
509 filename
, &width
, &height
, &bitmap
, &xhot
, &yhot
);
510 if (result
!= BitmapSuccess
)
513 id
= x_allocate_bitmap_record (f
);
514 dpyinfo
->bitmaps
[id
- 1].pixmap
= bitmap
;
515 dpyinfo
->bitmaps
[id
- 1].refcount
= 1;
516 dpyinfo
->bitmaps
[id
- 1].file
= (char *) xmalloc (XSTRING (file
)->size
+ 1);
517 dpyinfo
->bitmaps
[id
- 1].depth
= 1;
518 dpyinfo
->bitmaps
[id
- 1].height
= height
;
519 dpyinfo
->bitmaps
[id
- 1].width
= width
;
520 strcpy (dpyinfo
->bitmaps
[id
- 1].file
, XSTRING (file
)->data
);
526 /* Remove reference to bitmap with id number ID. */
529 x_destroy_bitmap (f
, id
)
533 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
537 --dpyinfo
->bitmaps
[id
- 1].refcount
;
538 if (dpyinfo
->bitmaps
[id
- 1].refcount
== 0)
541 DeleteObject (dpyinfo
->bitmaps
[id
- 1].pixmap
);
542 if (dpyinfo
->bitmaps
[id
- 1].file
)
544 free (dpyinfo
->bitmaps
[id
- 1].file
);
545 dpyinfo
->bitmaps
[id
- 1].file
= NULL
;
552 /* Free all the bitmaps for the display specified by DPYINFO. */
555 x_destroy_all_bitmaps (dpyinfo
)
556 struct w32_display_info
*dpyinfo
;
559 for (i
= 0; i
< dpyinfo
->bitmaps_last
; i
++)
560 if (dpyinfo
->bitmaps
[i
].refcount
> 0)
562 DeleteObject (dpyinfo
->bitmaps
[i
].pixmap
);
563 if (dpyinfo
->bitmaps
[i
].file
)
564 free (dpyinfo
->bitmaps
[i
].file
);
566 dpyinfo
->bitmaps_last
= 0;
569 /* Connect the frame-parameter names for W32 frames
570 to the ways of passing the parameter values to the window system.
572 The name of a parameter, as a Lisp symbol,
573 has an `x-frame-parameter' property which is an integer in Lisp
574 but can be interpreted as an `enum x_frame_parm' in C. */
578 X_PARM_FOREGROUND_COLOR
,
579 X_PARM_BACKGROUND_COLOR
,
586 X_PARM_INTERNAL_BORDER_WIDTH
,
590 X_PARM_VERT_SCROLL_BAR
,
592 X_PARM_MENU_BAR_LINES
596 struct x_frame_parm_table
599 void (*setter
)( /* struct frame *frame, Lisp_Object val, oldval */ );
602 void x_set_foreground_color ();
603 void x_set_background_color ();
604 void x_set_mouse_color ();
605 void x_set_cursor_color ();
606 void x_set_border_color ();
607 void x_set_cursor_type ();
608 void x_set_icon_type ();
609 void x_set_icon_name ();
611 void x_set_border_width ();
612 void x_set_internal_border_width ();
613 void x_explicitly_set_name ();
614 void x_set_autoraise ();
615 void x_set_autolower ();
616 void x_set_vertical_scroll_bars ();
617 void x_set_visibility ();
618 void x_set_menu_bar_lines ();
619 void x_set_scroll_bar_width ();
621 void x_set_unsplittable ();
623 static struct x_frame_parm_table x_frame_parms
[] =
625 "auto-raise", x_set_autoraise
,
626 "auto-lower", x_set_autolower
,
627 "background-color", x_set_background_color
,
628 "border-color", x_set_border_color
,
629 "border-width", x_set_border_width
,
630 "cursor-color", x_set_cursor_color
,
631 "cursor-type", x_set_cursor_type
,
633 "foreground-color", x_set_foreground_color
,
634 "icon-name", x_set_icon_name
,
635 "icon-type", x_set_icon_type
,
636 "internal-border-width", x_set_internal_border_width
,
637 "menu-bar-lines", x_set_menu_bar_lines
,
638 "mouse-color", x_set_mouse_color
,
639 "name", x_explicitly_set_name
,
640 "scroll-bar-width", x_set_scroll_bar_width
,
641 "title", x_set_title
,
642 "unsplittable", x_set_unsplittable
,
643 "vertical-scroll-bars", x_set_vertical_scroll_bars
,
644 "visibility", x_set_visibility
,
647 /* Attach the `x-frame-parameter' properties to
648 the Lisp symbol names of parameters relevant to W32. */
650 init_x_parm_symbols ()
654 for (i
= 0; i
< sizeof (x_frame_parms
) / sizeof (x_frame_parms
[0]); i
++)
655 Fput (intern (x_frame_parms
[i
].name
), Qx_frame_parameter
,
659 /* Change the parameters of FRAME as specified by ALIST.
660 If a parameter is not specially recognized, do nothing;
661 otherwise call the `x_set_...' function for that parameter. */
664 x_set_frame_parameters (f
, alist
)
670 /* If both of these parameters are present, it's more efficient to
671 set them both at once. So we wait until we've looked at the
672 entire list before we set them. */
676 Lisp_Object left
, top
;
678 /* Same with these. */
679 Lisp_Object icon_left
, icon_top
;
681 /* Record in these vectors all the parms specified. */
685 int left_no_change
= 0, top_no_change
= 0;
686 int icon_left_no_change
= 0, icon_top_no_change
= 0;
689 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
692 parms
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
693 values
= (Lisp_Object
*) alloca (i
* sizeof (Lisp_Object
));
695 /* Extract parm names and values into those vectors. */
698 for (tail
= alist
; CONSP (tail
); tail
= Fcdr (tail
))
700 Lisp_Object elt
, prop
, val
;
703 parms
[i
] = Fcar (elt
);
704 values
[i
] = Fcdr (elt
);
708 top
= left
= Qunbound
;
709 icon_left
= icon_top
= Qunbound
;
711 /* Provide default values for HEIGHT and WIDTH. */
712 width
= FRAME_WIDTH (f
);
713 height
= FRAME_HEIGHT (f
);
715 /* Now process them in reverse of specified order. */
716 for (i
--; i
>= 0; i
--)
718 Lisp_Object prop
, val
;
723 if (EQ (prop
, Qwidth
) && NUMBERP (val
))
724 width
= XFASTINT (val
);
725 else if (EQ (prop
, Qheight
) && NUMBERP (val
))
726 height
= XFASTINT (val
);
727 else if (EQ (prop
, Qtop
))
729 else if (EQ (prop
, Qleft
))
731 else if (EQ (prop
, Qicon_top
))
733 else if (EQ (prop
, Qicon_left
))
737 register Lisp_Object param_index
, old_value
;
739 param_index
= Fget (prop
, Qx_frame_parameter
);
740 old_value
= get_frame_param (f
, prop
);
741 store_frame_param (f
, prop
, val
);
742 if (NATNUMP (param_index
)
743 && (XFASTINT (param_index
)
744 < sizeof (x_frame_parms
)/sizeof (x_frame_parms
[0])))
745 (*x_frame_parms
[XINT (param_index
)].setter
)(f
, val
, old_value
);
749 /* Don't die if just one of these was set. */
750 if (EQ (left
, Qunbound
))
753 if (f
->output_data
.w32
->left_pos
< 0)
754 left
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.w32
->left_pos
), Qnil
));
756 XSETINT (left
, f
->output_data
.w32
->left_pos
);
758 if (EQ (top
, Qunbound
))
761 if (f
->output_data
.w32
->top_pos
< 0)
762 top
= Fcons (Qplus
, Fcons (make_number (f
->output_data
.w32
->top_pos
), Qnil
));
764 XSETINT (top
, f
->output_data
.w32
->top_pos
);
767 /* If one of the icon positions was not set, preserve or default it. */
768 if (EQ (icon_left
, Qunbound
) || ! INTEGERP (icon_left
))
770 icon_left_no_change
= 1;
771 icon_left
= Fcdr (Fassq (Qicon_left
, f
->param_alist
));
772 if (NILP (icon_left
))
773 XSETINT (icon_left
, 0);
775 if (EQ (icon_top
, Qunbound
) || ! INTEGERP (icon_top
))
777 icon_top_no_change
= 1;
778 icon_top
= Fcdr (Fassq (Qicon_top
, f
->param_alist
));
780 XSETINT (icon_top
, 0);
783 /* Don't set these parameters unless they've been explicitly
784 specified. The window might be mapped or resized while we're in
785 this function, and we don't want to override that unless the lisp
786 code has asked for it.
788 Don't set these parameters unless they actually differ from the
789 window's current parameters; the window may not actually exist
794 check_frame_size (f
, &height
, &width
);
796 XSETFRAME (frame
, f
);
798 if (XINT (width
) != FRAME_WIDTH (f
)
799 || XINT (height
) != FRAME_HEIGHT (f
))
800 Fset_frame_size (frame
, make_number (width
), make_number (height
));
802 if ((!NILP (left
) || !NILP (top
))
803 && ! (left_no_change
&& top_no_change
)
804 && ! (NUMBERP (left
) && XINT (left
) == f
->output_data
.w32
->left_pos
805 && NUMBERP (top
) && XINT (top
) == f
->output_data
.w32
->top_pos
))
810 /* Record the signs. */
811 f
->output_data
.w32
->size_hint_flags
&= ~ (XNegative
| YNegative
);
812 if (EQ (left
, Qminus
))
813 f
->output_data
.w32
->size_hint_flags
|= XNegative
;
814 else if (INTEGERP (left
))
816 leftpos
= XINT (left
);
818 f
->output_data
.w32
->size_hint_flags
|= XNegative
;
820 else if (CONSP (left
) && EQ (XCONS (left
)->car
, Qminus
)
821 && CONSP (XCONS (left
)->cdr
)
822 && INTEGERP (XCONS (XCONS (left
)->cdr
)->car
))
824 leftpos
= - XINT (XCONS (XCONS (left
)->cdr
)->car
);
825 f
->output_data
.w32
->size_hint_flags
|= XNegative
;
827 else if (CONSP (left
) && EQ (XCONS (left
)->car
, Qplus
)
828 && CONSP (XCONS (left
)->cdr
)
829 && INTEGERP (XCONS (XCONS (left
)->cdr
)->car
))
831 leftpos
= XINT (XCONS (XCONS (left
)->cdr
)->car
);
834 if (EQ (top
, Qminus
))
835 f
->output_data
.w32
->size_hint_flags
|= YNegative
;
836 else if (INTEGERP (top
))
840 f
->output_data
.w32
->size_hint_flags
|= YNegative
;
842 else if (CONSP (top
) && EQ (XCONS (top
)->car
, Qminus
)
843 && CONSP (XCONS (top
)->cdr
)
844 && INTEGERP (XCONS (XCONS (top
)->cdr
)->car
))
846 toppos
= - XINT (XCONS (XCONS (top
)->cdr
)->car
);
847 f
->output_data
.w32
->size_hint_flags
|= YNegative
;
849 else if (CONSP (top
) && EQ (XCONS (top
)->car
, Qplus
)
850 && CONSP (XCONS (top
)->cdr
)
851 && INTEGERP (XCONS (XCONS (top
)->cdr
)->car
))
853 toppos
= XINT (XCONS (XCONS (top
)->cdr
)->car
);
857 /* Store the numeric value of the position. */
858 f
->output_data
.w32
->top_pos
= toppos
;
859 f
->output_data
.w32
->left_pos
= leftpos
;
861 f
->output_data
.w32
->win_gravity
= NorthWestGravity
;
863 /* Actually set that position, and convert to absolute. */
864 x_set_offset (f
, leftpos
, toppos
, -1);
867 if ((!NILP (icon_left
) || !NILP (icon_top
))
868 && ! (icon_left_no_change
&& icon_top_no_change
))
869 x_wm_set_icon_position (f
, XINT (icon_left
), XINT (icon_top
));
873 /* Store the screen positions of frame F into XPTR and YPTR.
874 These are the positions of the containing window manager window,
875 not Emacs's own window. */
878 x_real_positions (f
, xptr
, yptr
)
887 GetClientRect(FRAME_W32_WINDOW(f
), &rect
);
888 AdjustWindowRect(&rect
, f
->output_data
.w32
->dwStyle
, FRAME_EXTERNAL_MENU_BAR(f
));
894 ClientToScreen (FRAME_W32_WINDOW(f
), &pt
);
900 /* Insert a description of internally-recorded parameters of frame X
901 into the parameter alist *ALISTPTR that is to be given to the user.
902 Only parameters that are specific to W32
903 and whose values are not correctly recorded in the frame's
904 param_alist need to be considered here. */
906 x_report_frame_params (f
, alistptr
)
908 Lisp_Object
*alistptr
;
913 /* Represent negative positions (off the top or left screen edge)
914 in a way that Fmodify_frame_parameters will understand correctly. */
915 XSETINT (tem
, f
->output_data
.w32
->left_pos
);
916 if (f
->output_data
.w32
->left_pos
>= 0)
917 store_in_alist (alistptr
, Qleft
, tem
);
919 store_in_alist (alistptr
, Qleft
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
921 XSETINT (tem
, f
->output_data
.w32
->top_pos
);
922 if (f
->output_data
.w32
->top_pos
>= 0)
923 store_in_alist (alistptr
, Qtop
, tem
);
925 store_in_alist (alistptr
, Qtop
, Fcons (Qplus
, Fcons (tem
, Qnil
)));
927 store_in_alist (alistptr
, Qborder_width
,
928 make_number (f
->output_data
.w32
->border_width
));
929 store_in_alist (alistptr
, Qinternal_border_width
,
930 make_number (f
->output_data
.w32
->internal_border_width
));
931 sprintf (buf
, "%ld", (long) FRAME_W32_WINDOW (f
));
932 store_in_alist (alistptr
, Qwindow_id
,
934 store_in_alist (alistptr
, Qicon_name
, f
->icon_name
);
935 FRAME_SAMPLE_VISIBILITY (f
);
936 store_in_alist (alistptr
, Qvisibility
,
937 (FRAME_VISIBLE_P (f
) ? Qt
938 : FRAME_ICONIFIED_P (f
) ? Qicon
: Qnil
));
939 store_in_alist (alistptr
, Qdisplay
,
940 XCONS (FRAME_W32_DISPLAY_INFO (f
)->name_list_element
)->car
);
944 DEFUN ("w32-define-rgb-color", Fw32_define_rgb_color
, Sw32_define_rgb_color
, 4, 4, 0,
945 "Convert RGB numbers to a windows color reference and associate with NAME (a string).\n\
946 This adds or updates a named color to w32-color-map, making it available for use.\n\
947 The original entry's RGB ref is returned, or nil if the entry is new.")
948 (red
, green
, blue
, name
)
949 Lisp_Object red
, green
, blue
, name
;
952 Lisp_Object oldrgb
= Qnil
;
955 CHECK_NUMBER (red
, 0);
956 CHECK_NUMBER (green
, 0);
957 CHECK_NUMBER (blue
, 0);
958 CHECK_STRING (name
, 0);
960 XSET (rgb
, Lisp_Int
, RGB(XUINT (red
), XUINT (green
), XUINT (blue
)));
964 /* replace existing entry in w32-color-map or add new entry. */
965 entry
= Fassoc (name
, Vw32_color_map
);
968 entry
= Fcons (name
, rgb
);
969 Vw32_color_map
= Fcons (entry
, Vw32_color_map
);
973 oldrgb
= Fcdr (entry
);
974 Fsetcdr (entry
, rgb
);
982 DEFUN ("w32-load-color-file", Fw32_load_color_file
, Sw32_load_color_file
, 1, 1, 0,
983 "Create an alist of color entries from an external file (ie. rgb.txt).\n\
984 Assign this value to w32-color-map to replace the existing color map.\n\
986 The file should define one named RGB color per line like so:\
988 where R,G,B are numbers between 0 and 255 and name is an arbitrary string.")
990 Lisp_Object filename
;
993 Lisp_Object cmap
= Qnil
;
996 CHECK_STRING (filename
, 0);
997 abspath
= Fexpand_file_name (filename
, Qnil
);
999 fp
= fopen (XSTRING (filename
)->data
, "rt");
1003 int red
, green
, blue
;
1008 while (fgets (buf
, sizeof (buf
), fp
) != NULL
) {
1009 if (sscanf (buf
, "%u %u %u %n", &red
, &green
, &blue
, &num
) == 3)
1011 char *name
= buf
+ num
;
1012 num
= strlen (name
) - 1;
1013 if (name
[num
] == '\n')
1015 cmap
= Fcons (Fcons (build_string (name
),
1016 make_number (RGB (red
, green
, blue
))),
1028 /* The default colors for the w32 color map */
1029 typedef struct colormap_t
1035 colormap_t w32_color_map
[] =
1037 {"snow" , PALETTERGB (255,250,250)},
1038 {"ghost white" , PALETTERGB (248,248,255)},
1039 {"GhostWhite" , PALETTERGB (248,248,255)},
1040 {"white smoke" , PALETTERGB (245,245,245)},
1041 {"WhiteSmoke" , PALETTERGB (245,245,245)},
1042 {"gainsboro" , PALETTERGB (220,220,220)},
1043 {"floral white" , PALETTERGB (255,250,240)},
1044 {"FloralWhite" , PALETTERGB (255,250,240)},
1045 {"old lace" , PALETTERGB (253,245,230)},
1046 {"OldLace" , PALETTERGB (253,245,230)},
1047 {"linen" , PALETTERGB (250,240,230)},
1048 {"antique white" , PALETTERGB (250,235,215)},
1049 {"AntiqueWhite" , PALETTERGB (250,235,215)},
1050 {"papaya whip" , PALETTERGB (255,239,213)},
1051 {"PapayaWhip" , PALETTERGB (255,239,213)},
1052 {"blanched almond" , PALETTERGB (255,235,205)},
1053 {"BlanchedAlmond" , PALETTERGB (255,235,205)},
1054 {"bisque" , PALETTERGB (255,228,196)},
1055 {"peach puff" , PALETTERGB (255,218,185)},
1056 {"PeachPuff" , PALETTERGB (255,218,185)},
1057 {"navajo white" , PALETTERGB (255,222,173)},
1058 {"NavajoWhite" , PALETTERGB (255,222,173)},
1059 {"moccasin" , PALETTERGB (255,228,181)},
1060 {"cornsilk" , PALETTERGB (255,248,220)},
1061 {"ivory" , PALETTERGB (255,255,240)},
1062 {"lemon chiffon" , PALETTERGB (255,250,205)},
1063 {"LemonChiffon" , PALETTERGB (255,250,205)},
1064 {"seashell" , PALETTERGB (255,245,238)},
1065 {"honeydew" , PALETTERGB (240,255,240)},
1066 {"mint cream" , PALETTERGB (245,255,250)},
1067 {"MintCream" , PALETTERGB (245,255,250)},
1068 {"azure" , PALETTERGB (240,255,255)},
1069 {"alice blue" , PALETTERGB (240,248,255)},
1070 {"AliceBlue" , PALETTERGB (240,248,255)},
1071 {"lavender" , PALETTERGB (230,230,250)},
1072 {"lavender blush" , PALETTERGB (255,240,245)},
1073 {"LavenderBlush" , PALETTERGB (255,240,245)},
1074 {"misty rose" , PALETTERGB (255,228,225)},
1075 {"MistyRose" , PALETTERGB (255,228,225)},
1076 {"white" , PALETTERGB (255,255,255)},
1077 {"black" , PALETTERGB ( 0, 0, 0)},
1078 {"dark slate gray" , PALETTERGB ( 47, 79, 79)},
1079 {"DarkSlateGray" , PALETTERGB ( 47, 79, 79)},
1080 {"dark slate grey" , PALETTERGB ( 47, 79, 79)},
1081 {"DarkSlateGrey" , PALETTERGB ( 47, 79, 79)},
1082 {"dim gray" , PALETTERGB (105,105,105)},
1083 {"DimGray" , PALETTERGB (105,105,105)},
1084 {"dim grey" , PALETTERGB (105,105,105)},
1085 {"DimGrey" , PALETTERGB (105,105,105)},
1086 {"slate gray" , PALETTERGB (112,128,144)},
1087 {"SlateGray" , PALETTERGB (112,128,144)},
1088 {"slate grey" , PALETTERGB (112,128,144)},
1089 {"SlateGrey" , PALETTERGB (112,128,144)},
1090 {"light slate gray" , PALETTERGB (119,136,153)},
1091 {"LightSlateGray" , PALETTERGB (119,136,153)},
1092 {"light slate grey" , PALETTERGB (119,136,153)},
1093 {"LightSlateGrey" , PALETTERGB (119,136,153)},
1094 {"gray" , PALETTERGB (190,190,190)},
1095 {"grey" , PALETTERGB (190,190,190)},
1096 {"light grey" , PALETTERGB (211,211,211)},
1097 {"LightGrey" , PALETTERGB (211,211,211)},
1098 {"light gray" , PALETTERGB (211,211,211)},
1099 {"LightGray" , PALETTERGB (211,211,211)},
1100 {"midnight blue" , PALETTERGB ( 25, 25,112)},
1101 {"MidnightBlue" , PALETTERGB ( 25, 25,112)},
1102 {"navy" , PALETTERGB ( 0, 0,128)},
1103 {"navy blue" , PALETTERGB ( 0, 0,128)},
1104 {"NavyBlue" , PALETTERGB ( 0, 0,128)},
1105 {"cornflower blue" , PALETTERGB (100,149,237)},
1106 {"CornflowerBlue" , PALETTERGB (100,149,237)},
1107 {"dark slate blue" , PALETTERGB ( 72, 61,139)},
1108 {"DarkSlateBlue" , PALETTERGB ( 72, 61,139)},
1109 {"slate blue" , PALETTERGB (106, 90,205)},
1110 {"SlateBlue" , PALETTERGB (106, 90,205)},
1111 {"medium slate blue" , PALETTERGB (123,104,238)},
1112 {"MediumSlateBlue" , PALETTERGB (123,104,238)},
1113 {"light slate blue" , PALETTERGB (132,112,255)},
1114 {"LightSlateBlue" , PALETTERGB (132,112,255)},
1115 {"medium blue" , PALETTERGB ( 0, 0,205)},
1116 {"MediumBlue" , PALETTERGB ( 0, 0,205)},
1117 {"royal blue" , PALETTERGB ( 65,105,225)},
1118 {"RoyalBlue" , PALETTERGB ( 65,105,225)},
1119 {"blue" , PALETTERGB ( 0, 0,255)},
1120 {"dodger blue" , PALETTERGB ( 30,144,255)},
1121 {"DodgerBlue" , PALETTERGB ( 30,144,255)},
1122 {"deep sky blue" , PALETTERGB ( 0,191,255)},
1123 {"DeepSkyBlue" , PALETTERGB ( 0,191,255)},
1124 {"sky blue" , PALETTERGB (135,206,235)},
1125 {"SkyBlue" , PALETTERGB (135,206,235)},
1126 {"light sky blue" , PALETTERGB (135,206,250)},
1127 {"LightSkyBlue" , PALETTERGB (135,206,250)},
1128 {"steel blue" , PALETTERGB ( 70,130,180)},
1129 {"SteelBlue" , PALETTERGB ( 70,130,180)},
1130 {"light steel blue" , PALETTERGB (176,196,222)},
1131 {"LightSteelBlue" , PALETTERGB (176,196,222)},
1132 {"light blue" , PALETTERGB (173,216,230)},
1133 {"LightBlue" , PALETTERGB (173,216,230)},
1134 {"powder blue" , PALETTERGB (176,224,230)},
1135 {"PowderBlue" , PALETTERGB (176,224,230)},
1136 {"pale turquoise" , PALETTERGB (175,238,238)},
1137 {"PaleTurquoise" , PALETTERGB (175,238,238)},
1138 {"dark turquoise" , PALETTERGB ( 0,206,209)},
1139 {"DarkTurquoise" , PALETTERGB ( 0,206,209)},
1140 {"medium turquoise" , PALETTERGB ( 72,209,204)},
1141 {"MediumTurquoise" , PALETTERGB ( 72,209,204)},
1142 {"turquoise" , PALETTERGB ( 64,224,208)},
1143 {"cyan" , PALETTERGB ( 0,255,255)},
1144 {"light cyan" , PALETTERGB (224,255,255)},
1145 {"LightCyan" , PALETTERGB (224,255,255)},
1146 {"cadet blue" , PALETTERGB ( 95,158,160)},
1147 {"CadetBlue" , PALETTERGB ( 95,158,160)},
1148 {"medium aquamarine" , PALETTERGB (102,205,170)},
1149 {"MediumAquamarine" , PALETTERGB (102,205,170)},
1150 {"aquamarine" , PALETTERGB (127,255,212)},
1151 {"dark green" , PALETTERGB ( 0,100, 0)},
1152 {"DarkGreen" , PALETTERGB ( 0,100, 0)},
1153 {"dark olive green" , PALETTERGB ( 85,107, 47)},
1154 {"DarkOliveGreen" , PALETTERGB ( 85,107, 47)},
1155 {"dark sea green" , PALETTERGB (143,188,143)},
1156 {"DarkSeaGreen" , PALETTERGB (143,188,143)},
1157 {"sea green" , PALETTERGB ( 46,139, 87)},
1158 {"SeaGreen" , PALETTERGB ( 46,139, 87)},
1159 {"medium sea green" , PALETTERGB ( 60,179,113)},
1160 {"MediumSeaGreen" , PALETTERGB ( 60,179,113)},
1161 {"light sea green" , PALETTERGB ( 32,178,170)},
1162 {"LightSeaGreen" , PALETTERGB ( 32,178,170)},
1163 {"pale green" , PALETTERGB (152,251,152)},
1164 {"PaleGreen" , PALETTERGB (152,251,152)},
1165 {"spring green" , PALETTERGB ( 0,255,127)},
1166 {"SpringGreen" , PALETTERGB ( 0,255,127)},
1167 {"lawn green" , PALETTERGB (124,252, 0)},
1168 {"LawnGreen" , PALETTERGB (124,252, 0)},
1169 {"green" , PALETTERGB ( 0,255, 0)},
1170 {"chartreuse" , PALETTERGB (127,255, 0)},
1171 {"medium spring green" , PALETTERGB ( 0,250,154)},
1172 {"MediumSpringGreen" , PALETTERGB ( 0,250,154)},
1173 {"green yellow" , PALETTERGB (173,255, 47)},
1174 {"GreenYellow" , PALETTERGB (173,255, 47)},
1175 {"lime green" , PALETTERGB ( 50,205, 50)},
1176 {"LimeGreen" , PALETTERGB ( 50,205, 50)},
1177 {"yellow green" , PALETTERGB (154,205, 50)},
1178 {"YellowGreen" , PALETTERGB (154,205, 50)},
1179 {"forest green" , PALETTERGB ( 34,139, 34)},
1180 {"ForestGreen" , PALETTERGB ( 34,139, 34)},
1181 {"olive drab" , PALETTERGB (107,142, 35)},
1182 {"OliveDrab" , PALETTERGB (107,142, 35)},
1183 {"dark khaki" , PALETTERGB (189,183,107)},
1184 {"DarkKhaki" , PALETTERGB (189,183,107)},
1185 {"khaki" , PALETTERGB (240,230,140)},
1186 {"pale goldenrod" , PALETTERGB (238,232,170)},
1187 {"PaleGoldenrod" , PALETTERGB (238,232,170)},
1188 {"light goldenrod yellow" , PALETTERGB (250,250,210)},
1189 {"LightGoldenrodYellow" , PALETTERGB (250,250,210)},
1190 {"light yellow" , PALETTERGB (255,255,224)},
1191 {"LightYellow" , PALETTERGB (255,255,224)},
1192 {"yellow" , PALETTERGB (255,255, 0)},
1193 {"gold" , PALETTERGB (255,215, 0)},
1194 {"light goldenrod" , PALETTERGB (238,221,130)},
1195 {"LightGoldenrod" , PALETTERGB (238,221,130)},
1196 {"goldenrod" , PALETTERGB (218,165, 32)},
1197 {"dark goldenrod" , PALETTERGB (184,134, 11)},
1198 {"DarkGoldenrod" , PALETTERGB (184,134, 11)},
1199 {"rosy brown" , PALETTERGB (188,143,143)},
1200 {"RosyBrown" , PALETTERGB (188,143,143)},
1201 {"indian red" , PALETTERGB (205, 92, 92)},
1202 {"IndianRed" , PALETTERGB (205, 92, 92)},
1203 {"saddle brown" , PALETTERGB (139, 69, 19)},
1204 {"SaddleBrown" , PALETTERGB (139, 69, 19)},
1205 {"sienna" , PALETTERGB (160, 82, 45)},
1206 {"peru" , PALETTERGB (205,133, 63)},
1207 {"burlywood" , PALETTERGB (222,184,135)},
1208 {"beige" , PALETTERGB (245,245,220)},
1209 {"wheat" , PALETTERGB (245,222,179)},
1210 {"sandy brown" , PALETTERGB (244,164, 96)},
1211 {"SandyBrown" , PALETTERGB (244,164, 96)},
1212 {"tan" , PALETTERGB (210,180,140)},
1213 {"chocolate" , PALETTERGB (210,105, 30)},
1214 {"firebrick" , PALETTERGB (178,34, 34)},
1215 {"brown" , PALETTERGB (165,42, 42)},
1216 {"dark salmon" , PALETTERGB (233,150,122)},
1217 {"DarkSalmon" , PALETTERGB (233,150,122)},
1218 {"salmon" , PALETTERGB (250,128,114)},
1219 {"light salmon" , PALETTERGB (255,160,122)},
1220 {"LightSalmon" , PALETTERGB (255,160,122)},
1221 {"orange" , PALETTERGB (255,165, 0)},
1222 {"dark orange" , PALETTERGB (255,140, 0)},
1223 {"DarkOrange" , PALETTERGB (255,140, 0)},
1224 {"coral" , PALETTERGB (255,127, 80)},
1225 {"light coral" , PALETTERGB (240,128,128)},
1226 {"LightCoral" , PALETTERGB (240,128,128)},
1227 {"tomato" , PALETTERGB (255, 99, 71)},
1228 {"orange red" , PALETTERGB (255, 69, 0)},
1229 {"OrangeRed" , PALETTERGB (255, 69, 0)},
1230 {"red" , PALETTERGB (255, 0, 0)},
1231 {"hot pink" , PALETTERGB (255,105,180)},
1232 {"HotPink" , PALETTERGB (255,105,180)},
1233 {"deep pink" , PALETTERGB (255, 20,147)},
1234 {"DeepPink" , PALETTERGB (255, 20,147)},
1235 {"pink" , PALETTERGB (255,192,203)},
1236 {"light pink" , PALETTERGB (255,182,193)},
1237 {"LightPink" , PALETTERGB (255,182,193)},
1238 {"pale violet red" , PALETTERGB (219,112,147)},
1239 {"PaleVioletRed" , PALETTERGB (219,112,147)},
1240 {"maroon" , PALETTERGB (176, 48, 96)},
1241 {"medium violet red" , PALETTERGB (199, 21,133)},
1242 {"MediumVioletRed" , PALETTERGB (199, 21,133)},
1243 {"violet red" , PALETTERGB (208, 32,144)},
1244 {"VioletRed" , PALETTERGB (208, 32,144)},
1245 {"magenta" , PALETTERGB (255, 0,255)},
1246 {"violet" , PALETTERGB (238,130,238)},
1247 {"plum" , PALETTERGB (221,160,221)},
1248 {"orchid" , PALETTERGB (218,112,214)},
1249 {"medium orchid" , PALETTERGB (186, 85,211)},
1250 {"MediumOrchid" , PALETTERGB (186, 85,211)},
1251 {"dark orchid" , PALETTERGB (153, 50,204)},
1252 {"DarkOrchid" , PALETTERGB (153, 50,204)},
1253 {"dark violet" , PALETTERGB (148, 0,211)},
1254 {"DarkViolet" , PALETTERGB (148, 0,211)},
1255 {"blue violet" , PALETTERGB (138, 43,226)},
1256 {"BlueViolet" , PALETTERGB (138, 43,226)},
1257 {"purple" , PALETTERGB (160, 32,240)},
1258 {"medium purple" , PALETTERGB (147,112,219)},
1259 {"MediumPurple" , PALETTERGB (147,112,219)},
1260 {"thistle" , PALETTERGB (216,191,216)},
1261 {"gray0" , PALETTERGB ( 0, 0, 0)},
1262 {"grey0" , PALETTERGB ( 0, 0, 0)},
1263 {"dark grey" , PALETTERGB (169,169,169)},
1264 {"DarkGrey" , PALETTERGB (169,169,169)},
1265 {"dark gray" , PALETTERGB (169,169,169)},
1266 {"DarkGray" , PALETTERGB (169,169,169)},
1267 {"dark blue" , PALETTERGB ( 0, 0,139)},
1268 {"DarkBlue" , PALETTERGB ( 0, 0,139)},
1269 {"dark cyan" , PALETTERGB ( 0,139,139)},
1270 {"DarkCyan" , PALETTERGB ( 0,139,139)},
1271 {"dark magenta" , PALETTERGB (139, 0,139)},
1272 {"DarkMagenta" , PALETTERGB (139, 0,139)},
1273 {"dark red" , PALETTERGB (139, 0, 0)},
1274 {"DarkRed" , PALETTERGB (139, 0, 0)},
1275 {"light green" , PALETTERGB (144,238,144)},
1276 {"LightGreen" , PALETTERGB (144,238,144)},
1279 DEFUN ("w32-default-color-map", Fw32_default_color_map
, Sw32_default_color_map
,
1280 0, 0, 0, "Return the default color map.")
1284 colormap_t
*pc
= w32_color_map
;
1291 for (i
= 0; i
< sizeof (w32_color_map
) / sizeof (w32_color_map
[0]);
1293 cmap
= Fcons (Fcons (build_string (pc
->name
),
1294 make_number (pc
->colorref
)),
1303 w32_to_x_color (rgb
)
1308 CHECK_NUMBER (rgb
, 0);
1312 color
= Frassq (rgb
, Vw32_color_map
);
1317 return (Fcar (color
));
1323 w32_color_map_lookup (colorname
)
1326 Lisp_Object tail
, ret
= Qnil
;
1330 for (tail
= Vw32_color_map
; !NILP (tail
); tail
= Fcdr (tail
))
1332 register Lisp_Object elt
, tem
;
1335 if (!CONSP (elt
)) continue;
1339 if (lstrcmpi (XSTRING (tem
)->data
, colorname
) == 0)
1341 ret
= XUINT (Fcdr (elt
));
1355 x_to_w32_color (colorname
)
1358 register Lisp_Object tail
, ret
= Qnil
;
1362 if (colorname
[0] == '#')
1364 /* Could be an old-style RGB Device specification. */
1367 color
= colorname
+ 1;
1369 size
= strlen(color
);
1370 if (size
== 3 || size
== 6 || size
== 9 || size
== 12)
1378 for (i
= 0; i
< 3; i
++)
1382 unsigned long value
;
1384 /* The check for 'x' in the following conditional takes into
1385 account the fact that strtol allows a "0x" in front of
1386 our numbers, and we don't. */
1387 if (!isxdigit(color
[0]) || color
[1] == 'x')
1391 value
= strtoul(color
, &end
, 16);
1393 if (errno
== ERANGE
|| end
- color
!= size
)
1398 value
= value
* 0x10;
1409 colorval
|= (value
<< pos
);
1420 else if (strnicmp(colorname
, "rgb:", 4) == 0)
1428 color
= colorname
+ 4;
1429 for (i
= 0; i
< 3; i
++)
1432 unsigned long value
;
1434 /* The check for 'x' in the following conditional takes into
1435 account the fact that strtol allows a "0x" in front of
1436 our numbers, and we don't. */
1437 if (!isxdigit(color
[0]) || color
[1] == 'x')
1439 value
= strtoul(color
, &end
, 16);
1440 if (errno
== ERANGE
)
1442 switch (end
- color
)
1445 value
= value
* 0x10 + value
;
1458 if (value
== ULONG_MAX
)
1460 colorval
|= (value
<< pos
);
1474 else if (strnicmp(colorname
, "rgbi:", 5) == 0)
1476 /* This is an RGB Intensity specification. */
1483 color
= colorname
+ 5;
1484 for (i
= 0; i
< 3; i
++)
1490 value
= strtod(color
, &end
);
1491 if (errno
== ERANGE
)
1493 if (value
< 0.0 || value
> 1.0)
1495 val
= (UINT
)(0x100 * value
);
1496 /* We used 0x100 instead of 0xFF to give an continuous
1497 range between 0.0 and 1.0 inclusive. The next statement
1498 fixes the 1.0 case. */
1501 colorval
|= (val
<< pos
);
1515 /* I am not going to attempt to handle any of the CIE color schemes
1516 or TekHVC, since I don't know the algorithms for conversion to
1519 /* If we fail to lookup the color name in w32_color_map, then check the
1520 colorname to see if it can be crudely approximated: If the X color
1521 ends in a number (e.g., "darkseagreen2"), strip the number and
1522 return the result of looking up the base color name. */
1523 ret
= w32_color_map_lookup (colorname
);
1526 int len
= strlen (colorname
);
1528 if (isdigit (colorname
[len
- 1]))
1530 char *ptr
, *approx
= alloca (len
);
1532 strcpy (approx
, colorname
);
1533 ptr
= &approx
[len
- 1];
1534 while (ptr
> approx
&& isdigit (*ptr
))
1537 ret
= w32_color_map_lookup (approx
);
1547 w32_regenerate_palette (FRAME_PTR f
)
1549 struct w32_palette_entry
* list
;
1550 LOGPALETTE
* log_palette
;
1551 HPALETTE new_palette
;
1554 /* don't bother trying to create palette if not supported */
1555 if (! FRAME_W32_DISPLAY_INFO (f
)->has_palette
)
1558 log_palette
= (LOGPALETTE
*)
1559 alloca (sizeof (LOGPALETTE
) +
1560 FRAME_W32_DISPLAY_INFO (f
)->num_colors
* sizeof (PALETTEENTRY
));
1561 log_palette
->palVersion
= 0x300;
1562 log_palette
->palNumEntries
= FRAME_W32_DISPLAY_INFO (f
)->num_colors
;
1564 list
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1566 i
< FRAME_W32_DISPLAY_INFO (f
)->num_colors
;
1567 i
++, list
= list
->next
)
1568 log_palette
->palPalEntry
[i
] = list
->entry
;
1570 new_palette
= CreatePalette (log_palette
);
1574 if (FRAME_W32_DISPLAY_INFO (f
)->palette
)
1575 DeleteObject (FRAME_W32_DISPLAY_INFO (f
)->palette
);
1576 FRAME_W32_DISPLAY_INFO (f
)->palette
= new_palette
;
1578 /* Realize display palette and garbage all frames. */
1579 release_frame_dc (f
, get_frame_dc (f
));
1584 #define W32_COLOR(pe) RGB (pe.peRed, pe.peGreen, pe.peBlue)
1585 #define SET_W32_COLOR(pe, color) \
1588 pe.peRed = GetRValue (color); \
1589 pe.peGreen = GetGValue (color); \
1590 pe.peBlue = GetBValue (color); \
1595 /* Keep these around in case we ever want to track color usage. */
1597 w32_map_color (FRAME_PTR f
, COLORREF color
)
1599 struct w32_palette_entry
* list
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1601 if (NILP (Vw32_enable_palette
))
1604 /* check if color is already mapped */
1607 if (W32_COLOR (list
->entry
) == color
)
1615 /* not already mapped, so add to list and recreate Windows palette */
1616 list
= (struct w32_palette_entry
*)
1617 xmalloc (sizeof (struct w32_palette_entry
));
1618 SET_W32_COLOR (list
->entry
, color
);
1620 list
->next
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1621 FRAME_W32_DISPLAY_INFO (f
)->color_list
= list
;
1622 FRAME_W32_DISPLAY_INFO (f
)->num_colors
++;
1624 /* set flag that palette must be regenerated */
1625 FRAME_W32_DISPLAY_INFO (f
)->regen_palette
= TRUE
;
1629 w32_unmap_color (FRAME_PTR f
, COLORREF color
)
1631 struct w32_palette_entry
* list
= FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1632 struct w32_palette_entry
**prev
= &FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1634 if (NILP (Vw32_enable_palette
))
1637 /* check if color is already mapped */
1640 if (W32_COLOR (list
->entry
) == color
)
1642 if (--list
->refcount
== 0)
1646 FRAME_W32_DISPLAY_INFO (f
)->num_colors
--;
1656 /* set flag that palette must be regenerated */
1657 FRAME_W32_DISPLAY_INFO (f
)->regen_palette
= TRUE
;
1661 /* Decide if color named COLOR is valid for the display associated with
1662 the selected frame; if so, return the rgb values in COLOR_DEF.
1663 If ALLOC is nonzero, allocate a new colormap cell. */
1666 defined_color (f
, color
, color_def
, alloc
)
1669 COLORREF
*color_def
;
1672 register Lisp_Object tem
;
1674 tem
= x_to_w32_color (color
);
1678 if (!NILP (Vw32_enable_palette
))
1680 struct w32_palette_entry
* entry
=
1681 FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1682 struct w32_palette_entry
** prev
=
1683 &FRAME_W32_DISPLAY_INFO (f
)->color_list
;
1685 /* check if color is already mapped */
1688 if (W32_COLOR (entry
->entry
) == XUINT (tem
))
1690 prev
= &entry
->next
;
1691 entry
= entry
->next
;
1694 if (entry
== NULL
&& alloc
)
1696 /* not already mapped, so add to list */
1697 entry
= (struct w32_palette_entry
*)
1698 xmalloc (sizeof (struct w32_palette_entry
));
1699 SET_W32_COLOR (entry
->entry
, XUINT (tem
));
1702 FRAME_W32_DISPLAY_INFO (f
)->num_colors
++;
1704 /* set flag that palette must be regenerated */
1705 FRAME_W32_DISPLAY_INFO (f
)->regen_palette
= TRUE
;
1708 /* Ensure COLORREF value is snapped to nearest color in (default)
1709 palette by simulating the PALETTERGB macro. This works whether
1710 or not the display device has a palette. */
1711 *color_def
= XUINT (tem
) | 0x2000000;
1720 /* Given a string ARG naming a color, compute a pixel value from it
1721 suitable for screen F.
1722 If F is not a color screen, return DEF (default) regardless of what
1726 x_decode_color (f
, arg
, def
)
1733 CHECK_STRING (arg
, 0);
1735 if (strcmp (XSTRING (arg
)->data
, "black") == 0)
1736 return BLACK_PIX_DEFAULT (f
);
1737 else if (strcmp (XSTRING (arg
)->data
, "white") == 0)
1738 return WHITE_PIX_DEFAULT (f
);
1740 if ((FRAME_W32_DISPLAY_INFO (f
)->n_planes
* FRAME_W32_DISPLAY_INFO (f
)->n_cbits
) == 1)
1743 /* defined_color is responsible for coping with failures
1744 by looking for a near-miss. */
1745 if (defined_color (f
, XSTRING (arg
)->data
, &cdef
, 1))
1748 /* defined_color failed; return an ultimate default. */
1752 /* Functions called only from `x_set_frame_param'
1753 to set individual parameters.
1755 If FRAME_W32_WINDOW (f) is 0,
1756 the frame is being created and its window does not exist yet.
1757 In that case, just record the parameter's new value
1758 in the standard place; do not attempt to change the window. */
1761 x_set_foreground_color (f
, arg
, oldval
)
1763 Lisp_Object arg
, oldval
;
1765 f
->output_data
.w32
->foreground_pixel
1766 = x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1768 if (FRAME_W32_WINDOW (f
) != 0)
1770 recompute_basic_faces (f
);
1771 if (FRAME_VISIBLE_P (f
))
1777 x_set_background_color (f
, arg
, oldval
)
1779 Lisp_Object arg
, oldval
;
1784 f
->output_data
.w32
->background_pixel
1785 = x_decode_color (f
, arg
, WHITE_PIX_DEFAULT (f
));
1787 if (FRAME_W32_WINDOW (f
) != 0)
1789 SetWindowLong (FRAME_W32_WINDOW (f
), WND_BACKGROUND_INDEX
, f
->output_data
.w32
->background_pixel
);
1791 recompute_basic_faces (f
);
1793 if (FRAME_VISIBLE_P (f
))
1799 x_set_mouse_color (f
, arg
, oldval
)
1801 Lisp_Object arg
, oldval
;
1804 Cursor cursor
, nontext_cursor
, mode_cursor
, cross_cursor
;
1809 if (!EQ (Qnil
, arg
))
1810 f
->output_data
.w32
->mouse_pixel
1811 = x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1812 mask_color
= f
->output_data
.w32
->background_pixel
;
1813 /* No invisible pointers. */
1814 if (mask_color
== f
->output_data
.w32
->mouse_pixel
1815 && mask_color
== f
->output_data
.w32
->background_pixel
)
1816 f
->output_data
.w32
->mouse_pixel
= f
->output_data
.w32
->foreground_pixel
;
1821 /* It's not okay to crash if the user selects a screwy cursor. */
1822 count
= x_catch_errors (FRAME_W32_DISPLAY (f
));
1824 if (!EQ (Qnil
, Vx_pointer_shape
))
1826 CHECK_NUMBER (Vx_pointer_shape
, 0);
1827 cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XINT (Vx_pointer_shape
));
1830 cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_xterm
);
1831 x_check_errors (FRAME_W32_DISPLAY (f
), "bad text pointer cursor: %s");
1833 if (!EQ (Qnil
, Vx_nontext_pointer_shape
))
1835 CHECK_NUMBER (Vx_nontext_pointer_shape
, 0);
1836 nontext_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
),
1837 XINT (Vx_nontext_pointer_shape
));
1840 nontext_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_left_ptr
);
1841 x_check_errors (FRAME_W32_DISPLAY (f
), "bad nontext pointer cursor: %s");
1843 if (!EQ (Qnil
, Vx_mode_pointer_shape
))
1845 CHECK_NUMBER (Vx_mode_pointer_shape
, 0);
1846 mode_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
),
1847 XINT (Vx_mode_pointer_shape
));
1850 mode_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_xterm
);
1851 x_check_errors (FRAME_W32_DISPLAY (f
), "bad modeline pointer cursor: %s");
1853 if (!EQ (Qnil
, Vx_sensitive_text_pointer_shape
))
1855 CHECK_NUMBER (Vx_sensitive_text_pointer_shape
, 0);
1857 = XCreateFontCursor (FRAME_W32_DISPLAY (f
),
1858 XINT (Vx_sensitive_text_pointer_shape
));
1861 cross_cursor
= XCreateFontCursor (FRAME_W32_DISPLAY (f
), XC_crosshair
);
1863 /* Check and report errors with the above calls. */
1864 x_check_errors (FRAME_W32_DISPLAY (f
), "can't set cursor shape: %s");
1865 x_uncatch_errors (FRAME_W32_DISPLAY (f
), count
);
1868 XColor fore_color
, back_color
;
1870 fore_color
.pixel
= f
->output_data
.w32
->mouse_pixel
;
1871 back_color
.pixel
= mask_color
;
1872 XQueryColor (FRAME_W32_DISPLAY (f
),
1873 DefaultColormap (FRAME_W32_DISPLAY (f
),
1874 DefaultScreen (FRAME_W32_DISPLAY (f
))),
1876 XQueryColor (FRAME_W32_DISPLAY (f
),
1877 DefaultColormap (FRAME_W32_DISPLAY (f
),
1878 DefaultScreen (FRAME_W32_DISPLAY (f
))),
1880 XRecolorCursor (FRAME_W32_DISPLAY (f
), cursor
,
1881 &fore_color
, &back_color
);
1882 XRecolorCursor (FRAME_W32_DISPLAY (f
), nontext_cursor
,
1883 &fore_color
, &back_color
);
1884 XRecolorCursor (FRAME_W32_DISPLAY (f
), mode_cursor
,
1885 &fore_color
, &back_color
);
1886 XRecolorCursor (FRAME_W32_DISPLAY (f
), cross_cursor
,
1887 &fore_color
, &back_color
);
1890 if (FRAME_W32_WINDOW (f
) != 0)
1892 XDefineCursor (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
), cursor
);
1895 if (cursor
!= f
->output_data
.w32
->text_cursor
&& f
->output_data
.w32
->text_cursor
!= 0)
1896 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->text_cursor
);
1897 f
->output_data
.w32
->text_cursor
= cursor
;
1899 if (nontext_cursor
!= f
->output_data
.w32
->nontext_cursor
1900 && f
->output_data
.w32
->nontext_cursor
!= 0)
1901 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->nontext_cursor
);
1902 f
->output_data
.w32
->nontext_cursor
= nontext_cursor
;
1904 if (mode_cursor
!= f
->output_data
.w32
->modeline_cursor
1905 && f
->output_data
.w32
->modeline_cursor
!= 0)
1906 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->modeline_cursor
);
1907 f
->output_data
.w32
->modeline_cursor
= mode_cursor
;
1908 if (cross_cursor
!= f
->output_data
.w32
->cross_cursor
1909 && f
->output_data
.w32
->cross_cursor
!= 0)
1910 XFreeCursor (FRAME_W32_DISPLAY (f
), f
->output_data
.w32
->cross_cursor
);
1911 f
->output_data
.w32
->cross_cursor
= cross_cursor
;
1913 XFlush (FRAME_W32_DISPLAY (f
));
1919 x_set_cursor_color (f
, arg
, oldval
)
1921 Lisp_Object arg
, oldval
;
1923 unsigned long fore_pixel
;
1925 if (!EQ (Vx_cursor_fore_pixel
, Qnil
))
1926 fore_pixel
= x_decode_color (f
, Vx_cursor_fore_pixel
,
1927 WHITE_PIX_DEFAULT (f
));
1929 fore_pixel
= f
->output_data
.w32
->background_pixel
;
1930 f
->output_data
.w32
->cursor_pixel
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1932 /* Make sure that the cursor color differs from the background color. */
1933 if (f
->output_data
.w32
->cursor_pixel
== f
->output_data
.w32
->background_pixel
)
1935 f
->output_data
.w32
->cursor_pixel
= f
->output_data
.w32
->mouse_pixel
;
1936 if (f
->output_data
.w32
->cursor_pixel
== fore_pixel
)
1937 fore_pixel
= f
->output_data
.w32
->background_pixel
;
1939 f
->output_data
.w32
->cursor_foreground_pixel
= fore_pixel
;
1941 if (FRAME_W32_WINDOW (f
) != 0)
1943 if (FRAME_VISIBLE_P (f
))
1945 x_display_cursor (f
, 0);
1946 x_display_cursor (f
, 1);
1951 /* Set the border-color of frame F to value described by ARG.
1952 ARG can be a string naming a color.
1953 The border-color is used for the border that is drawn by the server.
1954 Note that this does not fully take effect if done before
1955 F has a window; it must be redone when the window is created. */
1958 x_set_border_color (f
, arg
, oldval
)
1960 Lisp_Object arg
, oldval
;
1965 CHECK_STRING (arg
, 0);
1966 str
= XSTRING (arg
)->data
;
1968 pix
= x_decode_color (f
, arg
, BLACK_PIX_DEFAULT (f
));
1970 x_set_border_pixel (f
, pix
);
1973 /* Set the border-color of frame F to pixel value PIX.
1974 Note that this does not fully take effect if done before
1977 x_set_border_pixel (f
, pix
)
1981 f
->output_data
.w32
->border_pixel
= pix
;
1983 if (FRAME_W32_WINDOW (f
) != 0 && f
->output_data
.w32
->border_width
> 0)
1985 if (FRAME_VISIBLE_P (f
))
1991 x_set_cursor_type (f
, arg
, oldval
)
1993 Lisp_Object arg
, oldval
;
1997 FRAME_DESIRED_CURSOR (f
) = bar_cursor
;
1998 f
->output_data
.w32
->cursor_width
= 2;
2000 else if (CONSP (arg
) && EQ (XCONS (arg
)->car
, Qbar
)
2001 && INTEGERP (XCONS (arg
)->cdr
))
2003 FRAME_DESIRED_CURSOR (f
) = bar_cursor
;
2004 f
->output_data
.w32
->cursor_width
= XINT (XCONS (arg
)->cdr
);
2007 /* Treat anything unknown as "box cursor".
2008 It was bad to signal an error; people have trouble fixing
2009 .Xdefaults with Emacs, when it has something bad in it. */
2010 FRAME_DESIRED_CURSOR (f
) = filled_box_cursor
;
2012 /* Make sure the cursor gets redrawn. This is overkill, but how
2013 often do people change cursor types? */
2014 update_mode_lines
++;
2018 x_set_icon_type (f
, arg
, oldval
)
2020 Lisp_Object arg
, oldval
;
2028 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
2031 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
2036 result
= x_text_icon (f
,
2037 (char *) XSTRING ((!NILP (f
->icon_name
)
2041 result
= x_bitmap_icon (f
, arg
);
2046 error ("No icon window available");
2049 /* If the window was unmapped (and its icon was mapped),
2050 the new icon is not mapped, so map the window in its stead. */
2051 if (FRAME_VISIBLE_P (f
))
2053 #ifdef USE_X_TOOLKIT
2054 XtPopup (f
->output_data
.w32
->widget
, XtGrabNone
);
2056 XMapWindow (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
));
2059 XFlush (FRAME_W32_DISPLAY (f
));
2064 /* Return non-nil if frame F wants a bitmap icon. */
2072 tem
= assq_no_quit (Qicon_type
, f
->param_alist
);
2074 return XCONS (tem
)->cdr
;
2080 x_set_icon_name (f
, arg
, oldval
)
2082 Lisp_Object arg
, oldval
;
2089 if (STRINGP (oldval
) && EQ (Fstring_equal (oldval
, arg
), Qt
))
2092 else if (!STRINGP (oldval
) && EQ (oldval
, Qnil
) == EQ (arg
, Qnil
))
2098 if (f
->output_data
.w32
->icon_bitmap
!= 0)
2103 result
= x_text_icon (f
,
2104 (char *) XSTRING ((!NILP (f
->icon_name
)
2113 error ("No icon window available");
2116 /* If the window was unmapped (and its icon was mapped),
2117 the new icon is not mapped, so map the window in its stead. */
2118 if (FRAME_VISIBLE_P (f
))
2120 #ifdef USE_X_TOOLKIT
2121 XtPopup (f
->output_data
.w32
->widget
, XtGrabNone
);
2123 XMapWindow (FRAME_W32_DISPLAY (f
), FRAME_W32_WINDOW (f
));
2126 XFlush (FRAME_W32_DISPLAY (f
));
2131 extern Lisp_Object
x_new_font ();
2132 extern Lisp_Object
x_new_fontset();
2135 x_set_font (f
, arg
, oldval
)
2137 Lisp_Object arg
, oldval
;
2140 Lisp_Object fontset_name
;
2143 CHECK_STRING (arg
, 1);
2145 fontset_name
= Fquery_fontset (arg
, Qnil
);
2148 result
= (STRINGP (fontset_name
)
2149 ? x_new_fontset (f
, XSTRING (fontset_name
)->data
)
2150 : x_new_font (f
, XSTRING (arg
)->data
));
2153 if (EQ (result
, Qnil
))
2154 error ("Font \"%s\" is not defined", XSTRING (arg
)->data
);
2155 else if (EQ (result
, Qt
))
2156 error ("the characters of the given font have varying widths");
2157 else if (STRINGP (result
))
2159 recompute_basic_faces (f
);
2160 store_frame_param (f
, Qfont
, result
);
2165 XSETFRAME (frame
, f
);
2166 call1 (Qface_set_after_frame_default
, frame
);
2170 x_set_border_width (f
, arg
, oldval
)
2172 Lisp_Object arg
, oldval
;
2174 CHECK_NUMBER (arg
, 0);
2176 if (XINT (arg
) == f
->output_data
.w32
->border_width
)
2179 if (FRAME_W32_WINDOW (f
) != 0)
2180 error ("Cannot change the border width of a window");
2182 f
->output_data
.w32
->border_width
= XINT (arg
);
2186 x_set_internal_border_width (f
, arg
, oldval
)
2188 Lisp_Object arg
, oldval
;
2191 int old
= f
->output_data
.w32
->internal_border_width
;
2193 CHECK_NUMBER (arg
, 0);
2194 f
->output_data
.w32
->internal_border_width
= XINT (arg
);
2195 if (f
->output_data
.w32
->internal_border_width
< 0)
2196 f
->output_data
.w32
->internal_border_width
= 0;
2198 if (f
->output_data
.w32
->internal_border_width
== old
)
2201 if (FRAME_W32_WINDOW (f
) != 0)
2204 x_set_window_size (f
, 0, f
->width
, f
->height
);
2206 SET_FRAME_GARBAGED (f
);
2211 x_set_visibility (f
, value
, oldval
)
2213 Lisp_Object value
, oldval
;
2216 XSETFRAME (frame
, f
);
2219 Fmake_frame_invisible (frame
, Qt
);
2220 else if (EQ (value
, Qicon
))
2221 Ficonify_frame (frame
);
2223 Fmake_frame_visible (frame
);
2227 x_set_menu_bar_lines (f
, value
, oldval
)
2229 Lisp_Object value
, oldval
;
2232 int olines
= FRAME_MENU_BAR_LINES (f
);
2234 /* Right now, menu bars don't work properly in minibuf-only frames;
2235 most of the commands try to apply themselves to the minibuffer
2236 frame itslef, and get an error because you can't switch buffers
2237 in or split the minibuffer window. */
2238 if (FRAME_MINIBUF_ONLY_P (f
))
2241 if (INTEGERP (value
))
2242 nlines
= XINT (value
);
2246 FRAME_MENU_BAR_LINES (f
) = 0;
2248 FRAME_EXTERNAL_MENU_BAR (f
) = 1;
2251 if (FRAME_EXTERNAL_MENU_BAR (f
) == 1)
2252 free_frame_menubar (f
);
2253 FRAME_EXTERNAL_MENU_BAR (f
) = 0;
2255 /* Adjust the frame size so that the client (text) dimensions
2256 remain the same. This depends on FRAME_EXTERNAL_MENU_BAR being
2258 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2262 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
2265 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2266 name; if NAME is a string, set F's name to NAME and set
2267 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2269 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2270 suggesting a new name, which lisp code should override; if
2271 F->explicit_name is set, ignore the new name; otherwise, set it. */
2274 x_set_name (f
, name
, explicit)
2279 /* Make sure that requests from lisp code override requests from
2280 Emacs redisplay code. */
2283 /* If we're switching from explicit to implicit, we had better
2284 update the mode lines and thereby update the title. */
2285 if (f
->explicit_name
&& NILP (name
))
2286 update_mode_lines
= 1;
2288 f
->explicit_name
= ! NILP (name
);
2290 else if (f
->explicit_name
)
2293 /* If NAME is nil, set the name to the w32_id_name. */
2296 /* Check for no change needed in this very common case
2297 before we do any consing. */
2298 if (!strcmp (FRAME_W32_DISPLAY_INFO (f
)->w32_id_name
,
2299 XSTRING (f
->name
)->data
))
2301 name
= build_string (FRAME_W32_DISPLAY_INFO (f
)->w32_id_name
);
2304 CHECK_STRING (name
, 0);
2306 /* Don't change the name if it's already NAME. */
2307 if (! NILP (Fstring_equal (name
, f
->name
)))
2312 /* For setting the frame title, the title parameter should override
2313 the name parameter. */
2314 if (! NILP (f
->title
))
2317 if (FRAME_W32_WINDOW (f
))
2320 SetWindowText(FRAME_W32_WINDOW (f
), XSTRING (name
)->data
);
2325 /* This function should be called when the user's lisp code has
2326 specified a name for the frame; the name will override any set by the
2329 x_explicitly_set_name (f
, arg
, oldval
)
2331 Lisp_Object arg
, oldval
;
2333 x_set_name (f
, arg
, 1);
2336 /* This function should be called by Emacs redisplay code to set the
2337 name; names set this way will never override names set by the user's
2340 x_implicitly_set_name (f
, arg
, oldval
)
2342 Lisp_Object arg
, oldval
;
2344 x_set_name (f
, arg
, 0);
2347 /* Change the title of frame F to NAME.
2348 If NAME is nil, use the frame name as the title.
2350 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2351 name; if NAME is a string, set F's name to NAME and set
2352 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2354 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2355 suggesting a new name, which lisp code should override; if
2356 F->explicit_name is set, ignore the new name; otherwise, set it. */
2359 x_set_title (f
, name
)
2363 /* Don't change the title if it's already NAME. */
2364 if (EQ (name
, f
->title
))
2367 update_mode_lines
= 1;
2374 if (FRAME_W32_WINDOW (f
))
2377 SetWindowText(FRAME_W32_WINDOW (f
), XSTRING (name
)->data
);
2383 x_set_autoraise (f
, arg
, oldval
)
2385 Lisp_Object arg
, oldval
;
2387 f
->auto_raise
= !EQ (Qnil
, arg
);
2391 x_set_autolower (f
, arg
, oldval
)
2393 Lisp_Object arg
, oldval
;
2395 f
->auto_lower
= !EQ (Qnil
, arg
);
2399 x_set_unsplittable (f
, arg
, oldval
)
2401 Lisp_Object arg
, oldval
;
2403 f
->no_split
= !NILP (arg
);
2407 x_set_vertical_scroll_bars (f
, arg
, oldval
)
2409 Lisp_Object arg
, oldval
;
2411 if ((EQ (arg
, Qleft
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f
))
2412 || (EQ (arg
, Qright
) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f
))
2413 || (NILP (arg
) && FRAME_HAS_VERTICAL_SCROLL_BARS (f
))
2414 || (!NILP (arg
) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f
)))
2416 FRAME_VERTICAL_SCROLL_BAR_TYPE (f
) = NILP (arg
) ?
2417 vertical_scroll_bar_none
:
2418 /* Put scroll bars on the right by default, as is conventional
2421 ? vertical_scroll_bar_left
2422 : vertical_scroll_bar_right
;
2424 /* We set this parameter before creating the window for the
2425 frame, so we can get the geometry right from the start.
2426 However, if the window hasn't been created yet, we shouldn't
2427 call x_set_window_size. */
2428 if (FRAME_W32_WINDOW (f
))
2429 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2434 x_set_scroll_bar_width (f
, arg
, oldval
)
2436 Lisp_Object arg
, oldval
;
2440 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = 0;
2441 FRAME_SCROLL_BAR_COLS (f
) = 2;
2443 else if (INTEGERP (arg
) && XINT (arg
) > 0
2444 && XFASTINT (arg
) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f
))
2446 int wid
= FONT_WIDTH (f
->output_data
.w32
->font
);
2447 FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) = XFASTINT (arg
);
2448 FRAME_SCROLL_BAR_COLS (f
) = (XFASTINT (arg
) + wid
-1) / wid
;
2449 if (FRAME_W32_WINDOW (f
))
2450 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
2454 /* Subroutines of creating an frame. */
2456 /* Make sure that Vx_resource_name is set to a reasonable value.
2457 Fix it up, or set it to `emacs' if it is too hopeless. */
2460 validate_x_resource_name ()
2463 /* Number of valid characters in the resource name. */
2465 /* Number of invalid characters in the resource name. */
2470 if (STRINGP (Vx_resource_name
))
2472 unsigned char *p
= XSTRING (Vx_resource_name
)->data
;
2475 len
= XSTRING (Vx_resource_name
)->size
;
2477 /* Only letters, digits, - and _ are valid in resource names.
2478 Count the valid characters and count the invalid ones. */
2479 for (i
= 0; i
< len
; i
++)
2482 if (! ((c
>= 'a' && c
<= 'z')
2483 || (c
>= 'A' && c
<= 'Z')
2484 || (c
>= '0' && c
<= '9')
2485 || c
== '-' || c
== '_'))
2492 /* Not a string => completely invalid. */
2493 bad_count
= 5, good_count
= 0;
2495 /* If name is valid already, return. */
2499 /* If name is entirely invalid, or nearly so, use `emacs'. */
2501 || (good_count
== 1 && bad_count
> 0))
2503 Vx_resource_name
= build_string ("emacs");
2507 /* Name is partly valid. Copy it and replace the invalid characters
2508 with underscores. */
2510 Vx_resource_name
= new = Fcopy_sequence (Vx_resource_name
);
2512 for (i
= 0; i
< len
; i
++)
2514 int c
= XSTRING (new)->data
[i
];
2515 if (! ((c
>= 'a' && c
<= 'z')
2516 || (c
>= 'A' && c
<= 'Z')
2517 || (c
>= '0' && c
<= '9')
2518 || c
== '-' || c
== '_'))
2519 XSTRING (new)->data
[i
] = '_';
2524 extern char *x_get_string_resource ();
2526 DEFUN ("x-get-resource", Fx_get_resource
, Sx_get_resource
, 2, 4, 0,
2527 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
2528 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
2529 class, where INSTANCE is the name under which Emacs was invoked, or\n\
2530 the name specified by the `-name' or `-rn' command-line arguments.\n\
2532 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
2533 class, respectively. You must specify both of them or neither.\n\
2534 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
2535 and the class is `Emacs.CLASS.SUBCLASS'.")
2536 (attribute
, class, component
, subclass
)
2537 Lisp_Object attribute
, class, component
, subclass
;
2539 register char *value
;
2543 CHECK_STRING (attribute
, 0);
2544 CHECK_STRING (class, 0);
2546 if (!NILP (component
))
2547 CHECK_STRING (component
, 1);
2548 if (!NILP (subclass
))
2549 CHECK_STRING (subclass
, 2);
2550 if (NILP (component
) != NILP (subclass
))
2551 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2553 validate_x_resource_name ();
2555 /* Allocate space for the components, the dots which separate them,
2556 and the final '\0'. Make them big enough for the worst case. */
2557 name_key
= (char *) alloca (XSTRING (Vx_resource_name
)->size
2558 + (STRINGP (component
)
2559 ? XSTRING (component
)->size
: 0)
2560 + XSTRING (attribute
)->size
2563 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
2564 + XSTRING (class)->size
2565 + (STRINGP (subclass
)
2566 ? XSTRING (subclass
)->size
: 0)
2569 /* Start with emacs.FRAMENAME for the name (the specific one)
2570 and with `Emacs' for the class key (the general one). */
2571 strcpy (name_key
, XSTRING (Vx_resource_name
)->data
);
2572 strcpy (class_key
, EMACS_CLASS
);
2574 strcat (class_key
, ".");
2575 strcat (class_key
, XSTRING (class)->data
);
2577 if (!NILP (component
))
2579 strcat (class_key
, ".");
2580 strcat (class_key
, XSTRING (subclass
)->data
);
2582 strcat (name_key
, ".");
2583 strcat (name_key
, XSTRING (component
)->data
);
2586 strcat (name_key
, ".");
2587 strcat (name_key
, XSTRING (attribute
)->data
);
2589 value
= x_get_string_resource (Qnil
,
2590 name_key
, class_key
);
2592 if (value
!= (char *) 0)
2593 return build_string (value
);
2598 /* Used when C code wants a resource value. */
2601 x_get_resource_string (attribute
, class)
2602 char *attribute
, *class;
2604 register char *value
;
2608 /* Allocate space for the components, the dots which separate them,
2609 and the final '\0'. */
2610 name_key
= (char *) alloca (XSTRING (Vinvocation_name
)->size
2611 + strlen (attribute
) + 2);
2612 class_key
= (char *) alloca ((sizeof (EMACS_CLASS
) - 1)
2613 + strlen (class) + 2);
2615 sprintf (name_key
, "%s.%s",
2616 XSTRING (Vinvocation_name
)->data
,
2618 sprintf (class_key
, "%s.%s", EMACS_CLASS
, class);
2620 return x_get_string_resource (selected_frame
,
2621 name_key
, class_key
);
2624 /* Types we might convert a resource string into. */
2627 number
, boolean
, string
, symbol
2630 /* Return the value of parameter PARAM.
2632 First search ALIST, then Vdefault_frame_alist, then the X defaults
2633 database, using ATTRIBUTE as the attribute name and CLASS as its class.
2635 Convert the resource to the type specified by desired_type.
2637 If no default is specified, return Qunbound. If you call
2638 x_get_arg, make sure you deal with Qunbound in a reasonable way,
2639 and don't let it get stored in any Lisp-visible variables! */
2642 x_get_arg (alist
, param
, attribute
, class, type
)
2643 Lisp_Object alist
, param
;
2646 enum resource_types type
;
2648 register Lisp_Object tem
;
2650 tem
= Fassq (param
, alist
);
2652 tem
= Fassq (param
, Vdefault_frame_alist
);
2658 tem
= Fx_get_resource (build_string (attribute
),
2659 build_string (class),
2668 return make_number (atoi (XSTRING (tem
)->data
));
2671 tem
= Fdowncase (tem
);
2672 if (!strcmp (XSTRING (tem
)->data
, "on")
2673 || !strcmp (XSTRING (tem
)->data
, "true"))
2682 /* As a special case, we map the values `true' and `on'
2683 to Qt, and `false' and `off' to Qnil. */
2686 lower
= Fdowncase (tem
);
2687 if (!strcmp (XSTRING (lower
)->data
, "on")
2688 || !strcmp (XSTRING (lower
)->data
, "true"))
2690 else if (!strcmp (XSTRING (lower
)->data
, "off")
2691 || !strcmp (XSTRING (lower
)->data
, "false"))
2694 return Fintern (tem
, Qnil
);
2707 /* Record in frame F the specified or default value according to ALIST
2708 of the parameter named PARAM (a Lisp symbol).
2709 If no value is specified for PARAM, look for an X default for XPROP
2710 on the frame named NAME.
2711 If that is not found either, use the value DEFLT. */
2714 x_default_parameter (f
, alist
, prop
, deflt
, xprop
, xclass
, type
)
2721 enum resource_types type
;
2725 tem
= x_get_arg (alist
, prop
, xprop
, xclass
, type
);
2726 if (EQ (tem
, Qunbound
))
2728 x_set_frame_parameters (f
, Fcons (Fcons (prop
, tem
), Qnil
));
2732 DEFUN ("x-parse-geometry", Fx_parse_geometry
, Sx_parse_geometry
, 1, 1, 0,
2733 "Parse an X-style geometry string STRING.\n\
2734 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
2735 The properties returned may include `top', `left', `height', and `width'.\n\
2736 The value of `left' or `top' may be an integer,\n\
2737 or a list (+ N) meaning N pixels relative to top/left corner,\n\
2738 or a list (- N) meaning -N pixels relative to bottom/right corner.")
2743 unsigned int width
, height
;
2746 CHECK_STRING (string
, 0);
2748 geometry
= XParseGeometry ((char *) XSTRING (string
)->data
,
2749 &x
, &y
, &width
, &height
);
2752 if (geometry
& XValue
)
2754 Lisp_Object element
;
2756 if (x
>= 0 && (geometry
& XNegative
))
2757 element
= Fcons (Qleft
, Fcons (Qminus
, Fcons (make_number (-x
), Qnil
)));
2758 else if (x
< 0 && ! (geometry
& XNegative
))
2759 element
= Fcons (Qleft
, Fcons (Qplus
, Fcons (make_number (x
), Qnil
)));
2761 element
= Fcons (Qleft
, make_number (x
));
2762 result
= Fcons (element
, result
);
2765 if (geometry
& YValue
)
2767 Lisp_Object element
;
2769 if (y
>= 0 && (geometry
& YNegative
))
2770 element
= Fcons (Qtop
, Fcons (Qminus
, Fcons (make_number (-y
), Qnil
)));
2771 else if (y
< 0 && ! (geometry
& YNegative
))
2772 element
= Fcons (Qtop
, Fcons (Qplus
, Fcons (make_number (y
), Qnil
)));
2774 element
= Fcons (Qtop
, make_number (y
));
2775 result
= Fcons (element
, result
);
2778 if (geometry
& WidthValue
)
2779 result
= Fcons (Fcons (Qwidth
, make_number (width
)), result
);
2780 if (geometry
& HeightValue
)
2781 result
= Fcons (Fcons (Qheight
, make_number (height
)), result
);
2786 /* Calculate the desired size and position of this window,
2787 and return the flags saying which aspects were specified.
2789 This function does not make the coordinates positive. */
2791 #define DEFAULT_ROWS 40
2792 #define DEFAULT_COLS 80
2795 x_figure_window_size (f
, parms
)
2799 register Lisp_Object tem0
, tem1
, tem2
;
2800 int height
, width
, left
, top
;
2801 register int geometry
;
2802 long window_prompting
= 0;
2804 /* Default values if we fall through.
2805 Actually, if that happens we should get
2806 window manager prompting. */
2807 SET_FRAME_WIDTH (f
, DEFAULT_COLS
);
2808 f
->height
= DEFAULT_ROWS
;
2809 /* Window managers expect that if program-specified
2810 positions are not (0,0), they're intentional, not defaults. */
2811 f
->output_data
.w32
->top_pos
= 0;
2812 f
->output_data
.w32
->left_pos
= 0;
2814 tem0
= x_get_arg (parms
, Qheight
, 0, 0, number
);
2815 tem1
= x_get_arg (parms
, Qwidth
, 0, 0, number
);
2816 tem2
= x_get_arg (parms
, Quser_size
, 0, 0, number
);
2817 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
2819 if (!EQ (tem0
, Qunbound
))
2821 CHECK_NUMBER (tem0
, 0);
2822 f
->height
= XINT (tem0
);
2824 if (!EQ (tem1
, Qunbound
))
2826 CHECK_NUMBER (tem1
, 0);
2827 SET_FRAME_WIDTH (f
, XINT (tem1
));
2829 if (!NILP (tem2
) && !EQ (tem2
, Qunbound
))
2830 window_prompting
|= USSize
;
2832 window_prompting
|= PSize
;
2835 f
->output_data
.w32
->vertical_scroll_bar_extra
2836 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f
)
2838 : FRAME_SCROLL_BAR_PIXEL_WIDTH (f
) > 0
2839 ? FRAME_SCROLL_BAR_PIXEL_WIDTH (f
)
2840 : (FRAME_SCROLL_BAR_COLS (f
) * FONT_WIDTH (f
->output_data
.w32
->font
)));
2841 f
->output_data
.w32
->pixel_width
= CHAR_TO_PIXEL_WIDTH (f
, f
->width
);
2842 f
->output_data
.w32
->pixel_height
= CHAR_TO_PIXEL_HEIGHT (f
, f
->height
);
2844 tem0
= x_get_arg (parms
, Qtop
, 0, 0, number
);
2845 tem1
= x_get_arg (parms
, Qleft
, 0, 0, number
);
2846 tem2
= x_get_arg (parms
, Quser_position
, 0, 0, number
);
2847 if (! EQ (tem0
, Qunbound
) || ! EQ (tem1
, Qunbound
))
2849 if (EQ (tem0
, Qminus
))
2851 f
->output_data
.w32
->top_pos
= 0;
2852 window_prompting
|= YNegative
;
2854 else if (CONSP (tem0
) && EQ (XCONS (tem0
)->car
, Qminus
)
2855 && CONSP (XCONS (tem0
)->cdr
)
2856 && INTEGERP (XCONS (XCONS (tem0
)->cdr
)->car
))
2858 f
->output_data
.w32
->top_pos
= - XINT (XCONS (XCONS (tem0
)->cdr
)->car
);
2859 window_prompting
|= YNegative
;
2861 else if (CONSP (tem0
) && EQ (XCONS (tem0
)->car
, Qplus
)
2862 && CONSP (XCONS (tem0
)->cdr
)
2863 && INTEGERP (XCONS (XCONS (tem0
)->cdr
)->car
))
2865 f
->output_data
.w32
->top_pos
= XINT (XCONS (XCONS (tem0
)->cdr
)->car
);
2867 else if (EQ (tem0
, Qunbound
))
2868 f
->output_data
.w32
->top_pos
= 0;
2871 CHECK_NUMBER (tem0
, 0);
2872 f
->output_data
.w32
->top_pos
= XINT (tem0
);
2873 if (f
->output_data
.w32
->top_pos
< 0)
2874 window_prompting
|= YNegative
;
2877 if (EQ (tem1
, Qminus
))
2879 f
->output_data
.w32
->left_pos
= 0;
2880 window_prompting
|= XNegative
;
2882 else if (CONSP (tem1
) && EQ (XCONS (tem1
)->car
, Qminus
)
2883 && CONSP (XCONS (tem1
)->cdr
)
2884 && INTEGERP (XCONS (XCONS (tem1
)->cdr
)->car
))
2886 f
->output_data
.w32
->left_pos
= - XINT (XCONS (XCONS (tem1
)->cdr
)->car
);
2887 window_prompting
|= XNegative
;
2889 else if (CONSP (tem1
) && EQ (XCONS (tem1
)->car
, Qplus
)
2890 && CONSP (XCONS (tem1
)->cdr
)
2891 && INTEGERP (XCONS (XCONS (tem1
)->cdr
)->car
))
2893 f
->output_data
.w32
->left_pos
= XINT (XCONS (XCONS (tem1
)->cdr
)->car
);
2895 else if (EQ (tem1
, Qunbound
))
2896 f
->output_data
.w32
->left_pos
= 0;
2899 CHECK_NUMBER (tem1
, 0);
2900 f
->output_data
.w32
->left_pos
= XINT (tem1
);
2901 if (f
->output_data
.w32
->left_pos
< 0)
2902 window_prompting
|= XNegative
;
2905 if (!NILP (tem2
) && ! EQ (tem2
, Qunbound
))
2906 window_prompting
|= USPosition
;
2908 window_prompting
|= PPosition
;
2911 return window_prompting
;
2916 extern LRESULT CALLBACK
w32_wnd_proc ();
2919 w32_init_class (hinst
)
2924 wc
.style
= CS_HREDRAW
| CS_VREDRAW
;
2925 wc
.lpfnWndProc
= (WNDPROC
) w32_wnd_proc
;
2927 wc
.cbWndExtra
= WND_EXTRA_BYTES
;
2928 wc
.hInstance
= hinst
;
2929 wc
.hIcon
= LoadIcon (hinst
, EMACS_CLASS
);
2930 wc
.hCursor
= LoadCursor (NULL
, IDC_ARROW
);
2931 wc
.hbrBackground
= NULL
; /* GetStockObject (WHITE_BRUSH); */
2932 wc
.lpszMenuName
= NULL
;
2933 wc
.lpszClassName
= EMACS_CLASS
;
2935 return (RegisterClass (&wc
));
2939 w32_createscrollbar (f
, bar
)
2941 struct scroll_bar
* bar
;
2943 return (CreateWindow ("SCROLLBAR", "", SBS_VERT
| WS_CHILD
| WS_VISIBLE
,
2944 /* Position and size of scroll bar. */
2945 XINT(bar
->left
), XINT(bar
->top
),
2946 XINT(bar
->width
), XINT(bar
->height
),
2947 FRAME_W32_WINDOW (f
),
2954 w32_createwindow (f
)
2960 rect
.left
= rect
.top
= 0;
2961 rect
.right
= PIXEL_WIDTH (f
);
2962 rect
.bottom
= PIXEL_HEIGHT (f
);
2964 AdjustWindowRect (&rect
, f
->output_data
.w32
->dwStyle
,
2965 FRAME_EXTERNAL_MENU_BAR (f
));
2967 /* Do first time app init */
2971 w32_init_class (hinst
);
2974 FRAME_W32_WINDOW (f
) = hwnd
2975 = CreateWindow (EMACS_CLASS
,
2977 f
->output_data
.w32
->dwStyle
| WS_CLIPCHILDREN
,
2978 f
->output_data
.w32
->left_pos
,
2979 f
->output_data
.w32
->top_pos
,
2980 rect
.right
- rect
.left
,
2981 rect
.bottom
- rect
.top
,
2989 SetWindowLong (hwnd
, WND_FONTWIDTH_INDEX
, FONT_WIDTH (f
->output_data
.w32
->font
));
2990 SetWindowLong (hwnd
, WND_LINEHEIGHT_INDEX
, f
->output_data
.w32
->line_height
);
2991 SetWindowLong (hwnd
, WND_BORDER_INDEX
, f
->output_data
.w32
->internal_border_width
);
2992 SetWindowLong (hwnd
, WND_SCROLLBAR_INDEX
, f
->output_data
.w32
->vertical_scroll_bar_extra
);
2993 SetWindowLong (hwnd
, WND_BACKGROUND_INDEX
, f
->output_data
.w32
->background_pixel
);
2995 /* Enable drag-n-drop. */
2996 DragAcceptFiles (hwnd
, TRUE
);
2998 /* Do this to discard the default setting specified by our parent. */
2999 ShowWindow (hwnd
, SW_HIDE
);
3004 my_post_msg (wmsg
, hwnd
, msg
, wParam
, lParam
)
3011 wmsg
->msg
.hwnd
= hwnd
;
3012 wmsg
->msg
.message
= msg
;
3013 wmsg
->msg
.wParam
= wParam
;
3014 wmsg
->msg
.lParam
= lParam
;
3015 wmsg
->msg
.time
= GetMessageTime ();
3020 /* GetKeyState and MapVirtualKey on Windows 95 do not actually distinguish
3021 between left and right keys as advertised. We test for this
3022 support dynamically, and set a flag when the support is absent. If
3023 absent, we keep track of the left and right control and alt keys
3024 ourselves. This is particularly necessary on keyboards that rely
3025 upon the AltGr key, which is represented as having the left control
3026 and right alt keys pressed. For these keyboards, we need to know
3027 when the left alt key has been pressed in addition to the AltGr key
3028 so that we can properly support M-AltGr-key sequences (such as M-@
3029 on Swedish keyboards). */
3031 #define EMACS_LCONTROL 0
3032 #define EMACS_RCONTROL 1
3033 #define EMACS_LMENU 2
3034 #define EMACS_RMENU 3
3036 static int modifiers
[4];
3037 static int modifiers_recorded
;
3038 static int modifier_key_support_tested
;
3041 test_modifier_support (unsigned int wparam
)
3045 if (wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
)
3047 if (wparam
== VK_CONTROL
)
3057 if (!(GetKeyState (l
) & 0x8000) && !(GetKeyState (r
) & 0x8000))
3058 modifiers_recorded
= 1;
3060 modifiers_recorded
= 0;
3061 modifier_key_support_tested
= 1;
3065 record_keydown (unsigned int wparam
, unsigned int lparam
)
3069 if (!modifier_key_support_tested
)
3070 test_modifier_support (wparam
);
3072 if ((wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
) || !modifiers_recorded
)
3075 if (wparam
== VK_CONTROL
)
3076 i
= (lparam
& 0x1000000) ? EMACS_RCONTROL
: EMACS_LCONTROL
;
3078 i
= (lparam
& 0x1000000) ? EMACS_RMENU
: EMACS_LMENU
;
3084 record_keyup (unsigned int wparam
, unsigned int lparam
)
3088 if ((wparam
!= VK_CONTROL
&& wparam
!= VK_MENU
) || !modifiers_recorded
)
3091 if (wparam
== VK_CONTROL
)
3092 i
= (lparam
& 0x1000000) ? EMACS_RCONTROL
: EMACS_LCONTROL
;
3094 i
= (lparam
& 0x1000000) ? EMACS_RMENU
: EMACS_LMENU
;
3099 /* Emacs can lose focus while a modifier key has been pressed. When
3100 it regains focus, be conservative and clear all modifiers since
3101 we cannot reconstruct the left and right modifier state. */
3107 if (GetFocus () == NULL
)
3108 /* Emacs doesn't have keyboard focus. Do nothing. */
3111 ctrl
= GetAsyncKeyState (VK_CONTROL
);
3112 alt
= GetAsyncKeyState (VK_MENU
);
3114 if (!(ctrl
& 0x08000))
3115 /* Clear any recorded control modifier state. */
3116 modifiers
[EMACS_RCONTROL
] = modifiers
[EMACS_LCONTROL
] = 0;
3118 if (!(alt
& 0x08000))
3119 /* Clear any recorded alt modifier state. */
3120 modifiers
[EMACS_RMENU
] = modifiers
[EMACS_LMENU
] = 0;
3122 /* Update the state of all modifier keys, because modifiers used in
3123 hot-key combinations can get stuck on if Emacs loses focus as a
3124 result of a hot-key being pressed. */
3128 #define CURRENT_STATE(key) ((GetAsyncKeyState (key) & 0x8000) >> 8)
3130 GetKeyboardState (keystate
);
3131 keystate
[VK_SHIFT
] = CURRENT_STATE (VK_SHIFT
);
3132 keystate
[VK_CONTROL
] = CURRENT_STATE (VK_CONTROL
);
3133 keystate
[VK_LCONTROL
] = CURRENT_STATE (VK_LCONTROL
);
3134 keystate
[VK_RCONTROL
] = CURRENT_STATE (VK_RCONTROL
);
3135 keystate
[VK_MENU
] = CURRENT_STATE (VK_MENU
);
3136 keystate
[VK_LMENU
] = CURRENT_STATE (VK_LMENU
);
3137 keystate
[VK_RMENU
] = CURRENT_STATE (VK_RMENU
);
3138 keystate
[VK_LWIN
] = CURRENT_STATE (VK_LWIN
);
3139 keystate
[VK_RWIN
] = CURRENT_STATE (VK_RWIN
);
3140 keystate
[VK_APPS
] = CURRENT_STATE (VK_APPS
);
3141 SetKeyboardState (keystate
);
3145 /* Synchronize modifier state with what is reported with the current
3146 keystroke. Even if we cannot distinguish between left and right
3147 modifier keys, we know that, if no modifiers are set, then neither
3148 the left or right modifier should be set. */
3152 if (!modifiers_recorded
)
3155 if (!(GetKeyState (VK_CONTROL
) & 0x8000))
3156 modifiers
[EMACS_RCONTROL
] = modifiers
[EMACS_LCONTROL
] = 0;
3158 if (!(GetKeyState (VK_MENU
) & 0x8000))
3159 modifiers
[EMACS_RMENU
] = modifiers
[EMACS_LMENU
] = 0;
3163 modifier_set (int vkey
)
3165 if (vkey
== VK_CAPITAL
|| vkey
== VK_SCROLL
)
3166 return (GetKeyState (vkey
) & 0x1);
3167 if (!modifiers_recorded
)
3168 return (GetKeyState (vkey
) & 0x8000);
3173 return modifiers
[EMACS_LCONTROL
];
3175 return modifiers
[EMACS_RCONTROL
];
3177 return modifiers
[EMACS_LMENU
];
3179 return modifiers
[EMACS_RMENU
];
3181 return (GetKeyState (vkey
) & 0x8000);
3184 /* Convert between the modifier bits W32 uses and the modifier bits
3188 w32_key_to_modifier (int key
)
3190 Lisp_Object key_mapping
;
3195 key_mapping
= Vw32_lwindow_modifier
;
3198 key_mapping
= Vw32_rwindow_modifier
;
3201 key_mapping
= Vw32_apps_modifier
;
3204 key_mapping
= Vw32_scroll_lock_modifier
;
3210 /* NB. This code runs in the input thread, asychronously to the lisp
3211 thread, so we must be careful to ensure access to lisp data is
3212 thread-safe. The following code is safe because the modifier
3213 variable values are updated atomically from lisp and symbols are
3214 not relocated by GC. Also, we don't have to worry about seeing GC
3216 if (EQ (key_mapping
, Qhyper
))
3217 return hyper_modifier
;
3218 if (EQ (key_mapping
, Qsuper
))
3219 return super_modifier
;
3220 if (EQ (key_mapping
, Qmeta
))
3221 return meta_modifier
;
3222 if (EQ (key_mapping
, Qalt
))
3223 return alt_modifier
;
3224 if (EQ (key_mapping
, Qctrl
))
3225 return ctrl_modifier
;
3226 if (EQ (key_mapping
, Qcontrol
)) /* synonym for ctrl */
3227 return ctrl_modifier
;
3228 if (EQ (key_mapping
, Qshift
))
3229 return shift_modifier
;
3231 /* Don't generate any modifier if not explicitly requested. */
3236 w32_get_modifiers ()
3238 return ((modifier_set (VK_SHIFT
) ? shift_modifier
: 0) |
3239 (modifier_set (VK_CONTROL
) ? ctrl_modifier
: 0) |
3240 (modifier_set (VK_LWIN
) ? w32_key_to_modifier (VK_LWIN
) : 0) |
3241 (modifier_set (VK_RWIN
) ? w32_key_to_modifier (VK_RWIN
) : 0) |
3242 (modifier_set (VK_APPS
) ? w32_key_to_modifier (VK_APPS
) : 0) |
3243 (modifier_set (VK_SCROLL
) ? w32_key_to_modifier (VK_SCROLL
) : 0) |
3244 (modifier_set (VK_MENU
) ?
3245 ((NILP (Vw32_alt_is_meta
)) ? alt_modifier
: meta_modifier
) : 0));
3248 /* We map the VK_* modifiers into console modifier constants
3249 so that we can use the same routines to handle both console
3250 and window input. */
3253 construct_console_modifiers ()
3258 mods
|= (modifier_set (VK_SHIFT
)) ? SHIFT_PRESSED
: 0;
3259 mods
|= (modifier_set (VK_CAPITAL
)) ? CAPSLOCK_ON
: 0;
3260 mods
|= (modifier_set (VK_SCROLL
)) ? SCROLLLOCK_ON
: 0;
3261 mods
|= (modifier_set (VK_NUMLOCK
)) ? NUMLOCK_ON
: 0;
3262 mods
|= (modifier_set (VK_LCONTROL
)) ? LEFT_CTRL_PRESSED
: 0;
3263 mods
|= (modifier_set (VK_RCONTROL
)) ? RIGHT_CTRL_PRESSED
: 0;
3264 mods
|= (modifier_set (VK_LMENU
)) ? LEFT_ALT_PRESSED
: 0;
3265 mods
|= (modifier_set (VK_RMENU
)) ? RIGHT_ALT_PRESSED
: 0;
3266 mods
|= (modifier_set (VK_LWIN
)) ? LEFT_WIN_PRESSED
: 0;
3267 mods
|= (modifier_set (VK_RWIN
)) ? RIGHT_WIN_PRESSED
: 0;
3268 mods
|= (modifier_set (VK_APPS
)) ? APPS_PRESSED
: 0;
3274 w32_get_key_modifiers (unsigned int wparam
, unsigned int lparam
)
3278 /* Convert to emacs modifiers. */
3279 mods
= w32_kbd_mods_to_emacs (construct_console_modifiers (), wparam
);
3285 map_keypad_keys (unsigned int virt_key
, unsigned int extended
)
3287 if (virt_key
< VK_CLEAR
|| virt_key
> VK_DELETE
)
3290 if (virt_key
== VK_RETURN
)
3291 return (extended
? VK_NUMPAD_ENTER
: VK_RETURN
);
3293 if (virt_key
>= VK_PRIOR
&& virt_key
<= VK_DOWN
)
3294 return (!extended
? (VK_NUMPAD_PRIOR
+ (virt_key
- VK_PRIOR
)) : virt_key
);
3296 if (virt_key
== VK_INSERT
|| virt_key
== VK_DELETE
)
3297 return (!extended
? (VK_NUMPAD_INSERT
+ (virt_key
- VK_INSERT
)) : virt_key
);
3299 if (virt_key
== VK_CLEAR
)
3300 return (!extended
? VK_NUMPAD_CLEAR
: virt_key
);
3305 /* List of special key combinations which w32 would normally capture,
3306 but emacs should grab instead. Not directly visible to lisp, to
3307 simplify synchronization. Each item is an integer encoding a virtual
3308 key code and modifier combination to capture. */
3309 Lisp_Object w32_grabbed_keys
;
3311 #define HOTKEY(vk,mods) make_number (((vk) & 255) | ((mods) << 8))
3312 #define HOTKEY_ID(k) (XFASTINT (k) & 0xbfff)
3313 #define HOTKEY_VK_CODE(k) (XFASTINT (k) & 255)
3314 #define HOTKEY_MODIFIERS(k) (XFASTINT (k) >> 8)
3316 /* Register hot-keys for reserved key combinations when Emacs has
3317 keyboard focus, since this is the only way Emacs can receive key
3318 combinations like Alt-Tab which are used by the system. */
3321 register_hot_keys (hwnd
)
3324 Lisp_Object keylist
;
3326 /* Use GC_CONSP, since we are called asynchronously. */
3327 for (keylist
= w32_grabbed_keys
; GC_CONSP (keylist
); keylist
= XCDR (keylist
))
3329 Lisp_Object key
= XCAR (keylist
);
3331 /* Deleted entries get set to nil. */
3332 if (!INTEGERP (key
))
3335 RegisterHotKey (hwnd
, HOTKEY_ID (key
),
3336 HOTKEY_MODIFIERS (key
), HOTKEY_VK_CODE (key
));
3341 unregister_hot_keys (hwnd
)
3344 Lisp_Object keylist
;
3346 /* Use GC_CONSP, since we are called asynchronously. */
3347 for (keylist
= w32_grabbed_keys
; GC_CONSP (keylist
); keylist
= XCDR (keylist
))
3349 Lisp_Object key
= XCAR (keylist
);
3351 if (!INTEGERP (key
))
3354 UnregisterHotKey (hwnd
, HOTKEY_ID (key
));
3359 post_character_message (hwnd
, msg
, wParam
, lParam
, modifiers
)
3369 wmsg
.dwModifiers
= modifiers
;
3371 /* Detect quit_char and set quit-flag directly. Note that we
3372 still need to post a message to ensure the main thread will be
3373 woken up if blocked in sys_select(), but we do NOT want to post
3374 the quit_char message itself (because it will usually be as if
3375 the user had typed quit_char twice). Instead, we post a dummy
3376 message that has no particular effect. */
3379 if (isalpha (c
) && wmsg
.dwModifiers
== ctrl_modifier
)
3380 c
= make_ctrl_char (c
) & 0377;
3385 /* The choice of message is somewhat arbitrary, as long as
3386 the main thread handler just ignores it. */
3389 /* Interrupt any blocking system calls. */
3394 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3397 /* Main message dispatch loop. */
3400 w32_msg_pump (deferred_msg
* msg_buf
)
3406 msh_mousewheel
= RegisterWindowMessage (MSH_MOUSEWHEEL
);
3408 while (GetMessage (&msg
, NULL
, 0, 0))
3410 if (msg
.hwnd
== NULL
)
3412 switch (msg
.message
)
3414 case WM_EMACS_CREATEWINDOW
:
3415 w32_createwindow ((struct frame
*) msg
.wParam
);
3416 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
, 0, 0))
3419 case WM_EMACS_SETLOCALE
:
3420 SetThreadLocale (msg
.wParam
);
3421 /* Reply is not expected. */
3423 case WM_EMACS_SETKEYBOARDLAYOUT
:
3424 result
= (int) ActivateKeyboardLayout ((HKL
) msg
.wParam
, 0);
3425 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
,
3429 case WM_EMACS_REGISTER_HOT_KEY
:
3430 focus_window
= GetFocus ();
3431 if (focus_window
!= NULL
)
3432 RegisterHotKey (focus_window
,
3433 HOTKEY_ID (msg
.wParam
),
3434 HOTKEY_MODIFIERS (msg
.wParam
),
3435 HOTKEY_VK_CODE (msg
.wParam
));
3436 /* Reply is not expected. */
3438 case WM_EMACS_UNREGISTER_HOT_KEY
:
3439 focus_window
= GetFocus ();
3440 if (focus_window
!= NULL
)
3441 UnregisterHotKey (focus_window
, HOTKEY_ID (msg
.wParam
));
3442 /* Mark item as erased. NB: this code must be
3443 thread-safe. The next line is okay because the cons
3444 cell is never made into garbage and is not relocated by
3446 XCAR ((Lisp_Object
) msg
.lParam
) = Qnil
;
3447 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
, 0, 0))
3450 case WM_EMACS_TOGGLE_LOCK_KEY
:
3452 int vk_code
= (int) msg
.wParam
;
3453 int cur_state
= (GetKeyState (vk_code
) & 1);
3454 Lisp_Object new_state
= (Lisp_Object
) msg
.lParam
;
3456 /* NB: This code must be thread-safe. It is safe to
3457 call NILP because symbols are not relocated by GC,
3458 and pointer here is not touched by GC (so the markbit
3459 can't be set). Numbers are safe because they are
3460 immediate values. */
3461 if (NILP (new_state
)
3462 || (NUMBERP (new_state
)
3463 && (XUINT (new_state
)) & 1 != cur_state
))
3465 one_w32_display_info
.faked_key
= vk_code
;
3467 keybd_event ((BYTE
) vk_code
,
3468 (BYTE
) MapVirtualKey (vk_code
, 0),
3469 KEYEVENTF_EXTENDEDKEY
| KEYEVENTF_KEYUP
, 0);
3470 keybd_event ((BYTE
) vk_code
,
3471 (BYTE
) MapVirtualKey (vk_code
, 0),
3472 KEYEVENTF_EXTENDEDKEY
| 0, 0);
3473 keybd_event ((BYTE
) vk_code
,
3474 (BYTE
) MapVirtualKey (vk_code
, 0),
3475 KEYEVENTF_EXTENDEDKEY
| KEYEVENTF_KEYUP
, 0);
3476 cur_state
= !cur_state
;
3478 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
,
3484 DebPrint (("msg %x not expected by w32_msg_pump\n", msg
.message
));
3489 DispatchMessage (&msg
);
3492 /* Exit nested loop when our deferred message has completed. */
3493 if (msg_buf
->completed
)
3498 deferred_msg
* deferred_msg_head
;
3500 static deferred_msg
*
3501 find_deferred_msg (HWND hwnd
, UINT msg
)
3503 deferred_msg
* item
;
3505 /* Don't actually need synchronization for read access, since
3506 modification of single pointer is always atomic. */
3507 /* enter_crit (); */
3509 for (item
= deferred_msg_head
; item
!= NULL
; item
= item
->next
)
3510 if (item
->w32msg
.msg
.hwnd
== hwnd
3511 && item
->w32msg
.msg
.message
== msg
)
3514 /* leave_crit (); */
3520 send_deferred_msg (deferred_msg
* msg_buf
,
3526 /* Only input thread can send deferred messages. */
3527 if (GetCurrentThreadId () != dwWindowsThreadId
)
3530 /* It is an error to send a message that is already deferred. */
3531 if (find_deferred_msg (hwnd
, msg
) != NULL
)
3534 /* Enforced synchronization is not needed because this is the only
3535 function that alters deferred_msg_head, and the following critical
3536 section is guaranteed to only be serially reentered (since only the
3537 input thread can call us). */
3539 /* enter_crit (); */
3541 msg_buf
->completed
= 0;
3542 msg_buf
->next
= deferred_msg_head
;
3543 deferred_msg_head
= msg_buf
;
3544 my_post_msg (&msg_buf
->w32msg
, hwnd
, msg
, wParam
, lParam
);
3546 /* leave_crit (); */
3548 /* Start a new nested message loop to process other messages until
3549 this one is completed. */
3550 w32_msg_pump (msg_buf
);
3552 deferred_msg_head
= msg_buf
->next
;
3554 return msg_buf
->result
;
3558 complete_deferred_msg (HWND hwnd
, UINT msg
, LRESULT result
)
3560 deferred_msg
* msg_buf
= find_deferred_msg (hwnd
, msg
);
3562 if (msg_buf
== NULL
)
3565 msg_buf
->result
= result
;
3566 msg_buf
->completed
= 1;
3568 /* Ensure input thread is woken so it notices the completion. */
3569 PostThreadMessage (dwWindowsThreadId
, WM_NULL
, 0, 0);
3578 deferred_msg dummy_buf
;
3580 /* Ensure our message queue is created */
3582 PeekMessage (&msg
, NULL
, 0, 0, PM_NOREMOVE
);
3584 if (!PostThreadMessage (dwMainThreadId
, WM_EMACS_DONE
, 0, 0))
3587 memset (&dummy_buf
, 0, sizeof (dummy_buf
));
3588 dummy_buf
.w32msg
.msg
.hwnd
= NULL
;
3589 dummy_buf
.w32msg
.msg
.message
= WM_NULL
;
3591 /* This is the inital message loop which should only exit when the
3592 application quits. */
3593 w32_msg_pump (&dummy_buf
);
3598 /* Main window procedure */
3601 w32_wnd_proc (hwnd
, msg
, wParam
, lParam
)
3608 struct w32_display_info
*dpyinfo
= &one_w32_display_info
;
3610 int windows_translate
;
3612 /* Note that it is okay to call x_window_to_frame, even though we are
3613 not running in the main lisp thread, because frame deletion
3614 requires the lisp thread to synchronize with this thread. Thus, if
3615 a frame struct is returned, it can be used without concern that the
3616 lisp thread might make it disappear while we are using it.
3618 NB. Walking the frame list in this thread is safe (as long as
3619 writes of Lisp_Object slots are atomic, which they are on Windows).
3620 Although delete-frame can destructively modify the frame list while
3621 we are walking it, a garbage collection cannot occur until after
3622 delete-frame has synchronized with this thread.
3624 It is also safe to use functions that make GDI calls, such as
3625 w32_clear_rect, because these functions must obtain a DC handle
3626 from the frame struct using get_frame_dc which is thread-aware. */
3631 f
= x_window_to_frame (dpyinfo
, hwnd
);
3634 GetUpdateRect (hwnd
, &wmsg
.rect
, FALSE
);
3635 w32_clear_rect (f
, NULL
, &wmsg
.rect
);
3638 case WM_PALETTECHANGED
:
3639 /* ignore our own changes */
3640 if ((HWND
)wParam
!= hwnd
)
3642 f
= x_window_to_frame (dpyinfo
, hwnd
);
3644 /* get_frame_dc will realize our palette and force all
3645 frames to be redrawn if needed. */
3646 release_frame_dc (f
, get_frame_dc (f
));
3651 PAINTSTRUCT paintStruct
;
3654 BeginPaint (hwnd
, &paintStruct
);
3655 wmsg
.rect
= paintStruct
.rcPaint
;
3656 EndPaint (hwnd
, &paintStruct
);
3659 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3664 case WM_INPUTLANGCHANGE
:
3665 /* Inform lisp thread of keyboard layout changes. */
3666 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3668 /* Clear dead keys in the keyboard state; for simplicity only
3669 preserve modifier key states. */
3674 GetKeyboardState (keystate
);
3675 for (i
= 0; i
< 256; i
++)
3692 SetKeyboardState (keystate
);
3697 /* Synchronize hot keys with normal input. */
3698 PostMessage (hwnd
, WM_KEYDOWN
, HIWORD (lParam
), 0);
3703 record_keyup (wParam
, lParam
);
3708 /* Ignore keystrokes we fake ourself; see below. */
3709 if (dpyinfo
->faked_key
== wParam
)
3711 dpyinfo
->faked_key
= 0;
3712 /* Make sure TranslateMessage sees them though. */
3713 windows_translate
= 1;
3717 /* Synchronize modifiers with current keystroke. */
3719 record_keydown (wParam
, lParam
);
3720 wParam
= map_keypad_keys (wParam
, (lParam
& 0x1000000L
) != 0);
3722 windows_translate
= 0;
3727 if (NILP (Vw32_pass_lwindow_to_system
))
3729 /* Prevent system from acting on keyup (which opens the
3730 Start menu if no other key was pressed) by simulating a
3731 press of Space which we will ignore. */
3732 if (GetAsyncKeyState (wParam
) & 1)
3734 if (NUMBERP (Vw32_phantom_key_code
))
3735 wParam
= XUINT (Vw32_phantom_key_code
) & 255;
3738 dpyinfo
->faked_key
= wParam
;
3739 keybd_event (wParam
, (BYTE
) MapVirtualKey (wParam
, 0), 0, 0);
3742 if (!NILP (Vw32_lwindow_modifier
))
3744 windows_translate
= 1;
3747 if (NILP (Vw32_pass_rwindow_to_system
))
3749 if (GetAsyncKeyState (wParam
) & 1)
3751 if (NUMBERP (Vw32_phantom_key_code
))
3752 wParam
= XUINT (Vw32_phantom_key_code
) & 255;
3755 dpyinfo
->faked_key
= wParam
;
3756 keybd_event (wParam
, (BYTE
) MapVirtualKey (wParam
, 0), 0, 0);
3759 if (!NILP (Vw32_rwindow_modifier
))
3761 windows_translate
= 1;
3764 if (!NILP (Vw32_apps_modifier
))
3766 windows_translate
= 1;
3769 if (NILP (Vw32_pass_alt_to_system
))
3770 /* Prevent DefWindowProc from activating the menu bar if an
3771 Alt key is pressed and released by itself. */
3773 windows_translate
= 1;
3776 /* Decide whether to treat as modifier or function key. */
3777 if (NILP (Vw32_enable_caps_lock
))
3778 goto disable_lock_key
;
3779 windows_translate
= 1;
3782 /* Decide whether to treat as modifier or function key. */
3783 if (NILP (Vw32_enable_num_lock
))
3784 goto disable_lock_key
;
3785 windows_translate
= 1;
3788 /* Decide whether to treat as modifier or function key. */
3789 if (NILP (Vw32_scroll_lock_modifier
))
3790 goto disable_lock_key
;
3791 windows_translate
= 1;
3794 /* Ensure the appropriate lock key state (and indicator light)
3795 remains in the same state. We do this by faking another
3796 press of the relevant key. Apparently, this really is the
3797 only way to toggle the state of the indicator lights. */
3798 dpyinfo
->faked_key
= wParam
;
3799 keybd_event ((BYTE
) wParam
, (BYTE
) MapVirtualKey (wParam
, 0),
3800 KEYEVENTF_EXTENDEDKEY
| KEYEVENTF_KEYUP
, 0);
3801 keybd_event ((BYTE
) wParam
, (BYTE
) MapVirtualKey (wParam
, 0),
3802 KEYEVENTF_EXTENDEDKEY
| 0, 0);
3803 keybd_event ((BYTE
) wParam
, (BYTE
) MapVirtualKey (wParam
, 0),
3804 KEYEVENTF_EXTENDEDKEY
| KEYEVENTF_KEYUP
, 0);
3805 /* Ensure indicator lights are updated promptly on Windows 9x
3806 (TranslateMessage apparently does this), after forwarding
3808 post_character_message (hwnd
, msg
, wParam
, lParam
,
3809 w32_get_key_modifiers (wParam
, lParam
));
3810 windows_translate
= 1;
3814 case VK_PROCESSKEY
: /* Generated by IME. */
3815 windows_translate
= 1;
3818 /* Windows maps Ctrl-Pause (aka Ctrl-Break) into VK_CANCEL,
3819 which is confusing for purposes of key binding; convert
3820 VK_CANCEL events into VK_PAUSE events. */
3824 /* Windows maps Ctrl-NumLock into VK_PAUSE, which is confusing
3825 for purposes of key binding; convert these back into
3826 VK_NUMLOCK events, at least when we want to see NumLock key
3827 presses. (Note that there is never any possibility that
3828 VK_PAUSE with Ctrl really is C-Pause as per above.) */
3829 if (NILP (Vw32_enable_num_lock
) && modifier_set (VK_CONTROL
))
3830 wParam
= VK_NUMLOCK
;
3833 /* If not defined as a function key, change it to a WM_CHAR message. */
3834 if (lispy_function_keys
[wParam
] == 0)
3836 DWORD modifiers
= construct_console_modifiers ();
3838 if (!NILP (Vw32_recognize_altgr
)
3839 && modifier_set (VK_LCONTROL
) && modifier_set (VK_RMENU
))
3841 /* Always let TranslateMessage handle AltGr key chords;
3842 for some reason, ToAscii doesn't always process AltGr
3843 chords correctly. */
3844 windows_translate
= 1;
3846 else if ((modifiers
& (~SHIFT_PRESSED
& ~CAPSLOCK_ON
)) != 0)
3848 /* Handle key chords including any modifiers other
3849 than shift directly, in order to preserve as much
3850 modifier information as possible. */
3851 if ('A' <= wParam
&& wParam
<= 'Z')
3853 /* Don't translate modified alphabetic keystrokes,
3854 so the user doesn't need to constantly switch
3855 layout to type control or meta keystrokes when
3856 the normal layout translates alphabetic
3857 characters to non-ascii characters. */
3858 if (!modifier_set (VK_SHIFT
))
3859 wParam
+= ('a' - 'A');
3864 /* Try to handle other keystrokes by determining the
3865 base character (ie. translating the base key plus
3869 KEY_EVENT_RECORD key
;
3871 key
.bKeyDown
= TRUE
;
3872 key
.wRepeatCount
= 1;
3873 key
.wVirtualKeyCode
= wParam
;
3874 key
.wVirtualScanCode
= (lParam
& 0xFF0000) >> 16;
3875 key
.uChar
.AsciiChar
= 0;
3876 key
.dwControlKeyState
= modifiers
;
3878 add
= w32_kbd_patch_key (&key
);
3879 /* 0 means an unrecognised keycode, negative means
3880 dead key. Ignore both. */
3883 /* Forward asciified character sequence. */
3884 post_character_message
3885 (hwnd
, WM_CHAR
, key
.uChar
.AsciiChar
, lParam
,
3886 w32_get_key_modifiers (wParam
, lParam
));
3887 w32_kbd_patch_key (&key
);
3894 /* Let TranslateMessage handle everything else. */
3895 windows_translate
= 1;
3901 if (windows_translate
)
3903 MSG windows_msg
= { hwnd
, msg
, wParam
, lParam
, 0, {0,0} };
3905 windows_msg
.time
= GetMessageTime ();
3906 TranslateMessage (&windows_msg
);
3914 post_character_message (hwnd
, msg
, wParam
, lParam
,
3915 w32_get_key_modifiers (wParam
, lParam
));
3918 /* Simulate middle mouse button events when left and right buttons
3919 are used together, but only if user has two button mouse. */
3920 case WM_LBUTTONDOWN
:
3921 case WM_RBUTTONDOWN
:
3922 if (XINT (Vw32_num_mouse_buttons
) == 3)
3923 goto handle_plain_button
;
3926 int this = (msg
== WM_LBUTTONDOWN
) ? LMOUSE
: RMOUSE
;
3927 int other
= (msg
== WM_LBUTTONDOWN
) ? RMOUSE
: LMOUSE
;
3929 if (button_state
& this)
3932 if (button_state
== 0)
3935 button_state
|= this;
3937 if (button_state
& other
)
3939 if (mouse_button_timer
)
3941 KillTimer (hwnd
, mouse_button_timer
);
3942 mouse_button_timer
= 0;
3944 /* Generate middle mouse event instead. */
3945 msg
= WM_MBUTTONDOWN
;
3946 button_state
|= MMOUSE
;
3948 else if (button_state
& MMOUSE
)
3950 /* Ignore button event if we've already generated a
3951 middle mouse down event. This happens if the
3952 user releases and press one of the two buttons
3953 after we've faked a middle mouse event. */
3958 /* Flush out saved message. */
3959 post_msg (&saved_mouse_button_msg
);
3961 wmsg
.dwModifiers
= w32_get_modifiers ();
3962 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
3964 /* Clear message buffer. */
3965 saved_mouse_button_msg
.msg
.hwnd
= 0;
3969 /* Hold onto message for now. */
3970 mouse_button_timer
=
3971 SetTimer (hwnd
, MOUSE_BUTTON_ID
,
3972 XINT (Vw32_mouse_button_tolerance
), NULL
);
3973 saved_mouse_button_msg
.msg
.hwnd
= hwnd
;
3974 saved_mouse_button_msg
.msg
.message
= msg
;
3975 saved_mouse_button_msg
.msg
.wParam
= wParam
;
3976 saved_mouse_button_msg
.msg
.lParam
= lParam
;
3977 saved_mouse_button_msg
.msg
.time
= GetMessageTime ();
3978 saved_mouse_button_msg
.dwModifiers
= w32_get_modifiers ();
3985 if (XINT (Vw32_num_mouse_buttons
) == 3)
3986 goto handle_plain_button
;
3989 int this = (msg
== WM_LBUTTONUP
) ? LMOUSE
: RMOUSE
;
3990 int other
= (msg
== WM_LBUTTONUP
) ? RMOUSE
: LMOUSE
;
3992 if ((button_state
& this) == 0)
3995 button_state
&= ~this;
3997 if (button_state
& MMOUSE
)
3999 /* Only generate event when second button is released. */
4000 if ((button_state
& other
) == 0)
4003 button_state
&= ~MMOUSE
;
4005 if (button_state
) abort ();
4012 /* Flush out saved message if necessary. */
4013 if (saved_mouse_button_msg
.msg
.hwnd
)
4015 post_msg (&saved_mouse_button_msg
);
4018 wmsg
.dwModifiers
= w32_get_modifiers ();
4019 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4021 /* Always clear message buffer and cancel timer. */
4022 saved_mouse_button_msg
.msg
.hwnd
= 0;
4023 KillTimer (hwnd
, mouse_button_timer
);
4024 mouse_button_timer
= 0;
4026 if (button_state
== 0)
4031 case WM_MBUTTONDOWN
:
4033 handle_plain_button
:
4038 if (parse_button (msg
, &button
, &up
))
4040 if (up
) ReleaseCapture ();
4041 else SetCapture (hwnd
);
4042 button
= (button
== 0) ? LMOUSE
:
4043 ((button
== 1) ? MMOUSE
: RMOUSE
);
4045 button_state
&= ~button
;
4047 button_state
|= button
;
4051 wmsg
.dwModifiers
= w32_get_modifiers ();
4052 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4057 if (XINT (Vw32_mouse_move_interval
) <= 0
4058 || (msg
== WM_MOUSEMOVE
&& button_state
== 0))
4060 wmsg
.dwModifiers
= w32_get_modifiers ();
4061 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4065 /* Hang onto mouse move and scroll messages for a bit, to avoid
4066 sending such events to Emacs faster than it can process them.
4067 If we get more events before the timer from the first message
4068 expires, we just replace the first message. */
4070 if (saved_mouse_move_msg
.msg
.hwnd
== 0)
4072 SetTimer (hwnd
, MOUSE_MOVE_ID
,
4073 XINT (Vw32_mouse_move_interval
), NULL
);
4075 /* Hold onto message for now. */
4076 saved_mouse_move_msg
.msg
.hwnd
= hwnd
;
4077 saved_mouse_move_msg
.msg
.message
= msg
;
4078 saved_mouse_move_msg
.msg
.wParam
= wParam
;
4079 saved_mouse_move_msg
.msg
.lParam
= lParam
;
4080 saved_mouse_move_msg
.msg
.time
= GetMessageTime ();
4081 saved_mouse_move_msg
.dwModifiers
= w32_get_modifiers ();
4086 wmsg
.dwModifiers
= w32_get_modifiers ();
4087 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4091 wmsg
.dwModifiers
= w32_get_modifiers ();
4092 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4096 /* Flush out saved messages if necessary. */
4097 if (wParam
== mouse_button_timer
)
4099 if (saved_mouse_button_msg
.msg
.hwnd
)
4101 post_msg (&saved_mouse_button_msg
);
4102 saved_mouse_button_msg
.msg
.hwnd
= 0;
4104 KillTimer (hwnd
, mouse_button_timer
);
4105 mouse_button_timer
= 0;
4107 else if (wParam
== mouse_move_timer
)
4109 if (saved_mouse_move_msg
.msg
.hwnd
)
4111 post_msg (&saved_mouse_move_msg
);
4112 saved_mouse_move_msg
.msg
.hwnd
= 0;
4114 KillTimer (hwnd
, mouse_move_timer
);
4115 mouse_move_timer
= 0;
4120 /* Windows doesn't send us focus messages when putting up and
4121 taking down a system popup dialog as for Ctrl-Alt-Del on Windows 95.
4122 The only indication we get that something happened is receiving
4123 this message afterwards. So this is a good time to reset our
4124 keyboard modifiers' state. */
4129 /* We must ensure menu bar is fully constructed and up to date
4130 before allowing user interaction with it. To achieve this
4131 we send this message to the lisp thread and wait for a
4132 reply (whose value is not actually needed) to indicate that
4133 the menu bar is now ready for use, so we can now return.
4135 To remain responsive in the meantime, we enter a nested message
4136 loop that can process all other messages.
4138 However, we skip all this if the message results from calling
4139 TrackPopupMenu - in fact, we must NOT attempt to send the lisp
4140 thread a message because it is blocked on us at this point. We
4141 set menubar_active before calling TrackPopupMenu to indicate
4142 this (there is no possibility of confusion with real menubar
4145 f
= x_window_to_frame (dpyinfo
, hwnd
);
4147 && (f
->output_data
.w32
->menubar_active
4148 /* We can receive this message even in the absence of a
4149 menubar (ie. when the system menu is activated) - in this
4150 case we do NOT want to forward the message, otherwise it
4151 will cause the menubar to suddenly appear when the user
4152 had requested it to be turned off! */
4153 || f
->output_data
.w32
->menubar_widget
== NULL
))
4157 deferred_msg msg_buf
;
4159 /* Detect if message has already been deferred; in this case
4160 we cannot return any sensible value to ignore this. */
4161 if (find_deferred_msg (hwnd
, msg
) != NULL
)
4164 return send_deferred_msg (&msg_buf
, hwnd
, msg
, wParam
, lParam
);
4167 case WM_EXITMENULOOP
:
4168 f
= x_window_to_frame (dpyinfo
, hwnd
);
4170 /* Indicate that menubar can be modified again. */
4172 f
->output_data
.w32
->menubar_active
= 0;
4175 case WM_MEASUREITEM
:
4176 f
= x_window_to_frame (dpyinfo
, hwnd
);
4179 MEASUREITEMSTRUCT
* pMis
= (MEASUREITEMSTRUCT
*) lParam
;
4181 if (pMis
->CtlType
== ODT_MENU
)
4183 /* Work out dimensions for popup menu titles. */
4184 char * title
= (char *) pMis
->itemData
;
4185 HDC hdc
= GetDC (hwnd
);
4186 HFONT menu_font
= GetCurrentObject (hdc
, OBJ_FONT
);
4187 LOGFONT menu_logfont
;
4191 GetObject (menu_font
, sizeof (menu_logfont
), &menu_logfont
);
4192 menu_logfont
.lfWeight
= FW_BOLD
;
4193 menu_font
= CreateFontIndirect (&menu_logfont
);
4194 old_font
= SelectObject (hdc
, menu_font
);
4196 GetTextExtentPoint32 (hdc
, title
, strlen (title
), &size
);
4197 pMis
->itemWidth
= size
.cx
;
4198 pMis
->itemHeight
= GetSystemMetrics (SM_CYMENUSIZE
);
4199 if (pMis
->itemHeight
< size
.cy
)
4200 pMis
->itemHeight
= size
.cy
;
4202 SelectObject (hdc
, old_font
);
4203 DeleteObject (menu_font
);
4204 ReleaseDC (hwnd
, hdc
);
4211 f
= x_window_to_frame (dpyinfo
, hwnd
);
4214 DRAWITEMSTRUCT
* pDis
= (DRAWITEMSTRUCT
*) lParam
;
4216 if (pDis
->CtlType
== ODT_MENU
)
4218 /* Draw popup menu title. */
4219 char * title
= (char *) pDis
->itemData
;
4220 HDC hdc
= pDis
->hDC
;
4221 HFONT menu_font
= GetCurrentObject (hdc
, OBJ_FONT
);
4222 LOGFONT menu_logfont
;
4225 GetObject (menu_font
, sizeof (menu_logfont
), &menu_logfont
);
4226 menu_logfont
.lfWeight
= FW_BOLD
;
4227 menu_font
= CreateFontIndirect (&menu_logfont
);
4228 old_font
= SelectObject (hdc
, menu_font
);
4230 /* Always draw title as if not selected. */
4232 pDis
->rcItem
.left
+ GetSystemMetrics (SM_CXMENUCHECK
),
4234 ETO_OPAQUE
, &pDis
->rcItem
,
4235 title
, strlen (title
), NULL
);
4237 SelectObject (hdc
, old_font
);
4238 DeleteObject (menu_font
);
4245 /* Still not right - can't distinguish between clicks in the
4246 client area of the frame from clicks forwarded from the scroll
4247 bars - may have to hook WM_NCHITTEST to remember the mouse
4248 position and then check if it is in the client area ourselves. */
4249 case WM_MOUSEACTIVATE
:
4250 /* Discard the mouse click that activates a frame, allowing the
4251 user to click anywhere without changing point (or worse!).
4252 Don't eat mouse clicks on scrollbars though!! */
4253 if (LOWORD (lParam
) == HTCLIENT
)
4254 return MA_ACTIVATEANDEAT
;
4258 case WM_ACTIVATEAPP
:
4260 case WM_WINDOWPOSCHANGED
:
4262 /* Inform lisp thread that a frame might have just been obscured
4263 or exposed, so should recheck visibility of all frames. */
4264 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4268 dpyinfo
->faked_key
= 0;
4270 register_hot_keys (hwnd
);
4273 unregister_hot_keys (hwnd
);
4278 wmsg
.dwModifiers
= w32_get_modifiers ();
4279 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4283 wmsg
.dwModifiers
= w32_get_modifiers ();
4284 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4287 case WM_WINDOWPOSCHANGING
:
4290 LPWINDOWPOS lppos
= (WINDOWPOS
*) lParam
;
4292 wp
.length
= sizeof (WINDOWPLACEMENT
);
4293 GetWindowPlacement (hwnd
, &wp
);
4295 if (wp
.showCmd
!= SW_SHOWMINIMIZED
&& (lppos
->flags
& SWP_NOSIZE
) == 0)
4302 DWORD internal_border
;
4303 DWORD scrollbar_extra
;
4306 wp
.length
= sizeof(wp
);
4307 GetWindowRect (hwnd
, &wr
);
4311 font_width
= GetWindowLong (hwnd
, WND_FONTWIDTH_INDEX
);
4312 line_height
= GetWindowLong (hwnd
, WND_LINEHEIGHT_INDEX
);
4313 internal_border
= GetWindowLong (hwnd
, WND_BORDER_INDEX
);
4314 scrollbar_extra
= GetWindowLong (hwnd
, WND_SCROLLBAR_INDEX
);
4318 memset (&rect
, 0, sizeof (rect
));
4319 AdjustWindowRect (&rect
, GetWindowLong (hwnd
, GWL_STYLE
),
4320 GetMenu (hwnd
) != NULL
);
4322 /* Force width and height of client area to be exact
4323 multiples of the character cell dimensions. */
4324 wdiff
= (lppos
->cx
- (rect
.right
- rect
.left
)
4325 - 2 * internal_border
- scrollbar_extra
)
4327 hdiff
= (lppos
->cy
- (rect
.bottom
- rect
.top
)
4328 - 2 * internal_border
)
4333 /* For right/bottom sizing we can just fix the sizes.
4334 However for top/left sizing we will need to fix the X
4335 and Y positions as well. */
4340 if (wp
.showCmd
!= SW_SHOWMAXIMIZED
4341 && (lppos
->flags
& SWP_NOMOVE
) == 0)
4343 if (lppos
->x
!= wr
.left
|| lppos
->y
!= wr
.top
)
4350 lppos
->flags
|= SWP_NOMOVE
;
4361 case WM_EMACS_CREATESCROLLBAR
:
4362 return (LRESULT
) w32_createscrollbar ((struct frame
*) wParam
,
4363 (struct scroll_bar
*) lParam
);
4365 case WM_EMACS_SHOWWINDOW
:
4366 return ShowWindow ((HWND
) wParam
, (WPARAM
) lParam
);
4368 case WM_EMACS_SETFOREGROUND
:
4369 return SetForegroundWindow ((HWND
) wParam
);
4371 case WM_EMACS_SETWINDOWPOS
:
4373 WINDOWPOS
* pos
= (WINDOWPOS
*) wParam
;
4374 return SetWindowPos (hwnd
, pos
->hwndInsertAfter
,
4375 pos
->x
, pos
->y
, pos
->cx
, pos
->cy
, pos
->flags
);
4378 case WM_EMACS_DESTROYWINDOW
:
4379 DragAcceptFiles ((HWND
) wParam
, FALSE
);
4380 return DestroyWindow ((HWND
) wParam
);
4382 case WM_EMACS_TRACKPOPUPMENU
:
4387 pos
= (POINT
*)lParam
;
4388 flags
= TPM_CENTERALIGN
;
4389 if (button_state
& LMOUSE
)
4390 flags
|= TPM_LEFTBUTTON
;
4391 else if (button_state
& RMOUSE
)
4392 flags
|= TPM_RIGHTBUTTON
;
4394 /* Remember we did a SetCapture on the initial mouse down event,
4395 so for safety, we make sure the capture is cancelled now. */
4399 /* Use menubar_active to indicate that WM_INITMENU is from
4400 TrackPopupMenu below, and should be ignored. */
4401 f
= x_window_to_frame (dpyinfo
, hwnd
);
4403 f
->output_data
.w32
->menubar_active
= 1;
4405 if (TrackPopupMenu ((HMENU
)wParam
, flags
, pos
->x
, pos
->y
,
4409 /* Eat any mouse messages during popupmenu */
4410 while (PeekMessage (&amsg
, hwnd
, WM_MOUSEFIRST
, WM_MOUSELAST
,
4412 /* Get the menu selection, if any */
4413 if (PeekMessage (&amsg
, hwnd
, WM_COMMAND
, WM_COMMAND
, PM_REMOVE
))
4415 retval
= LOWORD (amsg
.wParam
);
4431 /* Check for messages registered at runtime. */
4432 if (msg
== msh_mousewheel
)
4434 wmsg
.dwModifiers
= w32_get_modifiers ();
4435 my_post_msg (&wmsg
, hwnd
, msg
, wParam
, lParam
);
4440 return DefWindowProc (hwnd
, msg
, wParam
, lParam
);
4444 /* The most common default return code for handled messages is 0. */
4449 my_create_window (f
)
4454 if (!PostThreadMessage (dwWindowsThreadId
, WM_EMACS_CREATEWINDOW
, (WPARAM
)f
, 0))
4456 GetMessage (&msg
, NULL
, WM_EMACS_DONE
, WM_EMACS_DONE
);
4459 /* Create and set up the w32 window for frame F. */
4462 w32_window (f
, window_prompting
, minibuffer_only
)
4464 long window_prompting
;
4465 int minibuffer_only
;
4469 /* Use the resource name as the top-level window name
4470 for looking up resources. Make a non-Lisp copy
4471 for the window manager, so GC relocation won't bother it.
4473 Elsewhere we specify the window name for the window manager. */
4476 char *str
= (char *) XSTRING (Vx_resource_name
)->data
;
4477 f
->namebuf
= (char *) xmalloc (strlen (str
) + 1);
4478 strcpy (f
->namebuf
, str
);
4481 my_create_window (f
);
4483 validate_x_resource_name ();
4485 /* x_set_name normally ignores requests to set the name if the
4486 requested name is the same as the current name. This is the one
4487 place where that assumption isn't correct; f->name is set, but
4488 the server hasn't been told. */
4491 int explicit = f
->explicit_name
;
4493 f
->explicit_name
= 0;
4496 x_set_name (f
, name
, explicit);
4501 if (!minibuffer_only
&& FRAME_EXTERNAL_MENU_BAR (f
))
4502 initialize_frame_menubar (f
);
4504 if (FRAME_W32_WINDOW (f
) == 0)
4505 error ("Unable to create window");
4508 /* Handle the icon stuff for this window. Perhaps later we might
4509 want an x_set_icon_position which can be called interactively as
4517 Lisp_Object icon_x
, icon_y
;
4519 /* Set the position of the icon. Note that Windows 95 groups all
4520 icons in the tray. */
4521 icon_x
= x_get_arg (parms
, Qicon_left
, 0, 0, number
);
4522 icon_y
= x_get_arg (parms
, Qicon_top
, 0, 0, number
);
4523 if (!EQ (icon_x
, Qunbound
) && !EQ (icon_y
, Qunbound
))
4525 CHECK_NUMBER (icon_x
, 0);
4526 CHECK_NUMBER (icon_y
, 0);
4528 else if (!EQ (icon_x
, Qunbound
) || !EQ (icon_y
, Qunbound
))
4529 error ("Both left and top icon corners of icon must be specified");
4533 if (! EQ (icon_x
, Qunbound
))
4534 x_wm_set_icon_position (f
, XINT (icon_x
), XINT (icon_y
));
4537 /* Start up iconic or window? */
4538 x_wm_set_window_state
4539 (f
, (EQ (x_get_arg (parms
, Qvisibility
, 0, 0, symbol
), Qicon
)
4543 x_text_icon (f
, (char *) XSTRING ((!NILP (f
->icon_name
)
4551 DEFUN ("x-create-frame", Fx_create_frame
, Sx_create_frame
,
4553 "Make a new window, which is called a \"frame\" in Emacs terms.\n\
4554 Returns an Emacs frame object.\n\
4555 ALIST is an alist of frame parameters.\n\
4556 If the parameters specify that the frame should not have a minibuffer,\n\
4557 and do not specify a specific minibuffer window to use,\n\
4558 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
4559 be shared by the new frame.\n\
4561 This function is an internal primitive--use `make-frame' instead.")
4566 Lisp_Object frame
, tem
;
4568 int minibuffer_only
= 0;
4569 long window_prompting
= 0;
4571 int count
= specpdl_ptr
- specpdl
;
4572 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
4573 Lisp_Object display
;
4574 struct w32_display_info
*dpyinfo
;
4580 /* Use this general default value to start with
4581 until we know if this frame has a specified name. */
4582 Vx_resource_name
= Vinvocation_name
;
4584 display
= x_get_arg (parms
, Qdisplay
, 0, 0, string
);
4585 if (EQ (display
, Qunbound
))
4587 dpyinfo
= check_x_display_info (display
);
4589 kb
= dpyinfo
->kboard
;
4591 kb
= &the_only_kboard
;
4594 name
= x_get_arg (parms
, Qname
, "name", "Name", string
);
4596 && ! EQ (name
, Qunbound
)
4598 error ("Invalid frame name--not a string or nil");
4601 Vx_resource_name
= name
;
4603 /* See if parent window is specified. */
4604 parent
= x_get_arg (parms
, Qparent_id
, NULL
, NULL
, number
);
4605 if (EQ (parent
, Qunbound
))
4607 if (! NILP (parent
))
4608 CHECK_NUMBER (parent
, 0);
4610 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
4611 /* No need to protect DISPLAY because that's not used after passing
4612 it to make_frame_without_minibuffer. */
4614 GCPRO4 (parms
, parent
, name
, frame
);
4615 tem
= x_get_arg (parms
, Qminibuffer
, 0, 0, symbol
);
4616 if (EQ (tem
, Qnone
) || NILP (tem
))
4617 f
= make_frame_without_minibuffer (Qnil
, kb
, display
);
4618 else if (EQ (tem
, Qonly
))
4620 f
= make_minibuffer_frame ();
4621 minibuffer_only
= 1;
4623 else if (WINDOWP (tem
))
4624 f
= make_frame_without_minibuffer (tem
, kb
, display
);
4628 XSETFRAME (frame
, f
);
4630 /* Note that Windows does support scroll bars. */
4631 FRAME_CAN_HAVE_SCROLL_BARS (f
) = 1;
4632 /* By default, make scrollbars the system standard width. */
4633 f
->scroll_bar_pixel_width
= GetSystemMetrics (SM_CXVSCROLL
);
4635 f
->output_method
= output_w32
;
4636 f
->output_data
.w32
= (struct w32_output
*) xmalloc (sizeof (struct w32_output
));
4637 bzero (f
->output_data
.w32
, sizeof (struct w32_output
));
4639 FRAME_FONTSET (f
) = -1;
4642 = x_get_arg (parms
, Qicon_name
, "iconName", "Title", string
);
4643 if (! STRINGP (f
->icon_name
))
4644 f
->icon_name
= Qnil
;
4646 /* FRAME_W32_DISPLAY_INFO (f) = dpyinfo; */
4648 FRAME_KBOARD (f
) = kb
;
4651 /* Specify the parent under which to make this window. */
4655 f
->output_data
.w32
->parent_desc
= (Window
) parent
;
4656 f
->output_data
.w32
->explicit_parent
= 1;
4660 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
4661 f
->output_data
.w32
->explicit_parent
= 0;
4664 /* Note that the frame has no physical cursor right now. */
4665 f
->phys_cursor_x
= -1;
4667 /* Set the name; the functions to which we pass f expect the name to
4669 if (EQ (name
, Qunbound
) || NILP (name
))
4671 f
->name
= build_string (dpyinfo
->w32_id_name
);
4672 f
->explicit_name
= 0;
4677 f
->explicit_name
= 1;
4678 /* use the frame's title when getting resources for this frame. */
4679 specbind (Qx_resource_name
, name
);
4682 /* Create fontsets from `global_fontset_alist' before handling fonts. */
4683 for (tem
= Vglobal_fontset_alist
; CONSP (tem
); tem
= XCONS (tem
)->cdr
)
4684 fs_register_fontset (f
, XCONS (tem
)->car
);
4686 /* Extract the window parameters from the supplied values
4687 that are needed to determine window geometry. */
4691 font
= x_get_arg (parms
, Qfont
, "font", "Font", string
);
4693 /* First, try whatever font the caller has specified. */
4696 tem
= Fquery_fontset (font
, Qnil
);
4698 font
= x_new_fontset (f
, XSTRING (tem
)->data
);
4700 font
= x_new_font (f
, XSTRING (font
)->data
);
4702 /* Try out a font which we hope has bold and italic variations. */
4703 if (!STRINGP (font
))
4704 font
= x_new_font (f
, "-*-Courier New-normal-r-*-*-13-*-*-*-c-*-iso8859-1");
4705 if (! STRINGP (font
))
4706 font
= x_new_font (f
, "-*-Courier-normal-r-*-*-*-97-*-*-c-*-iso8859-1");
4707 /* If those didn't work, look for something which will at least work. */
4708 if (! STRINGP (font
))
4709 font
= x_new_font (f
, "-*-Fixedsys-normal-r-*-*-*-*-90-*-c-*-iso8859-1");
4711 if (! STRINGP (font
))
4712 font
= build_string ("Fixedsys");
4714 x_default_parameter (f
, parms
, Qfont
, font
,
4715 "font", "Font", string
);
4718 x_default_parameter (f
, parms
, Qborder_width
, make_number (2),
4719 "borderwidth", "BorderWidth", number
);
4720 /* This defaults to 2 in order to match xterm. We recognize either
4721 internalBorderWidth or internalBorder (which is what xterm calls
4723 if (NILP (Fassq (Qinternal_border_width
, parms
)))
4727 value
= x_get_arg (parms
, Qinternal_border_width
,
4728 "internalBorder", "BorderWidth", number
);
4729 if (! EQ (value
, Qunbound
))
4730 parms
= Fcons (Fcons (Qinternal_border_width
, value
),
4733 /* Default internalBorderWidth to 0 on Windows to match other programs. */
4734 x_default_parameter (f
, parms
, Qinternal_border_width
, make_number (0),
4735 "internalBorderWidth", "BorderWidth", number
);
4736 x_default_parameter (f
, parms
, Qvertical_scroll_bars
, Qt
,
4737 "verticalScrollBars", "ScrollBars", boolean
);
4739 /* Also do the stuff which must be set before the window exists. */
4740 x_default_parameter (f
, parms
, Qforeground_color
, build_string ("black"),
4741 "foreground", "Foreground", string
);
4742 x_default_parameter (f
, parms
, Qbackground_color
, build_string ("white"),
4743 "background", "Background", string
);
4744 x_default_parameter (f
, parms
, Qmouse_color
, build_string ("black"),
4745 "pointerColor", "Foreground", string
);
4746 x_default_parameter (f
, parms
, Qcursor_color
, build_string ("black"),
4747 "cursorColor", "Foreground", string
);
4748 x_default_parameter (f
, parms
, Qborder_color
, build_string ("black"),
4749 "borderColor", "BorderColor", string
);
4751 x_default_parameter (f
, parms
, Qmenu_bar_lines
, make_number (1),
4752 "menuBar", "MenuBar", number
);
4753 x_default_parameter (f
, parms
, Qscroll_bar_width
, Qnil
,
4754 "scrollBarWidth", "ScrollBarWidth", number
);
4755 x_default_parameter (f
, parms
, Qbuffer_predicate
, Qnil
,
4756 "bufferPredicate", "BufferPredicate", symbol
);
4757 x_default_parameter (f
, parms
, Qtitle
, Qnil
,
4758 "title", "Title", string
);
4760 f
->output_data
.w32
->dwStyle
= WS_OVERLAPPEDWINDOW
;
4761 f
->output_data
.w32
->parent_desc
= FRAME_W32_DISPLAY_INFO (f
)->root_window
;
4762 window_prompting
= x_figure_window_size (f
, parms
);
4764 if (window_prompting
& XNegative
)
4766 if (window_prompting
& YNegative
)
4767 f
->output_data
.w32
->win_gravity
= SouthEastGravity
;
4769 f
->output_data
.w32
->win_gravity
= NorthEastGravity
;
4773 if (window_prompting
& YNegative
)
4774 f
->output_data
.w32
->win_gravity
= SouthWestGravity
;
4776 f
->output_data
.w32
->win_gravity
= NorthWestGravity
;
4779 f
->output_data
.w32
->size_hint_flags
= window_prompting
;
4781 w32_window (f
, window_prompting
, minibuffer_only
);
4783 init_frame_faces (f
);
4785 /* We need to do this after creating the window, so that the
4786 icon-creation functions can say whose icon they're describing. */
4787 x_default_parameter (f
, parms
, Qicon_type
, Qnil
,
4788 "bitmapIcon", "BitmapIcon", symbol
);
4790 x_default_parameter (f
, parms
, Qauto_raise
, Qnil
,
4791 "autoRaise", "AutoRaiseLower", boolean
);
4792 x_default_parameter (f
, parms
, Qauto_lower
, Qnil
,
4793 "autoLower", "AutoRaiseLower", boolean
);
4794 x_default_parameter (f
, parms
, Qcursor_type
, Qbox
,
4795 "cursorType", "CursorType", symbol
);
4797 /* Dimensions, especially f->height, must be done via change_frame_size.
4798 Change will not be effected unless different from the current
4803 SET_FRAME_WIDTH (f
, 0);
4804 change_frame_size (f
, height
, width
, 1, 0);
4806 /* Tell the server what size and position, etc, we want,
4807 and how badly we want them. */
4809 x_wm_set_size_hint (f
, window_prompting
, 0);
4812 tem
= x_get_arg (parms
, Qunsplittable
, 0, 0, boolean
);
4813 f
->no_split
= minibuffer_only
|| EQ (tem
, Qt
);
4817 /* It is now ok to make the frame official
4818 even if we get an error below.
4819 And the frame needs to be on Vframe_list
4820 or making it visible won't work. */
4821 Vframe_list
= Fcons (frame
, Vframe_list
);
4823 /* Now that the frame is official, it counts as a reference to
4825 FRAME_W32_DISPLAY_INFO (f
)->reference_count
++;
4827 /* Make the window appear on the frame and enable display,
4828 unless the caller says not to. However, with explicit parent,
4829 Emacs cannot control visibility, so don't try. */
4830 if (! f
->output_data
.w32
->explicit_parent
)
4832 Lisp_Object visibility
;
4834 visibility
= x_get_arg (parms
, Qvisibility
, 0, 0, symbol
);
4835 if (EQ (visibility
, Qunbound
))
4838 if (EQ (visibility
, Qicon
))
4839 x_iconify_frame (f
);
4840 else if (! NILP (visibility
))
4841 x_make_frame_visible (f
);
4843 /* Must have been Qnil. */
4847 return unbind_to (count
, frame
);
4850 /* FRAME is used only to get a handle on the X display. We don't pass the
4851 display info directly because we're called from frame.c, which doesn't
4852 know about that structure. */
4854 x_get_focus_frame (frame
)
4855 struct frame
*frame
;
4857 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (frame
);
4859 if (! dpyinfo
->w32_focus_frame
)
4862 XSETFRAME (xfocus
, dpyinfo
->w32_focus_frame
);
4866 DEFUN ("w32-focus-frame", Fw32_focus_frame
, Sw32_focus_frame
, 1, 1, 0,
4867 "Give FRAME input focus, raising to foreground if necessary.")
4871 x_focus_on_frame (check_x_frame (frame
));
4876 /* Load font named FONTNAME of size SIZE for frame F, and return a
4877 pointer to the structure font_info while allocating it dynamically.
4878 If loading fails, return NULL. */
4880 w32_load_font (f
,fontname
,size
)
4885 struct w32_display_info
*dpyinfo
= FRAME_W32_DISPLAY_INFO (f
);
4886 Lisp_Object font_names
;
4888 #if 0 /* x_load_font attempts to get a list of fonts - presumably to
4889 allow a fuzzier fontname to be specified. w32_list_fonts
4890 appears to be a bit too fuzzy for this purpose. */
4892 /* Get a list of all the fonts that match this name. Once we
4893 have a list of matching fonts, we compare them against the fonts
4894 we already have loaded by comparing names. */
4895 font_names
= w32_list_fonts (f
, build_string (fontname
), size
, 100);
4897 if (!NILP (font_names
))
4902 #if 0 /* This code has nasty side effects that cause Emacs to crash. */
4904 /* First check if any are already loaded, as that is cheaper
4905 than loading another one. */
4906 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
4907 for (tail
= font_names
; CONSP (tail
); tail
= XCONS (tail
)->cdr
)
4908 if (!strcmp (dpyinfo
->font_table
[i
].name
,
4909 XSTRING (XCONS (tail
)->car
)->data
)
4910 || !strcmp (dpyinfo
->font_table
[i
].full_name
,
4911 XSTRING (XCONS (tail
)->car
)->data
))
4912 return (dpyinfo
->font_table
+ i
);
4915 fontname
= (char *) XSTRING (XCONS (font_names
)->car
)->data
;
4921 /* Load the font and add it to the table. */
4925 struct font_info
*fontp
;
4929 if (!fontname
|| !x_to_w32_font (fontname
, &lf
))
4932 if (!*lf
.lfFaceName
)
4933 /* If no name was specified for the font, we get a random font
4934 from CreateFontIndirect - this is not particularly
4935 desirable, especially since CreateFontIndirect does not
4936 fill out the missing name in lf, so we never know what we
4940 font
= (XFontStruct
*) xmalloc (sizeof (XFontStruct
));
4942 if (!font
) return (NULL
);
4946 font
->hfont
= CreateFontIndirect (&lf
);
4948 if (font
->hfont
== NULL
)
4957 hdc
= GetDC (dpyinfo
->root_window
);
4958 oldobj
= SelectObject (hdc
, font
->hfont
);
4959 ok
= GetTextMetrics (hdc
, &font
->tm
);
4960 SelectObject (hdc
, oldobj
);
4961 ReleaseDC (dpyinfo
->root_window
, hdc
);
4968 w32_unload_font (dpyinfo
, font
);
4972 /* Do we need to create the table? */
4973 if (dpyinfo
->font_table_size
== 0)
4975 dpyinfo
->font_table_size
= 16;
4977 = (struct font_info
*) xmalloc (dpyinfo
->font_table_size
4978 * sizeof (struct font_info
));
4980 /* Do we need to grow the table? */
4981 else if (dpyinfo
->n_fonts
4982 >= dpyinfo
->font_table_size
)
4984 dpyinfo
->font_table_size
*= 2;
4986 = (struct font_info
*) xrealloc (dpyinfo
->font_table
,
4987 (dpyinfo
->font_table_size
4988 * sizeof (struct font_info
)));
4991 fontp
= dpyinfo
->font_table
+ dpyinfo
->n_fonts
;
4993 /* Now fill in the slots of *FONTP. */
4996 fontp
->font_idx
= dpyinfo
->n_fonts
;
4997 fontp
->name
= (char *) xmalloc (strlen (fontname
) + 1);
4998 bcopy (fontname
, fontp
->name
, strlen (fontname
) + 1);
5000 /* Work out the font's full name. */
5001 full_name
= (char *)xmalloc (100);
5002 if (full_name
&& w32_to_x_font (&lf
, full_name
, 100))
5003 fontp
->full_name
= full_name
;
5006 /* If all else fails - just use the name we used to load it. */
5008 fontp
->full_name
= fontp
->name
;
5011 fontp
->size
= FONT_WIDTH (font
);
5012 fontp
->height
= FONT_HEIGHT (font
);
5014 /* The slot `encoding' specifies how to map a character
5015 code-points (0x20..0x7F or 0x2020..0x7F7F) of each charset to
5016 the font code-points (0:0x20..0x7F, 1:0xA0..0xFF, 0:0x2020..0x7F7F,
5017 the font code-points (0:0x20..0x7F, 1:0xA0..0xFF,
5018 0:0x2020..0x7F7F, 1:0xA0A0..0xFFFF, 3:0x20A0..0x7FFF, or
5019 2:0xA020..0xFF7F). For the moment, we don't know which charset
5020 uses this font. So, we set informatoin in fontp->encoding[1]
5021 which is never used by any charset. If mapping can't be
5022 decided, set FONT_ENCODING_NOT_DECIDED. */
5023 fontp
->encoding
[1] = FONT_ENCODING_NOT_DECIDED
;
5025 /* The following three values are set to 0 under W32, which is
5026 what they get set to if XGetFontProperty fails under X. */
5027 fontp
->baseline_offset
= 0;
5028 fontp
->relative_compose
= 0;
5029 fontp
->default_ascent
= FONT_BASE (font
);
5039 w32_unload_font (dpyinfo
, font
)
5040 struct w32_display_info
*dpyinfo
;
5045 if (font
->hfont
) DeleteObject(font
->hfont
);
5050 /* The font conversion stuff between x and w32 */
5052 /* X font string is as follows (from faces.el)
5056 * (weight "\\(bold\\|demibold\\|medium\\)") ; 1
5057 * (weight\? "\\([^-]*\\)") ; 1
5058 * (slant "\\([ior]\\)") ; 2
5059 * (slant\? "\\([^-]?\\)") ; 2
5060 * (swidth "\\([^-]*\\)") ; 3
5061 * (adstyle "[^-]*") ; 4
5062 * (pixelsize "[0-9]+")
5063 * (pointsize "[0-9][0-9]+")
5064 * (resx "[0-9][0-9]+")
5065 * (resy "[0-9][0-9]+")
5066 * (spacing "[cmp?*]")
5067 * (avgwidth "[0-9]+")
5068 * (registry "[^-]+")
5069 * (encoding "[^-]+")
5071 * (setq x-font-regexp
5072 * (concat "\\`\\*?[-?*]"
5073 * foundry - family - weight\? - slant\? - swidth - adstyle -
5074 * pixelsize - pointsize - resx - resy - spacing - registry -
5075 * encoding "[-?*]\\*?\\'"
5077 * (setq x-font-regexp-head
5078 * (concat "\\`[-?*]" foundry - family - weight\? - slant\?
5079 * "\\([-*?]\\|\\'\\)"))
5080 * (setq x-font-regexp-slant (concat - slant -))
5081 * (setq x-font-regexp-weight (concat - weight -))
5085 #define FONT_START "[-?]"
5086 #define FONT_FOUNDRY "[^-]+"
5087 #define FONT_FAMILY "\\([^-]+\\)" /* 1 */
5088 #define FONT_WEIGHT "\\(bold\\|demibold\\|medium\\)" /* 2 */
5089 #define FONT_WEIGHT_Q "\\([^-]*\\)" /* 2 */
5090 #define FONT_SLANT "\\([ior]\\)" /* 3 */
5091 #define FONT_SLANT_Q "\\([^-]?\\)" /* 3 */
5092 #define FONT_SWIDTH "\\([^-]*\\)" /* 4 */
5093 #define FONT_ADSTYLE "[^-]*"
5094 #define FONT_PIXELSIZE "[^-]*"
5095 #define FONT_POINTSIZE "\\([0-9][0-9]+\\|\\*\\)" /* 5 */
5096 #define FONT_RESX "[0-9][0-9]+"
5097 #define FONT_RESY "[0-9][0-9]+"
5098 #define FONT_SPACING "[cmp?*]"
5099 #define FONT_AVGWIDTH "[0-9]+"
5100 #define FONT_REGISTRY "[^-]+"
5101 #define FONT_ENCODING "[^-]+"
5103 #define FONT_REGEXP ("\\`\\*?[-?*]" \
5110 FONT_PIXELSIZE "-" \
5111 FONT_POINTSIZE "-" \
5114 #define FONT_REGEXP_HEAD ("\\`[-?*]" \
5119 "\\([-*?]\\|\\'\\)")
5121 #define FONT_REGEXP_SLANT "-" FONT_SLANT "-"
5122 #define FONT_REGEXP_WEIGHT "-" FONT_WEIGHT "-"
5125 x_to_w32_weight (lpw
)
5128 if (!lpw
) return (FW_DONTCARE
);
5130 if (stricmp (lpw
,"heavy") == 0) return FW_HEAVY
;
5131 else if (stricmp (lpw
,"extrabold") == 0) return FW_EXTRABOLD
;
5132 else if (stricmp (lpw
,"bold") == 0) return FW_BOLD
;
5133 else if (stricmp (lpw
,"demibold") == 0) return FW_SEMIBOLD
;
5134 else if (stricmp (lpw
,"semibold") == 0) return FW_SEMIBOLD
;
5135 else if (stricmp (lpw
,"medium") == 0) return FW_MEDIUM
;
5136 else if (stricmp (lpw
,"normal") == 0) return FW_NORMAL
;
5137 else if (stricmp (lpw
,"light") == 0) return FW_LIGHT
;
5138 else if (stricmp (lpw
,"extralight") == 0) return FW_EXTRALIGHT
;
5139 else if (stricmp (lpw
,"thin") == 0) return FW_THIN
;
5146 w32_to_x_weight (fnweight
)
5149 if (fnweight
>= FW_HEAVY
) return "heavy";
5150 if (fnweight
>= FW_EXTRABOLD
) return "extrabold";
5151 if (fnweight
>= FW_BOLD
) return "bold";
5152 if (fnweight
>= FW_SEMIBOLD
) return "semibold";
5153 if (fnweight
>= FW_MEDIUM
) return "medium";
5154 if (fnweight
>= FW_NORMAL
) return "normal";
5155 if (fnweight
>= FW_LIGHT
) return "light";
5156 if (fnweight
>= FW_EXTRALIGHT
) return "extralight";
5157 if (fnweight
>= FW_THIN
) return "thin";
5163 x_to_w32_charset (lpcs
)
5166 if (!lpcs
) return (0);
5168 if (stricmp (lpcs
,"ansi") == 0) return ANSI_CHARSET
;
5169 else if (stricmp (lpcs
,"iso8859-1") == 0) return ANSI_CHARSET
;
5170 else if (stricmp (lpcs
, "symbol") == 0) return SYMBOL_CHARSET
;
5171 else if (stricmp (lpcs
, "jis") == 0) return SHIFTJIS_CHARSET
;
5172 else if (stricmp (lpcs
, "ksc5601") == 0) return HANGEUL_CHARSET
;
5173 else if (stricmp (lpcs
, "gb2312") == 0) return GB2312_CHARSET
;
5174 else if (stricmp (lpcs
, "big5") == 0) return CHINESEBIG5_CHARSET
;
5175 else if (stricmp (lpcs
, "oem") == 0) return OEM_CHARSET
;
5177 #ifdef EASTEUROPE_CHARSET
5178 else if (stricmp (lpcs
, "iso8859-2") == 0) return EASTEUROPE_CHARSET
;
5179 else if (stricmp (lpcs
, "iso8859-3") == 0) return TURKISH_CHARSET
;
5180 else if (stricmp (lpcs
, "iso8859-4") == 0) return BALTIC_CHARSET
;
5181 else if (stricmp (lpcs
, "iso8859-5") == 0) return RUSSIAN_CHARSET
;
5182 else if (stricmp (lpcs
, "koi8") == 0) return RUSSIAN_CHARSET
;
5183 else if (stricmp (lpcs
, "iso8859-6") == 0) return ARABIC_CHARSET
;
5184 else if (stricmp (lpcs
, "iso8859-7") == 0) return GREEK_CHARSET
;
5185 else if (stricmp (lpcs
, "iso8859-8") == 0) return HEBREW_CHARSET
;
5186 else if (stricmp (lpcs
, "viscii") == 0) return VIETNAMESE_CHARSET
;
5187 else if (stricmp (lpcs
, "vscii") == 0) return VIETNAMESE_CHARSET
;
5188 else if (stricmp (lpcs
, "tis620") == 0) return THAI_CHARSET
;
5189 else if (stricmp (lpcs
, "mac") == 0) return MAC_CHARSET
;
5192 #ifdef UNICODE_CHARSET
5193 else if (stricmp (lpcs
,"iso10646") == 0) return UNICODE_CHARSET
;
5194 else if (stricmp (lpcs
, "unicode") == 0) return UNICODE_CHARSET
;
5196 else if (lpcs
[0] == '#') return atoi (lpcs
+ 1);
5198 return DEFAULT_CHARSET
;
5202 w32_to_x_charset (fncharset
)
5205 static char buf
[16];
5209 /* ansi is considered iso8859-1, as most modern ansi fonts are. */
5210 case ANSI_CHARSET
: return "iso8859-1";
5211 case DEFAULT_CHARSET
: return "ascii-*";
5212 case SYMBOL_CHARSET
: return "*-symbol";
5213 case SHIFTJIS_CHARSET
: return "jisx0212-sjis";
5214 case HANGEUL_CHARSET
: return "ksc5601-*";
5215 case GB2312_CHARSET
: return "gb2312-*";
5216 case CHINESEBIG5_CHARSET
: return "big5-*";
5217 case OEM_CHARSET
: return "*-oem";
5219 /* More recent versions of Windows (95 and NT4.0) define more
5221 #ifdef EASTEUROPE_CHARSET
5222 case EASTEUROPE_CHARSET
: return "iso8859-2";
5223 case TURKISH_CHARSET
: return "iso8859-3";
5224 case BALTIC_CHARSET
: return "iso8859-4";
5225 case RUSSIAN_CHARSET
: return "iso8859-5";
5226 case ARABIC_CHARSET
: return "iso8859-6";
5227 case GREEK_CHARSET
: return "iso8859-7";
5228 case HEBREW_CHARSET
: return "iso8859-8";
5229 case VIETNAMESE_CHARSET
: return "viscii1.1-*";
5230 case THAI_CHARSET
: return "tis620-*";
5231 case MAC_CHARSET
: return "*-mac";
5232 case JOHAB_CHARSET
: break; /* What is this? Latin-9? */
5235 #ifdef UNICODE_CHARSET
5236 case UNICODE_CHARSET
: return "iso10646-unicode";
5239 /* Encode numerical value of unknown charset. */
5240 sprintf (buf
, "*-#%u", fncharset
);
5245 w32_to_x_font (lplogfont
, lpxstr
, len
)
5246 LOGFONT
* lplogfont
;
5251 char height_pixels
[8];
5253 char width_pixels
[8];
5254 char *fontname_dash
;
5256 if (!lpxstr
) abort ();
5261 strncpy (fontname
, lplogfont
->lfFaceName
, 50);
5262 fontname
[49] = '\0'; /* Just in case */
5264 /* Replace dashes with underscores so the dashes are not
5266 fontname_dash
= fontname
;
5267 while (fontname_dash
= strchr (fontname_dash
, '-'))
5268 *fontname_dash
= '_';
5270 if (lplogfont
->lfHeight
)
5272 sprintf (height_pixels
, "%u", abs (lplogfont
->lfHeight
));
5273 sprintf (height_dpi
, "%u",
5274 (abs (lplogfont
->lfHeight
) * 720) / one_w32_display_info
.height_in
);
5278 strcpy (height_pixels
, "*");
5279 strcpy (height_dpi
, "*");
5281 if (lplogfont
->lfWidth
)
5282 sprintf (width_pixels
, "%u", lplogfont
->lfWidth
* 10);
5284 strcpy (width_pixels
, "*");
5286 _snprintf (lpxstr
, len
- 1,
5287 "-*-%s-%s-%c-*-*-%s-%s-*-*-%c-%s-%s",
5289 fontname
, /* family */
5290 w32_to_x_weight (lplogfont
->lfWeight
), /* weight */
5291 lplogfont
->lfItalic
?'i':'r', /* slant */
5293 /* add style name */
5294 height_pixels
, /* pixel size */
5295 height_dpi
, /* point size */
5298 ((lplogfont
->lfPitchAndFamily
& 0x3) == VARIABLE_PITCH
)
5299 ? 'p' : 'c', /* spacing */
5300 width_pixels
, /* avg width */
5301 w32_to_x_charset (lplogfont
->lfCharSet
) /* charset registry
5305 lpxstr
[len
- 1] = 0; /* just to be sure */
5310 x_to_w32_font (lpxstr
, lplogfont
)
5312 LOGFONT
* lplogfont
;
5314 if (!lplogfont
) return (FALSE
);
5316 memset (lplogfont
, 0, sizeof (*lplogfont
));
5318 /* Set default value for each field. */
5320 lplogfont
->lfOutPrecision
= OUT_DEFAULT_PRECIS
;
5321 lplogfont
->lfClipPrecision
= CLIP_DEFAULT_PRECIS
;
5322 lplogfont
->lfQuality
= DEFAULT_QUALITY
;
5324 /* go for maximum quality */
5325 lplogfont
->lfOutPrecision
= OUT_STROKE_PRECIS
;
5326 lplogfont
->lfClipPrecision
= CLIP_STROKE_PRECIS
;
5327 lplogfont
->lfQuality
= PROOF_QUALITY
;
5330 lplogfont
->lfCharSet
= DEFAULT_CHARSET
;
5331 lplogfont
->lfWeight
= FW_DONTCARE
;
5332 lplogfont
->lfPitchAndFamily
= DEFAULT_PITCH
| FF_DONTCARE
;
5337 /* Provide a simple escape mechanism for specifying Windows font names
5338 * directly -- if font spec does not beginning with '-', assume this
5340 * "<font name>[:height in pixels[:width in pixels[:weight]]]"
5346 char name
[50], weight
[20], slant
, pitch
, pixels
[10], height
[10], width
[10], remainder
[20];
5349 fields
= sscanf (lpxstr
,
5350 "-%*[^-]-%49[^-]-%19[^-]-%c-%*[^-]-%*[^-]-%9[^-]-%9[^-]-%*[^-]-%*[^-]-%c-%9[^-]-%19s",
5351 name
, weight
, &slant
, pixels
, height
, &pitch
, width
, remainder
);
5353 if (fields
== EOF
) return (FALSE
);
5355 if (fields
> 0 && name
[0] != '*')
5357 strncpy (lplogfont
->lfFaceName
,name
, LF_FACESIZE
);
5358 lplogfont
->lfFaceName
[LF_FACESIZE
-1] = 0;
5362 lplogfont
->lfFaceName
[0] = 0;
5367 lplogfont
->lfWeight
= x_to_w32_weight ((fields
> 0 ? weight
: ""));
5371 if (!NILP (Vw32_enable_italics
))
5372 lplogfont
->lfItalic
= (fields
> 0 && slant
== 'i');
5376 if (fields
> 0 && pixels
[0] != '*')
5377 lplogfont
->lfHeight
= atoi (pixels
);
5381 if (fields
> 0 && lplogfont
->lfHeight
== 0 && height
[0] != '*')
5382 lplogfont
->lfHeight
= (atoi (height
)
5383 * one_w32_display_info
.height_in
) / 720;
5387 lplogfont
->lfPitchAndFamily
=
5388 (fields
> 0 && pitch
== 'p') ? VARIABLE_PITCH
: FIXED_PITCH
;
5392 if (fields
> 0 && width
[0] != '*')
5393 lplogfont
->lfWidth
= atoi (width
) / 10;
5397 /* Strip the trailing '-' if present. (it shouldn't be, as it
5398 fails the test against xlfn-tight-regexp in fontset.el). */
5400 int len
= strlen (remainder
);
5401 if (len
> 0 && remainder
[len
-1] == '-')
5402 remainder
[len
-1] = 0;
5404 encoding
= remainder
;
5405 if (strncmp (encoding
, "*-", 2) == 0)
5407 lplogfont
->lfCharSet
= x_to_w32_charset (fields
> 0 ? encoding
: "");
5412 char name
[100], height
[10], width
[10], weight
[20];
5414 fields
= sscanf (lpxstr
,
5415 "%99[^:]:%9[^:]:%9[^:]:%19s",
5416 name
, height
, width
, weight
);
5418 if (fields
== EOF
) return (FALSE
);
5422 strncpy (lplogfont
->lfFaceName
,name
, LF_FACESIZE
);
5423 lplogfont
->lfFaceName
[LF_FACESIZE
-1] = 0;
5427 lplogfont
->lfFaceName
[0] = 0;
5433 lplogfont
->lfHeight
= atoi (height
);
5438 lplogfont
->lfWidth
= atoi (width
);
5442 lplogfont
->lfWeight
= x_to_w32_weight ((fields
> 0 ? weight
: ""));
5445 /* This makes TrueType fonts work better. */
5446 lplogfont
->lfHeight
= - abs (lplogfont
->lfHeight
);
5452 w32_font_match (lpszfont1
, lpszfont2
)
5456 char * s1
= lpszfont1
, *e1
;
5457 char * s2
= lpszfont2
, *e2
;
5459 if (s1
== NULL
|| s2
== NULL
) return (FALSE
);
5461 if (*s1
== '-') s1
++;
5462 if (*s2
== '-') s2
++;
5468 e1
= strchr (s1
, '-');
5469 e2
= strchr (s2
, '-');
5471 if (e1
== NULL
|| e2
== NULL
) return (TRUE
);
5476 if (*s1
!= '*' && *s2
!= '*'
5477 && (len1
!= len2
|| strnicmp (s1
, s2
, len1
) != 0))
5485 typedef struct enumfont_t
5490 XFontStruct
*size_ref
;
5491 Lisp_Object
*pattern
;
5497 enum_font_cb2 (lplf
, lptm
, FontType
, lpef
)
5499 NEWTEXTMETRIC
* lptm
;
5503 if (lplf
->elfLogFont
.lfStrikeOut
|| lplf
->elfLogFont
.lfUnderline
)
5506 /* Check that the character set matches if it was specified */
5507 if (lpef
->logfont
.lfCharSet
!= DEFAULT_CHARSET
&&
5508 lplf
->elfLogFont
.lfCharSet
!= lpef
->logfont
.lfCharSet
)
5511 /* We want all fonts cached, so don't compare sizes just yet */
5512 /* if (!lpef->size_ref || lptm->tmMaxCharWidth == FONT_WIDTH (lpef->size_ref)) */
5515 Lisp_Object width
= Qnil
;
5517 if (!NILP (*(lpef
->pattern
)) && FontType
!= RASTER_FONTTYPE
)
5519 /* Scalable fonts are as big as you want them to be. */
5520 lplf
->elfLogFont
.lfHeight
= lpef
->logfont
.lfHeight
;
5521 lplf
->elfLogFont
.lfWidth
= lpef
->logfont
.lfWidth
;
5524 /* The MaxCharWidth is not valid at this stage for scalable fonts. */
5525 if (FontType
== RASTER_FONTTYPE
)
5526 width
= make_number (lptm
->tmMaxCharWidth
);
5528 if (!w32_to_x_font (lplf
, buf
, 100)) return (0);
5530 if (NILP (*(lpef
->pattern
)) || w32_font_match (buf
, XSTRING (*(lpef
->pattern
))->data
))
5532 *lpef
->tail
= Fcons (Fcons (build_string (buf
), width
), Qnil
);
5533 lpef
->tail
= &(XCONS (*lpef
->tail
)->cdr
);
5542 enum_font_cb1 (lplf
, lptm
, FontType
, lpef
)
5544 NEWTEXTMETRIC
* lptm
;
5548 return EnumFontFamilies (lpef
->hdc
,
5549 lplf
->elfLogFont
.lfFaceName
,
5550 (FONTENUMPROC
) enum_font_cb2
,
5555 /* Interface to fontset handler. (adapted from mw32font.c in Meadow
5556 and xterm.c in Emacs 20.3) */
5558 /* Return a list of names of available fonts matching PATTERN on frame
5559 F. If SIZE is not 0, it is the size (maximum bound width) of fonts
5560 to be listed. Frame F NULL means we have not yet created any
5561 frame, which means we can't get proper size info, as we don't have
5562 a device context to use for GetTextMetrics.
5563 MAXNAMES sets a limit on how many fonts to match. */
5566 w32_list_fonts (FRAME_PTR f
, Lisp_Object pattern
, int size
, int maxnames
)
5568 Lisp_Object patterns
, key
, tem
;
5569 Lisp_Object list
= Qnil
, newlist
= Qnil
, second_best
= Qnil
;
5571 /* If we don't have a frame, we can't use the Windows API to list
5572 fonts, as it requires a device context for the Window. This will
5573 only happen during startup if the user specifies a font on the
5574 command line. Print a message on stderr and return nil. */
5580 "Emacs cannot get a list of fonts before the initial frame "
5581 "is created.\nThe font specified on the command line may not "
5583 MessageBox (NULL
, buffer
, "Emacs Warning Dialog",
5584 MB_OK
| MB_ICONEXCLAMATION
| MB_TASKMODAL
);
5589 patterns
= Fassoc (pattern
, Valternate_fontname_alist
);
5590 if (NILP (patterns
))
5591 patterns
= Fcons (pattern
, Qnil
);
5593 for (; CONSP (patterns
); patterns
= XCONS (patterns
)->cdr
)
5597 pattern
= XCONS (patterns
)->car
;
5599 /* See if we cached the result for this particular query.
5600 The cache is an alist of the form:
5601 ((PATTERN (FONTNAME . WIDTH) ...) ...)
5604 (tem
= XCONS (FRAME_W32_DISPLAY_INFO (f
)->name_list_element
)->cdr
,
5605 !NILP (list
= Fassoc (pattern
, tem
))))
5607 list
= Fcdr_safe (list
);
5608 /* We have a cached list. Don't have to get the list again. */
5613 /* At first, put PATTERN in the cache. */
5615 ef
.pattern
= &pattern
;
5616 ef
.tail
= ef
.head
= &list
;
5618 x_to_w32_font (STRINGP (pattern
) ? XSTRING (pattern
)->data
:
5621 ef
.hdc
= GetDC (FRAME_W32_WINDOW (f
));
5623 EnumFontFamilies (ef
.hdc
, NULL
, (FONTENUMPROC
) enum_font_cb1
,
5626 ReleaseDC (FRAME_W32_WINDOW (f
), ef
.hdc
);
5631 /* Make a list of the fonts we got back.
5632 Store that in the font cache for the display. */
5634 XCONS (FRAME_W32_DISPLAY_INFO (f
)->name_list_element
)->cdr
5635 = Fcons (Fcons (pattern
, list
),
5636 XCONS (FRAME_W32_DISPLAY_INFO (f
)->name_list_element
)->cdr
);
5639 if (NILP (list
)) continue; /* Try the remaining alternatives. */
5641 newlist
= second_best
= Qnil
;
5643 /* Make a list of the fonts that have the right width. */
5644 for (; CONSP (list
); list
= XCONS (list
)->cdr
)
5647 tem
= XCONS (list
)->car
;
5651 if (NILP (XCONS (tem
)->car
))
5655 newlist
= Fcons (XCONS (tem
)->car
, newlist
);
5658 if (!INTEGERP (XCONS (tem
)->cdr
))
5660 /* Since we don't yet know the size of the font, we must
5661 load it and try GetTextMetrics. */
5662 struct w32_display_info
*dpyinfo
5663 = FRAME_W32_DISPLAY_INFO (f
);
5664 W32FontStruct thisinfo
;
5669 if (!x_to_w32_font (XSTRING (XCONS (tem
)->car
)->data
, &lf
))
5673 thisinfo
.hfont
= CreateFontIndirect (&lf
);
5674 if (thisinfo
.hfont
== NULL
)
5677 hdc
= GetDC (dpyinfo
->root_window
);
5678 oldobj
= SelectObject (hdc
, thisinfo
.hfont
);
5679 if (GetTextMetrics (hdc
, &thisinfo
.tm
))
5680 XCONS (tem
)->cdr
= make_number (FONT_WIDTH (&thisinfo
));
5682 XCONS (tem
)->cdr
= make_number (0);
5683 SelectObject (hdc
, oldobj
);
5684 ReleaseDC (dpyinfo
->root_window
, hdc
);
5685 DeleteObject(thisinfo
.hfont
);
5688 found_size
= XINT (XCONS (tem
)->cdr
);
5689 if (found_size
== size
)
5690 newlist
= Fcons (XCONS (tem
)->car
, newlist
);
5692 /* keep track of the closest matching size in case
5693 no exact match is found. */
5694 else if (found_size
> 0)
5696 if (NILP (second_best
))
5698 else if (found_size
< size
)
5700 if (XINT (XCONS (second_best
)->cdr
) > size
5701 || XINT (XCONS (second_best
)->cdr
) < found_size
)
5706 if (XINT (XCONS (second_best
)->cdr
) > size
5707 && XINT (XCONS (second_best
)->cdr
) >
5714 if (!NILP (newlist
))
5716 else if (!NILP (second_best
))
5718 newlist
= Fcons (XCONS (second_best
)->car
, Qnil
);
5726 /* Return a pointer to struct font_info of font FONT_IDX of frame F. */
5728 w32_get_font_info (f
, font_idx
)
5732 return (FRAME_W32_FONT_TABLE (f
) + font_idx
);
5737 w32_query_font (struct frame
*f
, char *fontname
)
5740 struct font_info
*pfi
;
5742 pfi
= FRAME_W32_FONT_TABLE (f
);
5744 for (i
= 0; i
< one_w32_display_info
.n_fonts
;i
++, pfi
++)
5746 if (strcmp(pfi
->name
, fontname
) == 0) return pfi
;
5752 /* Find a CCL program for a font specified by FONTP, and set the member
5753 `encoder' of the structure. */
5756 w32_find_ccl_program (fontp
)
5757 struct font_info
*fontp
;
5759 extern Lisp_Object Vfont_ccl_encoder_alist
, Vccl_program_table
;
5760 extern Lisp_Object Qccl_program_idx
;
5761 extern Lisp_Object
resolve_symbol_ccl_program ();
5762 Lisp_Object list
, elt
, ccl_prog
, ccl_id
;
5764 for (list
= Vfont_ccl_encoder_alist
; CONSP (list
); list
= XCONS (list
)->cdr
)
5766 elt
= XCONS (list
)->car
;
5768 && STRINGP (XCONS (elt
)->car
)
5769 && (fast_c_string_match_ignore_case (XCONS (elt
)->car
, fontp
->name
)
5772 if (SYMBOLP (XCONS (elt
)->cdr
) &&
5773 (!NILP (ccl_id
= Fget (XCONS (elt
)->cdr
, Qccl_program_idx
))))
5775 ccl_prog
= XVECTOR (Vccl_program_table
)->contents
[XUINT (ccl_id
)];
5776 if (!CONSP (ccl_prog
)) continue;
5777 ccl_prog
= XCONS (ccl_prog
)->cdr
;
5781 ccl_prog
= XCONS (elt
)->cdr
;
5782 if (!VECTORP (ccl_prog
)) continue;
5786 = (struct ccl_program
*) xmalloc (sizeof (struct ccl_program
));
5787 setup_ccl_program (fontp
->font_encoder
,
5788 resolve_symbol_ccl_program (ccl_prog
));
5796 #include "x-list-font.c"
5798 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 4, 0,
5799 "Return a list of the names of available fonts matching PATTERN.\n\
5800 If optional arguments FACE and FRAME are specified, return only fonts\n\
5801 the same size as FACE on FRAME.\n\
5803 PATTERN is a string, perhaps with wildcard characters;\n\
5804 the * character matches any substring, and\n\
5805 the ? character matches any single character.\n\
5806 PATTERN is case-insensitive.\n\
5807 FACE is a face name--a symbol.\n\
5809 The return value is a list of strings, suitable as arguments to\n\
5812 Fonts Emacs can't use (i.e. proportional fonts) may or may not be excluded\n\
5813 even if they match PATTERN and FACE.\n\
5815 The optional fourth argument MAXIMUM sets a limit on how many\n\
5816 fonts to match. The first MAXIMUM fonts are reported.")
5817 (pattern
, face
, frame
, maximum
)
5818 Lisp_Object pattern
, face
, frame
, maximum
;
5823 XFontStruct
*size_ref
;
5824 Lisp_Object namelist
;
5829 CHECK_STRING (pattern
, 0);
5831 CHECK_SYMBOL (face
, 1);
5833 f
= check_x_frame (frame
);
5835 /* Determine the width standard for comparison with the fonts we find. */
5843 /* Don't die if we get called with a terminal frame. */
5844 if (! FRAME_W32_P (f
))
5845 error ("non-w32 frame used in `x-list-fonts'");
5847 face_id
= face_name_id_number (f
, face
);
5849 if (face_id
< 0 || face_id
>= FRAME_N_PARAM_FACES (f
)
5850 || FRAME_PARAM_FACES (f
) [face_id
] == 0)
5851 size_ref
= f
->output_data
.w32
->font
;
5854 size_ref
= FRAME_PARAM_FACES (f
) [face_id
]->font
;
5855 if (size_ref
== (XFontStruct
*) (~0))
5856 size_ref
= f
->output_data
.w32
->font
;
5860 /* See if we cached the result for this particular query. */
5861 list
= Fassoc (pattern
,
5862 XCONS (FRAME_W32_DISPLAY_INFO (f
)->name_list_element
)->cdr
);
5864 /* We have info in the cache for this PATTERN. */
5867 Lisp_Object tem
, newlist
;
5869 /* We have info about this pattern. */
5870 list
= XCONS (list
)->cdr
;
5877 /* Filter the cached info and return just the fonts that match FACE. */
5879 for (tem
= list
; CONSP (tem
); tem
= XCONS (tem
)->cdr
)
5881 struct font_info
*fontinf
;
5882 XFontStruct
*thisinfo
= NULL
;
5884 fontinf
= w32_load_font (f
, XSTRING (XCONS (tem
)->car
)->data
, 0);
5886 thisinfo
= (XFontStruct
*)fontinf
->font
;
5887 if (thisinfo
&& same_size_fonts (thisinfo
, size_ref
))
5888 newlist
= Fcons (XCONS (tem
)->car
, newlist
);
5890 w32_unload_font (FRAME_W32_DISPLAY_INFO (f
), thisinfo
);
5901 ef
.pattern
= &pattern
;
5902 ef
.tail
= ef
.head
= &namelist
;
5904 x_to_w32_font (STRINGP (pattern
) ? XSTRING (pattern
)->data
: NULL
, &ef
.logfont
);
5907 ef
.hdc
= GetDC (FRAME_W32_WINDOW (f
));
5909 EnumFontFamilies (ef
.hdc
, NULL
, (FONTENUMPROC
) enum_font_cb1
, (LPARAM
)&ef
);
5911 ReleaseDC (FRAME_W32_WINDOW (f
), ef
.hdc
);
5921 /* Make a list of all the fonts we got back.
5922 Store that in the font cache for the display. */
5923 XCONS (FRAME_W32_DISPLAY_INFO (f
)->name_list_element
)->cdr
5924 = Fcons (Fcons (pattern
, namelist
),
5925 XCONS (FRAME_W32_DISPLAY_INFO (f
)->name_list_element
)->cdr
);
5927 /* Make a list of the fonts that have the right width. */
5930 for (i
= 0; i
< ef
.numFonts
; i
++)
5938 struct font_info
*fontinf
;
5939 XFontStruct
*thisinfo
= NULL
;
5942 fontinf
= w32_load_font (f
, XSTRING (Fcar (cur
))->data
, 0);
5944 thisinfo
= (XFontStruct
*)fontinf
->font
;
5946 keeper
= thisinfo
&& same_size_fonts (thisinfo
, size_ref
);
5948 w32_unload_font (FRAME_W32_DISPLAY_INFO (f
), thisinfo
);
5953 list
= Fcons (build_string (XSTRING (Fcar (cur
))->data
), list
);
5957 list
= Fnreverse (list
);
5964 DEFUN ("x-color-defined-p", Fx_color_defined_p
, Sx_color_defined_p
, 1, 2, 0,
5965 "Return non-nil if color COLOR is supported on frame FRAME.\n\
5966 If FRAME is omitted or nil, use the selected frame.")
5968 Lisp_Object color
, frame
;
5971 FRAME_PTR f
= check_x_frame (frame
);
5973 CHECK_STRING (color
, 1);
5975 if (defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
5981 DEFUN ("x-color-values", Fx_color_values
, Sx_color_values
, 1, 2, 0,
5982 "Return a description of the color named COLOR on frame FRAME.\n\
5983 The value is a list of integer RGB values--(RED GREEN BLUE).\n\
5984 These values appear to range from 0 to 65280 or 65535, depending\n\
5985 on the system; white is (65280 65280 65280) or (65535 65535 65535).\n\
5986 If FRAME is omitted or nil, use the selected frame.")
5988 Lisp_Object color
, frame
;
5991 FRAME_PTR f
= check_x_frame (frame
);
5993 CHECK_STRING (color
, 1);
5995 if (defined_color (f
, XSTRING (color
)->data
, &foo
, 0))
5999 rgb
[0] = make_number ((GetRValue (foo
) << 8) | GetRValue (foo
));
6000 rgb
[1] = make_number ((GetGValue (foo
) << 8) | GetGValue (foo
));
6001 rgb
[2] = make_number ((GetBValue (foo
) << 8) | GetBValue (foo
));
6002 return Flist (3, rgb
);
6008 DEFUN ("x-display-color-p", Fx_display_color_p
, Sx_display_color_p
, 0, 1, 0,
6009 "Return t if the X display supports color.\n\
6010 The optional argument DISPLAY specifies which display to ask about.\n\
6011 DISPLAY should be either a frame or a display name (a string).\n\
6012 If omitted or nil, that stands for the selected frame's display.")
6014 Lisp_Object display
;
6016 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6018 if ((dpyinfo
->n_planes
* dpyinfo
->n_cbits
) <= 2)
6024 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p
, Sx_display_grayscale_p
,
6026 "Return t if the X display supports shades of gray.\n\
6027 Note that color displays do support shades of gray.\n\
6028 The optional argument DISPLAY specifies which display to ask about.\n\
6029 DISPLAY should be either a frame or a display name (a string).\n\
6030 If omitted or nil, that stands for the selected frame's display.")
6032 Lisp_Object display
;
6034 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6036 if ((dpyinfo
->n_planes
* dpyinfo
->n_cbits
) <= 1)
6042 DEFUN ("x-display-pixel-width", Fx_display_pixel_width
, Sx_display_pixel_width
,
6044 "Returns the width in pixels of the X display DISPLAY.\n\
6045 The optional argument DISPLAY specifies which display to ask about.\n\
6046 DISPLAY should be either a frame or a display name (a string).\n\
6047 If omitted or nil, that stands for the selected frame's display.")
6049 Lisp_Object display
;
6051 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6053 return make_number (dpyinfo
->width
);
6056 DEFUN ("x-display-pixel-height", Fx_display_pixel_height
,
6057 Sx_display_pixel_height
, 0, 1, 0,
6058 "Returns the height in pixels of the X display DISPLAY.\n\
6059 The optional argument DISPLAY specifies which display to ask about.\n\
6060 DISPLAY should be either a frame or a display name (a string).\n\
6061 If omitted or nil, that stands for the selected frame's display.")
6063 Lisp_Object display
;
6065 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6067 return make_number (dpyinfo
->height
);
6070 DEFUN ("x-display-planes", Fx_display_planes
, Sx_display_planes
,
6072 "Returns the number of bitplanes of the display DISPLAY.\n\
6073 The optional argument DISPLAY specifies which display to ask about.\n\
6074 DISPLAY should be either a frame or a display name (a string).\n\
6075 If omitted or nil, that stands for the selected frame's display.")
6077 Lisp_Object display
;
6079 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6081 return make_number (dpyinfo
->n_planes
* dpyinfo
->n_cbits
);
6084 DEFUN ("x-display-color-cells", Fx_display_color_cells
, Sx_display_color_cells
,
6086 "Returns the number of color cells of the display DISPLAY.\n\
6087 The optional argument DISPLAY specifies which display to ask about.\n\
6088 DISPLAY should be either a frame or a display name (a string).\n\
6089 If omitted or nil, that stands for the selected frame's display.")
6091 Lisp_Object display
;
6093 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6097 hdc
= GetDC (dpyinfo
->root_window
);
6098 if (dpyinfo
->has_palette
)
6099 cap
= GetDeviceCaps (hdc
,SIZEPALETTE
);
6101 cap
= GetDeviceCaps (hdc
,NUMCOLORS
);
6103 ReleaseDC (dpyinfo
->root_window
, hdc
);
6105 return make_number (cap
);
6108 DEFUN ("x-server-max-request-size", Fx_server_max_request_size
,
6109 Sx_server_max_request_size
,
6111 "Returns the maximum request size of the server of display DISPLAY.\n\
6112 The optional argument DISPLAY specifies which display to ask about.\n\
6113 DISPLAY should be either a frame or a display name (a string).\n\
6114 If omitted or nil, that stands for the selected frame's display.")
6116 Lisp_Object display
;
6118 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6120 return make_number (1);
6123 DEFUN ("x-server-vendor", Fx_server_vendor
, Sx_server_vendor
, 0, 1, 0,
6124 "Returns the vendor ID string of the W32 system (Microsoft).\n\
6125 The optional argument DISPLAY specifies which display to ask about.\n\
6126 DISPLAY should be either a frame or a display name (a string).\n\
6127 If omitted or nil, that stands for the selected frame's display.")
6129 Lisp_Object display
;
6131 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6132 char *vendor
= "Microsoft Corp.";
6134 if (! vendor
) vendor
= "";
6135 return build_string (vendor
);
6138 DEFUN ("x-server-version", Fx_server_version
, Sx_server_version
, 0, 1, 0,
6139 "Returns the version numbers of the server of display DISPLAY.\n\
6140 The value is a list of three integers: the major and minor\n\
6141 version numbers, and the vendor-specific release\n\
6142 number. See also the function `x-server-vendor'.\n\n\
6143 The optional argument DISPLAY specifies which display to ask about.\n\
6144 DISPLAY should be either a frame or a display name (a string).\n\
6145 If omitted or nil, that stands for the selected frame's display.")
6147 Lisp_Object display
;
6149 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6151 return Fcons (make_number (w32_major_version
),
6152 Fcons (make_number (w32_minor_version
), Qnil
));
6155 DEFUN ("x-display-screens", Fx_display_screens
, Sx_display_screens
, 0, 1, 0,
6156 "Returns the number of screens on the server of display DISPLAY.\n\
6157 The optional argument DISPLAY specifies which display to ask about.\n\
6158 DISPLAY should be either a frame or a display name (a string).\n\
6159 If omitted or nil, that stands for the selected frame's display.")
6161 Lisp_Object display
;
6163 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6165 return make_number (1);
6168 DEFUN ("x-display-mm-height", Fx_display_mm_height
, Sx_display_mm_height
, 0, 1, 0,
6169 "Returns the height in millimeters of the X display DISPLAY.\n\
6170 The optional argument DISPLAY specifies which display to ask about.\n\
6171 DISPLAY should be either a frame or a display name (a string).\n\
6172 If omitted or nil, that stands for the selected frame's display.")
6174 Lisp_Object display
;
6176 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6180 hdc
= GetDC (dpyinfo
->root_window
);
6182 cap
= GetDeviceCaps (hdc
, VERTSIZE
);
6184 ReleaseDC (dpyinfo
->root_window
, hdc
);
6186 return make_number (cap
);
6189 DEFUN ("x-display-mm-width", Fx_display_mm_width
, Sx_display_mm_width
, 0, 1, 0,
6190 "Returns the width in millimeters of the X display DISPLAY.\n\
6191 The optional argument DISPLAY specifies which display to ask about.\n\
6192 DISPLAY should be either a frame or a display name (a string).\n\
6193 If omitted or nil, that stands for the selected frame's display.")
6195 Lisp_Object display
;
6197 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6202 hdc
= GetDC (dpyinfo
->root_window
);
6204 cap
= GetDeviceCaps (hdc
, HORZSIZE
);
6206 ReleaseDC (dpyinfo
->root_window
, hdc
);
6208 return make_number (cap
);
6211 DEFUN ("x-display-backing-store", Fx_display_backing_store
,
6212 Sx_display_backing_store
, 0, 1, 0,
6213 "Returns an indication of whether display DISPLAY does backing store.\n\
6214 The value may be `always', `when-mapped', or `not-useful'.\n\
6215 The optional argument DISPLAY specifies which display to ask about.\n\
6216 DISPLAY should be either a frame or a display name (a string).\n\
6217 If omitted or nil, that stands for the selected frame's display.")
6219 Lisp_Object display
;
6221 return intern ("not-useful");
6224 DEFUN ("x-display-visual-class", Fx_display_visual_class
,
6225 Sx_display_visual_class
, 0, 1, 0,
6226 "Returns the visual class of the display DISPLAY.\n\
6227 The value is one of the symbols `static-gray', `gray-scale',\n\
6228 `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
6229 The optional argument DISPLAY specifies which display to ask about.\n\
6230 DISPLAY should be either a frame or a display name (a string).\n\
6231 If omitted or nil, that stands for the selected frame's display.")
6233 Lisp_Object display
;
6235 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6238 switch (dpyinfo
->visual
->class)
6240 case StaticGray
: return (intern ("static-gray"));
6241 case GrayScale
: return (intern ("gray-scale"));
6242 case StaticColor
: return (intern ("static-color"));
6243 case PseudoColor
: return (intern ("pseudo-color"));
6244 case TrueColor
: return (intern ("true-color"));
6245 case DirectColor
: return (intern ("direct-color"));
6247 error ("Display has an unknown visual class");
6251 error ("Display has an unknown visual class");
6254 DEFUN ("x-display-save-under", Fx_display_save_under
,
6255 Sx_display_save_under
, 0, 1, 0,
6256 "Returns t if the display DISPLAY supports the save-under feature.\n\
6257 The optional argument DISPLAY specifies which display to ask about.\n\
6258 DISPLAY should be either a frame or a display name (a string).\n\
6259 If omitted or nil, that stands for the selected frame's display.")
6261 Lisp_Object display
;
6263 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6270 register struct frame
*f
;
6272 return PIXEL_WIDTH (f
);
6277 register struct frame
*f
;
6279 return PIXEL_HEIGHT (f
);
6284 register struct frame
*f
;
6286 return FONT_WIDTH (f
->output_data
.w32
->font
);
6291 register struct frame
*f
;
6293 return f
->output_data
.w32
->line_height
;
6297 x_screen_planes (frame
)
6300 return (FRAME_W32_DISPLAY_INFO (XFRAME (frame
))->n_planes
*
6301 FRAME_W32_DISPLAY_INFO (XFRAME (frame
))->n_cbits
);
6304 /* Return the display structure for the display named NAME.
6305 Open a new connection if necessary. */
6307 struct w32_display_info
*
6308 x_display_info_for_name (name
)
6312 struct w32_display_info
*dpyinfo
;
6314 CHECK_STRING (name
, 0);
6316 for (dpyinfo
= &one_w32_display_info
, names
= w32_display_name_list
;
6318 dpyinfo
= dpyinfo
->next
, names
= XCONS (names
)->cdr
)
6321 tem
= Fstring_equal (XCONS (XCONS (names
)->car
)->car
, name
);
6326 /* Use this general default value to start with. */
6327 Vx_resource_name
= Vinvocation_name
;
6329 validate_x_resource_name ();
6331 dpyinfo
= w32_term_init (name
, (unsigned char *)0,
6332 (char *) XSTRING (Vx_resource_name
)->data
);
6335 error ("Cannot connect to server %s", XSTRING (name
)->data
);
6338 XSETFASTINT (Vwindow_system_version
, 3);
6343 DEFUN ("x-open-connection", Fx_open_connection
, Sx_open_connection
,
6344 1, 3, 0, "Open a connection to a server.\n\
6345 DISPLAY is the name of the display to connect to.\n\
6346 Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
6347 If the optional third arg MUST-SUCCEED is non-nil,\n\
6348 terminate Emacs if we can't open the connection.")
6349 (display
, xrm_string
, must_succeed
)
6350 Lisp_Object display
, xrm_string
, must_succeed
;
6352 unsigned int n_planes
;
6353 unsigned char *xrm_option
;
6354 struct w32_display_info
*dpyinfo
;
6356 CHECK_STRING (display
, 0);
6357 if (! NILP (xrm_string
))
6358 CHECK_STRING (xrm_string
, 1);
6360 if (! EQ (Vwindow_system
, intern ("w32")))
6361 error ("Not using Microsoft Windows");
6363 /* Allow color mapping to be defined externally; first look in user's
6364 HOME directory, then in Emacs etc dir for a file called rgb.txt. */
6366 Lisp_Object color_file
;
6367 struct gcpro gcpro1
;
6369 color_file
= build_string("~/rgb.txt");
6371 GCPRO1 (color_file
);
6373 if (NILP (Ffile_readable_p (color_file
)))
6375 Fexpand_file_name (build_string ("rgb.txt"),
6376 Fsymbol_value (intern ("data-directory")));
6378 Vw32_color_map
= Fw32_load_color_file (color_file
);
6382 if (NILP (Vw32_color_map
))
6383 Vw32_color_map
= Fw32_default_color_map ();
6385 if (! NILP (xrm_string
))
6386 xrm_option
= (unsigned char *) XSTRING (xrm_string
)->data
;
6388 xrm_option
= (unsigned char *) 0;
6390 /* Use this general default value to start with. */
6391 /* First remove .exe suffix from invocation-name - it looks ugly. */
6393 char basename
[ MAX_PATH
], *str
;
6395 strcpy (basename
, XSTRING (Vinvocation_name
)->data
);
6396 str
= strrchr (basename
, '.');
6398 Vinvocation_name
= build_string (basename
);
6400 Vx_resource_name
= Vinvocation_name
;
6402 validate_x_resource_name ();
6404 /* This is what opens the connection and sets x_current_display.
6405 This also initializes many symbols, such as those used for input. */
6406 dpyinfo
= w32_term_init (display
, xrm_option
,
6407 (char *) XSTRING (Vx_resource_name
)->data
);
6411 if (!NILP (must_succeed
))
6412 fatal ("Cannot connect to server %s.\n",
6413 XSTRING (display
)->data
);
6415 error ("Cannot connect to server %s", XSTRING (display
)->data
);
6420 XSETFASTINT (Vwindow_system_version
, 3);
6424 DEFUN ("x-close-connection", Fx_close_connection
,
6425 Sx_close_connection
, 1, 1, 0,
6426 "Close the connection to DISPLAY's server.\n\
6427 For DISPLAY, specify either a frame or a display name (a string).\n\
6428 If DISPLAY is nil, that stands for the selected frame's display.")
6430 Lisp_Object display
;
6432 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6433 struct w32_display_info
*tail
;
6436 if (dpyinfo
->reference_count
> 0)
6437 error ("Display still has frames on it");
6440 /* Free the fonts in the font table. */
6441 for (i
= 0; i
< dpyinfo
->n_fonts
; i
++)
6443 if (dpyinfo
->font_table
[i
].name
)
6444 free (dpyinfo
->font_table
[i
].name
);
6445 /* Don't free the full_name string;
6446 it is always shared with something else. */
6447 w32_unload_font (dpyinfo
, dpyinfo
->font_table
[i
].font
);
6449 x_destroy_all_bitmaps (dpyinfo
);
6451 x_delete_display (dpyinfo
);
6457 DEFUN ("x-display-list", Fx_display_list
, Sx_display_list
, 0, 0, 0,
6458 "Return the list of display names that Emacs has connections to.")
6461 Lisp_Object tail
, result
;
6464 for (tail
= w32_display_name_list
; ! NILP (tail
); tail
= XCONS (tail
)->cdr
)
6465 result
= Fcons (XCONS (XCONS (tail
)->car
)->car
, result
);
6470 DEFUN ("x-synchronize", Fx_synchronize
, Sx_synchronize
, 1, 2, 0,
6471 "If ON is non-nil, report errors as soon as the erring request is made.\n\
6472 If ON is nil, allow buffering of requests.\n\
6473 This is a noop on W32 systems.\n\
6474 The optional second argument DISPLAY specifies which display to act on.\n\
6475 DISPLAY should be either a frame or a display name (a string).\n\
6476 If DISPLAY is omitted or nil, that stands for the selected frame's display.")
6478 Lisp_Object display
, on
;
6480 struct w32_display_info
*dpyinfo
= check_x_display_info (display
);
6486 /* These are the w32 specialized functions */
6488 DEFUN ("w32-select-font", Fw32_select_font
, Sw32_select_font
, 0, 1, 0,
6489 "This will display the W32 font dialog and return an X font string corresponding to the selection.")
6493 FRAME_PTR f
= check_x_frame (frame
);
6498 bzero (&cf
, sizeof (cf
));
6500 cf
.lStructSize
= sizeof (cf
);
6501 cf
.hwndOwner
= FRAME_W32_WINDOW (f
);
6502 cf
.Flags
= CF_FIXEDPITCHONLY
| CF_FORCEFONTEXIST
| CF_SCREENFONTS
;
6505 if (!ChooseFont (&cf
) || !w32_to_x_font (&lf
, buf
, 100))
6508 return build_string (buf
);
6511 DEFUN ("w32-send-sys-command", Fw32_send_sys_command
, Sw32_send_sys_command
, 1, 2, 0,
6512 "Send frame a Windows WM_SYSCOMMAND message of type COMMAND.\n\
6513 Some useful values for command are 0xf030 to maximise frame (0xf020\n\
6514 to minimize), 0xf120 to restore frame to original size, and 0xf100\n\
6515 to activate the menubar for keyboard access. 0xf140 activates the\n\
6516 screen saver if defined.\n\
6518 If optional parameter FRAME is not specified, use selected frame.")
6520 Lisp_Object command
, frame
;
6523 FRAME_PTR f
= check_x_frame (frame
);
6525 CHECK_NUMBER (command
, 0);
6527 PostMessage (FRAME_W32_WINDOW (f
), WM_SYSCOMMAND
, XINT (command
), 0);
6532 /* Lookup virtual keycode from string representing the name of a
6533 non-ascii keystroke into the corresponding virtual key, using
6534 lispy_function_keys. */
6536 lookup_vk_code (char *key
)
6540 for (i
= 0; i
< 256; i
++)
6541 if (lispy_function_keys
[i
] != 0
6542 && strcmp (lispy_function_keys
[i
], key
) == 0)
6548 /* Convert a one-element vector style key sequence to a hot key
6551 w32_parse_hot_key (key
)
6554 /* Copied from Fdefine_key and store_in_keymap. */
6555 register Lisp_Object c
;
6559 struct gcpro gcpro1
;
6561 CHECK_VECTOR (key
, 0);
6563 if (XFASTINT (Flength (key
)) != 1)
6568 c
= Faref (key
, make_number (0));
6570 if (CONSP (c
) && lucid_event_type_list_p (c
))
6571 c
= Fevent_convert_list (c
);
6575 if (! INTEGERP (c
) && ! SYMBOLP (c
))
6576 error ("Key definition is invalid");
6578 /* Work out the base key and the modifiers. */
6581 c
= parse_modifiers (c
);
6582 lisp_modifiers
= Fcar (Fcdr (c
));
6586 vk_code
= lookup_vk_code (XSYMBOL (c
)->name
->data
);
6588 else if (INTEGERP (c
))
6590 lisp_modifiers
= XINT (c
) & ~CHARACTERBITS
;
6591 /* Many ascii characters are their own virtual key code. */
6592 vk_code
= XINT (c
) & CHARACTERBITS
;
6595 if (vk_code
< 0 || vk_code
> 255)
6598 if ((lisp_modifiers
& meta_modifier
) != 0
6599 && !NILP (Vw32_alt_is_meta
))
6600 lisp_modifiers
|= alt_modifier
;
6602 /* Convert lisp modifiers to Windows hot-key form. */
6603 w32_modifiers
= (lisp_modifiers
& hyper_modifier
) ? MOD_WIN
: 0;
6604 w32_modifiers
|= (lisp_modifiers
& alt_modifier
) ? MOD_ALT
: 0;
6605 w32_modifiers
|= (lisp_modifiers
& ctrl_modifier
) ? MOD_CONTROL
: 0;
6606 w32_modifiers
|= (lisp_modifiers
& shift_modifier
) ? MOD_SHIFT
: 0;
6608 return HOTKEY (vk_code
, w32_modifiers
);
6611 DEFUN ("w32-register-hot-key", Fw32_register_hot_key
, Sw32_register_hot_key
, 1, 1, 0,
6612 "Register KEY as a hot-key combination.\n\
6613 Certain key combinations like Alt-Tab are reserved for system use on\n\
6614 Windows, and therefore are normally intercepted by the system. However,\n\
6615 most of these key combinations can be received by registering them as\n\
6616 hot-keys, overriding their special meaning.\n\
6618 KEY must be a one element key definition in vector form that would be\n\
6619 acceptable to `define-key' (e.g. [A-tab] for Alt-Tab). The meta\n\
6620 modifier is interpreted as Alt if `w32-alt-is-meta' is t, and hyper\n\
6621 is always interpreted as the Windows modifier keys.\n\
6623 The return value is the hotkey-id if registered, otherwise nil.")
6627 key
= w32_parse_hot_key (key
);
6629 if (NILP (Fmemq (key
, w32_grabbed_keys
)))
6631 /* Reuse an empty slot if possible. */
6632 Lisp_Object item
= Fmemq (Qnil
, w32_grabbed_keys
);
6634 /* Safe to add new key to list, even if we have focus. */
6636 w32_grabbed_keys
= Fcons (key
, w32_grabbed_keys
);
6640 /* Notify input thread about new hot-key definition, so that it
6641 takes effect without needing to switch focus. */
6642 PostThreadMessage (dwWindowsThreadId
, WM_EMACS_REGISTER_HOT_KEY
,
6649 DEFUN ("w32-unregister-hot-key", Fw32_unregister_hot_key
, Sw32_unregister_hot_key
, 1, 1, 0,
6650 "Unregister HOTKEY as a hot-key combination.")
6656 if (!INTEGERP (key
))
6657 key
= w32_parse_hot_key (key
);
6659 item
= Fmemq (key
, w32_grabbed_keys
);
6663 /* Notify input thread about hot-key definition being removed, so
6664 that it takes effect without needing focus switch. */
6665 if (PostThreadMessage (dwWindowsThreadId
, WM_EMACS_UNREGISTER_HOT_KEY
,
6666 (WPARAM
) XINT (XCAR (item
)), (LPARAM
) item
))
6669 GetMessage (&msg
, NULL
, WM_EMACS_DONE
, WM_EMACS_DONE
);
6676 DEFUN ("w32-registered-hot-keys", Fw32_registered_hot_keys
, Sw32_registered_hot_keys
, 0, 0, 0,
6677 "Return list of registered hot-key IDs.")
6680 return Fcopy_sequence (w32_grabbed_keys
);
6683 DEFUN ("w32-reconstruct-hot-key", Fw32_reconstruct_hot_key
, Sw32_reconstruct_hot_key
, 1, 1, 0,
6684 "Convert hot-key ID to a lisp key combination.")
6686 Lisp_Object hotkeyid
;
6688 int vk_code
, w32_modifiers
;
6691 CHECK_NUMBER (hotkeyid
, 0);
6693 vk_code
= HOTKEY_VK_CODE (hotkeyid
);
6694 w32_modifiers
= HOTKEY_MODIFIERS (hotkeyid
);
6696 if (lispy_function_keys
[vk_code
])
6697 key
= intern (lispy_function_keys
[vk_code
]);
6699 key
= make_number (vk_code
);
6701 key
= Fcons (key
, Qnil
);
6702 if (w32_modifiers
& MOD_SHIFT
)
6703 key
= Fcons (intern ("shift"), key
);
6704 if (w32_modifiers
& MOD_CONTROL
)
6705 key
= Fcons (intern ("control"), key
);
6706 if (w32_modifiers
& MOD_ALT
)
6707 key
= Fcons (intern (NILP (Vw32_alt_is_meta
) ? "alt" : "meta"), key
);
6708 if (w32_modifiers
& MOD_WIN
)
6709 key
= Fcons (intern ("hyper"), key
);
6714 DEFUN ("w32-toggle-lock-key", Fw32_toggle_lock_key
, Sw32_toggle_lock_key
, 1, 2, 0,
6715 "Toggle the state of the lock key KEY.\n\
6716 KEY can be `capslock', `kp-numlock', or `scroll'.\n\
6717 If the optional parameter NEW-STATE is a number, then the state of KEY\n\
6718 is set to off if the low bit of NEW-STATE is zero, otherwise on.")
6720 Lisp_Object key
, new_state
;
6725 if (EQ (key
, intern ("capslock")))
6726 vk_code
= VK_CAPITAL
;
6727 else if (EQ (key
, intern ("kp-numlock")))
6728 vk_code
= VK_NUMLOCK
;
6729 else if (EQ (key
, intern ("scroll")))
6730 vk_code
= VK_SCROLL
;
6734 if (!dwWindowsThreadId
)
6735 return make_number (w32_console_toggle_lock_key (vk_code
, new_state
));
6737 if (PostThreadMessage (dwWindowsThreadId
, WM_EMACS_TOGGLE_LOCK_KEY
,
6738 (WPARAM
) vk_code
, (LPARAM
) new_state
))
6741 GetMessage (&msg
, NULL
, WM_EMACS_DONE
, WM_EMACS_DONE
);
6742 return make_number (msg
.wParam
);
6749 /* This is zero if not using MS-Windows. */
6752 /* The section below is built by the lisp expression at the top of the file,
6753 just above where these variables are declared. */
6754 /*&&& init symbols here &&&*/
6755 Qauto_raise
= intern ("auto-raise");
6756 staticpro (&Qauto_raise
);
6757 Qauto_lower
= intern ("auto-lower");
6758 staticpro (&Qauto_lower
);
6759 Qbackground_color
= intern ("background-color");
6760 staticpro (&Qbackground_color
);
6761 Qbar
= intern ("bar");
6763 Qborder_color
= intern ("border-color");
6764 staticpro (&Qborder_color
);
6765 Qborder_width
= intern ("border-width");
6766 staticpro (&Qborder_width
);
6767 Qbox
= intern ("box");
6769 Qcursor_color
= intern ("cursor-color");
6770 staticpro (&Qcursor_color
);
6771 Qcursor_type
= intern ("cursor-type");
6772 staticpro (&Qcursor_type
);
6773 Qforeground_color
= intern ("foreground-color");
6774 staticpro (&Qforeground_color
);
6775 Qgeometry
= intern ("geometry");
6776 staticpro (&Qgeometry
);
6777 Qicon_left
= intern ("icon-left");
6778 staticpro (&Qicon_left
);
6779 Qicon_top
= intern ("icon-top");
6780 staticpro (&Qicon_top
);
6781 Qicon_type
= intern ("icon-type");
6782 staticpro (&Qicon_type
);
6783 Qicon_name
= intern ("icon-name");
6784 staticpro (&Qicon_name
);
6785 Qinternal_border_width
= intern ("internal-border-width");
6786 staticpro (&Qinternal_border_width
);
6787 Qleft
= intern ("left");
6789 Qright
= intern ("right");
6790 staticpro (&Qright
);
6791 Qmouse_color
= intern ("mouse-color");
6792 staticpro (&Qmouse_color
);
6793 Qnone
= intern ("none");
6795 Qparent_id
= intern ("parent-id");
6796 staticpro (&Qparent_id
);
6797 Qscroll_bar_width
= intern ("scroll-bar-width");
6798 staticpro (&Qscroll_bar_width
);
6799 Qsuppress_icon
= intern ("suppress-icon");
6800 staticpro (&Qsuppress_icon
);
6801 Qtop
= intern ("top");
6803 Qundefined_color
= intern ("undefined-color");
6804 staticpro (&Qundefined_color
);
6805 Qvertical_scroll_bars
= intern ("vertical-scroll-bars");
6806 staticpro (&Qvertical_scroll_bars
);
6807 Qvisibility
= intern ("visibility");
6808 staticpro (&Qvisibility
);
6809 Qwindow_id
= intern ("window-id");
6810 staticpro (&Qwindow_id
);
6811 Qx_frame_parameter
= intern ("x-frame-parameter");
6812 staticpro (&Qx_frame_parameter
);
6813 Qx_resource_name
= intern ("x-resource-name");
6814 staticpro (&Qx_resource_name
);
6815 Quser_position
= intern ("user-position");
6816 staticpro (&Quser_position
);
6817 Quser_size
= intern ("user-size");
6818 staticpro (&Quser_size
);
6819 Qdisplay
= intern ("display");
6820 staticpro (&Qdisplay
);
6821 /* This is the end of symbol initialization. */
6823 Qhyper
= intern ("hyper");
6824 staticpro (&Qhyper
);
6825 Qsuper
= intern ("super");
6826 staticpro (&Qsuper
);
6827 Qmeta
= intern ("meta");
6829 Qalt
= intern ("alt");
6831 Qctrl
= intern ("ctrl");
6833 Qcontrol
= intern ("control");
6834 staticpro (&Qcontrol
);
6835 Qshift
= intern ("shift");
6836 staticpro (&Qshift
);
6838 Qface_set_after_frame_default
= intern ("face-set-after-frame-default");
6839 staticpro (&Qface_set_after_frame_default
);
6841 Fput (Qundefined_color
, Qerror_conditions
,
6842 Fcons (Qundefined_color
, Fcons (Qerror
, Qnil
)));
6843 Fput (Qundefined_color
, Qerror_message
,
6844 build_string ("Undefined color"));
6846 staticpro (&w32_grabbed_keys
);
6847 w32_grabbed_keys
= Qnil
;
6849 DEFVAR_LISP ("w32-color-map", &Vw32_color_map
,
6850 "An array of color name mappings for windows.");
6851 Vw32_color_map
= Qnil
;
6853 DEFVAR_LISP ("w32-pass-alt-to-system", &Vw32_pass_alt_to_system
,
6854 "Non-nil if alt key presses are passed on to Windows.\n\
6855 When non-nil, for example, alt pressed and released and then space will\n\
6856 open the System menu. When nil, Emacs silently swallows alt key events.");
6857 Vw32_pass_alt_to_system
= Qnil
;
6859 DEFVAR_LISP ("w32-alt-is-meta", &Vw32_alt_is_meta
,
6860 "Non-nil if the alt key is to be considered the same as the meta key.\n\
6861 When nil, Emacs will translate the alt key to the Alt modifier, and not Meta.");
6862 Vw32_alt_is_meta
= Qt
;
6864 DEFVAR_LISP ("w32-pass-lwindow-to-system",
6865 &Vw32_pass_lwindow_to_system
,
6866 "Non-nil if the left \"Windows\" key is passed on to Windows.\n\
6867 When non-nil, the Start menu is opened by tapping the key.");
6868 Vw32_pass_lwindow_to_system
= Qt
;
6870 DEFVAR_LISP ("w32-pass-rwindow-to-system",
6871 &Vw32_pass_rwindow_to_system
,
6872 "Non-nil if the right \"Windows\" key is passed on to Windows.\n\
6873 When non-nil, the Start menu is opened by tapping the key.");
6874 Vw32_pass_rwindow_to_system
= Qt
;
6876 DEFVAR_INT ("w32-phantom-key-code",
6877 &Vw32_phantom_key_code
,
6878 "Virtual key code used to generate \"phantom\" key presses.\n\
6879 Value is a number between 0 and 255.\n\
6881 Phantom key presses are generated in order to stop the system from\n\
6882 acting on \"Windows\" key events when `w32-pass-lwindow-to-system' or\n\
6883 `w32-pass-rwindow-to-system' is nil.");
6884 Vw32_phantom_key_code
= VK_SPACE
;
6886 DEFVAR_LISP ("w32-enable-num-lock",
6887 &Vw32_enable_num_lock
,
6888 "Non-nil if Num Lock should act normally.\n\
6889 Set to nil to see Num Lock as the key `kp-numlock'.");
6890 Vw32_enable_num_lock
= Qt
;
6892 DEFVAR_LISP ("w32-enable-caps-lock",
6893 &Vw32_enable_caps_lock
,
6894 "Non-nil if Caps Lock should act normally.\n\
6895 Set to nil to see Caps Lock as the key `capslock'.");
6896 Vw32_enable_caps_lock
= Qt
;
6898 DEFVAR_LISP ("w32-scroll-lock-modifier",
6899 &Vw32_scroll_lock_modifier
,
6900 "Modifier to use for the Scroll Lock on state.\n\
6901 The value can be hyper, super, meta, alt, control or shift for the\n\
6902 respective modifier, or nil to see Scroll Lock as the key `scroll'.\n\
6903 Any other value will cause the key to be ignored.");
6904 Vw32_scroll_lock_modifier
= Qt
;
6906 DEFVAR_LISP ("w32-lwindow-modifier",
6907 &Vw32_lwindow_modifier
,
6908 "Modifier to use for the left \"Windows\" key.\n\
6909 The value can be hyper, super, meta, alt, control or shift for the\n\
6910 respective modifier, or nil to appear as the key `lwindow'.\n\
6911 Any other value will cause the key to be ignored.");
6912 Vw32_lwindow_modifier
= Qnil
;
6914 DEFVAR_LISP ("w32-rwindow-modifier",
6915 &Vw32_rwindow_modifier
,
6916 "Modifier to use for the right \"Windows\" key.\n\
6917 The value can be hyper, super, meta, alt, control or shift for the\n\
6918 respective modifier, or nil to appear as the key `rwindow'.\n\
6919 Any other value will cause the key to be ignored.");
6920 Vw32_rwindow_modifier
= Qnil
;
6922 DEFVAR_LISP ("w32-apps-modifier",
6923 &Vw32_apps_modifier
,
6924 "Modifier to use for the \"Apps\" key.\n\
6925 The value can be hyper, super, meta, alt, control or shift for the\n\
6926 respective modifier, or nil to appear as the key `apps'.\n\
6927 Any other value will cause the key to be ignored.");
6928 Vw32_apps_modifier
= Qnil
;
6930 DEFVAR_LISP ("w32-enable-italics", &Vw32_enable_italics
,
6931 "Non-nil enables selection of artificially italicized fonts.");
6932 Vw32_enable_italics
= Qnil
;
6934 DEFVAR_LISP ("w32-enable-palette", &Vw32_enable_palette
,
6935 "Non-nil enables Windows palette management to map colors exactly.");
6936 Vw32_enable_palette
= Qt
;
6938 DEFVAR_INT ("w32-mouse-button-tolerance",
6939 &Vw32_mouse_button_tolerance
,
6940 "Analogue of double click interval for faking middle mouse events.\n\
6941 The value is the minimum time in milliseconds that must elapse between\n\
6942 left/right button down events before they are considered distinct events.\n\
6943 If both mouse buttons are depressed within this interval, a middle mouse\n\
6944 button down event is generated instead.");
6945 XSETINT (Vw32_mouse_button_tolerance
, GetDoubleClickTime () / 2);
6947 DEFVAR_INT ("w32-mouse-move-interval",
6948 &Vw32_mouse_move_interval
,
6949 "Minimum interval between mouse move events.\n\
6950 The value is the minimum time in milliseconds that must elapse between\n\
6951 successive mouse move (or scroll bar drag) events before they are\n\
6952 reported as lisp events.");
6953 XSETINT (Vw32_mouse_move_interval
, 50);
6955 init_x_parm_symbols ();
6957 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path
,
6958 "List of directories to search for bitmap files for w32.");
6959 Vx_bitmap_file_path
= decode_env_path ((char *) 0, "PATH");
6961 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape
,
6962 "The shape of the pointer when over text.\n\
6963 Changing the value does not affect existing frames\n\
6964 unless you set the mouse color.");
6965 Vx_pointer_shape
= Qnil
;
6967 DEFVAR_LISP ("x-resource-name", &Vx_resource_name
,
6968 "The name Emacs uses to look up resources; for internal use only.\n\
6969 `x-get-resource' uses this as the first component of the instance name\n\
6970 when requesting resource values.\n\
6971 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
6972 was invoked, or to the value specified with the `-name' or `-rn'\n\
6973 switches, if present.");
6974 Vx_resource_name
= Qnil
;
6976 Vx_nontext_pointer_shape
= Qnil
;
6978 Vx_mode_pointer_shape
= Qnil
;
6980 DEFVAR_INT ("x-sensitive-text-pointer-shape",
6981 &Vx_sensitive_text_pointer_shape
,
6982 "The shape of the pointer when over mouse-sensitive text.\n\
6983 This variable takes effect when you create a new frame\n\
6984 or when you set the mouse color.");
6985 Vx_sensitive_text_pointer_shape
= Qnil
;
6987 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel
,
6988 "A string indicating the foreground color of the cursor box.");
6989 Vx_cursor_fore_pixel
= Qnil
;
6991 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager
,
6992 "Non-nil if no window manager is in use.\n\
6993 Emacs doesn't try to figure this out; this is always nil\n\
6994 unless you set it to something else.");
6995 /* We don't have any way to find this out, so set it to nil
6996 and maybe the user would like to set it to t. */
6997 Vx_no_window_manager
= Qnil
;
6999 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
7000 &Vx_pixel_size_width_font_regexp
,
7001 "Regexp matching a font name whose width is the same as `PIXEL_SIZE'.\n\
7003 Since Emacs gets width of a font matching with this regexp from\n\
7004 PIXEL_SIZE field of the name, font finding mechanism gets faster for\n\
7005 such a font. This is especially effective for such large fonts as\n\
7006 Chinese, Japanese, and Korean.");
7007 Vx_pixel_size_width_font_regexp
= Qnil
;
7009 DEFVAR_BOOL ("unibyte-display-via-language-environment",
7010 &unibyte_display_via_language_environment
,
7011 "*Non-nil means display unibyte text according to language environment.\n\
7012 Specifically this means that unibyte non-ASCII characters\n\
7013 are displayed by converting them to the equivalent multibyte characters\n\
7014 according to the current language environment. As a result, they are\n\
7015 displayed according to the current fontset.");
7016 unibyte_display_via_language_environment
= 0;
7018 defsubr (&Sx_get_resource
);
7019 defsubr (&Sx_list_fonts
);
7020 defsubr (&Sx_display_color_p
);
7021 defsubr (&Sx_display_grayscale_p
);
7022 defsubr (&Sx_color_defined_p
);
7023 defsubr (&Sx_color_values
);
7024 defsubr (&Sx_server_max_request_size
);
7025 defsubr (&Sx_server_vendor
);
7026 defsubr (&Sx_server_version
);
7027 defsubr (&Sx_display_pixel_width
);
7028 defsubr (&Sx_display_pixel_height
);
7029 defsubr (&Sx_display_mm_width
);
7030 defsubr (&Sx_display_mm_height
);
7031 defsubr (&Sx_display_screens
);
7032 defsubr (&Sx_display_planes
);
7033 defsubr (&Sx_display_color_cells
);
7034 defsubr (&Sx_display_visual_class
);
7035 defsubr (&Sx_display_backing_store
);
7036 defsubr (&Sx_display_save_under
);
7037 defsubr (&Sx_parse_geometry
);
7038 defsubr (&Sx_create_frame
);
7039 defsubr (&Sx_open_connection
);
7040 defsubr (&Sx_close_connection
);
7041 defsubr (&Sx_display_list
);
7042 defsubr (&Sx_synchronize
);
7044 /* W32 specific functions */
7046 defsubr (&Sw32_focus_frame
);
7047 defsubr (&Sw32_select_font
);
7048 defsubr (&Sw32_define_rgb_color
);
7049 defsubr (&Sw32_default_color_map
);
7050 defsubr (&Sw32_load_color_file
);
7051 defsubr (&Sw32_send_sys_command
);
7052 defsubr (&Sw32_register_hot_key
);
7053 defsubr (&Sw32_unregister_hot_key
);
7054 defsubr (&Sw32_registered_hot_keys
);
7055 defsubr (&Sw32_reconstruct_hot_key
);
7056 defsubr (&Sw32_toggle_lock_key
);
7058 /* Setting callback functions for fontset handler. */
7059 get_font_info_func
= w32_get_font_info
;
7060 list_fonts_func
= w32_list_fonts
;
7061 load_font_func
= w32_load_font
;
7062 find_ccl_program_func
= w32_find_ccl_program
;
7063 query_font_func
= w32_query_font
;
7064 set_frame_fontset_func
= x_set_font
;
7065 check_window_system_func
= check_w32
;
7074 button
= MessageBox (NULL
,
7075 "A fatal error has occurred!\n\n"
7076 "Select Abort to exit, Retry to debug, Ignore to continue",
7077 "Emacs Abort Dialog",
7078 MB_ICONEXCLAMATION
| MB_TASKMODAL
7079 | MB_SETFOREGROUND
| MB_ABORTRETRYIGNORE
);
7094 /* For convenience when debugging. */
7098 return GetLastError ();