(setup-slovak-environment): Call latin-2's setup function.
[bpt/emacs.git] / src / w32fns.c
CommitLineData
e9e23e23 1/* Graphical user interface functions for the Microsoft W32 API.
8681157a 2 Copyright (C) 1989, 92, 93, 94, 95, 1996 Free Software Foundation, Inc.
ee78dc32
GV
3
4This file is part of GNU Emacs.
5
6GNU Emacs is free software; you can redistribute it and/or modify
7it under the terms of the GNU General Public License as published by
8the Free Software Foundation; either version 2, or (at your option)
9any later version.
10
11GNU Emacs is distributed in the hope that it will be useful,
12but WITHOUT ANY WARRANTY; without even the implied warranty of
13MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14GNU General Public License for more details.
15
16You should have received a copy of the GNU General Public License
17along with GNU Emacs; see the file COPYING. If not, write to
3b7ad313
EN
18the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19Boston, MA 02111-1307, USA. */
ee78dc32
GV
20
21/* Added by Kevin Gallo */
22
ee78dc32 23#include <config.h>
1edf84e7
GV
24
25#include <signal.h>
ee78dc32 26#include <stdio.h>
1edf84e7
GV
27#include <limits.h>
28#include <errno.h>
ee78dc32
GV
29
30#include "lisp.h"
31#include "w32term.h"
32#include "frame.h"
33#include "window.h"
34#include "buffer.h"
35#include "dispextern.h"
36#include "keyboard.h"
37#include "blockinput.h"
38#include "paths.h"
489f9371 39#include "w32heap.h"
ee78dc32
GV
40#include "termhooks.h"
41
42#include <commdlg.h>
cb9e33d4 43#include <shellapi.h>
ee78dc32
GV
44
45extern void abort ();
46extern void free_frame_menubar ();
47extern struct scroll_bar *x_window_to_scroll_bar ();
5ac45f98 48extern int quit_char;
ee78dc32
GV
49
50/* The colormap for converting color names to RGB values */
fbd6baed 51Lisp_Object Vw32_color_map;
ee78dc32 52
da36a4d6 53/* Non nil if alt key presses are passed on to Windows. */
fbd6baed 54Lisp_Object Vw32_pass_alt_to_system;
da36a4d6 55
8c205c63
RS
56/* Non nil if alt key is translated to meta_modifier, nil if it is translated
57 to alt_modifier. */
fbd6baed 58Lisp_Object Vw32_alt_is_meta;
8c205c63 59
da36a4d6
GV
60/* Non nil if left window, right window, and application key events
61 are passed on to Windows. */
fbd6baed 62Lisp_Object Vw32_pass_optional_keys_to_system;
da36a4d6 63
5ac45f98
GV
64/* Switch to control whether we inhibit requests for italicised fonts (which
65 are synthesized, look ugly, and are trashed by cursor movement under NT). */
fbd6baed 66Lisp_Object Vw32_enable_italics;
5ac45f98
GV
67
68/* Enable palette management. */
fbd6baed 69Lisp_Object Vw32_enable_palette;
5ac45f98
GV
70
71/* Control how close left/right button down events must be to
72 be converted to a middle button down event. */
fbd6baed 73Lisp_Object Vw32_mouse_button_tolerance;
5ac45f98 74
84fb1139
KH
75/* Minimum interval between mouse movement (and scroll bar drag)
76 events that are passed on to the event loop. */
fbd6baed 77Lisp_Object Vw32_mouse_move_interval;
84fb1139 78
ee78dc32
GV
79/* The name we're using in resource queries. */
80Lisp_Object Vx_resource_name;
81
82/* Non nil if no window manager is in use. */
83Lisp_Object Vx_no_window_manager;
84
85/* The background and shape of the mouse pointer, and shape when not
86 over text or in the modeline. */
87Lisp_Object Vx_pointer_shape, Vx_nontext_pointer_shape, Vx_mode_pointer_shape;
88/* The shape when over mouse-sensitive text. */
89Lisp_Object Vx_sensitive_text_pointer_shape;
90
91/* Color of chars displayed in cursor box. */
92Lisp_Object Vx_cursor_fore_pixel;
93
1edf84e7
GV
94/* Nonzero if using Windows. */
95static int w32_in_use;
96
ee78dc32
GV
97/* Search path for bitmap files. */
98Lisp_Object Vx_bitmap_file_path;
99
100/* Evaluate this expression to rebuild the section of syms_of_w32fns
101 that initializes and staticpros the symbols declared below. Note
102 that Emacs 18 has a bug that keeps C-x C-e from being able to
103 evaluate this expression.
104
105(progn
106 ;; Accumulate a list of the symbols we want to initialize from the
107 ;; declarations at the top of the file.
108 (goto-char (point-min))
109 (search-forward "/\*&&& symbols declared here &&&*\/\n")
110 (let (symbol-list)
111 (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)")
112 (setq symbol-list
113 (cons (buffer-substring (match-beginning 1) (match-end 1))
114 symbol-list))
115 (forward-line 1))
116 (setq symbol-list (nreverse symbol-list))
117 ;; Delete the section of syms_of_... where we initialize the symbols.
118 (search-forward "\n /\*&&& init symbols here &&&*\/\n")
119 (let ((start (point)))
120 (while (looking-at "^ Q")
121 (forward-line 2))
122 (kill-region start (point)))
123 ;; Write a new symbol initialization section.
124 (while symbol-list
125 (insert (format " %s = intern (\"" (car symbol-list)))
126 (let ((start (point)))
127 (insert (substring (car symbol-list) 1))
128 (subst-char-in-region start (point) ?_ ?-))
129 (insert (format "\");\n staticpro (&%s);\n" (car symbol-list)))
130 (setq symbol-list (cdr symbol-list)))))
131
132 */
133
134/*&&& symbols declared here &&&*/
135Lisp_Object Qauto_raise;
136Lisp_Object Qauto_lower;
137Lisp_Object Qbackground_color;
138Lisp_Object Qbar;
139Lisp_Object Qborder_color;
140Lisp_Object Qborder_width;
141Lisp_Object Qbox;
142Lisp_Object Qcursor_color;
143Lisp_Object Qcursor_type;
ee78dc32
GV
144Lisp_Object Qforeground_color;
145Lisp_Object Qgeometry;
146Lisp_Object Qicon_left;
147Lisp_Object Qicon_top;
148Lisp_Object Qicon_type;
149Lisp_Object Qicon_name;
150Lisp_Object Qinternal_border_width;
151Lisp_Object Qleft;
1026b400 152Lisp_Object Qright;
ee78dc32
GV
153Lisp_Object Qmouse_color;
154Lisp_Object Qnone;
155Lisp_Object Qparent_id;
156Lisp_Object Qscroll_bar_width;
157Lisp_Object Qsuppress_icon;
158Lisp_Object Qtop;
159Lisp_Object Qundefined_color;
160Lisp_Object Qvertical_scroll_bars;
161Lisp_Object Qvisibility;
162Lisp_Object Qwindow_id;
163Lisp_Object Qx_frame_parameter;
164Lisp_Object Qx_resource_name;
165Lisp_Object Quser_position;
166Lisp_Object Quser_size;
167Lisp_Object Qdisplay;
168
5ac45f98
GV
169/* State variables for emulating a three button mouse. */
170#define LMOUSE 1
171#define MMOUSE 2
172#define RMOUSE 4
173
174static int button_state = 0;
fbd6baed 175static W32Msg saved_mouse_button_msg;
84fb1139 176static unsigned mouse_button_timer; /* non-zero when timer is active */
fbd6baed 177static W32Msg saved_mouse_move_msg;
84fb1139
KH
178static unsigned mouse_move_timer;
179
93fbe8b7
GV
180/* W95 mousewheel handler */
181unsigned int msh_mousewheel = 0;
182
84fb1139
KH
183#define MOUSE_BUTTON_ID 1
184#define MOUSE_MOVE_ID 2
5ac45f98 185
ee78dc32
GV
186/* The below are defined in frame.c. */
187extern Lisp_Object Qheight, Qminibuffer, Qname, Qonly, Qwidth;
1edf84e7 188extern Lisp_Object Qunsplittable, Qmenu_bar_lines, Qbuffer_predicate, Qtitle;
ee78dc32
GV
189
190extern Lisp_Object Vwindow_system_version;
191
192extern Lisp_Object last_mouse_scroll_bar;
193extern int last_mouse_scroll_bar_pos;
5ac45f98 194
fbd6baed
GV
195/* From w32term.c. */
196extern Lisp_Object Vw32_num_mouse_buttons;
5ac45f98 197
ee78dc32 198\f
1edf84e7
GV
199/* Error if we are not connected to MS-Windows. */
200void
201check_w32 ()
202{
203 if (! w32_in_use)
204 error ("MS-Windows not in use or not initialized");
205}
206
207/* Nonzero if we can use mouse menus.
208 You should not call this unless HAVE_MENUS is defined. */
209
210int
211have_menus_p ()
212{
213 return w32_in_use;
214}
215
ee78dc32 216/* Extract a frame as a FRAME_PTR, defaulting to the selected frame
fbd6baed 217 and checking validity for W32. */
ee78dc32
GV
218
219FRAME_PTR
220check_x_frame (frame)
221 Lisp_Object frame;
222{
223 FRAME_PTR f;
224
225 if (NILP (frame))
226 f = selected_frame;
227 else
228 {
229 CHECK_LIVE_FRAME (frame, 0);
230 f = XFRAME (frame);
231 }
fbd6baed
GV
232 if (! FRAME_W32_P (f))
233 error ("non-w32 frame used");
ee78dc32
GV
234 return f;
235}
236
237/* Let the user specify an display with a frame.
fbd6baed 238 nil stands for the selected frame--or, if that is not a w32 frame,
ee78dc32
GV
239 the first display on the list. */
240
fbd6baed 241static struct w32_display_info *
ee78dc32
GV
242check_x_display_info (frame)
243 Lisp_Object frame;
244{
245 if (NILP (frame))
246 {
fbd6baed
GV
247 if (FRAME_W32_P (selected_frame))
248 return FRAME_W32_DISPLAY_INFO (selected_frame);
ee78dc32 249 else
fbd6baed 250 return &one_w32_display_info;
ee78dc32
GV
251 }
252 else if (STRINGP (frame))
253 return x_display_info_for_name (frame);
254 else
255 {
256 FRAME_PTR f;
257
258 CHECK_LIVE_FRAME (frame, 0);
259 f = XFRAME (frame);
fbd6baed
GV
260 if (! FRAME_W32_P (f))
261 error ("non-w32 frame used");
262 return FRAME_W32_DISPLAY_INFO (f);
ee78dc32
GV
263 }
264}
265\f
fbd6baed 266/* Return the Emacs frame-object corresponding to an w32 window.
ee78dc32
GV
267 It could be the frame's main window or an icon window. */
268
269/* This function can be called during GC, so use GC_xxx type test macros. */
270
271struct frame *
272x_window_to_frame (dpyinfo, wdesc)
fbd6baed 273 struct w32_display_info *dpyinfo;
ee78dc32
GV
274 HWND wdesc;
275{
276 Lisp_Object tail, frame;
277 struct frame *f;
278
279 for (tail = Vframe_list; GC_CONSP (tail); tail = XCONS (tail)->cdr)
280 {
281 frame = XCONS (tail)->car;
282 if (!GC_FRAMEP (frame))
283 continue;
284 f = XFRAME (frame);
285 if (f->output_data.nothing == 1
fbd6baed 286 || FRAME_W32_DISPLAY_INFO (f) != dpyinfo)
ee78dc32 287 continue;
fbd6baed 288 if (FRAME_W32_WINDOW (f) == wdesc)
ee78dc32
GV
289 return f;
290 }
291 return 0;
292}
293
294\f
295
296/* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
297 id, which is just an int that this section returns. Bitmaps are
298 reference counted so they can be shared among frames.
299
300 Bitmap indices are guaranteed to be > 0, so a negative number can
301 be used to indicate no bitmap.
302
303 If you use x_create_bitmap_from_data, then you must keep track of
304 the bitmaps yourself. That is, creating a bitmap from the same
305 data more than once will not be caught. */
306
307
308/* Functions to access the contents of a bitmap, given an id. */
309
310int
311x_bitmap_height (f, id)
312 FRAME_PTR f;
313 int id;
314{
fbd6baed 315 return FRAME_W32_DISPLAY_INFO (f)->bitmaps[id - 1].height;
ee78dc32
GV
316}
317
318int
319x_bitmap_width (f, id)
320 FRAME_PTR f;
321 int id;
322{
fbd6baed 323 return FRAME_W32_DISPLAY_INFO (f)->bitmaps[id - 1].width;
ee78dc32
GV
324}
325
326int
327x_bitmap_pixmap (f, id)
328 FRAME_PTR f;
329 int id;
330{
fbd6baed 331 return (int) FRAME_W32_DISPLAY_INFO (f)->bitmaps[id - 1].pixmap;
ee78dc32
GV
332}
333
334
335/* Allocate a new bitmap record. Returns index of new record. */
336
337static int
338x_allocate_bitmap_record (f)
339 FRAME_PTR f;
340{
fbd6baed 341 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
ee78dc32
GV
342 int i;
343
344 if (dpyinfo->bitmaps == NULL)
345 {
346 dpyinfo->bitmaps_size = 10;
347 dpyinfo->bitmaps
fbd6baed 348 = (struct w32_bitmap_record *) xmalloc (dpyinfo->bitmaps_size * sizeof (struct w32_bitmap_record));
ee78dc32
GV
349 dpyinfo->bitmaps_last = 1;
350 return 1;
351 }
352
353 if (dpyinfo->bitmaps_last < dpyinfo->bitmaps_size)
354 return ++dpyinfo->bitmaps_last;
355
356 for (i = 0; i < dpyinfo->bitmaps_size; ++i)
357 if (dpyinfo->bitmaps[i].refcount == 0)
358 return i + 1;
359
360 dpyinfo->bitmaps_size *= 2;
361 dpyinfo->bitmaps
fbd6baed
GV
362 = (struct w32_bitmap_record *) xrealloc (dpyinfo->bitmaps,
363 dpyinfo->bitmaps_size * sizeof (struct w32_bitmap_record));
ee78dc32
GV
364 return ++dpyinfo->bitmaps_last;
365}
366
367/* Add one reference to the reference count of the bitmap with id ID. */
368
369void
370x_reference_bitmap (f, id)
371 FRAME_PTR f;
372 int id;
373{
fbd6baed 374 ++FRAME_W32_DISPLAY_INFO (f)->bitmaps[id - 1].refcount;
ee78dc32
GV
375}
376
377/* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
378
379int
380x_create_bitmap_from_data (f, bits, width, height)
381 struct frame *f;
382 char *bits;
383 unsigned int width, height;
384{
fbd6baed 385 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
ee78dc32
GV
386 Pixmap bitmap;
387 int id;
388
389 bitmap = CreateBitmap (width, height,
fbd6baed
GV
390 FRAME_W32_DISPLAY_INFO (XFRAME (frame))->n_planes,
391 FRAME_W32_DISPLAY_INFO (XFRAME (frame))->n_cbits,
ee78dc32
GV
392 bits);
393
394 if (! bitmap)
395 return -1;
396
397 id = x_allocate_bitmap_record (f);
398 dpyinfo->bitmaps[id - 1].pixmap = bitmap;
399 dpyinfo->bitmaps[id - 1].file = NULL;
400 dpyinfo->bitmaps[id - 1].hinst = NULL;
401 dpyinfo->bitmaps[id - 1].refcount = 1;
402 dpyinfo->bitmaps[id - 1].depth = 1;
403 dpyinfo->bitmaps[id - 1].height = height;
404 dpyinfo->bitmaps[id - 1].width = width;
405
406 return id;
407}
408
409/* Create bitmap from file FILE for frame F. */
410
411int
412x_create_bitmap_from_file (f, file)
413 struct frame *f;
414 Lisp_Object file;
415{
416 return -1;
417#if 0
fbd6baed 418 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
ee78dc32
GV
419 unsigned int width, height;
420 Pixmap bitmap;
421 int xhot, yhot, result, id;
422 Lisp_Object found;
423 int fd;
424 char *filename;
425 HINSTANCE hinst;
426
427 /* Look for an existing bitmap with the same name. */
428 for (id = 0; id < dpyinfo->bitmaps_last; ++id)
429 {
430 if (dpyinfo->bitmaps[id].refcount
431 && dpyinfo->bitmaps[id].file
432 && !strcmp (dpyinfo->bitmaps[id].file, (char *) XSTRING (file)->data))
433 {
434 ++dpyinfo->bitmaps[id].refcount;
435 return id + 1;
436 }
437 }
438
439 /* Search bitmap-file-path for the file, if appropriate. */
440 fd = openp (Vx_bitmap_file_path, file, "", &found, 0);
441 if (fd < 0)
442 return -1;
443 close (fd);
444
445 filename = (char *) XSTRING (found)->data;
446
447 hinst = LoadLibraryEx (filename, NULL, LOAD_LIBRARY_AS_DATAFILE);
448
449 if (hinst == NULL)
450 return -1;
451
452
fbd6baed 453 result = XReadBitmapFile (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
ee78dc32
GV
454 filename, &width, &height, &bitmap, &xhot, &yhot);
455 if (result != BitmapSuccess)
456 return -1;
457
458 id = x_allocate_bitmap_record (f);
459 dpyinfo->bitmaps[id - 1].pixmap = bitmap;
460 dpyinfo->bitmaps[id - 1].refcount = 1;
461 dpyinfo->bitmaps[id - 1].file = (char *) xmalloc (XSTRING (file)->size + 1);
462 dpyinfo->bitmaps[id - 1].depth = 1;
463 dpyinfo->bitmaps[id - 1].height = height;
464 dpyinfo->bitmaps[id - 1].width = width;
465 strcpy (dpyinfo->bitmaps[id - 1].file, XSTRING (file)->data);
466
467 return id;
468#endif
469}
470
471/* Remove reference to bitmap with id number ID. */
472
473int
474x_destroy_bitmap (f, id)
475 FRAME_PTR f;
476 int id;
477{
fbd6baed 478 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
ee78dc32
GV
479
480 if (id > 0)
481 {
482 --dpyinfo->bitmaps[id - 1].refcount;
483 if (dpyinfo->bitmaps[id - 1].refcount == 0)
484 {
485 BLOCK_INPUT;
486 DeleteObject (dpyinfo->bitmaps[id - 1].pixmap);
487 if (dpyinfo->bitmaps[id - 1].file)
488 {
489 free (dpyinfo->bitmaps[id - 1].file);
490 dpyinfo->bitmaps[id - 1].file = NULL;
491 }
492 UNBLOCK_INPUT;
493 }
494 }
495}
496
497/* Free all the bitmaps for the display specified by DPYINFO. */
498
499static void
500x_destroy_all_bitmaps (dpyinfo)
fbd6baed 501 struct w32_display_info *dpyinfo;
ee78dc32
GV
502{
503 int i;
504 for (i = 0; i < dpyinfo->bitmaps_last; i++)
505 if (dpyinfo->bitmaps[i].refcount > 0)
506 {
507 DeleteObject (dpyinfo->bitmaps[i].pixmap);
508 if (dpyinfo->bitmaps[i].file)
509 free (dpyinfo->bitmaps[i].file);
510 }
511 dpyinfo->bitmaps_last = 0;
512}
513\f
fbd6baed 514/* Connect the frame-parameter names for W32 frames
ee78dc32
GV
515 to the ways of passing the parameter values to the window system.
516
517 The name of a parameter, as a Lisp symbol,
518 has an `x-frame-parameter' property which is an integer in Lisp
519 but can be interpreted as an `enum x_frame_parm' in C. */
520
521enum x_frame_parm
522{
523 X_PARM_FOREGROUND_COLOR,
524 X_PARM_BACKGROUND_COLOR,
525 X_PARM_MOUSE_COLOR,
526 X_PARM_CURSOR_COLOR,
527 X_PARM_BORDER_COLOR,
528 X_PARM_ICON_TYPE,
529 X_PARM_FONT,
530 X_PARM_BORDER_WIDTH,
531 X_PARM_INTERNAL_BORDER_WIDTH,
532 X_PARM_NAME,
533 X_PARM_AUTORAISE,
534 X_PARM_AUTOLOWER,
535 X_PARM_VERT_SCROLL_BAR,
536 X_PARM_VISIBILITY,
537 X_PARM_MENU_BAR_LINES
538};
539
540
541struct x_frame_parm_table
542{
543 char *name;
544 void (*setter)( /* struct frame *frame, Lisp_Object val, oldval */ );
545};
546
547void x_set_foreground_color ();
548void x_set_background_color ();
549void x_set_mouse_color ();
550void x_set_cursor_color ();
551void x_set_border_color ();
552void x_set_cursor_type ();
553void x_set_icon_type ();
554void x_set_icon_name ();
555void x_set_font ();
556void x_set_border_width ();
557void x_set_internal_border_width ();
558void x_explicitly_set_name ();
559void x_set_autoraise ();
560void x_set_autolower ();
561void x_set_vertical_scroll_bars ();
562void x_set_visibility ();
563void x_set_menu_bar_lines ();
564void x_set_scroll_bar_width ();
1edf84e7 565void x_set_title ();
ee78dc32
GV
566void x_set_unsplittable ();
567
568static struct x_frame_parm_table x_frame_parms[] =
569{
1edf84e7
GV
570 "auto-raise", x_set_autoraise,
571 "auto-lower", x_set_autolower,
ee78dc32 572 "background-color", x_set_background_color,
ee78dc32 573 "border-color", x_set_border_color,
1edf84e7
GV
574 "border-width", x_set_border_width,
575 "cursor-color", x_set_cursor_color,
ee78dc32 576 "cursor-type", x_set_cursor_type,
ee78dc32 577 "font", x_set_font,
1edf84e7
GV
578 "foreground-color", x_set_foreground_color,
579 "icon-name", x_set_icon_name,
580 "icon-type", x_set_icon_type,
ee78dc32 581 "internal-border-width", x_set_internal_border_width,
ee78dc32 582 "menu-bar-lines", x_set_menu_bar_lines,
1edf84e7
GV
583 "mouse-color", x_set_mouse_color,
584 "name", x_explicitly_set_name,
ee78dc32 585 "scroll-bar-width", x_set_scroll_bar_width,
1edf84e7 586 "title", x_set_title,
ee78dc32 587 "unsplittable", x_set_unsplittable,
1edf84e7
GV
588 "vertical-scroll-bars", x_set_vertical_scroll_bars,
589 "visibility", x_set_visibility,
ee78dc32
GV
590};
591
592/* Attach the `x-frame-parameter' properties to
fbd6baed 593 the Lisp symbol names of parameters relevant to W32. */
ee78dc32
GV
594
595init_x_parm_symbols ()
596{
597 int i;
598
599 for (i = 0; i < sizeof (x_frame_parms) / sizeof (x_frame_parms[0]); i++)
600 Fput (intern (x_frame_parms[i].name), Qx_frame_parameter,
601 make_number (i));
602}
603\f
604/* Change the parameters of FRAME as specified by ALIST.
605 If a parameter is not specially recognized, do nothing;
606 otherwise call the `x_set_...' function for that parameter. */
607
608void
609x_set_frame_parameters (f, alist)
610 FRAME_PTR f;
611 Lisp_Object alist;
612{
613 Lisp_Object tail;
614
615 /* If both of these parameters are present, it's more efficient to
616 set them both at once. So we wait until we've looked at the
617 entire list before we set them. */
b839712d 618 int width, height;
ee78dc32
GV
619
620 /* Same here. */
621 Lisp_Object left, top;
622
623 /* Same with these. */
624 Lisp_Object icon_left, icon_top;
625
626 /* Record in these vectors all the parms specified. */
627 Lisp_Object *parms;
628 Lisp_Object *values;
629 int i;
630 int left_no_change = 0, top_no_change = 0;
631 int icon_left_no_change = 0, icon_top_no_change = 0;
632
633 i = 0;
634 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
635 i++;
636
637 parms = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
638 values = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
639
640 /* Extract parm names and values into those vectors. */
641
642 i = 0;
643 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
644 {
645 Lisp_Object elt, prop, val;
646
647 elt = Fcar (tail);
648 parms[i] = Fcar (elt);
649 values[i] = Fcdr (elt);
650 i++;
651 }
652
b839712d 653 top = left = Qunbound;
ee78dc32
GV
654 icon_left = icon_top = Qunbound;
655
b839712d
RS
656 /* Provide default values for HEIGHT and WIDTH. */
657 width = FRAME_WIDTH (f);
658 height = FRAME_HEIGHT (f);
659
ee78dc32
GV
660 /* Now process them in reverse of specified order. */
661 for (i--; i >= 0; i--)
662 {
663 Lisp_Object prop, val;
664
665 prop = parms[i];
666 val = values[i];
667
b839712d
RS
668 if (EQ (prop, Qwidth) && NUMBERP (val))
669 width = XFASTINT (val);
670 else if (EQ (prop, Qheight) && NUMBERP (val))
671 height = XFASTINT (val);
ee78dc32
GV
672 else if (EQ (prop, Qtop))
673 top = val;
674 else if (EQ (prop, Qleft))
675 left = val;
676 else if (EQ (prop, Qicon_top))
677 icon_top = val;
678 else if (EQ (prop, Qicon_left))
679 icon_left = val;
680 else
681 {
682 register Lisp_Object param_index, old_value;
683
684 param_index = Fget (prop, Qx_frame_parameter);
685 old_value = get_frame_param (f, prop);
686 store_frame_param (f, prop, val);
687 if (NATNUMP (param_index)
688 && (XFASTINT (param_index)
689 < sizeof (x_frame_parms)/sizeof (x_frame_parms[0])))
3c190163 690 (*x_frame_parms[XINT (param_index)].setter)(f, val, old_value);
ee78dc32
GV
691 }
692 }
693
694 /* Don't die if just one of these was set. */
695 if (EQ (left, Qunbound))
696 {
697 left_no_change = 1;
fbd6baed
GV
698 if (f->output_data.w32->left_pos < 0)
699 left = Fcons (Qplus, Fcons (make_number (f->output_data.w32->left_pos), Qnil));
ee78dc32 700 else
fbd6baed 701 XSETINT (left, f->output_data.w32->left_pos);
ee78dc32
GV
702 }
703 if (EQ (top, Qunbound))
704 {
705 top_no_change = 1;
fbd6baed
GV
706 if (f->output_data.w32->top_pos < 0)
707 top = Fcons (Qplus, Fcons (make_number (f->output_data.w32->top_pos), Qnil));
ee78dc32 708 else
fbd6baed 709 XSETINT (top, f->output_data.w32->top_pos);
ee78dc32
GV
710 }
711
712 /* If one of the icon positions was not set, preserve or default it. */
713 if (EQ (icon_left, Qunbound) || ! INTEGERP (icon_left))
714 {
715 icon_left_no_change = 1;
716 icon_left = Fcdr (Fassq (Qicon_left, f->param_alist));
717 if (NILP (icon_left))
718 XSETINT (icon_left, 0);
719 }
720 if (EQ (icon_top, Qunbound) || ! INTEGERP (icon_top))
721 {
722 icon_top_no_change = 1;
723 icon_top = Fcdr (Fassq (Qicon_top, f->param_alist));
724 if (NILP (icon_top))
725 XSETINT (icon_top, 0);
726 }
727
ee78dc32
GV
728 /* Don't set these parameters unless they've been explicitly
729 specified. The window might be mapped or resized while we're in
730 this function, and we don't want to override that unless the lisp
731 code has asked for it.
732
733 Don't set these parameters unless they actually differ from the
734 window's current parameters; the window may not actually exist
735 yet. */
736 {
737 Lisp_Object frame;
738
739 check_frame_size (f, &height, &width);
740
741 XSETFRAME (frame, f);
742
b839712d
RS
743 if (XINT (width) != FRAME_WIDTH (f)
744 || XINT (height) != FRAME_HEIGHT (f))
745 Fset_frame_size (frame, make_number (width), make_number (height));
ee78dc32
GV
746
747 if ((!NILP (left) || !NILP (top))
748 && ! (left_no_change && top_no_change)
fbd6baed
GV
749 && ! (NUMBERP (left) && XINT (left) == f->output_data.w32->left_pos
750 && NUMBERP (top) && XINT (top) == f->output_data.w32->top_pos))
ee78dc32
GV
751 {
752 int leftpos = 0;
753 int toppos = 0;
754
755 /* Record the signs. */
fbd6baed 756 f->output_data.w32->size_hint_flags &= ~ (XNegative | YNegative);
ee78dc32 757 if (EQ (left, Qminus))
fbd6baed 758 f->output_data.w32->size_hint_flags |= XNegative;
ee78dc32
GV
759 else if (INTEGERP (left))
760 {
761 leftpos = XINT (left);
762 if (leftpos < 0)
fbd6baed 763 f->output_data.w32->size_hint_flags |= XNegative;
ee78dc32
GV
764 }
765 else if (CONSP (left) && EQ (XCONS (left)->car, Qminus)
766 && CONSP (XCONS (left)->cdr)
767 && INTEGERP (XCONS (XCONS (left)->cdr)->car))
768 {
769 leftpos = - XINT (XCONS (XCONS (left)->cdr)->car);
fbd6baed 770 f->output_data.w32->size_hint_flags |= XNegative;
ee78dc32
GV
771 }
772 else if (CONSP (left) && EQ (XCONS (left)->car, Qplus)
773 && CONSP (XCONS (left)->cdr)
774 && INTEGERP (XCONS (XCONS (left)->cdr)->car))
775 {
776 leftpos = XINT (XCONS (XCONS (left)->cdr)->car);
777 }
778
779 if (EQ (top, Qminus))
fbd6baed 780 f->output_data.w32->size_hint_flags |= YNegative;
ee78dc32
GV
781 else if (INTEGERP (top))
782 {
783 toppos = XINT (top);
784 if (toppos < 0)
fbd6baed 785 f->output_data.w32->size_hint_flags |= YNegative;
ee78dc32
GV
786 }
787 else if (CONSP (top) && EQ (XCONS (top)->car, Qminus)
788 && CONSP (XCONS (top)->cdr)
789 && INTEGERP (XCONS (XCONS (top)->cdr)->car))
790 {
791 toppos = - XINT (XCONS (XCONS (top)->cdr)->car);
fbd6baed 792 f->output_data.w32->size_hint_flags |= YNegative;
ee78dc32
GV
793 }
794 else if (CONSP (top) && EQ (XCONS (top)->car, Qplus)
795 && CONSP (XCONS (top)->cdr)
796 && INTEGERP (XCONS (XCONS (top)->cdr)->car))
797 {
798 toppos = XINT (XCONS (XCONS (top)->cdr)->car);
799 }
800
801
802 /* Store the numeric value of the position. */
fbd6baed
GV
803 f->output_data.w32->top_pos = toppos;
804 f->output_data.w32->left_pos = leftpos;
ee78dc32 805
fbd6baed 806 f->output_data.w32->win_gravity = NorthWestGravity;
ee78dc32
GV
807
808 /* Actually set that position, and convert to absolute. */
809 x_set_offset (f, leftpos, toppos, -1);
810 }
811
812 if ((!NILP (icon_left) || !NILP (icon_top))
813 && ! (icon_left_no_change && icon_top_no_change))
814 x_wm_set_icon_position (f, XINT (icon_left), XINT (icon_top));
815 }
816}
817
818/* Store the screen positions of frame F into XPTR and YPTR.
819 These are the positions of the containing window manager window,
820 not Emacs's own window. */
821
822void
823x_real_positions (f, xptr, yptr)
824 FRAME_PTR f;
825 int *xptr, *yptr;
826{
827 POINT pt;
3c190163
GV
828
829 {
830 RECT rect;
ee78dc32 831
fbd6baed
GV
832 GetClientRect(FRAME_W32_WINDOW(f), &rect);
833 AdjustWindowRect(&rect, f->output_data.w32->dwStyle, FRAME_EXTERNAL_MENU_BAR(f));
ee78dc32 834
3c190163
GV
835 pt.x = rect.left;
836 pt.y = rect.top;
837 }
ee78dc32 838
fbd6baed 839 ClientToScreen (FRAME_W32_WINDOW(f), &pt);
ee78dc32
GV
840
841 *xptr = pt.x;
842 *yptr = pt.y;
843}
844
845/* Insert a description of internally-recorded parameters of frame X
846 into the parameter alist *ALISTPTR that is to be given to the user.
fbd6baed 847 Only parameters that are specific to W32
ee78dc32
GV
848 and whose values are not correctly recorded in the frame's
849 param_alist need to be considered here. */
850
851x_report_frame_params (f, alistptr)
852 struct frame *f;
853 Lisp_Object *alistptr;
854{
855 char buf[16];
856 Lisp_Object tem;
857
858 /* Represent negative positions (off the top or left screen edge)
859 in a way that Fmodify_frame_parameters will understand correctly. */
fbd6baed
GV
860 XSETINT (tem, f->output_data.w32->left_pos);
861 if (f->output_data.w32->left_pos >= 0)
ee78dc32
GV
862 store_in_alist (alistptr, Qleft, tem);
863 else
864 store_in_alist (alistptr, Qleft, Fcons (Qplus, Fcons (tem, Qnil)));
865
fbd6baed
GV
866 XSETINT (tem, f->output_data.w32->top_pos);
867 if (f->output_data.w32->top_pos >= 0)
ee78dc32
GV
868 store_in_alist (alistptr, Qtop, tem);
869 else
870 store_in_alist (alistptr, Qtop, Fcons (Qplus, Fcons (tem, Qnil)));
871
872 store_in_alist (alistptr, Qborder_width,
fbd6baed 873 make_number (f->output_data.w32->border_width));
ee78dc32 874 store_in_alist (alistptr, Qinternal_border_width,
fbd6baed
GV
875 make_number (f->output_data.w32->internal_border_width));
876 sprintf (buf, "%ld", (long) FRAME_W32_WINDOW (f));
ee78dc32
GV
877 store_in_alist (alistptr, Qwindow_id,
878 build_string (buf));
879 store_in_alist (alistptr, Qicon_name, f->icon_name);
880 FRAME_SAMPLE_VISIBILITY (f);
881 store_in_alist (alistptr, Qvisibility,
882 (FRAME_VISIBLE_P (f) ? Qt
883 : FRAME_ICONIFIED_P (f) ? Qicon : Qnil));
884 store_in_alist (alistptr, Qdisplay,
fbd6baed 885 XCONS (FRAME_W32_DISPLAY_INFO (f)->name_list_element)->car);
ee78dc32
GV
886}
887\f
888
fbd6baed 889DEFUN ("w32-define-rgb-color", Fw32_define_rgb_color, Sw32_define_rgb_color, 4, 4, 0,
5ac45f98 890 "Convert RGB numbers to a windows color reference and associate with NAME (a string).\n\
fbd6baed 891This adds or updates a named color to w32-color-map, making it available for use.\n\
5ac45f98
GV
892The original entry's RGB ref is returned, or nil if the entry is new.")
893 (red, green, blue, name)
894 Lisp_Object red, green, blue, name;
ee78dc32 895{
5ac45f98
GV
896 Lisp_Object rgb;
897 Lisp_Object oldrgb = Qnil;
898 Lisp_Object entry;
899
900 CHECK_NUMBER (red, 0);
901 CHECK_NUMBER (green, 0);
902 CHECK_NUMBER (blue, 0);
903 CHECK_STRING (name, 0);
ee78dc32 904
5ac45f98 905 XSET (rgb, Lisp_Int, RGB(XUINT (red), XUINT (green), XUINT (blue)));
ee78dc32 906
5ac45f98 907 BLOCK_INPUT;
ee78dc32 908
fbd6baed
GV
909 /* replace existing entry in w32-color-map or add new entry. */
910 entry = Fassoc (name, Vw32_color_map);
5ac45f98
GV
911 if (NILP (entry))
912 {
913 entry = Fcons (name, rgb);
fbd6baed 914 Vw32_color_map = Fcons (entry, Vw32_color_map);
5ac45f98
GV
915 }
916 else
917 {
918 oldrgb = Fcdr (entry);
919 Fsetcdr (entry, rgb);
920 }
921
922 UNBLOCK_INPUT;
923
924 return (oldrgb);
ee78dc32
GV
925}
926
fbd6baed 927DEFUN ("w32-load-color-file", Fw32_load_color_file, Sw32_load_color_file, 1, 1, 0,
5ac45f98 928 "Create an alist of color entries from an external file (ie. rgb.txt).\n\
fbd6baed 929Assign this value to w32-color-map to replace the existing color map.\n\
5ac45f98
GV
930\
931The file should define one named RGB color per line like so:\
932 R G B name\n\
933where R,G,B are numbers between 0 and 255 and name is an arbitrary string.")
934 (filename)
935 Lisp_Object filename;
936{
937 FILE *fp;
938 Lisp_Object cmap = Qnil;
939 Lisp_Object abspath;
940
941 CHECK_STRING (filename, 0);
942 abspath = Fexpand_file_name (filename, Qnil);
943
944 fp = fopen (XSTRING (filename)->data, "rt");
945 if (fp)
946 {
947 char buf[512];
948 int red, green, blue;
949 int num;
950
951 BLOCK_INPUT;
952
953 while (fgets (buf, sizeof (buf), fp) != NULL) {
954 if (sscanf (buf, "%u %u %u %n", &red, &green, &blue, &num) == 3)
955 {
956 char *name = buf + num;
957 num = strlen (name) - 1;
958 if (name[num] == '\n')
959 name[num] = 0;
960 cmap = Fcons (Fcons (build_string (name),
961 make_number (RGB (red, green, blue))),
962 cmap);
963 }
964 }
965 fclose (fp);
966
967 UNBLOCK_INPUT;
968 }
969
970 return cmap;
971}
ee78dc32 972
fbd6baed 973/* The default colors for the w32 color map */
ee78dc32
GV
974typedef struct colormap_t
975{
976 char *name;
977 COLORREF colorref;
978} colormap_t;
979
fbd6baed 980colormap_t w32_color_map[] =
ee78dc32 981{
1da8a614
GV
982 {"snow" , PALETTERGB (255,250,250)},
983 {"ghost white" , PALETTERGB (248,248,255)},
984 {"GhostWhite" , PALETTERGB (248,248,255)},
985 {"white smoke" , PALETTERGB (245,245,245)},
986 {"WhiteSmoke" , PALETTERGB (245,245,245)},
987 {"gainsboro" , PALETTERGB (220,220,220)},
988 {"floral white" , PALETTERGB (255,250,240)},
989 {"FloralWhite" , PALETTERGB (255,250,240)},
990 {"old lace" , PALETTERGB (253,245,230)},
991 {"OldLace" , PALETTERGB (253,245,230)},
992 {"linen" , PALETTERGB (250,240,230)},
993 {"antique white" , PALETTERGB (250,235,215)},
994 {"AntiqueWhite" , PALETTERGB (250,235,215)},
995 {"papaya whip" , PALETTERGB (255,239,213)},
996 {"PapayaWhip" , PALETTERGB (255,239,213)},
997 {"blanched almond" , PALETTERGB (255,235,205)},
998 {"BlanchedAlmond" , PALETTERGB (255,235,205)},
999 {"bisque" , PALETTERGB (255,228,196)},
1000 {"peach puff" , PALETTERGB (255,218,185)},
1001 {"PeachPuff" , PALETTERGB (255,218,185)},
1002 {"navajo white" , PALETTERGB (255,222,173)},
1003 {"NavajoWhite" , PALETTERGB (255,222,173)},
1004 {"moccasin" , PALETTERGB (255,228,181)},
1005 {"cornsilk" , PALETTERGB (255,248,220)},
1006 {"ivory" , PALETTERGB (255,255,240)},
1007 {"lemon chiffon" , PALETTERGB (255,250,205)},
1008 {"LemonChiffon" , PALETTERGB (255,250,205)},
1009 {"seashell" , PALETTERGB (255,245,238)},
1010 {"honeydew" , PALETTERGB (240,255,240)},
1011 {"mint cream" , PALETTERGB (245,255,250)},
1012 {"MintCream" , PALETTERGB (245,255,250)},
1013 {"azure" , PALETTERGB (240,255,255)},
1014 {"alice blue" , PALETTERGB (240,248,255)},
1015 {"AliceBlue" , PALETTERGB (240,248,255)},
1016 {"lavender" , PALETTERGB (230,230,250)},
1017 {"lavender blush" , PALETTERGB (255,240,245)},
1018 {"LavenderBlush" , PALETTERGB (255,240,245)},
1019 {"misty rose" , PALETTERGB (255,228,225)},
1020 {"MistyRose" , PALETTERGB (255,228,225)},
1021 {"white" , PALETTERGB (255,255,255)},
1022 {"black" , PALETTERGB ( 0, 0, 0)},
1023 {"dark slate gray" , PALETTERGB ( 47, 79, 79)},
1024 {"DarkSlateGray" , PALETTERGB ( 47, 79, 79)},
1025 {"dark slate grey" , PALETTERGB ( 47, 79, 79)},
1026 {"DarkSlateGrey" , PALETTERGB ( 47, 79, 79)},
1027 {"dim gray" , PALETTERGB (105,105,105)},
1028 {"DimGray" , PALETTERGB (105,105,105)},
1029 {"dim grey" , PALETTERGB (105,105,105)},
1030 {"DimGrey" , PALETTERGB (105,105,105)},
1031 {"slate gray" , PALETTERGB (112,128,144)},
1032 {"SlateGray" , PALETTERGB (112,128,144)},
1033 {"slate grey" , PALETTERGB (112,128,144)},
1034 {"SlateGrey" , PALETTERGB (112,128,144)},
1035 {"light slate gray" , PALETTERGB (119,136,153)},
1036 {"LightSlateGray" , PALETTERGB (119,136,153)},
1037 {"light slate grey" , PALETTERGB (119,136,153)},
1038 {"LightSlateGrey" , PALETTERGB (119,136,153)},
1039 {"gray" , PALETTERGB (190,190,190)},
1040 {"grey" , PALETTERGB (190,190,190)},
1041 {"light grey" , PALETTERGB (211,211,211)},
1042 {"LightGrey" , PALETTERGB (211,211,211)},
1043 {"light gray" , PALETTERGB (211,211,211)},
1044 {"LightGray" , PALETTERGB (211,211,211)},
1045 {"midnight blue" , PALETTERGB ( 25, 25,112)},
1046 {"MidnightBlue" , PALETTERGB ( 25, 25,112)},
1047 {"navy" , PALETTERGB ( 0, 0,128)},
1048 {"navy blue" , PALETTERGB ( 0, 0,128)},
1049 {"NavyBlue" , PALETTERGB ( 0, 0,128)},
1050 {"cornflower blue" , PALETTERGB (100,149,237)},
1051 {"CornflowerBlue" , PALETTERGB (100,149,237)},
1052 {"dark slate blue" , PALETTERGB ( 72, 61,139)},
1053 {"DarkSlateBlue" , PALETTERGB ( 72, 61,139)},
1054 {"slate blue" , PALETTERGB (106, 90,205)},
1055 {"SlateBlue" , PALETTERGB (106, 90,205)},
1056 {"medium slate blue" , PALETTERGB (123,104,238)},
1057 {"MediumSlateBlue" , PALETTERGB (123,104,238)},
1058 {"light slate blue" , PALETTERGB (132,112,255)},
1059 {"LightSlateBlue" , PALETTERGB (132,112,255)},
1060 {"medium blue" , PALETTERGB ( 0, 0,205)},
1061 {"MediumBlue" , PALETTERGB ( 0, 0,205)},
1062 {"royal blue" , PALETTERGB ( 65,105,225)},
1063 {"RoyalBlue" , PALETTERGB ( 65,105,225)},
1064 {"blue" , PALETTERGB ( 0, 0,255)},
1065 {"dodger blue" , PALETTERGB ( 30,144,255)},
1066 {"DodgerBlue" , PALETTERGB ( 30,144,255)},
1067 {"deep sky blue" , PALETTERGB ( 0,191,255)},
1068 {"DeepSkyBlue" , PALETTERGB ( 0,191,255)},
1069 {"sky blue" , PALETTERGB (135,206,235)},
1070 {"SkyBlue" , PALETTERGB (135,206,235)},
1071 {"light sky blue" , PALETTERGB (135,206,250)},
1072 {"LightSkyBlue" , PALETTERGB (135,206,250)},
1073 {"steel blue" , PALETTERGB ( 70,130,180)},
1074 {"SteelBlue" , PALETTERGB ( 70,130,180)},
1075 {"light steel blue" , PALETTERGB (176,196,222)},
1076 {"LightSteelBlue" , PALETTERGB (176,196,222)},
1077 {"light blue" , PALETTERGB (173,216,230)},
1078 {"LightBlue" , PALETTERGB (173,216,230)},
1079 {"powder blue" , PALETTERGB (176,224,230)},
1080 {"PowderBlue" , PALETTERGB (176,224,230)},
1081 {"pale turquoise" , PALETTERGB (175,238,238)},
1082 {"PaleTurquoise" , PALETTERGB (175,238,238)},
1083 {"dark turquoise" , PALETTERGB ( 0,206,209)},
1084 {"DarkTurquoise" , PALETTERGB ( 0,206,209)},
1085 {"medium turquoise" , PALETTERGB ( 72,209,204)},
1086 {"MediumTurquoise" , PALETTERGB ( 72,209,204)},
1087 {"turquoise" , PALETTERGB ( 64,224,208)},
1088 {"cyan" , PALETTERGB ( 0,255,255)},
1089 {"light cyan" , PALETTERGB (224,255,255)},
1090 {"LightCyan" , PALETTERGB (224,255,255)},
1091 {"cadet blue" , PALETTERGB ( 95,158,160)},
1092 {"CadetBlue" , PALETTERGB ( 95,158,160)},
1093 {"medium aquamarine" , PALETTERGB (102,205,170)},
1094 {"MediumAquamarine" , PALETTERGB (102,205,170)},
1095 {"aquamarine" , PALETTERGB (127,255,212)},
1096 {"dark green" , PALETTERGB ( 0,100, 0)},
1097 {"DarkGreen" , PALETTERGB ( 0,100, 0)},
1098 {"dark olive green" , PALETTERGB ( 85,107, 47)},
1099 {"DarkOliveGreen" , PALETTERGB ( 85,107, 47)},
1100 {"dark sea green" , PALETTERGB (143,188,143)},
1101 {"DarkSeaGreen" , PALETTERGB (143,188,143)},
1102 {"sea green" , PALETTERGB ( 46,139, 87)},
1103 {"SeaGreen" , PALETTERGB ( 46,139, 87)},
1104 {"medium sea green" , PALETTERGB ( 60,179,113)},
1105 {"MediumSeaGreen" , PALETTERGB ( 60,179,113)},
1106 {"light sea green" , PALETTERGB ( 32,178,170)},
1107 {"LightSeaGreen" , PALETTERGB ( 32,178,170)},
1108 {"pale green" , PALETTERGB (152,251,152)},
1109 {"PaleGreen" , PALETTERGB (152,251,152)},
1110 {"spring green" , PALETTERGB ( 0,255,127)},
1111 {"SpringGreen" , PALETTERGB ( 0,255,127)},
1112 {"lawn green" , PALETTERGB (124,252, 0)},
1113 {"LawnGreen" , PALETTERGB (124,252, 0)},
1114 {"green" , PALETTERGB ( 0,255, 0)},
1115 {"chartreuse" , PALETTERGB (127,255, 0)},
1116 {"medium spring green" , PALETTERGB ( 0,250,154)},
1117 {"MediumSpringGreen" , PALETTERGB ( 0,250,154)},
1118 {"green yellow" , PALETTERGB (173,255, 47)},
1119 {"GreenYellow" , PALETTERGB (173,255, 47)},
1120 {"lime green" , PALETTERGB ( 50,205, 50)},
1121 {"LimeGreen" , PALETTERGB ( 50,205, 50)},
1122 {"yellow green" , PALETTERGB (154,205, 50)},
1123 {"YellowGreen" , PALETTERGB (154,205, 50)},
1124 {"forest green" , PALETTERGB ( 34,139, 34)},
1125 {"ForestGreen" , PALETTERGB ( 34,139, 34)},
1126 {"olive drab" , PALETTERGB (107,142, 35)},
1127 {"OliveDrab" , PALETTERGB (107,142, 35)},
1128 {"dark khaki" , PALETTERGB (189,183,107)},
1129 {"DarkKhaki" , PALETTERGB (189,183,107)},
1130 {"khaki" , PALETTERGB (240,230,140)},
1131 {"pale goldenrod" , PALETTERGB (238,232,170)},
1132 {"PaleGoldenrod" , PALETTERGB (238,232,170)},
1133 {"light goldenrod yellow" , PALETTERGB (250,250,210)},
1134 {"LightGoldenrodYellow" , PALETTERGB (250,250,210)},
1135 {"light yellow" , PALETTERGB (255,255,224)},
1136 {"LightYellow" , PALETTERGB (255,255,224)},
1137 {"yellow" , PALETTERGB (255,255, 0)},
1138 {"gold" , PALETTERGB (255,215, 0)},
1139 {"light goldenrod" , PALETTERGB (238,221,130)},
1140 {"LightGoldenrod" , PALETTERGB (238,221,130)},
1141 {"goldenrod" , PALETTERGB (218,165, 32)},
1142 {"dark goldenrod" , PALETTERGB (184,134, 11)},
1143 {"DarkGoldenrod" , PALETTERGB (184,134, 11)},
1144 {"rosy brown" , PALETTERGB (188,143,143)},
1145 {"RosyBrown" , PALETTERGB (188,143,143)},
1146 {"indian red" , PALETTERGB (205, 92, 92)},
1147 {"IndianRed" , PALETTERGB (205, 92, 92)},
1148 {"saddle brown" , PALETTERGB (139, 69, 19)},
1149 {"SaddleBrown" , PALETTERGB (139, 69, 19)},
1150 {"sienna" , PALETTERGB (160, 82, 45)},
1151 {"peru" , PALETTERGB (205,133, 63)},
1152 {"burlywood" , PALETTERGB (222,184,135)},
1153 {"beige" , PALETTERGB (245,245,220)},
1154 {"wheat" , PALETTERGB (245,222,179)},
1155 {"sandy brown" , PALETTERGB (244,164, 96)},
1156 {"SandyBrown" , PALETTERGB (244,164, 96)},
1157 {"tan" , PALETTERGB (210,180,140)},
1158 {"chocolate" , PALETTERGB (210,105, 30)},
1159 {"firebrick" , PALETTERGB (178,34, 34)},
1160 {"brown" , PALETTERGB (165,42, 42)},
1161 {"dark salmon" , PALETTERGB (233,150,122)},
1162 {"DarkSalmon" , PALETTERGB (233,150,122)},
1163 {"salmon" , PALETTERGB (250,128,114)},
1164 {"light salmon" , PALETTERGB (255,160,122)},
1165 {"LightSalmon" , PALETTERGB (255,160,122)},
1166 {"orange" , PALETTERGB (255,165, 0)},
1167 {"dark orange" , PALETTERGB (255,140, 0)},
1168 {"DarkOrange" , PALETTERGB (255,140, 0)},
1169 {"coral" , PALETTERGB (255,127, 80)},
1170 {"light coral" , PALETTERGB (240,128,128)},
1171 {"LightCoral" , PALETTERGB (240,128,128)},
1172 {"tomato" , PALETTERGB (255, 99, 71)},
1173 {"orange red" , PALETTERGB (255, 69, 0)},
1174 {"OrangeRed" , PALETTERGB (255, 69, 0)},
1175 {"red" , PALETTERGB (255, 0, 0)},
1176 {"hot pink" , PALETTERGB (255,105,180)},
1177 {"HotPink" , PALETTERGB (255,105,180)},
1178 {"deep pink" , PALETTERGB (255, 20,147)},
1179 {"DeepPink" , PALETTERGB (255, 20,147)},
1180 {"pink" , PALETTERGB (255,192,203)},
1181 {"light pink" , PALETTERGB (255,182,193)},
1182 {"LightPink" , PALETTERGB (255,182,193)},
1183 {"pale violet red" , PALETTERGB (219,112,147)},
1184 {"PaleVioletRed" , PALETTERGB (219,112,147)},
1185 {"maroon" , PALETTERGB (176, 48, 96)},
1186 {"medium violet red" , PALETTERGB (199, 21,133)},
1187 {"MediumVioletRed" , PALETTERGB (199, 21,133)},
1188 {"violet red" , PALETTERGB (208, 32,144)},
1189 {"VioletRed" , PALETTERGB (208, 32,144)},
1190 {"magenta" , PALETTERGB (255, 0,255)},
1191 {"violet" , PALETTERGB (238,130,238)},
1192 {"plum" , PALETTERGB (221,160,221)},
1193 {"orchid" , PALETTERGB (218,112,214)},
1194 {"medium orchid" , PALETTERGB (186, 85,211)},
1195 {"MediumOrchid" , PALETTERGB (186, 85,211)},
1196 {"dark orchid" , PALETTERGB (153, 50,204)},
1197 {"DarkOrchid" , PALETTERGB (153, 50,204)},
1198 {"dark violet" , PALETTERGB (148, 0,211)},
1199 {"DarkViolet" , PALETTERGB (148, 0,211)},
1200 {"blue violet" , PALETTERGB (138, 43,226)},
1201 {"BlueViolet" , PALETTERGB (138, 43,226)},
1202 {"purple" , PALETTERGB (160, 32,240)},
1203 {"medium purple" , PALETTERGB (147,112,219)},
1204 {"MediumPurple" , PALETTERGB (147,112,219)},
1205 {"thistle" , PALETTERGB (216,191,216)},
1206 {"gray0" , PALETTERGB ( 0, 0, 0)},
1207 {"grey0" , PALETTERGB ( 0, 0, 0)},
1208 {"dark grey" , PALETTERGB (169,169,169)},
1209 {"DarkGrey" , PALETTERGB (169,169,169)},
1210 {"dark gray" , PALETTERGB (169,169,169)},
1211 {"DarkGray" , PALETTERGB (169,169,169)},
1212 {"dark blue" , PALETTERGB ( 0, 0,139)},
1213 {"DarkBlue" , PALETTERGB ( 0, 0,139)},
1214 {"dark cyan" , PALETTERGB ( 0,139,139)},
1215 {"DarkCyan" , PALETTERGB ( 0,139,139)},
1216 {"dark magenta" , PALETTERGB (139, 0,139)},
1217 {"DarkMagenta" , PALETTERGB (139, 0,139)},
1218 {"dark red" , PALETTERGB (139, 0, 0)},
1219 {"DarkRed" , PALETTERGB (139, 0, 0)},
1220 {"light green" , PALETTERGB (144,238,144)},
1221 {"LightGreen" , PALETTERGB (144,238,144)},
ee78dc32
GV
1222};
1223
fbd6baed 1224DEFUN ("w32-default-color-map", Fw32_default_color_map, Sw32_default_color_map,
ee78dc32
GV
1225 0, 0, 0, "Return the default color map.")
1226 ()
1227{
1228 int i;
fbd6baed 1229 colormap_t *pc = w32_color_map;
ee78dc32
GV
1230 Lisp_Object cmap;
1231
1232 BLOCK_INPUT;
1233
1234 cmap = Qnil;
1235
fbd6baed 1236 for (i = 0; i < sizeof (w32_color_map) / sizeof (w32_color_map[0]);
ee78dc32
GV
1237 pc++, i++)
1238 cmap = Fcons (Fcons (build_string (pc->name),
1239 make_number (pc->colorref)),
1240 cmap);
1241
1242 UNBLOCK_INPUT;
1243
1244 return (cmap);
1245}
ee78dc32
GV
1246
1247Lisp_Object
fbd6baed 1248w32_to_x_color (rgb)
ee78dc32
GV
1249 Lisp_Object rgb;
1250{
1251 Lisp_Object color;
1252
1253 CHECK_NUMBER (rgb, 0);
1254
1255 BLOCK_INPUT;
1256
fbd6baed 1257 color = Frassq (rgb, Vw32_color_map);
ee78dc32
GV
1258
1259 UNBLOCK_INPUT;
1260
1261 if (!NILP (color))
1262 return (Fcar (color));
1263 else
1264 return Qnil;
1265}
1266
1267COLORREF
fbd6baed 1268x_to_w32_color (colorname)
ee78dc32
GV
1269 char * colorname;
1270{
1271 register Lisp_Object tail, ret = Qnil;
1272
1273 BLOCK_INPUT;
1edf84e7
GV
1274
1275 if (colorname[0] == '#')
1276 {
1277 /* Could be an old-style RGB Device specification. */
1278 char *color;
1279 int size;
1280 color = colorname + 1;
1281
1282 size = strlen(color);
1283 if (size == 3 || size == 6 || size == 9 || size == 12)
1284 {
1285 UINT colorval;
1286 int i, pos;
1287 pos = 0;
1288 size /= 3;
1289 colorval = 0;
1290
1291 for (i = 0; i < 3; i++)
1292 {
1293 char *end;
1294 char t;
1295 unsigned long value;
1296
1297 /* The check for 'x' in the following conditional takes into
1298 account the fact that strtol allows a "0x" in front of
1299 our numbers, and we don't. */
1300 if (!isxdigit(color[0]) || color[1] == 'x')
1301 break;
1302 t = color[size];
1303 color[size] = '\0';
1304 value = strtoul(color, &end, 16);
1305 color[size] = t;
1306 if (errno == ERANGE || end - color != size)
1307 break;
1308 switch (size)
1309 {
1310 case 1:
1311 value = value * 0x10;
1312 break;
1313 case 2:
1314 break;
1315 case 3:
1316 value /= 0x10;
1317 break;
1318 case 4:
1319 value /= 0x100;
1320 break;
1321 }
1322 colorval |= (value << pos);
1323 pos += 0x8;
1324 if (i == 2)
1325 {
1326 UNBLOCK_INPUT;
1327 return (colorval);
1328 }
1329 color = end;
1330 }
1331 }
1332 }
1333 else if (strnicmp(colorname, "rgb:", 4) == 0)
1334 {
1335 char *color;
1336 UINT colorval;
1337 int i, pos;
1338 pos = 0;
1339
1340 colorval = 0;
1341 color = colorname + 4;
1342 for (i = 0; i < 3; i++)
1343 {
1344 char *end;
1345 unsigned long value;
1346
1347 /* The check for 'x' in the following conditional takes into
1348 account the fact that strtol allows a "0x" in front of
1349 our numbers, and we don't. */
1350 if (!isxdigit(color[0]) || color[1] == 'x')
1351 break;
1352 value = strtoul(color, &end, 16);
1353 if (errno == ERANGE)
1354 break;
1355 switch (end - color)
1356 {
1357 case 1:
1358 value = value * 0x10 + value;
1359 break;
1360 case 2:
1361 break;
1362 case 3:
1363 value /= 0x10;
1364 break;
1365 case 4:
1366 value /= 0x100;
1367 break;
1368 default:
1369 value = ULONG_MAX;
1370 }
1371 if (value == ULONG_MAX)
1372 break;
1373 colorval |= (value << pos);
1374 pos += 0x8;
1375 if (i == 2)
1376 {
1377 if (*end != '\0')
1378 break;
1379 UNBLOCK_INPUT;
1380 return (colorval);
1381 }
1382 if (*end != '/')
1383 break;
1384 color = end + 1;
1385 }
1386 }
1387 else if (strnicmp(colorname, "rgbi:", 5) == 0)
1388 {
1389 /* This is an RGB Intensity specification. */
1390 char *color;
1391 UINT colorval;
1392 int i, pos;
1393 pos = 0;
1394
1395 colorval = 0;
1396 color = colorname + 5;
1397 for (i = 0; i < 3; i++)
1398 {
1399 char *end;
1400 double value;
1401 UINT val;
1402
1403 value = strtod(color, &end);
1404 if (errno == ERANGE)
1405 break;
1406 if (value < 0.0 || value > 1.0)
1407 break;
1408 val = (UINT)(0x100 * value);
1409 /* We used 0x100 instead of 0xFF to give an continuous
1410 range between 0.0 and 1.0 inclusive. The next statement
1411 fixes the 1.0 case. */
1412 if (val == 0x100)
1413 val = 0xFF;
1414 colorval |= (val << pos);
1415 pos += 0x8;
1416 if (i == 2)
1417 {
1418 if (*end != '\0')
1419 break;
1420 UNBLOCK_INPUT;
1421 return (colorval);
1422 }
1423 if (*end != '/')
1424 break;
1425 color = end + 1;
1426 }
1427 }
1428 /* I am not going to attempt to handle any of the CIE color schemes
1429 or TekHVC, since I don't know the algorithms for conversion to
1430 RGB. */
ee78dc32 1431
fbd6baed 1432 for (tail = Vw32_color_map; !NILP (tail); tail = Fcdr (tail))
ee78dc32
GV
1433 {
1434 register Lisp_Object elt, tem;
1435
1436 elt = Fcar (tail);
1437 if (!CONSP (elt)) continue;
1438
1439 tem = Fcar (elt);
1440
1441 if (lstrcmpi (XSTRING (tem)->data, colorname) == 0)
1442 {
1443 ret = XUINT(Fcdr (elt));
1444 break;
1445 }
1446
1447 QUIT;
1448 }
1449
1450 UNBLOCK_INPUT;
1451
1452 return ret;
1453}
1454
5ac45f98
GV
1455
1456void
fbd6baed 1457w32_regenerate_palette (FRAME_PTR f)
5ac45f98 1458{
fbd6baed 1459 struct w32_palette_entry * list;
5ac45f98
GV
1460 LOGPALETTE * log_palette;
1461 HPALETTE new_palette;
1462 int i;
1463
1464 /* don't bother trying to create palette if not supported */
fbd6baed 1465 if (! FRAME_W32_DISPLAY_INFO (f)->has_palette)
5ac45f98
GV
1466 return;
1467
1468 log_palette = (LOGPALETTE *)
1469 alloca (sizeof (LOGPALETTE) +
fbd6baed 1470 FRAME_W32_DISPLAY_INFO (f)->num_colors * sizeof (PALETTEENTRY));
5ac45f98 1471 log_palette->palVersion = 0x300;
fbd6baed 1472 log_palette->palNumEntries = FRAME_W32_DISPLAY_INFO (f)->num_colors;
5ac45f98 1473
fbd6baed 1474 list = FRAME_W32_DISPLAY_INFO (f)->color_list;
5ac45f98 1475 for (i = 0;
fbd6baed 1476 i < FRAME_W32_DISPLAY_INFO (f)->num_colors;
5ac45f98
GV
1477 i++, list = list->next)
1478 log_palette->palPalEntry[i] = list->entry;
1479
1480 new_palette = CreatePalette (log_palette);
1481
1482 enter_crit ();
1483
fbd6baed
GV
1484 if (FRAME_W32_DISPLAY_INFO (f)->palette)
1485 DeleteObject (FRAME_W32_DISPLAY_INFO (f)->palette);
1486 FRAME_W32_DISPLAY_INFO (f)->palette = new_palette;
5ac45f98
GV
1487
1488 /* Realize display palette and garbage all frames. */
1489 release_frame_dc (f, get_frame_dc (f));
1490
1491 leave_crit ();
1492}
1493
fbd6baed
GV
1494#define W32_COLOR(pe) RGB (pe.peRed, pe.peGreen, pe.peBlue)
1495#define SET_W32_COLOR(pe, color) \
5ac45f98
GV
1496 do \
1497 { \
1498 pe.peRed = GetRValue (color); \
1499 pe.peGreen = GetGValue (color); \
1500 pe.peBlue = GetBValue (color); \
1501 pe.peFlags = 0; \
1502 } while (0)
1503
1504#if 0
1505/* Keep these around in case we ever want to track color usage. */
1506void
fbd6baed 1507w32_map_color (FRAME_PTR f, COLORREF color)
5ac45f98 1508{
fbd6baed 1509 struct w32_palette_entry * list = FRAME_W32_DISPLAY_INFO (f)->color_list;
5ac45f98 1510
fbd6baed 1511 if (NILP (Vw32_enable_palette))
5ac45f98
GV
1512 return;
1513
1514 /* check if color is already mapped */
1515 while (list)
1516 {
fbd6baed 1517 if (W32_COLOR (list->entry) == color)
5ac45f98
GV
1518 {
1519 ++list->refcount;
1520 return;
1521 }
1522 list = list->next;
1523 }
1524
1525 /* not already mapped, so add to list and recreate Windows palette */
fbd6baed
GV
1526 list = (struct w32_palette_entry *)
1527 xmalloc (sizeof (struct w32_palette_entry));
1528 SET_W32_COLOR (list->entry, color);
5ac45f98 1529 list->refcount = 1;
fbd6baed
GV
1530 list->next = FRAME_W32_DISPLAY_INFO (f)->color_list;
1531 FRAME_W32_DISPLAY_INFO (f)->color_list = list;
1532 FRAME_W32_DISPLAY_INFO (f)->num_colors++;
5ac45f98
GV
1533
1534 /* set flag that palette must be regenerated */
fbd6baed 1535 FRAME_W32_DISPLAY_INFO (f)->regen_palette = TRUE;
5ac45f98
GV
1536}
1537
1538void
fbd6baed 1539w32_unmap_color (FRAME_PTR f, COLORREF color)
5ac45f98 1540{
fbd6baed
GV
1541 struct w32_palette_entry * list = FRAME_W32_DISPLAY_INFO (f)->color_list;
1542 struct w32_palette_entry **prev = &FRAME_W32_DISPLAY_INFO (f)->color_list;
5ac45f98 1543
fbd6baed 1544 if (NILP (Vw32_enable_palette))
5ac45f98
GV
1545 return;
1546
1547 /* check if color is already mapped */
1548 while (list)
1549 {
fbd6baed 1550 if (W32_COLOR (list->entry) == color)
5ac45f98
GV
1551 {
1552 if (--list->refcount == 0)
1553 {
1554 *prev = list->next;
1555 xfree (list);
fbd6baed 1556 FRAME_W32_DISPLAY_INFO (f)->num_colors--;
5ac45f98
GV
1557 break;
1558 }
1559 else
1560 return;
1561 }
1562 prev = &list->next;
1563 list = list->next;
1564 }
1565
1566 /* set flag that palette must be regenerated */
fbd6baed 1567 FRAME_W32_DISPLAY_INFO (f)->regen_palette = TRUE;
5ac45f98
GV
1568}
1569#endif
1570
ee78dc32
GV
1571/* Decide if color named COLOR is valid for the display associated with
1572 the selected frame; if so, return the rgb values in COLOR_DEF.
1573 If ALLOC is nonzero, allocate a new colormap cell. */
1574
1575int
1576defined_color (f, color, color_def, alloc)
1577 FRAME_PTR f;
1578 char *color;
1579 COLORREF *color_def;
1580 int alloc;
1581{
1582 register Lisp_Object tem;
3c190163 1583
fbd6baed 1584 tem = x_to_w32_color (color);
3c190163 1585
ee78dc32
GV
1586 if (!NILP (tem))
1587 {
fbd6baed 1588 if (!NILP (Vw32_enable_palette))
5ac45f98 1589 {
fbd6baed
GV
1590 struct w32_palette_entry * entry =
1591 FRAME_W32_DISPLAY_INFO (f)->color_list;
1592 struct w32_palette_entry ** prev =
1593 &FRAME_W32_DISPLAY_INFO (f)->color_list;
5ac45f98
GV
1594
1595 /* check if color is already mapped */
1596 while (entry)
1597 {
fbd6baed 1598 if (W32_COLOR (entry->entry) == XUINT (tem))
5ac45f98
GV
1599 break;
1600 prev = &entry->next;
1601 entry = entry->next;
1602 }
1603
1604 if (entry == NULL && alloc)
1605 {
1606 /* not already mapped, so add to list */
fbd6baed
GV
1607 entry = (struct w32_palette_entry *)
1608 xmalloc (sizeof (struct w32_palette_entry));
1609 SET_W32_COLOR (entry->entry, XUINT (tem));
5ac45f98
GV
1610 entry->next = NULL;
1611 *prev = entry;
fbd6baed 1612 FRAME_W32_DISPLAY_INFO (f)->num_colors++;
5ac45f98
GV
1613
1614 /* set flag that palette must be regenerated */
fbd6baed 1615 FRAME_W32_DISPLAY_INFO (f)->regen_palette = TRUE;
5ac45f98
GV
1616 }
1617 }
1618 /* Ensure COLORREF value is snapped to nearest color in (default)
1619 palette by simulating the PALETTERGB macro. This works whether
1620 or not the display device has a palette. */
8847d890 1621 *color_def = XUINT (tem) | 0x2000000;
ee78dc32 1622 return 1;
5ac45f98 1623 }
7fb46567 1624 else
3c190163
GV
1625 {
1626 return 0;
1627 }
ee78dc32
GV
1628}
1629
1630/* Given a string ARG naming a color, compute a pixel value from it
1631 suitable for screen F.
1632 If F is not a color screen, return DEF (default) regardless of what
1633 ARG says. */
1634
1635int
1636x_decode_color (f, arg, def)
1637 FRAME_PTR f;
1638 Lisp_Object arg;
1639 int def;
1640{
1641 COLORREF cdef;
1642
1643 CHECK_STRING (arg, 0);
1644
1645 if (strcmp (XSTRING (arg)->data, "black") == 0)
1646 return BLACK_PIX_DEFAULT (f);
1647 else if (strcmp (XSTRING (arg)->data, "white") == 0)
1648 return WHITE_PIX_DEFAULT (f);
1649
fbd6baed 1650 if ((FRAME_W32_DISPLAY_INFO (f)->n_planes * FRAME_W32_DISPLAY_INFO (f)->n_cbits) == 1)
ee78dc32
GV
1651 return def;
1652
1653 /* defined_color is responsible for coping with failures
1654 by looking for a near-miss. */
1655 if (defined_color (f, XSTRING (arg)->data, &cdef, 1))
1656 return cdef;
1657
1658 /* defined_color failed; return an ultimate default. */
1659 return def;
1660}
1661\f
1662/* Functions called only from `x_set_frame_param'
1663 to set individual parameters.
1664
fbd6baed 1665 If FRAME_W32_WINDOW (f) is 0,
ee78dc32
GV
1666 the frame is being created and its window does not exist yet.
1667 In that case, just record the parameter's new value
1668 in the standard place; do not attempt to change the window. */
1669
1670void
1671x_set_foreground_color (f, arg, oldval)
1672 struct frame *f;
1673 Lisp_Object arg, oldval;
1674{
fbd6baed 1675 f->output_data.w32->foreground_pixel
ee78dc32 1676 = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
5ac45f98 1677
fbd6baed 1678 if (FRAME_W32_WINDOW (f) != 0)
ee78dc32
GV
1679 {
1680 recompute_basic_faces (f);
1681 if (FRAME_VISIBLE_P (f))
1682 redraw_frame (f);
1683 }
1684}
1685
1686void
1687x_set_background_color (f, arg, oldval)
1688 struct frame *f;
1689 Lisp_Object arg, oldval;
1690{
1691 Pixmap temp;
1692 int mask;
1693
fbd6baed 1694 f->output_data.w32->background_pixel
ee78dc32
GV
1695 = x_decode_color (f, arg, WHITE_PIX_DEFAULT (f));
1696
fbd6baed 1697 if (FRAME_W32_WINDOW (f) != 0)
ee78dc32 1698 {
fbd6baed 1699 SetWindowLong (FRAME_W32_WINDOW (f), WND_BACKGROUND_INDEX, f->output_data.w32->background_pixel);
ee78dc32
GV
1700
1701 recompute_basic_faces (f);
1702
1703 if (FRAME_VISIBLE_P (f))
1704 redraw_frame (f);
1705 }
1706}
1707
1708void
1709x_set_mouse_color (f, arg, oldval)
1710 struct frame *f;
1711 Lisp_Object arg, oldval;
1712{
1713#if 0
1714 Cursor cursor, nontext_cursor, mode_cursor, cross_cursor;
1715#endif
dfc465d3 1716 int count;
ee78dc32
GV
1717 int mask_color;
1718
1719 if (!EQ (Qnil, arg))
fbd6baed 1720 f->output_data.w32->mouse_pixel
ee78dc32 1721 = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
fbd6baed 1722 mask_color = f->output_data.w32->background_pixel;
ee78dc32 1723 /* No invisible pointers. */
fbd6baed
GV
1724 if (mask_color == f->output_data.w32->mouse_pixel
1725 && mask_color == f->output_data.w32->background_pixel)
1726 f->output_data.w32->mouse_pixel = f->output_data.w32->foreground_pixel;
ee78dc32
GV
1727
1728#if 0
1729 BLOCK_INPUT;
1730
1731 /* It's not okay to crash if the user selects a screwy cursor. */
fadca6c6 1732 count = x_catch_errors (FRAME_W32_DISPLAY (f));
ee78dc32
GV
1733
1734 if (!EQ (Qnil, Vx_pointer_shape))
1735 {
1736 CHECK_NUMBER (Vx_pointer_shape, 0);
fbd6baed 1737 cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XINT (Vx_pointer_shape));
ee78dc32
GV
1738 }
1739 else
fbd6baed
GV
1740 cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_xterm);
1741 x_check_errors (FRAME_W32_DISPLAY (f), "bad text pointer cursor: %s");
ee78dc32
GV
1742
1743 if (!EQ (Qnil, Vx_nontext_pointer_shape))
1744 {
1745 CHECK_NUMBER (Vx_nontext_pointer_shape, 0);
fbd6baed 1746 nontext_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f),
ee78dc32
GV
1747 XINT (Vx_nontext_pointer_shape));
1748 }
1749 else
fbd6baed
GV
1750 nontext_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_left_ptr);
1751 x_check_errors (FRAME_W32_DISPLAY (f), "bad nontext pointer cursor: %s");
ee78dc32
GV
1752
1753 if (!EQ (Qnil, Vx_mode_pointer_shape))
1754 {
1755 CHECK_NUMBER (Vx_mode_pointer_shape, 0);
fbd6baed 1756 mode_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f),
ee78dc32
GV
1757 XINT (Vx_mode_pointer_shape));
1758 }
1759 else
fbd6baed
GV
1760 mode_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_xterm);
1761 x_check_errors (FRAME_W32_DISPLAY (f), "bad modeline pointer cursor: %s");
ee78dc32
GV
1762
1763 if (!EQ (Qnil, Vx_sensitive_text_pointer_shape))
1764 {
1765 CHECK_NUMBER (Vx_sensitive_text_pointer_shape, 0);
1766 cross_cursor
fbd6baed 1767 = XCreateFontCursor (FRAME_W32_DISPLAY (f),
ee78dc32
GV
1768 XINT (Vx_sensitive_text_pointer_shape));
1769 }
1770 else
fbd6baed 1771 cross_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_crosshair);
ee78dc32
GV
1772
1773 /* Check and report errors with the above calls. */
fbd6baed 1774 x_check_errors (FRAME_W32_DISPLAY (f), "can't set cursor shape: %s");
fadca6c6 1775 x_uncatch_errors (FRAME_W32_DISPLAY (f), count);
ee78dc32
GV
1776
1777 {
1778 XColor fore_color, back_color;
1779
fbd6baed 1780 fore_color.pixel = f->output_data.w32->mouse_pixel;
ee78dc32 1781 back_color.pixel = mask_color;
fbd6baed
GV
1782 XQueryColor (FRAME_W32_DISPLAY (f),
1783 DefaultColormap (FRAME_W32_DISPLAY (f),
1784 DefaultScreen (FRAME_W32_DISPLAY (f))),
ee78dc32 1785 &fore_color);
fbd6baed
GV
1786 XQueryColor (FRAME_W32_DISPLAY (f),
1787 DefaultColormap (FRAME_W32_DISPLAY (f),
1788 DefaultScreen (FRAME_W32_DISPLAY (f))),
ee78dc32 1789 &back_color);
fbd6baed 1790 XRecolorCursor (FRAME_W32_DISPLAY (f), cursor,
ee78dc32 1791 &fore_color, &back_color);
fbd6baed 1792 XRecolorCursor (FRAME_W32_DISPLAY (f), nontext_cursor,
ee78dc32 1793 &fore_color, &back_color);
fbd6baed 1794 XRecolorCursor (FRAME_W32_DISPLAY (f), mode_cursor,
ee78dc32 1795 &fore_color, &back_color);
fbd6baed 1796 XRecolorCursor (FRAME_W32_DISPLAY (f), cross_cursor,
ee78dc32
GV
1797 &fore_color, &back_color);
1798 }
1799
fbd6baed 1800 if (FRAME_W32_WINDOW (f) != 0)
ee78dc32 1801 {
fbd6baed 1802 XDefineCursor (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f), cursor);
ee78dc32
GV
1803 }
1804
fbd6baed
GV
1805 if (cursor != f->output_data.w32->text_cursor && f->output_data.w32->text_cursor != 0)
1806 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->text_cursor);
1807 f->output_data.w32->text_cursor = cursor;
1808
1809 if (nontext_cursor != f->output_data.w32->nontext_cursor
1810 && f->output_data.w32->nontext_cursor != 0)
1811 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->nontext_cursor);
1812 f->output_data.w32->nontext_cursor = nontext_cursor;
1813
1814 if (mode_cursor != f->output_data.w32->modeline_cursor
1815 && f->output_data.w32->modeline_cursor != 0)
1816 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->modeline_cursor);
1817 f->output_data.w32->modeline_cursor = mode_cursor;
1818 if (cross_cursor != f->output_data.w32->cross_cursor
1819 && f->output_data.w32->cross_cursor != 0)
1820 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->cross_cursor);
1821 f->output_data.w32->cross_cursor = cross_cursor;
1822
1823 XFlush (FRAME_W32_DISPLAY (f));
ee78dc32
GV
1824 UNBLOCK_INPUT;
1825#endif
1826}
1827
1828void
1829x_set_cursor_color (f, arg, oldval)
1830 struct frame *f;
1831 Lisp_Object arg, oldval;
1832{
1833 unsigned long fore_pixel;
1834
1835 if (!EQ (Vx_cursor_fore_pixel, Qnil))
1836 fore_pixel = x_decode_color (f, Vx_cursor_fore_pixel,
1837 WHITE_PIX_DEFAULT (f));
1838 else
fbd6baed
GV
1839 fore_pixel = f->output_data.w32->background_pixel;
1840 f->output_data.w32->cursor_pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
ee78dc32
GV
1841
1842 /* Make sure that the cursor color differs from the background color. */
fbd6baed 1843 if (f->output_data.w32->cursor_pixel == f->output_data.w32->background_pixel)
ee78dc32 1844 {
fbd6baed
GV
1845 f->output_data.w32->cursor_pixel = f->output_data.w32->mouse_pixel;
1846 if (f->output_data.w32->cursor_pixel == fore_pixel)
1847 fore_pixel = f->output_data.w32->background_pixel;
ee78dc32 1848 }
fbd6baed 1849 f->output_data.w32->cursor_foreground_pixel = fore_pixel;
ee78dc32 1850
fbd6baed 1851 if (FRAME_W32_WINDOW (f) != 0)
ee78dc32
GV
1852 {
1853 if (FRAME_VISIBLE_P (f))
1854 {
1855 x_display_cursor (f, 0);
1856 x_display_cursor (f, 1);
1857 }
1858 }
1859}
1860
1861/* Set the border-color of frame F to value described by ARG.
1862 ARG can be a string naming a color.
1863 The border-color is used for the border that is drawn by the server.
1864 Note that this does not fully take effect if done before
1865 F has a window; it must be redone when the window is created. */
1866
1867void
1868x_set_border_color (f, arg, oldval)
1869 struct frame *f;
1870 Lisp_Object arg, oldval;
1871{
1872 unsigned char *str;
1873 int pix;
1874
1875 CHECK_STRING (arg, 0);
1876 str = XSTRING (arg)->data;
1877
1878 pix = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1879
1880 x_set_border_pixel (f, pix);
1881}
1882
1883/* Set the border-color of frame F to pixel value PIX.
1884 Note that this does not fully take effect if done before
1885 F has an window. */
1886
1887x_set_border_pixel (f, pix)
1888 struct frame *f;
1889 int pix;
1890{
fbd6baed 1891 f->output_data.w32->border_pixel = pix;
ee78dc32 1892
fbd6baed 1893 if (FRAME_W32_WINDOW (f) != 0 && f->output_data.w32->border_width > 0)
ee78dc32
GV
1894 {
1895 if (FRAME_VISIBLE_P (f))
1896 redraw_frame (f);
1897 }
1898}
1899
1900void
1901x_set_cursor_type (f, arg, oldval)
1902 FRAME_PTR f;
1903 Lisp_Object arg, oldval;
1904{
1905 if (EQ (arg, Qbar))
1906 {
1907 FRAME_DESIRED_CURSOR (f) = bar_cursor;
fbd6baed 1908 f->output_data.w32->cursor_width = 2;
ee78dc32
GV
1909 }
1910 else if (CONSP (arg) && EQ (XCONS (arg)->car, Qbar)
1911 && INTEGERP (XCONS (arg)->cdr))
1912 {
1913 FRAME_DESIRED_CURSOR (f) = bar_cursor;
fbd6baed 1914 f->output_data.w32->cursor_width = XINT (XCONS (arg)->cdr);
ee78dc32
GV
1915 }
1916 else
1917 /* Treat anything unknown as "box cursor".
1918 It was bad to signal an error; people have trouble fixing
1919 .Xdefaults with Emacs, when it has something bad in it. */
1920 FRAME_DESIRED_CURSOR (f) = filled_box_cursor;
1921
1922 /* Make sure the cursor gets redrawn. This is overkill, but how
1923 often do people change cursor types? */
1924 update_mode_lines++;
1925}
1926
1927void
1928x_set_icon_type (f, arg, oldval)
1929 struct frame *f;
1930 Lisp_Object arg, oldval;
1931{
1932#if 0
1933 Lisp_Object tem;
1934 int result;
1935
1936 if (STRINGP (arg))
1937 {
1938 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
1939 return;
1940 }
1941 else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
1942 return;
1943
1944 BLOCK_INPUT;
1945 if (NILP (arg))
1946 result = x_text_icon (f,
1947 (char *) XSTRING ((!NILP (f->icon_name)
1948 ? f->icon_name
1949 : f->name))->data);
1950 else
1951 result = x_bitmap_icon (f, arg);
1952
1953 if (result)
1954 {
1955 UNBLOCK_INPUT;
1956 error ("No icon window available");
1957 }
1958
1959 /* If the window was unmapped (and its icon was mapped),
1960 the new icon is not mapped, so map the window in its stead. */
1961 if (FRAME_VISIBLE_P (f))
1962 {
1963#ifdef USE_X_TOOLKIT
fbd6baed 1964 XtPopup (f->output_data.w32->widget, XtGrabNone);
ee78dc32 1965#endif
fbd6baed 1966 XMapWindow (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f));
ee78dc32
GV
1967 }
1968
fbd6baed 1969 XFlush (FRAME_W32_DISPLAY (f));
ee78dc32
GV
1970 UNBLOCK_INPUT;
1971#endif
1972}
1973
1974/* Return non-nil if frame F wants a bitmap icon. */
1975
1976Lisp_Object
1977x_icon_type (f)
1978 FRAME_PTR f;
1979{
1980 Lisp_Object tem;
1981
1982 tem = assq_no_quit (Qicon_type, f->param_alist);
1983 if (CONSP (tem))
1984 return XCONS (tem)->cdr;
1985 else
1986 return Qnil;
1987}
1988
1989void
1990x_set_icon_name (f, arg, oldval)
1991 struct frame *f;
1992 Lisp_Object arg, oldval;
1993{
1994 Lisp_Object tem;
1995 int result;
1996
1997 if (STRINGP (arg))
1998 {
1999 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
2000 return;
2001 }
2002 else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
2003 return;
2004
2005 f->icon_name = arg;
2006
2007#if 0
fbd6baed 2008 if (f->output_data.w32->icon_bitmap != 0)
ee78dc32
GV
2009 return;
2010
2011 BLOCK_INPUT;
2012
2013 result = x_text_icon (f,
1edf84e7 2014 (char *) XSTRING ((!NILP (f->icon_name)
ee78dc32 2015 ? f->icon_name
1edf84e7
GV
2016 : !NILP (f->title)
2017 ? f->title
ee78dc32
GV
2018 : f->name))->data);
2019
2020 if (result)
2021 {
2022 UNBLOCK_INPUT;
2023 error ("No icon window available");
2024 }
2025
2026 /* If the window was unmapped (and its icon was mapped),
2027 the new icon is not mapped, so map the window in its stead. */
2028 if (FRAME_VISIBLE_P (f))
2029 {
2030#ifdef USE_X_TOOLKIT
fbd6baed 2031 XtPopup (f->output_data.w32->widget, XtGrabNone);
ee78dc32 2032#endif
fbd6baed 2033 XMapWindow (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f));
ee78dc32
GV
2034 }
2035
fbd6baed 2036 XFlush (FRAME_W32_DISPLAY (f));
ee78dc32
GV
2037 UNBLOCK_INPUT;
2038#endif
2039}
2040
2041extern Lisp_Object x_new_font ();
2042
2043void
2044x_set_font (f, arg, oldval)
2045 struct frame *f;
2046 Lisp_Object arg, oldval;
2047{
2048 Lisp_Object result;
2049
2050 CHECK_STRING (arg, 1);
2051
2052 BLOCK_INPUT;
2053 result = x_new_font (f, XSTRING (arg)->data);
2054 UNBLOCK_INPUT;
2055
2056 if (EQ (result, Qnil))
2057 error ("Font \"%s\" is not defined", XSTRING (arg)->data);
2058 else if (EQ (result, Qt))
2059 error ("the characters of the given font have varying widths");
2060 else if (STRINGP (result))
2061 {
2062 recompute_basic_faces (f);
2063 store_frame_param (f, Qfont, result);
2064 }
2065 else
2066 abort ();
2067}
2068
2069void
2070x_set_border_width (f, arg, oldval)
2071 struct frame *f;
2072 Lisp_Object arg, oldval;
2073{
2074 CHECK_NUMBER (arg, 0);
2075
fbd6baed 2076 if (XINT (arg) == f->output_data.w32->border_width)
ee78dc32
GV
2077 return;
2078
fbd6baed 2079 if (FRAME_W32_WINDOW (f) != 0)
ee78dc32
GV
2080 error ("Cannot change the border width of a window");
2081
fbd6baed 2082 f->output_data.w32->border_width = XINT (arg);
ee78dc32
GV
2083}
2084
2085void
2086x_set_internal_border_width (f, arg, oldval)
2087 struct frame *f;
2088 Lisp_Object arg, oldval;
2089{
2090 int mask;
fbd6baed 2091 int old = f->output_data.w32->internal_border_width;
ee78dc32
GV
2092
2093 CHECK_NUMBER (arg, 0);
fbd6baed
GV
2094 f->output_data.w32->internal_border_width = XINT (arg);
2095 if (f->output_data.w32->internal_border_width < 0)
2096 f->output_data.w32->internal_border_width = 0;
ee78dc32 2097
fbd6baed 2098 if (f->output_data.w32->internal_border_width == old)
ee78dc32
GV
2099 return;
2100
fbd6baed 2101 if (FRAME_W32_WINDOW (f) != 0)
ee78dc32
GV
2102 {
2103 BLOCK_INPUT;
2104 x_set_window_size (f, 0, f->width, f->height);
2105 UNBLOCK_INPUT;
2106 SET_FRAME_GARBAGED (f);
2107 }
2108}
2109
2110void
2111x_set_visibility (f, value, oldval)
2112 struct frame *f;
2113 Lisp_Object value, oldval;
2114{
2115 Lisp_Object frame;
2116 XSETFRAME (frame, f);
2117
2118 if (NILP (value))
2119 Fmake_frame_invisible (frame, Qt);
2120 else if (EQ (value, Qicon))
2121 Ficonify_frame (frame);
2122 else
2123 Fmake_frame_visible (frame);
2124}
2125
2126void
2127x_set_menu_bar_lines (f, value, oldval)
2128 struct frame *f;
2129 Lisp_Object value, oldval;
2130{
2131 int nlines;
2132 int olines = FRAME_MENU_BAR_LINES (f);
2133
2134 /* Right now, menu bars don't work properly in minibuf-only frames;
2135 most of the commands try to apply themselves to the minibuffer
2136 frame itslef, and get an error because you can't switch buffers
2137 in or split the minibuffer window. */
2138 if (FRAME_MINIBUF_ONLY_P (f))
2139 return;
2140
2141 if (INTEGERP (value))
2142 nlines = XINT (value);
2143 else
2144 nlines = 0;
2145
2146 FRAME_MENU_BAR_LINES (f) = 0;
2147 if (nlines)
2148 FRAME_EXTERNAL_MENU_BAR (f) = 1;
2149 else
2150 {
2151 if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
2152 free_frame_menubar (f);
2153 FRAME_EXTERNAL_MENU_BAR (f) = 0;
1edf84e7
GV
2154
2155 /* Adjust the frame size so that the client (text) dimensions
2156 remain the same. This depends on FRAME_EXTERNAL_MENU_BAR being
2157 set correctly. */
2158 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
ee78dc32
GV
2159 }
2160}
2161
2162/* Change the name of frame F to NAME. If NAME is nil, set F's name to
fbd6baed 2163 w32_id_name.
ee78dc32
GV
2164
2165 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2166 name; if NAME is a string, set F's name to NAME and set
2167 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2168
2169 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2170 suggesting a new name, which lisp code should override; if
2171 F->explicit_name is set, ignore the new name; otherwise, set it. */
2172
2173void
2174x_set_name (f, name, explicit)
2175 struct frame *f;
2176 Lisp_Object name;
2177 int explicit;
2178{
2179 /* Make sure that requests from lisp code override requests from
2180 Emacs redisplay code. */
2181 if (explicit)
2182 {
2183 /* If we're switching from explicit to implicit, we had better
2184 update the mode lines and thereby update the title. */
2185 if (f->explicit_name && NILP (name))
2186 update_mode_lines = 1;
2187
2188 f->explicit_name = ! NILP (name);
2189 }
2190 else if (f->explicit_name)
2191 return;
2192
fbd6baed 2193 /* If NAME is nil, set the name to the w32_id_name. */
ee78dc32
GV
2194 if (NILP (name))
2195 {
2196 /* Check for no change needed in this very common case
2197 before we do any consing. */
fbd6baed 2198 if (!strcmp (FRAME_W32_DISPLAY_INFO (f)->w32_id_name,
ee78dc32
GV
2199 XSTRING (f->name)->data))
2200 return;
fbd6baed 2201 name = build_string (FRAME_W32_DISPLAY_INFO (f)->w32_id_name);
ee78dc32
GV
2202 }
2203 else
2204 CHECK_STRING (name, 0);
2205
2206 /* Don't change the name if it's already NAME. */
2207 if (! NILP (Fstring_equal (name, f->name)))
2208 return;
2209
1edf84e7
GV
2210 f->name = name;
2211
2212 /* For setting the frame title, the title parameter should override
2213 the name parameter. */
2214 if (! NILP (f->title))
2215 name = f->title;
2216
fbd6baed 2217 if (FRAME_W32_WINDOW (f))
ee78dc32
GV
2218 {
2219 BLOCK_INPUT;
fbd6baed 2220 SetWindowText(FRAME_W32_WINDOW (f), XSTRING (name)->data);
ee78dc32
GV
2221 UNBLOCK_INPUT;
2222 }
ee78dc32
GV
2223}
2224
2225/* This function should be called when the user's lisp code has
2226 specified a name for the frame; the name will override any set by the
2227 redisplay code. */
2228void
2229x_explicitly_set_name (f, arg, oldval)
2230 FRAME_PTR f;
2231 Lisp_Object arg, oldval;
2232{
2233 x_set_name (f, arg, 1);
2234}
2235
2236/* This function should be called by Emacs redisplay code to set the
2237 name; names set this way will never override names set by the user's
2238 lisp code. */
2239void
2240x_implicitly_set_name (f, arg, oldval)
2241 FRAME_PTR f;
2242 Lisp_Object arg, oldval;
2243{
2244 x_set_name (f, arg, 0);
2245}
1edf84e7
GV
2246\f
2247/* Change the title of frame F to NAME.
2248 If NAME is nil, use the frame name as the title.
2249
2250 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2251 name; if NAME is a string, set F's name to NAME and set
2252 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2253
2254 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2255 suggesting a new name, which lisp code should override; if
2256 F->explicit_name is set, ignore the new name; otherwise, set it. */
ee78dc32 2257
1edf84e7
GV
2258void
2259x_set_title (f, name)
2260 struct frame *f;
2261 Lisp_Object name;
2262{
2263 /* Don't change the title if it's already NAME. */
2264 if (EQ (name, f->title))
2265 return;
2266
2267 update_mode_lines = 1;
2268
2269 f->title = name;
2270
2271 if (NILP (name))
2272 name = f->name;
2273
2274 if (FRAME_W32_WINDOW (f))
2275 {
2276 BLOCK_INPUT;
2277 SetWindowText(FRAME_W32_WINDOW (f), XSTRING (name)->data);
2278 UNBLOCK_INPUT;
2279 }
2280}
2281\f
ee78dc32
GV
2282void
2283x_set_autoraise (f, arg, oldval)
2284 struct frame *f;
2285 Lisp_Object arg, oldval;
2286{
2287 f->auto_raise = !EQ (Qnil, arg);
2288}
2289
2290void
2291x_set_autolower (f, arg, oldval)
2292 struct frame *f;
2293 Lisp_Object arg, oldval;
2294{
2295 f->auto_lower = !EQ (Qnil, arg);
2296}
2297
2298void
2299x_set_unsplittable (f, arg, oldval)
2300 struct frame *f;
2301 Lisp_Object arg, oldval;
2302{
2303 f->no_split = !NILP (arg);
2304}
2305
2306void
2307x_set_vertical_scroll_bars (f, arg, oldval)
2308 struct frame *f;
2309 Lisp_Object arg, oldval;
2310{
1026b400
RS
2311 if ((EQ (arg, Qleft) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f))
2312 || (EQ (arg, Qright) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f))
2313 || (NILP (arg) && FRAME_HAS_VERTICAL_SCROLL_BARS (f))
2314 || (!NILP (arg) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f)))
ee78dc32 2315 {
1026b400
RS
2316 FRAME_VERTICAL_SCROLL_BAR_TYPE (f) = NILP (arg) ?
2317 vertical_scroll_bar_none :
87996783
GV
2318 /* Put scroll bars on the right by default, as is conventional
2319 on MS-Windows. */
2320 EQ (Qleft, arg)
2321 ? vertical_scroll_bar_left
2322 : vertical_scroll_bar_right;
ee78dc32
GV
2323
2324 /* We set this parameter before creating the window for the
2325 frame, so we can get the geometry right from the start.
2326 However, if the window hasn't been created yet, we shouldn't
2327 call x_set_window_size. */
fbd6baed 2328 if (FRAME_W32_WINDOW (f))
ee78dc32
GV
2329 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
2330 }
2331}
2332
2333void
2334x_set_scroll_bar_width (f, arg, oldval)
2335 struct frame *f;
2336 Lisp_Object arg, oldval;
2337{
2338 if (NILP (arg))
2339 {
2340 FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = 0;
2341 FRAME_SCROLL_BAR_COLS (f) = 2;
2342 }
2343 else if (INTEGERP (arg) && XINT (arg) > 0
2344 && XFASTINT (arg) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f))
2345 {
fbd6baed 2346 int wid = FONT_WIDTH (f->output_data.w32->font);
ee78dc32
GV
2347 FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = XFASTINT (arg);
2348 FRAME_SCROLL_BAR_COLS (f) = (XFASTINT (arg) + wid-1) / wid;
fbd6baed 2349 if (FRAME_W32_WINDOW (f))
ee78dc32
GV
2350 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
2351 }
2352}
2353\f
2354/* Subroutines of creating an frame. */
2355
2356/* Make sure that Vx_resource_name is set to a reasonable value.
2357 Fix it up, or set it to `emacs' if it is too hopeless. */
2358
2359static void
2360validate_x_resource_name ()
2361{
2362 int len;
2363 /* Number of valid characters in the resource name. */
2364 int good_count = 0;
2365 /* Number of invalid characters in the resource name. */
2366 int bad_count = 0;
2367 Lisp_Object new;
2368 int i;
2369
2370 if (STRINGP (Vx_resource_name))
2371 {
2372 unsigned char *p = XSTRING (Vx_resource_name)->data;
2373 int i;
2374
2375 len = XSTRING (Vx_resource_name)->size;
2376
2377 /* Only letters, digits, - and _ are valid in resource names.
2378 Count the valid characters and count the invalid ones. */
2379 for (i = 0; i < len; i++)
2380 {
2381 int c = p[i];
2382 if (! ((c >= 'a' && c <= 'z')
2383 || (c >= 'A' && c <= 'Z')
2384 || (c >= '0' && c <= '9')
2385 || c == '-' || c == '_'))
2386 bad_count++;
2387 else
2388 good_count++;
2389 }
2390 }
2391 else
2392 /* Not a string => completely invalid. */
2393 bad_count = 5, good_count = 0;
2394
2395 /* If name is valid already, return. */
2396 if (bad_count == 0)
2397 return;
2398
2399 /* If name is entirely invalid, or nearly so, use `emacs'. */
2400 if (good_count == 0
2401 || (good_count == 1 && bad_count > 0))
2402 {
2403 Vx_resource_name = build_string ("emacs");
2404 return;
2405 }
2406
2407 /* Name is partly valid. Copy it and replace the invalid characters
2408 with underscores. */
2409
2410 Vx_resource_name = new = Fcopy_sequence (Vx_resource_name);
2411
2412 for (i = 0; i < len; i++)
2413 {
2414 int c = XSTRING (new)->data[i];
2415 if (! ((c >= 'a' && c <= 'z')
2416 || (c >= 'A' && c <= 'Z')
2417 || (c >= '0' && c <= '9')
2418 || c == '-' || c == '_'))
2419 XSTRING (new)->data[i] = '_';
2420 }
2421}
2422
2423
2424extern char *x_get_string_resource ();
2425
2426DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 2, 4, 0,
2427 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
2428This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
2429class, where INSTANCE is the name under which Emacs was invoked, or\n\
2430the name specified by the `-name' or `-rn' command-line arguments.\n\
2431\n\
2432The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
2433class, respectively. You must specify both of them or neither.\n\
2434If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
2435and the class is `Emacs.CLASS.SUBCLASS'.")
2436 (attribute, class, component, subclass)
2437 Lisp_Object attribute, class, component, subclass;
2438{
2439 register char *value;
2440 char *name_key;
2441 char *class_key;
2442
2443 CHECK_STRING (attribute, 0);
2444 CHECK_STRING (class, 0);
2445
2446 if (!NILP (component))
2447 CHECK_STRING (component, 1);
2448 if (!NILP (subclass))
2449 CHECK_STRING (subclass, 2);
2450 if (NILP (component) != NILP (subclass))
2451 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2452
2453 validate_x_resource_name ();
2454
2455 /* Allocate space for the components, the dots which separate them,
2456 and the final '\0'. Make them big enough for the worst case. */
2457 name_key = (char *) alloca (XSTRING (Vx_resource_name)->size
2458 + (STRINGP (component)
2459 ? XSTRING (component)->size : 0)
2460 + XSTRING (attribute)->size
2461 + 3);
2462
2463 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
2464 + XSTRING (class)->size
2465 + (STRINGP (subclass)
2466 ? XSTRING (subclass)->size : 0)
2467 + 3);
2468
2469 /* Start with emacs.FRAMENAME for the name (the specific one)
2470 and with `Emacs' for the class key (the general one). */
2471 strcpy (name_key, XSTRING (Vx_resource_name)->data);
2472 strcpy (class_key, EMACS_CLASS);
2473
2474 strcat (class_key, ".");
2475 strcat (class_key, XSTRING (class)->data);
2476
2477 if (!NILP (component))
2478 {
2479 strcat (class_key, ".");
2480 strcat (class_key, XSTRING (subclass)->data);
2481
2482 strcat (name_key, ".");
2483 strcat (name_key, XSTRING (component)->data);
2484 }
2485
2486 strcat (name_key, ".");
2487 strcat (name_key, XSTRING (attribute)->data);
2488
2489 value = x_get_string_resource (Qnil,
2490 name_key, class_key);
2491
2492 if (value != (char *) 0)
2493 return build_string (value);
2494 else
2495 return Qnil;
2496}
2497
2498/* Used when C code wants a resource value. */
2499
2500char *
2501x_get_resource_string (attribute, class)
2502 char *attribute, *class;
2503{
2504 register char *value;
2505 char *name_key;
2506 char *class_key;
2507
2508 /* Allocate space for the components, the dots which separate them,
2509 and the final '\0'. */
2510 name_key = (char *) alloca (XSTRING (Vinvocation_name)->size
2511 + strlen (attribute) + 2);
2512 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
2513 + strlen (class) + 2);
2514
2515 sprintf (name_key, "%s.%s",
2516 XSTRING (Vinvocation_name)->data,
2517 attribute);
2518 sprintf (class_key, "%s.%s", EMACS_CLASS, class);
2519
2520 return x_get_string_resource (selected_frame,
2521 name_key, class_key);
2522}
2523
2524/* Types we might convert a resource string into. */
2525enum resource_types
2526 {
2527 number, boolean, string, symbol
2528 };
2529
2530/* Return the value of parameter PARAM.
2531
2532 First search ALIST, then Vdefault_frame_alist, then the X defaults
2533 database, using ATTRIBUTE as the attribute name and CLASS as its class.
2534
2535 Convert the resource to the type specified by desired_type.
2536
2537 If no default is specified, return Qunbound. If you call
2538 x_get_arg, make sure you deal with Qunbound in a reasonable way,
2539 and don't let it get stored in any Lisp-visible variables! */
2540
2541static Lisp_Object
2542x_get_arg (alist, param, attribute, class, type)
2543 Lisp_Object alist, param;
2544 char *attribute;
2545 char *class;
2546 enum resource_types type;
2547{
2548 register Lisp_Object tem;
2549
2550 tem = Fassq (param, alist);
2551 if (EQ (tem, Qnil))
2552 tem = Fassq (param, Vdefault_frame_alist);
2553 if (EQ (tem, Qnil))
2554 {
2555
2556 if (attribute)
2557 {
2558 tem = Fx_get_resource (build_string (attribute),
2559 build_string (class),
2560 Qnil, Qnil);
2561
2562 if (NILP (tem))
2563 return Qunbound;
2564
2565 switch (type)
2566 {
2567 case number:
2568 return make_number (atoi (XSTRING (tem)->data));
2569
2570 case boolean:
2571 tem = Fdowncase (tem);
2572 if (!strcmp (XSTRING (tem)->data, "on")
2573 || !strcmp (XSTRING (tem)->data, "true"))
2574 return Qt;
2575 else
2576 return Qnil;
2577
2578 case string:
2579 return tem;
2580
2581 case symbol:
2582 /* As a special case, we map the values `true' and `on'
2583 to Qt, and `false' and `off' to Qnil. */
2584 {
2585 Lisp_Object lower;
2586 lower = Fdowncase (tem);
2587 if (!strcmp (XSTRING (lower)->data, "on")
2588 || !strcmp (XSTRING (lower)->data, "true"))
2589 return Qt;
2590 else if (!strcmp (XSTRING (lower)->data, "off")
2591 || !strcmp (XSTRING (lower)->data, "false"))
2592 return Qnil;
2593 else
2594 return Fintern (tem, Qnil);
2595 }
2596
2597 default:
2598 abort ();
2599 }
2600 }
2601 else
2602 return Qunbound;
2603 }
2604 return Fcdr (tem);
2605}
2606
2607/* Record in frame F the specified or default value according to ALIST
2608 of the parameter named PARAM (a Lisp symbol).
2609 If no value is specified for PARAM, look for an X default for XPROP
2610 on the frame named NAME.
2611 If that is not found either, use the value DEFLT. */
2612
2613static Lisp_Object
2614x_default_parameter (f, alist, prop, deflt, xprop, xclass, type)
2615 struct frame *f;
2616 Lisp_Object alist;
2617 Lisp_Object prop;
2618 Lisp_Object deflt;
2619 char *xprop;
2620 char *xclass;
2621 enum resource_types type;
2622{
2623 Lisp_Object tem;
2624
2625 tem = x_get_arg (alist, prop, xprop, xclass, type);
2626 if (EQ (tem, Qunbound))
2627 tem = deflt;
2628 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
2629 return tem;
2630}
2631\f
2632DEFUN ("x-parse-geometry", Fx_parse_geometry, Sx_parse_geometry, 1, 1, 0,
2633 "Parse an X-style geometry string STRING.\n\
2634Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
2635The properties returned may include `top', `left', `height', and `width'.\n\
2636The value of `left' or `top' may be an integer,\n\
2637or a list (+ N) meaning N pixels relative to top/left corner,\n\
2638or a list (- N) meaning -N pixels relative to bottom/right corner.")
2639 (string)
2640 Lisp_Object string;
2641{
2642 int geometry, x, y;
2643 unsigned int width, height;
2644 Lisp_Object result;
2645
2646 CHECK_STRING (string, 0);
2647
2648 geometry = XParseGeometry ((char *) XSTRING (string)->data,
2649 &x, &y, &width, &height);
2650
2651 result = Qnil;
2652 if (geometry & XValue)
2653 {
2654 Lisp_Object element;
2655
2656 if (x >= 0 && (geometry & XNegative))
2657 element = Fcons (Qleft, Fcons (Qminus, Fcons (make_number (-x), Qnil)));
2658 else if (x < 0 && ! (geometry & XNegative))
2659 element = Fcons (Qleft, Fcons (Qplus, Fcons (make_number (x), Qnil)));
2660 else
2661 element = Fcons (Qleft, make_number (x));
2662 result = Fcons (element, result);
2663 }
2664
2665 if (geometry & YValue)
2666 {
2667 Lisp_Object element;
2668
2669 if (y >= 0 && (geometry & YNegative))
2670 element = Fcons (Qtop, Fcons (Qminus, Fcons (make_number (-y), Qnil)));
2671 else if (y < 0 && ! (geometry & YNegative))
2672 element = Fcons (Qtop, Fcons (Qplus, Fcons (make_number (y), Qnil)));
2673 else
2674 element = Fcons (Qtop, make_number (y));
2675 result = Fcons (element, result);
2676 }
2677
2678 if (geometry & WidthValue)
2679 result = Fcons (Fcons (Qwidth, make_number (width)), result);
2680 if (geometry & HeightValue)
2681 result = Fcons (Fcons (Qheight, make_number (height)), result);
2682
2683 return result;
2684}
2685
2686/* Calculate the desired size and position of this window,
2687 and return the flags saying which aspects were specified.
2688
2689 This function does not make the coordinates positive. */
2690
2691#define DEFAULT_ROWS 40
2692#define DEFAULT_COLS 80
2693
2694static int
2695x_figure_window_size (f, parms)
2696 struct frame *f;
2697 Lisp_Object parms;
2698{
2699 register Lisp_Object tem0, tem1, tem2;
2700 int height, width, left, top;
2701 register int geometry;
2702 long window_prompting = 0;
2703
2704 /* Default values if we fall through.
2705 Actually, if that happens we should get
2706 window manager prompting. */
1026b400 2707 SET_FRAME_WIDTH (f, DEFAULT_COLS);
ee78dc32
GV
2708 f->height = DEFAULT_ROWS;
2709 /* Window managers expect that if program-specified
2710 positions are not (0,0), they're intentional, not defaults. */
fbd6baed
GV
2711 f->output_data.w32->top_pos = 0;
2712 f->output_data.w32->left_pos = 0;
ee78dc32
GV
2713
2714 tem0 = x_get_arg (parms, Qheight, 0, 0, number);
2715 tem1 = x_get_arg (parms, Qwidth, 0, 0, number);
2716 tem2 = x_get_arg (parms, Quser_size, 0, 0, number);
2717 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
2718 {
2719 if (!EQ (tem0, Qunbound))
2720 {
2721 CHECK_NUMBER (tem0, 0);
2722 f->height = XINT (tem0);
2723 }
2724 if (!EQ (tem1, Qunbound))
2725 {
2726 CHECK_NUMBER (tem1, 0);
1026b400 2727 SET_FRAME_WIDTH (f, XINT (tem1));
ee78dc32
GV
2728 }
2729 if (!NILP (tem2) && !EQ (tem2, Qunbound))
2730 window_prompting |= USSize;
2731 else
2732 window_prompting |= PSize;
2733 }
2734
fbd6baed 2735 f->output_data.w32->vertical_scroll_bar_extra
ee78dc32
GV
2736 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f)
2737 ? 0
2738 : FRAME_SCROLL_BAR_PIXEL_WIDTH (f) > 0
2739 ? FRAME_SCROLL_BAR_PIXEL_WIDTH (f)
fbd6baed
GV
2740 : (FRAME_SCROLL_BAR_COLS (f) * FONT_WIDTH (f->output_data.w32->font)));
2741 f->output_data.w32->pixel_width = CHAR_TO_PIXEL_WIDTH (f, f->width);
2742 f->output_data.w32->pixel_height = CHAR_TO_PIXEL_HEIGHT (f, f->height);
ee78dc32
GV
2743
2744 tem0 = x_get_arg (parms, Qtop, 0, 0, number);
2745 tem1 = x_get_arg (parms, Qleft, 0, 0, number);
2746 tem2 = x_get_arg (parms, Quser_position, 0, 0, number);
2747 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
2748 {
2749 if (EQ (tem0, Qminus))
2750 {
fbd6baed 2751 f->output_data.w32->top_pos = 0;
ee78dc32
GV
2752 window_prompting |= YNegative;
2753 }
2754 else if (CONSP (tem0) && EQ (XCONS (tem0)->car, Qminus)
2755 && CONSP (XCONS (tem0)->cdr)
2756 && INTEGERP (XCONS (XCONS (tem0)->cdr)->car))
2757 {
fbd6baed 2758 f->output_data.w32->top_pos = - XINT (XCONS (XCONS (tem0)->cdr)->car);
ee78dc32
GV
2759 window_prompting |= YNegative;
2760 }
2761 else if (CONSP (tem0) && EQ (XCONS (tem0)->car, Qplus)
2762 && CONSP (XCONS (tem0)->cdr)
2763 && INTEGERP (XCONS (XCONS (tem0)->cdr)->car))
2764 {
fbd6baed 2765 f->output_data.w32->top_pos = XINT (XCONS (XCONS (tem0)->cdr)->car);
ee78dc32
GV
2766 }
2767 else if (EQ (tem0, Qunbound))
fbd6baed 2768 f->output_data.w32->top_pos = 0;
ee78dc32
GV
2769 else
2770 {
2771 CHECK_NUMBER (tem0, 0);
fbd6baed
GV
2772 f->output_data.w32->top_pos = XINT (tem0);
2773 if (f->output_data.w32->top_pos < 0)
ee78dc32
GV
2774 window_prompting |= YNegative;
2775 }
2776
2777 if (EQ (tem1, Qminus))
2778 {
fbd6baed 2779 f->output_data.w32->left_pos = 0;
ee78dc32
GV
2780 window_prompting |= XNegative;
2781 }
2782 else if (CONSP (tem1) && EQ (XCONS (tem1)->car, Qminus)
2783 && CONSP (XCONS (tem1)->cdr)
2784 && INTEGERP (XCONS (XCONS (tem1)->cdr)->car))
2785 {
fbd6baed 2786 f->output_data.w32->left_pos = - XINT (XCONS (XCONS (tem1)->cdr)->car);
ee78dc32
GV
2787 window_prompting |= XNegative;
2788 }
2789 else if (CONSP (tem1) && EQ (XCONS (tem1)->car, Qplus)
2790 && CONSP (XCONS (tem1)->cdr)
2791 && INTEGERP (XCONS (XCONS (tem1)->cdr)->car))
2792 {
fbd6baed 2793 f->output_data.w32->left_pos = XINT (XCONS (XCONS (tem1)->cdr)->car);
ee78dc32
GV
2794 }
2795 else if (EQ (tem1, Qunbound))
fbd6baed 2796 f->output_data.w32->left_pos = 0;
ee78dc32
GV
2797 else
2798 {
2799 CHECK_NUMBER (tem1, 0);
fbd6baed
GV
2800 f->output_data.w32->left_pos = XINT (tem1);
2801 if (f->output_data.w32->left_pos < 0)
ee78dc32
GV
2802 window_prompting |= XNegative;
2803 }
2804
2805 if (!NILP (tem2) && ! EQ (tem2, Qunbound))
2806 window_prompting |= USPosition;
2807 else
2808 window_prompting |= PPosition;
2809 }
2810
2811 return window_prompting;
2812}
2813
2814\f
2815
fbd6baed 2816extern LRESULT CALLBACK w32_wnd_proc ();
ee78dc32
GV
2817
2818BOOL
fbd6baed 2819w32_init_class (hinst)
ee78dc32
GV
2820 HINSTANCE hinst;
2821{
2822 WNDCLASS wc;
2823
5ac45f98 2824 wc.style = CS_HREDRAW | CS_VREDRAW;
fbd6baed 2825 wc.lpfnWndProc = (WNDPROC) w32_wnd_proc;
ee78dc32
GV
2826 wc.cbClsExtra = 0;
2827 wc.cbWndExtra = WND_EXTRA_BYTES;
2828 wc.hInstance = hinst;
2829 wc.hIcon = LoadIcon (hinst, EMACS_CLASS);
2830 wc.hCursor = LoadCursor (NULL, IDC_ARROW);
2831 wc.hbrBackground = NULL; // GetStockObject (WHITE_BRUSH);
2832 wc.lpszMenuName = NULL;
2833 wc.lpszClassName = EMACS_CLASS;
2834
2835 return (RegisterClass (&wc));
2836}
2837
2838HWND
fbd6baed 2839w32_createscrollbar (f, bar)
ee78dc32
GV
2840 struct frame *f;
2841 struct scroll_bar * bar;
2842{
2843 return (CreateWindow ("SCROLLBAR", "", SBS_VERT | WS_CHILD | WS_VISIBLE,
2844 /* Position and size of scroll bar. */
2845 XINT(bar->left), XINT(bar->top),
2846 XINT(bar->width), XINT(bar->height),
fbd6baed 2847 FRAME_W32_WINDOW (f),
ee78dc32
GV
2848 NULL,
2849 hinst,
2850 NULL));
2851}
2852
2853void
fbd6baed 2854w32_createwindow (f)
ee78dc32
GV
2855 struct frame *f;
2856{
2857 HWND hwnd;
1edf84e7
GV
2858 RECT rect;
2859
2860 rect.left = rect.top = 0;
2861 rect.right = PIXEL_WIDTH (f);
2862 rect.bottom = PIXEL_HEIGHT (f);
2863
2864 AdjustWindowRect (&rect, f->output_data.w32->dwStyle,
2865 FRAME_EXTERNAL_MENU_BAR (f));
ee78dc32
GV
2866
2867 /* Do first time app init */
2868
2869 if (!hprevinst)
2870 {
fbd6baed 2871 w32_init_class (hinst);
ee78dc32
GV
2872 }
2873
1edf84e7
GV
2874 FRAME_W32_WINDOW (f) = hwnd
2875 = CreateWindow (EMACS_CLASS,
2876 f->namebuf,
2877 f->output_data.w32->dwStyle | WS_CLIPCHILDREN,
2878 f->output_data.w32->left_pos,
2879 f->output_data.w32->top_pos,
2880 rect.right - rect.left,
2881 rect.bottom - rect.top,
2882 NULL,
2883 NULL,
2884 hinst,
2885 NULL);
2886
ee78dc32
GV
2887 if (hwnd)
2888 {
1edf84e7
GV
2889 SetWindowLong (hwnd, WND_FONTWIDTH_INDEX, FONT_WIDTH (f->output_data.w32->font));
2890 SetWindowLong (hwnd, WND_LINEHEIGHT_INDEX, f->output_data.w32->line_height);
2891 SetWindowLong (hwnd, WND_BORDER_INDEX, f->output_data.w32->internal_border_width);
2892 SetWindowLong (hwnd, WND_SCROLLBAR_INDEX, f->output_data.w32->vertical_scroll_bar_extra);
fbd6baed 2893 SetWindowLong (hwnd, WND_BACKGROUND_INDEX, f->output_data.w32->background_pixel);
ee78dc32 2894
cb9e33d4
RS
2895 /* Enable drag-n-drop. */
2896 DragAcceptFiles (hwnd, TRUE);
2897
5ac45f98
GV
2898 /* Do this to discard the default setting specified by our parent. */
2899 ShowWindow (hwnd, SW_HIDE);
3c190163 2900 }
3c190163
GV
2901}
2902
fbd6baed 2903/* Convert between the modifier bits W32 uses and the modifier bits
ee78dc32
GV
2904 Emacs uses. */
2905unsigned int
fbd6baed 2906w32_get_modifiers ()
ee78dc32
GV
2907{
2908 return (((GetKeyState (VK_SHIFT)&0x8000) ? shift_modifier : 0) |
2909 ((GetKeyState (VK_CONTROL)&0x8000) ? ctrl_modifier : 0) |
8c205c63 2910 ((GetKeyState (VK_MENU)&0x8000) ?
fbd6baed 2911 ((NILP (Vw32_alt_is_meta)) ? alt_modifier : meta_modifier) : 0));
ee78dc32
GV
2912}
2913
2914void
2915my_post_msg (wmsg, hwnd, msg, wParam, lParam)
fbd6baed 2916 W32Msg * wmsg;
ee78dc32
GV
2917 HWND hwnd;
2918 UINT msg;
2919 WPARAM wParam;
2920 LPARAM lParam;
2921{
2922 wmsg->msg.hwnd = hwnd;
2923 wmsg->msg.message = msg;
2924 wmsg->msg.wParam = wParam;
2925 wmsg->msg.lParam = lParam;
2926 wmsg->msg.time = GetMessageTime ();
2927
2928 post_msg (wmsg);
2929}
2930
e9e23e23 2931/* GetKeyState and MapVirtualKey on Windows 95 do not actually distinguish
a1a80b40
GV
2932 between left and right keys as advertised. We test for this
2933 support dynamically, and set a flag when the support is absent. If
2934 absent, we keep track of the left and right control and alt keys
2935 ourselves. This is particularly necessary on keyboards that rely
2936 upon the AltGr key, which is represented as having the left control
2937 and right alt keys pressed. For these keyboards, we need to know
2938 when the left alt key has been pressed in addition to the AltGr key
2939 so that we can properly support M-AltGr-key sequences (such as M-@
2940 on Swedish keyboards). */
2941
2942#define EMACS_LCONTROL 0
2943#define EMACS_RCONTROL 1
2944#define EMACS_LMENU 2
2945#define EMACS_RMENU 3
2946
2947static int modifiers[4];
2948static int modifiers_recorded;
2949static int modifier_key_support_tested;
2950
2951static void
2952test_modifier_support (unsigned int wparam)
2953{
2954 unsigned int l, r;
2955
2956 if (wparam != VK_CONTROL && wparam != VK_MENU)
2957 return;
2958 if (wparam == VK_CONTROL)
2959 {
2960 l = VK_LCONTROL;
2961 r = VK_RCONTROL;
2962 }
2963 else
2964 {
2965 l = VK_LMENU;
2966 r = VK_RMENU;
2967 }
2968 if (!(GetKeyState (l) & 0x8000) && !(GetKeyState (r) & 0x8000))
2969 modifiers_recorded = 1;
2970 else
2971 modifiers_recorded = 0;
2972 modifier_key_support_tested = 1;
2973}
2974
2975static void
2976record_keydown (unsigned int wparam, unsigned int lparam)
2977{
2978 int i;
2979
2980 if (!modifier_key_support_tested)
2981 test_modifier_support (wparam);
2982
2983 if ((wparam != VK_CONTROL && wparam != VK_MENU) || !modifiers_recorded)
2984 return;
2985
2986 if (wparam == VK_CONTROL)
2987 i = (lparam & 0x1000000) ? EMACS_RCONTROL : EMACS_LCONTROL;
2988 else
2989 i = (lparam & 0x1000000) ? EMACS_RMENU : EMACS_LMENU;
2990
2991 modifiers[i] = 1;
2992}
2993
2994static void
2995record_keyup (unsigned int wparam, unsigned int lparam)
2996{
2997 int i;
2998
2999 if ((wparam != VK_CONTROL && wparam != VK_MENU) || !modifiers_recorded)
3000 return;
3001
3002 if (wparam == VK_CONTROL)
3003 i = (lparam & 0x1000000) ? EMACS_RCONTROL : EMACS_LCONTROL;
3004 else
3005 i = (lparam & 0x1000000) ? EMACS_RMENU : EMACS_LMENU;
3006
3007 modifiers[i] = 0;
3008}
3009
da36a4d6
GV
3010/* Emacs can lose focus while a modifier key has been pressed. When
3011 it regains focus, be conservative and clear all modifiers since
3012 we cannot reconstruct the left and right modifier state. */
3013static void
3014reset_modifiers ()
3015{
8681157a
RS
3016 SHORT ctrl, alt;
3017
da36a4d6
GV
3018 if (!modifiers_recorded)
3019 return;
8681157a
RS
3020
3021 ctrl = GetAsyncKeyState (VK_CONTROL);
3022 alt = GetAsyncKeyState (VK_MENU);
3023
3024 if (ctrl == 0 || alt == 0)
3025 /* Emacs doesn't have keyboard focus. Do nothing. */
3026 return;
3027
3028 if (!(ctrl & 0x08000))
3029 /* Clear any recorded control modifier state. */
3030 modifiers[EMACS_RCONTROL] = modifiers[EMACS_LCONTROL] = 0;
3031
3032 if (!(alt & 0x08000))
3033 /* Clear any recorded alt modifier state. */
3034 modifiers[EMACS_RMENU] = modifiers[EMACS_LMENU] = 0;
3035
3036 /* Otherwise, leave the modifier state as it was when Emacs lost
3037 keyboard focus. */
da36a4d6
GV
3038}
3039
7830e24b
RS
3040/* Synchronize modifier state with what is reported with the current
3041 keystroke. Even if we cannot distinguish between left and right
3042 modifier keys, we know that, if no modifiers are set, then neither
3043 the left or right modifier should be set. */
3044static void
3045sync_modifiers ()
3046{
3047 if (!modifiers_recorded)
3048 return;
3049
3050 if (!(GetKeyState (VK_CONTROL) & 0x8000))
3051 modifiers[EMACS_RCONTROL] = modifiers[EMACS_LCONTROL] = 0;
3052
3053 if (!(GetKeyState (VK_MENU) & 0x8000))
3054 modifiers[EMACS_RMENU] = modifiers[EMACS_LMENU] = 0;
3055}
3056
a1a80b40
GV
3057static int
3058modifier_set (int vkey)
3059{
891560d6
KH
3060 if (vkey == VK_CAPITAL)
3061 return (GetKeyState (vkey) & 0x1);
a1a80b40
GV
3062 if (!modifiers_recorded)
3063 return (GetKeyState (vkey) & 0x8000);
3064
3065 switch (vkey)
3066 {
3067 case VK_LCONTROL:
3068 return modifiers[EMACS_LCONTROL];
3069 case VK_RCONTROL:
3070 return modifiers[EMACS_RCONTROL];
3071 case VK_LMENU:
3072 return modifiers[EMACS_LMENU];
3073 case VK_RMENU:
3074 return modifiers[EMACS_RMENU];
a1a80b40
GV
3075 default:
3076 break;
3077 }
3078 return (GetKeyState (vkey) & 0x8000);
3079}
3080
3081/* We map the VK_* modifiers into console modifier constants
3082 so that we can use the same routines to handle both console
3083 and window input. */
3084
3085static int
3086construct_modifiers (unsigned int wparam, unsigned int lparam)
3087{
3088 int mods;
3089
3090 if (wparam != VK_CONTROL && wparam != VK_MENU)
3091 mods = GetLastError ();
3092
3093 mods = 0;
3094 mods |= (modifier_set (VK_SHIFT)) ? SHIFT_PRESSED : 0;
3095 mods |= (modifier_set (VK_CAPITAL)) ? CAPSLOCK_ON : 0;
3096 mods |= (modifier_set (VK_LCONTROL)) ? LEFT_CTRL_PRESSED : 0;
3097 mods |= (modifier_set (VK_RCONTROL)) ? RIGHT_CTRL_PRESSED : 0;
3098 mods |= (modifier_set (VK_LMENU)) ? LEFT_ALT_PRESSED : 0;
3099 mods |= (modifier_set (VK_RMENU)) ? RIGHT_ALT_PRESSED : 0;
3100
3101 return mods;
3102}
3103
da36a4d6
GV
3104static unsigned int
3105map_keypad_keys (unsigned int wparam, unsigned int lparam)
3106{
3107 unsigned int extended = (lparam & 0x1000000L);
3108
3109 if (wparam < VK_CLEAR || wparam > VK_DELETE)
3110 return wparam;
3111
3112 if (wparam == VK_RETURN)
3113 return (extended ? VK_NUMPAD_ENTER : VK_RETURN);
3114
3115 if (wparam >= VK_PRIOR && wparam <= VK_DOWN)
3116 return (!extended ? (VK_NUMPAD_PRIOR + (wparam - VK_PRIOR)) : wparam);
3117
3118 if (wparam == VK_INSERT || wparam == VK_DELETE)
3119 return (!extended ? (VK_NUMPAD_INSERT + (wparam - VK_INSERT)) : wparam);
3120
3121 if (wparam == VK_CLEAR)
3122 return (!extended ? VK_NUMPAD_CLEAR : wparam);
3123
3124 return wparam;
3125}
3126
5ac45f98
GV
3127/* Main message dispatch loop. */
3128
1edf84e7
GV
3129static void
3130w32_msg_pump (deferred_msg * msg_buf)
5ac45f98
GV
3131{
3132 MSG msg;
93fbe8b7
GV
3133
3134 msh_mousewheel = RegisterWindowMessage (MSH_MOUSEWHEEL);
5ac45f98 3135
5ac45f98
GV
3136 while (GetMessage (&msg, NULL, 0, 0))
3137 {
3138 if (msg.hwnd == NULL)
3139 {
3140 switch (msg.message)
3141 {
5ac45f98 3142 case WM_EMACS_CREATEWINDOW:
fbd6baed 3143 w32_createwindow ((struct frame *) msg.wParam);
1edf84e7
GV
3144 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0))
3145 abort ();
5ac45f98 3146 break;
dfdb4047
GV
3147 case WM_EMACS_SETLOCALE:
3148 SetThreadLocale (msg.wParam);
3149 /* Reply is not expected. */
3150 break;
1edf84e7
GV
3151 default:
3152 /* No need to be so draconian! */
3153 /* abort (); */
3154 DebPrint (("msg %x not expected by w32_msg_pump\n", msg.message));
5ac45f98
GV
3155 }
3156 }
3157 else
3158 {
3159 DispatchMessage (&msg);
3160 }
1edf84e7
GV
3161
3162 /* Exit nested loop when our deferred message has completed. */
3163 if (msg_buf->completed)
3164 break;
5ac45f98 3165 }
1edf84e7
GV
3166}
3167
3168deferred_msg * deferred_msg_head;
3169
3170static deferred_msg *
3171find_deferred_msg (HWND hwnd, UINT msg)
3172{
3173 deferred_msg * item;
3174
3175 /* Don't actually need synchronization for read access, since
3176 modification of single pointer is always atomic. */
3177 /* enter_crit (); */
3178
3179 for (item = deferred_msg_head; item != NULL; item = item->next)
3180 if (item->w32msg.msg.hwnd == hwnd
3181 && item->w32msg.msg.message == msg)
3182 break;
3183
3184 /* leave_crit (); */
3185
3186 return item;
3187}
3188
3189static LRESULT
3190send_deferred_msg (deferred_msg * msg_buf,
3191 HWND hwnd,
3192 UINT msg,
3193 WPARAM wParam,
3194 LPARAM lParam)
3195{
3196 /* Only input thread can send deferred messages. */
3197 if (GetCurrentThreadId () != dwWindowsThreadId)
3198 abort ();
3199
3200 /* It is an error to send a message that is already deferred. */
3201 if (find_deferred_msg (hwnd, msg) != NULL)
3202 abort ();
3203
3204 /* Enforced synchronization is not needed because this is the only
3205 function that alters deferred_msg_head, and the following critical
3206 section is guaranteed to only be serially reentered (since only the
3207 input thread can call us). */
3208
3209 /* enter_crit (); */
3210
3211 msg_buf->completed = 0;
3212 msg_buf->next = deferred_msg_head;
3213 deferred_msg_head = msg_buf;
3214 my_post_msg (&msg_buf->w32msg, hwnd, msg, wParam, lParam);
3215
3216 /* leave_crit (); */
3217
3218 /* Start a new nested message loop to process other messages until
3219 this one is completed. */
3220 w32_msg_pump (msg_buf);
3221
3222 deferred_msg_head = msg_buf->next;
3223
3224 return msg_buf->result;
3225}
3226
3227void
3228complete_deferred_msg (HWND hwnd, UINT msg, LRESULT result)
3229{
3230 deferred_msg * msg_buf = find_deferred_msg (hwnd, msg);
3231
3232 if (msg_buf == NULL)
3233 abort ();
3234
3235 msg_buf->result = result;
3236 msg_buf->completed = 1;
3237
3238 /* Ensure input thread is woken so it notices the completion. */
3239 PostThreadMessage (dwWindowsThreadId, WM_NULL, 0, 0);
3240}
3241
3242
3243DWORD
3244w32_msg_worker (dw)
3245 DWORD dw;
3246{
3247 MSG msg;
3248 deferred_msg dummy_buf;
3249
3250 /* Ensure our message queue is created */
3251
3252 PeekMessage (&msg, NULL, 0, 0, PM_NOREMOVE);
5ac45f98 3253
1edf84e7
GV
3254 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0))
3255 abort ();
3256
3257 memset (&dummy_buf, 0, sizeof (dummy_buf));
3258 dummy_buf.w32msg.msg.hwnd = NULL;
3259 dummy_buf.w32msg.msg.message = WM_NULL;
3260
3261 /* This is the inital message loop which should only exit when the
3262 application quits. */
3263 w32_msg_pump (&dummy_buf);
3264
3265 return 0;
5ac45f98
GV
3266}
3267
ee78dc32
GV
3268/* Main window procedure */
3269
3270extern char *lispy_function_keys[];
3271
3272LRESULT CALLBACK
fbd6baed 3273w32_wnd_proc (hwnd, msg, wParam, lParam)
ee78dc32
GV
3274 HWND hwnd;
3275 UINT msg;
3276 WPARAM wParam;
3277 LPARAM lParam;
3278{
3279 struct frame *f;
fbd6baed
GV
3280 struct w32_display_info *dpyinfo = &one_w32_display_info;
3281 W32Msg wmsg;
84fb1139
KH
3282 int windows_translate;
3283
a6085637
KH
3284 /* Note that it is okay to call x_window_to_frame, even though we are
3285 not running in the main lisp thread, because frame deletion
3286 requires the lisp thread to synchronize with this thread. Thus, if
3287 a frame struct is returned, it can be used without concern that the
3288 lisp thread might make it disappear while we are using it.
3289
3290 NB. Walking the frame list in this thread is safe (as long as
3291 writes of Lisp_Object slots are atomic, which they are on Windows).
3292 Although delete-frame can destructively modify the frame list while
3293 we are walking it, a garbage collection cannot occur until after
3294 delete-frame has synchronized with this thread.
3295
3296 It is also safe to use functions that make GDI calls, such as
fbd6baed 3297 w32_clear_rect, because these functions must obtain a DC handle
a6085637
KH
3298 from the frame struct using get_frame_dc which is thread-aware. */
3299
ee78dc32
GV
3300 switch (msg)
3301 {
3302 case WM_ERASEBKGND:
a6085637
KH
3303 f = x_window_to_frame (dpyinfo, hwnd);
3304 if (f)
3305 {
3306 GetUpdateRect (hwnd, &wmsg.rect, FALSE);
fbd6baed 3307 w32_clear_rect (f, NULL, &wmsg.rect);
a6085637 3308 }
5ac45f98
GV
3309 return 1;
3310 case WM_PALETTECHANGED:
3311 /* ignore our own changes */
3312 if ((HWND)wParam != hwnd)
3313 {
a6085637
KH
3314 f = x_window_to_frame (dpyinfo, hwnd);
3315 if (f)
3316 /* get_frame_dc will realize our palette and force all
3317 frames to be redrawn if needed. */
3318 release_frame_dc (f, get_frame_dc (f));
5ac45f98
GV
3319 }
3320 return 0;
ee78dc32
GV
3321 case WM_PAINT:
3322 {
3323 PAINTSTRUCT paintStruct;
5ac45f98
GV
3324
3325 enter_crit ();
ee78dc32
GV
3326 BeginPaint (hwnd, &paintStruct);
3327 wmsg.rect = paintStruct.rcPaint;
3328 EndPaint (hwnd, &paintStruct);
5ac45f98
GV
3329 leave_crit ();
3330
ee78dc32
GV
3331 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3332
3333 return (0);
3334 }
a1a80b40
GV
3335
3336 case WM_KEYUP:
3337 case WM_SYSKEYUP:
3338 record_keyup (wParam, lParam);
3339 goto dflt;
3340
ee78dc32
GV
3341 case WM_KEYDOWN:
3342 case WM_SYSKEYDOWN:
7830e24b
RS
3343 /* Synchronize modifiers with current keystroke. */
3344 sync_modifiers ();
3345
a1a80b40
GV
3346 record_keydown (wParam, lParam);
3347
da36a4d6 3348 wParam = map_keypad_keys (wParam, lParam);
84fb1139
KH
3349
3350 windows_translate = 0;
a1a80b40 3351 switch (wParam) {
da36a4d6
GV
3352 case VK_LWIN:
3353 case VK_RWIN:
3354 case VK_APPS:
3355 /* More support for these keys will likely be necessary. */
fbd6baed 3356 if (!NILP (Vw32_pass_optional_keys_to_system))
84fb1139 3357 windows_translate = 1;
da36a4d6
GV
3358 break;
3359 case VK_MENU:
fbd6baed 3360 if (NILP (Vw32_pass_alt_to_system))
da36a4d6 3361 return 0;
84fb1139
KH
3362 windows_translate = 1;
3363 break;
da36a4d6
GV
3364 case VK_CONTROL:
3365 case VK_CAPITAL:
3366 case VK_SHIFT:
8681157a
RS
3367 case VK_NUMLOCK:
3368 case VK_SCROLL:
84fb1139
KH
3369 windows_translate = 1;
3370 break;
a1a80b40 3371 default:
da36a4d6
GV
3372 /* If not defined as a function key, change it to a WM_CHAR message. */
3373 if (lispy_function_keys[wParam] == 0)
3374 msg = WM_CHAR;
3c190163 3375 break;
a1a80b40
GV
3376 }
3377
84fb1139
KH
3378 if (windows_translate)
3379 {
e9e23e23 3380 MSG windows_msg = { hwnd, msg, wParam, lParam, 0, {0,0} };
84fb1139 3381
e9e23e23
GV
3382 windows_msg.time = GetMessageTime ();
3383 TranslateMessage (&windows_msg);
84fb1139
KH
3384 goto dflt;
3385 }
3386
ee78dc32
GV
3387 /* Fall through */
3388
3389 case WM_SYSCHAR:
3390 case WM_CHAR:
a1a80b40 3391 wmsg.dwModifiers = construct_modifiers (wParam, lParam);
da36a4d6 3392
3d32fc48 3393#if 1
3aef7b4e
GV
3394 /* Detect quit_char and set quit-flag directly. Note that we
3395 still need to post a message to ensure the main thread will be
3396 woken up if blocked in sys_select(), but we do NOT want to post
3397 the quit_char message itself (because it will usually be as if
3398 the user had typed quit_char twice). Instead, we post a dummy
3399 message that has no particular effect. */
5ac45f98
GV
3400 {
3401 int c = wParam;
3402 if (isalpha (c) && (wmsg.dwModifiers == LEFT_CTRL_PRESSED
3403 || wmsg.dwModifiers == RIGHT_CTRL_PRESSED))
3404 c = make_ctrl_char (c) & 0377;
3405 if (c == quit_char)
3aef7b4e
GV
3406 {
3407 Vquit_flag = Qt;
3408
3409 /* The choice of message is somewhat arbitrary, as long as
3410 the main thread handler just ignores it. */
3411 msg = WM_QUIT;
3412 }
5ac45f98 3413 }
4ba07e88
GV
3414#endif
3415
3aef7b4e
GV
3416 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3417
ee78dc32 3418 break;
da36a4d6 3419
5ac45f98
GV
3420 /* Simulate middle mouse button events when left and right buttons
3421 are used together, but only if user has two button mouse. */
ee78dc32 3422 case WM_LBUTTONDOWN:
5ac45f98 3423 case WM_RBUTTONDOWN:
fbd6baed 3424 if (XINT (Vw32_num_mouse_buttons) == 3)
5ac45f98
GV
3425 goto handle_plain_button;
3426
3427 {
3428 int this = (msg == WM_LBUTTONDOWN) ? LMOUSE : RMOUSE;
3429 int other = (msg == WM_LBUTTONDOWN) ? RMOUSE : LMOUSE;
3430
3cb20f4a
RS
3431 if (button_state & this)
3432 return 0;
5ac45f98
GV
3433
3434 if (button_state == 0)
3435 SetCapture (hwnd);
3436
3437 button_state |= this;
3438
3439 if (button_state & other)
3440 {
84fb1139 3441 if (mouse_button_timer)
5ac45f98 3442 {
84fb1139
KH
3443 KillTimer (hwnd, mouse_button_timer);
3444 mouse_button_timer = 0;
5ac45f98
GV
3445
3446 /* Generate middle mouse event instead. */
3447 msg = WM_MBUTTONDOWN;
3448 button_state |= MMOUSE;
3449 }
3450 else if (button_state & MMOUSE)
3451 {
3452 /* Ignore button event if we've already generated a
3453 middle mouse down event. This happens if the
3454 user releases and press one of the two buttons
3455 after we've faked a middle mouse event. */
3456 return 0;
3457 }
3458 else
3459 {
3460 /* Flush out saved message. */
84fb1139 3461 post_msg (&saved_mouse_button_msg);
5ac45f98 3462 }
fbd6baed 3463 wmsg.dwModifiers = w32_get_modifiers ();
5ac45f98
GV
3464 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3465
3466 /* Clear message buffer. */
84fb1139 3467 saved_mouse_button_msg.msg.hwnd = 0;
5ac45f98
GV
3468 }
3469 else
3470 {
3471 /* Hold onto message for now. */
84fb1139 3472 mouse_button_timer =
fbd6baed 3473 SetTimer (hwnd, MOUSE_BUTTON_ID, XINT (Vw32_mouse_button_tolerance), NULL);
84fb1139
KH
3474 saved_mouse_button_msg.msg.hwnd = hwnd;
3475 saved_mouse_button_msg.msg.message = msg;
3476 saved_mouse_button_msg.msg.wParam = wParam;
3477 saved_mouse_button_msg.msg.lParam = lParam;
3478 saved_mouse_button_msg.msg.time = GetMessageTime ();
fbd6baed 3479 saved_mouse_button_msg.dwModifiers = w32_get_modifiers ();
5ac45f98
GV
3480 }
3481 }
3482 return 0;
3483
ee78dc32 3484 case WM_LBUTTONUP:
5ac45f98 3485 case WM_RBUTTONUP:
fbd6baed 3486 if (XINT (Vw32_num_mouse_buttons) == 3)
5ac45f98
GV
3487 goto handle_plain_button;
3488
3489 {
3490 int this = (msg == WM_LBUTTONUP) ? LMOUSE : RMOUSE;
3491 int other = (msg == WM_LBUTTONUP) ? RMOUSE : LMOUSE;
3492
3cb20f4a
RS
3493 if ((button_state & this) == 0)
3494 return 0;
5ac45f98
GV
3495
3496 button_state &= ~this;
3497
3498 if (button_state & MMOUSE)
3499 {
3500 /* Only generate event when second button is released. */
3501 if ((button_state & other) == 0)
3502 {
3503 msg = WM_MBUTTONUP;
3504 button_state &= ~MMOUSE;
3505
3506 if (button_state) abort ();
3507 }
3508 else
3509 return 0;
3510 }
3511 else
3512 {
3513 /* Flush out saved message if necessary. */
84fb1139 3514 if (saved_mouse_button_msg.msg.hwnd)
5ac45f98 3515 {
84fb1139 3516 post_msg (&saved_mouse_button_msg);
5ac45f98
GV
3517 }
3518 }
fbd6baed 3519 wmsg.dwModifiers = w32_get_modifiers ();
5ac45f98
GV
3520 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3521
3522 /* Always clear message buffer and cancel timer. */
84fb1139
KH
3523 saved_mouse_button_msg.msg.hwnd = 0;
3524 KillTimer (hwnd, mouse_button_timer);
3525 mouse_button_timer = 0;
5ac45f98
GV
3526
3527 if (button_state == 0)
3528 ReleaseCapture ();
3529 }
3530 return 0;
3531
ee78dc32
GV
3532 case WM_MBUTTONDOWN:
3533 case WM_MBUTTONUP:
5ac45f98 3534 handle_plain_button:
ee78dc32
GV
3535 {
3536 BOOL up;
1edf84e7 3537 int button;
ee78dc32 3538
1edf84e7 3539 if (parse_button (msg, &button, &up))
ee78dc32
GV
3540 {
3541 if (up) ReleaseCapture ();
3542 else SetCapture (hwnd);
1edf84e7
GV
3543 button = (button == 0) ? LMOUSE :
3544 ((button == 1) ? MMOUSE : RMOUSE);
3545 if (up)
3546 button_state &= ~button;
3547 else
3548 button_state |= button;
ee78dc32
GV
3549 }
3550 }
3551
fbd6baed 3552 wmsg.dwModifiers = w32_get_modifiers ();
ee78dc32 3553 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
5ac45f98
GV
3554 return 0;
3555
84fb1139 3556 case WM_VSCROLL:
5ac45f98 3557 case WM_MOUSEMOVE:
fbd6baed 3558 if (XINT (Vw32_mouse_move_interval) <= 0
84fb1139
KH
3559 || (msg == WM_MOUSEMOVE && button_state == 0))
3560 {
fbd6baed 3561 wmsg.dwModifiers = w32_get_modifiers ();
84fb1139
KH
3562 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3563 return 0;
3564 }
3565
3566 /* Hang onto mouse move and scroll messages for a bit, to avoid
3567 sending such events to Emacs faster than it can process them.
3568 If we get more events before the timer from the first message
3569 expires, we just replace the first message. */
3570
3571 if (saved_mouse_move_msg.msg.hwnd == 0)
3572 mouse_move_timer =
fbd6baed 3573 SetTimer (hwnd, MOUSE_MOVE_ID, XINT (Vw32_mouse_move_interval), NULL);
84fb1139
KH
3574
3575 /* Hold onto message for now. */
3576 saved_mouse_move_msg.msg.hwnd = hwnd;
3577 saved_mouse_move_msg.msg.message = msg;
3578 saved_mouse_move_msg.msg.wParam = wParam;
3579 saved_mouse_move_msg.msg.lParam = lParam;
3580 saved_mouse_move_msg.msg.time = GetMessageTime ();
fbd6baed 3581 saved_mouse_move_msg.dwModifiers = w32_get_modifiers ();
84fb1139
KH
3582
3583 return 0;
3584
1edf84e7
GV
3585 case WM_MOUSEWHEEL:
3586 wmsg.dwModifiers = w32_get_modifiers ();
3587 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3588 return 0;
3589
cb9e33d4
RS
3590 case WM_DROPFILES:
3591 wmsg.dwModifiers = w32_get_modifiers ();
3592 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3593 return 0;
3594
84fb1139
KH
3595 case WM_TIMER:
3596 /* Flush out saved messages if necessary. */
3597 if (wParam == mouse_button_timer)
5ac45f98 3598 {
84fb1139
KH
3599 if (saved_mouse_button_msg.msg.hwnd)
3600 {
3601 post_msg (&saved_mouse_button_msg);
3602 saved_mouse_button_msg.msg.hwnd = 0;
3603 }
3604 KillTimer (hwnd, mouse_button_timer);
3605 mouse_button_timer = 0;
3606 }
3607 else if (wParam == mouse_move_timer)
3608 {
3609 if (saved_mouse_move_msg.msg.hwnd)
3610 {
3611 post_msg (&saved_mouse_move_msg);
3612 saved_mouse_move_msg.msg.hwnd = 0;
3613 }
3614 KillTimer (hwnd, mouse_move_timer);
3615 mouse_move_timer = 0;
5ac45f98 3616 }
5ac45f98 3617 return 0;
84fb1139
KH
3618
3619 case WM_NCACTIVATE:
3620 /* Windows doesn't send us focus messages when putting up and
e9e23e23 3621 taking down a system popup dialog as for Ctrl-Alt-Del on Windows 95.
84fb1139
KH
3622 The only indication we get that something happened is receiving
3623 this message afterwards. So this is a good time to reset our
3624 keyboard modifiers' state. */
3625 reset_modifiers ();
3626 goto dflt;
da36a4d6 3627
1edf84e7
GV
3628 case WM_INITMENU:
3629 /* We must ensure menu bar is fully constructed and up to date
3630 before allowing user interaction with it. To achieve this
3631 we send this message to the lisp thread and wait for a
3632 reply (whose value is not actually needed) to indicate that
3633 the menu bar is now ready for use, so we can now return.
3634
3635 To remain responsive in the meantime, we enter a nested message
3636 loop that can process all other messages.
3637
3638 However, we skip all this if the message results from calling
3639 TrackPopupMenu - in fact, we must NOT attempt to send the lisp
3640 thread a message because it is blocked on us at this point. We
3641 set menubar_active before calling TrackPopupMenu to indicate
3642 this (there is no possibility of confusion with real menubar
3643 being active). */
3644
3645 f = x_window_to_frame (dpyinfo, hwnd);
3646 if (f
3647 && (f->output_data.w32->menubar_active
3648 /* We can receive this message even in the absence of a
3649 menubar (ie. when the system menu is activated) - in this
3650 case we do NOT want to forward the message, otherwise it
3651 will cause the menubar to suddenly appear when the user
3652 had requested it to be turned off! */
3653 || f->output_data.w32->menubar_widget == NULL))
3654 return 0;
3655
3656 {
3657 deferred_msg msg_buf;
3658
3659 /* Detect if message has already been deferred; in this case
3660 we cannot return any sensible value to ignore this. */
3661 if (find_deferred_msg (hwnd, msg) != NULL)
3662 abort ();
3663
3664 return send_deferred_msg (&msg_buf, hwnd, msg, wParam, lParam);
3665 }
3666
3667 case WM_EXITMENULOOP:
3668 f = x_window_to_frame (dpyinfo, hwnd);
3669
3670 /* Indicate that menubar can be modified again. */
3671 if (f)
3672 f->output_data.w32->menubar_active = 0;
3673 goto dflt;
3674
87996783
GV
3675 case WM_MEASUREITEM:
3676 f = x_window_to_frame (dpyinfo, hwnd);
3677 if (f)
3678 {
3679 MEASUREITEMSTRUCT * pMis = (MEASUREITEMSTRUCT *) lParam;
3680
3681 if (pMis->CtlType == ODT_MENU)
3682 {
3683 /* Work out dimensions for popup menu titles. */
3684 char * title = (char *) pMis->itemData;
3685 HDC hdc = GetDC (hwnd);
3686 HFONT menu_font = GetCurrentObject (hdc, OBJ_FONT);
3687 LOGFONT menu_logfont;
3688 HFONT old_font;
3689 SIZE size;
3690
3691 GetObject (menu_font, sizeof (menu_logfont), &menu_logfont);
3692 menu_logfont.lfWeight = FW_BOLD;
3693 menu_font = CreateFontIndirect (&menu_logfont);
3694 old_font = SelectObject (hdc, menu_font);
3695
3696 GetTextExtentPoint32 (hdc, title, strlen (title), &size);
3697 pMis->itemWidth = size.cx;
3698 pMis->itemHeight = GetSystemMetrics (SM_CYMENUSIZE);
3699 if (pMis->itemHeight < size.cy)
3700 pMis->itemHeight = size.cy;
3701
3702 SelectObject (hdc, old_font);
3703 DeleteObject (menu_font);
3704 ReleaseDC (hwnd, hdc);
3705 return TRUE;
3706 }
3707 }
3708 return 0;
3709
3710 case WM_DRAWITEM:
3711 f = x_window_to_frame (dpyinfo, hwnd);
3712 if (f)
3713 {
3714 DRAWITEMSTRUCT * pDis = (DRAWITEMSTRUCT *) lParam;
3715
3716 if (pDis->CtlType == ODT_MENU)
3717 {
3718 /* Draw popup menu title. */
3719 char * title = (char *) pDis->itemData;
3720 HDC hdc = pDis->hDC;
3721 HFONT menu_font = GetCurrentObject (hdc, OBJ_FONT);
3722 LOGFONT menu_logfont;
3723 HFONT old_font;
3724
3725 GetObject (menu_font, sizeof (menu_logfont), &menu_logfont);
3726 menu_logfont.lfWeight = FW_BOLD;
3727 menu_font = CreateFontIndirect (&menu_logfont);
3728 old_font = SelectObject (hdc, menu_font);
3729
3730 /* Always draw title as if not selected. */
3731 ExtTextOut (hdc,
3732 pDis->rcItem.left + GetSystemMetrics (SM_CXMENUCHECK),
3733 pDis->rcItem.top,
3734 ETO_OPAQUE, &pDis->rcItem,
3735 title, strlen (title), NULL);
3736
3737 SelectObject (hdc, old_font);
3738 DeleteObject (menu_font);
3739 return TRUE;
3740 }
3741 }
3742 return 0;
3743
1edf84e7
GV
3744#if 0
3745 /* Still not right - can't distinguish between clicks in the
3746 client area of the frame from clicks forwarded from the scroll
3747 bars - may have to hook WM_NCHITTEST to remember the mouse
3748 position and then check if it is in the client area ourselves. */
3749 case WM_MOUSEACTIVATE:
3750 /* Discard the mouse click that activates a frame, allowing the
3751 user to click anywhere without changing point (or worse!).
3752 Don't eat mouse clicks on scrollbars though!! */
3753 if (LOWORD (lParam) == HTCLIENT )
3754 return MA_ACTIVATEANDEAT;
3755 goto dflt;
3756#endif
3757
3758 case WM_ACTIVATE:
3759 case WM_ACTIVATEAPP:
3760 case WM_WINDOWPOSCHANGED:
3761 case WM_SHOWWINDOW:
3762 /* Inform lisp thread that a frame might have just been obscured
3763 or exposed, so should recheck visibility of all frames. */
3764 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3765 goto dflt;
3766
da36a4d6
GV
3767 case WM_SETFOCUS:
3768 reset_modifiers ();
8681157a 3769 case WM_KILLFOCUS:
ee78dc32
GV
3770 case WM_MOVE:
3771 case WM_SIZE:
ee78dc32 3772 case WM_COMMAND:
fbd6baed 3773 wmsg.dwModifiers = w32_get_modifiers ();
ee78dc32
GV
3774 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3775 goto dflt;
8847d890
RS
3776
3777 case WM_CLOSE:
fbd6baed 3778 wmsg.dwModifiers = w32_get_modifiers ();
8847d890
RS
3779 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3780 return 0;
3781
ee78dc32
GV
3782 case WM_WINDOWPOSCHANGING:
3783 {
3784 WINDOWPLACEMENT wp;
3785 LPWINDOWPOS lppos = (WINDOWPOS *) lParam;
1edf84e7
GV
3786
3787 wp.length = sizeof (WINDOWPLACEMENT);
ee78dc32
GV
3788 GetWindowPlacement (hwnd, &wp);
3789
1edf84e7 3790 if (wp.showCmd != SW_SHOWMINIMIZED && (lppos->flags & SWP_NOSIZE) == 0)
ee78dc32
GV
3791 {
3792 RECT rect;
3793 int wdiff;
3794 int hdiff;
1edf84e7
GV
3795 DWORD font_width;
3796 DWORD line_height;
3797 DWORD internal_border;
3798 DWORD scrollbar_extra;
ee78dc32
GV
3799 RECT wr;
3800
5ac45f98 3801 wp.length = sizeof(wp);
ee78dc32
GV
3802 GetWindowRect (hwnd, &wr);
3803
3c190163 3804 enter_crit ();
ee78dc32 3805
1edf84e7
GV
3806 font_width = GetWindowLong (hwnd, WND_FONTWIDTH_INDEX);
3807 line_height = GetWindowLong (hwnd, WND_LINEHEIGHT_INDEX);
3808 internal_border = GetWindowLong (hwnd, WND_BORDER_INDEX);
3809 scrollbar_extra = GetWindowLong (hwnd, WND_SCROLLBAR_INDEX);
ee78dc32 3810
3c190163 3811 leave_crit ();
ee78dc32
GV
3812
3813 memset (&rect, 0, sizeof (rect));
3814 AdjustWindowRect (&rect, GetWindowLong (hwnd, GWL_STYLE),
3815 GetMenu (hwnd) != NULL);
3816
1edf84e7
GV
3817 /* Force width and height of client area to be exact
3818 multiples of the character cell dimensions. */
3819 wdiff = (lppos->cx - (rect.right - rect.left)
3820 - 2 * internal_border - scrollbar_extra)
3821 % font_width;
3822 hdiff = (lppos->cy - (rect.bottom - rect.top)
3823 - 2 * internal_border)
3824 % line_height;
ee78dc32
GV
3825
3826 if (wdiff || hdiff)
3827 {
3828 /* For right/bottom sizing we can just fix the sizes.
3829 However for top/left sizing we will need to fix the X
3830 and Y positions as well. */
3831
3832 lppos->cx -= wdiff;
3833 lppos->cy -= hdiff;
3834
3835 if (wp.showCmd != SW_SHOWMAXIMIZED
1edf84e7 3836 && (lppos->flags & SWP_NOMOVE) == 0)
ee78dc32
GV
3837 {
3838 if (lppos->x != wr.left || lppos->y != wr.top)
3839 {
3840 lppos->x += wdiff;
3841 lppos->y += hdiff;
3842 }
3843 else
3844 {
3845 lppos->flags |= SWP_NOMOVE;
3846 }
3847 }
3848
1edf84e7 3849 return 0;
ee78dc32
GV
3850 }
3851 }
3852 }
ee78dc32
GV
3853
3854 goto dflt;
1edf84e7
GV
3855
3856 case WM_EMACS_CREATESCROLLBAR:
3857 return (LRESULT) w32_createscrollbar ((struct frame *) wParam,
3858 (struct scroll_bar *) lParam);
3859
5ac45f98 3860 case WM_EMACS_SHOWWINDOW:
1edf84e7
GV
3861 return ShowWindow ((HWND) wParam, (WPARAM) lParam);
3862
dfdb4047
GV
3863 case WM_EMACS_SETFOREGROUND:
3864 return SetForegroundWindow ((HWND) wParam);
3865
5ac45f98
GV
3866 case WM_EMACS_SETWINDOWPOS:
3867 {
1edf84e7
GV
3868 WINDOWPOS * pos = (WINDOWPOS *) wParam;
3869 return SetWindowPos (hwnd, pos->hwndInsertAfter,
5ac45f98
GV
3870 pos->x, pos->y, pos->cx, pos->cy, pos->flags);
3871 }
1edf84e7 3872
ee78dc32 3873 case WM_EMACS_DESTROYWINDOW:
cb9e33d4 3874 DragAcceptFiles ((HWND) wParam, FALSE);
1edf84e7
GV
3875 return DestroyWindow ((HWND) wParam);
3876
3877 case WM_EMACS_TRACKPOPUPMENU:
3878 {
3879 UINT flags;
3880 POINT *pos;
3881 int retval;
3882 pos = (POINT *)lParam;
3883 flags = TPM_CENTERALIGN;
3884 if (button_state & LMOUSE)
3885 flags |= TPM_LEFTBUTTON;
3886 else if (button_state & RMOUSE)
3887 flags |= TPM_RIGHTBUTTON;
3888
87996783
GV
3889 /* Remember we did a SetCapture on the initial mouse down event,
3890 so for safety, we make sure the capture is cancelled now. */
3891 ReleaseCapture ();
3892
1edf84e7
GV
3893 /* Use menubar_active to indicate that WM_INITMENU is from
3894 TrackPopupMenu below, and should be ignored. */
3895 f = x_window_to_frame (dpyinfo, hwnd);
3896 if (f)
3897 f->output_data.w32->menubar_active = 1;
3898
3899 if (TrackPopupMenu ((HMENU)wParam, flags, pos->x, pos->y,
3900 0, hwnd, NULL))
3901 {
3902 MSG amsg;
3903 /* Eat any mouse messages during popupmenu */
3904 while (PeekMessage (&amsg, hwnd, WM_MOUSEFIRST, WM_MOUSELAST,
3905 PM_REMOVE));
3906 /* Get the menu selection, if any */
3907 if (PeekMessage (&amsg, hwnd, WM_COMMAND, WM_COMMAND, PM_REMOVE))
3908 {
3909 retval = LOWORD (amsg.wParam);
3910 }
3911 else
3912 {
3913 retval = 0;
3914 }
3915 button_state = 0;
1edf84e7
GV
3916 }
3917 else
3918 {
3919 retval = -1;
3920 }
3921
3922 return retval;
3923 }
3924
ee78dc32 3925 default:
93fbe8b7
GV
3926 /* Check for messages registered at runtime. */
3927 if (msg == msh_mousewheel)
3928 {
3929 wmsg.dwModifiers = w32_get_modifiers ();
3930 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3931 return 0;
3932 }
3933
ee78dc32
GV
3934 dflt:
3935 return DefWindowProc (hwnd, msg, wParam, lParam);
3936 }
3937
1edf84e7
GV
3938
3939 /* The most common default return code for handled messages is 0. */
3940 return 0;
ee78dc32
GV
3941}
3942
3943void
3944my_create_window (f)
3945 struct frame * f;
3946{
3947 MSG msg;
3948
1edf84e7
GV
3949 if (!PostThreadMessage (dwWindowsThreadId, WM_EMACS_CREATEWINDOW, (WPARAM)f, 0))
3950 abort ();
ee78dc32
GV
3951 GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
3952}
3953
fbd6baed 3954/* Create and set up the w32 window for frame F. */
ee78dc32
GV
3955
3956static void
fbd6baed 3957w32_window (f, window_prompting, minibuffer_only)
ee78dc32
GV
3958 struct frame *f;
3959 long window_prompting;
3960 int minibuffer_only;
3961{
3962 BLOCK_INPUT;
3963
3964 /* Use the resource name as the top-level window name
3965 for looking up resources. Make a non-Lisp copy
3966 for the window manager, so GC relocation won't bother it.
3967
3968 Elsewhere we specify the window name for the window manager. */
3969
3970 {
3971 char *str = (char *) XSTRING (Vx_resource_name)->data;
3972 f->namebuf = (char *) xmalloc (strlen (str) + 1);
3973 strcpy (f->namebuf, str);
3974 }
3975
3976 my_create_window (f);
3977
3978 validate_x_resource_name ();
3979
3980 /* x_set_name normally ignores requests to set the name if the
3981 requested name is the same as the current name. This is the one
3982 place where that assumption isn't correct; f->name is set, but
3983 the server hasn't been told. */
3984 {
3985 Lisp_Object name;
3986 int explicit = f->explicit_name;
3987
3988 f->explicit_name = 0;
3989 name = f->name;
3990 f->name = Qnil;
3991 x_set_name (f, name, explicit);
3992 }
3993
3994 UNBLOCK_INPUT;
3995
3996 if (!minibuffer_only && FRAME_EXTERNAL_MENU_BAR (f))
3997 initialize_frame_menubar (f);
3998
fbd6baed 3999 if (FRAME_W32_WINDOW (f) == 0)
ee78dc32
GV
4000 error ("Unable to create window");
4001}
4002
4003/* Handle the icon stuff for this window. Perhaps later we might
4004 want an x_set_icon_position which can be called interactively as
4005 well. */
4006
4007static void
4008x_icon (f, parms)
4009 struct frame *f;
4010 Lisp_Object parms;
4011{
4012 Lisp_Object icon_x, icon_y;
4013
e9e23e23 4014 /* Set the position of the icon. Note that Windows 95 groups all
ee78dc32
GV
4015 icons in the tray. */
4016 icon_x = x_get_arg (parms, Qicon_left, 0, 0, number);
4017 icon_y = x_get_arg (parms, Qicon_top, 0, 0, number);
4018 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
4019 {
4020 CHECK_NUMBER (icon_x, 0);
4021 CHECK_NUMBER (icon_y, 0);
4022 }
4023 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
4024 error ("Both left and top icon corners of icon must be specified");
4025
4026 BLOCK_INPUT;
4027
4028 if (! EQ (icon_x, Qunbound))
4029 x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y));
4030
1edf84e7
GV
4031#if 0 /* TODO */
4032 /* Start up iconic or window? */
4033 x_wm_set_window_state
4034 (f, (EQ (x_get_arg (parms, Qvisibility, 0, 0, symbol), Qicon)
4035 ? IconicState
4036 : NormalState));
4037
4038 x_text_icon (f, (char *) XSTRING ((!NILP (f->icon_name)
4039 ? f->icon_name
4040 : f->name))->data);
4041#endif
4042
ee78dc32
GV
4043 UNBLOCK_INPUT;
4044}
4045
4046DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
4047 1, 1, 0,
4048 "Make a new window, which is called a \"frame\" in Emacs terms.\n\
4049Returns an Emacs frame object.\n\
4050ALIST is an alist of frame parameters.\n\
4051If the parameters specify that the frame should not have a minibuffer,\n\
4052and do not specify a specific minibuffer window to use,\n\
4053then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
4054be shared by the new frame.\n\
4055\n\
4056This function is an internal primitive--use `make-frame' instead.")
4057 (parms)
4058 Lisp_Object parms;
4059{
4060 struct frame *f;
4061 Lisp_Object frame, tem;
4062 Lisp_Object name;
4063 int minibuffer_only = 0;
4064 long window_prompting = 0;
4065 int width, height;
4066 int count = specpdl_ptr - specpdl;
1edf84e7 4067 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
ee78dc32 4068 Lisp_Object display;
fbd6baed 4069 struct w32_display_info *dpyinfo;
ee78dc32
GV
4070 Lisp_Object parent;
4071 struct kboard *kb;
4072
4073 /* Use this general default value to start with
4074 until we know if this frame has a specified name. */
4075 Vx_resource_name = Vinvocation_name;
4076
4077 display = x_get_arg (parms, Qdisplay, 0, 0, string);
4078 if (EQ (display, Qunbound))
4079 display = Qnil;
4080 dpyinfo = check_x_display_info (display);
4081#ifdef MULTI_KBOARD
4082 kb = dpyinfo->kboard;
4083#else
4084 kb = &the_only_kboard;
4085#endif
4086
1edf84e7 4087 name = x_get_arg (parms, Qname, "name", "Name", string);
ee78dc32
GV
4088 if (!STRINGP (name)
4089 && ! EQ (name, Qunbound)
4090 && ! NILP (name))
4091 error ("Invalid frame name--not a string or nil");
4092
4093 if (STRINGP (name))
4094 Vx_resource_name = name;
4095
4096 /* See if parent window is specified. */
4097 parent = x_get_arg (parms, Qparent_id, NULL, NULL, number);
4098 if (EQ (parent, Qunbound))
4099 parent = Qnil;
4100 if (! NILP (parent))
4101 CHECK_NUMBER (parent, 0);
4102
1edf84e7
GV
4103 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
4104 /* No need to protect DISPLAY because that's not used after passing
4105 it to make_frame_without_minibuffer. */
4106 frame = Qnil;
4107 GCPRO4 (parms, parent, name, frame);
ee78dc32
GV
4108 tem = x_get_arg (parms, Qminibuffer, 0, 0, symbol);
4109 if (EQ (tem, Qnone) || NILP (tem))
4110 f = make_frame_without_minibuffer (Qnil, kb, display);
4111 else if (EQ (tem, Qonly))
4112 {
4113 f = make_minibuffer_frame ();
4114 minibuffer_only = 1;
4115 }
4116 else if (WINDOWP (tem))
4117 f = make_frame_without_minibuffer (tem, kb, display);
4118 else
4119 f = make_frame (1);
4120
1edf84e7
GV
4121 XSETFRAME (frame, f);
4122
ee78dc32
GV
4123 /* Note that Windows does support scroll bars. */
4124 FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
5ac45f98
GV
4125 /* By default, make scrollbars the system standard width. */
4126 f->scroll_bar_pixel_width = GetSystemMetrics (SM_CXVSCROLL);
ee78dc32 4127
fbd6baed
GV
4128 f->output_method = output_w32;
4129 f->output_data.w32 = (struct w32_output *) xmalloc (sizeof (struct w32_output));
4130 bzero (f->output_data.w32, sizeof (struct w32_output));
ee78dc32 4131
1edf84e7
GV
4132 f->icon_name
4133 = x_get_arg (parms, Qicon_name, "iconName", "Title", string);
4134 if (! STRINGP (f->icon_name))
4135 f->icon_name = Qnil;
4136
fbd6baed 4137/* FRAME_W32_DISPLAY_INFO (f) = dpyinfo; */
ee78dc32
GV
4138#ifdef MULTI_KBOARD
4139 FRAME_KBOARD (f) = kb;
4140#endif
4141
4142 /* Specify the parent under which to make this window. */
4143
4144 if (!NILP (parent))
4145 {
fbd6baed
GV
4146 f->output_data.w32->parent_desc = (Window) parent;
4147 f->output_data.w32->explicit_parent = 1;
ee78dc32
GV
4148 }
4149 else
4150 {
fbd6baed
GV
4151 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
4152 f->output_data.w32->explicit_parent = 0;
ee78dc32
GV
4153 }
4154
4155 /* Note that the frame has no physical cursor right now. */
4156 f->phys_cursor_x = -1;
4157
4158 /* Set the name; the functions to which we pass f expect the name to
4159 be set. */
4160 if (EQ (name, Qunbound) || NILP (name))
4161 {
fbd6baed 4162 f->name = build_string (dpyinfo->w32_id_name);
ee78dc32
GV
4163 f->explicit_name = 0;
4164 }
4165 else
4166 {
4167 f->name = name;
4168 f->explicit_name = 1;
4169 /* use the frame's title when getting resources for this frame. */
4170 specbind (Qx_resource_name, name);
4171 }
4172
4173 /* Extract the window parameters from the supplied values
4174 that are needed to determine window geometry. */
4175 {
4176 Lisp_Object font;
4177
4178 font = x_get_arg (parms, Qfont, "font", "Font", string);
4179 BLOCK_INPUT;
4180 /* First, try whatever font the caller has specified. */
4181 if (STRINGP (font))
4182 font = x_new_font (f, XSTRING (font)->data);
ee78dc32
GV
4183 /* Try out a font which we hope has bold and italic variations. */
4184 if (!STRINGP (font))
1edf84e7 4185 font = x_new_font (f, "-*-Courier New-normal-r-*-*-13-97-*-*-c-*-*-ansi-");
ee78dc32 4186 if (! STRINGP (font))
1edf84e7 4187 font = x_new_font (f, "-*-Courier-normal-r-*-*-13-97-*-*-c-*-*-ansi-");
ee78dc32
GV
4188 /* If those didn't work, look for something which will at least work. */
4189 if (! STRINGP (font))
1edf84e7 4190 font = x_new_font (f, "-*-Fixedsys-normal-r-*-*-13-97-*-*-c-*-*-ansi-");
ee78dc32
GV
4191 UNBLOCK_INPUT;
4192 if (! STRINGP (font))
1edf84e7 4193 font = build_string ("Fixedsys");
ee78dc32
GV
4194
4195 x_default_parameter (f, parms, Qfont, font,
4196 "font", "Font", string);
4197 }
4198
4199 x_default_parameter (f, parms, Qborder_width, make_number (2),
4200 "borderwidth", "BorderWidth", number);
4201 /* This defaults to 2 in order to match xterm. We recognize either
4202 internalBorderWidth or internalBorder (which is what xterm calls
4203 it). */
4204 if (NILP (Fassq (Qinternal_border_width, parms)))
4205 {
4206 Lisp_Object value;
4207
4208 value = x_get_arg (parms, Qinternal_border_width,
4209 "internalBorder", "BorderWidth", number);
4210 if (! EQ (value, Qunbound))
4211 parms = Fcons (Fcons (Qinternal_border_width, value),
4212 parms);
4213 }
1edf84e7 4214 /* Default internalBorderWidth to 0 on Windows to match other programs. */
ee78dc32
GV
4215 x_default_parameter (f, parms, Qinternal_border_width, make_number (0),
4216 "internalBorderWidth", "BorderWidth", number);
4217 x_default_parameter (f, parms, Qvertical_scroll_bars, Qt,
4218 "verticalScrollBars", "ScrollBars", boolean);
4219
4220 /* Also do the stuff which must be set before the window exists. */
4221 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
4222 "foreground", "Foreground", string);
4223 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
4224 "background", "Background", string);
4225 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
4226 "pointerColor", "Foreground", string);
4227 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
4228 "cursorColor", "Foreground", string);
4229 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
4230 "borderColor", "BorderColor", string);
4231
4232 x_default_parameter (f, parms, Qmenu_bar_lines, make_number (1),
4233 "menuBar", "MenuBar", number);
4234 x_default_parameter (f, parms, Qscroll_bar_width, Qnil,
4235 "scrollBarWidth", "ScrollBarWidth", number);
1edf84e7
GV
4236 x_default_parameter (f, parms, Qbuffer_predicate, Qnil,
4237 "bufferPredicate", "BufferPredicate", symbol);
4238 x_default_parameter (f, parms, Qtitle, Qnil,
4239 "title", "Title", string);
ee78dc32 4240
fbd6baed
GV
4241 f->output_data.w32->dwStyle = WS_OVERLAPPEDWINDOW;
4242 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
ee78dc32
GV
4243 window_prompting = x_figure_window_size (f, parms);
4244
4245 if (window_prompting & XNegative)
4246 {
4247 if (window_prompting & YNegative)
fbd6baed 4248 f->output_data.w32->win_gravity = SouthEastGravity;
ee78dc32 4249 else
fbd6baed 4250 f->output_data.w32->win_gravity = NorthEastGravity;
ee78dc32
GV
4251 }
4252 else
4253 {
4254 if (window_prompting & YNegative)
fbd6baed 4255 f->output_data.w32->win_gravity = SouthWestGravity;
ee78dc32 4256 else
fbd6baed 4257 f->output_data.w32->win_gravity = NorthWestGravity;
ee78dc32
GV
4258 }
4259
fbd6baed 4260 f->output_data.w32->size_hint_flags = window_prompting;
ee78dc32 4261
fbd6baed 4262 w32_window (f, window_prompting, minibuffer_only);
ee78dc32
GV
4263 x_icon (f, parms);
4264 init_frame_faces (f);
4265
4266 /* We need to do this after creating the window, so that the
4267 icon-creation functions can say whose icon they're describing. */
4268 x_default_parameter (f, parms, Qicon_type, Qnil,
4269 "bitmapIcon", "BitmapIcon", symbol);
4270
4271 x_default_parameter (f, parms, Qauto_raise, Qnil,
4272 "autoRaise", "AutoRaiseLower", boolean);
4273 x_default_parameter (f, parms, Qauto_lower, Qnil,
4274 "autoLower", "AutoRaiseLower", boolean);
4275 x_default_parameter (f, parms, Qcursor_type, Qbox,
4276 "cursorType", "CursorType", symbol);
4277
4278 /* Dimensions, especially f->height, must be done via change_frame_size.
4279 Change will not be effected unless different from the current
4280 f->height. */
4281 width = f->width;
4282 height = f->height;
1026b400
RS
4283 f->height = 0;
4284 SET_FRAME_WIDTH (f, 0);
ee78dc32
GV
4285 change_frame_size (f, height, width, 1, 0);
4286
4287 /* Tell the server what size and position, etc, we want,
4288 and how badly we want them. */
4289 BLOCK_INPUT;
4290 x_wm_set_size_hint (f, window_prompting, 0);
4291 UNBLOCK_INPUT;
4292
4293 tem = x_get_arg (parms, Qunsplittable, 0, 0, boolean);
4294 f->no_split = minibuffer_only || EQ (tem, Qt);
4295
4296 UNGCPRO;
4297
4298 /* It is now ok to make the frame official
4299 even if we get an error below.
4300 And the frame needs to be on Vframe_list
4301 or making it visible won't work. */
4302 Vframe_list = Fcons (frame, Vframe_list);
4303
4304 /* Now that the frame is official, it counts as a reference to
4305 its display. */
fbd6baed 4306 FRAME_W32_DISPLAY_INFO (f)->reference_count++;
ee78dc32
GV
4307
4308 /* Make the window appear on the frame and enable display,
4309 unless the caller says not to. However, with explicit parent,
4310 Emacs cannot control visibility, so don't try. */
fbd6baed 4311 if (! f->output_data.w32->explicit_parent)
ee78dc32
GV
4312 {
4313 Lisp_Object visibility;
4314
4315 visibility = x_get_arg (parms, Qvisibility, 0, 0, symbol);
4316 if (EQ (visibility, Qunbound))
4317 visibility = Qt;
4318
4319 if (EQ (visibility, Qicon))
4320 x_iconify_frame (f);
4321 else if (! NILP (visibility))
4322 x_make_frame_visible (f);
4323 else
4324 /* Must have been Qnil. */
4325 ;
4326 }
4327
4328 return unbind_to (count, frame);
4329}
4330
4331/* FRAME is used only to get a handle on the X display. We don't pass the
4332 display info directly because we're called from frame.c, which doesn't
4333 know about that structure. */
4334Lisp_Object
4335x_get_focus_frame (frame)
4336 struct frame *frame;
4337{
fbd6baed 4338 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (frame);
ee78dc32 4339 Lisp_Object xfocus;
fbd6baed 4340 if (! dpyinfo->w32_focus_frame)
ee78dc32
GV
4341 return Qnil;
4342
fbd6baed 4343 XSETFRAME (xfocus, dpyinfo->w32_focus_frame);
ee78dc32
GV
4344 return xfocus;
4345}
1edf84e7
GV
4346
4347DEFUN ("w32-focus-frame", Fw32_focus_frame, Sw32_focus_frame, 1, 1, 0,
4348 "Give FRAME input focus, raising to foreground if necessary.")
4349 (frame)
4350 Lisp_Object frame;
4351{
4352 x_focus_on_frame (check_x_frame (frame));
4353 return Qnil;
4354}
4355
ee78dc32 4356\f
5ac45f98 4357XFontStruct *
fbd6baed
GV
4358w32_load_font (dpyinfo,name)
4359struct w32_display_info *dpyinfo;
3c190163 4360char * name;
ee78dc32
GV
4361{
4362 XFontStruct * font = NULL;
4363 BOOL ok;
5ac45f98 4364
3c190163
GV
4365 {
4366 LOGFONT lf;
5ac45f98 4367
fbd6baed 4368 if (!name || !x_to_w32_font (name, &lf))
3c190163 4369 return (NULL);
5ac45f98 4370
3c190163 4371 font = (XFontStruct *) xmalloc (sizeof (XFontStruct));
5ac45f98 4372
3c190163 4373 if (!font) return (NULL);
5ac45f98 4374
3c190163 4375 BLOCK_INPUT;
5ac45f98
GV
4376
4377 font->hfont = CreateFontIndirect (&lf);
ee78dc32 4378 }
ee78dc32 4379
5ac45f98
GV
4380 if (font->hfont == NULL)
4381 {
4382 ok = FALSE;
4383 }
4384 else
4385 {
4386 HDC hdc;
4387 HANDLE oldobj;
4388
4389 hdc = GetDC (dpyinfo->root_window);
4390 oldobj = SelectObject (hdc, font->hfont);
4391 ok = GetTextMetrics (hdc, &font->tm);
4392 SelectObject (hdc, oldobj);
4393 ReleaseDC (dpyinfo->root_window, hdc);
4394 }
4395
ee78dc32 4396 UNBLOCK_INPUT;
5ac45f98 4397
ee78dc32 4398 if (ok) return (font);
5ac45f98 4399
fbd6baed 4400 w32_unload_font (dpyinfo, font);
ee78dc32
GV
4401 return (NULL);
4402}
4403
4404void
fbd6baed
GV
4405w32_unload_font (dpyinfo, font)
4406 struct w32_display_info *dpyinfo;
ee78dc32
GV
4407 XFontStruct * font;
4408{
4409 if (font)
4410 {
3c190163 4411 if (font->hfont) DeleteObject(font->hfont);
ee78dc32
GV
4412 xfree (font);
4413 }
4414}
4415
fbd6baed 4416/* The font conversion stuff between x and w32 */
ee78dc32
GV
4417
4418/* X font string is as follows (from faces.el)
4419 * (let ((- "[-?]")
4420 * (foundry "[^-]+")
4421 * (family "[^-]+")
4422 * (weight "\\(bold\\|demibold\\|medium\\)") ; 1
4423 * (weight\? "\\([^-]*\\)") ; 1
4424 * (slant "\\([ior]\\)") ; 2
4425 * (slant\? "\\([^-]?\\)") ; 2
4426 * (swidth "\\([^-]*\\)") ; 3
4427 * (adstyle "[^-]*") ; 4
4428 * (pixelsize "[0-9]+")
4429 * (pointsize "[0-9][0-9]+")
4430 * (resx "[0-9][0-9]+")
4431 * (resy "[0-9][0-9]+")
4432 * (spacing "[cmp?*]")
4433 * (avgwidth "[0-9]+")
4434 * (registry "[^-]+")
4435 * (encoding "[^-]+")
4436 * )
4437 * (setq x-font-regexp
4438 * (concat "\\`\\*?[-?*]"
4439 * foundry - family - weight\? - slant\? - swidth - adstyle -
4440 * pixelsize - pointsize - resx - resy - spacing - registry -
4441 * encoding "[-?*]\\*?\\'"
4442 * ))
4443 * (setq x-font-regexp-head
4444 * (concat "\\`[-?*]" foundry - family - weight\? - slant\?
4445 * "\\([-*?]\\|\\'\\)"))
4446 * (setq x-font-regexp-slant (concat - slant -))
4447 * (setq x-font-regexp-weight (concat - weight -))
4448 * nil)
4449 */
4450
4451#define FONT_START "[-?]"
4452#define FONT_FOUNDRY "[^-]+"
4453#define FONT_FAMILY "\\([^-]+\\)" /* 1 */
4454#define FONT_WEIGHT "\\(bold\\|demibold\\|medium\\)" /* 2 */
4455#define FONT_WEIGHT_Q "\\([^-]*\\)" /* 2 */
4456#define FONT_SLANT "\\([ior]\\)" /* 3 */
4457#define FONT_SLANT_Q "\\([^-]?\\)" /* 3 */
4458#define FONT_SWIDTH "\\([^-]*\\)" /* 4 */
4459#define FONT_ADSTYLE "[^-]*"
4460#define FONT_PIXELSIZE "[^-]*"
4461#define FONT_POINTSIZE "\\([0-9][0-9]+\\|\\*\\)" /* 5 */
4462#define FONT_RESX "[0-9][0-9]+"
4463#define FONT_RESY "[0-9][0-9]+"
4464#define FONT_SPACING "[cmp?*]"
4465#define FONT_AVGWIDTH "[0-9]+"
4466#define FONT_REGISTRY "[^-]+"
4467#define FONT_ENCODING "[^-]+"
4468
4469#define FONT_REGEXP ("\\`\\*?[-?*]" \
4470 FONT_FOUNDRY "-" \
4471 FONT_FAMILY "-" \
4472 FONT_WEIGHT_Q "-" \
4473 FONT_SLANT_Q "-" \
4474 FONT_SWIDTH "-" \
4475 FONT_ADSTYLE "-" \
4476 FONT_PIXELSIZE "-" \
4477 FONT_POINTSIZE "-" \
4478 "[-?*]\\|\\'")
4479
4480#define FONT_REGEXP_HEAD ("\\`[-?*]" \
4481 FONT_FOUNDRY "-" \
4482 FONT_FAMILY "-" \
4483 FONT_WEIGHT_Q "-" \
4484 FONT_SLANT_Q \
4485 "\\([-*?]\\|\\'\\)")
4486
4487#define FONT_REGEXP_SLANT "-" FONT_SLANT "-"
4488#define FONT_REGEXP_WEIGHT "-" FONT_WEIGHT "-"
4489
4490LONG
fbd6baed 4491x_to_w32_weight (lpw)
ee78dc32
GV
4492 char * lpw;
4493{
4494 if (!lpw) return (FW_DONTCARE);
5ac45f98
GV
4495
4496 if (stricmp (lpw,"heavy") == 0) return FW_HEAVY;
4497 else if (stricmp (lpw,"extrabold") == 0) return FW_EXTRABOLD;
4498 else if (stricmp (lpw,"bold") == 0) return FW_BOLD;
4499 else if (stricmp (lpw,"demibold") == 0) return FW_SEMIBOLD;
1edf84e7 4500 else if (stricmp (lpw,"semibold") == 0) return FW_SEMIBOLD;
5ac45f98
GV
4501 else if (stricmp (lpw,"medium") == 0) return FW_MEDIUM;
4502 else if (stricmp (lpw,"normal") == 0) return FW_NORMAL;
4503 else if (stricmp (lpw,"light") == 0) return FW_LIGHT;
4504 else if (stricmp (lpw,"extralight") == 0) return FW_EXTRALIGHT;
4505 else if (stricmp (lpw,"thin") == 0) return FW_THIN;
ee78dc32 4506 else
5ac45f98 4507 return FW_DONTCARE;
ee78dc32
GV
4508}
4509
5ac45f98 4510
ee78dc32 4511char *
fbd6baed 4512w32_to_x_weight (fnweight)
ee78dc32
GV
4513 int fnweight;
4514{
5ac45f98
GV
4515 if (fnweight >= FW_HEAVY) return "heavy";
4516 if (fnweight >= FW_EXTRABOLD) return "extrabold";
4517 if (fnweight >= FW_BOLD) return "bold";
4518 if (fnweight >= FW_SEMIBOLD) return "semibold";
4519 if (fnweight >= FW_MEDIUM) return "medium";
4520 if (fnweight >= FW_NORMAL) return "normal";
4521 if (fnweight >= FW_LIGHT) return "light";
4522 if (fnweight >= FW_EXTRALIGHT) return "extralight";
4523 if (fnweight >= FW_THIN) return "thin";
4524 else
4525 return "*";
4526}
4527
4528LONG
fbd6baed 4529x_to_w32_charset (lpcs)
5ac45f98
GV
4530 char * lpcs;
4531{
4532 if (!lpcs) return (0);
4533
4534 if (stricmp (lpcs,"ansi") == 0) return ANSI_CHARSET;
4535 else if (stricmp (lpcs,"iso8859-1") == 0) return ANSI_CHARSET;
4536 else if (stricmp (lpcs,"iso8859") == 0) return ANSI_CHARSET;
4537 else if (stricmp (lpcs,"oem") == 0) return OEM_CHARSET;
4538#ifdef UNICODE_CHARSET
4539 else if (stricmp (lpcs,"unicode") == 0) return UNICODE_CHARSET;
4540 else if (stricmp (lpcs,"iso10646") == 0) return UNICODE_CHARSET;
4541#endif
1edf84e7 4542 else if (lpcs[0] == '#') return atoi (lpcs + 1);
5ac45f98 4543 else
1edf84e7 4544 return DEFAULT_CHARSET;
5ac45f98
GV
4545}
4546
4547char *
fbd6baed 4548w32_to_x_charset (fncharset)
5ac45f98
GV
4549 int fncharset;
4550{
1edf84e7
GV
4551 static char buf[16];
4552
5ac45f98
GV
4553 switch (fncharset)
4554 {
4555 case ANSI_CHARSET: return "ansi";
4556 case OEM_CHARSET: return "oem";
4557 case SYMBOL_CHARSET: return "symbol";
4558#ifdef UNICODE_CHARSET
4559 case UNICODE_CHARSET: return "unicode";
4560#endif
4561 }
1edf84e7
GV
4562 /* Encode numerical value of unknown charset. */
4563 sprintf (buf, "#%u", fncharset);
4564 return buf;
ee78dc32
GV
4565}
4566
4567BOOL
fbd6baed 4568w32_to_x_font (lplogfont, lpxstr, len)
ee78dc32
GV
4569 LOGFONT * lplogfont;
4570 char * lpxstr;
4571 int len;
4572{
3cb20f4a
RS
4573 char height_pixels[8];
4574 char height_dpi[8];
4575 char width_pixels[8];
4576
4577 if (!lpxstr) abort ();
ee78dc32 4578
3cb20f4a
RS
4579 if (!lplogfont)
4580 return FALSE;
4581
4582 if (lplogfont->lfHeight)
ee78dc32 4583 {
3cb20f4a
RS
4584 sprintf (height_pixels, "%u", abs (lplogfont->lfHeight));
4585 sprintf (height_dpi, "%u",
fbd6baed 4586 (abs (lplogfont->lfHeight) * 720) / one_w32_display_info.height_in);
5ac45f98
GV
4587 }
4588 else
ee78dc32 4589 {
3cb20f4a
RS
4590 strcpy (height_pixels, "*");
4591 strcpy (height_dpi, "*");
ee78dc32 4592 }
3cb20f4a
RS
4593 if (lplogfont->lfWidth)
4594 sprintf (width_pixels, "%u", lplogfont->lfWidth * 10);
4595 else
4596 strcpy (width_pixels, "*");
4597
4598 _snprintf (lpxstr, len - 1,
4599 "-*-%s-%s-%c-*-*-%s-%s-*-*-%c-%s-*-%s-",
4600 lplogfont->lfFaceName,
fbd6baed 4601 w32_to_x_weight (lplogfont->lfWeight),
3cb20f4a
RS
4602 lplogfont->lfItalic?'i':'r',
4603 height_pixels,
4604 height_dpi,
4605 ((lplogfont->lfPitchAndFamily & 0x3) == VARIABLE_PITCH) ? 'p' : 'c',
4606 width_pixels,
fbd6baed 4607 w32_to_x_charset (lplogfont->lfCharSet)
3cb20f4a
RS
4608 );
4609
ee78dc32
GV
4610 lpxstr[len - 1] = 0; /* just to be sure */
4611 return (TRUE);
4612}
4613
4614BOOL
fbd6baed 4615x_to_w32_font (lpxstr, lplogfont)
ee78dc32
GV
4616 char * lpxstr;
4617 LOGFONT * lplogfont;
4618{
4619 if (!lplogfont) return (FALSE);
4620
4621 memset (lplogfont, 0, sizeof (*lplogfont));
5ac45f98 4622
771c47d5 4623#if 1
ee78dc32
GV
4624 lplogfont->lfOutPrecision = OUT_DEFAULT_PRECIS;
4625 lplogfont->lfClipPrecision = CLIP_DEFAULT_PRECIS;
4626 lplogfont->lfQuality = DEFAULT_QUALITY;
5ac45f98
GV
4627#else
4628 /* go for maximum quality */
4629 lplogfont->lfOutPrecision = OUT_STROKE_PRECIS;
4630 lplogfont->lfClipPrecision = CLIP_STROKE_PRECIS;
4631 lplogfont->lfQuality = PROOF_QUALITY;
4632#endif
4633
4634 if (!lpxstr)
4635 return FALSE;
4636
4637 /* Provide a simple escape mechanism for specifying Windows font names
4638 * directly -- if font spec does not beginning with '-', assume this
4639 * format:
4640 * "<font name>[:height in pixels[:width in pixels[:weight]]]"
4641 */
ee78dc32 4642
5ac45f98
GV
4643 if (*lpxstr == '-')
4644 {
4645 int fields;
4646 char name[50], weight[20], slant, pitch, pixels[10], height[10], width[10], remainder[20];
4647 char * encoding;
4648
4649 fields = sscanf (lpxstr,
4650 "-%*[^-]-%49[^-]-%19[^-]-%c-%*[^-]-%*[^-]-%9[^-]-%9[^-]-%*[^-]-%*[^-]-%c-%9[^-]-%19s",
4651 name, weight, &slant, pixels, height, &pitch, width, remainder);
4652
4653 if (fields == EOF) return (FALSE);
4654
4655 if (fields > 0 && name[0] != '*')
4656 {
4657 strncpy (lplogfont->lfFaceName,name, LF_FACESIZE);
4658 lplogfont->lfFaceName[LF_FACESIZE-1] = 0;
4659 }
4660 else
4661 {
4662 lplogfont->lfFaceName[0] = 0;
4663 }
4664
4665 fields--;
4666
fbd6baed 4667 lplogfont->lfWeight = x_to_w32_weight ((fields > 0 ? weight : ""));
5ac45f98
GV
4668
4669 fields--;
4670
fbd6baed 4671 if (!NILP (Vw32_enable_italics))
5ac45f98
GV
4672 lplogfont->lfItalic = (fields > 0 && slant == 'i');
4673
4674 fields--;
4675
4676 if (fields > 0 && pixels[0] != '*')
4677 lplogfont->lfHeight = atoi (pixels);
4678
4679 fields--;
4680
4681 if (fields > 0 && lplogfont->lfHeight == 0 && height[0] != '*')
4682 lplogfont->lfHeight = (atoi (height)
fbd6baed 4683 * one_w32_display_info.height_in) / 720;
5ac45f98
GV
4684
4685 fields--;
4686
4687 lplogfont->lfPitchAndFamily =
4688 (fields > 0 && pitch == 'p') ? VARIABLE_PITCH : FIXED_PITCH;
4689
4690 fields--;
4691
4692 if (fields > 0 && width[0] != '*')
4693 lplogfont->lfWidth = atoi (width) / 10;
4694
4695 fields--;
4696
4697 /* Not all font specs include the registry field, so we allow for an
4698 optional registry field before the encoding when parsing
4699 remainder. Also we strip the trailing '-' if present. */
3c190163 4700 {
5ac45f98
GV
4701 int len = strlen (remainder);
4702 if (len > 0 && remainder[len-1] == '-')
4703 remainder[len-1] = 0;
ee78dc32 4704 }
5ac45f98
GV
4705 encoding = remainder;
4706 if (strncmp (encoding, "*-", 2) == 0)
4707 encoding += 2;
fbd6baed 4708 lplogfont->lfCharSet = x_to_w32_charset (fields > 0 ? encoding : "");
5ac45f98
GV
4709 }
4710 else
4711 {
4712 int fields;
4713 char name[100], height[10], width[10], weight[20];
a1a80b40 4714
5ac45f98
GV
4715 fields = sscanf (lpxstr,
4716 "%99[^:]:%9[^:]:%9[^:]:%19s",
4717 name, height, width, weight);
4718
4719 if (fields == EOF) return (FALSE);
4720
4721 if (fields > 0)
4722 {
4723 strncpy (lplogfont->lfFaceName,name, LF_FACESIZE);
4724 lplogfont->lfFaceName[LF_FACESIZE-1] = 0;
4725 }
4726 else
4727 {
4728 lplogfont->lfFaceName[0] = 0;
4729 }
4730
4731 fields--;
4732
4733 if (fields > 0)
4734 lplogfont->lfHeight = atoi (height);
4735
4736 fields--;
4737
4738 if (fields > 0)
4739 lplogfont->lfWidth = atoi (width);
4740
4741 fields--;
4742
fbd6baed 4743 lplogfont->lfWeight = x_to_w32_weight ((fields > 0 ? weight : ""));
5ac45f98
GV
4744 }
4745
4746 /* This makes TrueType fonts work better. */
4747 lplogfont->lfHeight = - abs (lplogfont->lfHeight);
ee78dc32
GV
4748
4749 return (TRUE);
4750}
4751
4752BOOL
fbd6baed 4753w32_font_match (lpszfont1, lpszfont2)
ee78dc32
GV
4754 char * lpszfont1;
4755 char * lpszfont2;
4756{
4757 char * s1 = lpszfont1, *e1;
4758 char * s2 = lpszfont2, *e2;
4759
4760 if (s1 == NULL || s2 == NULL) return (FALSE);
4761
4762 if (*s1 == '-') s1++;
4763 if (*s2 == '-') s2++;
4764
4765 while (1)
4766 {
4767 int len1, len2;
4768
4769 e1 = strchr (s1, '-');
4770 e2 = strchr (s2, '-');
4771
4772 if (e1 == NULL || e2 == NULL) return (TRUE);
4773
4774 len1 = e1 - s1;
4775 len2 = e2 - s2;
4776
4777 if (*s1 != '*' && *s2 != '*'
4778 && (len1 != len2 || strnicmp (s1, s2, len1) != 0))
4779 return (FALSE);
4780
4781 s1 = e1 + 1;
4782 s2 = e2 + 1;
4783 }
4784}
4785
4786typedef struct enumfont_t
4787{
4788 HDC hdc;
4789 int numFonts;
3cb20f4a 4790 LOGFONT logfont;
ee78dc32
GV
4791 XFontStruct *size_ref;
4792 Lisp_Object *pattern;
4793 Lisp_Object *head;
4794 Lisp_Object *tail;
4795} enumfont_t;
4796
4797int CALLBACK
4798enum_font_cb2 (lplf, lptm, FontType, lpef)
4799 ENUMLOGFONT * lplf;
4800 NEWTEXTMETRIC * lptm;
4801 int FontType;
4802 enumfont_t * lpef;
4803{
1edf84e7 4804 if (lplf->elfLogFont.lfStrikeOut || lplf->elfLogFont.lfUnderline)
ee78dc32
GV
4805 return (1);
4806
4807 /* if (!lpef->size_ref || lptm->tmMaxCharWidth == FONT_WIDTH (lpef->size_ref)) */
4808 {
4809 char buf[100];
4810
3cb20f4a
RS
4811 if (!NILP (*(lpef->pattern)) && FontType == TRUETYPE_FONTTYPE)
4812 {
4813 lplf->elfLogFont.lfHeight = lpef->logfont.lfHeight;
4814 lplf->elfLogFont.lfWidth = lpef->logfont.lfWidth;
4815 }
4816
fbd6baed 4817 if (!w32_to_x_font (lplf, buf, 100)) return (0);
ee78dc32 4818
fbd6baed 4819 if (NILP (*(lpef->pattern)) || w32_font_match (buf, XSTRING (*(lpef->pattern))->data))
ee78dc32
GV
4820 {
4821 *lpef->tail = Fcons (build_string (buf), Qnil);
4822 lpef->tail = &XCONS (*lpef->tail)->cdr;
4823 lpef->numFonts++;
4824 }
4825 }
4826
4827 return (1);
4828}
4829
4830int CALLBACK
4831enum_font_cb1 (lplf, lptm, FontType, lpef)
4832 ENUMLOGFONT * lplf;
4833 NEWTEXTMETRIC * lptm;
4834 int FontType;
4835 enumfont_t * lpef;
4836{
4837 return EnumFontFamilies (lpef->hdc,
4838 lplf->elfLogFont.lfFaceName,
4839 (FONTENUMPROC) enum_font_cb2,
4840 (LPARAM) lpef);
4841}
4842
4843
4844DEFUN ("x-list-fonts", Fx_list_fonts, Sx_list_fonts, 1, 3, 0,
4845 "Return a list of the names of available fonts matching PATTERN.\n\
4846If optional arguments FACE and FRAME are specified, return only fonts\n\
4847the same size as FACE on FRAME.\n\
4848\n\
4849PATTERN is a string, perhaps with wildcard characters;\n\
4850 the * character matches any substring, and\n\
4851 the ? character matches any single character.\n\
4852 PATTERN is case-insensitive.\n\
4853FACE is a face name--a symbol.\n\
4854\n\
4855The return value is a list of strings, suitable as arguments to\n\
4856set-face-font.\n\
4857\n\
4858Fonts Emacs can't use (i.e. proportional fonts) may or may not be excluded\n\
4859even if they match PATTERN and FACE.")
4860 (pattern, face, frame)
4861 Lisp_Object pattern, face, frame;
4862{
4863 int num_fonts;
4864 char **names;
4865 XFontStruct *info;
4866 XFontStruct *size_ref;
4867 Lisp_Object namelist;
4868 Lisp_Object list;
4869 FRAME_PTR f;
4870 enumfont_t ef;
4871
4872 CHECK_STRING (pattern, 0);
4873 if (!NILP (face))
4874 CHECK_SYMBOL (face, 1);
4875
4876 f = check_x_frame (frame);
4877
4878 /* Determine the width standard for comparison with the fonts we find. */
4879
4880 if (NILP (face))
4881 size_ref = 0;
4882 else
4883 {
4884 int face_id;
4885
4886 /* Don't die if we get called with a terminal frame. */
fbd6baed
GV
4887 if (! FRAME_W32_P (f))
4888 error ("non-w32 frame used in `x-list-fonts'");
ee78dc32
GV
4889
4890 face_id = face_name_id_number (f, face);
4891
4892 if (face_id < 0 || face_id >= FRAME_N_PARAM_FACES (f)
4893 || FRAME_PARAM_FACES (f) [face_id] == 0)
fbd6baed 4894 size_ref = f->output_data.w32->font;
ee78dc32
GV
4895 else
4896 {
4897 size_ref = FRAME_PARAM_FACES (f) [face_id]->font;
4898 if (size_ref == (XFontStruct *) (~0))
fbd6baed 4899 size_ref = f->output_data.w32->font;
ee78dc32
GV
4900 }
4901 }
4902
4903 /* See if we cached the result for this particular query. */
4904 list = Fassoc (pattern,
fbd6baed 4905 XCONS (FRAME_W32_DISPLAY_INFO (f)->name_list_element)->cdr);
ee78dc32
GV
4906
4907 /* We have info in the cache for this PATTERN. */
4908 if (!NILP (list))
4909 {
4910 Lisp_Object tem, newlist;
4911
4912 /* We have info about this pattern. */
4913 list = XCONS (list)->cdr;
4914
4915 if (size_ref == 0)
4916 return list;
4917
4918 BLOCK_INPUT;
4919
4920 /* Filter the cached info and return just the fonts that match FACE. */
4921 newlist = Qnil;
4922 for (tem = list; CONSP (tem); tem = XCONS (tem)->cdr)
4923 {
4924 XFontStruct *thisinfo;
4925
fbd6baed 4926 thisinfo = w32_load_font (FRAME_W32_DISPLAY_INFO (f), XSTRING (XCONS (tem)->car)->data);
ee78dc32
GV
4927
4928 if (thisinfo && same_size_fonts (thisinfo, size_ref))
4929 newlist = Fcons (XCONS (tem)->car, newlist);
4930
fbd6baed 4931 w32_unload_font (FRAME_W32_DISPLAY_INFO (f), thisinfo);
ee78dc32
GV
4932 }
4933
4934 UNBLOCK_INPUT;
4935
4936 return newlist;
4937 }
4938
4939 BLOCK_INPUT;
4940
4941 namelist = Qnil;
4942 ef.pattern = &pattern;
4943 ef.tail = ef.head = &namelist;
4944 ef.numFonts = 0;
fbd6baed 4945 x_to_w32_font (STRINGP (pattern) ? XSTRING (pattern)->data : NULL, &ef.logfont);
ee78dc32
GV
4946
4947 {
fbd6baed 4948 ef.hdc = GetDC (FRAME_W32_WINDOW (f));
ee78dc32
GV
4949
4950 EnumFontFamilies (ef.hdc, NULL, (FONTENUMPROC) enum_font_cb1, (LPARAM)&ef);
4951
fbd6baed 4952 ReleaseDC (FRAME_W32_WINDOW (f), ef.hdc);
ee78dc32
GV
4953 }
4954
4955 UNBLOCK_INPUT;
4956
4957 if (ef.numFonts)
4958 {
4959 int i;
4960 Lisp_Object cur;
4961
4962 /* Make a list of all the fonts we got back.
4963 Store that in the font cache for the display. */
fbd6baed 4964 XCONS (FRAME_W32_DISPLAY_INFO (f)->name_list_element)->cdr
ee78dc32 4965 = Fcons (Fcons (pattern, namelist),
fbd6baed 4966 XCONS (FRAME_W32_DISPLAY_INFO (f)->name_list_element)->cdr);
ee78dc32
GV
4967
4968 /* Make a list of the fonts that have the right width. */
4969 list = Qnil;
4970 cur=namelist;
4971 for (i = 0; i < ef.numFonts; i++)
4972 {
4973 int keeper;
4974
4975 if (!size_ref)
4976 keeper = 1;
4977 else
4978 {
4979 XFontStruct *thisinfo;
4980
4981 BLOCK_INPUT;
fbd6baed 4982 thisinfo = w32_load_font (FRAME_W32_DISPLAY_INFO (f), XSTRING (Fcar (cur))->data);
ee78dc32
GV
4983
4984 keeper = thisinfo && same_size_fonts (thisinfo, size_ref);
4985
fbd6baed 4986 w32_unload_font (FRAME_W32_DISPLAY_INFO (f), thisinfo);
ee78dc32
GV
4987
4988 UNBLOCK_INPUT;
4989 }
4990 if (keeper)
4991 list = Fcons (build_string (XSTRING (Fcar (cur))->data), list);
4992
4993 cur = Fcdr (cur);
4994 }
4995 list = Fnreverse (list);
4996 }
4997
4998 return list;
4999}
5000\f
5001DEFUN ("x-color-defined-p", Fx_color_defined_p, Sx_color_defined_p, 1, 2, 0,
5002 "Return non-nil if color COLOR is supported on frame FRAME.\n\
5003If FRAME is omitted or nil, use the selected frame.")
5004 (color, frame)
5005 Lisp_Object color, frame;
5006{
5007 COLORREF foo;
5008 FRAME_PTR f = check_x_frame (frame);
5009
5010 CHECK_STRING (color, 1);
5011
5012 if (defined_color (f, XSTRING (color)->data, &foo, 0))
5013 return Qt;
5014 else
5015 return Qnil;
5016}
5017
5018DEFUN ("x-color-values", Fx_color_values, Sx_color_values, 1, 2, 0,
5019 "Return a description of the color named COLOR on frame FRAME.\n\
5020The value is a list of integer RGB values--(RED GREEN BLUE).\n\
5021These values appear to range from 0 to 65280 or 65535, depending\n\
5022on the system; white is (65280 65280 65280) or (65535 65535 65535).\n\
5023If FRAME is omitted or nil, use the selected frame.")
5024 (color, frame)
5025 Lisp_Object color, frame;
5026{
5027 COLORREF foo;
5028 FRAME_PTR f = check_x_frame (frame);
5029
5030 CHECK_STRING (color, 1);
5031
5032 if (defined_color (f, XSTRING (color)->data, &foo, 0))
5033 {
5034 Lisp_Object rgb[3];
5035
1edf84e7
GV
5036 rgb[0] = make_number ((GetRValue (foo) << 8) | GetRValue (foo));
5037 rgb[1] = make_number ((GetGValue (foo) << 8) | GetGValue (foo));
5038 rgb[2] = make_number ((GetBValue (foo) << 8) | GetBValue (foo));
ee78dc32
GV
5039 return Flist (3, rgb);
5040 }
5041 else
5042 return Qnil;
5043}
5044
5045DEFUN ("x-display-color-p", Fx_display_color_p, Sx_display_color_p, 0, 1, 0,
5046 "Return t if the X display supports color.\n\
5047The optional argument DISPLAY specifies which display to ask about.\n\
5048DISPLAY should be either a frame or a display name (a string).\n\
5049If omitted or nil, that stands for the selected frame's display.")
5050 (display)
5051 Lisp_Object display;
5052{
fbd6baed 5053 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV
5054
5055 if ((dpyinfo->n_planes * dpyinfo->n_cbits) <= 2)
5056 return Qnil;
5057
5058 return Qt;
5059}
5060
5061DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p, Sx_display_grayscale_p,
5062 0, 1, 0,
5063 "Return t if the X display supports shades of gray.\n\
5064Note that color displays do support shades of gray.\n\
5065The optional argument DISPLAY specifies which display to ask about.\n\
5066DISPLAY should be either a frame or a display name (a string).\n\
5067If omitted or nil, that stands for the selected frame's display.")
5068 (display)
5069 Lisp_Object display;
5070{
fbd6baed 5071 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV
5072
5073 if ((dpyinfo->n_planes * dpyinfo->n_cbits) <= 1)
5074 return Qnil;
5075
5076 return Qt;
5077}
5078
5079DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width,
5080 0, 1, 0,
5081 "Returns the width in pixels of the X display DISPLAY.\n\
5082The optional argument DISPLAY specifies which display to ask about.\n\
5083DISPLAY should be either a frame or a display name (a string).\n\
5084If omitted or nil, that stands for the selected frame's display.")
5085 (display)
5086 Lisp_Object display;
5087{
fbd6baed 5088 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV
5089
5090 return make_number (dpyinfo->width);
5091}
5092
5093DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
5094 Sx_display_pixel_height, 0, 1, 0,
5095 "Returns the height in pixels of the X display DISPLAY.\n\
5096The optional argument DISPLAY specifies which display to ask about.\n\
5097DISPLAY should be either a frame or a display name (a string).\n\
5098If omitted or nil, that stands for the selected frame's display.")
5099 (display)
5100 Lisp_Object display;
5101{
fbd6baed 5102 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV
5103
5104 return make_number (dpyinfo->height);
5105}
5106
5107DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
5108 0, 1, 0,
5109 "Returns the number of bitplanes of the display DISPLAY.\n\
5110The optional argument DISPLAY specifies which display to ask about.\n\
5111DISPLAY should be either a frame or a display name (a string).\n\
5112If omitted or nil, that stands for the selected frame's display.")
5113 (display)
5114 Lisp_Object display;
5115{
fbd6baed 5116 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV
5117
5118 return make_number (dpyinfo->n_planes * dpyinfo->n_cbits);
5119}
5120
5121DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
5122 0, 1, 0,
5123 "Returns the number of color cells of the display DISPLAY.\n\
5124The optional argument DISPLAY specifies which display to ask about.\n\
5125DISPLAY should be either a frame or a display name (a string).\n\
5126If omitted or nil, that stands for the selected frame's display.")
5127 (display)
5128 Lisp_Object display;
5129{
fbd6baed 5130 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV
5131 HDC hdc;
5132 int cap;
5133
5ac45f98
GV
5134 hdc = GetDC (dpyinfo->root_window);
5135 if (dpyinfo->has_palette)
5136 cap = GetDeviceCaps (hdc,SIZEPALETTE);
5137 else
5138 cap = GetDeviceCaps (hdc,NUMCOLORS);
ee78dc32
GV
5139
5140 ReleaseDC (dpyinfo->root_window, hdc);
5141
5142 return make_number (cap);
5143}
5144
5145DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
5146 Sx_server_max_request_size,
5147 0, 1, 0,
5148 "Returns the maximum request size of the server of display DISPLAY.\n\
5149The optional argument DISPLAY specifies which display to ask about.\n\
5150DISPLAY should be either a frame or a display name (a string).\n\
5151If omitted or nil, that stands for the selected frame's display.")
5152 (display)
5153 Lisp_Object display;
5154{
fbd6baed 5155 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV
5156
5157 return make_number (1);
5158}
5159
5160DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
fbd6baed 5161 "Returns the vendor ID string of the W32 system (Microsoft).\n\
ee78dc32
GV
5162The optional argument DISPLAY specifies which display to ask about.\n\
5163DISPLAY should be either a frame or a display name (a string).\n\
5164If omitted or nil, that stands for the selected frame's display.")
5165 (display)
5166 Lisp_Object display;
5167{
fbd6baed 5168 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV
5169 char *vendor = "Microsoft Corp.";
5170
5171 if (! vendor) vendor = "";
5172 return build_string (vendor);
5173}
5174
5175DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
5176 "Returns the version numbers of the server of display DISPLAY.\n\
5177The value is a list of three integers: the major and minor\n\
5178version numbers, and the vendor-specific release\n\
5179number. See also the function `x-server-vendor'.\n\n\
5180The optional argument DISPLAY specifies which display to ask about.\n\
5181DISPLAY should be either a frame or a display name (a string).\n\
5182If omitted or nil, that stands for the selected frame's display.")
5183 (display)
5184 Lisp_Object display;
5185{
fbd6baed 5186 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32 5187
fbd6baed
GV
5188 return Fcons (make_number (w32_major_version),
5189 Fcons (make_number (w32_minor_version), Qnil));
ee78dc32
GV
5190}
5191
5192DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
5193 "Returns the number of screens on the server of display DISPLAY.\n\
5194The optional argument DISPLAY specifies which display to ask about.\n\
5195DISPLAY should be either a frame or a display name (a string).\n\
5196If omitted or nil, that stands for the selected frame's display.")
5197 (display)
5198 Lisp_Object display;
5199{
fbd6baed 5200 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV
5201
5202 return make_number (1);
5203}
5204
5205DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, 0,
5206 "Returns the height in millimeters of the X display DISPLAY.\n\
5207The optional argument DISPLAY specifies which display to ask about.\n\
5208DISPLAY should be either a frame or a display name (a string).\n\
5209If omitted or nil, that stands for the selected frame's display.")
5210 (display)
5211 Lisp_Object display;
5212{
fbd6baed 5213 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV
5214 HDC hdc;
5215 int cap;
5216
5ac45f98 5217 hdc = GetDC (dpyinfo->root_window);
3c190163 5218
ee78dc32 5219 cap = GetDeviceCaps (hdc, VERTSIZE);
3c190163 5220
ee78dc32
GV
5221 ReleaseDC (dpyinfo->root_window, hdc);
5222
5223 return make_number (cap);
5224}
5225
5226DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
5227 "Returns the width in millimeters of the X display DISPLAY.\n\
5228The optional argument DISPLAY specifies which display to ask about.\n\
5229DISPLAY should be either a frame or a display name (a string).\n\
5230If omitted or nil, that stands for the selected frame's display.")
5231 (display)
5232 Lisp_Object display;
5233{
fbd6baed 5234 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV
5235
5236 HDC hdc;
5237 int cap;
5238
5ac45f98 5239 hdc = GetDC (dpyinfo->root_window);
3c190163 5240
ee78dc32 5241 cap = GetDeviceCaps (hdc, HORZSIZE);
3c190163 5242
ee78dc32
GV
5243 ReleaseDC (dpyinfo->root_window, hdc);
5244
5245 return make_number (cap);
5246}
5247
5248DEFUN ("x-display-backing-store", Fx_display_backing_store,
5249 Sx_display_backing_store, 0, 1, 0,
5250 "Returns an indication of whether display DISPLAY does backing store.\n\
5251The value may be `always', `when-mapped', or `not-useful'.\n\
5252The optional argument DISPLAY specifies which display to ask about.\n\
5253DISPLAY should be either a frame or a display name (a string).\n\
5254If omitted or nil, that stands for the selected frame's display.")
5255 (display)
5256 Lisp_Object display;
5257{
5258 return intern ("not-useful");
5259}
5260
5261DEFUN ("x-display-visual-class", Fx_display_visual_class,
5262 Sx_display_visual_class, 0, 1, 0,
5263 "Returns the visual class of the display DISPLAY.\n\
5264The value is one of the symbols `static-gray', `gray-scale',\n\
5265`static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
5266The optional argument DISPLAY specifies which display to ask about.\n\
5267DISPLAY should be either a frame or a display name (a string).\n\
5268If omitted or nil, that stands for the selected frame's display.")
5269 (display)
5270 Lisp_Object display;
5271{
fbd6baed 5272 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV
5273
5274#if 0
5275 switch (dpyinfo->visual->class)
5276 {
5277 case StaticGray: return (intern ("static-gray"));
5278 case GrayScale: return (intern ("gray-scale"));
5279 case StaticColor: return (intern ("static-color"));
5280 case PseudoColor: return (intern ("pseudo-color"));
5281 case TrueColor: return (intern ("true-color"));
5282 case DirectColor: return (intern ("direct-color"));
5283 default:
5284 error ("Display has an unknown visual class");
5285 }
5286#endif
5287
5288 error ("Display has an unknown visual class");
5289}
5290
5291DEFUN ("x-display-save-under", Fx_display_save_under,
5292 Sx_display_save_under, 0, 1, 0,
5293 "Returns t if the display DISPLAY supports the save-under feature.\n\
5294The optional argument DISPLAY specifies which display to ask about.\n\
5295DISPLAY should be either a frame or a display name (a string).\n\
5296If omitted or nil, that stands for the selected frame's display.")
5297 (display)
5298 Lisp_Object display;
5299{
fbd6baed 5300 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV
5301
5302 return Qnil;
5303}
5304\f
5305int
5306x_pixel_width (f)
5307 register struct frame *f;
5308{
5309 return PIXEL_WIDTH (f);
5310}
5311
5312int
5313x_pixel_height (f)
5314 register struct frame *f;
5315{
5316 return PIXEL_HEIGHT (f);
5317}
5318
5319int
5320x_char_width (f)
5321 register struct frame *f;
5322{
fbd6baed 5323 return FONT_WIDTH (f->output_data.w32->font);
ee78dc32
GV
5324}
5325
5326int
5327x_char_height (f)
5328 register struct frame *f;
5329{
fbd6baed 5330 return f->output_data.w32->line_height;
ee78dc32
GV
5331}
5332
5333int
5334x_screen_planes (frame)
5335 Lisp_Object frame;
5336{
fbd6baed
GV
5337 return (FRAME_W32_DISPLAY_INFO (XFRAME (frame))->n_planes *
5338 FRAME_W32_DISPLAY_INFO (XFRAME (frame))->n_cbits);
ee78dc32
GV
5339}
5340\f
5341/* Return the display structure for the display named NAME.
5342 Open a new connection if necessary. */
5343
fbd6baed 5344struct w32_display_info *
ee78dc32
GV
5345x_display_info_for_name (name)
5346 Lisp_Object name;
5347{
5348 Lisp_Object names;
fbd6baed 5349 struct w32_display_info *dpyinfo;
ee78dc32
GV
5350
5351 CHECK_STRING (name, 0);
5352
fbd6baed 5353 for (dpyinfo = &one_w32_display_info, names = w32_display_name_list;
ee78dc32
GV
5354 dpyinfo;
5355 dpyinfo = dpyinfo->next, names = XCONS (names)->cdr)
5356 {
5357 Lisp_Object tem;
5358 tem = Fstring_equal (XCONS (XCONS (names)->car)->car, name);
5359 if (!NILP (tem))
5360 return dpyinfo;
5361 }
5362
5363 /* Use this general default value to start with. */
5364 Vx_resource_name = Vinvocation_name;
5365
5366 validate_x_resource_name ();
5367
fbd6baed 5368 dpyinfo = w32_term_init (name, (unsigned char *)0,
ee78dc32
GV
5369 (char *) XSTRING (Vx_resource_name)->data);
5370
5371 if (dpyinfo == 0)
5372 error ("Cannot connect to server %s", XSTRING (name)->data);
5373
1edf84e7 5374 w32_in_use = 1;
ee78dc32
GV
5375 XSETFASTINT (Vwindow_system_version, 3);
5376
5377 return dpyinfo;
5378}
5379
5380DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
5381 1, 3, 0, "Open a connection to a server.\n\
5382DISPLAY is the name of the display to connect to.\n\
5383Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
5384If the optional third arg MUST-SUCCEED is non-nil,\n\
5385terminate Emacs if we can't open the connection.")
5386 (display, xrm_string, must_succeed)
5387 Lisp_Object display, xrm_string, must_succeed;
5388{
5389 unsigned int n_planes;
5390 unsigned char *xrm_option;
fbd6baed 5391 struct w32_display_info *dpyinfo;
ee78dc32
GV
5392
5393 CHECK_STRING (display, 0);
5394 if (! NILP (xrm_string))
5395 CHECK_STRING (xrm_string, 1);
5396
1edf84e7
GV
5397 if (! EQ (Vwindow_system, intern ("w32")))
5398 error ("Not using Microsoft Windows");
5399
5ac45f98
GV
5400 /* Allow color mapping to be defined externally; first look in user's
5401 HOME directory, then in Emacs etc dir for a file called rgb.txt. */
5402 {
5403 Lisp_Object color_file;
5404 struct gcpro gcpro1;
5405
5406 color_file = build_string("~/rgb.txt");
5407
5408 GCPRO1 (color_file);
5409
5410 if (NILP (Ffile_readable_p (color_file)))
5411 color_file =
5412 Fexpand_file_name (build_string ("rgb.txt"),
5413 Fsymbol_value (intern ("data-directory")));
5414
fbd6baed 5415 Vw32_color_map = Fw32_load_color_file (color_file);
5ac45f98
GV
5416
5417 UNGCPRO;
5418 }
fbd6baed
GV
5419 if (NILP (Vw32_color_map))
5420 Vw32_color_map = Fw32_default_color_map ();
ee78dc32
GV
5421
5422 if (! NILP (xrm_string))
5423 xrm_option = (unsigned char *) XSTRING (xrm_string)->data;
5424 else
5425 xrm_option = (unsigned char *) 0;
5426
5427 /* Use this general default value to start with. */
5ac45f98
GV
5428 /* First remove .exe suffix from invocation-name - it looks ugly. */
5429 {
5430 char basename[ MAX_PATH ], *str;
5431
5432 strcpy (basename, XSTRING (Vinvocation_name)->data);
5433 str = strrchr (basename, '.');
5434 if (str) *str = 0;
5435 Vinvocation_name = build_string (basename);
5436 }
ee78dc32
GV
5437 Vx_resource_name = Vinvocation_name;
5438
5439 validate_x_resource_name ();
5440
5441 /* This is what opens the connection and sets x_current_display.
5442 This also initializes many symbols, such as those used for input. */
fbd6baed 5443 dpyinfo = w32_term_init (display, xrm_option,
ee78dc32
GV
5444 (char *) XSTRING (Vx_resource_name)->data);
5445
5446 if (dpyinfo == 0)
5447 {
5448 if (!NILP (must_succeed))
3c190163
GV
5449 fatal ("Cannot connect to server %s.\n",
5450 XSTRING (display)->data);
ee78dc32
GV
5451 else
5452 error ("Cannot connect to server %s", XSTRING (display)->data);
5453 }
5454
1edf84e7
GV
5455 w32_in_use = 1;
5456
ee78dc32
GV
5457 XSETFASTINT (Vwindow_system_version, 3);
5458 return Qnil;
5459}
5460
5461DEFUN ("x-close-connection", Fx_close_connection,
5462 Sx_close_connection, 1, 1, 0,
5463 "Close the connection to DISPLAY's server.\n\
5464For DISPLAY, specify either a frame or a display name (a string).\n\
5465If DISPLAY is nil, that stands for the selected frame's display.")
5466 (display)
5467 Lisp_Object display;
5468{
fbd6baed
GV
5469 struct w32_display_info *dpyinfo = check_x_display_info (display);
5470 struct w32_display_info *tail;
ee78dc32
GV
5471 int i;
5472
5473 if (dpyinfo->reference_count > 0)
5474 error ("Display still has frames on it");
5475
5476 BLOCK_INPUT;
5477 /* Free the fonts in the font table. */
5478 for (i = 0; i < dpyinfo->n_fonts; i++)
5479 {
5480 if (dpyinfo->font_table[i].name)
5481 free (dpyinfo->font_table[i].name);
5482 /* Don't free the full_name string;
5483 it is always shared with something else. */
fbd6baed 5484 w32_unload_font (dpyinfo, dpyinfo->font_table[i].font);
ee78dc32
GV
5485 }
5486 x_destroy_all_bitmaps (dpyinfo);
5487
5488 x_delete_display (dpyinfo);
5489 UNBLOCK_INPUT;
5490
5491 return Qnil;
5492}
5493
5494DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0,
5495 "Return the list of display names that Emacs has connections to.")
5496 ()
5497{
5498 Lisp_Object tail, result;
5499
5500 result = Qnil;
fbd6baed 5501 for (tail = w32_display_name_list; ! NILP (tail); tail = XCONS (tail)->cdr)
ee78dc32
GV
5502 result = Fcons (XCONS (XCONS (tail)->car)->car, result);
5503
5504 return result;
5505}
5506
5507DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize, 1, 2, 0,
5508 "If ON is non-nil, report errors as soon as the erring request is made.\n\
5509If ON is nil, allow buffering of requests.\n\
fbd6baed 5510This is a noop on W32 systems.\n\
ee78dc32
GV
5511The optional second argument DISPLAY specifies which display to act on.\n\
5512DISPLAY should be either a frame or a display name (a string).\n\
5513If DISPLAY is omitted or nil, that stands for the selected frame's display.")
5514 (on, display)
5515 Lisp_Object display, on;
5516{
fbd6baed 5517 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV
5518
5519 return Qnil;
5520}
5521
5522\f
fbd6baed 5523/* These are the w32 specialized functions */
ee78dc32 5524
fbd6baed
GV
5525DEFUN ("w32-select-font", Fw32_select_font, Sw32_select_font, 0, 1, 0,
5526 "This will display the W32 font dialog and return an X font string corresponding to the selection.")
ee78dc32
GV
5527 (frame)
5528 Lisp_Object frame;
5529{
5530 FRAME_PTR f = check_x_frame (frame);
5531 CHOOSEFONT cf;
5532 LOGFONT lf;
5533 char buf[100];
5534
5535 bzero (&cf, sizeof (cf));
5536
5537 cf.lStructSize = sizeof (cf);
fbd6baed 5538 cf.hwndOwner = FRAME_W32_WINDOW (f);
ee78dc32
GV
5539 cf.Flags = CF_FIXEDPITCHONLY | CF_FORCEFONTEXIST | CF_SCREENFONTS;
5540 cf.lpLogFont = &lf;
5541
fbd6baed 5542 if (!ChooseFont (&cf) || !w32_to_x_font (&lf, buf, 100))
3c190163 5543 return Qnil;
ee78dc32
GV
5544
5545 return build_string (buf);
5546}
5547
1edf84e7
GV
5548DEFUN ("w32-send-sys-command", Fw32_send_sys_command, Sw32_send_sys_command, 1, 2, 0,
5549 "Send frame a Windows WM_SYSCOMMAND message of type COMMAND.\n\
5550Some useful values for command are 0xf030 to maximise frame (0xf020\n\
5551to minimize), 0xf120 to restore frame to original size, and 0xf100\n\
5552to activate the menubar for keyboard access. 0xf140 activates the\n\
5553screen saver if defined.\n\
5554\n\
5555If optional parameter FRAME is not specified, use selected frame.")
5556 (command, frame)
5557 Lisp_Object command, frame;
5558{
5559 WPARAM code;
5560 FRAME_PTR f = check_x_frame (frame);
5561
5562 CHECK_NUMBER (command, 0);
5563
5564 PostMessage (FRAME_W32_WINDOW (f), WM_SYSCOMMAND, XINT (command), 0);
5565
5566 return Qnil;
5567}
5568
ee78dc32 5569\f
fbd6baed 5570syms_of_w32fns ()
ee78dc32 5571{
1edf84e7
GV
5572 /* This is zero if not using MS-Windows. */
5573 w32_in_use = 0;
5574
ee78dc32
GV
5575 /* The section below is built by the lisp expression at the top of the file,
5576 just above where these variables are declared. */
5577 /*&&& init symbols here &&&*/
5578 Qauto_raise = intern ("auto-raise");
5579 staticpro (&Qauto_raise);
5580 Qauto_lower = intern ("auto-lower");
5581 staticpro (&Qauto_lower);
5582 Qbackground_color = intern ("background-color");
5583 staticpro (&Qbackground_color);
5584 Qbar = intern ("bar");
5585 staticpro (&Qbar);
5586 Qborder_color = intern ("border-color");
5587 staticpro (&Qborder_color);
5588 Qborder_width = intern ("border-width");
5589 staticpro (&Qborder_width);
5590 Qbox = intern ("box");
5591 staticpro (&Qbox);
5592 Qcursor_color = intern ("cursor-color");
5593 staticpro (&Qcursor_color);
5594 Qcursor_type = intern ("cursor-type");
5595 staticpro (&Qcursor_type);
ee78dc32
GV
5596 Qforeground_color = intern ("foreground-color");
5597 staticpro (&Qforeground_color);
5598 Qgeometry = intern ("geometry");
5599 staticpro (&Qgeometry);
5600 Qicon_left = intern ("icon-left");
5601 staticpro (&Qicon_left);
5602 Qicon_top = intern ("icon-top");
5603 staticpro (&Qicon_top);
5604 Qicon_type = intern ("icon-type");
5605 staticpro (&Qicon_type);
5606 Qicon_name = intern ("icon-name");
5607 staticpro (&Qicon_name);
5608 Qinternal_border_width = intern ("internal-border-width");
5609 staticpro (&Qinternal_border_width);
5610 Qleft = intern ("left");
5611 staticpro (&Qleft);
1026b400
RS
5612 Qright = intern ("right");
5613 staticpro (&Qright);
ee78dc32
GV
5614 Qmouse_color = intern ("mouse-color");
5615 staticpro (&Qmouse_color);
5616 Qnone = intern ("none");
5617 staticpro (&Qnone);
5618 Qparent_id = intern ("parent-id");
5619 staticpro (&Qparent_id);
5620 Qscroll_bar_width = intern ("scroll-bar-width");
5621 staticpro (&Qscroll_bar_width);
5622 Qsuppress_icon = intern ("suppress-icon");
5623 staticpro (&Qsuppress_icon);
5624 Qtop = intern ("top");
5625 staticpro (&Qtop);
5626 Qundefined_color = intern ("undefined-color");
5627 staticpro (&Qundefined_color);
5628 Qvertical_scroll_bars = intern ("vertical-scroll-bars");
5629 staticpro (&Qvertical_scroll_bars);
5630 Qvisibility = intern ("visibility");
5631 staticpro (&Qvisibility);
5632 Qwindow_id = intern ("window-id");
5633 staticpro (&Qwindow_id);
5634 Qx_frame_parameter = intern ("x-frame-parameter");
5635 staticpro (&Qx_frame_parameter);
5636 Qx_resource_name = intern ("x-resource-name");
5637 staticpro (&Qx_resource_name);
5638 Quser_position = intern ("user-position");
5639 staticpro (&Quser_position);
5640 Quser_size = intern ("user-size");
5641 staticpro (&Quser_size);
5642 Qdisplay = intern ("display");
5643 staticpro (&Qdisplay);
5644 /* This is the end of symbol initialization. */
5645
5646 Fput (Qundefined_color, Qerror_conditions,
5647 Fcons (Qundefined_color, Fcons (Qerror, Qnil)));
5648 Fput (Qundefined_color, Qerror_message,
5649 build_string ("Undefined color"));
5650
fbd6baed 5651 DEFVAR_LISP ("w32-color-map", &Vw32_color_map,
ee78dc32 5652 "A array of color name mappings for windows.");
fbd6baed 5653 Vw32_color_map = Qnil;
ee78dc32 5654
fbd6baed 5655 DEFVAR_LISP ("w32-pass-alt-to-system", &Vw32_pass_alt_to_system,
da36a4d6
GV
5656 "Non-nil if alt key presses are passed on to Windows.\n\
5657When non-nil, for example, alt pressed and released and then space will\n\
5658open the System menu. When nil, Emacs silently swallows alt key events.");
fbd6baed 5659 Vw32_pass_alt_to_system = Qnil;
da36a4d6 5660
fbd6baed 5661 DEFVAR_LISP ("w32-alt-is-meta", &Vw32_alt_is_meta,
8c205c63
RS
5662 "Non-nil if the alt key is to be considered the same as the meta key.\n\
5663When nil, Emacs will translate the alt key to the Alt modifier, and not Meta.");
fbd6baed 5664 Vw32_alt_is_meta = Qt;
8c205c63 5665
fbd6baed
GV
5666 DEFVAR_LISP ("w32-pass-optional-keys-to-system",
5667 &Vw32_pass_optional_keys_to_system,
da36a4d6
GV
5668 "Non-nil if the 'optional' keys (left window, right window,\n\
5669and application keys) are passed on to Windows.");
fbd6baed 5670 Vw32_pass_optional_keys_to_system = Qnil;
da36a4d6 5671
fbd6baed 5672 DEFVAR_LISP ("w32-enable-italics", &Vw32_enable_italics,
5ac45f98 5673 "Non-nil enables selection of artificially italicized fonts.");
fbd6baed 5674 Vw32_enable_italics = Qnil;
5ac45f98 5675
fbd6baed 5676 DEFVAR_LISP ("w32-enable-palette", &Vw32_enable_palette,
5ac45f98 5677 "Non-nil enables Windows palette management to map colors exactly.");
fbd6baed 5678 Vw32_enable_palette = Qt;
5ac45f98 5679
fbd6baed
GV
5680 DEFVAR_INT ("w32-mouse-button-tolerance",
5681 &Vw32_mouse_button_tolerance,
5ac45f98
GV
5682 "Analogue of double click interval for faking middle mouse events.\n\
5683The value is the minimum time in milliseconds that must elapse between\n\
5684left/right button down events before they are considered distinct events.\n\
5685If both mouse buttons are depressed within this interval, a middle mouse\n\
5686button down event is generated instead.");
fbd6baed 5687 XSETINT (Vw32_mouse_button_tolerance, GetDoubleClickTime () / 2);
5ac45f98 5688
fbd6baed
GV
5689 DEFVAR_INT ("w32-mouse-move-interval",
5690 &Vw32_mouse_move_interval,
84fb1139
KH
5691 "Minimum interval between mouse move events.\n\
5692The value is the minimum time in milliseconds that must elapse between\n\
5693successive mouse move (or scroll bar drag) events before they are\n\
5694reported as lisp events.");
fbd6baed 5695 XSETINT (Vw32_mouse_move_interval, 50);
84fb1139 5696
ee78dc32
GV
5697 init_x_parm_symbols ();
5698
5699 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path,
fbd6baed 5700 "List of directories to search for bitmap files for w32.");
ee78dc32
GV
5701 Vx_bitmap_file_path = decode_env_path ((char *) 0, "PATH");
5702
5703 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape,
5704 "The shape of the pointer when over text.\n\
5705Changing the value does not affect existing frames\n\
5706unless you set the mouse color.");
5707 Vx_pointer_shape = Qnil;
5708
5709 DEFVAR_LISP ("x-resource-name", &Vx_resource_name,
5710 "The name Emacs uses to look up resources; for internal use only.\n\
5711`x-get-resource' uses this as the first component of the instance name\n\
5712when requesting resource values.\n\
5713Emacs initially sets `x-resource-name' to the name under which Emacs\n\
5714was invoked, or to the value specified with the `-name' or `-rn'\n\
5715switches, if present.");
5716 Vx_resource_name = Qnil;
5717
5718 Vx_nontext_pointer_shape = Qnil;
5719
5720 Vx_mode_pointer_shape = Qnil;
5721
5722 DEFVAR_INT ("x-sensitive-text-pointer-shape",
5723 &Vx_sensitive_text_pointer_shape,
5724 "The shape of the pointer when over mouse-sensitive text.\n\
5725This variable takes effect when you create a new frame\n\
5726or when you set the mouse color.");
5727 Vx_sensitive_text_pointer_shape = Qnil;
5728
5729 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel,
5730 "A string indicating the foreground color of the cursor box.");
5731 Vx_cursor_fore_pixel = Qnil;
5732
5733 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager,
5734 "Non-nil if no window manager is in use.\n\
5735Emacs doesn't try to figure this out; this is always nil\n\
5736unless you set it to something else.");
5737 /* We don't have any way to find this out, so set it to nil
5738 and maybe the user would like to set it to t. */
5739 Vx_no_window_manager = Qnil;
5740
5741 defsubr (&Sx_get_resource);
5742 defsubr (&Sx_list_fonts);
5743 defsubr (&Sx_display_color_p);
5744 defsubr (&Sx_display_grayscale_p);
5745 defsubr (&Sx_color_defined_p);
5746 defsubr (&Sx_color_values);
5747 defsubr (&Sx_server_max_request_size);
5748 defsubr (&Sx_server_vendor);
5749 defsubr (&Sx_server_version);
5750 defsubr (&Sx_display_pixel_width);
5751 defsubr (&Sx_display_pixel_height);
5752 defsubr (&Sx_display_mm_width);
5753 defsubr (&Sx_display_mm_height);
5754 defsubr (&Sx_display_screens);
5755 defsubr (&Sx_display_planes);
5756 defsubr (&Sx_display_color_cells);
5757 defsubr (&Sx_display_visual_class);
5758 defsubr (&Sx_display_backing_store);
5759 defsubr (&Sx_display_save_under);
5760 defsubr (&Sx_parse_geometry);
5761 defsubr (&Sx_create_frame);
ee78dc32
GV
5762 defsubr (&Sx_open_connection);
5763 defsubr (&Sx_close_connection);
5764 defsubr (&Sx_display_list);
5765 defsubr (&Sx_synchronize);
5766
fbd6baed 5767 /* W32 specific functions */
ee78dc32 5768
1edf84e7 5769 defsubr (&Sw32_focus_frame);
fbd6baed
GV
5770 defsubr (&Sw32_select_font);
5771 defsubr (&Sw32_define_rgb_color);
5772 defsubr (&Sw32_default_color_map);
5773 defsubr (&Sw32_load_color_file);
1edf84e7 5774 defsubr (&Sw32_send_sys_command);
ee78dc32
GV
5775}
5776
5777#undef abort
5778
5779void
fbd6baed 5780w32_abort()
ee78dc32 5781{
5ac45f98
GV
5782 int button;
5783 button = MessageBox (NULL,
5784 "A fatal error has occurred!\n\n"
5785 "Select Abort to exit, Retry to debug, Ignore to continue",
5786 "Emacs Abort Dialog",
5787 MB_ICONEXCLAMATION | MB_TASKMODAL
5788 | MB_SETFOREGROUND | MB_ABORTRETRYIGNORE);
5789 switch (button)
5790 {
5791 case IDRETRY:
5792 DebugBreak ();
5793 break;
5794 case IDIGNORE:
5795 break;
5796 case IDABORT:
5797 default:
5798 abort ();
5799 break;
5800 }
ee78dc32 5801}
d573caac 5802