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