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