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