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