(set-face-font): For now, don't call
[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. */
53d60803
RS
3411 msg = WM_NULL;
3412
3413 /* Interrupt any blocking system calls. */
3414 signal_quit ();
3aef7b4e 3415 }
5ac45f98 3416 }
4ba07e88
GV
3417#endif
3418
3aef7b4e
GV
3419 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3420
ee78dc32 3421 break;
da36a4d6 3422
5ac45f98
GV
3423 /* Simulate middle mouse button events when left and right buttons
3424 are used together, but only if user has two button mouse. */
ee78dc32 3425 case WM_LBUTTONDOWN:
5ac45f98 3426 case WM_RBUTTONDOWN:
fbd6baed 3427 if (XINT (Vw32_num_mouse_buttons) == 3)
5ac45f98
GV
3428 goto handle_plain_button;
3429
3430 {
3431 int this = (msg == WM_LBUTTONDOWN) ? LMOUSE : RMOUSE;
3432 int other = (msg == WM_LBUTTONDOWN) ? RMOUSE : LMOUSE;
3433
3cb20f4a
RS
3434 if (button_state & this)
3435 return 0;
5ac45f98
GV
3436
3437 if (button_state == 0)
3438 SetCapture (hwnd);
3439
3440 button_state |= this;
3441
3442 if (button_state & other)
3443 {
84fb1139 3444 if (mouse_button_timer)
5ac45f98 3445 {
84fb1139
KH
3446 KillTimer (hwnd, mouse_button_timer);
3447 mouse_button_timer = 0;
5ac45f98
GV
3448
3449 /* Generate middle mouse event instead. */
3450 msg = WM_MBUTTONDOWN;
3451 button_state |= MMOUSE;
3452 }
3453 else if (button_state & MMOUSE)
3454 {
3455 /* Ignore button event if we've already generated a
3456 middle mouse down event. This happens if the
3457 user releases and press one of the two buttons
3458 after we've faked a middle mouse event. */
3459 return 0;
3460 }
3461 else
3462 {
3463 /* Flush out saved message. */
84fb1139 3464 post_msg (&saved_mouse_button_msg);
5ac45f98 3465 }
fbd6baed 3466 wmsg.dwModifiers = w32_get_modifiers ();
5ac45f98
GV
3467 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3468
3469 /* Clear message buffer. */
84fb1139 3470 saved_mouse_button_msg.msg.hwnd = 0;
5ac45f98
GV
3471 }
3472 else
3473 {
3474 /* Hold onto message for now. */
84fb1139 3475 mouse_button_timer =
fbd6baed 3476 SetTimer (hwnd, MOUSE_BUTTON_ID, XINT (Vw32_mouse_button_tolerance), NULL);
84fb1139
KH
3477 saved_mouse_button_msg.msg.hwnd = hwnd;
3478 saved_mouse_button_msg.msg.message = msg;
3479 saved_mouse_button_msg.msg.wParam = wParam;
3480 saved_mouse_button_msg.msg.lParam = lParam;
3481 saved_mouse_button_msg.msg.time = GetMessageTime ();
fbd6baed 3482 saved_mouse_button_msg.dwModifiers = w32_get_modifiers ();
5ac45f98
GV
3483 }
3484 }
3485 return 0;
3486
ee78dc32 3487 case WM_LBUTTONUP:
5ac45f98 3488 case WM_RBUTTONUP:
fbd6baed 3489 if (XINT (Vw32_num_mouse_buttons) == 3)
5ac45f98
GV
3490 goto handle_plain_button;
3491
3492 {
3493 int this = (msg == WM_LBUTTONUP) ? LMOUSE : RMOUSE;
3494 int other = (msg == WM_LBUTTONUP) ? RMOUSE : LMOUSE;
3495
3cb20f4a
RS
3496 if ((button_state & this) == 0)
3497 return 0;
5ac45f98
GV
3498
3499 button_state &= ~this;
3500
3501 if (button_state & MMOUSE)
3502 {
3503 /* Only generate event when second button is released. */
3504 if ((button_state & other) == 0)
3505 {
3506 msg = WM_MBUTTONUP;
3507 button_state &= ~MMOUSE;
3508
3509 if (button_state) abort ();
3510 }
3511 else
3512 return 0;
3513 }
3514 else
3515 {
3516 /* Flush out saved message if necessary. */
84fb1139 3517 if (saved_mouse_button_msg.msg.hwnd)
5ac45f98 3518 {
84fb1139 3519 post_msg (&saved_mouse_button_msg);
5ac45f98
GV
3520 }
3521 }
fbd6baed 3522 wmsg.dwModifiers = w32_get_modifiers ();
5ac45f98
GV
3523 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3524
3525 /* Always clear message buffer and cancel timer. */
84fb1139
KH
3526 saved_mouse_button_msg.msg.hwnd = 0;
3527 KillTimer (hwnd, mouse_button_timer);
3528 mouse_button_timer = 0;
5ac45f98
GV
3529
3530 if (button_state == 0)
3531 ReleaseCapture ();
3532 }
3533 return 0;
3534
ee78dc32
GV
3535 case WM_MBUTTONDOWN:
3536 case WM_MBUTTONUP:
5ac45f98 3537 handle_plain_button:
ee78dc32
GV
3538 {
3539 BOOL up;
1edf84e7 3540 int button;
ee78dc32 3541
1edf84e7 3542 if (parse_button (msg, &button, &up))
ee78dc32
GV
3543 {
3544 if (up) ReleaseCapture ();
3545 else SetCapture (hwnd);
1edf84e7
GV
3546 button = (button == 0) ? LMOUSE :
3547 ((button == 1) ? MMOUSE : RMOUSE);
3548 if (up)
3549 button_state &= ~button;
3550 else
3551 button_state |= button;
ee78dc32
GV
3552 }
3553 }
3554
fbd6baed 3555 wmsg.dwModifiers = w32_get_modifiers ();
ee78dc32 3556 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
5ac45f98
GV
3557 return 0;
3558
84fb1139 3559 case WM_VSCROLL:
5ac45f98 3560 case WM_MOUSEMOVE:
fbd6baed 3561 if (XINT (Vw32_mouse_move_interval) <= 0
84fb1139
KH
3562 || (msg == WM_MOUSEMOVE && button_state == 0))
3563 {
fbd6baed 3564 wmsg.dwModifiers = w32_get_modifiers ();
84fb1139
KH
3565 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3566 return 0;
3567 }
3568
3569 /* Hang onto mouse move and scroll messages for a bit, to avoid
3570 sending such events to Emacs faster than it can process them.
3571 If we get more events before the timer from the first message
3572 expires, we just replace the first message. */
3573
3574 if (saved_mouse_move_msg.msg.hwnd == 0)
3575 mouse_move_timer =
fbd6baed 3576 SetTimer (hwnd, MOUSE_MOVE_ID, XINT (Vw32_mouse_move_interval), NULL);
84fb1139
KH
3577
3578 /* Hold onto message for now. */
3579 saved_mouse_move_msg.msg.hwnd = hwnd;
3580 saved_mouse_move_msg.msg.message = msg;
3581 saved_mouse_move_msg.msg.wParam = wParam;
3582 saved_mouse_move_msg.msg.lParam = lParam;
3583 saved_mouse_move_msg.msg.time = GetMessageTime ();
fbd6baed 3584 saved_mouse_move_msg.dwModifiers = w32_get_modifiers ();
84fb1139
KH
3585
3586 return 0;
3587
1edf84e7
GV
3588 case WM_MOUSEWHEEL:
3589 wmsg.dwModifiers = w32_get_modifiers ();
3590 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3591 return 0;
3592
cb9e33d4
RS
3593 case WM_DROPFILES:
3594 wmsg.dwModifiers = w32_get_modifiers ();
3595 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3596 return 0;
3597
84fb1139
KH
3598 case WM_TIMER:
3599 /* Flush out saved messages if necessary. */
3600 if (wParam == mouse_button_timer)
5ac45f98 3601 {
84fb1139
KH
3602 if (saved_mouse_button_msg.msg.hwnd)
3603 {
3604 post_msg (&saved_mouse_button_msg);
3605 saved_mouse_button_msg.msg.hwnd = 0;
3606 }
3607 KillTimer (hwnd, mouse_button_timer);
3608 mouse_button_timer = 0;
3609 }
3610 else if (wParam == mouse_move_timer)
3611 {
3612 if (saved_mouse_move_msg.msg.hwnd)
3613 {
3614 post_msg (&saved_mouse_move_msg);
3615 saved_mouse_move_msg.msg.hwnd = 0;
3616 }
3617 KillTimer (hwnd, mouse_move_timer);
3618 mouse_move_timer = 0;
5ac45f98 3619 }
5ac45f98 3620 return 0;
84fb1139
KH
3621
3622 case WM_NCACTIVATE:
3623 /* Windows doesn't send us focus messages when putting up and
e9e23e23 3624 taking down a system popup dialog as for Ctrl-Alt-Del on Windows 95.
84fb1139
KH
3625 The only indication we get that something happened is receiving
3626 this message afterwards. So this is a good time to reset our
3627 keyboard modifiers' state. */
3628 reset_modifiers ();
3629 goto dflt;
da36a4d6 3630
1edf84e7
GV
3631 case WM_INITMENU:
3632 /* We must ensure menu bar is fully constructed and up to date
3633 before allowing user interaction with it. To achieve this
3634 we send this message to the lisp thread and wait for a
3635 reply (whose value is not actually needed) to indicate that
3636 the menu bar is now ready for use, so we can now return.
3637
3638 To remain responsive in the meantime, we enter a nested message
3639 loop that can process all other messages.
3640
3641 However, we skip all this if the message results from calling
3642 TrackPopupMenu - in fact, we must NOT attempt to send the lisp
3643 thread a message because it is blocked on us at this point. We
3644 set menubar_active before calling TrackPopupMenu to indicate
3645 this (there is no possibility of confusion with real menubar
3646 being active). */
3647
3648 f = x_window_to_frame (dpyinfo, hwnd);
3649 if (f
3650 && (f->output_data.w32->menubar_active
3651 /* We can receive this message even in the absence of a
3652 menubar (ie. when the system menu is activated) - in this
3653 case we do NOT want to forward the message, otherwise it
3654 will cause the menubar to suddenly appear when the user
3655 had requested it to be turned off! */
3656 || f->output_data.w32->menubar_widget == NULL))
3657 return 0;
3658
3659 {
3660 deferred_msg msg_buf;
3661
3662 /* Detect if message has already been deferred; in this case
3663 we cannot return any sensible value to ignore this. */
3664 if (find_deferred_msg (hwnd, msg) != NULL)
3665 abort ();
3666
3667 return send_deferred_msg (&msg_buf, hwnd, msg, wParam, lParam);
3668 }
3669
3670 case WM_EXITMENULOOP:
3671 f = x_window_to_frame (dpyinfo, hwnd);
3672
3673 /* Indicate that menubar can be modified again. */
3674 if (f)
3675 f->output_data.w32->menubar_active = 0;
3676 goto dflt;
3677
87996783
GV
3678 case WM_MEASUREITEM:
3679 f = x_window_to_frame (dpyinfo, hwnd);
3680 if (f)
3681 {
3682 MEASUREITEMSTRUCT * pMis = (MEASUREITEMSTRUCT *) lParam;
3683
3684 if (pMis->CtlType == ODT_MENU)
3685 {
3686 /* Work out dimensions for popup menu titles. */
3687 char * title = (char *) pMis->itemData;
3688 HDC hdc = GetDC (hwnd);
3689 HFONT menu_font = GetCurrentObject (hdc, OBJ_FONT);
3690 LOGFONT menu_logfont;
3691 HFONT old_font;
3692 SIZE size;
3693
3694 GetObject (menu_font, sizeof (menu_logfont), &menu_logfont);
3695 menu_logfont.lfWeight = FW_BOLD;
3696 menu_font = CreateFontIndirect (&menu_logfont);
3697 old_font = SelectObject (hdc, menu_font);
3698
3699 GetTextExtentPoint32 (hdc, title, strlen (title), &size);
3700 pMis->itemWidth = size.cx;
3701 pMis->itemHeight = GetSystemMetrics (SM_CYMENUSIZE);
3702 if (pMis->itemHeight < size.cy)
3703 pMis->itemHeight = size.cy;
3704
3705 SelectObject (hdc, old_font);
3706 DeleteObject (menu_font);
3707 ReleaseDC (hwnd, hdc);
3708 return TRUE;
3709 }
3710 }
3711 return 0;
3712
3713 case WM_DRAWITEM:
3714 f = x_window_to_frame (dpyinfo, hwnd);
3715 if (f)
3716 {
3717 DRAWITEMSTRUCT * pDis = (DRAWITEMSTRUCT *) lParam;
3718
3719 if (pDis->CtlType == ODT_MENU)
3720 {
3721 /* Draw popup menu title. */
3722 char * title = (char *) pDis->itemData;
3723 HDC hdc = pDis->hDC;
3724 HFONT menu_font = GetCurrentObject (hdc, OBJ_FONT);
3725 LOGFONT menu_logfont;
3726 HFONT old_font;
3727
3728 GetObject (menu_font, sizeof (menu_logfont), &menu_logfont);
3729 menu_logfont.lfWeight = FW_BOLD;
3730 menu_font = CreateFontIndirect (&menu_logfont);
3731 old_font = SelectObject (hdc, menu_font);
3732
3733 /* Always draw title as if not selected. */
3734 ExtTextOut (hdc,
3735 pDis->rcItem.left + GetSystemMetrics (SM_CXMENUCHECK),
3736 pDis->rcItem.top,
3737 ETO_OPAQUE, &pDis->rcItem,
3738 title, strlen (title), NULL);
3739
3740 SelectObject (hdc, old_font);
3741 DeleteObject (menu_font);
3742 return TRUE;
3743 }
3744 }
3745 return 0;
3746
1edf84e7
GV
3747#if 0
3748 /* Still not right - can't distinguish between clicks in the
3749 client area of the frame from clicks forwarded from the scroll
3750 bars - may have to hook WM_NCHITTEST to remember the mouse
3751 position and then check if it is in the client area ourselves. */
3752 case WM_MOUSEACTIVATE:
3753 /* Discard the mouse click that activates a frame, allowing the
3754 user to click anywhere without changing point (or worse!).
3755 Don't eat mouse clicks on scrollbars though!! */
3756 if (LOWORD (lParam) == HTCLIENT )
3757 return MA_ACTIVATEANDEAT;
3758 goto dflt;
3759#endif
3760
3761 case WM_ACTIVATE:
3762 case WM_ACTIVATEAPP:
3763 case WM_WINDOWPOSCHANGED:
3764 case WM_SHOWWINDOW:
3765 /* Inform lisp thread that a frame might have just been obscured
3766 or exposed, so should recheck visibility of all frames. */
3767 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3768 goto dflt;
3769
da36a4d6
GV
3770 case WM_SETFOCUS:
3771 reset_modifiers ();
8681157a 3772 case WM_KILLFOCUS:
ee78dc32
GV
3773 case WM_MOVE:
3774 case WM_SIZE:
ee78dc32 3775 case WM_COMMAND:
fbd6baed 3776 wmsg.dwModifiers = w32_get_modifiers ();
ee78dc32
GV
3777 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3778 goto dflt;
8847d890
RS
3779
3780 case WM_CLOSE:
fbd6baed 3781 wmsg.dwModifiers = w32_get_modifiers ();
8847d890
RS
3782 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3783 return 0;
3784
ee78dc32
GV
3785 case WM_WINDOWPOSCHANGING:
3786 {
3787 WINDOWPLACEMENT wp;
3788 LPWINDOWPOS lppos = (WINDOWPOS *) lParam;
1edf84e7
GV
3789
3790 wp.length = sizeof (WINDOWPLACEMENT);
ee78dc32
GV
3791 GetWindowPlacement (hwnd, &wp);
3792
1edf84e7 3793 if (wp.showCmd != SW_SHOWMINIMIZED && (lppos->flags & SWP_NOSIZE) == 0)
ee78dc32
GV
3794 {
3795 RECT rect;
3796 int wdiff;
3797 int hdiff;
1edf84e7
GV
3798 DWORD font_width;
3799 DWORD line_height;
3800 DWORD internal_border;
3801 DWORD scrollbar_extra;
ee78dc32
GV
3802 RECT wr;
3803
5ac45f98 3804 wp.length = sizeof(wp);
ee78dc32
GV
3805 GetWindowRect (hwnd, &wr);
3806
3c190163 3807 enter_crit ();
ee78dc32 3808
1edf84e7
GV
3809 font_width = GetWindowLong (hwnd, WND_FONTWIDTH_INDEX);
3810 line_height = GetWindowLong (hwnd, WND_LINEHEIGHT_INDEX);
3811 internal_border = GetWindowLong (hwnd, WND_BORDER_INDEX);
3812 scrollbar_extra = GetWindowLong (hwnd, WND_SCROLLBAR_INDEX);
ee78dc32 3813
3c190163 3814 leave_crit ();
ee78dc32
GV
3815
3816 memset (&rect, 0, sizeof (rect));
3817 AdjustWindowRect (&rect, GetWindowLong (hwnd, GWL_STYLE),
3818 GetMenu (hwnd) != NULL);
3819
1edf84e7
GV
3820 /* Force width and height of client area to be exact
3821 multiples of the character cell dimensions. */
3822 wdiff = (lppos->cx - (rect.right - rect.left)
3823 - 2 * internal_border - scrollbar_extra)
3824 % font_width;
3825 hdiff = (lppos->cy - (rect.bottom - rect.top)
3826 - 2 * internal_border)
3827 % line_height;
ee78dc32
GV
3828
3829 if (wdiff || hdiff)
3830 {
3831 /* For right/bottom sizing we can just fix the sizes.
3832 However for top/left sizing we will need to fix the X
3833 and Y positions as well. */
3834
3835 lppos->cx -= wdiff;
3836 lppos->cy -= hdiff;
3837
3838 if (wp.showCmd != SW_SHOWMAXIMIZED
1edf84e7 3839 && (lppos->flags & SWP_NOMOVE) == 0)
ee78dc32
GV
3840 {
3841 if (lppos->x != wr.left || lppos->y != wr.top)
3842 {
3843 lppos->x += wdiff;
3844 lppos->y += hdiff;
3845 }
3846 else
3847 {
3848 lppos->flags |= SWP_NOMOVE;
3849 }
3850 }
3851
1edf84e7 3852 return 0;
ee78dc32
GV
3853 }
3854 }
3855 }
ee78dc32
GV
3856
3857 goto dflt;
1edf84e7
GV
3858
3859 case WM_EMACS_CREATESCROLLBAR:
3860 return (LRESULT) w32_createscrollbar ((struct frame *) wParam,
3861 (struct scroll_bar *) lParam);
3862
5ac45f98 3863 case WM_EMACS_SHOWWINDOW:
1edf84e7
GV
3864 return ShowWindow ((HWND) wParam, (WPARAM) lParam);
3865
dfdb4047
GV
3866 case WM_EMACS_SETFOREGROUND:
3867 return SetForegroundWindow ((HWND) wParam);
3868
5ac45f98
GV
3869 case WM_EMACS_SETWINDOWPOS:
3870 {
1edf84e7
GV
3871 WINDOWPOS * pos = (WINDOWPOS *) wParam;
3872 return SetWindowPos (hwnd, pos->hwndInsertAfter,
5ac45f98
GV
3873 pos->x, pos->y, pos->cx, pos->cy, pos->flags);
3874 }
1edf84e7 3875
ee78dc32 3876 case WM_EMACS_DESTROYWINDOW:
cb9e33d4 3877 DragAcceptFiles ((HWND) wParam, FALSE);
1edf84e7
GV
3878 return DestroyWindow ((HWND) wParam);
3879
3880 case WM_EMACS_TRACKPOPUPMENU:
3881 {
3882 UINT flags;
3883 POINT *pos;
3884 int retval;
3885 pos = (POINT *)lParam;
3886 flags = TPM_CENTERALIGN;
3887 if (button_state & LMOUSE)
3888 flags |= TPM_LEFTBUTTON;
3889 else if (button_state & RMOUSE)
3890 flags |= TPM_RIGHTBUTTON;
3891
87996783
GV
3892 /* Remember we did a SetCapture on the initial mouse down event,
3893 so for safety, we make sure the capture is cancelled now. */
3894 ReleaseCapture ();
3895
1edf84e7
GV
3896 /* Use menubar_active to indicate that WM_INITMENU is from
3897 TrackPopupMenu below, and should be ignored. */
3898 f = x_window_to_frame (dpyinfo, hwnd);
3899 if (f)
3900 f->output_data.w32->menubar_active = 1;
3901
3902 if (TrackPopupMenu ((HMENU)wParam, flags, pos->x, pos->y,
3903 0, hwnd, NULL))
3904 {
3905 MSG amsg;
3906 /* Eat any mouse messages during popupmenu */
3907 while (PeekMessage (&amsg, hwnd, WM_MOUSEFIRST, WM_MOUSELAST,
3908 PM_REMOVE));
3909 /* Get the menu selection, if any */
3910 if (PeekMessage (&amsg, hwnd, WM_COMMAND, WM_COMMAND, PM_REMOVE))
3911 {
3912 retval = LOWORD (amsg.wParam);
3913 }
3914 else
3915 {
3916 retval = 0;
3917 }
3918 button_state = 0;
1edf84e7
GV
3919 }
3920 else
3921 {
3922 retval = -1;
3923 }
3924
3925 return retval;
3926 }
3927
ee78dc32 3928 default:
93fbe8b7
GV
3929 /* Check for messages registered at runtime. */
3930 if (msg == msh_mousewheel)
3931 {
3932 wmsg.dwModifiers = w32_get_modifiers ();
3933 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3934 return 0;
3935 }
3936
ee78dc32
GV
3937 dflt:
3938 return DefWindowProc (hwnd, msg, wParam, lParam);
3939 }
3940
1edf84e7
GV
3941
3942 /* The most common default return code for handled messages is 0. */
3943 return 0;
ee78dc32
GV
3944}
3945
3946void
3947my_create_window (f)
3948 struct frame * f;
3949{
3950 MSG msg;
3951
1edf84e7
GV
3952 if (!PostThreadMessage (dwWindowsThreadId, WM_EMACS_CREATEWINDOW, (WPARAM)f, 0))
3953 abort ();
ee78dc32
GV
3954 GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
3955}
3956
fbd6baed 3957/* Create and set up the w32 window for frame F. */
ee78dc32
GV
3958
3959static void
fbd6baed 3960w32_window (f, window_prompting, minibuffer_only)
ee78dc32
GV
3961 struct frame *f;
3962 long window_prompting;
3963 int minibuffer_only;
3964{
3965 BLOCK_INPUT;
3966
3967 /* Use the resource name as the top-level window name
3968 for looking up resources. Make a non-Lisp copy
3969 for the window manager, so GC relocation won't bother it.
3970
3971 Elsewhere we specify the window name for the window manager. */
3972
3973 {
3974 char *str = (char *) XSTRING (Vx_resource_name)->data;
3975 f->namebuf = (char *) xmalloc (strlen (str) + 1);
3976 strcpy (f->namebuf, str);
3977 }
3978
3979 my_create_window (f);
3980
3981 validate_x_resource_name ();
3982
3983 /* x_set_name normally ignores requests to set the name if the
3984 requested name is the same as the current name. This is the one
3985 place where that assumption isn't correct; f->name is set, but
3986 the server hasn't been told. */
3987 {
3988 Lisp_Object name;
3989 int explicit = f->explicit_name;
3990
3991 f->explicit_name = 0;
3992 name = f->name;
3993 f->name = Qnil;
3994 x_set_name (f, name, explicit);
3995 }
3996
3997 UNBLOCK_INPUT;
3998
3999 if (!minibuffer_only && FRAME_EXTERNAL_MENU_BAR (f))
4000 initialize_frame_menubar (f);
4001
fbd6baed 4002 if (FRAME_W32_WINDOW (f) == 0)
ee78dc32
GV
4003 error ("Unable to create window");
4004}
4005
4006/* Handle the icon stuff for this window. Perhaps later we might
4007 want an x_set_icon_position which can be called interactively as
4008 well. */
4009
4010static void
4011x_icon (f, parms)
4012 struct frame *f;
4013 Lisp_Object parms;
4014{
4015 Lisp_Object icon_x, icon_y;
4016
e9e23e23 4017 /* Set the position of the icon. Note that Windows 95 groups all
ee78dc32
GV
4018 icons in the tray. */
4019 icon_x = x_get_arg (parms, Qicon_left, 0, 0, number);
4020 icon_y = x_get_arg (parms, Qicon_top, 0, 0, number);
4021 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
4022 {
4023 CHECK_NUMBER (icon_x, 0);
4024 CHECK_NUMBER (icon_y, 0);
4025 }
4026 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
4027 error ("Both left and top icon corners of icon must be specified");
4028
4029 BLOCK_INPUT;
4030
4031 if (! EQ (icon_x, Qunbound))
4032 x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y));
4033
1edf84e7
GV
4034#if 0 /* TODO */
4035 /* Start up iconic or window? */
4036 x_wm_set_window_state
4037 (f, (EQ (x_get_arg (parms, Qvisibility, 0, 0, symbol), Qicon)
4038 ? IconicState
4039 : NormalState));
4040
4041 x_text_icon (f, (char *) XSTRING ((!NILP (f->icon_name)
4042 ? f->icon_name
4043 : f->name))->data);
4044#endif
4045
ee78dc32
GV
4046 UNBLOCK_INPUT;
4047}
4048
4049DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
4050 1, 1, 0,
4051 "Make a new window, which is called a \"frame\" in Emacs terms.\n\
4052Returns an Emacs frame object.\n\
4053ALIST is an alist of frame parameters.\n\
4054If the parameters specify that the frame should not have a minibuffer,\n\
4055and do not specify a specific minibuffer window to use,\n\
4056then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
4057be shared by the new frame.\n\
4058\n\
4059This function is an internal primitive--use `make-frame' instead.")
4060 (parms)
4061 Lisp_Object parms;
4062{
4063 struct frame *f;
4064 Lisp_Object frame, tem;
4065 Lisp_Object name;
4066 int minibuffer_only = 0;
4067 long window_prompting = 0;
4068 int width, height;
4069 int count = specpdl_ptr - specpdl;
1edf84e7 4070 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
ee78dc32 4071 Lisp_Object display;
fbd6baed 4072 struct w32_display_info *dpyinfo;
ee78dc32
GV
4073 Lisp_Object parent;
4074 struct kboard *kb;
4075
4076 /* Use this general default value to start with
4077 until we know if this frame has a specified name. */
4078 Vx_resource_name = Vinvocation_name;
4079
4080 display = x_get_arg (parms, Qdisplay, 0, 0, string);
4081 if (EQ (display, Qunbound))
4082 display = Qnil;
4083 dpyinfo = check_x_display_info (display);
4084#ifdef MULTI_KBOARD
4085 kb = dpyinfo->kboard;
4086#else
4087 kb = &the_only_kboard;
4088#endif
4089
1edf84e7 4090 name = x_get_arg (parms, Qname, "name", "Name", string);
ee78dc32
GV
4091 if (!STRINGP (name)
4092 && ! EQ (name, Qunbound)
4093 && ! NILP (name))
4094 error ("Invalid frame name--not a string or nil");
4095
4096 if (STRINGP (name))
4097 Vx_resource_name = name;
4098
4099 /* See if parent window is specified. */
4100 parent = x_get_arg (parms, Qparent_id, NULL, NULL, number);
4101 if (EQ (parent, Qunbound))
4102 parent = Qnil;
4103 if (! NILP (parent))
4104 CHECK_NUMBER (parent, 0);
4105
1edf84e7
GV
4106 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
4107 /* No need to protect DISPLAY because that's not used after passing
4108 it to make_frame_without_minibuffer. */
4109 frame = Qnil;
4110 GCPRO4 (parms, parent, name, frame);
ee78dc32
GV
4111 tem = x_get_arg (parms, Qminibuffer, 0, 0, symbol);
4112 if (EQ (tem, Qnone) || NILP (tem))
4113 f = make_frame_without_minibuffer (Qnil, kb, display);
4114 else if (EQ (tem, Qonly))
4115 {
4116 f = make_minibuffer_frame ();
4117 minibuffer_only = 1;
4118 }
4119 else if (WINDOWP (tem))
4120 f = make_frame_without_minibuffer (tem, kb, display);
4121 else
4122 f = make_frame (1);
4123
1edf84e7
GV
4124 XSETFRAME (frame, f);
4125
ee78dc32
GV
4126 /* Note that Windows does support scroll bars. */
4127 FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
5ac45f98
GV
4128 /* By default, make scrollbars the system standard width. */
4129 f->scroll_bar_pixel_width = GetSystemMetrics (SM_CXVSCROLL);
ee78dc32 4130
fbd6baed
GV
4131 f->output_method = output_w32;
4132 f->output_data.w32 = (struct w32_output *) xmalloc (sizeof (struct w32_output));
4133 bzero (f->output_data.w32, sizeof (struct w32_output));
ee78dc32 4134
1edf84e7
GV
4135 f->icon_name
4136 = x_get_arg (parms, Qicon_name, "iconName", "Title", string);
4137 if (! STRINGP (f->icon_name))
4138 f->icon_name = Qnil;
4139
fbd6baed 4140/* FRAME_W32_DISPLAY_INFO (f) = dpyinfo; */
ee78dc32
GV
4141#ifdef MULTI_KBOARD
4142 FRAME_KBOARD (f) = kb;
4143#endif
4144
4145 /* Specify the parent under which to make this window. */
4146
4147 if (!NILP (parent))
4148 {
fbd6baed
GV
4149 f->output_data.w32->parent_desc = (Window) parent;
4150 f->output_data.w32->explicit_parent = 1;
ee78dc32
GV
4151 }
4152 else
4153 {
fbd6baed
GV
4154 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
4155 f->output_data.w32->explicit_parent = 0;
ee78dc32
GV
4156 }
4157
4158 /* Note that the frame has no physical cursor right now. */
4159 f->phys_cursor_x = -1;
4160
4161 /* Set the name; the functions to which we pass f expect the name to
4162 be set. */
4163 if (EQ (name, Qunbound) || NILP (name))
4164 {
fbd6baed 4165 f->name = build_string (dpyinfo->w32_id_name);
ee78dc32
GV
4166 f->explicit_name = 0;
4167 }
4168 else
4169 {
4170 f->name = name;
4171 f->explicit_name = 1;
4172 /* use the frame's title when getting resources for this frame. */
4173 specbind (Qx_resource_name, name);
4174 }
4175
4176 /* Extract the window parameters from the supplied values
4177 that are needed to determine window geometry. */
4178 {
4179 Lisp_Object font;
4180
4181 font = x_get_arg (parms, Qfont, "font", "Font", string);
4182 BLOCK_INPUT;
4183 /* First, try whatever font the caller has specified. */
4184 if (STRINGP (font))
4185 font = x_new_font (f, XSTRING (font)->data);
ee78dc32
GV
4186 /* Try out a font which we hope has bold and italic variations. */
4187 if (!STRINGP (font))
1edf84e7 4188 font = x_new_font (f, "-*-Courier New-normal-r-*-*-13-97-*-*-c-*-*-ansi-");
ee78dc32 4189 if (! STRINGP (font))
1edf84e7 4190 font = x_new_font (f, "-*-Courier-normal-r-*-*-13-97-*-*-c-*-*-ansi-");
ee78dc32
GV
4191 /* If those didn't work, look for something which will at least work. */
4192 if (! STRINGP (font))
1edf84e7 4193 font = x_new_font (f, "-*-Fixedsys-normal-r-*-*-13-97-*-*-c-*-*-ansi-");
ee78dc32
GV
4194 UNBLOCK_INPUT;
4195 if (! STRINGP (font))
1edf84e7 4196 font = build_string ("Fixedsys");
ee78dc32
GV
4197
4198 x_default_parameter (f, parms, Qfont, font,
4199 "font", "Font", string);
4200 }
4201
4202 x_default_parameter (f, parms, Qborder_width, make_number (2),
4203 "borderwidth", "BorderWidth", number);
4204 /* This defaults to 2 in order to match xterm. We recognize either
4205 internalBorderWidth or internalBorder (which is what xterm calls
4206 it). */
4207 if (NILP (Fassq (Qinternal_border_width, parms)))
4208 {
4209 Lisp_Object value;
4210
4211 value = x_get_arg (parms, Qinternal_border_width,
4212 "internalBorder", "BorderWidth", number);
4213 if (! EQ (value, Qunbound))
4214 parms = Fcons (Fcons (Qinternal_border_width, value),
4215 parms);
4216 }
1edf84e7 4217 /* Default internalBorderWidth to 0 on Windows to match other programs. */
ee78dc32
GV
4218 x_default_parameter (f, parms, Qinternal_border_width, make_number (0),
4219 "internalBorderWidth", "BorderWidth", number);
4220 x_default_parameter (f, parms, Qvertical_scroll_bars, Qt,
4221 "verticalScrollBars", "ScrollBars", boolean);
4222
4223 /* Also do the stuff which must be set before the window exists. */
4224 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
4225 "foreground", "Foreground", string);
4226 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
4227 "background", "Background", string);
4228 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
4229 "pointerColor", "Foreground", string);
4230 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
4231 "cursorColor", "Foreground", string);
4232 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
4233 "borderColor", "BorderColor", string);
4234
4235 x_default_parameter (f, parms, Qmenu_bar_lines, make_number (1),
4236 "menuBar", "MenuBar", number);
4237 x_default_parameter (f, parms, Qscroll_bar_width, Qnil,
4238 "scrollBarWidth", "ScrollBarWidth", number);
1edf84e7
GV
4239 x_default_parameter (f, parms, Qbuffer_predicate, Qnil,
4240 "bufferPredicate", "BufferPredicate", symbol);
4241 x_default_parameter (f, parms, Qtitle, Qnil,
4242 "title", "Title", string);
ee78dc32 4243
fbd6baed
GV
4244 f->output_data.w32->dwStyle = WS_OVERLAPPEDWINDOW;
4245 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
ee78dc32
GV
4246 window_prompting = x_figure_window_size (f, parms);
4247
4248 if (window_prompting & XNegative)
4249 {
4250 if (window_prompting & YNegative)
fbd6baed 4251 f->output_data.w32->win_gravity = SouthEastGravity;
ee78dc32 4252 else
fbd6baed 4253 f->output_data.w32->win_gravity = NorthEastGravity;
ee78dc32
GV
4254 }
4255 else
4256 {
4257 if (window_prompting & YNegative)
fbd6baed 4258 f->output_data.w32->win_gravity = SouthWestGravity;
ee78dc32 4259 else
fbd6baed 4260 f->output_data.w32->win_gravity = NorthWestGravity;
ee78dc32
GV
4261 }
4262
fbd6baed 4263 f->output_data.w32->size_hint_flags = window_prompting;
ee78dc32 4264
fbd6baed 4265 w32_window (f, window_prompting, minibuffer_only);
ee78dc32
GV
4266 x_icon (f, parms);
4267 init_frame_faces (f);
4268
4269 /* We need to do this after creating the window, so that the
4270 icon-creation functions can say whose icon they're describing. */
4271 x_default_parameter (f, parms, Qicon_type, Qnil,
4272 "bitmapIcon", "BitmapIcon", symbol);
4273
4274 x_default_parameter (f, parms, Qauto_raise, Qnil,
4275 "autoRaise", "AutoRaiseLower", boolean);
4276 x_default_parameter (f, parms, Qauto_lower, Qnil,
4277 "autoLower", "AutoRaiseLower", boolean);
4278 x_default_parameter (f, parms, Qcursor_type, Qbox,
4279 "cursorType", "CursorType", symbol);
4280
4281 /* Dimensions, especially f->height, must be done via change_frame_size.
4282 Change will not be effected unless different from the current
4283 f->height. */
4284 width = f->width;
4285 height = f->height;
1026b400
RS
4286 f->height = 0;
4287 SET_FRAME_WIDTH (f, 0);
ee78dc32
GV
4288 change_frame_size (f, height, width, 1, 0);
4289
4290 /* Tell the server what size and position, etc, we want,
4291 and how badly we want them. */
4292 BLOCK_INPUT;
4293 x_wm_set_size_hint (f, window_prompting, 0);
4294 UNBLOCK_INPUT;
4295
4296 tem = x_get_arg (parms, Qunsplittable, 0, 0, boolean);
4297 f->no_split = minibuffer_only || EQ (tem, Qt);
4298
4299 UNGCPRO;
4300
4301 /* It is now ok to make the frame official
4302 even if we get an error below.
4303 And the frame needs to be on Vframe_list
4304 or making it visible won't work. */
4305 Vframe_list = Fcons (frame, Vframe_list);
4306
4307 /* Now that the frame is official, it counts as a reference to
4308 its display. */
fbd6baed 4309 FRAME_W32_DISPLAY_INFO (f)->reference_count++;
ee78dc32
GV
4310
4311 /* Make the window appear on the frame and enable display,
4312 unless the caller says not to. However, with explicit parent,
4313 Emacs cannot control visibility, so don't try. */
fbd6baed 4314 if (! f->output_data.w32->explicit_parent)
ee78dc32
GV
4315 {
4316 Lisp_Object visibility;
4317
4318 visibility = x_get_arg (parms, Qvisibility, 0, 0, symbol);
4319 if (EQ (visibility, Qunbound))
4320 visibility = Qt;
4321
4322 if (EQ (visibility, Qicon))
4323 x_iconify_frame (f);
4324 else if (! NILP (visibility))
4325 x_make_frame_visible (f);
4326 else
4327 /* Must have been Qnil. */
4328 ;
4329 }
4330
4331 return unbind_to (count, frame);
4332}
4333
4334/* FRAME is used only to get a handle on the X display. We don't pass the
4335 display info directly because we're called from frame.c, which doesn't
4336 know about that structure. */
4337Lisp_Object
4338x_get_focus_frame (frame)
4339 struct frame *frame;
4340{
fbd6baed 4341 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (frame);
ee78dc32 4342 Lisp_Object xfocus;
fbd6baed 4343 if (! dpyinfo->w32_focus_frame)
ee78dc32
GV
4344 return Qnil;
4345
fbd6baed 4346 XSETFRAME (xfocus, dpyinfo->w32_focus_frame);
ee78dc32
GV
4347 return xfocus;
4348}
1edf84e7
GV
4349
4350DEFUN ("w32-focus-frame", Fw32_focus_frame, Sw32_focus_frame, 1, 1, 0,
4351 "Give FRAME input focus, raising to foreground if necessary.")
4352 (frame)
4353 Lisp_Object frame;
4354{
4355 x_focus_on_frame (check_x_frame (frame));
4356 return Qnil;
4357}
4358
ee78dc32 4359\f
5ac45f98 4360XFontStruct *
fbd6baed
GV
4361w32_load_font (dpyinfo,name)
4362struct w32_display_info *dpyinfo;
3c190163 4363char * name;
ee78dc32
GV
4364{
4365 XFontStruct * font = NULL;
4366 BOOL ok;
5ac45f98 4367
3c190163
GV
4368 {
4369 LOGFONT lf;
5ac45f98 4370
fbd6baed 4371 if (!name || !x_to_w32_font (name, &lf))
3c190163 4372 return (NULL);
5ac45f98 4373
3c190163 4374 font = (XFontStruct *) xmalloc (sizeof (XFontStruct));
5ac45f98 4375
3c190163 4376 if (!font) return (NULL);
5ac45f98 4377
3c190163 4378 BLOCK_INPUT;
5ac45f98
GV
4379
4380 font->hfont = CreateFontIndirect (&lf);
ee78dc32 4381 }
ee78dc32 4382
5ac45f98
GV
4383 if (font->hfont == NULL)
4384 {
4385 ok = FALSE;
4386 }
4387 else
4388 {
4389 HDC hdc;
4390 HANDLE oldobj;
4391
4392 hdc = GetDC (dpyinfo->root_window);
4393 oldobj = SelectObject (hdc, font->hfont);
4394 ok = GetTextMetrics (hdc, &font->tm);
4395 SelectObject (hdc, oldobj);
4396 ReleaseDC (dpyinfo->root_window, hdc);
4397 }
4398
ee78dc32 4399 UNBLOCK_INPUT;
5ac45f98 4400
ee78dc32 4401 if (ok) return (font);
5ac45f98 4402
fbd6baed 4403 w32_unload_font (dpyinfo, font);
ee78dc32
GV
4404 return (NULL);
4405}
4406
4407void
fbd6baed
GV
4408w32_unload_font (dpyinfo, font)
4409 struct w32_display_info *dpyinfo;
ee78dc32
GV
4410 XFontStruct * font;
4411{
4412 if (font)
4413 {
3c190163 4414 if (font->hfont) DeleteObject(font->hfont);
ee78dc32
GV
4415 xfree (font);
4416 }
4417}
4418
fbd6baed 4419/* The font conversion stuff between x and w32 */
ee78dc32
GV
4420
4421/* X font string is as follows (from faces.el)
4422 * (let ((- "[-?]")
4423 * (foundry "[^-]+")
4424 * (family "[^-]+")
4425 * (weight "\\(bold\\|demibold\\|medium\\)") ; 1
4426 * (weight\? "\\([^-]*\\)") ; 1
4427 * (slant "\\([ior]\\)") ; 2
4428 * (slant\? "\\([^-]?\\)") ; 2
4429 * (swidth "\\([^-]*\\)") ; 3
4430 * (adstyle "[^-]*") ; 4
4431 * (pixelsize "[0-9]+")
4432 * (pointsize "[0-9][0-9]+")
4433 * (resx "[0-9][0-9]+")
4434 * (resy "[0-9][0-9]+")
4435 * (spacing "[cmp?*]")
4436 * (avgwidth "[0-9]+")
4437 * (registry "[^-]+")
4438 * (encoding "[^-]+")
4439 * )
4440 * (setq x-font-regexp
4441 * (concat "\\`\\*?[-?*]"
4442 * foundry - family - weight\? - slant\? - swidth - adstyle -
4443 * pixelsize - pointsize - resx - resy - spacing - registry -
4444 * encoding "[-?*]\\*?\\'"
4445 * ))
4446 * (setq x-font-regexp-head
4447 * (concat "\\`[-?*]" foundry - family - weight\? - slant\?
4448 * "\\([-*?]\\|\\'\\)"))
4449 * (setq x-font-regexp-slant (concat - slant -))
4450 * (setq x-font-regexp-weight (concat - weight -))
4451 * nil)
4452 */
4453
4454#define FONT_START "[-?]"
4455#define FONT_FOUNDRY "[^-]+"
4456#define FONT_FAMILY "\\([^-]+\\)" /* 1 */
4457#define FONT_WEIGHT "\\(bold\\|demibold\\|medium\\)" /* 2 */
4458#define FONT_WEIGHT_Q "\\([^-]*\\)" /* 2 */
4459#define FONT_SLANT "\\([ior]\\)" /* 3 */
4460#define FONT_SLANT_Q "\\([^-]?\\)" /* 3 */
4461#define FONT_SWIDTH "\\([^-]*\\)" /* 4 */
4462#define FONT_ADSTYLE "[^-]*"
4463#define FONT_PIXELSIZE "[^-]*"
4464#define FONT_POINTSIZE "\\([0-9][0-9]+\\|\\*\\)" /* 5 */
4465#define FONT_RESX "[0-9][0-9]+"
4466#define FONT_RESY "[0-9][0-9]+"
4467#define FONT_SPACING "[cmp?*]"
4468#define FONT_AVGWIDTH "[0-9]+"
4469#define FONT_REGISTRY "[^-]+"
4470#define FONT_ENCODING "[^-]+"
4471
4472#define FONT_REGEXP ("\\`\\*?[-?*]" \
4473 FONT_FOUNDRY "-" \
4474 FONT_FAMILY "-" \
4475 FONT_WEIGHT_Q "-" \
4476 FONT_SLANT_Q "-" \
4477 FONT_SWIDTH "-" \
4478 FONT_ADSTYLE "-" \
4479 FONT_PIXELSIZE "-" \
4480 FONT_POINTSIZE "-" \
4481 "[-?*]\\|\\'")
4482
4483#define FONT_REGEXP_HEAD ("\\`[-?*]" \
4484 FONT_FOUNDRY "-" \
4485 FONT_FAMILY "-" \
4486 FONT_WEIGHT_Q "-" \
4487 FONT_SLANT_Q \
4488 "\\([-*?]\\|\\'\\)")
4489
4490#define FONT_REGEXP_SLANT "-" FONT_SLANT "-"
4491#define FONT_REGEXP_WEIGHT "-" FONT_WEIGHT "-"
4492
4493LONG
fbd6baed 4494x_to_w32_weight (lpw)
ee78dc32
GV
4495 char * lpw;
4496{
4497 if (!lpw) return (FW_DONTCARE);
5ac45f98
GV
4498
4499 if (stricmp (lpw,"heavy") == 0) return FW_HEAVY;
4500 else if (stricmp (lpw,"extrabold") == 0) return FW_EXTRABOLD;
4501 else if (stricmp (lpw,"bold") == 0) return FW_BOLD;
4502 else if (stricmp (lpw,"demibold") == 0) return FW_SEMIBOLD;
1edf84e7 4503 else if (stricmp (lpw,"semibold") == 0) return FW_SEMIBOLD;
5ac45f98
GV
4504 else if (stricmp (lpw,"medium") == 0) return FW_MEDIUM;
4505 else if (stricmp (lpw,"normal") == 0) return FW_NORMAL;
4506 else if (stricmp (lpw,"light") == 0) return FW_LIGHT;
4507 else if (stricmp (lpw,"extralight") == 0) return FW_EXTRALIGHT;
4508 else if (stricmp (lpw,"thin") == 0) return FW_THIN;
ee78dc32 4509 else
5ac45f98 4510 return FW_DONTCARE;
ee78dc32
GV
4511}
4512
5ac45f98 4513
ee78dc32 4514char *
fbd6baed 4515w32_to_x_weight (fnweight)
ee78dc32
GV
4516 int fnweight;
4517{
5ac45f98
GV
4518 if (fnweight >= FW_HEAVY) return "heavy";
4519 if (fnweight >= FW_EXTRABOLD) return "extrabold";
4520 if (fnweight >= FW_BOLD) return "bold";
4521 if (fnweight >= FW_SEMIBOLD) return "semibold";
4522 if (fnweight >= FW_MEDIUM) return "medium";
4523 if (fnweight >= FW_NORMAL) return "normal";
4524 if (fnweight >= FW_LIGHT) return "light";
4525 if (fnweight >= FW_EXTRALIGHT) return "extralight";
4526 if (fnweight >= FW_THIN) return "thin";
4527 else
4528 return "*";
4529}
4530
4531LONG
fbd6baed 4532x_to_w32_charset (lpcs)
5ac45f98
GV
4533 char * lpcs;
4534{
4535 if (!lpcs) return (0);
4536
4537 if (stricmp (lpcs,"ansi") == 0) return ANSI_CHARSET;
4538 else if (stricmp (lpcs,"iso8859-1") == 0) return ANSI_CHARSET;
4539 else if (stricmp (lpcs,"iso8859") == 0) return ANSI_CHARSET;
4540 else if (stricmp (lpcs,"oem") == 0) return OEM_CHARSET;
4541#ifdef UNICODE_CHARSET
4542 else if (stricmp (lpcs,"unicode") == 0) return UNICODE_CHARSET;
4543 else if (stricmp (lpcs,"iso10646") == 0) return UNICODE_CHARSET;
4544#endif
1edf84e7 4545 else if (lpcs[0] == '#') return atoi (lpcs + 1);
5ac45f98 4546 else
1edf84e7 4547 return DEFAULT_CHARSET;
5ac45f98
GV
4548}
4549
4550char *
fbd6baed 4551w32_to_x_charset (fncharset)
5ac45f98
GV
4552 int fncharset;
4553{
1edf84e7
GV
4554 static char buf[16];
4555
5ac45f98
GV
4556 switch (fncharset)
4557 {
4558 case ANSI_CHARSET: return "ansi";
4559 case OEM_CHARSET: return "oem";
4560 case SYMBOL_CHARSET: return "symbol";
4561#ifdef UNICODE_CHARSET
4562 case UNICODE_CHARSET: return "unicode";
4563#endif
4564 }
1edf84e7
GV
4565 /* Encode numerical value of unknown charset. */
4566 sprintf (buf, "#%u", fncharset);
4567 return buf;
ee78dc32
GV
4568}
4569
4570BOOL
fbd6baed 4571w32_to_x_font (lplogfont, lpxstr, len)
ee78dc32
GV
4572 LOGFONT * lplogfont;
4573 char * lpxstr;
4574 int len;
4575{
3cb20f4a
RS
4576 char height_pixels[8];
4577 char height_dpi[8];
4578 char width_pixels[8];
4579
4580 if (!lpxstr) abort ();
ee78dc32 4581
3cb20f4a
RS
4582 if (!lplogfont)
4583 return FALSE;
4584
4585 if (lplogfont->lfHeight)
ee78dc32 4586 {
3cb20f4a
RS
4587 sprintf (height_pixels, "%u", abs (lplogfont->lfHeight));
4588 sprintf (height_dpi, "%u",
fbd6baed 4589 (abs (lplogfont->lfHeight) * 720) / one_w32_display_info.height_in);
5ac45f98
GV
4590 }
4591 else
ee78dc32 4592 {
3cb20f4a
RS
4593 strcpy (height_pixels, "*");
4594 strcpy (height_dpi, "*");
ee78dc32 4595 }
3cb20f4a
RS
4596 if (lplogfont->lfWidth)
4597 sprintf (width_pixels, "%u", lplogfont->lfWidth * 10);
4598 else
4599 strcpy (width_pixels, "*");
4600
4601 _snprintf (lpxstr, len - 1,
4602 "-*-%s-%s-%c-*-*-%s-%s-*-*-%c-%s-*-%s-",
4603 lplogfont->lfFaceName,
fbd6baed 4604 w32_to_x_weight (lplogfont->lfWeight),
3cb20f4a
RS
4605 lplogfont->lfItalic?'i':'r',
4606 height_pixels,
4607 height_dpi,
4608 ((lplogfont->lfPitchAndFamily & 0x3) == VARIABLE_PITCH) ? 'p' : 'c',
4609 width_pixels,
fbd6baed 4610 w32_to_x_charset (lplogfont->lfCharSet)
3cb20f4a
RS
4611 );
4612
ee78dc32
GV
4613 lpxstr[len - 1] = 0; /* just to be sure */
4614 return (TRUE);
4615}
4616
4617BOOL
fbd6baed 4618x_to_w32_font (lpxstr, lplogfont)
ee78dc32
GV
4619 char * lpxstr;
4620 LOGFONT * lplogfont;
4621{
4622 if (!lplogfont) return (FALSE);
4623
4624 memset (lplogfont, 0, sizeof (*lplogfont));
5ac45f98 4625
771c47d5 4626#if 1
ee78dc32
GV
4627 lplogfont->lfOutPrecision = OUT_DEFAULT_PRECIS;
4628 lplogfont->lfClipPrecision = CLIP_DEFAULT_PRECIS;
4629 lplogfont->lfQuality = DEFAULT_QUALITY;
5ac45f98
GV
4630#else
4631 /* go for maximum quality */
4632 lplogfont->lfOutPrecision = OUT_STROKE_PRECIS;
4633 lplogfont->lfClipPrecision = CLIP_STROKE_PRECIS;
4634 lplogfont->lfQuality = PROOF_QUALITY;
4635#endif
4636
4637 if (!lpxstr)
4638 return FALSE;
4639
4640 /* Provide a simple escape mechanism for specifying Windows font names
4641 * directly -- if font spec does not beginning with '-', assume this
4642 * format:
4643 * "<font name>[:height in pixels[:width in pixels[:weight]]]"
4644 */
ee78dc32 4645
5ac45f98
GV
4646 if (*lpxstr == '-')
4647 {
4648 int fields;
4649 char name[50], weight[20], slant, pitch, pixels[10], height[10], width[10], remainder[20];
4650 char * encoding;
4651
4652 fields = sscanf (lpxstr,
4653 "-%*[^-]-%49[^-]-%19[^-]-%c-%*[^-]-%*[^-]-%9[^-]-%9[^-]-%*[^-]-%*[^-]-%c-%9[^-]-%19s",
4654 name, weight, &slant, pixels, height, &pitch, width, remainder);
4655
4656 if (fields == EOF) return (FALSE);
4657
4658 if (fields > 0 && name[0] != '*')
4659 {
4660 strncpy (lplogfont->lfFaceName,name, LF_FACESIZE);
4661 lplogfont->lfFaceName[LF_FACESIZE-1] = 0;
4662 }
4663 else
4664 {
4665 lplogfont->lfFaceName[0] = 0;
4666 }
4667
4668 fields--;
4669
fbd6baed 4670 lplogfont->lfWeight = x_to_w32_weight ((fields > 0 ? weight : ""));
5ac45f98
GV
4671
4672 fields--;
4673
fbd6baed 4674 if (!NILP (Vw32_enable_italics))
5ac45f98
GV
4675 lplogfont->lfItalic = (fields > 0 && slant == 'i');
4676
4677 fields--;
4678
4679 if (fields > 0 && pixels[0] != '*')
4680 lplogfont->lfHeight = atoi (pixels);
4681
4682 fields--;
4683
4684 if (fields > 0 && lplogfont->lfHeight == 0 && height[0] != '*')
4685 lplogfont->lfHeight = (atoi (height)
fbd6baed 4686 * one_w32_display_info.height_in) / 720;
5ac45f98
GV
4687
4688 fields--;
4689
4690 lplogfont->lfPitchAndFamily =
4691 (fields > 0 && pitch == 'p') ? VARIABLE_PITCH : FIXED_PITCH;
4692
4693 fields--;
4694
4695 if (fields > 0 && width[0] != '*')
4696 lplogfont->lfWidth = atoi (width) / 10;
4697
4698 fields--;
4699
4700 /* Not all font specs include the registry field, so we allow for an
4701 optional registry field before the encoding when parsing
4702 remainder. Also we strip the trailing '-' if present. */
3c190163 4703 {
5ac45f98
GV
4704 int len = strlen (remainder);
4705 if (len > 0 && remainder[len-1] == '-')
4706 remainder[len-1] = 0;
ee78dc32 4707 }
5ac45f98
GV
4708 encoding = remainder;
4709 if (strncmp (encoding, "*-", 2) == 0)
4710 encoding += 2;
fbd6baed 4711 lplogfont->lfCharSet = x_to_w32_charset (fields > 0 ? encoding : "");
5ac45f98
GV
4712 }
4713 else
4714 {
4715 int fields;
4716 char name[100], height[10], width[10], weight[20];
a1a80b40 4717
5ac45f98
GV
4718 fields = sscanf (lpxstr,
4719 "%99[^:]:%9[^:]:%9[^:]:%19s",
4720 name, height, width, weight);
4721
4722 if (fields == EOF) return (FALSE);
4723
4724 if (fields > 0)
4725 {
4726 strncpy (lplogfont->lfFaceName,name, LF_FACESIZE);
4727 lplogfont->lfFaceName[LF_FACESIZE-1] = 0;
4728 }
4729 else
4730 {
4731 lplogfont->lfFaceName[0] = 0;
4732 }
4733
4734 fields--;
4735
4736 if (fields > 0)
4737 lplogfont->lfHeight = atoi (height);
4738
4739 fields--;
4740
4741 if (fields > 0)
4742 lplogfont->lfWidth = atoi (width);
4743
4744 fields--;
4745
fbd6baed 4746 lplogfont->lfWeight = x_to_w32_weight ((fields > 0 ? weight : ""));
5ac45f98
GV
4747 }
4748
4749 /* This makes TrueType fonts work better. */
4750 lplogfont->lfHeight = - abs (lplogfont->lfHeight);
ee78dc32
GV
4751
4752 return (TRUE);
4753}
4754
4755BOOL
fbd6baed 4756w32_font_match (lpszfont1, lpszfont2)
ee78dc32
GV
4757 char * lpszfont1;
4758 char * lpszfont2;
4759{
4760 char * s1 = lpszfont1, *e1;
4761 char * s2 = lpszfont2, *e2;
4762
4763 if (s1 == NULL || s2 == NULL) return (FALSE);
4764
4765 if (*s1 == '-') s1++;
4766 if (*s2 == '-') s2++;
4767
4768 while (1)
4769 {
4770 int len1, len2;
4771
4772 e1 = strchr (s1, '-');
4773 e2 = strchr (s2, '-');
4774
4775 if (e1 == NULL || e2 == NULL) return (TRUE);
4776
4777 len1 = e1 - s1;
4778 len2 = e2 - s2;
4779
4780 if (*s1 != '*' && *s2 != '*'
4781 && (len1 != len2 || strnicmp (s1, s2, len1) != 0))
4782 return (FALSE);
4783
4784 s1 = e1 + 1;
4785 s2 = e2 + 1;
4786 }
4787}
4788
4789typedef struct enumfont_t
4790{
4791 HDC hdc;
4792 int numFonts;
3cb20f4a 4793 LOGFONT logfont;
ee78dc32
GV
4794 XFontStruct *size_ref;
4795 Lisp_Object *pattern;
4796 Lisp_Object *head;
4797 Lisp_Object *tail;
4798} enumfont_t;
4799
4800int CALLBACK
4801enum_font_cb2 (lplf, lptm, FontType, lpef)
4802 ENUMLOGFONT * lplf;
4803 NEWTEXTMETRIC * lptm;
4804 int FontType;
4805 enumfont_t * lpef;
4806{
1edf84e7 4807 if (lplf->elfLogFont.lfStrikeOut || lplf->elfLogFont.lfUnderline)
ee78dc32
GV
4808 return (1);
4809
4810 /* if (!lpef->size_ref || lptm->tmMaxCharWidth == FONT_WIDTH (lpef->size_ref)) */
4811 {
4812 char buf[100];
4813
779a69a8 4814 if (!NILP (*(lpef->pattern)) && FontType != RASTER_FONTTYPE)
3cb20f4a
RS
4815 {
4816 lplf->elfLogFont.lfHeight = lpef->logfont.lfHeight;
4817 lplf->elfLogFont.lfWidth = lpef->logfont.lfWidth;
4818 }
4819
fbd6baed 4820 if (!w32_to_x_font (lplf, buf, 100)) return (0);
ee78dc32 4821
fbd6baed 4822 if (NILP (*(lpef->pattern)) || w32_font_match (buf, XSTRING (*(lpef->pattern))->data))
ee78dc32
GV
4823 {
4824 *lpef->tail = Fcons (build_string (buf), Qnil);
4825 lpef->tail = &XCONS (*lpef->tail)->cdr;
4826 lpef->numFonts++;
4827 }
4828 }
4829
4830 return (1);
4831}
4832
4833int CALLBACK
4834enum_font_cb1 (lplf, lptm, FontType, lpef)
4835 ENUMLOGFONT * lplf;
4836 NEWTEXTMETRIC * lptm;
4837 int FontType;
4838 enumfont_t * lpef;
4839{
4840 return EnumFontFamilies (lpef->hdc,
4841 lplf->elfLogFont.lfFaceName,
4842 (FONTENUMPROC) enum_font_cb2,
4843 (LPARAM) lpef);
4844}
4845
4846
4847DEFUN ("x-list-fonts", Fx_list_fonts, Sx_list_fonts, 1, 3, 0,
4848 "Return a list of the names of available fonts matching PATTERN.\n\
4849If optional arguments FACE and FRAME are specified, return only fonts\n\
4850the same size as FACE on FRAME.\n\
4851\n\
4852PATTERN is a string, perhaps with wildcard characters;\n\
4853 the * character matches any substring, and\n\
4854 the ? character matches any single character.\n\
4855 PATTERN is case-insensitive.\n\
4856FACE is a face name--a symbol.\n\
4857\n\
4858The return value is a list of strings, suitable as arguments to\n\
4859set-face-font.\n\
4860\n\
4861Fonts Emacs can't use (i.e. proportional fonts) may or may not be excluded\n\
4862even if they match PATTERN and FACE.")
4863 (pattern, face, frame)
4864 Lisp_Object pattern, face, frame;
4865{
4866 int num_fonts;
4867 char **names;
4868 XFontStruct *info;
4869 XFontStruct *size_ref;
4870 Lisp_Object namelist;
4871 Lisp_Object list;
4872 FRAME_PTR f;
4873 enumfont_t ef;
4874
4875 CHECK_STRING (pattern, 0);
4876 if (!NILP (face))
4877 CHECK_SYMBOL (face, 1);
4878
4879 f = check_x_frame (frame);
4880
4881 /* Determine the width standard for comparison with the fonts we find. */
4882
4883 if (NILP (face))
4884 size_ref = 0;
4885 else
4886 {
4887 int face_id;
4888
4889 /* Don't die if we get called with a terminal frame. */
fbd6baed
GV
4890 if (! FRAME_W32_P (f))
4891 error ("non-w32 frame used in `x-list-fonts'");
ee78dc32
GV
4892
4893 face_id = face_name_id_number (f, face);
4894
4895 if (face_id < 0 || face_id >= FRAME_N_PARAM_FACES (f)
4896 || FRAME_PARAM_FACES (f) [face_id] == 0)
fbd6baed 4897 size_ref = f->output_data.w32->font;
ee78dc32
GV
4898 else
4899 {
4900 size_ref = FRAME_PARAM_FACES (f) [face_id]->font;
4901 if (size_ref == (XFontStruct *) (~0))
fbd6baed 4902 size_ref = f->output_data.w32->font;
ee78dc32
GV
4903 }
4904 }
4905
4906 /* See if we cached the result for this particular query. */
4907 list = Fassoc (pattern,
fbd6baed 4908 XCONS (FRAME_W32_DISPLAY_INFO (f)->name_list_element)->cdr);
ee78dc32
GV
4909
4910 /* We have info in the cache for this PATTERN. */
4911 if (!NILP (list))
4912 {
4913 Lisp_Object tem, newlist;
4914
4915 /* We have info about this pattern. */
4916 list = XCONS (list)->cdr;
4917
4918 if (size_ref == 0)
4919 return list;
4920
4921 BLOCK_INPUT;
4922
4923 /* Filter the cached info and return just the fonts that match FACE. */
4924 newlist = Qnil;
4925 for (tem = list; CONSP (tem); tem = XCONS (tem)->cdr)
4926 {
4927 XFontStruct *thisinfo;
4928
fbd6baed 4929 thisinfo = w32_load_font (FRAME_W32_DISPLAY_INFO (f), XSTRING (XCONS (tem)->car)->data);
ee78dc32
GV
4930
4931 if (thisinfo && same_size_fonts (thisinfo, size_ref))
4932 newlist = Fcons (XCONS (tem)->car, newlist);
4933
fbd6baed 4934 w32_unload_font (FRAME_W32_DISPLAY_INFO (f), thisinfo);
ee78dc32
GV
4935 }
4936
4937 UNBLOCK_INPUT;
4938
4939 return newlist;
4940 }
4941
4942 BLOCK_INPUT;
4943
4944 namelist = Qnil;
4945 ef.pattern = &pattern;
4946 ef.tail = ef.head = &namelist;
4947 ef.numFonts = 0;
fbd6baed 4948 x_to_w32_font (STRINGP (pattern) ? XSTRING (pattern)->data : NULL, &ef.logfont);
ee78dc32
GV
4949
4950 {
fbd6baed 4951 ef.hdc = GetDC (FRAME_W32_WINDOW (f));
ee78dc32
GV
4952
4953 EnumFontFamilies (ef.hdc, NULL, (FONTENUMPROC) enum_font_cb1, (LPARAM)&ef);
4954
fbd6baed 4955 ReleaseDC (FRAME_W32_WINDOW (f), ef.hdc);
ee78dc32
GV
4956 }
4957
4958 UNBLOCK_INPUT;
4959
4960 if (ef.numFonts)
4961 {
4962 int i;
4963 Lisp_Object cur;
4964
4965 /* Make a list of all the fonts we got back.
4966 Store that in the font cache for the display. */
fbd6baed 4967 XCONS (FRAME_W32_DISPLAY_INFO (f)->name_list_element)->cdr
ee78dc32 4968 = Fcons (Fcons (pattern, namelist),
fbd6baed 4969 XCONS (FRAME_W32_DISPLAY_INFO (f)->name_list_element)->cdr);
ee78dc32
GV
4970
4971 /* Make a list of the fonts that have the right width. */
4972 list = Qnil;
4973 cur=namelist;
4974 for (i = 0; i < ef.numFonts; i++)
4975 {
4976 int keeper;
4977
4978 if (!size_ref)
4979 keeper = 1;
4980 else
4981 {
4982 XFontStruct *thisinfo;
4983
4984 BLOCK_INPUT;
fbd6baed 4985 thisinfo = w32_load_font (FRAME_W32_DISPLAY_INFO (f), XSTRING (Fcar (cur))->data);
ee78dc32
GV
4986
4987 keeper = thisinfo && same_size_fonts (thisinfo, size_ref);
4988
fbd6baed 4989 w32_unload_font (FRAME_W32_DISPLAY_INFO (f), thisinfo);
ee78dc32
GV
4990
4991 UNBLOCK_INPUT;
4992 }
4993 if (keeper)
4994 list = Fcons (build_string (XSTRING (Fcar (cur))->data), list);
4995
4996 cur = Fcdr (cur);
4997 }
4998 list = Fnreverse (list);
4999 }
5000
5001 return list;
5002}
5003\f
5004DEFUN ("x-color-defined-p", Fx_color_defined_p, Sx_color_defined_p, 1, 2, 0,
5005 "Return non-nil if color COLOR is supported on frame FRAME.\n\
5006If FRAME is omitted or nil, use the selected frame.")
5007 (color, frame)
5008 Lisp_Object color, frame;
5009{
5010 COLORREF foo;
5011 FRAME_PTR f = check_x_frame (frame);
5012
5013 CHECK_STRING (color, 1);
5014
5015 if (defined_color (f, XSTRING (color)->data, &foo, 0))
5016 return Qt;
5017 else
5018 return Qnil;
5019}
5020
5021DEFUN ("x-color-values", Fx_color_values, Sx_color_values, 1, 2, 0,
5022 "Return a description of the color named COLOR on frame FRAME.\n\
5023The value is a list of integer RGB values--(RED GREEN BLUE).\n\
5024These values appear to range from 0 to 65280 or 65535, depending\n\
5025on the system; white is (65280 65280 65280) or (65535 65535 65535).\n\
5026If FRAME is omitted or nil, use the selected frame.")
5027 (color, frame)
5028 Lisp_Object color, frame;
5029{
5030 COLORREF foo;
5031 FRAME_PTR f = check_x_frame (frame);
5032
5033 CHECK_STRING (color, 1);
5034
5035 if (defined_color (f, XSTRING (color)->data, &foo, 0))
5036 {
5037 Lisp_Object rgb[3];
5038
1edf84e7
GV
5039 rgb[0] = make_number ((GetRValue (foo) << 8) | GetRValue (foo));
5040 rgb[1] = make_number ((GetGValue (foo) << 8) | GetGValue (foo));
5041 rgb[2] = make_number ((GetBValue (foo) << 8) | GetBValue (foo));
ee78dc32
GV
5042 return Flist (3, rgb);
5043 }
5044 else
5045 return Qnil;
5046}
5047
5048DEFUN ("x-display-color-p", Fx_display_color_p, Sx_display_color_p, 0, 1, 0,
5049 "Return t if the X display supports color.\n\
5050The optional argument DISPLAY specifies which display to ask about.\n\
5051DISPLAY should be either a frame or a display name (a string).\n\
5052If omitted or nil, that stands for the selected frame's display.")
5053 (display)
5054 Lisp_Object display;
5055{
fbd6baed 5056 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV
5057
5058 if ((dpyinfo->n_planes * dpyinfo->n_cbits) <= 2)
5059 return Qnil;
5060
5061 return Qt;
5062}
5063
5064DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p, Sx_display_grayscale_p,
5065 0, 1, 0,
5066 "Return t if the X display supports shades of gray.\n\
5067Note that color displays do support shades of gray.\n\
5068The optional argument DISPLAY specifies which display to ask about.\n\
5069DISPLAY should be either a frame or a display name (a string).\n\
5070If omitted or nil, that stands for the selected frame's display.")
5071 (display)
5072 Lisp_Object display;
5073{
fbd6baed 5074 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV
5075
5076 if ((dpyinfo->n_planes * dpyinfo->n_cbits) <= 1)
5077 return Qnil;
5078
5079 return Qt;
5080}
5081
5082DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width,
5083 0, 1, 0,
5084 "Returns the width in pixels of the X display DISPLAY.\n\
5085The optional argument DISPLAY specifies which display to ask about.\n\
5086DISPLAY should be either a frame or a display name (a string).\n\
5087If omitted or nil, that stands for the selected frame's display.")
5088 (display)
5089 Lisp_Object display;
5090{
fbd6baed 5091 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV
5092
5093 return make_number (dpyinfo->width);
5094}
5095
5096DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
5097 Sx_display_pixel_height, 0, 1, 0,
5098 "Returns the height in pixels of the X display DISPLAY.\n\
5099The optional argument DISPLAY specifies which display to ask about.\n\
5100DISPLAY should be either a frame or a display name (a string).\n\
5101If omitted or nil, that stands for the selected frame's display.")
5102 (display)
5103 Lisp_Object display;
5104{
fbd6baed 5105 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV
5106
5107 return make_number (dpyinfo->height);
5108}
5109
5110DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
5111 0, 1, 0,
5112 "Returns the number of bitplanes of the display DISPLAY.\n\
5113The optional argument DISPLAY specifies which display to ask about.\n\
5114DISPLAY should be either a frame or a display name (a string).\n\
5115If omitted or nil, that stands for the selected frame's display.")
5116 (display)
5117 Lisp_Object display;
5118{
fbd6baed 5119 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV
5120
5121 return make_number (dpyinfo->n_planes * dpyinfo->n_cbits);
5122}
5123
5124DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
5125 0, 1, 0,
5126 "Returns the number of color cells of the display DISPLAY.\n\
5127The optional argument DISPLAY specifies which display to ask about.\n\
5128DISPLAY should be either a frame or a display name (a string).\n\
5129If omitted or nil, that stands for the selected frame's display.")
5130 (display)
5131 Lisp_Object display;
5132{
fbd6baed 5133 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV
5134 HDC hdc;
5135 int cap;
5136
5ac45f98
GV
5137 hdc = GetDC (dpyinfo->root_window);
5138 if (dpyinfo->has_palette)
5139 cap = GetDeviceCaps (hdc,SIZEPALETTE);
5140 else
5141 cap = GetDeviceCaps (hdc,NUMCOLORS);
ee78dc32
GV
5142
5143 ReleaseDC (dpyinfo->root_window, hdc);
5144
5145 return make_number (cap);
5146}
5147
5148DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
5149 Sx_server_max_request_size,
5150 0, 1, 0,
5151 "Returns the maximum request size of the server of display DISPLAY.\n\
5152The optional argument DISPLAY specifies which display to ask about.\n\
5153DISPLAY should be either a frame or a display name (a string).\n\
5154If omitted or nil, that stands for the selected frame's display.")
5155 (display)
5156 Lisp_Object display;
5157{
fbd6baed 5158 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV
5159
5160 return make_number (1);
5161}
5162
5163DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
fbd6baed 5164 "Returns the vendor ID string of the W32 system (Microsoft).\n\
ee78dc32
GV
5165The optional argument DISPLAY specifies which display to ask about.\n\
5166DISPLAY should be either a frame or a display name (a string).\n\
5167If omitted or nil, that stands for the selected frame's display.")
5168 (display)
5169 Lisp_Object display;
5170{
fbd6baed 5171 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV
5172 char *vendor = "Microsoft Corp.";
5173
5174 if (! vendor) vendor = "";
5175 return build_string (vendor);
5176}
5177
5178DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
5179 "Returns the version numbers of the server of display DISPLAY.\n\
5180The value is a list of three integers: the major and minor\n\
5181version numbers, and the vendor-specific release\n\
5182number. See also the function `x-server-vendor'.\n\n\
5183The optional argument DISPLAY specifies which display to ask about.\n\
5184DISPLAY should be either a frame or a display name (a string).\n\
5185If omitted or nil, that stands for the selected frame's display.")
5186 (display)
5187 Lisp_Object display;
5188{
fbd6baed 5189 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32 5190
fbd6baed
GV
5191 return Fcons (make_number (w32_major_version),
5192 Fcons (make_number (w32_minor_version), Qnil));
ee78dc32
GV
5193}
5194
5195DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
5196 "Returns the number of screens on the server of display DISPLAY.\n\
5197The optional argument DISPLAY specifies which display to ask about.\n\
5198DISPLAY should be either a frame or a display name (a string).\n\
5199If omitted or nil, that stands for the selected frame's display.")
5200 (display)
5201 Lisp_Object display;
5202{
fbd6baed 5203 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV
5204
5205 return make_number (1);
5206}
5207
5208DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, 0,
5209 "Returns the height in millimeters of the X display DISPLAY.\n\
5210The optional argument DISPLAY specifies which display to ask about.\n\
5211DISPLAY should be either a frame or a display name (a string).\n\
5212If omitted or nil, that stands for the selected frame's display.")
5213 (display)
5214 Lisp_Object display;
5215{
fbd6baed 5216 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV
5217 HDC hdc;
5218 int cap;
5219
5ac45f98 5220 hdc = GetDC (dpyinfo->root_window);
3c190163 5221
ee78dc32 5222 cap = GetDeviceCaps (hdc, VERTSIZE);
3c190163 5223
ee78dc32
GV
5224 ReleaseDC (dpyinfo->root_window, hdc);
5225
5226 return make_number (cap);
5227}
5228
5229DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
5230 "Returns the width in millimeters of the X display DISPLAY.\n\
5231The optional argument DISPLAY specifies which display to ask about.\n\
5232DISPLAY should be either a frame or a display name (a string).\n\
5233If omitted or nil, that stands for the selected frame's display.")
5234 (display)
5235 Lisp_Object display;
5236{
fbd6baed 5237 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV
5238
5239 HDC hdc;
5240 int cap;
5241
5ac45f98 5242 hdc = GetDC (dpyinfo->root_window);
3c190163 5243
ee78dc32 5244 cap = GetDeviceCaps (hdc, HORZSIZE);
3c190163 5245
ee78dc32
GV
5246 ReleaseDC (dpyinfo->root_window, hdc);
5247
5248 return make_number (cap);
5249}
5250
5251DEFUN ("x-display-backing-store", Fx_display_backing_store,
5252 Sx_display_backing_store, 0, 1, 0,
5253 "Returns an indication of whether display DISPLAY does backing store.\n\
5254The value may be `always', `when-mapped', or `not-useful'.\n\
5255The optional argument DISPLAY specifies which display to ask about.\n\
5256DISPLAY should be either a frame or a display name (a string).\n\
5257If omitted or nil, that stands for the selected frame's display.")
5258 (display)
5259 Lisp_Object display;
5260{
5261 return intern ("not-useful");
5262}
5263
5264DEFUN ("x-display-visual-class", Fx_display_visual_class,
5265 Sx_display_visual_class, 0, 1, 0,
5266 "Returns the visual class of the display DISPLAY.\n\
5267The value is one of the symbols `static-gray', `gray-scale',\n\
5268`static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
5269The optional argument DISPLAY specifies which display to ask about.\n\
5270DISPLAY should be either a frame or a display name (a string).\n\
5271If omitted or nil, that stands for the selected frame's display.")
5272 (display)
5273 Lisp_Object display;
5274{
fbd6baed 5275 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV
5276
5277#if 0
5278 switch (dpyinfo->visual->class)
5279 {
5280 case StaticGray: return (intern ("static-gray"));
5281 case GrayScale: return (intern ("gray-scale"));
5282 case StaticColor: return (intern ("static-color"));
5283 case PseudoColor: return (intern ("pseudo-color"));
5284 case TrueColor: return (intern ("true-color"));
5285 case DirectColor: return (intern ("direct-color"));
5286 default:
5287 error ("Display has an unknown visual class");
5288 }
5289#endif
5290
5291 error ("Display has an unknown visual class");
5292}
5293
5294DEFUN ("x-display-save-under", Fx_display_save_under,
5295 Sx_display_save_under, 0, 1, 0,
5296 "Returns t if the display DISPLAY supports the save-under feature.\n\
5297The optional argument DISPLAY specifies which display to ask about.\n\
5298DISPLAY should be either a frame or a display name (a string).\n\
5299If omitted or nil, that stands for the selected frame's display.")
5300 (display)
5301 Lisp_Object display;
5302{
fbd6baed 5303 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV
5304
5305 return Qnil;
5306}
5307\f
5308int
5309x_pixel_width (f)
5310 register struct frame *f;
5311{
5312 return PIXEL_WIDTH (f);
5313}
5314
5315int
5316x_pixel_height (f)
5317 register struct frame *f;
5318{
5319 return PIXEL_HEIGHT (f);
5320}
5321
5322int
5323x_char_width (f)
5324 register struct frame *f;
5325{
fbd6baed 5326 return FONT_WIDTH (f->output_data.w32->font);
ee78dc32
GV
5327}
5328
5329int
5330x_char_height (f)
5331 register struct frame *f;
5332{
fbd6baed 5333 return f->output_data.w32->line_height;
ee78dc32
GV
5334}
5335
5336int
5337x_screen_planes (frame)
5338 Lisp_Object frame;
5339{
fbd6baed
GV
5340 return (FRAME_W32_DISPLAY_INFO (XFRAME (frame))->n_planes *
5341 FRAME_W32_DISPLAY_INFO (XFRAME (frame))->n_cbits);
ee78dc32
GV
5342}
5343\f
5344/* Return the display structure for the display named NAME.
5345 Open a new connection if necessary. */
5346
fbd6baed 5347struct w32_display_info *
ee78dc32
GV
5348x_display_info_for_name (name)
5349 Lisp_Object name;
5350{
5351 Lisp_Object names;
fbd6baed 5352 struct w32_display_info *dpyinfo;
ee78dc32
GV
5353
5354 CHECK_STRING (name, 0);
5355
fbd6baed 5356 for (dpyinfo = &one_w32_display_info, names = w32_display_name_list;
ee78dc32
GV
5357 dpyinfo;
5358 dpyinfo = dpyinfo->next, names = XCONS (names)->cdr)
5359 {
5360 Lisp_Object tem;
5361 tem = Fstring_equal (XCONS (XCONS (names)->car)->car, name);
5362 if (!NILP (tem))
5363 return dpyinfo;
5364 }
5365
5366 /* Use this general default value to start with. */
5367 Vx_resource_name = Vinvocation_name;
5368
5369 validate_x_resource_name ();
5370
fbd6baed 5371 dpyinfo = w32_term_init (name, (unsigned char *)0,
ee78dc32
GV
5372 (char *) XSTRING (Vx_resource_name)->data);
5373
5374 if (dpyinfo == 0)
5375 error ("Cannot connect to server %s", XSTRING (name)->data);
5376
1edf84e7 5377 w32_in_use = 1;
ee78dc32
GV
5378 XSETFASTINT (Vwindow_system_version, 3);
5379
5380 return dpyinfo;
5381}
5382
5383DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
5384 1, 3, 0, "Open a connection to a server.\n\
5385DISPLAY is the name of the display to connect to.\n\
5386Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
5387If the optional third arg MUST-SUCCEED is non-nil,\n\
5388terminate Emacs if we can't open the connection.")
5389 (display, xrm_string, must_succeed)
5390 Lisp_Object display, xrm_string, must_succeed;
5391{
5392 unsigned int n_planes;
5393 unsigned char *xrm_option;
fbd6baed 5394 struct w32_display_info *dpyinfo;
ee78dc32
GV
5395
5396 CHECK_STRING (display, 0);
5397 if (! NILP (xrm_string))
5398 CHECK_STRING (xrm_string, 1);
5399
1edf84e7
GV
5400 if (! EQ (Vwindow_system, intern ("w32")))
5401 error ("Not using Microsoft Windows");
5402
5ac45f98
GV
5403 /* Allow color mapping to be defined externally; first look in user's
5404 HOME directory, then in Emacs etc dir for a file called rgb.txt. */
5405 {
5406 Lisp_Object color_file;
5407 struct gcpro gcpro1;
5408
5409 color_file = build_string("~/rgb.txt");
5410
5411 GCPRO1 (color_file);
5412
5413 if (NILP (Ffile_readable_p (color_file)))
5414 color_file =
5415 Fexpand_file_name (build_string ("rgb.txt"),
5416 Fsymbol_value (intern ("data-directory")));
5417
fbd6baed 5418 Vw32_color_map = Fw32_load_color_file (color_file);
5ac45f98
GV
5419
5420 UNGCPRO;
5421 }
fbd6baed
GV
5422 if (NILP (Vw32_color_map))
5423 Vw32_color_map = Fw32_default_color_map ();
ee78dc32
GV
5424
5425 if (! NILP (xrm_string))
5426 xrm_option = (unsigned char *) XSTRING (xrm_string)->data;
5427 else
5428 xrm_option = (unsigned char *) 0;
5429
5430 /* Use this general default value to start with. */
5ac45f98
GV
5431 /* First remove .exe suffix from invocation-name - it looks ugly. */
5432 {
5433 char basename[ MAX_PATH ], *str;
5434
5435 strcpy (basename, XSTRING (Vinvocation_name)->data);
5436 str = strrchr (basename, '.');
5437 if (str) *str = 0;
5438 Vinvocation_name = build_string (basename);
5439 }
ee78dc32
GV
5440 Vx_resource_name = Vinvocation_name;
5441
5442 validate_x_resource_name ();
5443
5444 /* This is what opens the connection and sets x_current_display.
5445 This also initializes many symbols, such as those used for input. */
fbd6baed 5446 dpyinfo = w32_term_init (display, xrm_option,
ee78dc32
GV
5447 (char *) XSTRING (Vx_resource_name)->data);
5448
5449 if (dpyinfo == 0)
5450 {
5451 if (!NILP (must_succeed))
3c190163
GV
5452 fatal ("Cannot connect to server %s.\n",
5453 XSTRING (display)->data);
ee78dc32
GV
5454 else
5455 error ("Cannot connect to server %s", XSTRING (display)->data);
5456 }
5457
1edf84e7
GV
5458 w32_in_use = 1;
5459
ee78dc32
GV
5460 XSETFASTINT (Vwindow_system_version, 3);
5461 return Qnil;
5462}
5463
5464DEFUN ("x-close-connection", Fx_close_connection,
5465 Sx_close_connection, 1, 1, 0,
5466 "Close the connection to DISPLAY's server.\n\
5467For DISPLAY, specify either a frame or a display name (a string).\n\
5468If DISPLAY is nil, that stands for the selected frame's display.")
5469 (display)
5470 Lisp_Object display;
5471{
fbd6baed
GV
5472 struct w32_display_info *dpyinfo = check_x_display_info (display);
5473 struct w32_display_info *tail;
ee78dc32
GV
5474 int i;
5475
5476 if (dpyinfo->reference_count > 0)
5477 error ("Display still has frames on it");
5478
5479 BLOCK_INPUT;
5480 /* Free the fonts in the font table. */
5481 for (i = 0; i < dpyinfo->n_fonts; i++)
5482 {
5483 if (dpyinfo->font_table[i].name)
5484 free (dpyinfo->font_table[i].name);
5485 /* Don't free the full_name string;
5486 it is always shared with something else. */
fbd6baed 5487 w32_unload_font (dpyinfo, dpyinfo->font_table[i].font);
ee78dc32
GV
5488 }
5489 x_destroy_all_bitmaps (dpyinfo);
5490
5491 x_delete_display (dpyinfo);
5492 UNBLOCK_INPUT;
5493
5494 return Qnil;
5495}
5496
5497DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0,
5498 "Return the list of display names that Emacs has connections to.")
5499 ()
5500{
5501 Lisp_Object tail, result;
5502
5503 result = Qnil;
fbd6baed 5504 for (tail = w32_display_name_list; ! NILP (tail); tail = XCONS (tail)->cdr)
ee78dc32
GV
5505 result = Fcons (XCONS (XCONS (tail)->car)->car, result);
5506
5507 return result;
5508}
5509
5510DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize, 1, 2, 0,
5511 "If ON is non-nil, report errors as soon as the erring request is made.\n\
5512If ON is nil, allow buffering of requests.\n\
fbd6baed 5513This is a noop on W32 systems.\n\
ee78dc32
GV
5514The optional second argument DISPLAY specifies which display to act on.\n\
5515DISPLAY should be either a frame or a display name (a string).\n\
5516If DISPLAY is omitted or nil, that stands for the selected frame's display.")
5517 (on, display)
5518 Lisp_Object display, on;
5519{
fbd6baed 5520 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV
5521
5522 return Qnil;
5523}
5524
5525\f
fbd6baed 5526/* These are the w32 specialized functions */
ee78dc32 5527
fbd6baed
GV
5528DEFUN ("w32-select-font", Fw32_select_font, Sw32_select_font, 0, 1, 0,
5529 "This will display the W32 font dialog and return an X font string corresponding to the selection.")
ee78dc32
GV
5530 (frame)
5531 Lisp_Object frame;
5532{
5533 FRAME_PTR f = check_x_frame (frame);
5534 CHOOSEFONT cf;
5535 LOGFONT lf;
5536 char buf[100];
5537
5538 bzero (&cf, sizeof (cf));
5539
5540 cf.lStructSize = sizeof (cf);
fbd6baed 5541 cf.hwndOwner = FRAME_W32_WINDOW (f);
ee78dc32
GV
5542 cf.Flags = CF_FIXEDPITCHONLY | CF_FORCEFONTEXIST | CF_SCREENFONTS;
5543 cf.lpLogFont = &lf;
5544
fbd6baed 5545 if (!ChooseFont (&cf) || !w32_to_x_font (&lf, buf, 100))
3c190163 5546 return Qnil;
ee78dc32
GV
5547
5548 return build_string (buf);
5549}
5550
1edf84e7
GV
5551DEFUN ("w32-send-sys-command", Fw32_send_sys_command, Sw32_send_sys_command, 1, 2, 0,
5552 "Send frame a Windows WM_SYSCOMMAND message of type COMMAND.\n\
5553Some useful values for command are 0xf030 to maximise frame (0xf020\n\
5554to minimize), 0xf120 to restore frame to original size, and 0xf100\n\
5555to activate the menubar for keyboard access. 0xf140 activates the\n\
5556screen saver if defined.\n\
5557\n\
5558If optional parameter FRAME is not specified, use selected frame.")
5559 (command, frame)
5560 Lisp_Object command, frame;
5561{
5562 WPARAM code;
5563 FRAME_PTR f = check_x_frame (frame);
5564
5565 CHECK_NUMBER (command, 0);
5566
5567 PostMessage (FRAME_W32_WINDOW (f), WM_SYSCOMMAND, XINT (command), 0);
5568
5569 return Qnil;
5570}
5571
ee78dc32 5572\f
fbd6baed 5573syms_of_w32fns ()
ee78dc32 5574{
1edf84e7
GV
5575 /* This is zero if not using MS-Windows. */
5576 w32_in_use = 0;
5577
ee78dc32
GV
5578 /* The section below is built by the lisp expression at the top of the file,
5579 just above where these variables are declared. */
5580 /*&&& init symbols here &&&*/
5581 Qauto_raise = intern ("auto-raise");
5582 staticpro (&Qauto_raise);
5583 Qauto_lower = intern ("auto-lower");
5584 staticpro (&Qauto_lower);
5585 Qbackground_color = intern ("background-color");
5586 staticpro (&Qbackground_color);
5587 Qbar = intern ("bar");
5588 staticpro (&Qbar);
5589 Qborder_color = intern ("border-color");
5590 staticpro (&Qborder_color);
5591 Qborder_width = intern ("border-width");
5592 staticpro (&Qborder_width);
5593 Qbox = intern ("box");
5594 staticpro (&Qbox);
5595 Qcursor_color = intern ("cursor-color");
5596 staticpro (&Qcursor_color);
5597 Qcursor_type = intern ("cursor-type");
5598 staticpro (&Qcursor_type);
ee78dc32
GV
5599 Qforeground_color = intern ("foreground-color");
5600 staticpro (&Qforeground_color);
5601 Qgeometry = intern ("geometry");
5602 staticpro (&Qgeometry);
5603 Qicon_left = intern ("icon-left");
5604 staticpro (&Qicon_left);
5605 Qicon_top = intern ("icon-top");
5606 staticpro (&Qicon_top);
5607 Qicon_type = intern ("icon-type");
5608 staticpro (&Qicon_type);
5609 Qicon_name = intern ("icon-name");
5610 staticpro (&Qicon_name);
5611 Qinternal_border_width = intern ("internal-border-width");
5612 staticpro (&Qinternal_border_width);
5613 Qleft = intern ("left");
5614 staticpro (&Qleft);
1026b400
RS
5615 Qright = intern ("right");
5616 staticpro (&Qright);
ee78dc32
GV
5617 Qmouse_color = intern ("mouse-color");
5618 staticpro (&Qmouse_color);
5619 Qnone = intern ("none");
5620 staticpro (&Qnone);
5621 Qparent_id = intern ("parent-id");
5622 staticpro (&Qparent_id);
5623 Qscroll_bar_width = intern ("scroll-bar-width");
5624 staticpro (&Qscroll_bar_width);
5625 Qsuppress_icon = intern ("suppress-icon");
5626 staticpro (&Qsuppress_icon);
5627 Qtop = intern ("top");
5628 staticpro (&Qtop);
5629 Qundefined_color = intern ("undefined-color");
5630 staticpro (&Qundefined_color);
5631 Qvertical_scroll_bars = intern ("vertical-scroll-bars");
5632 staticpro (&Qvertical_scroll_bars);
5633 Qvisibility = intern ("visibility");
5634 staticpro (&Qvisibility);
5635 Qwindow_id = intern ("window-id");
5636 staticpro (&Qwindow_id);
5637 Qx_frame_parameter = intern ("x-frame-parameter");
5638 staticpro (&Qx_frame_parameter);
5639 Qx_resource_name = intern ("x-resource-name");
5640 staticpro (&Qx_resource_name);
5641 Quser_position = intern ("user-position");
5642 staticpro (&Quser_position);
5643 Quser_size = intern ("user-size");
5644 staticpro (&Quser_size);
5645 Qdisplay = intern ("display");
5646 staticpro (&Qdisplay);
5647 /* This is the end of symbol initialization. */
5648
5649 Fput (Qundefined_color, Qerror_conditions,
5650 Fcons (Qundefined_color, Fcons (Qerror, Qnil)));
5651 Fput (Qundefined_color, Qerror_message,
5652 build_string ("Undefined color"));
5653
fbd6baed 5654 DEFVAR_LISP ("w32-color-map", &Vw32_color_map,
ee78dc32 5655 "A array of color name mappings for windows.");
fbd6baed 5656 Vw32_color_map = Qnil;
ee78dc32 5657
fbd6baed 5658 DEFVAR_LISP ("w32-pass-alt-to-system", &Vw32_pass_alt_to_system,
da36a4d6
GV
5659 "Non-nil if alt key presses are passed on to Windows.\n\
5660When non-nil, for example, alt pressed and released and then space will\n\
5661open the System menu. When nil, Emacs silently swallows alt key events.");
fbd6baed 5662 Vw32_pass_alt_to_system = Qnil;
da36a4d6 5663
fbd6baed 5664 DEFVAR_LISP ("w32-alt-is-meta", &Vw32_alt_is_meta,
8c205c63
RS
5665 "Non-nil if the alt key is to be considered the same as the meta key.\n\
5666When nil, Emacs will translate the alt key to the Alt modifier, and not Meta.");
fbd6baed 5667 Vw32_alt_is_meta = Qt;
8c205c63 5668
fbd6baed
GV
5669 DEFVAR_LISP ("w32-pass-optional-keys-to-system",
5670 &Vw32_pass_optional_keys_to_system,
da36a4d6
GV
5671 "Non-nil if the 'optional' keys (left window, right window,\n\
5672and application keys) are passed on to Windows.");
fbd6baed 5673 Vw32_pass_optional_keys_to_system = Qnil;
da36a4d6 5674
fbd6baed 5675 DEFVAR_LISP ("w32-enable-italics", &Vw32_enable_italics,
5ac45f98 5676 "Non-nil enables selection of artificially italicized fonts.");
fbd6baed 5677 Vw32_enable_italics = Qnil;
5ac45f98 5678
fbd6baed 5679 DEFVAR_LISP ("w32-enable-palette", &Vw32_enable_palette,
5ac45f98 5680 "Non-nil enables Windows palette management to map colors exactly.");
fbd6baed 5681 Vw32_enable_palette = Qt;
5ac45f98 5682
fbd6baed
GV
5683 DEFVAR_INT ("w32-mouse-button-tolerance",
5684 &Vw32_mouse_button_tolerance,
5ac45f98
GV
5685 "Analogue of double click interval for faking middle mouse events.\n\
5686The value is the minimum time in milliseconds that must elapse between\n\
5687left/right button down events before they are considered distinct events.\n\
5688If both mouse buttons are depressed within this interval, a middle mouse\n\
5689button down event is generated instead.");
fbd6baed 5690 XSETINT (Vw32_mouse_button_tolerance, GetDoubleClickTime () / 2);
5ac45f98 5691
fbd6baed
GV
5692 DEFVAR_INT ("w32-mouse-move-interval",
5693 &Vw32_mouse_move_interval,
84fb1139
KH
5694 "Minimum interval between mouse move events.\n\
5695The value is the minimum time in milliseconds that must elapse between\n\
5696successive mouse move (or scroll bar drag) events before they are\n\
5697reported as lisp events.");
fbd6baed 5698 XSETINT (Vw32_mouse_move_interval, 50);
84fb1139 5699
ee78dc32
GV
5700 init_x_parm_symbols ();
5701
5702 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path,
fbd6baed 5703 "List of directories to search for bitmap files for w32.");
ee78dc32
GV
5704 Vx_bitmap_file_path = decode_env_path ((char *) 0, "PATH");
5705
5706 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape,
5707 "The shape of the pointer when over text.\n\
5708Changing the value does not affect existing frames\n\
5709unless you set the mouse color.");
5710 Vx_pointer_shape = Qnil;
5711
5712 DEFVAR_LISP ("x-resource-name", &Vx_resource_name,
5713 "The name Emacs uses to look up resources; for internal use only.\n\
5714`x-get-resource' uses this as the first component of the instance name\n\
5715when requesting resource values.\n\
5716Emacs initially sets `x-resource-name' to the name under which Emacs\n\
5717was invoked, or to the value specified with the `-name' or `-rn'\n\
5718switches, if present.");
5719 Vx_resource_name = Qnil;
5720
5721 Vx_nontext_pointer_shape = Qnil;
5722
5723 Vx_mode_pointer_shape = Qnil;
5724
5725 DEFVAR_INT ("x-sensitive-text-pointer-shape",
5726 &Vx_sensitive_text_pointer_shape,
5727 "The shape of the pointer when over mouse-sensitive text.\n\
5728This variable takes effect when you create a new frame\n\
5729or when you set the mouse color.");
5730 Vx_sensitive_text_pointer_shape = Qnil;
5731
5732 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel,
5733 "A string indicating the foreground color of the cursor box.");
5734 Vx_cursor_fore_pixel = Qnil;
5735
5736 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager,
5737 "Non-nil if no window manager is in use.\n\
5738Emacs doesn't try to figure this out; this is always nil\n\
5739unless you set it to something else.");
5740 /* We don't have any way to find this out, so set it to nil
5741 and maybe the user would like to set it to t. */
5742 Vx_no_window_manager = Qnil;
5743
5744 defsubr (&Sx_get_resource);
5745 defsubr (&Sx_list_fonts);
5746 defsubr (&Sx_display_color_p);
5747 defsubr (&Sx_display_grayscale_p);
5748 defsubr (&Sx_color_defined_p);
5749 defsubr (&Sx_color_values);
5750 defsubr (&Sx_server_max_request_size);
5751 defsubr (&Sx_server_vendor);
5752 defsubr (&Sx_server_version);
5753 defsubr (&Sx_display_pixel_width);
5754 defsubr (&Sx_display_pixel_height);
5755 defsubr (&Sx_display_mm_width);
5756 defsubr (&Sx_display_mm_height);
5757 defsubr (&Sx_display_screens);
5758 defsubr (&Sx_display_planes);
5759 defsubr (&Sx_display_color_cells);
5760 defsubr (&Sx_display_visual_class);
5761 defsubr (&Sx_display_backing_store);
5762 defsubr (&Sx_display_save_under);
5763 defsubr (&Sx_parse_geometry);
5764 defsubr (&Sx_create_frame);
ee78dc32
GV
5765 defsubr (&Sx_open_connection);
5766 defsubr (&Sx_close_connection);
5767 defsubr (&Sx_display_list);
5768 defsubr (&Sx_synchronize);
5769
fbd6baed 5770 /* W32 specific functions */
ee78dc32 5771
1edf84e7 5772 defsubr (&Sw32_focus_frame);
fbd6baed
GV
5773 defsubr (&Sw32_select_font);
5774 defsubr (&Sw32_define_rgb_color);
5775 defsubr (&Sw32_default_color_map);
5776 defsubr (&Sw32_load_color_file);
1edf84e7 5777 defsubr (&Sw32_send_sys_command);
ee78dc32
GV
5778}
5779
5780#undef abort
5781
5782void
fbd6baed 5783w32_abort()
ee78dc32 5784{
5ac45f98
GV
5785 int button;
5786 button = MessageBox (NULL,
5787 "A fatal error has occurred!\n\n"
5788 "Select Abort to exit, Retry to debug, Ignore to continue",
5789 "Emacs Abort Dialog",
5790 MB_ICONEXCLAMATION | MB_TASKMODAL
5791 | MB_SETFOREGROUND | MB_ABORTRETRYIGNORE);
5792 switch (button)
5793 {
5794 case IDRETRY:
5795 DebugBreak ();
5796 break;
5797 case IDIGNORE:
5798 break;
5799 case IDABORT:
5800 default:
5801 abort ();
5802 break;
5803 }
ee78dc32 5804}
d573caac 5805