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