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