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