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