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