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