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