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