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