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