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