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