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