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