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