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