Comment change.
[emacs.git] / src / w32fns.c
blob9d48646e45b63aa768e55548777aa87d02c76ffa
1 /* Functions for the Win32 window system.
2 Copyright (C) 1989, 1992, 1993, 1994, 1995 Free Software Foundation.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
9 any later version.
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
21 /* Added by Kevin Gallo */
23 #include <signal.h>
24 #include <config.h>
25 #include <stdio.h>
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"
39 #include <commdlg.h>
41 extern void abort ();
42 extern void free_frame_menubar ();
43 extern struct scroll_bar *x_window_to_scroll_bar ();
45 /* The colormap for converting color names to RGB values */
46 Lisp_Object Vwin32_color_map;
48 /* The name we're using in resource queries. */
49 Lisp_Object Vx_resource_name;
51 /* Non nil if no window manager is in use. */
52 Lisp_Object Vx_no_window_manager;
54 /* The background and shape of the mouse pointer, and shape when not
55 over text or in the modeline. */
56 Lisp_Object Vx_pointer_shape, Vx_nontext_pointer_shape, Vx_mode_pointer_shape;
57 /* The shape when over mouse-sensitive text. */
58 Lisp_Object Vx_sensitive_text_pointer_shape;
60 /* Color of chars displayed in cursor box. */
61 Lisp_Object Vx_cursor_fore_pixel;
63 /* Search path for bitmap files. */
64 Lisp_Object Vx_bitmap_file_path;
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.
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)))))
98 */
100 /*&&& symbols declared here &&&*/
101 Lisp_Object Qauto_raise;
102 Lisp_Object Qauto_lower;
103 Lisp_Object Qbackground_color;
104 Lisp_Object Qbar;
105 Lisp_Object Qborder_color;
106 Lisp_Object Qborder_width;
107 Lisp_Object Qbox;
108 Lisp_Object Qcursor_color;
109 Lisp_Object Qcursor_type;
110 Lisp_Object Qfont;
111 Lisp_Object Qforeground_color;
112 Lisp_Object Qgeometry;
113 Lisp_Object Qicon_left;
114 Lisp_Object Qicon_top;
115 Lisp_Object Qicon_type;
116 Lisp_Object Qicon_name;
117 Lisp_Object Qinternal_border_width;
118 Lisp_Object Qleft;
119 Lisp_Object Qmouse_color;
120 Lisp_Object Qnone;
121 Lisp_Object Qparent_id;
122 Lisp_Object Qscroll_bar_width;
123 Lisp_Object Qsuppress_icon;
124 Lisp_Object Qtop;
125 Lisp_Object Qundefined_color;
126 Lisp_Object Qvertical_scroll_bars;
127 Lisp_Object Qvisibility;
128 Lisp_Object Qwindow_id;
129 Lisp_Object Qx_frame_parameter;
130 Lisp_Object Qx_resource_name;
131 Lisp_Object Quser_position;
132 Lisp_Object Quser_size;
133 Lisp_Object Qdisplay;
135 /* The below are defined in frame.c. */
136 extern Lisp_Object Qheight, Qminibuffer, Qname, Qonly, Qwidth;
137 extern Lisp_Object Qunsplittable, Qmenu_bar_lines;
139 extern Lisp_Object Vwindow_system_version;
141 extern Lisp_Object last_mouse_scroll_bar;
142 extern int last_mouse_scroll_bar_pos;
143 Time last_mouse_movement_time;
146 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
147 and checking validity for Win32. */
149 FRAME_PTR
150 check_x_frame (frame)
151 Lisp_Object frame;
153 FRAME_PTR f;
155 if (NILP (frame))
156 f = selected_frame;
157 else
159 CHECK_LIVE_FRAME (frame, 0);
160 f = XFRAME (frame);
162 if (! FRAME_WIN32_P (f))
163 error ("non-win32 frame used");
164 return f;
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. */
171 static struct win32_display_info *
172 check_x_display_info (frame)
173 Lisp_Object frame;
175 if (NILP (frame))
177 if (FRAME_WIN32_P (selected_frame))
178 return FRAME_WIN32_DISPLAY_INFO (selected_frame);
179 else
180 return &one_win32_display_info;
182 else if (STRINGP (frame))
183 return x_display_info_for_name (frame);
184 else
186 FRAME_PTR f;
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);
196 /* Return the Emacs frame-object corresponding to an win32 window.
197 It could be the frame's main window or an icon window. */
199 /* This function can be called during GC, so use GC_xxx type test macros. */
201 struct frame *
202 x_window_to_frame (dpyinfo, wdesc)
203 struct win32_display_info *dpyinfo;
204 HWND wdesc;
206 Lisp_Object tail, frame;
207 struct frame *f;
209 for (tail = Vframe_list; GC_CONSP (tail); tail = XCONS (tail)->cdr)
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;
221 return 0;
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.
230 Bitmap indices are guaranteed to be > 0, so a negative number can
231 be used to indicate no bitmap.
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. */
238 /* Functions to access the contents of a bitmap, given an id. */
241 x_bitmap_height (f, id)
242 FRAME_PTR f;
243 int id;
245 return FRAME_WIN32_DISPLAY_INFO (f)->bitmaps[id - 1].height;
249 x_bitmap_width (f, id)
250 FRAME_PTR f;
251 int id;
253 return FRAME_WIN32_DISPLAY_INFO (f)->bitmaps[id - 1].width;
257 x_bitmap_pixmap (f, id)
258 FRAME_PTR f;
259 int id;
261 return (int) FRAME_WIN32_DISPLAY_INFO (f)->bitmaps[id - 1].pixmap;
265 /* Allocate a new bitmap record. Returns index of new record. */
267 static int
268 x_allocate_bitmap_record (f)
269 FRAME_PTR f;
271 struct win32_display_info *dpyinfo = FRAME_WIN32_DISPLAY_INFO (f);
272 int i;
274 if (dpyinfo->bitmaps == NULL)
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;
283 if (dpyinfo->bitmaps_last < dpyinfo->bitmaps_size)
284 return ++dpyinfo->bitmaps_last;
286 for (i = 0; i < dpyinfo->bitmaps_size; ++i)
287 if (dpyinfo->bitmaps[i].refcount == 0)
288 return i + 1;
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;
297 /* Add one reference to the reference count of the bitmap with id ID. */
299 void
300 x_reference_bitmap (f, id)
301 FRAME_PTR f;
302 int id;
304 ++FRAME_WIN32_DISPLAY_INFO (f)->bitmaps[id - 1].refcount;
307 /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
310 x_create_bitmap_from_data (f, bits, width, height)
311 struct frame *f;
312 char *bits;
313 unsigned int width, height;
315 struct win32_display_info *dpyinfo = FRAME_WIN32_DISPLAY_INFO (f);
316 Pixmap bitmap;
317 int id;
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);
324 if (! bitmap)
325 return -1;
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;
336 return id;
339 /* Create bitmap from file FILE for frame F. */
342 x_create_bitmap_from_file (f, file)
343 struct frame *f;
344 Lisp_Object file;
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;
357 /* Look for an existing bitmap with the same name. */
358 for (id = 0; id < dpyinfo->bitmaps_last; ++id)
360 if (dpyinfo->bitmaps[id].refcount
361 && dpyinfo->bitmaps[id].file
362 && !strcmp (dpyinfo->bitmaps[id].file, (char *) XSTRING (file)->data))
364 ++dpyinfo->bitmaps[id].refcount;
365 return id + 1;
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);
375 filename = (char *) XSTRING (found)->data;
377 hinst = LoadLibraryEx (filename, NULL, LOAD_LIBRARY_AS_DATAFILE);
379 if (hinst == NULL)
380 return -1;
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;
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);
397 return id;
398 #endif
401 /* Remove reference to bitmap with id number ID. */
404 x_destroy_bitmap (f, id)
405 FRAME_PTR f;
406 int id;
408 struct win32_display_info *dpyinfo = FRAME_WIN32_DISPLAY_INFO (f);
410 if (id > 0)
412 --dpyinfo->bitmaps[id - 1].refcount;
413 if (dpyinfo->bitmaps[id - 1].refcount == 0)
415 BLOCK_INPUT;
416 DeleteObject (dpyinfo->bitmaps[id - 1].pixmap);
417 if (dpyinfo->bitmaps[id - 1].file)
419 free (dpyinfo->bitmaps[id - 1].file);
420 dpyinfo->bitmaps[id - 1].file = NULL;
422 UNBLOCK_INPUT;
427 /* Free all the bitmaps for the display specified by DPYINFO. */
429 static void
430 x_destroy_all_bitmaps (dpyinfo)
431 struct win32_display_info *dpyinfo;
433 int i;
434 for (i = 0; i < dpyinfo->bitmaps_last; i++)
435 if (dpyinfo->bitmaps[i].refcount > 0)
437 DeleteObject (dpyinfo->bitmaps[i].pixmap);
438 if (dpyinfo->bitmaps[i].file)
439 free (dpyinfo->bitmaps[i].file);
441 dpyinfo->bitmaps_last = 0;
444 /* Connect the frame-parameter names for Win32 frames
445 to the ways of passing the parameter values to the window system.
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. */
451 enum x_frame_parm
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
471 struct x_frame_parm_table
473 char *name;
474 void (*setter)( /* struct frame *frame, Lisp_Object val, oldval */ );
477 void x_set_foreground_color ();
478 void x_set_background_color ();
479 void x_set_mouse_color ();
480 void x_set_cursor_color ();
481 void x_set_border_color ();
482 void x_set_cursor_type ();
483 void x_set_icon_type ();
484 void x_set_icon_name ();
485 void x_set_font ();
486 void x_set_border_width ();
487 void x_set_internal_border_width ();
488 void x_explicitly_set_name ();
489 void x_set_autoraise ();
490 void x_set_autolower ();
491 void x_set_vertical_scroll_bars ();
492 void x_set_visibility ();
493 void x_set_menu_bar_lines ();
494 void x_set_scroll_bar_width ();
495 void x_set_unsplittable ();
497 static struct x_frame_parm_table x_frame_parms[] =
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,
520 /* Attach the `x-frame-parameter' properties to
521 the Lisp symbol names of parameters relevant to Win32. */
523 init_x_parm_symbols ()
525 int i;
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));
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. */
536 void
537 x_set_frame_parameters (f, alist)
538 FRAME_PTR f;
539 Lisp_Object alist;
541 Lisp_Object tail;
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;
548 /* Same here. */
549 Lisp_Object left, top;
551 /* Same with these. */
552 Lisp_Object icon_left, icon_top;
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;
561 i = 0;
562 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
563 i++;
565 parms = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
566 values = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
568 /* Extract parm names and values into those vectors. */
570 i = 0;
571 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
573 Lisp_Object elt, prop, val;
575 elt = Fcar (tail);
576 parms[i] = Fcar (elt);
577 values[i] = Fcdr (elt);
578 i++;
581 width = height = top = left = Qunbound;
582 icon_left = icon_top = Qunbound;
584 /* Now process them in reverse of specified order. */
585 for (i--; i >= 0; i--)
587 Lisp_Object prop, val;
589 prop = parms[i];
590 val = values[i];
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
606 register Lisp_Object param_index, old_value;
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])))
614 (*x_frame_parms[XINT (param_index)].setter)(f, val, old_value);
618 /* Don't die if just one of these was set. */
619 if (EQ (left, Qunbound))
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);
627 if (EQ (top, Qunbound))
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);
636 /* If one of the icon positions was not set, preserve or default it. */
637 if (EQ (icon_left, Qunbound) || ! INTEGERP (icon_left))
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);
644 if (EQ (icon_top, Qunbound) || ! INTEGERP (icon_top))
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);
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));
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.
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. */
667 Lisp_Object frame;
669 check_frame_size (f, &height, &width);
671 XSETFRAME (frame, f);
673 if ((NUMBERP (width) && XINT (width) != FRAME_WIDTH (f))
674 || (NUMBERP (height) && XINT (height) != FRAME_HEIGHT (f)))
675 Fset_frame_size (frame, width, height);
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))
682 int leftpos = 0;
683 int toppos = 0;
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))
691 leftpos = XINT (left);
692 if (leftpos < 0)
693 f->output_data.win32->size_hint_flags |= XNegative;
695 else if (CONSP (left) && EQ (XCONS (left)->car, Qminus)
696 && CONSP (XCONS (left)->cdr)
697 && INTEGERP (XCONS (XCONS (left)->cdr)->car))
699 leftpos = - XINT (XCONS (XCONS (left)->cdr)->car);
700 f->output_data.win32->size_hint_flags |= XNegative;
702 else if (CONSP (left) && EQ (XCONS (left)->car, Qplus)
703 && CONSP (XCONS (left)->cdr)
704 && INTEGERP (XCONS (XCONS (left)->cdr)->car))
706 leftpos = XINT (XCONS (XCONS (left)->cdr)->car);
709 if (EQ (top, Qminus))
710 f->output_data.win32->size_hint_flags |= YNegative;
711 else if (INTEGERP (top))
713 toppos = XINT (top);
714 if (toppos < 0)
715 f->output_data.win32->size_hint_flags |= YNegative;
717 else if (CONSP (top) && EQ (XCONS (top)->car, Qminus)
718 && CONSP (XCONS (top)->cdr)
719 && INTEGERP (XCONS (XCONS (top)->cdr)->car))
721 toppos = - XINT (XCONS (XCONS (top)->cdr)->car);
722 f->output_data.win32->size_hint_flags |= YNegative;
724 else if (CONSP (top) && EQ (XCONS (top)->car, Qplus)
725 && CONSP (XCONS (top)->cdr)
726 && INTEGERP (XCONS (XCONS (top)->cdr)->car))
728 toppos = XINT (XCONS (XCONS (top)->cdr)->car);
732 /* Store the numeric value of the position. */
733 f->output_data.win32->top_pos = toppos;
734 f->output_data.win32->left_pos = leftpos;
736 f->output_data.win32->win_gravity = NorthWestGravity;
738 /* Actually set that position, and convert to absolute. */
739 x_set_offset (f, leftpos, toppos, -1);
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));
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. */
752 void
753 x_real_positions (f, xptr, yptr)
754 FRAME_PTR f;
755 int *xptr, *yptr;
757 POINT pt;
760 RECT rect;
762 GetClientRect(FRAME_WIN32_WINDOW(f), &rect);
763 AdjustWindowRect(&rect, f->output_data.win32->dwStyle, FRAME_EXTERNAL_MENU_BAR(f));
765 pt.x = rect.left;
766 pt.y = rect.top;
769 ClientToScreen (FRAME_WIN32_WINDOW(f), &pt);
771 *xptr = pt.x;
772 *yptr = pt.y;
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. */
781 x_report_frame_params (f, alistptr)
782 struct frame *f;
783 Lisp_Object *alistptr;
785 char buf[16];
786 Lisp_Object tem;
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)));
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)));
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);
819 #if 0
820 DEFUN ("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;
825 Lisp_Object rgb;
827 CHECK_NUMBER (red, 0);
828 CHECK_NUMBER (green, 0);
829 CHECK_NUMBER (blue, 0);
831 XSET (rgb, Lisp_Int, RGB(XUINT(red), XUINT(green), XUINT(blue)));
833 return (rgb);
837 #else
838 /* The default colors for the win32 color map */
839 typedef struct colormap_t
841 char *name;
842 COLORREF colorref;
843 } colormap_t;
845 colormap_t win32_color_map[] =
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)},
1089 DEFUN ("win32-default-color-map", Fwin32_default_color_map, Swin32_default_color_map,
1090 0, 0, 0, "Return the default color map.")
1093 int i;
1094 colormap_t *pc = win32_color_map;
1095 Lisp_Object cmap;
1097 BLOCK_INPUT;
1099 cmap = Qnil;
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);
1107 UNBLOCK_INPUT;
1109 return (cmap);
1111 #endif
1113 Lisp_Object
1114 win32_to_x_color (rgb)
1115 Lisp_Object rgb;
1117 Lisp_Object color;
1119 CHECK_NUMBER (rgb, 0);
1121 BLOCK_INPUT;
1123 color = Frassq (rgb, Vwin32_color_map);
1125 UNBLOCK_INPUT;
1127 if (!NILP (color))
1128 return (Fcar (color));
1129 else
1130 return Qnil;
1133 COLORREF
1134 x_to_win32_color (colorname)
1135 char * colorname;
1137 register Lisp_Object tail, ret = Qnil;
1139 BLOCK_INPUT;
1141 for (tail = Vwin32_color_map; !NILP (tail); tail = Fcdr (tail))
1143 register Lisp_Object elt, tem;
1145 elt = Fcar (tail);
1146 if (!CONSP (elt)) continue;
1148 tem = Fcar (elt);
1150 if (lstrcmpi (XSTRING (tem)->data, colorname) == 0)
1152 ret = XUINT(Fcdr (elt));
1153 break;
1156 QUIT;
1159 UNBLOCK_INPUT;
1161 return ret;
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. */
1169 defined_color (f, color, color_def, alloc)
1170 FRAME_PTR f;
1171 char *color;
1172 COLORREF *color_def;
1173 int alloc;
1175 register Lisp_Object tem;
1177 tem = x_to_win32_color (color);
1179 if (!NILP (tem))
1181 *color_def = XUINT (tem);
1182 return 1;
1184 else
1186 return 0;
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. */
1196 x_decode_color (f, arg, def)
1197 FRAME_PTR f;
1198 Lisp_Object arg;
1199 int def;
1201 COLORREF cdef;
1203 CHECK_STRING (arg, 0);
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);
1210 if ((FRAME_WIN32_DISPLAY_INFO (f)->n_planes * FRAME_WIN32_DISPLAY_INFO (f)->n_cbits) == 1)
1211 return def;
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;
1218 /* defined_color failed; return an ultimate default. */
1219 return def;
1222 /* Functions called only from `x_set_frame_param'
1223 to set individual parameters.
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. */
1230 void
1231 x_set_foreground_color (f, arg, oldval)
1232 struct frame *f;
1233 Lisp_Object arg, oldval;
1235 f->output_data.win32->foreground_pixel
1236 = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1237 if (FRAME_WIN32_WINDOW (f) != 0)
1239 recompute_basic_faces (f);
1240 if (FRAME_VISIBLE_P (f))
1241 redraw_frame (f);
1245 void
1246 x_set_background_color (f, arg, oldval)
1247 struct frame *f;
1248 Lisp_Object arg, oldval;
1250 Pixmap temp;
1251 int mask;
1253 f->output_data.win32->background_pixel
1254 = x_decode_color (f, arg, WHITE_PIX_DEFAULT (f));
1256 if (FRAME_WIN32_WINDOW (f) != 0)
1258 SetWindowLong (FRAME_WIN32_WINDOW (f), WND_BACKGROUND_INDEX, f->output_data.win32->background_pixel);
1260 recompute_basic_faces (f);
1262 if (FRAME_VISIBLE_P (f))
1263 redraw_frame (f);
1267 void
1268 x_set_mouse_color (f, arg, oldval)
1269 struct frame *f;
1270 Lisp_Object arg, oldval;
1272 #if 0
1273 Cursor cursor, nontext_cursor, mode_cursor, cross_cursor;
1274 #endif
1275 int mask_color;
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;
1286 #if 0
1287 BLOCK_INPUT;
1289 /* It's not okay to crash if the user selects a screwy cursor. */
1290 x_catch_errors (FRAME_WIN32_DISPLAY (f));
1292 if (!EQ (Qnil, Vx_pointer_shape))
1294 CHECK_NUMBER (Vx_pointer_shape, 0);
1295 cursor = XCreateFontCursor (FRAME_WIN32_DISPLAY (f), XINT (Vx_pointer_shape));
1297 else
1298 cursor = XCreateFontCursor (FRAME_WIN32_DISPLAY (f), XC_xterm);
1299 x_check_errors (FRAME_WIN32_DISPLAY (f), "bad text pointer cursor: %s");
1301 if (!EQ (Qnil, Vx_nontext_pointer_shape))
1303 CHECK_NUMBER (Vx_nontext_pointer_shape, 0);
1304 nontext_cursor = XCreateFontCursor (FRAME_WIN32_DISPLAY (f),
1305 XINT (Vx_nontext_pointer_shape));
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");
1311 if (!EQ (Qnil, Vx_mode_pointer_shape))
1313 CHECK_NUMBER (Vx_mode_pointer_shape, 0);
1314 mode_cursor = XCreateFontCursor (FRAME_WIN32_DISPLAY (f),
1315 XINT (Vx_mode_pointer_shape));
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");
1321 if (!EQ (Qnil, Vx_sensitive_text_pointer_shape))
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));
1328 else
1329 cross_cursor = XCreateFontCursor (FRAME_WIN32_DISPLAY (f), XC_crosshair);
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));
1336 XColor fore_color, back_color;
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);
1358 if (FRAME_WIN32_WINDOW (f) != 0)
1360 XDefineCursor (FRAME_WIN32_DISPLAY (f), FRAME_WIN32_WINDOW (f), cursor);
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;
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;
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;
1381 XFlush (FRAME_WIN32_DISPLAY (f));
1382 UNBLOCK_INPUT;
1383 #endif
1386 void
1387 x_set_cursor_color (f, arg, oldval)
1388 struct frame *f;
1389 Lisp_Object arg, oldval;
1391 unsigned long fore_pixel;
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));
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)
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;
1407 f->output_data.win32->cursor_foreground_pixel = fore_pixel;
1409 if (FRAME_WIN32_WINDOW (f) != 0)
1411 if (FRAME_VISIBLE_P (f))
1413 x_display_cursor (f, 0);
1414 x_display_cursor (f, 1);
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. */
1425 void
1426 x_set_border_color (f, arg, oldval)
1427 struct frame *f;
1428 Lisp_Object arg, oldval;
1430 unsigned char *str;
1431 int pix;
1433 CHECK_STRING (arg, 0);
1434 str = XSTRING (arg)->data;
1436 pix = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1438 x_set_border_pixel (f, pix);
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. */
1445 x_set_border_pixel (f, pix)
1446 struct frame *f;
1447 int pix;
1449 f->output_data.win32->border_pixel = pix;
1451 if (FRAME_WIN32_WINDOW (f) != 0 && f->output_data.win32->border_width > 0)
1453 if (FRAME_VISIBLE_P (f))
1454 redraw_frame (f);
1458 void
1459 x_set_cursor_type (f, arg, oldval)
1460 FRAME_PTR f;
1461 Lisp_Object arg, oldval;
1463 if (EQ (arg, Qbar))
1465 FRAME_DESIRED_CURSOR (f) = bar_cursor;
1466 f->output_data.win32->cursor_width = 2;
1468 else if (CONSP (arg) && EQ (XCONS (arg)->car, Qbar)
1469 && INTEGERP (XCONS (arg)->cdr))
1471 FRAME_DESIRED_CURSOR (f) = bar_cursor;
1472 f->output_data.win32->cursor_width = XINT (XCONS (arg)->cdr);
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;
1480 /* Make sure the cursor gets redrawn. This is overkill, but how
1481 often do people change cursor types? */
1482 update_mode_lines++;
1485 void
1486 x_set_icon_type (f, arg, oldval)
1487 struct frame *f;
1488 Lisp_Object arg, oldval;
1490 #if 0
1491 Lisp_Object tem;
1492 int result;
1494 if (STRINGP (arg))
1496 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
1497 return;
1499 else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
1500 return;
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);
1511 if (result)
1513 UNBLOCK_INPUT;
1514 error ("No icon window available");
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))
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));
1527 XFlush (FRAME_WIN32_DISPLAY (f));
1528 UNBLOCK_INPUT;
1529 #endif
1532 /* Return non-nil if frame F wants a bitmap icon. */
1534 Lisp_Object
1535 x_icon_type (f)
1536 FRAME_PTR f;
1538 Lisp_Object tem;
1540 tem = assq_no_quit (Qicon_type, f->param_alist);
1541 if (CONSP (tem))
1542 return XCONS (tem)->cdr;
1543 else
1544 return Qnil;
1547 void
1548 x_set_icon_name (f, arg, oldval)
1549 struct frame *f;
1550 Lisp_Object arg, oldval;
1552 Lisp_Object tem;
1553 int result;
1555 if (STRINGP (arg))
1557 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
1558 return;
1560 else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
1561 return;
1563 f->icon_name = arg;
1565 #if 0
1566 if (f->output_data.win32->icon_bitmap != 0)
1567 return;
1569 BLOCK_INPUT;
1571 result = x_text_icon (f,
1572 (char *) XSTRING ((!NILP (f->icon_name)
1573 ? f->icon_name
1574 : f->name))->data);
1576 if (result)
1578 UNBLOCK_INPUT;
1579 error ("No icon window available");
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))
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));
1592 XFlush (FRAME_WIN32_DISPLAY (f));
1593 UNBLOCK_INPUT;
1594 #endif
1597 extern Lisp_Object x_new_font ();
1599 void
1600 x_set_font (f, arg, oldval)
1601 struct frame *f;
1602 Lisp_Object arg, oldval;
1604 Lisp_Object result;
1606 CHECK_STRING (arg, 1);
1608 BLOCK_INPUT;
1609 result = x_new_font (f, XSTRING (arg)->data);
1610 UNBLOCK_INPUT;
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))
1618 recompute_basic_faces (f);
1619 store_frame_param (f, Qfont, result);
1621 else
1622 abort ();
1625 void
1626 x_set_border_width (f, arg, oldval)
1627 struct frame *f;
1628 Lisp_Object arg, oldval;
1630 CHECK_NUMBER (arg, 0);
1632 if (XINT (arg) == f->output_data.win32->border_width)
1633 return;
1635 if (FRAME_WIN32_WINDOW (f) != 0)
1636 error ("Cannot change the border width of a window");
1638 f->output_data.win32->border_width = XINT (arg);
1641 void
1642 x_set_internal_border_width (f, arg, oldval)
1643 struct frame *f;
1644 Lisp_Object arg, oldval;
1646 int mask;
1647 int old = f->output_data.win32->internal_border_width;
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;
1654 if (f->output_data.win32->internal_border_width == old)
1655 return;
1657 if (FRAME_WIN32_WINDOW (f) != 0)
1659 BLOCK_INPUT;
1660 x_set_window_size (f, 0, f->width, f->height);
1661 UNBLOCK_INPUT;
1662 SET_FRAME_GARBAGED (f);
1666 void
1667 x_set_visibility (f, value, oldval)
1668 struct frame *f;
1669 Lisp_Object value, oldval;
1671 Lisp_Object frame;
1672 XSETFRAME (frame, f);
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);
1682 void
1683 x_set_menu_bar_lines (f, value, oldval)
1684 struct frame *f;
1685 Lisp_Object value, oldval;
1687 int nlines;
1688 int olines = FRAME_MENU_BAR_LINES (f);
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;
1697 if (INTEGERP (value))
1698 nlines = XINT (value);
1699 else
1700 nlines = 0;
1702 FRAME_MENU_BAR_LINES (f) = 0;
1703 if (nlines)
1704 FRAME_EXTERNAL_MENU_BAR (f) = 1;
1705 else
1707 if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
1708 free_frame_menubar (f);
1709 FRAME_EXTERNAL_MENU_BAR (f) = 0;
1713 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
1714 win32_id_name.
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.
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. */
1724 void
1725 x_set_name (f, name, explicit)
1726 struct frame *f;
1727 Lisp_Object name;
1728 int explicit;
1730 /* Make sure that requests from lisp code override requests from
1731 Emacs redisplay code. */
1732 if (explicit)
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;
1739 f->explicit_name = ! NILP (name);
1741 else if (f->explicit_name)
1742 return;
1744 /* If NAME is nil, set the name to the win32_id_name. */
1745 if (NILP (name))
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);
1754 else
1755 CHECK_STRING (name, 0);
1757 /* Don't change the name if it's already NAME. */
1758 if (! NILP (Fstring_equal (name, f->name)))
1759 return;
1761 if (FRAME_WIN32_WINDOW (f))
1763 BLOCK_INPUT;
1764 SetWindowText(FRAME_WIN32_WINDOW (f), XSTRING (name)->data);
1765 UNBLOCK_INPUT;
1768 f->name = name;
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. */
1774 void
1775 x_explicitly_set_name (f, arg, oldval)
1776 FRAME_PTR f;
1777 Lisp_Object arg, oldval;
1779 x_set_name (f, arg, 1);
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. */
1785 void
1786 x_implicitly_set_name (f, arg, oldval)
1787 FRAME_PTR f;
1788 Lisp_Object arg, oldval;
1790 x_set_name (f, arg, 0);
1793 void
1794 x_set_autoraise (f, arg, oldval)
1795 struct frame *f;
1796 Lisp_Object arg, oldval;
1798 f->auto_raise = !EQ (Qnil, arg);
1801 void
1802 x_set_autolower (f, arg, oldval)
1803 struct frame *f;
1804 Lisp_Object arg, oldval;
1806 f->auto_lower = !EQ (Qnil, arg);
1809 void
1810 x_set_unsplittable (f, arg, oldval)
1811 struct frame *f;
1812 Lisp_Object arg, oldval;
1814 f->no_split = !NILP (arg);
1817 void
1818 x_set_vertical_scroll_bars (f, arg, oldval)
1819 struct frame *f;
1820 Lisp_Object arg, oldval;
1822 if (NILP (arg) != ! FRAME_HAS_VERTICAL_SCROLL_BARS (f))
1824 FRAME_HAS_VERTICAL_SCROLL_BARS (f) = ! NILP (arg);
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));
1835 void
1836 x_set_scroll_bar_width (f, arg, oldval)
1837 struct frame *f;
1838 Lisp_Object arg, oldval;
1840 if (NILP (arg))
1842 FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = 0;
1843 FRAME_SCROLL_BAR_COLS (f) = 2;
1845 else if (INTEGERP (arg) && XINT (arg) > 0
1846 && XFASTINT (arg) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f))
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));
1856 /* Subroutines of creating an frame. */
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. */
1861 static void
1862 validate_x_resource_name ()
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;
1872 if (STRINGP (Vx_resource_name))
1874 unsigned char *p = XSTRING (Vx_resource_name)->data;
1875 int i;
1877 len = XSTRING (Vx_resource_name)->size;
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++)
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++;
1893 else
1894 /* Not a string => completely invalid. */
1895 bad_count = 5, good_count = 0;
1897 /* If name is valid already, return. */
1898 if (bad_count == 0)
1899 return;
1901 /* If name is entirely invalid, or nearly so, use `emacs'. */
1902 if (good_count == 0
1903 || (good_count == 1 && bad_count > 0))
1905 Vx_resource_name = build_string ("emacs");
1906 return;
1909 /* Name is partly valid. Copy it and replace the invalid characters
1910 with underscores. */
1912 Vx_resource_name = new = Fcopy_sequence (Vx_resource_name);
1914 for (i = 0; i < len; i++)
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] = '_';
1926 extern char *x_get_string_resource ();
1928 DEFUN ("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\
1930 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
1931 class, where INSTANCE is the name under which Emacs was invoked, or\n\
1932 the name specified by the `-name' or `-rn' command-line arguments.\n\
1934 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
1935 class, respectively. You must specify both of them or neither.\n\
1936 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
1937 and the class is `Emacs.CLASS.SUBCLASS'.")
1938 (attribute, class, component, subclass)
1939 Lisp_Object attribute, class, component, subclass;
1941 register char *value;
1942 char *name_key;
1943 char *class_key;
1945 CHECK_STRING (attribute, 0);
1946 CHECK_STRING (class, 0);
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");
1955 validate_x_resource_name ();
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);
1965 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
1966 + XSTRING (class)->size
1967 + (STRINGP (subclass)
1968 ? XSTRING (subclass)->size : 0)
1969 + 3);
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);
1976 strcat (class_key, ".");
1977 strcat (class_key, XSTRING (class)->data);
1979 if (!NILP (component))
1981 strcat (class_key, ".");
1982 strcat (class_key, XSTRING (subclass)->data);
1984 strcat (name_key, ".");
1985 strcat (name_key, XSTRING (component)->data);
1988 strcat (name_key, ".");
1989 strcat (name_key, XSTRING (attribute)->data);
1991 value = x_get_string_resource (Qnil,
1992 name_key, class_key);
1994 if (value != (char *) 0)
1995 return build_string (value);
1996 else
1997 return Qnil;
2000 /* Used when C code wants a resource value. */
2002 char *
2003 x_get_resource_string (attribute, class)
2004 char *attribute, *class;
2006 register char *value;
2007 char *name_key;
2008 char *class_key;
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);
2017 sprintf (name_key, "%s.%s",
2018 XSTRING (Vinvocation_name)->data,
2019 attribute);
2020 sprintf (class_key, "%s.%s", EMACS_CLASS, class);
2022 return x_get_string_resource (selected_frame,
2023 name_key, class_key);
2026 /* Types we might convert a resource string into. */
2027 enum resource_types
2029 number, boolean, string, symbol
2032 /* Return the value of parameter PARAM.
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.
2037 Convert the resource to the type specified by desired_type.
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! */
2043 static Lisp_Object
2044 x_get_arg (alist, param, attribute, class, type)
2045 Lisp_Object alist, param;
2046 char *attribute;
2047 char *class;
2048 enum resource_types type;
2050 register Lisp_Object tem;
2052 tem = Fassq (param, alist);
2053 if (EQ (tem, Qnil))
2054 tem = Fassq (param, Vdefault_frame_alist);
2055 if (EQ (tem, Qnil))
2058 if (attribute)
2060 tem = Fx_get_resource (build_string (attribute),
2061 build_string (class),
2062 Qnil, Qnil);
2064 if (NILP (tem))
2065 return Qunbound;
2067 switch (type)
2069 case number:
2070 return make_number (atoi (XSTRING (tem)->data));
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;
2080 case string:
2081 return tem;
2083 case symbol:
2084 /* As a special case, we map the values `true' and `on'
2085 to Qt, and `false' and `off' to Qnil. */
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);
2099 default:
2100 abort ();
2103 else
2104 return Qunbound;
2106 return Fcdr (tem);
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. */
2115 static Lisp_Object
2116 x_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;
2125 Lisp_Object tem;
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;
2134 DEFUN ("x-parse-geometry", Fx_parse_geometry, Sx_parse_geometry, 1, 1, 0,
2135 "Parse an X-style geometry string STRING.\n\
2136 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
2137 The properties returned may include `top', `left', `height', and `width'.\n\
2138 The value of `left' or `top' may be an integer,\n\
2139 or a list (+ N) meaning N pixels relative to top/left corner,\n\
2140 or a list (- N) meaning -N pixels relative to bottom/right corner.")
2141 (string)
2142 Lisp_Object string;
2144 int geometry, x, y;
2145 unsigned int width, height;
2146 Lisp_Object result;
2148 CHECK_STRING (string, 0);
2150 geometry = XParseGeometry ((char *) XSTRING (string)->data,
2151 &x, &y, &width, &height);
2153 result = Qnil;
2154 if (geometry & XValue)
2156 Lisp_Object element;
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);
2167 if (geometry & YValue)
2169 Lisp_Object element;
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);
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);
2185 return result;
2188 /* Calculate the desired size and position of this window,
2189 and return the flags saying which aspects were specified.
2191 This function does not make the coordinates positive. */
2193 #define DEFAULT_ROWS 40
2194 #define DEFAULT_COLS 80
2196 static int
2197 x_figure_window_size (f, parms)
2198 struct frame *f;
2199 Lisp_Object parms;
2201 register Lisp_Object tem0, tem1, tem2;
2202 int height, width, left, top;
2203 register int geometry;
2204 long window_prompting = 0;
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;
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))
2221 if (!EQ (tem0, Qunbound))
2223 CHECK_NUMBER (tem0, 0);
2224 f->height = XINT (tem0);
2226 if (!EQ (tem1, Qunbound))
2228 CHECK_NUMBER (tem1, 0);
2229 f->width = XINT (tem1);
2231 if (!NILP (tem2) && !EQ (tem2, Qunbound))
2232 window_prompting |= USSize;
2233 else
2234 window_prompting |= PSize;
2237 f->output_data.win32->vertical_scroll_bar_extra
2238 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f)
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);
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))
2251 if (EQ (tem0, Qminus))
2253 f->output_data.win32->top_pos = 0;
2254 window_prompting |= YNegative;
2256 else if (CONSP (tem0) && EQ (XCONS (tem0)->car, Qminus)
2257 && CONSP (XCONS (tem0)->cdr)
2258 && INTEGERP (XCONS (XCONS (tem0)->cdr)->car))
2260 f->output_data.win32->top_pos = - XINT (XCONS (XCONS (tem0)->cdr)->car);
2261 window_prompting |= YNegative;
2263 else if (CONSP (tem0) && EQ (XCONS (tem0)->car, Qplus)
2264 && CONSP (XCONS (tem0)->cdr)
2265 && INTEGERP (XCONS (XCONS (tem0)->cdr)->car))
2267 f->output_data.win32->top_pos = XINT (XCONS (XCONS (tem0)->cdr)->car);
2269 else if (EQ (tem0, Qunbound))
2270 f->output_data.win32->top_pos = 0;
2271 else
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;
2279 if (EQ (tem1, Qminus))
2281 f->output_data.win32->left_pos = 0;
2282 window_prompting |= XNegative;
2284 else if (CONSP (tem1) && EQ (XCONS (tem1)->car, Qminus)
2285 && CONSP (XCONS (tem1)->cdr)
2286 && INTEGERP (XCONS (XCONS (tem1)->cdr)->car))
2288 f->output_data.win32->left_pos = - XINT (XCONS (XCONS (tem1)->cdr)->car);
2289 window_prompting |= XNegative;
2291 else if (CONSP (tem1) && EQ (XCONS (tem1)->car, Qplus)
2292 && CONSP (XCONS (tem1)->cdr)
2293 && INTEGERP (XCONS (XCONS (tem1)->cdr)->car))
2295 f->output_data.win32->left_pos = XINT (XCONS (XCONS (tem1)->cdr)->car);
2297 else if (EQ (tem1, Qunbound))
2298 f->output_data.win32->left_pos = 0;
2299 else
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;
2307 if (!NILP (tem2) && ! EQ (tem2, Qunbound))
2308 window_prompting |= USPosition;
2309 else
2310 window_prompting |= PPosition;
2313 return window_prompting;
2318 extern LRESULT CALLBACK win32_wnd_proc ();
2320 BOOL
2321 win32_init_class (hinst)
2322 HINSTANCE hinst;
2324 WNDCLASS wc;
2326 wc.style = CS_HREDRAW | CS_VREDRAW | CS_OWNDC;
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;
2337 return (RegisterClass (&wc));
2340 HWND
2341 win32_createscrollbar (f, bar)
2342 struct frame *f;
2343 struct scroll_bar * bar;
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));
2355 void
2356 win32_createwindow (f)
2357 struct frame *f;
2359 HWND hwnd;
2361 /* Do first time app init */
2363 if (!hprevinst)
2365 win32_init_class (hinst);
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);
2380 if (hwnd)
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);
2388 DWORD
2389 win_msg_worker (dw)
2390 DWORD dw;
2392 MSG msg;
2394 /* Ensure our message queue is created */
2396 PeekMessage (&msg, NULL, 0, 0, PM_NOREMOVE);
2398 PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0);
2400 while (GetMessage (&msg, NULL, 0, 0))
2402 if (msg.hwnd == NULL)
2404 switch (msg.message)
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:
2412 HWND hwnd = win32_createscrollbar ((struct frame *) msg.wParam,
2413 (struct scroll_bar *) msg.lParam);
2414 PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, (WPARAM)hwnd, 0);
2416 break;
2417 case WM_EMACS_KILL:
2418 return (0);
2421 else
2423 DispatchMessage (&msg);
2427 return (0);
2430 HDC
2431 map_mode (hdc)
2432 HDC hdc;
2434 if (hdc)
2436 #if 0
2437 /* Make mapping mode be in 1/20 of point */
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
2447 return (hdc);
2450 /* Convert between the modifier bits Win32 uses and the modifier bits
2451 Emacs uses. */
2452 unsigned int
2453 win32_get_modifiers ()
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));
2460 void
2461 my_post_msg (wmsg, hwnd, msg, wParam, lParam)
2462 Win32Msg * wmsg;
2463 HWND hwnd;
2464 UINT msg;
2465 WPARAM wParam;
2466 LPARAM lParam;
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 ();
2474 post_msg (wmsg);
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). */
2488 #define EMACS_LCONTROL 0
2489 #define EMACS_RCONTROL 1
2490 #define EMACS_LMENU 2
2491 #define EMACS_RMENU 3
2493 static int modifiers[4];
2494 static int modifiers_recorded;
2495 static int modifier_key_support_tested;
2497 static void
2498 test_modifier_support (unsigned int wparam)
2500 unsigned int l, r;
2502 if (wparam != VK_CONTROL && wparam != VK_MENU)
2503 return;
2504 if (wparam == VK_CONTROL)
2506 l = VK_LCONTROL;
2507 r = VK_RCONTROL;
2509 else
2511 l = VK_LMENU;
2512 r = VK_RMENU;
2514 if (!(GetKeyState (l) & 0x8000) && !(GetKeyState (r) & 0x8000))
2515 modifiers_recorded = 1;
2516 else
2517 modifiers_recorded = 0;
2518 modifier_key_support_tested = 1;
2521 static void
2522 record_keydown (unsigned int wparam, unsigned int lparam)
2524 int i;
2526 if (!modifier_key_support_tested)
2527 test_modifier_support (wparam);
2529 if ((wparam != VK_CONTROL && wparam != VK_MENU) || !modifiers_recorded)
2530 return;
2532 if (wparam == VK_CONTROL)
2533 i = (lparam & 0x1000000) ? EMACS_RCONTROL : EMACS_LCONTROL;
2534 else
2535 i = (lparam & 0x1000000) ? EMACS_RMENU : EMACS_LMENU;
2537 modifiers[i] = 1;
2540 static void
2541 record_keyup (unsigned int wparam, unsigned int lparam)
2543 int i;
2545 if ((wparam != VK_CONTROL && wparam != VK_MENU) || !modifiers_recorded)
2546 return;
2548 if (wparam == VK_CONTROL)
2549 i = (lparam & 0x1000000) ? EMACS_RCONTROL : EMACS_LCONTROL;
2550 else
2551 i = (lparam & 0x1000000) ? EMACS_RMENU : EMACS_LMENU;
2553 modifiers[i] = 0;
2556 static int
2557 modifier_set (int vkey)
2559 if (!modifiers_recorded)
2560 return (GetKeyState (vkey) & 0x8000);
2562 switch (vkey)
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;
2577 return (GetKeyState (vkey) & 0x8000);
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. */
2584 static int
2585 construct_modifiers (unsigned int wparam, unsigned int lparam)
2587 int mods;
2589 if (wparam != VK_CONTROL && wparam != VK_MENU)
2590 mods = GetLastError ();
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;
2600 return mods;
2603 /* Main window procedure */
2605 extern char *lispy_function_keys[];
2607 LRESULT CALLBACK
2608 win32_wnd_proc (hwnd, msg, wParam, lParam)
2609 HWND hwnd;
2610 UINT msg;
2611 WPARAM wParam;
2612 LPARAM lParam;
2614 struct frame *f;
2615 LRESULT ret = 1;
2616 struct win32_display_info *dpyinfo = &one_win32_display_info;
2617 Win32Msg wmsg;
2619 switch (msg)
2621 case WM_ERASEBKGND:
2623 HBRUSH hb;
2624 HANDLE oldobj;
2625 RECT rect;
2627 GetClientRect (hwnd, &rect);
2629 hb = CreateSolidBrush (GetWindowLong (hwnd, WND_BACKGROUND_INDEX));
2631 oldobj = SelectObject ((HDC)wParam, hb);
2633 FillRect((HDC)wParam, &rect, hb);
2635 SelectObject((HDC)wParam, oldobj);
2637 DeleteObject (hb);
2639 return (0);
2641 case WM_PAINT:
2643 PAINTSTRUCT paintStruct;
2645 BeginPaint (hwnd, &paintStruct);
2646 wmsg.rect = paintStruct.rcPaint;
2647 EndPaint (hwnd, &paintStruct);
2649 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
2651 return (0);
2654 case WM_CREATE:
2656 HDC hdc = my_get_dc (hwnd);
2658 /* Make mapping mode be in 1/20 of point */
2660 map_mode (hdc);
2662 ReleaseDC (hwnd, hdc);
2665 return (0);
2667 case WM_KEYUP:
2668 case WM_SYSKEYUP:
2669 record_keyup (wParam, lParam);
2670 goto dflt;
2672 case WM_KEYDOWN:
2673 case WM_SYSKEYDOWN:
2674 record_keydown (wParam, lParam);
2676 switch (wParam) {
2677 case VK_CONTROL: case VK_CAPITAL: case VK_MENU: case VK_SHIFT:
2678 goto dflt;
2679 default:
2680 break;
2683 if (lispy_function_keys[wParam] == 0)
2684 msg = WM_CHAR;
2686 /* Fall through */
2688 case WM_SYSCHAR:
2689 case WM_CHAR:
2690 wmsg.dwModifiers = construct_modifiers (wParam, lParam);
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:
2701 BOOL up;
2703 if (parse_button (msg, NULL, &up))
2705 if (up) ReleaseCapture ();
2706 else SetCapture (hwnd);
2710 wmsg.dwModifiers = win32_get_modifiers ();
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:
2727 WINDOWPLACEMENT wp;
2728 LPWINDOWPOS lppos = (WINDOWPOS *) lParam;
2730 GetWindowPlacement (hwnd, &wp);
2732 if (wp.showCmd != SW_SHOWMINIMIZED && ! (lppos->flags & SWP_NOSIZE))
2734 RECT rect;
2735 int wdiff;
2736 int hdiff;
2737 DWORD dwXUnits;
2738 DWORD dwYUnits;
2739 RECT wr;
2741 GetWindowRect (hwnd, &wr);
2743 enter_crit ();
2745 dwXUnits = GetWindowLong (hwnd, WND_X_UNITS_INDEX);
2746 dwYUnits = GetWindowLong (hwnd, WND_Y_UNITS_INDEX);
2748 leave_crit ();
2750 memset (&rect, 0, sizeof (rect));
2751 AdjustWindowRect (&rect, GetWindowLong (hwnd, GWL_STYLE),
2752 GetMenu (hwnd) != NULL);
2754 /* All windows have an extra pixel so subtract 1 */
2756 wdiff = (lppos->cx - (rect.right - rect.left) - 0) % dwXUnits;
2757 hdiff = (lppos->cy - (rect.bottom - rect.top) - 0) % dwYUnits;
2759 if (wdiff || hdiff)
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. */
2765 lppos->cx -= wdiff;
2766 lppos->cy -= hdiff;
2768 if (wp.showCmd != SW_SHOWMAXIMIZED
2769 && ! (lppos->flags & SWP_NOMOVE))
2771 if (lppos->x != wr.left || lppos->y != wr.top)
2773 lppos->x += wdiff;
2774 lppos->y += hdiff;
2776 else
2778 lppos->flags |= SWP_NOMOVE;
2782 ret = 0;
2787 if (ret == 0) return (0);
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);
2798 return (1);
2801 void
2802 my_create_window (f)
2803 struct frame * f;
2805 MSG msg;
2807 PostThreadMessage (dwWinThreadId, WM_EMACS_CREATEWINDOW, (WPARAM)f, 0);
2808 GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
2811 /* Create and set up the win32 window for frame F. */
2813 static void
2814 win32_window (f, window_prompting, minibuffer_only)
2815 struct frame *f;
2816 long window_prompting;
2817 int minibuffer_only;
2819 BLOCK_INPUT;
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.
2825 Elsewhere we specify the window name for the window manager. */
2828 char *str = (char *) XSTRING (Vx_resource_name)->data;
2829 f->namebuf = (char *) xmalloc (strlen (str) + 1);
2830 strcpy (f->namebuf, str);
2833 my_create_window (f);
2835 validate_x_resource_name ();
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. */
2842 Lisp_Object name;
2843 int explicit = f->explicit_name;
2845 f->explicit_name = 0;
2846 name = f->name;
2847 f->name = Qnil;
2848 x_set_name (f, name, explicit);
2851 UNBLOCK_INPUT;
2853 if (!minibuffer_only && FRAME_EXTERNAL_MENU_BAR (f))
2854 initialize_frame_menubar (f);
2856 if (FRAME_WIN32_WINDOW (f) == 0)
2857 error ("Unable to create window");
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. */
2864 static void
2865 x_icon (f, parms)
2866 struct frame *f;
2867 Lisp_Object parms;
2869 Lisp_Object icon_x, icon_y;
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))
2877 CHECK_NUMBER (icon_x, 0);
2878 CHECK_NUMBER (icon_y, 0);
2880 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
2881 error ("Both left and top icon corners of icon must be specified");
2883 BLOCK_INPUT;
2885 if (! EQ (icon_x, Qunbound))
2886 x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y));
2888 UNBLOCK_INPUT;
2891 DEFUN ("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\
2894 Returns an Emacs frame object.\n\
2895 ALIST is an alist of frame parameters.\n\
2896 If the parameters specify that the frame should not have a minibuffer,\n\
2897 and do not specify a specific minibuffer window to use,\n\
2898 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
2899 be shared by the new frame.\n\
2901 This function is an internal primitive--use `make-frame' instead.")
2902 (parms)
2903 Lisp_Object parms;
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;
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;
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
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");
2938 if (STRINGP (name))
2939 Vx_resource_name = name;
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);
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))
2953 f = make_minibuffer_frame ();
2954 minibuffer_only = 1;
2956 else if (WINDOWP (tem))
2957 f = make_frame_without_minibuffer (tem, kb, display);
2958 else
2959 f = make_frame (1);
2961 /* Note that Windows does support scroll bars. */
2962 FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
2964 XSETFRAME (frame, f);
2965 GCPRO1 (frame);
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));
2971 /* FRAME_WIN32_DISPLAY_INFO (f) = dpyinfo; */
2972 #ifdef MULTI_KBOARD
2973 FRAME_KBOARD (f) = kb;
2974 #endif
2976 /* Specify the parent under which to make this window. */
2978 if (!NILP (parent))
2980 f->output_data.win32->parent_desc = (Window) parent;
2981 f->output_data.win32->explicit_parent = 1;
2983 else
2985 f->output_data.win32->parent_desc = FRAME_WIN32_DISPLAY_INFO (f)->root_window;
2986 f->output_data.win32->explicit_parent = 0;
2989 /* Note that the frame has no physical cursor right now. */
2990 f->phys_cursor_x = -1;
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))
2996 f->name = build_string (dpyinfo->win32_id_name);
2997 f->explicit_name = 0;
2999 else
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);
3007 /* Extract the window parameters from the supplied values
3008 that are needed to determine window geometry. */
3010 Lisp_Object font;
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))
3034 font = x_new_font (f, "-*-Fixedsys-*-r-*-*-12-90-*-*-c-*-*-*");
3035 UNBLOCK_INPUT;
3036 if (! STRINGP (font))
3037 font = build_string ("-*-system");
3039 x_default_parameter (f, parms, Qfont, font,
3040 "font", "Font", string);
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)))
3050 Lisp_Object value;
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);
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);
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);
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);
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);
3084 if (window_prompting & XNegative)
3086 if (window_prompting & YNegative)
3087 f->output_data.win32->win_gravity = SouthEastGravity;
3088 else
3089 f->output_data.win32->win_gravity = NorthEastGravity;
3091 else
3093 if (window_prompting & YNegative)
3094 f->output_data.win32->win_gravity = SouthWestGravity;
3095 else
3096 f->output_data.win32->win_gravity = NorthWestGravity;
3099 f->output_data.win32->size_hint_flags = window_prompting;
3101 win32_window (f, window_prompting, minibuffer_only);
3102 x_icon (f, parms);
3103 init_frame_faces (f);
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);
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);
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);
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;
3131 tem = x_get_arg (parms, Qunsplittable, 0, 0, boolean);
3132 f->no_split = minibuffer_only || EQ (tem, Qt);
3134 UNGCPRO;
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);
3142 /* Now that the frame is official, it counts as a reference to
3143 its display. */
3144 FRAME_WIN32_DISPLAY_INFO (f)->reference_count++;
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)
3151 Lisp_Object visibility;
3153 visibility = x_get_arg (parms, Qvisibility, 0, 0, symbol);
3154 if (EQ (visibility, Qunbound))
3155 visibility = Qt;
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. */
3166 return unbind_to (count, frame);
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. */
3172 Lisp_Object
3173 x_get_focus_frame (frame)
3174 struct frame *frame;
3176 struct win32_display_info *dpyinfo = FRAME_WIN32_DISPLAY_INFO (frame);
3177 Lisp_Object xfocus;
3178 if (! dpyinfo->win32_focus_frame)
3179 return Qnil;
3181 XSETFRAME (xfocus, dpyinfo->win32_focus_frame);
3182 return xfocus;
3185 DEFUN ("focus-frame", Ffocus_frame, Sfocus_frame, 1, 1, 0,
3186 "Set the focus on FRAME.")
3187 (frame)
3188 Lisp_Object frame;
3190 CHECK_LIVE_FRAME (frame, 0);
3192 if (FRAME_WIN32_P (XFRAME (frame)))
3194 BLOCK_INPUT;
3195 x_focus_on_frame (XFRAME (frame));
3196 UNBLOCK_INPUT;
3197 return frame;
3200 return Qnil;
3203 DEFUN ("unfocus-frame", Funfocus_frame, Sunfocus_frame, 0, 0, 0,
3204 "If a frame has been focused, release it.")
3207 if (FRAME_WIN32_P (selected_frame))
3209 struct win32_display_info *dpyinfo = FRAME_WIN32_DISPLAY_INFO (selected_frame);
3211 if (dpyinfo->win32_focus_frame)
3213 BLOCK_INPUT;
3214 x_unfocus_frame (dpyinfo->win32_focus_frame);
3215 UNBLOCK_INPUT;
3219 return Qnil;
3222 XFontStruct
3223 *win32_load_font (dpyinfo,name)
3224 struct win32_display_info *dpyinfo;
3225 char * name;
3227 XFontStruct * font = NULL;
3228 BOOL ok;
3231 LOGFONT lf;
3233 if (!name || !x_to_win32_font(name, &lf))
3234 return (NULL);
3236 font = (XFontStruct *) xmalloc (sizeof (XFontStruct));
3238 if (!font) return (NULL);
3240 BLOCK_INPUT;
3242 font->hfont = CreateFontIndirect(&lf);
3245 if (font->hfont == NULL)
3247 ok = FALSE;
3249 else
3251 HDC hdc;
3252 HANDLE oldobj;
3254 hdc = my_get_dc (dpyinfo->root_window);
3256 oldobj = SelectObject (hdc, font->hfont);
3258 ok = GetTextMetrics (hdc, &font->tm);
3260 SelectObject (hdc, oldobj);
3262 ReleaseDC (dpyinfo->root_window, hdc);
3265 UNBLOCK_INPUT;
3267 if (ok) return (font);
3269 win32_unload_font(dpyinfo, font);
3270 return (NULL);
3273 void
3274 win32_unload_font (dpyinfo, font)
3275 struct win32_display_info *dpyinfo;
3276 XFontStruct * font;
3278 if (font)
3280 if (font->hfont) DeleteObject(font->hfont);
3281 xfree (font);
3285 /* The font conversion stuff between x and win32 */
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 "[^-]+")
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)
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 "[^-]+"
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 "[-?*]\\|\\'")
3349 #define FONT_REGEXP_HEAD ("\\`[-?*]" \
3350 FONT_FOUNDRY "-" \
3351 FONT_FAMILY "-" \
3352 FONT_WEIGHT_Q "-" \
3353 FONT_SLANT_Q \
3354 "\\([-*?]\\|\\'\\)")
3356 #define FONT_REGEXP_SLANT "-" FONT_SLANT "-"
3357 #define FONT_REGEXP_WEIGHT "-" FONT_WEIGHT "-"
3359 LONG
3360 x_to_win32_weight (lpw)
3361 char * lpw;
3363 if (!lpw) return (FW_DONTCARE);
3365 if (stricmp (lpw, "bold") == 0)
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);
3377 char *
3378 win32_to_x_weight (fnweight)
3379 int fnweight;
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");
3391 BOOL
3392 win32_to_x_font (lplogfont, lpxstr, len)
3393 LOGFONT * lplogfont;
3394 char * lpxstr;
3395 int len;
3397 if (!lpxstr) return (FALSE);
3399 if (lplogfont)
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;
3406 height = abs (height);
3407 _snprintf (lpxstr, len - 1,
3408 "-*-%s-%s-%c-%s-%s-*-%d-*-*-%c-%d-*-*-",
3409 lplogfont->lfFaceName,
3410 win32_to_x_weight (lplogfont->lfWeight),
3411 lplogfont->lfItalic ? 'i' : 'r',
3412 "*", "*",
3413 height,
3414 ((lplogfont->lfPitchAndFamily & 0x3) == VARIABLE_PITCH) ? 'p' : 'c',
3415 width);
3417 else
3419 strncpy (lpxstr, "-*-*-*-*-*-*-*-*-*-*-*-*-*-*-", len - 1);
3422 lpxstr[len - 1] = 0; /* just to be sure */
3423 return (TRUE);
3426 BOOL
3427 x_to_win32_font (lpxstr, lplogfont)
3428 char * lpxstr;
3429 LOGFONT * lplogfont;
3431 if (!lplogfont) return (FALSE);
3433 memset (lplogfont, 0, sizeof (*lplogfont));
3435 lplogfont->lfCharSet = OEM_CHARSET;
3436 lplogfont->lfOutPrecision = OUT_DEFAULT_PRECIS;
3437 lplogfont->lfClipPrecision = CLIP_DEFAULT_PRECIS;
3438 lplogfont->lfQuality = DEFAULT_QUALITY;
3440 if (lpxstr && *lpxstr == '-') lpxstr++;
3443 int fields;
3444 char name[50], weight[20], slant, pitch, height[10], width[10];
3446 fields = (lpxstr
3447 ? sscanf (lpxstr,
3448 "%*[^-]-%[^-]-%[^-]-%c-%*[^-]-%*[^-]-%*[^-]-%[^-]-%*[^-]-%*[^-]-%c-%[^-]",
3449 name, weight, &slant, height, &pitch, width)
3450 : 0);
3452 if (fields == EOF) return (FALSE);
3454 if (fields > 0 && name[0] != '*')
3456 strncpy (lplogfont->lfFaceName, name, LF_FACESIZE);
3458 else
3460 lplogfont->lfFaceName[0] = 0;
3463 fields--;
3465 lplogfont->lfWeight = x_to_win32_weight((fields > 0 ? weight : ""));
3467 fields--;
3469 lplogfont->lfItalic = (fields > 0 && slant == 'i');
3471 fields--;
3473 if (fields > 0 && height[0] != '*')
3474 lplogfont->lfHeight = (atoi (height) * one_win32_display_info.height_in) / 1440;
3476 fields--;
3478 lplogfont->lfPitchAndFamily = (fields > 0 && pitch == 'p') ? VARIABLE_PITCH : FIXED_PITCH;
3480 fields--;
3482 if (fields > 0 && width[0] != '*')
3483 lplogfont->lfWidth = (atoi (width) * one_win32_display_info.width_in) / 1440;
3485 lplogfont->lfCharSet = ANSI_CHARSET;
3488 return (TRUE);
3491 BOOL
3492 win32_font_match (lpszfont1, lpszfont2)
3493 char * lpszfont1;
3494 char * lpszfont2;
3496 char * s1 = lpszfont1, *e1;
3497 char * s2 = lpszfont2, *e2;
3499 if (s1 == NULL || s2 == NULL) return (FALSE);
3501 if (*s1 == '-') s1++;
3502 if (*s2 == '-') s2++;
3504 while (1)
3506 int len1, len2;
3508 e1 = strchr (s1, '-');
3509 e2 = strchr (s2, '-');
3511 if (e1 == NULL || e2 == NULL) return (TRUE);
3513 len1 = e1 - s1;
3514 len2 = e2 - s2;
3516 if (*s1 != '*' && *s2 != '*'
3517 && (len1 != len2 || strnicmp (s1, s2, len1) != 0))
3518 return (FALSE);
3520 s1 = e1 + 1;
3521 s2 = e2 + 1;
3525 typedef struct enumfont_t
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;
3535 int CALLBACK
3536 enum_font_cb2 (lplf, lptm, FontType, lpef)
3537 ENUMLOGFONT * lplf;
3538 NEWTEXTMETRIC * lptm;
3539 int FontType;
3540 enumfont_t * lpef;
3542 if (lplf->elfLogFont.lfStrikeOut || lplf->elfLogFont.lfUnderline
3543 || (lplf->elfLogFont.lfCharSet != ANSI_CHARSET && lplf->elfLogFont.lfCharSet != OEM_CHARSET))
3544 return (1);
3546 /* if (!lpef->size_ref || lptm->tmMaxCharWidth == FONT_WIDTH (lpef->size_ref)) */
3548 char buf[100];
3550 if (!win32_to_x_font (lplf, buf, 100)) return (0);
3552 if (NILP (*(lpef->pattern)) || win32_font_match (buf, XSTRING (*(lpef->pattern))->data))
3554 *lpef->tail = Fcons (build_string (buf), Qnil);
3555 lpef->tail = &XCONS (*lpef->tail)->cdr;
3556 lpef->numFonts++;
3560 return (1);
3563 int CALLBACK
3564 enum_font_cb1 (lplf, lptm, FontType, lpef)
3565 ENUMLOGFONT * lplf;
3566 NEWTEXTMETRIC * lptm;
3567 int FontType;
3568 enumfont_t * lpef;
3570 return EnumFontFamilies (lpef->hdc,
3571 lplf->elfLogFont.lfFaceName,
3572 (FONTENUMPROC) enum_font_cb2,
3573 (LPARAM) lpef);
3577 DEFUN ("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\
3579 If optional arguments FACE and FRAME are specified, return only fonts\n\
3580 the same size as FACE on FRAME.\n\
3582 PATTERN 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\
3586 FACE is a face name--a symbol.\n\
3588 The return value is a list of strings, suitable as arguments to\n\
3589 set-face-font.\n\
3591 Fonts Emacs can't use (i.e. proportional fonts) may or may not be excluded\n\
3592 even if they match PATTERN and FACE.")
3593 (pattern, face, frame)
3594 Lisp_Object pattern, face, frame;
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;
3605 CHECK_STRING (pattern, 0);
3606 if (!NILP (face))
3607 CHECK_SYMBOL (face, 1);
3609 f = check_x_frame (frame);
3611 /* Determine the width standard for comparison with the fonts we find. */
3613 if (NILP (face))
3614 size_ref = 0;
3615 else
3617 int face_id;
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'");
3623 face_id = face_name_id_number (f, face);
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
3630 size_ref = FRAME_PARAM_FACES (f) [face_id]->font;
3631 if (size_ref == (XFontStruct *) (~0))
3632 size_ref = f->output_data.win32->font;
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);
3640 /* We have info in the cache for this PATTERN. */
3641 if (!NILP (list))
3643 Lisp_Object tem, newlist;
3645 /* We have info about this pattern. */
3646 list = XCONS (list)->cdr;
3648 if (size_ref == 0)
3649 return list;
3651 BLOCK_INPUT;
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)
3657 XFontStruct *thisinfo;
3659 thisinfo = win32_load_font (FRAME_WIN32_DISPLAY_INFO (f), XSTRING (XCONS (tem)->car)->data);
3661 if (thisinfo && same_size_fonts (thisinfo, size_ref))
3662 newlist = Fcons (XCONS (tem)->car, newlist);
3664 win32_unload_font (FRAME_WIN32_DISPLAY_INFO (f), thisinfo);
3667 UNBLOCK_INPUT;
3669 return newlist;
3672 BLOCK_INPUT;
3674 namelist = Qnil;
3675 ef.pattern = &pattern;
3676 ef.tail = ef.head = &namelist;
3677 ef.numFonts = 0;
3680 ef.hdc = my_get_dc (FRAME_WIN32_WINDOW (f));
3682 EnumFontFamilies (ef.hdc, NULL, (FONTENUMPROC) enum_font_cb1, (LPARAM)&ef);
3684 ReleaseDC (FRAME_WIN32_WINDOW (f), ef.hdc);
3687 UNBLOCK_INPUT;
3689 if (ef.numFonts)
3691 int i;
3692 Lisp_Object cur;
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);
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++)
3705 int keeper;
3707 if (!size_ref)
3708 keeper = 1;
3709 else
3711 XFontStruct *thisinfo;
3713 BLOCK_INPUT;
3714 thisinfo = win32_load_font (FRAME_WIN32_DISPLAY_INFO (f), XSTRING (Fcar (cur))->data);
3716 keeper = thisinfo && same_size_fonts (thisinfo, size_ref);
3718 win32_unload_font (FRAME_WIN32_DISPLAY_INFO (f), thisinfo);
3720 UNBLOCK_INPUT;
3722 if (keeper)
3723 list = Fcons (build_string (XSTRING (Fcar (cur))->data), list);
3725 cur = Fcdr (cur);
3727 list = Fnreverse (list);
3730 return list;
3733 DEFUN ("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\
3735 If FRAME is omitted or nil, use the selected frame.")
3736 (color, frame)
3737 Lisp_Object color, frame;
3739 COLORREF foo;
3740 FRAME_PTR f = check_x_frame (frame);
3742 CHECK_STRING (color, 1);
3744 if (defined_color (f, XSTRING (color)->data, &foo, 0))
3745 return Qt;
3746 else
3747 return Qnil;
3750 DEFUN ("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\
3752 The value is a list of integer RGB values--(RED GREEN BLUE).\n\
3753 These values appear to range from 0 to 65280 or 65535, depending\n\
3754 on the system; white is (65280 65280 65280) or (65535 65535 65535).\n\
3755 If FRAME is omitted or nil, use the selected frame.")
3756 (color, frame)
3757 Lisp_Object color, frame;
3759 COLORREF foo;
3760 FRAME_PTR f = check_x_frame (frame);
3762 CHECK_STRING (color, 1);
3764 if (defined_color (f, XSTRING (color)->data, &foo, 0))
3766 Lisp_Object rgb[3];
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);
3773 else
3774 return Qnil;
3777 DEFUN ("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\
3779 The optional argument DISPLAY specifies which display to ask about.\n\
3780 DISPLAY should be either a frame or a display name (a string).\n\
3781 If omitted or nil, that stands for the selected frame's display.")
3782 (display)
3783 Lisp_Object display;
3785 struct win32_display_info *dpyinfo = check_x_display_info (display);
3787 if ((dpyinfo->n_planes * dpyinfo->n_cbits) <= 2)
3788 return Qnil;
3790 return Qt;
3793 DEFUN ("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\
3796 Note that color displays do support shades of gray.\n\
3797 The optional argument DISPLAY specifies which display to ask about.\n\
3798 DISPLAY should be either a frame or a display name (a string).\n\
3799 If omitted or nil, that stands for the selected frame's display.")
3800 (display)
3801 Lisp_Object display;
3803 struct win32_display_info *dpyinfo = check_x_display_info (display);
3805 if ((dpyinfo->n_planes * dpyinfo->n_cbits) <= 1)
3806 return Qnil;
3808 return Qt;
3811 DEFUN ("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\
3814 The optional argument DISPLAY specifies which display to ask about.\n\
3815 DISPLAY should be either a frame or a display name (a string).\n\
3816 If omitted or nil, that stands for the selected frame's display.")
3817 (display)
3818 Lisp_Object display;
3820 struct win32_display_info *dpyinfo = check_x_display_info (display);
3822 return make_number (dpyinfo->width);
3825 DEFUN ("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\
3828 The optional argument DISPLAY specifies which display to ask about.\n\
3829 DISPLAY should be either a frame or a display name (a string).\n\
3830 If omitted or nil, that stands for the selected frame's display.")
3831 (display)
3832 Lisp_Object display;
3834 struct win32_display_info *dpyinfo = check_x_display_info (display);
3836 return make_number (dpyinfo->height);
3839 DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
3840 0, 1, 0,
3841 "Returns the number of bitplanes of the display DISPLAY.\n\
3842 The optional argument DISPLAY specifies which display to ask about.\n\
3843 DISPLAY should be either a frame or a display name (a string).\n\
3844 If omitted or nil, that stands for the selected frame's display.")
3845 (display)
3846 Lisp_Object display;
3848 struct win32_display_info *dpyinfo = check_x_display_info (display);
3850 return make_number (dpyinfo->n_planes * dpyinfo->n_cbits);
3853 DEFUN ("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\
3856 The optional argument DISPLAY specifies which display to ask about.\n\
3857 DISPLAY should be either a frame or a display name (a string).\n\
3858 If omitted or nil, that stands for the selected frame's display.")
3859 (display)
3860 Lisp_Object display;
3862 struct win32_display_info *dpyinfo = check_x_display_info (display);
3863 HDC hdc;
3864 int cap;
3866 hdc = my_get_dc (dpyinfo->root_window);
3868 cap = GetDeviceCaps (hdc,NUMCOLORS);
3870 ReleaseDC (dpyinfo->root_window, hdc);
3872 return make_number (cap);
3875 DEFUN ("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\
3879 The optional argument DISPLAY specifies which display to ask about.\n\
3880 DISPLAY should be either a frame or a display name (a string).\n\
3881 If omitted or nil, that stands for the selected frame's display.")
3882 (display)
3883 Lisp_Object display;
3885 struct win32_display_info *dpyinfo = check_x_display_info (display);
3887 return make_number (1);
3890 DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
3891 "Returns the vendor ID string of the Win32 system (Microsoft).\n\
3892 The optional argument DISPLAY specifies which display to ask about.\n\
3893 DISPLAY should be either a frame or a display name (a string).\n\
3894 If omitted or nil, that stands for the selected frame's display.")
3895 (display)
3896 Lisp_Object display;
3898 struct win32_display_info *dpyinfo = check_x_display_info (display);
3899 char *vendor = "Microsoft Corp.";
3901 if (! vendor) vendor = "";
3902 return build_string (vendor);
3905 DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
3906 "Returns the version numbers of the server of display DISPLAY.\n\
3907 The value is a list of three integers: the major and minor\n\
3908 version numbers, and the vendor-specific release\n\
3909 number. See also the function `x-server-vendor'.\n\n\
3910 The optional argument DISPLAY specifies which display to ask about.\n\
3911 DISPLAY should be either a frame or a display name (a string).\n\
3912 If omitted or nil, that stands for the selected frame's display.")
3913 (display)
3914 Lisp_Object display;
3916 struct win32_display_info *dpyinfo = check_x_display_info (display);
3918 return Fcons (make_number (nt_major_version),
3919 Fcons (make_number (nt_minor_version), Qnil));
3922 DEFUN ("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\
3924 The optional argument DISPLAY specifies which display to ask about.\n\
3925 DISPLAY should be either a frame or a display name (a string).\n\
3926 If omitted or nil, that stands for the selected frame's display.")
3927 (display)
3928 Lisp_Object display;
3930 struct win32_display_info *dpyinfo = check_x_display_info (display);
3932 return make_number (1);
3935 DEFUN ("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\
3937 The optional argument DISPLAY specifies which display to ask about.\n\
3938 DISPLAY should be either a frame or a display name (a string).\n\
3939 If omitted or nil, that stands for the selected frame's display.")
3940 (display)
3941 Lisp_Object display;
3943 struct win32_display_info *dpyinfo = check_x_display_info (display);
3944 HDC hdc;
3945 int cap;
3947 hdc = my_get_dc (dpyinfo->root_window);
3949 cap = GetDeviceCaps (hdc, VERTSIZE);
3951 ReleaseDC (dpyinfo->root_window, hdc);
3953 return make_number (cap);
3956 DEFUN ("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\
3958 The optional argument DISPLAY specifies which display to ask about.\n\
3959 DISPLAY should be either a frame or a display name (a string).\n\
3960 If omitted or nil, that stands for the selected frame's display.")
3961 (display)
3962 Lisp_Object display;
3964 struct win32_display_info *dpyinfo = check_x_display_info (display);
3966 HDC hdc;
3967 int cap;
3969 hdc = my_get_dc (dpyinfo->root_window);
3971 cap = GetDeviceCaps (hdc, HORZSIZE);
3973 ReleaseDC (dpyinfo->root_window, hdc);
3975 return make_number (cap);
3978 DEFUN ("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\
3981 The value may be `always', `when-mapped', or `not-useful'.\n\
3982 The optional argument DISPLAY specifies which display to ask about.\n\
3983 DISPLAY should be either a frame or a display name (a string).\n\
3984 If omitted or nil, that stands for the selected frame's display.")
3985 (display)
3986 Lisp_Object display;
3988 return intern ("not-useful");
3991 DEFUN ("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\
3994 The value is one of the symbols `static-gray', `gray-scale',\n\
3995 `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
3996 The optional argument DISPLAY specifies which display to ask about.\n\
3997 DISPLAY should be either a frame or a display name (a string).\n\
3998 If omitted or nil, that stands for the selected frame's display.")
3999 (display)
4000 Lisp_Object display;
4002 struct win32_display_info *dpyinfo = check_x_display_info (display);
4004 #if 0
4005 switch (dpyinfo->visual->class)
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");
4016 #endif
4018 error ("Display has an unknown visual class");
4021 DEFUN ("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\
4024 The optional argument DISPLAY specifies which display to ask about.\n\
4025 DISPLAY should be either a frame or a display name (a string).\n\
4026 If omitted or nil, that stands for the selected frame's display.")
4027 (display)
4028 Lisp_Object display;
4030 struct win32_display_info *dpyinfo = check_x_display_info (display);
4032 return Qnil;
4036 x_pixel_width (f)
4037 register struct frame *f;
4039 return PIXEL_WIDTH (f);
4043 x_pixel_height (f)
4044 register struct frame *f;
4046 return PIXEL_HEIGHT (f);
4050 x_char_width (f)
4051 register struct frame *f;
4053 return FONT_WIDTH (f->output_data.win32->font);
4057 x_char_height (f)
4058 register struct frame *f;
4060 return f->output_data.win32->line_height;
4064 x_screen_planes (frame)
4065 Lisp_Object frame;
4067 return (FRAME_WIN32_DISPLAY_INFO (XFRAME (frame))->n_planes *
4068 FRAME_WIN32_DISPLAY_INFO (XFRAME (frame))->n_cbits);
4071 /* Return the display structure for the display named NAME.
4072 Open a new connection if necessary. */
4074 struct win32_display_info *
4075 x_display_info_for_name (name)
4076 Lisp_Object name;
4078 Lisp_Object names;
4079 struct win32_display_info *dpyinfo;
4081 CHECK_STRING (name, 0);
4083 for (dpyinfo = &one_win32_display_info, names = win32_display_name_list;
4084 dpyinfo;
4085 dpyinfo = dpyinfo->next, names = XCONS (names)->cdr)
4087 Lisp_Object tem;
4088 tem = Fstring_equal (XCONS (XCONS (names)->car)->car, name);
4089 if (!NILP (tem))
4090 return dpyinfo;
4093 /* Use this general default value to start with. */
4094 Vx_resource_name = Vinvocation_name;
4096 validate_x_resource_name ();
4098 dpyinfo = win32_term_init (name, (unsigned char *)0,
4099 (char *) XSTRING (Vx_resource_name)->data);
4101 if (dpyinfo == 0)
4102 error ("Cannot connect to server %s", XSTRING (name)->data);
4104 XSETFASTINT (Vwindow_system_version, 3);
4106 return dpyinfo;
4109 DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
4110 1, 3, 0, "Open a connection to a server.\n\
4111 DISPLAY is the name of the display to connect to.\n\
4112 Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
4113 If the optional third arg MUST-SUCCEED is non-nil,\n\
4114 terminate Emacs if we can't open the connection.")
4115 (display, xrm_string, must_succeed)
4116 Lisp_Object display, xrm_string, must_succeed;
4118 unsigned int n_planes;
4119 unsigned char *xrm_option;
4120 struct win32_display_info *dpyinfo;
4122 CHECK_STRING (display, 0);
4123 if (! NILP (xrm_string))
4124 CHECK_STRING (xrm_string, 1);
4126 Vwin32_color_map = Fwin32_default_color_map ();
4128 if (! NILP (xrm_string))
4129 xrm_option = (unsigned char *) XSTRING (xrm_string)->data;
4130 else
4131 xrm_option = (unsigned char *) 0;
4133 /* Use this general default value to start with. */
4134 Vx_resource_name = Vinvocation_name;
4136 validate_x_resource_name ();
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);
4143 if (dpyinfo == 0)
4145 if (!NILP (must_succeed))
4146 fatal ("Cannot connect to server %s.\n",
4147 XSTRING (display)->data);
4148 else
4149 error ("Cannot connect to server %s", XSTRING (display)->data);
4152 XSETFASTINT (Vwindow_system_version, 3);
4153 return Qnil;
4156 DEFUN ("x-close-connection", Fx_close_connection,
4157 Sx_close_connection, 1, 1, 0,
4158 "Close the connection to DISPLAY's server.\n\
4159 For DISPLAY, specify either a frame or a display name (a string).\n\
4160 If DISPLAY is nil, that stands for the selected frame's display.")
4161 (display)
4162 Lisp_Object display;
4164 struct win32_display_info *dpyinfo = check_x_display_info (display);
4165 struct win32_display_info *tail;
4166 int i;
4168 if (dpyinfo->reference_count > 0)
4169 error ("Display still has frames on it");
4171 BLOCK_INPUT;
4172 /* Free the fonts in the font table. */
4173 for (i = 0; i < dpyinfo->n_fonts; i++)
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);
4181 x_destroy_all_bitmaps (dpyinfo);
4183 x_delete_display (dpyinfo);
4184 UNBLOCK_INPUT;
4186 return Qnil;
4189 DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0,
4190 "Return the list of display names that Emacs has connections to.")
4193 Lisp_Object tail, result;
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);
4199 return result;
4202 DEFUN ("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\
4204 If ON is nil, allow buffering of requests.\n\
4205 This is a noop on Win32 systems.\n\
4206 The optional second argument DISPLAY specifies which display to act on.\n\
4207 DISPLAY should be either a frame or a display name (a string).\n\
4208 If DISPLAY is omitted or nil, that stands for the selected frame's display.")
4209 (on, display)
4210 Lisp_Object display, on;
4212 struct win32_display_info *dpyinfo = check_x_display_info (display);
4214 return Qnil;
4218 /* These are the win32 specialized functions */
4220 DEFUN ("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;
4225 FRAME_PTR f = check_x_frame (frame);
4226 CHOOSEFONT cf;
4227 LOGFONT lf;
4228 char buf[100];
4230 bzero (&cf, sizeof (cf));
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;
4237 if (!ChooseFont (&cf) || !win32_to_x_font (&lf, buf, 100))
4238 return Qnil;
4240 return build_string (buf);
4244 syms_of_win32fns ()
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. */
4317 Fput (Qundefined_color, Qerror_conditions,
4318 Fcons (Qundefined_color, Fcons (Qerror, Qnil)));
4319 Fput (Qundefined_color, Qerror_message,
4320 build_string ("Undefined color"));
4322 DEFVAR_LISP ("win32-color-map", &Vwin32_color_map,
4323 "A array of color name mappings for windows.");
4324 Vwin32_color_map = Qnil;
4326 init_x_parm_symbols ();
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");
4332 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape,
4333 "The shape of the pointer when over text.\n\
4334 Changing the value does not affect existing frames\n\
4335 unless you set the mouse color.");
4336 Vx_pointer_shape = Qnil;
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\
4341 when requesting resource values.\n\
4342 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
4343 was invoked, or to the value specified with the `-name' or `-rn'\n\
4344 switches, if present.");
4345 Vx_resource_name = Qnil;
4347 Vx_nontext_pointer_shape = Qnil;
4349 Vx_mode_pointer_shape = Qnil;
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\
4354 This variable takes effect when you create a new frame\n\
4355 or when you set the mouse color.");
4356 Vx_sensitive_text_pointer_shape = Qnil;
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;
4362 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager,
4363 "Non-nil if no window manager is in use.\n\
4364 Emacs doesn't try to figure this out; this is always nil\n\
4365 unless 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;
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);
4398 /* Win32 specific functions */
4400 defsubr (&Swin32_select_font);
4403 #undef abort
4405 void
4406 win32_abort()
4408 MessageBox (NULL,
4409 "A fatal error has occurred - aborting!",
4410 "Emacs Abort Dialog",
4411 MB_OK|MB_ICONEXCLAMATION);
4412 abort();