(get_volume_info): Always update *pPath correctly, even if
[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 2967
3d32fc48 2968#if 1
5ac45f98
GV
2969 /* Detect quit_char and set quit-flag directly. Note that we dow
2970 this *after* posting the message to ensure the main thread will
2971 be woken up if blocked in sys_select(). */
2972 {
2973 int c = wParam;
2974 if (isalpha (c) && (wmsg.dwModifiers == LEFT_CTRL_PRESSED
2975 || wmsg.dwModifiers == RIGHT_CTRL_PRESSED))
2976 c = make_ctrl_char (c) & 0377;
2977 if (c == quit_char)
2978 Vquit_flag = Qt;
2979 }
4ba07e88
GV
2980#endif
2981
5ac45f98 2982 leave_crit ();
ee78dc32 2983 break;
da36a4d6 2984
5ac45f98
GV
2985 /* Simulate middle mouse button events when left and right buttons
2986 are used together, but only if user has two button mouse. */
ee78dc32 2987 case WM_LBUTTONDOWN:
5ac45f98
GV
2988 case WM_RBUTTONDOWN:
2989 if (XINT (Vwin32_num_mouse_buttons) == 3)
2990 goto handle_plain_button;
2991
2992 {
2993 int this = (msg == WM_LBUTTONDOWN) ? LMOUSE : RMOUSE;
2994 int other = (msg == WM_LBUTTONDOWN) ? RMOUSE : LMOUSE;
2995
3cb20f4a
RS
2996 if (button_state & this)
2997 return 0;
5ac45f98
GV
2998
2999 if (button_state == 0)
3000 SetCapture (hwnd);
3001
3002 button_state |= this;
3003
3004 if (button_state & other)
3005 {
3006 if (timer_id)
3007 {
3008 KillTimer (NULL, timer_id);
3009 timer_id = 0;
3010
3011 /* Generate middle mouse event instead. */
3012 msg = WM_MBUTTONDOWN;
3013 button_state |= MMOUSE;
3014 }
3015 else if (button_state & MMOUSE)
3016 {
3017 /* Ignore button event if we've already generated a
3018 middle mouse down event. This happens if the
3019 user releases and press one of the two buttons
3020 after we've faked a middle mouse event. */
3021 return 0;
3022 }
3023 else
3024 {
3025 /* Flush out saved message. */
3cb20f4a 3026 post_msg (&saved_mouse_msg);
5ac45f98
GV
3027 }
3028 wmsg.dwModifiers = win32_get_modifiers ();
3029 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3030
3031 /* Clear message buffer. */
3032 saved_mouse_msg.msg.hwnd = 0;
3033 }
3034 else
3035 {
3036 /* Hold onto message for now. */
3037 timer_id =
3038 SetTimer (NULL, 0, XINT (Vwin32_mouse_button_tolerance), NULL);
3039 saved_mouse_msg.msg.hwnd = hwnd;
3040 saved_mouse_msg.msg.message = msg;
3041 saved_mouse_msg.msg.wParam = wParam;
3042 saved_mouse_msg.msg.lParam = lParam;
3043 saved_mouse_msg.msg.time = GetMessageTime ();
3044 saved_mouse_msg.dwModifiers = win32_get_modifiers ();
3045 }
3046 }
3047 return 0;
3048
ee78dc32 3049 case WM_LBUTTONUP:
5ac45f98
GV
3050 case WM_RBUTTONUP:
3051 if (XINT (Vwin32_num_mouse_buttons) == 3)
3052 goto handle_plain_button;
3053
3054 {
3055 int this = (msg == WM_LBUTTONUP) ? LMOUSE : RMOUSE;
3056 int other = (msg == WM_LBUTTONUP) ? RMOUSE : LMOUSE;
3057
3cb20f4a
RS
3058 if ((button_state & this) == 0)
3059 return 0;
5ac45f98
GV
3060
3061 button_state &= ~this;
3062
3063 if (button_state & MMOUSE)
3064 {
3065 /* Only generate event when second button is released. */
3066 if ((button_state & other) == 0)
3067 {
3068 msg = WM_MBUTTONUP;
3069 button_state &= ~MMOUSE;
3070
3071 if (button_state) abort ();
3072 }
3073 else
3074 return 0;
3075 }
3076 else
3077 {
3078 /* Flush out saved message if necessary. */
3079 if (saved_mouse_msg.msg.hwnd)
3080 {
3cb20f4a 3081 post_msg (&saved_mouse_msg);
5ac45f98
GV
3082 }
3083 }
3084 wmsg.dwModifiers = win32_get_modifiers ();
3085 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3086
3087 /* Always clear message buffer and cancel timer. */
3088 saved_mouse_msg.msg.hwnd = 0;
3089 KillTimer (NULL, timer_id);
3090 timer_id = 0;
3091
3092 if (button_state == 0)
3093 ReleaseCapture ();
3094 }
3095 return 0;
3096
ee78dc32
GV
3097 case WM_MBUTTONDOWN:
3098 case WM_MBUTTONUP:
5ac45f98 3099 handle_plain_button:
ee78dc32
GV
3100 {
3101 BOOL up;
3102
3103 if (parse_button (msg, NULL, &up))
3104 {
3105 if (up) ReleaseCapture ();
3106 else SetCapture (hwnd);
3107 }
3108 }
3109
3110 wmsg.dwModifiers = win32_get_modifiers ();
ee78dc32 3111 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
5ac45f98
GV
3112 return 0;
3113
3114#if 0
3115 case WM_MOUSEMOVE:
3116 /* Flush out saved message if necessary. */
3117 if (saved_mouse_msg.msg.hwnd)
3118 {
3119 wmsg = saved_mouse_msg;
3120 my_post_msg (&wmsg, wmsg.msg.hwnd, wmsg.msg.message,
3121 wmsg.msg.wParam, wmsg.msg.lParam);
3122 }
3123 wmsg.dwModifiers = win32_get_modifiers ();
3124 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3125
3126 /* Always clear message buffer and cancel timer. */
3127 saved_mouse_msg.msg.hwnd = 0;
3128 KillTimer (NULL, timer_id);
3129 timer_id = 0;
3130
3131 return 0;
3132#endif
da36a4d6
GV
3133
3134 case WM_SETFOCUS:
3135 reset_modifiers ();
ee78dc32
GV
3136 case WM_MOUSEMOVE:
3137 case WM_MOVE:
3138 case WM_SIZE:
ee78dc32 3139 case WM_KILLFOCUS:
ee78dc32
GV
3140 case WM_VSCROLL:
3141 case WM_SYSCOMMAND:
3142 case WM_COMMAND:
5ac45f98 3143 wmsg.dwModifiers = win32_get_modifiers ();
ee78dc32
GV
3144 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3145 goto dflt;
8847d890
RS
3146
3147 case WM_CLOSE:
5ac45f98 3148 wmsg.dwModifiers = win32_get_modifiers ();
8847d890
RS
3149 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3150 return 0;
3151
ee78dc32
GV
3152 case WM_WINDOWPOSCHANGING:
3153 {
3154 WINDOWPLACEMENT wp;
3155 LPWINDOWPOS lppos = (WINDOWPOS *) lParam;
3c190163 3156
ee78dc32
GV
3157 GetWindowPlacement (hwnd, &wp);
3158
3159 if (wp.showCmd != SW_SHOWMINIMIZED && ! (lppos->flags & SWP_NOSIZE))
3160 {
3161 RECT rect;
3162 int wdiff;
3163 int hdiff;
3164 DWORD dwXUnits;
3165 DWORD dwYUnits;
3166 RECT wr;
3167
5ac45f98 3168 wp.length = sizeof(wp);
ee78dc32
GV
3169 GetWindowRect (hwnd, &wr);
3170
3c190163 3171 enter_crit ();
ee78dc32
GV
3172
3173 dwXUnits = GetWindowLong (hwnd, WND_X_UNITS_INDEX);
3174 dwYUnits = GetWindowLong (hwnd, WND_Y_UNITS_INDEX);
3175
3c190163 3176 leave_crit ();
ee78dc32
GV
3177
3178 memset (&rect, 0, sizeof (rect));
3179 AdjustWindowRect (&rect, GetWindowLong (hwnd, GWL_STYLE),
3180 GetMenu (hwnd) != NULL);
3181
3182 /* All windows have an extra pixel so subtract 1 */
3183
3184 wdiff = (lppos->cx - (rect.right - rect.left) - 0) % dwXUnits;
3185 hdiff = (lppos->cy - (rect.bottom - rect.top) - 0) % dwYUnits;
3186
3187 if (wdiff || hdiff)
3188 {
3189 /* For right/bottom sizing we can just fix the sizes.
3190 However for top/left sizing we will need to fix the X
3191 and Y positions as well. */
3192
3193 lppos->cx -= wdiff;
3194 lppos->cy -= hdiff;
3195
3196 if (wp.showCmd != SW_SHOWMAXIMIZED
3197 && ! (lppos->flags & SWP_NOMOVE))
3198 {
3199 if (lppos->x != wr.left || lppos->y != wr.top)
3200 {
3201 lppos->x += wdiff;
3202 lppos->y += hdiff;
3203 }
3204 else
3205 {
3206 lppos->flags |= SWP_NOMOVE;
3207 }
3208 }
3209
3210 ret = 0;
3211 }
3212 }
3213 }
3214
3215 if (ret == 0) return (0);
3216
3217 goto dflt;
5ac45f98
GV
3218 case WM_EMACS_SHOWWINDOW:
3219 return ShowWindow (hwnd, wParam);
3220 case WM_EMACS_SETWINDOWPOS:
3221 {
3222 Win32WindowPos * pos = (Win32WindowPos *) wParam;
3223 return SetWindowPos (hwnd, pos->hwndAfter,
3224 pos->x, pos->y, pos->cx, pos->cy, pos->flags);
3225 }
ee78dc32
GV
3226 case WM_EMACS_DESTROYWINDOW:
3227 DestroyWindow ((HWND) wParam);
3228 break;
3229 default:
3230 dflt:
3231 return DefWindowProc (hwnd, msg, wParam, lParam);
3232 }
3233
3234 return (1);
3235}
3236
3237void
3238my_create_window (f)
3239 struct frame * f;
3240{
3241 MSG msg;
3242
3243 PostThreadMessage (dwWinThreadId, WM_EMACS_CREATEWINDOW, (WPARAM)f, 0);
3244 GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
3245}
3246
3247/* Create and set up the win32 window for frame F. */
3248
3249static void
3250win32_window (f, window_prompting, minibuffer_only)
3251 struct frame *f;
3252 long window_prompting;
3253 int minibuffer_only;
3254{
3255 BLOCK_INPUT;
3256
3257 /* Use the resource name as the top-level window name
3258 for looking up resources. Make a non-Lisp copy
3259 for the window manager, so GC relocation won't bother it.
3260
3261 Elsewhere we specify the window name for the window manager. */
3262
3263 {
3264 char *str = (char *) XSTRING (Vx_resource_name)->data;
3265 f->namebuf = (char *) xmalloc (strlen (str) + 1);
3266 strcpy (f->namebuf, str);
3267 }
3268
3269 my_create_window (f);
3270
3271 validate_x_resource_name ();
3272
3273 /* x_set_name normally ignores requests to set the name if the
3274 requested name is the same as the current name. This is the one
3275 place where that assumption isn't correct; f->name is set, but
3276 the server hasn't been told. */
3277 {
3278 Lisp_Object name;
3279 int explicit = f->explicit_name;
3280
3281 f->explicit_name = 0;
3282 name = f->name;
3283 f->name = Qnil;
3284 x_set_name (f, name, explicit);
3285 }
3286
3287 UNBLOCK_INPUT;
3288
3289 if (!minibuffer_only && FRAME_EXTERNAL_MENU_BAR (f))
3290 initialize_frame_menubar (f);
3291
3292 if (FRAME_WIN32_WINDOW (f) == 0)
3293 error ("Unable to create window");
3294}
3295
3296/* Handle the icon stuff for this window. Perhaps later we might
3297 want an x_set_icon_position which can be called interactively as
3298 well. */
3299
3300static void
3301x_icon (f, parms)
3302 struct frame *f;
3303 Lisp_Object parms;
3304{
3305 Lisp_Object icon_x, icon_y;
3306
3307 /* Set the position of the icon. Note that win95 groups all
3308 icons in the tray. */
3309 icon_x = x_get_arg (parms, Qicon_left, 0, 0, number);
3310 icon_y = x_get_arg (parms, Qicon_top, 0, 0, number);
3311 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
3312 {
3313 CHECK_NUMBER (icon_x, 0);
3314 CHECK_NUMBER (icon_y, 0);
3315 }
3316 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
3317 error ("Both left and top icon corners of icon must be specified");
3318
3319 BLOCK_INPUT;
3320
3321 if (! EQ (icon_x, Qunbound))
3322 x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y));
3323
3324 UNBLOCK_INPUT;
3325}
3326
3327DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
3328 1, 1, 0,
3329 "Make a new window, which is called a \"frame\" in Emacs terms.\n\
3330Returns an Emacs frame object.\n\
3331ALIST is an alist of frame parameters.\n\
3332If the parameters specify that the frame should not have a minibuffer,\n\
3333and do not specify a specific minibuffer window to use,\n\
3334then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
3335be shared by the new frame.\n\
3336\n\
3337This function is an internal primitive--use `make-frame' instead.")
3338 (parms)
3339 Lisp_Object parms;
3340{
3341 struct frame *f;
3342 Lisp_Object frame, tem;
3343 Lisp_Object name;
3344 int minibuffer_only = 0;
3345 long window_prompting = 0;
3346 int width, height;
3347 int count = specpdl_ptr - specpdl;
3348 struct gcpro gcpro1;
3349 Lisp_Object display;
3350 struct win32_display_info *dpyinfo;
3351 Lisp_Object parent;
3352 struct kboard *kb;
3353
3354 /* Use this general default value to start with
3355 until we know if this frame has a specified name. */
3356 Vx_resource_name = Vinvocation_name;
3357
3358 display = x_get_arg (parms, Qdisplay, 0, 0, string);
3359 if (EQ (display, Qunbound))
3360 display = Qnil;
3361 dpyinfo = check_x_display_info (display);
3362#ifdef MULTI_KBOARD
3363 kb = dpyinfo->kboard;
3364#else
3365 kb = &the_only_kboard;
3366#endif
3367
3368 name = x_get_arg (parms, Qname, "title", "Title", string);
3369 if (!STRINGP (name)
3370 && ! EQ (name, Qunbound)
3371 && ! NILP (name))
3372 error ("Invalid frame name--not a string or nil");
3373
3374 if (STRINGP (name))
3375 Vx_resource_name = name;
3376
3377 /* See if parent window is specified. */
3378 parent = x_get_arg (parms, Qparent_id, NULL, NULL, number);
3379 if (EQ (parent, Qunbound))
3380 parent = Qnil;
3381 if (! NILP (parent))
3382 CHECK_NUMBER (parent, 0);
3383
3384 tem = x_get_arg (parms, Qminibuffer, 0, 0, symbol);
3385 if (EQ (tem, Qnone) || NILP (tem))
3386 f = make_frame_without_minibuffer (Qnil, kb, display);
3387 else if (EQ (tem, Qonly))
3388 {
3389 f = make_minibuffer_frame ();
3390 minibuffer_only = 1;
3391 }
3392 else if (WINDOWP (tem))
3393 f = make_frame_without_minibuffer (tem, kb, display);
3394 else
3395 f = make_frame (1);
3396
3397 /* Note that Windows does support scroll bars. */
3398 FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
5ac45f98
GV
3399 /* By default, make scrollbars the system standard width. */
3400 f->scroll_bar_pixel_width = GetSystemMetrics (SM_CXVSCROLL);
ee78dc32
GV
3401
3402 XSETFRAME (frame, f);
3403 GCPRO1 (frame);
3404
3405 f->output_method = output_win32;
3406 f->output_data.win32 = (struct win32_output *) xmalloc (sizeof (struct win32_output));
3407 bzero (f->output_data.win32, sizeof (struct win32_output));
3408
3409/* FRAME_WIN32_DISPLAY_INFO (f) = dpyinfo; */
3410#ifdef MULTI_KBOARD
3411 FRAME_KBOARD (f) = kb;
3412#endif
3413
3414 /* Specify the parent under which to make this window. */
3415
3416 if (!NILP (parent))
3417 {
3418 f->output_data.win32->parent_desc = (Window) parent;
3419 f->output_data.win32->explicit_parent = 1;
3420 }
3421 else
3422 {
3423 f->output_data.win32->parent_desc = FRAME_WIN32_DISPLAY_INFO (f)->root_window;
3424 f->output_data.win32->explicit_parent = 0;
3425 }
3426
3427 /* Note that the frame has no physical cursor right now. */
3428 f->phys_cursor_x = -1;
3429
3430 /* Set the name; the functions to which we pass f expect the name to
3431 be set. */
3432 if (EQ (name, Qunbound) || NILP (name))
3433 {
3434 f->name = build_string (dpyinfo->win32_id_name);
3435 f->explicit_name = 0;
3436 }
3437 else
3438 {
3439 f->name = name;
3440 f->explicit_name = 1;
3441 /* use the frame's title when getting resources for this frame. */
3442 specbind (Qx_resource_name, name);
3443 }
3444
3445 /* Extract the window parameters from the supplied values
3446 that are needed to determine window geometry. */
3447 {
3448 Lisp_Object font;
3449
3450 font = x_get_arg (parms, Qfont, "font", "Font", string);
3451 BLOCK_INPUT;
3452 /* First, try whatever font the caller has specified. */
3453 if (STRINGP (font))
3454 font = x_new_font (f, XSTRING (font)->data);
3455#if 0
3456 /* Try out a font which we hope has bold and italic variations. */
3457 if (!STRINGP (font))
3458 font = x_new_font (f, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3459 if (! STRINGP (font))
3460 font = x_new_font (f, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3461 if (! STRINGP (font))
3462 /* This was formerly the first thing tried, but it finds too many fonts
3463 and takes too long. */
3464 font = x_new_font (f, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
3465 /* If those didn't work, look for something which will at least work. */
3466 if (! STRINGP (font))
3467 font = x_new_font (f, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
3468 if (! STRINGP (font))
3469 font = x_new_font (f, "-*-system-medium-r-normal-*-*-200-*-*-c-120-*-*");
3470#endif
3471 if (! STRINGP (font))
a1a80b40 3472 font = x_new_font (f, "-*-Fixedsys-*-r-*-*-12-90-*-*-c-*-*-*");
ee78dc32
GV
3473 UNBLOCK_INPUT;
3474 if (! STRINGP (font))
3475 font = build_string ("-*-system");
3476
3477 x_default_parameter (f, parms, Qfont, font,
3478 "font", "Font", string);
3479 }
3480
3481 x_default_parameter (f, parms, Qborder_width, make_number (2),
3482 "borderwidth", "BorderWidth", number);
3483 /* This defaults to 2 in order to match xterm. We recognize either
3484 internalBorderWidth or internalBorder (which is what xterm calls
3485 it). */
3486 if (NILP (Fassq (Qinternal_border_width, parms)))
3487 {
3488 Lisp_Object value;
3489
3490 value = x_get_arg (parms, Qinternal_border_width,
3491 "internalBorder", "BorderWidth", number);
3492 if (! EQ (value, Qunbound))
3493 parms = Fcons (Fcons (Qinternal_border_width, value),
3494 parms);
3495 }
3496 x_default_parameter (f, parms, Qinternal_border_width, make_number (0),
3497 "internalBorderWidth", "BorderWidth", number);
3498 x_default_parameter (f, parms, Qvertical_scroll_bars, Qt,
3499 "verticalScrollBars", "ScrollBars", boolean);
3500
3501 /* Also do the stuff which must be set before the window exists. */
3502 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
3503 "foreground", "Foreground", string);
3504 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
3505 "background", "Background", string);
3506 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
3507 "pointerColor", "Foreground", string);
3508 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
3509 "cursorColor", "Foreground", string);
3510 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
3511 "borderColor", "BorderColor", string);
3512
3513 x_default_parameter (f, parms, Qmenu_bar_lines, make_number (1),
3514 "menuBar", "MenuBar", number);
3515 x_default_parameter (f, parms, Qscroll_bar_width, Qnil,
3516 "scrollBarWidth", "ScrollBarWidth", number);
3517
3518 f->output_data.win32->dwStyle = WS_OVERLAPPEDWINDOW;
3519 f->output_data.win32->parent_desc = FRAME_WIN32_DISPLAY_INFO (f)->root_window;
3520 window_prompting = x_figure_window_size (f, parms);
3521
3522 if (window_prompting & XNegative)
3523 {
3524 if (window_prompting & YNegative)
3525 f->output_data.win32->win_gravity = SouthEastGravity;
3526 else
3527 f->output_data.win32->win_gravity = NorthEastGravity;
3528 }
3529 else
3530 {
3531 if (window_prompting & YNegative)
3532 f->output_data.win32->win_gravity = SouthWestGravity;
3533 else
3534 f->output_data.win32->win_gravity = NorthWestGravity;
3535 }
3536
3537 f->output_data.win32->size_hint_flags = window_prompting;
3538
3539 win32_window (f, window_prompting, minibuffer_only);
3540 x_icon (f, parms);
3541 init_frame_faces (f);
3542
3543 /* We need to do this after creating the window, so that the
3544 icon-creation functions can say whose icon they're describing. */
3545 x_default_parameter (f, parms, Qicon_type, Qnil,
3546 "bitmapIcon", "BitmapIcon", symbol);
3547
3548 x_default_parameter (f, parms, Qauto_raise, Qnil,
3549 "autoRaise", "AutoRaiseLower", boolean);
3550 x_default_parameter (f, parms, Qauto_lower, Qnil,
3551 "autoLower", "AutoRaiseLower", boolean);
3552 x_default_parameter (f, parms, Qcursor_type, Qbox,
3553 "cursorType", "CursorType", symbol);
3554
3555 /* Dimensions, especially f->height, must be done via change_frame_size.
3556 Change will not be effected unless different from the current
3557 f->height. */
3558 width = f->width;
3559 height = f->height;
3560 f->height = f->width = 0;
3561 change_frame_size (f, height, width, 1, 0);
3562
3563 /* Tell the server what size and position, etc, we want,
3564 and how badly we want them. */
3565 BLOCK_INPUT;
3566 x_wm_set_size_hint (f, window_prompting, 0);
3567 UNBLOCK_INPUT;
3568
3569 tem = x_get_arg (parms, Qunsplittable, 0, 0, boolean);
3570 f->no_split = minibuffer_only || EQ (tem, Qt);
3571
3572 UNGCPRO;
3573
3574 /* It is now ok to make the frame official
3575 even if we get an error below.
3576 And the frame needs to be on Vframe_list
3577 or making it visible won't work. */
3578 Vframe_list = Fcons (frame, Vframe_list);
3579
3580 /* Now that the frame is official, it counts as a reference to
3581 its display. */
3582 FRAME_WIN32_DISPLAY_INFO (f)->reference_count++;
3583
3584 /* Make the window appear on the frame and enable display,
3585 unless the caller says not to. However, with explicit parent,
3586 Emacs cannot control visibility, so don't try. */
3587 if (! f->output_data.win32->explicit_parent)
3588 {
3589 Lisp_Object visibility;
3590
3591 visibility = x_get_arg (parms, Qvisibility, 0, 0, symbol);
3592 if (EQ (visibility, Qunbound))
3593 visibility = Qt;
3594
3595 if (EQ (visibility, Qicon))
3596 x_iconify_frame (f);
3597 else if (! NILP (visibility))
3598 x_make_frame_visible (f);
3599 else
3600 /* Must have been Qnil. */
3601 ;
3602 }
3603
3604 return unbind_to (count, frame);
3605}
3606
3607/* FRAME is used only to get a handle on the X display. We don't pass the
3608 display info directly because we're called from frame.c, which doesn't
3609 know about that structure. */
3610Lisp_Object
3611x_get_focus_frame (frame)
3612 struct frame *frame;
3613{
3614 struct win32_display_info *dpyinfo = FRAME_WIN32_DISPLAY_INFO (frame);
3615 Lisp_Object xfocus;
3616 if (! dpyinfo->win32_focus_frame)
3617 return Qnil;
3618
3619 XSETFRAME (xfocus, dpyinfo->win32_focus_frame);
3620 return xfocus;
3621}
3622
3623DEFUN ("focus-frame", Ffocus_frame, Sfocus_frame, 1, 1, 0,
5ac45f98 3624 "This function is obsolete, and does nothing.")
ee78dc32
GV
3625 (frame)
3626 Lisp_Object frame;
3627{
ee78dc32
GV
3628 return Qnil;
3629}
3630
3631DEFUN ("unfocus-frame", Funfocus_frame, Sunfocus_frame, 0, 0, 0,
5ac45f98
GV
3632 "This function is obsolete, and does nothing.")
3633 ()
ee78dc32 3634{
ee78dc32
GV
3635 return Qnil;
3636}
3637\f
5ac45f98
GV
3638XFontStruct *
3639win32_load_font (dpyinfo,name)
3c190163
GV
3640struct win32_display_info *dpyinfo;
3641char * name;
ee78dc32
GV
3642{
3643 XFontStruct * font = NULL;
3644 BOOL ok;
5ac45f98 3645
3c190163
GV
3646 {
3647 LOGFONT lf;
5ac45f98
GV
3648
3649 if (!name || !x_to_win32_font (name, &lf))
3c190163 3650 return (NULL);
5ac45f98 3651
3c190163 3652 font = (XFontStruct *) xmalloc (sizeof (XFontStruct));
5ac45f98 3653
3c190163 3654 if (!font) return (NULL);
5ac45f98 3655
3c190163 3656 BLOCK_INPUT;
5ac45f98
GV
3657
3658 font->hfont = CreateFontIndirect (&lf);
ee78dc32 3659 }
ee78dc32 3660
5ac45f98
GV
3661 if (font->hfont == NULL)
3662 {
3663 ok = FALSE;
3664 }
3665 else
3666 {
3667 HDC hdc;
3668 HANDLE oldobj;
3669
3670 hdc = GetDC (dpyinfo->root_window);
3671 oldobj = SelectObject (hdc, font->hfont);
3672 ok = GetTextMetrics (hdc, &font->tm);
3673 SelectObject (hdc, oldobj);
3674 ReleaseDC (dpyinfo->root_window, hdc);
3675 }
3676
ee78dc32 3677 UNBLOCK_INPUT;
5ac45f98 3678
ee78dc32 3679 if (ok) return (font);
5ac45f98
GV
3680
3681 win32_unload_font (dpyinfo, font);
ee78dc32
GV
3682 return (NULL);
3683}
3684
3685void
3686win32_unload_font (dpyinfo, font)
3687 struct win32_display_info *dpyinfo;
3688 XFontStruct * font;
3689{
3690 if (font)
3691 {
3c190163 3692 if (font->hfont) DeleteObject(font->hfont);
ee78dc32
GV
3693 xfree (font);
3694 }
3695}
3696
3697/* The font conversion stuff between x and win32 */
3698
3699/* X font string is as follows (from faces.el)
3700 * (let ((- "[-?]")
3701 * (foundry "[^-]+")
3702 * (family "[^-]+")
3703 * (weight "\\(bold\\|demibold\\|medium\\)") ; 1
3704 * (weight\? "\\([^-]*\\)") ; 1
3705 * (slant "\\([ior]\\)") ; 2
3706 * (slant\? "\\([^-]?\\)") ; 2
3707 * (swidth "\\([^-]*\\)") ; 3
3708 * (adstyle "[^-]*") ; 4
3709 * (pixelsize "[0-9]+")
3710 * (pointsize "[0-9][0-9]+")
3711 * (resx "[0-9][0-9]+")
3712 * (resy "[0-9][0-9]+")
3713 * (spacing "[cmp?*]")
3714 * (avgwidth "[0-9]+")
3715 * (registry "[^-]+")
3716 * (encoding "[^-]+")
3717 * )
3718 * (setq x-font-regexp
3719 * (concat "\\`\\*?[-?*]"
3720 * foundry - family - weight\? - slant\? - swidth - adstyle -
3721 * pixelsize - pointsize - resx - resy - spacing - registry -
3722 * encoding "[-?*]\\*?\\'"
3723 * ))
3724 * (setq x-font-regexp-head
3725 * (concat "\\`[-?*]" foundry - family - weight\? - slant\?
3726 * "\\([-*?]\\|\\'\\)"))
3727 * (setq x-font-regexp-slant (concat - slant -))
3728 * (setq x-font-regexp-weight (concat - weight -))
3729 * nil)
3730 */
3731
3732#define FONT_START "[-?]"
3733#define FONT_FOUNDRY "[^-]+"
3734#define FONT_FAMILY "\\([^-]+\\)" /* 1 */
3735#define FONT_WEIGHT "\\(bold\\|demibold\\|medium\\)" /* 2 */
3736#define FONT_WEIGHT_Q "\\([^-]*\\)" /* 2 */
3737#define FONT_SLANT "\\([ior]\\)" /* 3 */
3738#define FONT_SLANT_Q "\\([^-]?\\)" /* 3 */
3739#define FONT_SWIDTH "\\([^-]*\\)" /* 4 */
3740#define FONT_ADSTYLE "[^-]*"
3741#define FONT_PIXELSIZE "[^-]*"
3742#define FONT_POINTSIZE "\\([0-9][0-9]+\\|\\*\\)" /* 5 */
3743#define FONT_RESX "[0-9][0-9]+"
3744#define FONT_RESY "[0-9][0-9]+"
3745#define FONT_SPACING "[cmp?*]"
3746#define FONT_AVGWIDTH "[0-9]+"
3747#define FONT_REGISTRY "[^-]+"
3748#define FONT_ENCODING "[^-]+"
3749
3750#define FONT_REGEXP ("\\`\\*?[-?*]" \
3751 FONT_FOUNDRY "-" \
3752 FONT_FAMILY "-" \
3753 FONT_WEIGHT_Q "-" \
3754 FONT_SLANT_Q "-" \
3755 FONT_SWIDTH "-" \
3756 FONT_ADSTYLE "-" \
3757 FONT_PIXELSIZE "-" \
3758 FONT_POINTSIZE "-" \
3759 "[-?*]\\|\\'")
3760
3761#define FONT_REGEXP_HEAD ("\\`[-?*]" \
3762 FONT_FOUNDRY "-" \
3763 FONT_FAMILY "-" \
3764 FONT_WEIGHT_Q "-" \
3765 FONT_SLANT_Q \
3766 "\\([-*?]\\|\\'\\)")
3767
3768#define FONT_REGEXP_SLANT "-" FONT_SLANT "-"
3769#define FONT_REGEXP_WEIGHT "-" FONT_WEIGHT "-"
3770
3771LONG
3772x_to_win32_weight (lpw)
3773 char * lpw;
3774{
3775 if (!lpw) return (FW_DONTCARE);
5ac45f98
GV
3776
3777 if (stricmp (lpw,"heavy") == 0) return FW_HEAVY;
3778 else if (stricmp (lpw,"extrabold") == 0) return FW_EXTRABOLD;
3779 else if (stricmp (lpw,"bold") == 0) return FW_BOLD;
3780 else if (stricmp (lpw,"demibold") == 0) return FW_SEMIBOLD;
3781 else if (stricmp (lpw,"medium") == 0) return FW_MEDIUM;
3782 else if (stricmp (lpw,"normal") == 0) return FW_NORMAL;
3783 else if (stricmp (lpw,"light") == 0) return FW_LIGHT;
3784 else if (stricmp (lpw,"extralight") == 0) return FW_EXTRALIGHT;
3785 else if (stricmp (lpw,"thin") == 0) return FW_THIN;
ee78dc32 3786 else
5ac45f98 3787 return FW_DONTCARE;
ee78dc32
GV
3788}
3789
5ac45f98 3790
ee78dc32
GV
3791char *
3792win32_to_x_weight (fnweight)
3793 int fnweight;
3794{
5ac45f98
GV
3795 if (fnweight >= FW_HEAVY) return "heavy";
3796 if (fnweight >= FW_EXTRABOLD) return "extrabold";
3797 if (fnweight >= FW_BOLD) return "bold";
3798 if (fnweight >= FW_SEMIBOLD) return "semibold";
3799 if (fnweight >= FW_MEDIUM) return "medium";
3800 if (fnweight >= FW_NORMAL) return "normal";
3801 if (fnweight >= FW_LIGHT) return "light";
3802 if (fnweight >= FW_EXTRALIGHT) return "extralight";
3803 if (fnweight >= FW_THIN) return "thin";
3804 else
3805 return "*";
3806}
3807
3808LONG
3809x_to_win32_charset (lpcs)
3810 char * lpcs;
3811{
3812 if (!lpcs) return (0);
3813
3814 if (stricmp (lpcs,"ansi") == 0) return ANSI_CHARSET;
3815 else if (stricmp (lpcs,"iso8859-1") == 0) return ANSI_CHARSET;
3816 else if (stricmp (lpcs,"iso8859") == 0) return ANSI_CHARSET;
3817 else if (stricmp (lpcs,"oem") == 0) return OEM_CHARSET;
3818#ifdef UNICODE_CHARSET
3819 else if (stricmp (lpcs,"unicode") == 0) return UNICODE_CHARSET;
3820 else if (stricmp (lpcs,"iso10646") == 0) return UNICODE_CHARSET;
3821#endif
3822 else
3823 return 0;
3824}
3825
3826char *
3827win32_to_x_charset (fncharset)
3828 int fncharset;
3829{
3830 switch (fncharset)
3831 {
3832 case ANSI_CHARSET: return "ansi";
3833 case OEM_CHARSET: return "oem";
3834 case SYMBOL_CHARSET: return "symbol";
3835#ifdef UNICODE_CHARSET
3836 case UNICODE_CHARSET: return "unicode";
3837#endif
3838 }
3839 return "*";
ee78dc32
GV
3840}
3841
3842BOOL
3843win32_to_x_font (lplogfont, lpxstr, len)
3844 LOGFONT * lplogfont;
3845 char * lpxstr;
3846 int len;
3847{
3cb20f4a
RS
3848 char height_pixels[8];
3849 char height_dpi[8];
3850 char width_pixels[8];
3851
3852 if (!lpxstr) abort ();
ee78dc32 3853
3cb20f4a
RS
3854 if (!lplogfont)
3855 return FALSE;
3856
3857 if (lplogfont->lfHeight)
ee78dc32 3858 {
3cb20f4a
RS
3859 sprintf (height_pixels, "%u", abs (lplogfont->lfHeight));
3860 sprintf (height_dpi, "%u",
3861 (abs (lplogfont->lfHeight) * 720) / one_win32_display_info.height_in);
5ac45f98
GV
3862 }
3863 else
ee78dc32 3864 {
3cb20f4a
RS
3865 strcpy (height_pixels, "*");
3866 strcpy (height_dpi, "*");
ee78dc32 3867 }
3cb20f4a
RS
3868 if (lplogfont->lfWidth)
3869 sprintf (width_pixels, "%u", lplogfont->lfWidth * 10);
3870 else
3871 strcpy (width_pixels, "*");
3872
3873 _snprintf (lpxstr, len - 1,
3874 "-*-%s-%s-%c-*-*-%s-%s-*-*-%c-%s-*-%s-",
3875 lplogfont->lfFaceName,
3876 win32_to_x_weight (lplogfont->lfWeight),
3877 lplogfont->lfItalic?'i':'r',
3878 height_pixels,
3879 height_dpi,
3880 ((lplogfont->lfPitchAndFamily & 0x3) == VARIABLE_PITCH) ? 'p' : 'c',
3881 width_pixels,
3882 win32_to_x_charset (lplogfont->lfCharSet)
3883 );
3884
ee78dc32
GV
3885 lpxstr[len - 1] = 0; /* just to be sure */
3886 return (TRUE);
3887}
3888
3889BOOL
3890x_to_win32_font (lpxstr, lplogfont)
3891 char * lpxstr;
3892 LOGFONT * lplogfont;
3893{
3894 if (!lplogfont) return (FALSE);
3895
3896 memset (lplogfont, 0, sizeof (*lplogfont));
5ac45f98
GV
3897
3898#if 0
ee78dc32
GV
3899 lplogfont->lfOutPrecision = OUT_DEFAULT_PRECIS;
3900 lplogfont->lfClipPrecision = CLIP_DEFAULT_PRECIS;
3901 lplogfont->lfQuality = DEFAULT_QUALITY;
5ac45f98
GV
3902#else
3903 /* go for maximum quality */
3904 lplogfont->lfOutPrecision = OUT_STROKE_PRECIS;
3905 lplogfont->lfClipPrecision = CLIP_STROKE_PRECIS;
3906 lplogfont->lfQuality = PROOF_QUALITY;
3907#endif
3908
3909 if (!lpxstr)
3910 return FALSE;
3911
3912 /* Provide a simple escape mechanism for specifying Windows font names
3913 * directly -- if font spec does not beginning with '-', assume this
3914 * format:
3915 * "<font name>[:height in pixels[:width in pixels[:weight]]]"
3916 */
ee78dc32 3917
5ac45f98
GV
3918 if (*lpxstr == '-')
3919 {
3920 int fields;
3921 char name[50], weight[20], slant, pitch, pixels[10], height[10], width[10], remainder[20];
3922 char * encoding;
3923
3924 fields = sscanf (lpxstr,
3925 "-%*[^-]-%49[^-]-%19[^-]-%c-%*[^-]-%*[^-]-%9[^-]-%9[^-]-%*[^-]-%*[^-]-%c-%9[^-]-%19s",
3926 name, weight, &slant, pixels, height, &pitch, width, remainder);
3927
3928 if (fields == EOF) return (FALSE);
3929
3930 if (fields > 0 && name[0] != '*')
3931 {
3932 strncpy (lplogfont->lfFaceName,name, LF_FACESIZE);
3933 lplogfont->lfFaceName[LF_FACESIZE-1] = 0;
3934 }
3935 else
3936 {
3937 lplogfont->lfFaceName[0] = 0;
3938 }
3939
3940 fields--;
3941
3942 lplogfont->lfWeight = x_to_win32_weight ((fields > 0 ? weight : ""));
3943
3944 fields--;
3945
3946 if (!NILP (Vwin32_enable_italics))
3947 lplogfont->lfItalic = (fields > 0 && slant == 'i');
3948
3949 fields--;
3950
3951 if (fields > 0 && pixels[0] != '*')
3952 lplogfont->lfHeight = atoi (pixels);
3953
3954 fields--;
3955
3956 if (fields > 0 && lplogfont->lfHeight == 0 && height[0] != '*')
3957 lplogfont->lfHeight = (atoi (height)
3958 * one_win32_display_info.height_in) / 720;
3959
3960 fields--;
3961
3962 lplogfont->lfPitchAndFamily =
3963 (fields > 0 && pitch == 'p') ? VARIABLE_PITCH : FIXED_PITCH;
3964
3965 fields--;
3966
3967 if (fields > 0 && width[0] != '*')
3968 lplogfont->lfWidth = atoi (width) / 10;
3969
3970 fields--;
3971
3972 /* Not all font specs include the registry field, so we allow for an
3973 optional registry field before the encoding when parsing
3974 remainder. Also we strip the trailing '-' if present. */
3c190163 3975 {
5ac45f98
GV
3976 int len = strlen (remainder);
3977 if (len > 0 && remainder[len-1] == '-')
3978 remainder[len-1] = 0;
ee78dc32 3979 }
5ac45f98
GV
3980 encoding = remainder;
3981 if (strncmp (encoding, "*-", 2) == 0)
3982 encoding += 2;
3983 lplogfont->lfCharSet = x_to_win32_charset (fields > 0 ? encoding : "");
3984 }
3985 else
3986 {
3987 int fields;
3988 char name[100], height[10], width[10], weight[20];
a1a80b40 3989
5ac45f98
GV
3990 fields = sscanf (lpxstr,
3991 "%99[^:]:%9[^:]:%9[^:]:%19s",
3992 name, height, width, weight);
3993
3994 if (fields == EOF) return (FALSE);
3995
3996 if (fields > 0)
3997 {
3998 strncpy (lplogfont->lfFaceName,name, LF_FACESIZE);
3999 lplogfont->lfFaceName[LF_FACESIZE-1] = 0;
4000 }
4001 else
4002 {
4003 lplogfont->lfFaceName[0] = 0;
4004 }
4005
4006 fields--;
4007
4008 if (fields > 0)
4009 lplogfont->lfHeight = atoi (height);
4010
4011 fields--;
4012
4013 if (fields > 0)
4014 lplogfont->lfWidth = atoi (width);
4015
4016 fields--;
4017
4018 lplogfont->lfWeight = x_to_win32_weight ((fields > 0 ? weight : ""));
4019 }
4020
4021 /* This makes TrueType fonts work better. */
4022 lplogfont->lfHeight = - abs (lplogfont->lfHeight);
ee78dc32
GV
4023
4024 return (TRUE);
4025}
4026
4027BOOL
4028win32_font_match (lpszfont1, lpszfont2)
4029 char * lpszfont1;
4030 char * lpszfont2;
4031{
4032 char * s1 = lpszfont1, *e1;
4033 char * s2 = lpszfont2, *e2;
4034
4035 if (s1 == NULL || s2 == NULL) return (FALSE);
4036
4037 if (*s1 == '-') s1++;
4038 if (*s2 == '-') s2++;
4039
4040 while (1)
4041 {
4042 int len1, len2;
4043
4044 e1 = strchr (s1, '-');
4045 e2 = strchr (s2, '-');
4046
4047 if (e1 == NULL || e2 == NULL) return (TRUE);
4048
4049 len1 = e1 - s1;
4050 len2 = e2 - s2;
4051
4052 if (*s1 != '*' && *s2 != '*'
4053 && (len1 != len2 || strnicmp (s1, s2, len1) != 0))
4054 return (FALSE);
4055
4056 s1 = e1 + 1;
4057 s2 = e2 + 1;
4058 }
4059}
4060
4061typedef struct enumfont_t
4062{
4063 HDC hdc;
4064 int numFonts;
3cb20f4a 4065 LOGFONT logfont;
ee78dc32
GV
4066 XFontStruct *size_ref;
4067 Lisp_Object *pattern;
4068 Lisp_Object *head;
4069 Lisp_Object *tail;
4070} enumfont_t;
4071
4072int CALLBACK
4073enum_font_cb2 (lplf, lptm, FontType, lpef)
4074 ENUMLOGFONT * lplf;
4075 NEWTEXTMETRIC * lptm;
4076 int FontType;
4077 enumfont_t * lpef;
4078{
4079 if (lplf->elfLogFont.lfStrikeOut || lplf->elfLogFont.lfUnderline
4080 || (lplf->elfLogFont.lfCharSet != ANSI_CHARSET && lplf->elfLogFont.lfCharSet != OEM_CHARSET))
4081 return (1);
4082
4083 /* if (!lpef->size_ref || lptm->tmMaxCharWidth == FONT_WIDTH (lpef->size_ref)) */
4084 {
4085 char buf[100];
4086
3cb20f4a
RS
4087 if (!NILP (*(lpef->pattern)) && FontType == TRUETYPE_FONTTYPE)
4088 {
4089 lplf->elfLogFont.lfHeight = lpef->logfont.lfHeight;
4090 lplf->elfLogFont.lfWidth = lpef->logfont.lfWidth;
4091 }
4092
ee78dc32
GV
4093 if (!win32_to_x_font (lplf, buf, 100)) return (0);
4094
4095 if (NILP (*(lpef->pattern)) || win32_font_match (buf, XSTRING (*(lpef->pattern))->data))
4096 {
4097 *lpef->tail = Fcons (build_string (buf), Qnil);
4098 lpef->tail = &XCONS (*lpef->tail)->cdr;
4099 lpef->numFonts++;
4100 }
4101 }
4102
4103 return (1);
4104}
4105
4106int CALLBACK
4107enum_font_cb1 (lplf, lptm, FontType, lpef)
4108 ENUMLOGFONT * lplf;
4109 NEWTEXTMETRIC * lptm;
4110 int FontType;
4111 enumfont_t * lpef;
4112{
4113 return EnumFontFamilies (lpef->hdc,
4114 lplf->elfLogFont.lfFaceName,
4115 (FONTENUMPROC) enum_font_cb2,
4116 (LPARAM) lpef);
4117}
4118
4119
4120DEFUN ("x-list-fonts", Fx_list_fonts, Sx_list_fonts, 1, 3, 0,
4121 "Return a list of the names of available fonts matching PATTERN.\n\
4122If optional arguments FACE and FRAME are specified, return only fonts\n\
4123the same size as FACE on FRAME.\n\
4124\n\
4125PATTERN is a string, perhaps with wildcard characters;\n\
4126 the * character matches any substring, and\n\
4127 the ? character matches any single character.\n\
4128 PATTERN is case-insensitive.\n\
4129FACE is a face name--a symbol.\n\
4130\n\
4131The return value is a list of strings, suitable as arguments to\n\
4132set-face-font.\n\
4133\n\
4134Fonts Emacs can't use (i.e. proportional fonts) may or may not be excluded\n\
4135even if they match PATTERN and FACE.")
4136 (pattern, face, frame)
4137 Lisp_Object pattern, face, frame;
4138{
4139 int num_fonts;
4140 char **names;
4141 XFontStruct *info;
4142 XFontStruct *size_ref;
4143 Lisp_Object namelist;
4144 Lisp_Object list;
4145 FRAME_PTR f;
4146 enumfont_t ef;
4147
4148 CHECK_STRING (pattern, 0);
4149 if (!NILP (face))
4150 CHECK_SYMBOL (face, 1);
4151
4152 f = check_x_frame (frame);
4153
4154 /* Determine the width standard for comparison with the fonts we find. */
4155
4156 if (NILP (face))
4157 size_ref = 0;
4158 else
4159 {
4160 int face_id;
4161
4162 /* Don't die if we get called with a terminal frame. */
4163 if (! FRAME_WIN32_P (f))
4164 error ("non-win32 frame used in `x-list-fonts'");
4165
4166 face_id = face_name_id_number (f, face);
4167
4168 if (face_id < 0 || face_id >= FRAME_N_PARAM_FACES (f)
4169 || FRAME_PARAM_FACES (f) [face_id] == 0)
4170 size_ref = f->output_data.win32->font;
4171 else
4172 {
4173 size_ref = FRAME_PARAM_FACES (f) [face_id]->font;
4174 if (size_ref == (XFontStruct *) (~0))
4175 size_ref = f->output_data.win32->font;
4176 }
4177 }
4178
4179 /* See if we cached the result for this particular query. */
4180 list = Fassoc (pattern,
4181 XCONS (FRAME_WIN32_DISPLAY_INFO (f)->name_list_element)->cdr);
4182
4183 /* We have info in the cache for this PATTERN. */
4184 if (!NILP (list))
4185 {
4186 Lisp_Object tem, newlist;
4187
4188 /* We have info about this pattern. */
4189 list = XCONS (list)->cdr;
4190
4191 if (size_ref == 0)
4192 return list;
4193
4194 BLOCK_INPUT;
4195
4196 /* Filter the cached info and return just the fonts that match FACE. */
4197 newlist = Qnil;
4198 for (tem = list; CONSP (tem); tem = XCONS (tem)->cdr)
4199 {
4200 XFontStruct *thisinfo;
4201
4202 thisinfo = win32_load_font (FRAME_WIN32_DISPLAY_INFO (f), XSTRING (XCONS (tem)->car)->data);
4203
4204 if (thisinfo && same_size_fonts (thisinfo, size_ref))
4205 newlist = Fcons (XCONS (tem)->car, newlist);
4206
4207 win32_unload_font (FRAME_WIN32_DISPLAY_INFO (f), thisinfo);
4208 }
4209
4210 UNBLOCK_INPUT;
4211
4212 return newlist;
4213 }
4214
4215 BLOCK_INPUT;
4216
4217 namelist = Qnil;
4218 ef.pattern = &pattern;
4219 ef.tail = ef.head = &namelist;
4220 ef.numFonts = 0;
3cb20f4a 4221 x_to_win32_font (STRINGP (pattern) ? XSTRING (pattern)->data : NULL, &ef.logfont);
ee78dc32
GV
4222
4223 {
5ac45f98 4224 ef.hdc = GetDC (FRAME_WIN32_WINDOW (f));
ee78dc32
GV
4225
4226 EnumFontFamilies (ef.hdc, NULL, (FONTENUMPROC) enum_font_cb1, (LPARAM)&ef);
4227
4228 ReleaseDC (FRAME_WIN32_WINDOW (f), ef.hdc);
4229 }
4230
4231 UNBLOCK_INPUT;
4232
4233 if (ef.numFonts)
4234 {
4235 int i;
4236 Lisp_Object cur;
4237
4238 /* Make a list of all the fonts we got back.
4239 Store that in the font cache for the display. */
4240 XCONS (FRAME_WIN32_DISPLAY_INFO (f)->name_list_element)->cdr
4241 = Fcons (Fcons (pattern, namelist),
4242 XCONS (FRAME_WIN32_DISPLAY_INFO (f)->name_list_element)->cdr);
4243
4244 /* Make a list of the fonts that have the right width. */
4245 list = Qnil;
4246 cur=namelist;
4247 for (i = 0; i < ef.numFonts; i++)
4248 {
4249 int keeper;
4250
4251 if (!size_ref)
4252 keeper = 1;
4253 else
4254 {
4255 XFontStruct *thisinfo;
4256
4257 BLOCK_INPUT;
4258 thisinfo = win32_load_font (FRAME_WIN32_DISPLAY_INFO (f), XSTRING (Fcar (cur))->data);
4259
4260 keeper = thisinfo && same_size_fonts (thisinfo, size_ref);
4261
4262 win32_unload_font (FRAME_WIN32_DISPLAY_INFO (f), thisinfo);
4263
4264 UNBLOCK_INPUT;
4265 }
4266 if (keeper)
4267 list = Fcons (build_string (XSTRING (Fcar (cur))->data), list);
4268
4269 cur = Fcdr (cur);
4270 }
4271 list = Fnreverse (list);
4272 }
4273
4274 return list;
4275}
4276\f
4277DEFUN ("x-color-defined-p", Fx_color_defined_p, Sx_color_defined_p, 1, 2, 0,
4278 "Return non-nil if color COLOR is supported on frame FRAME.\n\
4279If FRAME is omitted or nil, use the selected frame.")
4280 (color, frame)
4281 Lisp_Object color, frame;
4282{
4283 COLORREF foo;
4284 FRAME_PTR f = check_x_frame (frame);
4285
4286 CHECK_STRING (color, 1);
4287
4288 if (defined_color (f, XSTRING (color)->data, &foo, 0))
4289 return Qt;
4290 else
4291 return Qnil;
4292}
4293
4294DEFUN ("x-color-values", Fx_color_values, Sx_color_values, 1, 2, 0,
4295 "Return a description of the color named COLOR on frame FRAME.\n\
4296The value is a list of integer RGB values--(RED GREEN BLUE).\n\
4297These values appear to range from 0 to 65280 or 65535, depending\n\
4298on the system; white is (65280 65280 65280) or (65535 65535 65535).\n\
4299If FRAME is omitted or nil, use the selected frame.")
4300 (color, frame)
4301 Lisp_Object color, frame;
4302{
4303 COLORREF foo;
4304 FRAME_PTR f = check_x_frame (frame);
4305
4306 CHECK_STRING (color, 1);
4307
4308 if (defined_color (f, XSTRING (color)->data, &foo, 0))
4309 {
4310 Lisp_Object rgb[3];
4311
4312 rgb[0] = make_number (GetRValue (foo));
4313 rgb[1] = make_number (GetGValue (foo));
4314 rgb[2] = make_number (GetBValue (foo));
4315 return Flist (3, rgb);
4316 }
4317 else
4318 return Qnil;
4319}
4320
4321DEFUN ("x-display-color-p", Fx_display_color_p, Sx_display_color_p, 0, 1, 0,
4322 "Return t if the X display supports color.\n\
4323The optional argument DISPLAY specifies which display to ask about.\n\
4324DISPLAY should be either a frame or a display name (a string).\n\
4325If omitted or nil, that stands for the selected frame's display.")
4326 (display)
4327 Lisp_Object display;
4328{
4329 struct win32_display_info *dpyinfo = check_x_display_info (display);
4330
4331 if ((dpyinfo->n_planes * dpyinfo->n_cbits) <= 2)
4332 return Qnil;
4333
4334 return Qt;
4335}
4336
4337DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p, Sx_display_grayscale_p,
4338 0, 1, 0,
4339 "Return t if the X display supports shades of gray.\n\
4340Note that color displays do support shades of gray.\n\
4341The optional argument DISPLAY specifies which display to ask about.\n\
4342DISPLAY should be either a frame or a display name (a string).\n\
4343If omitted or nil, that stands for the selected frame's display.")
4344 (display)
4345 Lisp_Object display;
4346{
4347 struct win32_display_info *dpyinfo = check_x_display_info (display);
4348
4349 if ((dpyinfo->n_planes * dpyinfo->n_cbits) <= 1)
4350 return Qnil;
4351
4352 return Qt;
4353}
4354
4355DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width,
4356 0, 1, 0,
4357 "Returns the width in pixels of the X display DISPLAY.\n\
4358The optional argument DISPLAY specifies which display to ask about.\n\
4359DISPLAY should be either a frame or a display name (a string).\n\
4360If omitted or nil, that stands for the selected frame's display.")
4361 (display)
4362 Lisp_Object display;
4363{
4364 struct win32_display_info *dpyinfo = check_x_display_info (display);
4365
4366 return make_number (dpyinfo->width);
4367}
4368
4369DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
4370 Sx_display_pixel_height, 0, 1, 0,
4371 "Returns the height in pixels of the X display DISPLAY.\n\
4372The optional argument DISPLAY specifies which display to ask about.\n\
4373DISPLAY should be either a frame or a display name (a string).\n\
4374If omitted or nil, that stands for the selected frame's display.")
4375 (display)
4376 Lisp_Object display;
4377{
4378 struct win32_display_info *dpyinfo = check_x_display_info (display);
4379
4380 return make_number (dpyinfo->height);
4381}
4382
4383DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
4384 0, 1, 0,
4385 "Returns the number of bitplanes of the display DISPLAY.\n\
4386The optional argument DISPLAY specifies which display to ask about.\n\
4387DISPLAY should be either a frame or a display name (a string).\n\
4388If omitted or nil, that stands for the selected frame's display.")
4389 (display)
4390 Lisp_Object display;
4391{
4392 struct win32_display_info *dpyinfo = check_x_display_info (display);
4393
4394 return make_number (dpyinfo->n_planes * dpyinfo->n_cbits);
4395}
4396
4397DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
4398 0, 1, 0,
4399 "Returns the number of color cells of the display DISPLAY.\n\
4400The optional argument DISPLAY specifies which display to ask about.\n\
4401DISPLAY should be either a frame or a display name (a string).\n\
4402If omitted or nil, that stands for the selected frame's display.")
4403 (display)
4404 Lisp_Object display;
4405{
4406 struct win32_display_info *dpyinfo = check_x_display_info (display);
4407 HDC hdc;
4408 int cap;
4409
5ac45f98
GV
4410 hdc = GetDC (dpyinfo->root_window);
4411 if (dpyinfo->has_palette)
4412 cap = GetDeviceCaps (hdc,SIZEPALETTE);
4413 else
4414 cap = GetDeviceCaps (hdc,NUMCOLORS);
ee78dc32
GV
4415
4416 ReleaseDC (dpyinfo->root_window, hdc);
4417
4418 return make_number (cap);
4419}
4420
4421DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
4422 Sx_server_max_request_size,
4423 0, 1, 0,
4424 "Returns the maximum request size of the server of display DISPLAY.\n\
4425The optional argument DISPLAY specifies which display to ask about.\n\
4426DISPLAY should be either a frame or a display name (a string).\n\
4427If omitted or nil, that stands for the selected frame's display.")
4428 (display)
4429 Lisp_Object display;
4430{
4431 struct win32_display_info *dpyinfo = check_x_display_info (display);
4432
4433 return make_number (1);
4434}
4435
4436DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
4437 "Returns the vendor ID string of the Win32 system (Microsoft).\n\
4438The optional argument DISPLAY specifies which display to ask about.\n\
4439DISPLAY should be either a frame or a display name (a string).\n\
4440If omitted or nil, that stands for the selected frame's display.")
4441 (display)
4442 Lisp_Object display;
4443{
4444 struct win32_display_info *dpyinfo = check_x_display_info (display);
4445 char *vendor = "Microsoft Corp.";
4446
4447 if (! vendor) vendor = "";
4448 return build_string (vendor);
4449}
4450
4451DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
4452 "Returns the version numbers of the server of display DISPLAY.\n\
4453The value is a list of three integers: the major and minor\n\
4454version numbers, and the vendor-specific release\n\
4455number. See also the function `x-server-vendor'.\n\n\
4456The optional argument DISPLAY specifies which display to ask about.\n\
4457DISPLAY should be either a frame or a display name (a string).\n\
4458If omitted or nil, that stands for the selected frame's display.")
4459 (display)
4460 Lisp_Object display;
4461{
4462 struct win32_display_info *dpyinfo = check_x_display_info (display);
4463
4464 return Fcons (make_number (nt_major_version),
4465 Fcons (make_number (nt_minor_version), Qnil));
4466}
4467
4468DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
4469 "Returns the number of screens on the server of display DISPLAY.\n\
4470The optional argument DISPLAY specifies which display to ask about.\n\
4471DISPLAY should be either a frame or a display name (a string).\n\
4472If omitted or nil, that stands for the selected frame's display.")
4473 (display)
4474 Lisp_Object display;
4475{
4476 struct win32_display_info *dpyinfo = check_x_display_info (display);
4477
4478 return make_number (1);
4479}
4480
4481DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, 0,
4482 "Returns the height in millimeters of the X display DISPLAY.\n\
4483The optional argument DISPLAY specifies which display to ask about.\n\
4484DISPLAY should be either a frame or a display name (a string).\n\
4485If omitted or nil, that stands for the selected frame's display.")
4486 (display)
4487 Lisp_Object display;
4488{
4489 struct win32_display_info *dpyinfo = check_x_display_info (display);
4490 HDC hdc;
4491 int cap;
4492
5ac45f98 4493 hdc = GetDC (dpyinfo->root_window);
3c190163 4494
ee78dc32 4495 cap = GetDeviceCaps (hdc, VERTSIZE);
3c190163 4496
ee78dc32
GV
4497 ReleaseDC (dpyinfo->root_window, hdc);
4498
4499 return make_number (cap);
4500}
4501
4502DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
4503 "Returns the width in millimeters of the X display DISPLAY.\n\
4504The optional argument DISPLAY specifies which display to ask about.\n\
4505DISPLAY should be either a frame or a display name (a string).\n\
4506If omitted or nil, that stands for the selected frame's display.")
4507 (display)
4508 Lisp_Object display;
4509{
4510 struct win32_display_info *dpyinfo = check_x_display_info (display);
4511
4512 HDC hdc;
4513 int cap;
4514
5ac45f98 4515 hdc = GetDC (dpyinfo->root_window);
3c190163 4516
ee78dc32 4517 cap = GetDeviceCaps (hdc, HORZSIZE);
3c190163 4518
ee78dc32
GV
4519 ReleaseDC (dpyinfo->root_window, hdc);
4520
4521 return make_number (cap);
4522}
4523
4524DEFUN ("x-display-backing-store", Fx_display_backing_store,
4525 Sx_display_backing_store, 0, 1, 0,
4526 "Returns an indication of whether display DISPLAY does backing store.\n\
4527The value may be `always', `when-mapped', or `not-useful'.\n\
4528The optional argument DISPLAY specifies which display to ask about.\n\
4529DISPLAY should be either a frame or a display name (a string).\n\
4530If omitted or nil, that stands for the selected frame's display.")
4531 (display)
4532 Lisp_Object display;
4533{
4534 return intern ("not-useful");
4535}
4536
4537DEFUN ("x-display-visual-class", Fx_display_visual_class,
4538 Sx_display_visual_class, 0, 1, 0,
4539 "Returns the visual class of the display DISPLAY.\n\
4540The value is one of the symbols `static-gray', `gray-scale',\n\
4541`static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
4542The optional argument DISPLAY specifies which display to ask about.\n\
4543DISPLAY should be either a frame or a display name (a string).\n\
4544If omitted or nil, that stands for the selected frame's display.")
4545 (display)
4546 Lisp_Object display;
4547{
4548 struct win32_display_info *dpyinfo = check_x_display_info (display);
4549
4550#if 0
4551 switch (dpyinfo->visual->class)
4552 {
4553 case StaticGray: return (intern ("static-gray"));
4554 case GrayScale: return (intern ("gray-scale"));
4555 case StaticColor: return (intern ("static-color"));
4556 case PseudoColor: return (intern ("pseudo-color"));
4557 case TrueColor: return (intern ("true-color"));
4558 case DirectColor: return (intern ("direct-color"));
4559 default:
4560 error ("Display has an unknown visual class");
4561 }
4562#endif
4563
4564 error ("Display has an unknown visual class");
4565}
4566
4567DEFUN ("x-display-save-under", Fx_display_save_under,
4568 Sx_display_save_under, 0, 1, 0,
4569 "Returns t if the display DISPLAY supports the save-under feature.\n\
4570The optional argument DISPLAY specifies which display to ask about.\n\
4571DISPLAY should be either a frame or a display name (a string).\n\
4572If omitted or nil, that stands for the selected frame's display.")
4573 (display)
4574 Lisp_Object display;
4575{
4576 struct win32_display_info *dpyinfo = check_x_display_info (display);
4577
4578 return Qnil;
4579}
4580\f
4581int
4582x_pixel_width (f)
4583 register struct frame *f;
4584{
4585 return PIXEL_WIDTH (f);
4586}
4587
4588int
4589x_pixel_height (f)
4590 register struct frame *f;
4591{
4592 return PIXEL_HEIGHT (f);
4593}
4594
4595int
4596x_char_width (f)
4597 register struct frame *f;
4598{
4599 return FONT_WIDTH (f->output_data.win32->font);
4600}
4601
4602int
4603x_char_height (f)
4604 register struct frame *f;
4605{
4606 return f->output_data.win32->line_height;
4607}
4608
4609int
4610x_screen_planes (frame)
4611 Lisp_Object frame;
4612{
4613 return (FRAME_WIN32_DISPLAY_INFO (XFRAME (frame))->n_planes *
4614 FRAME_WIN32_DISPLAY_INFO (XFRAME (frame))->n_cbits);
4615}
4616\f
4617/* Return the display structure for the display named NAME.
4618 Open a new connection if necessary. */
4619
4620struct win32_display_info *
4621x_display_info_for_name (name)
4622 Lisp_Object name;
4623{
4624 Lisp_Object names;
4625 struct win32_display_info *dpyinfo;
4626
4627 CHECK_STRING (name, 0);
4628
4629 for (dpyinfo = &one_win32_display_info, names = win32_display_name_list;
4630 dpyinfo;
4631 dpyinfo = dpyinfo->next, names = XCONS (names)->cdr)
4632 {
4633 Lisp_Object tem;
4634 tem = Fstring_equal (XCONS (XCONS (names)->car)->car, name);
4635 if (!NILP (tem))
4636 return dpyinfo;
4637 }
4638
4639 /* Use this general default value to start with. */
4640 Vx_resource_name = Vinvocation_name;
4641
4642 validate_x_resource_name ();
4643
4644 dpyinfo = win32_term_init (name, (unsigned char *)0,
4645 (char *) XSTRING (Vx_resource_name)->data);
4646
4647 if (dpyinfo == 0)
4648 error ("Cannot connect to server %s", XSTRING (name)->data);
4649
4650 XSETFASTINT (Vwindow_system_version, 3);
4651
4652 return dpyinfo;
4653}
4654
4655DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
4656 1, 3, 0, "Open a connection to a server.\n\
4657DISPLAY is the name of the display to connect to.\n\
4658Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
4659If the optional third arg MUST-SUCCEED is non-nil,\n\
4660terminate Emacs if we can't open the connection.")
4661 (display, xrm_string, must_succeed)
4662 Lisp_Object display, xrm_string, must_succeed;
4663{
4664 unsigned int n_planes;
4665 unsigned char *xrm_option;
4666 struct win32_display_info *dpyinfo;
4667
4668 CHECK_STRING (display, 0);
4669 if (! NILP (xrm_string))
4670 CHECK_STRING (xrm_string, 1);
4671
5ac45f98
GV
4672 /* Allow color mapping to be defined externally; first look in user's
4673 HOME directory, then in Emacs etc dir for a file called rgb.txt. */
4674 {
4675 Lisp_Object color_file;
4676 struct gcpro gcpro1;
4677
4678 color_file = build_string("~/rgb.txt");
4679
4680 GCPRO1 (color_file);
4681
4682 if (NILP (Ffile_readable_p (color_file)))
4683 color_file =
4684 Fexpand_file_name (build_string ("rgb.txt"),
4685 Fsymbol_value (intern ("data-directory")));
4686
4687 Vwin32_color_map = Fwin32_load_color_file (color_file);
4688
4689 UNGCPRO;
4690 }
4691 if (NILP (Vwin32_color_map))
4692 Vwin32_color_map = Fwin32_default_color_map ();
ee78dc32
GV
4693
4694 if (! NILP (xrm_string))
4695 xrm_option = (unsigned char *) XSTRING (xrm_string)->data;
4696 else
4697 xrm_option = (unsigned char *) 0;
4698
4699 /* Use this general default value to start with. */
5ac45f98
GV
4700 /* First remove .exe suffix from invocation-name - it looks ugly. */
4701 {
4702 char basename[ MAX_PATH ], *str;
4703
4704 strcpy (basename, XSTRING (Vinvocation_name)->data);
4705 str = strrchr (basename, '.');
4706 if (str) *str = 0;
4707 Vinvocation_name = build_string (basename);
4708 }
ee78dc32
GV
4709 Vx_resource_name = Vinvocation_name;
4710
4711 validate_x_resource_name ();
4712
4713 /* This is what opens the connection and sets x_current_display.
4714 This also initializes many symbols, such as those used for input. */
4715 dpyinfo = win32_term_init (display, xrm_option,
4716 (char *) XSTRING (Vx_resource_name)->data);
4717
4718 if (dpyinfo == 0)
4719 {
4720 if (!NILP (must_succeed))
3c190163
GV
4721 fatal ("Cannot connect to server %s.\n",
4722 XSTRING (display)->data);
ee78dc32
GV
4723 else
4724 error ("Cannot connect to server %s", XSTRING (display)->data);
4725 }
4726
4727 XSETFASTINT (Vwindow_system_version, 3);
4728 return Qnil;
4729}
4730
4731DEFUN ("x-close-connection", Fx_close_connection,
4732 Sx_close_connection, 1, 1, 0,
4733 "Close the connection to DISPLAY's server.\n\
4734For DISPLAY, specify either a frame or a display name (a string).\n\
4735If DISPLAY is nil, that stands for the selected frame's display.")
4736 (display)
4737 Lisp_Object display;
4738{
4739 struct win32_display_info *dpyinfo = check_x_display_info (display);
4740 struct win32_display_info *tail;
4741 int i;
4742
4743 if (dpyinfo->reference_count > 0)
4744 error ("Display still has frames on it");
4745
4746 BLOCK_INPUT;
4747 /* Free the fonts in the font table. */
4748 for (i = 0; i < dpyinfo->n_fonts; i++)
4749 {
4750 if (dpyinfo->font_table[i].name)
4751 free (dpyinfo->font_table[i].name);
4752 /* Don't free the full_name string;
4753 it is always shared with something else. */
4754 win32_unload_font (dpyinfo, dpyinfo->font_table[i].font);
4755 }
4756 x_destroy_all_bitmaps (dpyinfo);
4757
4758 x_delete_display (dpyinfo);
4759 UNBLOCK_INPUT;
4760
4761 return Qnil;
4762}
4763
4764DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0,
4765 "Return the list of display names that Emacs has connections to.")
4766 ()
4767{
4768 Lisp_Object tail, result;
4769
4770 result = Qnil;
4771 for (tail = win32_display_name_list; ! NILP (tail); tail = XCONS (tail)->cdr)
4772 result = Fcons (XCONS (XCONS (tail)->car)->car, result);
4773
4774 return result;
4775}
4776
4777DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize, 1, 2, 0,
4778 "If ON is non-nil, report errors as soon as the erring request is made.\n\
4779If ON is nil, allow buffering of requests.\n\
4780This is a noop on Win32 systems.\n\
4781The optional second argument DISPLAY specifies which display to act on.\n\
4782DISPLAY should be either a frame or a display name (a string).\n\
4783If DISPLAY is omitted or nil, that stands for the selected frame's display.")
4784 (on, display)
4785 Lisp_Object display, on;
4786{
4787 struct win32_display_info *dpyinfo = check_x_display_info (display);
4788
4789 return Qnil;
4790}
4791
4792\f
4793/* These are the win32 specialized functions */
4794
4795DEFUN ("win32-select-font", Fwin32_select_font, Swin32_select_font, 0, 1, 0,
4796 "This will display the Win32 font dialog and return an X font string corresponding to the selection.")
4797 (frame)
4798 Lisp_Object frame;
4799{
4800 FRAME_PTR f = check_x_frame (frame);
4801 CHOOSEFONT cf;
4802 LOGFONT lf;
4803 char buf[100];
4804
4805 bzero (&cf, sizeof (cf));
4806
4807 cf.lStructSize = sizeof (cf);
4808 cf.hwndOwner = FRAME_WIN32_WINDOW (f);
4809 cf.Flags = CF_FIXEDPITCHONLY | CF_FORCEFONTEXIST | CF_SCREENFONTS;
4810 cf.lpLogFont = &lf;
4811
4812 if (!ChooseFont (&cf) || !win32_to_x_font (&lf, buf, 100))
3c190163 4813 return Qnil;
ee78dc32
GV
4814
4815 return build_string (buf);
4816}
4817
4818\f
4819syms_of_win32fns ()
4820{
4821 /* The section below is built by the lisp expression at the top of the file,
4822 just above where these variables are declared. */
4823 /*&&& init symbols here &&&*/
4824 Qauto_raise = intern ("auto-raise");
4825 staticpro (&Qauto_raise);
4826 Qauto_lower = intern ("auto-lower");
4827 staticpro (&Qauto_lower);
4828 Qbackground_color = intern ("background-color");
4829 staticpro (&Qbackground_color);
4830 Qbar = intern ("bar");
4831 staticpro (&Qbar);
4832 Qborder_color = intern ("border-color");
4833 staticpro (&Qborder_color);
4834 Qborder_width = intern ("border-width");
4835 staticpro (&Qborder_width);
4836 Qbox = intern ("box");
4837 staticpro (&Qbox);
4838 Qcursor_color = intern ("cursor-color");
4839 staticpro (&Qcursor_color);
4840 Qcursor_type = intern ("cursor-type");
4841 staticpro (&Qcursor_type);
4842 Qfont = intern ("font");
4843 staticpro (&Qfont);
4844 Qforeground_color = intern ("foreground-color");
4845 staticpro (&Qforeground_color);
4846 Qgeometry = intern ("geometry");
4847 staticpro (&Qgeometry);
4848 Qicon_left = intern ("icon-left");
4849 staticpro (&Qicon_left);
4850 Qicon_top = intern ("icon-top");
4851 staticpro (&Qicon_top);
4852 Qicon_type = intern ("icon-type");
4853 staticpro (&Qicon_type);
4854 Qicon_name = intern ("icon-name");
4855 staticpro (&Qicon_name);
4856 Qinternal_border_width = intern ("internal-border-width");
4857 staticpro (&Qinternal_border_width);
4858 Qleft = intern ("left");
4859 staticpro (&Qleft);
4860 Qmouse_color = intern ("mouse-color");
4861 staticpro (&Qmouse_color);
4862 Qnone = intern ("none");
4863 staticpro (&Qnone);
4864 Qparent_id = intern ("parent-id");
4865 staticpro (&Qparent_id);
4866 Qscroll_bar_width = intern ("scroll-bar-width");
4867 staticpro (&Qscroll_bar_width);
4868 Qsuppress_icon = intern ("suppress-icon");
4869 staticpro (&Qsuppress_icon);
4870 Qtop = intern ("top");
4871 staticpro (&Qtop);
4872 Qundefined_color = intern ("undefined-color");
4873 staticpro (&Qundefined_color);
4874 Qvertical_scroll_bars = intern ("vertical-scroll-bars");
4875 staticpro (&Qvertical_scroll_bars);
4876 Qvisibility = intern ("visibility");
4877 staticpro (&Qvisibility);
4878 Qwindow_id = intern ("window-id");
4879 staticpro (&Qwindow_id);
4880 Qx_frame_parameter = intern ("x-frame-parameter");
4881 staticpro (&Qx_frame_parameter);
4882 Qx_resource_name = intern ("x-resource-name");
4883 staticpro (&Qx_resource_name);
4884 Quser_position = intern ("user-position");
4885 staticpro (&Quser_position);
4886 Quser_size = intern ("user-size");
4887 staticpro (&Quser_size);
4888 Qdisplay = intern ("display");
4889 staticpro (&Qdisplay);
4890 /* This is the end of symbol initialization. */
4891
4892 Fput (Qundefined_color, Qerror_conditions,
4893 Fcons (Qundefined_color, Fcons (Qerror, Qnil)));
4894 Fput (Qundefined_color, Qerror_message,
4895 build_string ("Undefined color"));
4896
4897 DEFVAR_LISP ("win32-color-map", &Vwin32_color_map,
4898 "A array of color name mappings for windows.");
4899 Vwin32_color_map = Qnil;
4900
da36a4d6
GV
4901 DEFVAR_LISP ("win32-pass-alt-to-system", &Vwin32_pass_alt_to_system,
4902 "Non-nil if alt key presses are passed on to Windows.\n\
4903When non-nil, for example, alt pressed and released and then space will\n\
4904open the System menu. When nil, Emacs silently swallows alt key events.");
4905 Vwin32_pass_alt_to_system = Qnil;
4906
4907 DEFVAR_LISP ("win32-pass-optional-keys-to-system",
4908 &Vwin32_pass_optional_keys_to_system,
4909 "Non-nil if the 'optional' keys (left window, right window,\n\
4910and application keys) are passed on to Windows.");
4911 Vwin32_pass_optional_keys_to_system = Qnil;
4912
5ac45f98
GV
4913 DEFVAR_LISP ("win32-enable-italics", &Vwin32_enable_italics,
4914 "Non-nil enables selection of artificially italicized fonts.");
4915 Vwin32_enable_italics = Qnil;
4916
4917 DEFVAR_LISP ("win32-enable-palette", &Vwin32_enable_palette,
4918 "Non-nil enables Windows palette management to map colors exactly.");
4919 Vwin32_enable_palette = Qt;
4920
4921 DEFVAR_INT ("win32-mouse-button-tolerance",
4922 &Vwin32_mouse_button_tolerance,
4923 "Analogue of double click interval for faking middle mouse events.\n\
4924The value is the minimum time in milliseconds that must elapse between\n\
4925left/right button down events before they are considered distinct events.\n\
4926If both mouse buttons are depressed within this interval, a middle mouse\n\
4927button down event is generated instead.");
4928 XSETINT (Vwin32_mouse_button_tolerance, GetDoubleClickTime () / 2);
4929
ee78dc32
GV
4930 init_x_parm_symbols ();
4931
4932 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path,
4933 "List of directories to search for bitmap files for win32.");
4934 Vx_bitmap_file_path = decode_env_path ((char *) 0, "PATH");
4935
4936 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape,
4937 "The shape of the pointer when over text.\n\
4938Changing the value does not affect existing frames\n\
4939unless you set the mouse color.");
4940 Vx_pointer_shape = Qnil;
4941
4942 DEFVAR_LISP ("x-resource-name", &Vx_resource_name,
4943 "The name Emacs uses to look up resources; for internal use only.\n\
4944`x-get-resource' uses this as the first component of the instance name\n\
4945when requesting resource values.\n\
4946Emacs initially sets `x-resource-name' to the name under which Emacs\n\
4947was invoked, or to the value specified with the `-name' or `-rn'\n\
4948switches, if present.");
4949 Vx_resource_name = Qnil;
4950
4951 Vx_nontext_pointer_shape = Qnil;
4952
4953 Vx_mode_pointer_shape = Qnil;
4954
4955 DEFVAR_INT ("x-sensitive-text-pointer-shape",
4956 &Vx_sensitive_text_pointer_shape,
4957 "The shape of the pointer when over mouse-sensitive text.\n\
4958This variable takes effect when you create a new frame\n\
4959or when you set the mouse color.");
4960 Vx_sensitive_text_pointer_shape = Qnil;
4961
4962 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel,
4963 "A string indicating the foreground color of the cursor box.");
4964 Vx_cursor_fore_pixel = Qnil;
4965
4966 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager,
4967 "Non-nil if no window manager is in use.\n\
4968Emacs doesn't try to figure this out; this is always nil\n\
4969unless you set it to something else.");
4970 /* We don't have any way to find this out, so set it to nil
4971 and maybe the user would like to set it to t. */
4972 Vx_no_window_manager = Qnil;
4973
4974 defsubr (&Sx_get_resource);
4975 defsubr (&Sx_list_fonts);
4976 defsubr (&Sx_display_color_p);
4977 defsubr (&Sx_display_grayscale_p);
4978 defsubr (&Sx_color_defined_p);
4979 defsubr (&Sx_color_values);
4980 defsubr (&Sx_server_max_request_size);
4981 defsubr (&Sx_server_vendor);
4982 defsubr (&Sx_server_version);
4983 defsubr (&Sx_display_pixel_width);
4984 defsubr (&Sx_display_pixel_height);
4985 defsubr (&Sx_display_mm_width);
4986 defsubr (&Sx_display_mm_height);
4987 defsubr (&Sx_display_screens);
4988 defsubr (&Sx_display_planes);
4989 defsubr (&Sx_display_color_cells);
4990 defsubr (&Sx_display_visual_class);
4991 defsubr (&Sx_display_backing_store);
4992 defsubr (&Sx_display_save_under);
4993 defsubr (&Sx_parse_geometry);
4994 defsubr (&Sx_create_frame);
4995 defsubr (&Sfocus_frame);
4996 defsubr (&Sunfocus_frame);
4997 defsubr (&Sx_open_connection);
4998 defsubr (&Sx_close_connection);
4999 defsubr (&Sx_display_list);
5000 defsubr (&Sx_synchronize);
5001
5002 /* Win32 specific functions */
5003
5004 defsubr (&Swin32_select_font);
5ac45f98
GV
5005 defsubr (&Swin32_define_rgb_color);
5006 defsubr (&Swin32_default_color_map);
5007 defsubr (&Swin32_load_color_file);
ee78dc32
GV
5008}
5009
5010#undef abort
5011
5012void
5013win32_abort()
5014{
5ac45f98
GV
5015 int button;
5016 button = MessageBox (NULL,
5017 "A fatal error has occurred!\n\n"
5018 "Select Abort to exit, Retry to debug, Ignore to continue",
5019 "Emacs Abort Dialog",
5020 MB_ICONEXCLAMATION | MB_TASKMODAL
5021 | MB_SETFOREGROUND | MB_ABORTRETRYIGNORE);
5022 switch (button)
5023 {
5024 case IDRETRY:
5025 DebugBreak ();
5026 break;
5027 case IDIGNORE:
5028 break;
5029 case IDABORT:
5030 default:
5031 abort ();
5032 break;
5033 }
ee78dc32 5034}
d573caac 5035