HCoop / bpt / emacs.git / blob
? search:
summary | shortlog | log | commit | commitdiff | tree
blame | history | raw | HEAD
(w32_wnd_proc): Fix bug introduced by previous change;
[bpt/emacs.git] / src / w32fns.c
1 /* Graphical user interface functions for the Microsoft W32 API.
2 Copyright (C) 1989, 92, 93, 94, 95, 1996 Free Software Foundation, Inc.
3
4 This file is part of GNU Emacs.
5
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
9 any later version.
10
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
15
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
20
21 /* Added by Kevin Gallo */
22
23 #include <config.h>
24
25 #include <signal.h>
26 #include <stdio.h>
27 #include <limits.h>
28 #include <errno.h>
29
30 #include "lisp.h"
31 #include "charset.h"
32 #include "fontset.h"
33 #include "w32term.h"
34 #include "frame.h"
35 #include "window.h"
36 #include "buffer.h"
37 #include "dispextern.h"
38 #include "keyboard.h"
39 #include "blockinput.h"
40 #include "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 int key;
3660
3661 /* Note that it is okay to call x_window_to_frame, even though we are
3662 not running in the main lisp thread, because frame deletion
3663 requires the lisp thread to synchronize with this thread. Thus, if
3664 a frame struct is returned, it can be used without concern that the
3665 lisp thread might make it disappear while we are using it.
3666
3667 NB. Walking the frame list in this thread is safe (as long as
3668 writes of Lisp_Object slots are atomic, which they are on Windows).
3669 Although delete-frame can destructively modify the frame list while
3670 we are walking it, a garbage collection cannot occur until after
3671 delete-frame has synchronized with this thread.
3672
3673 It is also safe to use functions that make GDI calls, such as
3674 w32_clear_rect, because these functions must obtain a DC handle
3675 from the frame struct using get_frame_dc which is thread-aware. */
3676
3677 switch (msg)
3678 {
3679 case WM_ERASEBKGND:
3680 f = x_window_to_frame (dpyinfo, hwnd);
3681 if (f)
3682 {
3683 GetUpdateRect (hwnd, &wmsg.rect, FALSE);
3684 w32_clear_rect (f, NULL, &wmsg.rect);
3685 }
3686 return 1;
3687 case WM_PALETTECHANGED:
3688 /* ignore our own changes */
3689 if ((HWND)wParam != hwnd)
3690 {
3691 f = x_window_to_frame (dpyinfo, hwnd);
3692 if (f)
3693 /* get_frame_dc will realize our palette and force all
3694 frames to be redrawn if needed. */
3695 release_frame_dc (f, get_frame_dc (f));
3696 }
3697 return 0;
3698 case WM_PAINT:
3699 {
3700 PAINTSTRUCT paintStruct;
3701
3702 enter_crit ();
3703 BeginPaint (hwnd, &paintStruct);
3704 wmsg.rect = paintStruct.rcPaint;
3705 EndPaint (hwnd, &paintStruct);
3706 leave_crit ();
3707
3708 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3709
3710 return (0);
3711 }
3712
3713 case WM_INPUTLANGCHANGE:
3714 /* Inform lisp thread of keyboard layout changes. */
3715 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3716
3717 /* Clear dead keys in the keyboard state; for simplicity only
3718 preserve modifier key states. */
3719 {
3720 int i;
3721 BYTE keystate[256];
3722
3723 GetKeyboardState (keystate);
3724 for (i = 0; i < 256; i++)
3725 if (1
3726 && i != VK_SHIFT
3727 && i != VK_LSHIFT
3728 && i != VK_RSHIFT
3729 && i != VK_CAPITAL
3730 && i != VK_NUMLOCK
3731 && i != VK_SCROLL
3732 && i != VK_CONTROL
3733 && i != VK_LCONTROL
3734 && i != VK_RCONTROL
3735 && i != VK_MENU
3736 && i != VK_LMENU
3737 && i != VK_RMENU
3738 && i != VK_LWIN
3739 && i != VK_RWIN)
3740 keystate[i] = 0;
3741 SetKeyboardState (keystate);
3742 }
3743 goto dflt;
3744
3745 case WM_HOTKEY:
3746 /* Synchronize hot keys with normal input. */
3747 PostMessage (hwnd, WM_KEYDOWN, HIWORD (lParam), 0);
3748 return (0);
3749
3750 case WM_KEYUP:
3751 case WM_SYSKEYUP:
3752 record_keyup (wParam, lParam);
3753 goto dflt;
3754
3755 case WM_KEYDOWN:
3756 case WM_SYSKEYDOWN:
3757 /* Ignore keystrokes we fake ourself; see below. */
3758 if (dpyinfo->faked_key == wParam)
3759 {
3760 dpyinfo->faked_key = 0;
3761 /* Make sure TranslateMessage sees them though (as long as
3762 they don't produce WM_CHAR messages). This ensures that
3763 indicator lights are toggled promptly on Windows 9x, for
3764 example. */
3765 if (lispy_function_keys[wParam] != 0)
3766 {
3767 windows_translate = 1;
3768 goto translate;
3769 }
3770 return 0;
3771 }
3772
3773 /* Synchronize modifiers with current keystroke. */
3774 sync_modifiers ();
3775 record_keydown (wParam, lParam);
3776 wParam = map_keypad_keys (wParam, (lParam & 0x1000000L) != 0);
3777
3778 windows_translate = 0;
3779
3780 switch (wParam)
3781 {
3782 case VK_LWIN:
3783 if (NILP (Vw32_pass_lwindow_to_system))
3784 {
3785 /* Prevent system from acting on keyup (which opens the
3786 Start menu if no other key was pressed) by simulating a
3787 press of Space which we will ignore. */
3788 if (GetAsyncKeyState (wParam) & 1)
3789 {
3790 if (NUMBERP (Vw32_phantom_key_code))
3791 key = XUINT (Vw32_phantom_key_code) & 255;
3792 else
3793 key = VK_SPACE;
3794 dpyinfo->faked_key = key;
3795 keybd_event (key, (BYTE) MapVirtualKey (key, 0), 0, 0);
3796 }
3797 }
3798 if (!NILP (Vw32_lwindow_modifier))
3799 return 0;
3800 break;
3801 case VK_RWIN:
3802 if (NILP (Vw32_pass_rwindow_to_system))
3803 {
3804 if (GetAsyncKeyState (wParam) & 1)
3805 {
3806 if (NUMBERP (Vw32_phantom_key_code))
3807 key = XUINT (Vw32_phantom_key_code) & 255;
3808 else
3809 key = VK_SPACE;
3810 dpyinfo->faked_key = key;
3811 keybd_event (key, (BYTE) MapVirtualKey (key, 0), 0, 0);
3812 }
3813 }
3814 if (!NILP (Vw32_rwindow_modifier))
3815 return 0;
3816 break;
3817 case VK_APPS:
3818 if (!NILP (Vw32_apps_modifier))
3819 return 0;
3820 break;
3821 case VK_MENU:
3822 if (NILP (Vw32_pass_alt_to_system))
3823 /* Prevent DefWindowProc from activating the menu bar if an
3824 Alt key is pressed and released by itself. */
3825 return 0;
3826 windows_translate = 1;
3827 break;
3828 case VK_CAPITAL:
3829 /* Decide whether to treat as modifier or function key. */
3830 if (NILP (Vw32_enable_caps_lock))
3831 goto disable_lock_key;
3832 windows_translate = 1;
3833 break;
3834 case VK_NUMLOCK:
3835 /* Decide whether to treat as modifier or function key. */
3836 if (NILP (Vw32_enable_num_lock))
3837 goto disable_lock_key;
3838 windows_translate = 1;
3839 break;
3840 case VK_SCROLL:
3841 /* Decide whether to treat as modifier or function key. */
3842 if (NILP (Vw32_scroll_lock_modifier))
3843 goto disable_lock_key;
3844 windows_translate = 1;
3845 break;
3846 disable_lock_key:
3847 /* Ensure the appropriate lock key state (and indicator light)
3848 remains in the same state. We do this by faking another
3849 press of the relevant key. Apparently, this really is the
3850 only way to toggle the state of the indicator lights. */
3851 dpyinfo->faked_key = wParam;
3852 keybd_event ((BYTE) wParam, (BYTE) MapVirtualKey (wParam, 0),
3853 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
3854 keybd_event ((BYTE) wParam, (BYTE) MapVirtualKey (wParam, 0),
3855 KEYEVENTF_EXTENDEDKEY | 0, 0);
3856 keybd_event ((BYTE) wParam, (BYTE) MapVirtualKey (wParam, 0),
3857 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
3858 /* Ensure indicator lights are updated promptly on Windows 9x
3859 (TranslateMessage apparently does this), after forwarding
3860 input event. */
3861 post_character_message (hwnd, msg, wParam, lParam,
3862 w32_get_key_modifiers (wParam, lParam));
3863 windows_translate = 1;
3864 break;
3865 case VK_CONTROL:
3866 case VK_SHIFT:
3867 case VK_PROCESSKEY: /* Generated by IME. */
3868 windows_translate = 1;
3869 break;
3870 case VK_CANCEL:
3871 /* Windows maps Ctrl-Pause (aka Ctrl-Break) into VK_CANCEL,
3872 which is confusing for purposes of key binding; convert
3873 VK_CANCEL events into VK_PAUSE events. */
3874 wParam = VK_PAUSE;
3875 break;
3876 case VK_PAUSE:
3877 /* Windows maps Ctrl-NumLock into VK_PAUSE, which is confusing
3878 for purposes of key binding; convert these back into
3879 VK_NUMLOCK events, at least when we want to see NumLock key
3880 presses. (Note that there is never any possibility that
3881 VK_PAUSE with Ctrl really is C-Pause as per above.) */
3882 if (NILP (Vw32_enable_num_lock) && modifier_set (VK_CONTROL))
3883 wParam = VK_NUMLOCK;
3884 break;
3885 default:
3886 /* If not defined as a function key, change it to a WM_CHAR message. */
3887 if (lispy_function_keys[wParam] == 0)
3888 {
3889 DWORD modifiers = construct_console_modifiers ();
3890
3891 if (!NILP (Vw32_recognize_altgr)
3892 && modifier_set (VK_LCONTROL) && modifier_set (VK_RMENU))
3893 {
3894 /* Always let TranslateMessage handle AltGr key chords;
3895 for some reason, ToAscii doesn't always process AltGr
3896 chords correctly. */
3897 windows_translate = 1;
3898 }
3899 else if ((modifiers & (~SHIFT_PRESSED & ~CAPSLOCK_ON)) != 0)
3900 {
3901 /* Handle key chords including any modifiers other
3902 than shift directly, in order to preserve as much
3903 modifier information as possible. */
3904 if ('A' <= wParam && wParam <= 'Z')
3905 {
3906 /* Don't translate modified alphabetic keystrokes,
3907 so the user doesn't need to constantly switch
3908 layout to type control or meta keystrokes when
3909 the normal layout translates alphabetic
3910 characters to non-ascii characters. */
3911 if (!modifier_set (VK_SHIFT))
3912 wParam += ('a' - 'A');
3913 msg = WM_CHAR;
3914 }
3915 else
3916 {
3917 /* Try to handle other keystrokes by determining the
3918 base character (ie. translating the base key plus
3919 shift modifier). */
3920 int add;
3921 int isdead = 0;
3922 KEY_EVENT_RECORD key;
3923
3924 key.bKeyDown = TRUE;
3925 key.wRepeatCount = 1;
3926 key.wVirtualKeyCode = wParam;
3927 key.wVirtualScanCode = (lParam & 0xFF0000) >> 16;
3928 key.uChar.AsciiChar = 0;
3929 key.dwControlKeyState = modifiers;
3930
3931 add = w32_kbd_patch_key (&key);
3932 /* 0 means an unrecognised keycode, negative means
3933 dead key. Ignore both. */
3934 while (--add >= 0)
3935 {
3936 /* Forward asciified character sequence. */
3937 post_character_message
3938 (hwnd, WM_CHAR, key.uChar.AsciiChar, lParam,
3939 w32_get_key_modifiers (wParam, lParam));
3940 w32_kbd_patch_key (&key);
3941 }
3942 return 0;
3943 }
3944 }
3945 else
3946 {
3947 /* Let TranslateMessage handle everything else. */
3948 windows_translate = 1;
3949 }
3950 }
3951 }
3952
3953 translate:
3954 if (windows_translate)
3955 {
3956 MSG windows_msg = { hwnd, msg, wParam, lParam, 0, {0,0} };
3957
3958 windows_msg.time = GetMessageTime ();
3959 TranslateMessage (&windows_msg);
3960 goto dflt;
3961 }
3962
3963 /* Fall through */
3964
3965 case WM_SYSCHAR:
3966 case WM_CHAR:
3967 post_character_message (hwnd, msg, wParam, lParam,
3968 w32_get_key_modifiers (wParam, lParam));
3969 break;
3970
3971 /* Simulate middle mouse button events when left and right buttons
3972 are used together, but only if user has two button mouse. */
3973 case WM_LBUTTONDOWN:
3974 case WM_RBUTTONDOWN:
3975 if (XINT (Vw32_num_mouse_buttons) == 3)
3976 goto handle_plain_button;
3977
3978 {
3979 int this = (msg == WM_LBUTTONDOWN) ? LMOUSE : RMOUSE;
3980 int other = (msg == WM_LBUTTONDOWN) ? RMOUSE : LMOUSE;
3981
3982 if (button_state & this)
3983 return 0;
3984
3985 if (button_state == 0)
3986 SetCapture (hwnd);
3987
3988 button_state |= this;
3989
3990 if (button_state & other)
3991 {
3992 if (mouse_button_timer)
3993 {
3994 KillTimer (hwnd, mouse_button_timer);
3995 mouse_button_timer = 0;
3996
3997 /* Generate middle mouse event instead. */
3998 msg = WM_MBUTTONDOWN;
3999 button_state |= MMOUSE;
4000 }
4001 else if (button_state & MMOUSE)
4002 {
4003 /* Ignore button event if we've already generated a
4004 middle mouse down event. This happens if the
4005 user releases and press one of the two buttons
4006 after we've faked a middle mouse event. */
4007 return 0;
4008 }
4009 else
4010 {
4011 /* Flush out saved message. */
4012 post_msg (&saved_mouse_button_msg);
4013 }
4014 wmsg.dwModifiers = w32_get_modifiers ();
4015 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4016
4017 /* Clear message buffer. */
4018 saved_mouse_button_msg.msg.hwnd = 0;
4019 }
4020 else
4021 {
4022 /* Hold onto message for now. */
4023 mouse_button_timer =
4024 SetTimer (hwnd, MOUSE_BUTTON_ID,
4025 XINT (Vw32_mouse_button_tolerance), NULL);
4026 saved_mouse_button_msg.msg.hwnd = hwnd;
4027 saved_mouse_button_msg.msg.message = msg;
4028 saved_mouse_button_msg.msg.wParam = wParam;
4029 saved_mouse_button_msg.msg.lParam = lParam;
4030 saved_mouse_button_msg.msg.time = GetMessageTime ();
4031 saved_mouse_button_msg.dwModifiers = w32_get_modifiers ();
4032 }
4033 }
4034 return 0;
4035
4036 case WM_LBUTTONUP:
4037 case WM_RBUTTONUP:
4038 if (XINT (Vw32_num_mouse_buttons) == 3)
4039 goto handle_plain_button;
4040
4041 {
4042 int this = (msg == WM_LBUTTONUP) ? LMOUSE : RMOUSE;
4043 int other = (msg == WM_LBUTTONUP) ? RMOUSE : LMOUSE;
4044
4045 if ((button_state & this) == 0)
4046 return 0;
4047
4048 button_state &= ~this;
4049
4050 if (button_state & MMOUSE)
4051 {
4052 /* Only generate event when second button is released. */
4053 if ((button_state & other) == 0)
4054 {
4055 msg = WM_MBUTTONUP;
4056 button_state &= ~MMOUSE;
4057
4058 if (button_state) abort ();
4059 }
4060 else
4061 return 0;
4062 }
4063 else
4064 {
4065 /* Flush out saved message if necessary. */
4066 if (saved_mouse_button_msg.msg.hwnd)
4067 {
4068 post_msg (&saved_mouse_button_msg);
4069 }
4070 }
4071 wmsg.dwModifiers = w32_get_modifiers ();
4072 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4073
4074 /* Always clear message buffer and cancel timer. */
4075 saved_mouse_button_msg.msg.hwnd = 0;
4076 KillTimer (hwnd, mouse_button_timer);
4077 mouse_button_timer = 0;
4078
4079 if (button_state == 0)
4080 ReleaseCapture ();
4081 }
4082 return 0;
4083
4084 case WM_MBUTTONDOWN:
4085 case WM_MBUTTONUP:
4086 handle_plain_button:
4087 {
4088 BOOL up;
4089 int button;
4090
4091 if (parse_button (msg, &button, &up))
4092 {
4093 if (up) ReleaseCapture ();
4094 else SetCapture (hwnd);
4095 button = (button == 0) ? LMOUSE :
4096 ((button == 1) ? MMOUSE : RMOUSE);
4097 if (up)
4098 button_state &= ~button;
4099 else
4100 button_state |= button;
4101 }
4102 }
4103
4104 wmsg.dwModifiers = w32_get_modifiers ();
4105 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4106 return 0;
4107
4108 case WM_VSCROLL:
4109 case WM_MOUSEMOVE:
4110 if (XINT (Vw32_mouse_move_interval) <= 0
4111 || (msg == WM_MOUSEMOVE && button_state == 0))
4112 {
4113 wmsg.dwModifiers = w32_get_modifiers ();
4114 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4115 return 0;
4116 }
4117
4118 /* Hang onto mouse move and scroll messages for a bit, to avoid
4119 sending such events to Emacs faster than it can process them.
4120 If we get more events before the timer from the first message
4121 expires, we just replace the first message. */
4122
4123 if (saved_mouse_move_msg.msg.hwnd == 0)
4124 mouse_move_timer =
4125 SetTimer (hwnd, MOUSE_MOVE_ID,
4126 XINT (Vw32_mouse_move_interval), NULL);
4127
4128 /* Hold onto message for now. */
4129 saved_mouse_move_msg.msg.hwnd = hwnd;
4130 saved_mouse_move_msg.msg.message = msg;
4131 saved_mouse_move_msg.msg.wParam = wParam;
4132 saved_mouse_move_msg.msg.lParam = lParam;
4133 saved_mouse_move_msg.msg.time = GetMessageTime ();
4134 saved_mouse_move_msg.dwModifiers = w32_get_modifiers ();
4135
4136 return 0;
4137
4138 case WM_MOUSEWHEEL:
4139 wmsg.dwModifiers = w32_get_modifiers ();
4140 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4141 return 0;
4142
4143 case WM_DROPFILES:
4144 wmsg.dwModifiers = w32_get_modifiers ();
4145 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4146 return 0;
4147
4148 case WM_TIMER:
4149 /* Flush out saved messages if necessary. */
4150 if (wParam == mouse_button_timer)
4151 {
4152 if (saved_mouse_button_msg.msg.hwnd)
4153 {
4154 post_msg (&saved_mouse_button_msg);
4155 saved_mouse_button_msg.msg.hwnd = 0;
4156 }
4157 KillTimer (hwnd, mouse_button_timer);
4158 mouse_button_timer = 0;
4159 }
4160 else if (wParam == mouse_move_timer)
4161 {
4162 if (saved_mouse_move_msg.msg.hwnd)
4163 {
4164 post_msg (&saved_mouse_move_msg);
4165 saved_mouse_move_msg.msg.hwnd = 0;
4166 }
4167 KillTimer (hwnd, mouse_move_timer);
4168 mouse_move_timer = 0;
4169 }
4170 return 0;
4171
4172 case WM_NCACTIVATE:
4173 /* Windows doesn't send us focus messages when putting up and
4174 taking down a system popup dialog as for Ctrl-Alt-Del on Windows 95.
4175 The only indication we get that something happened is receiving
4176 this message afterwards. So this is a good time to reset our
4177 keyboard modifiers' state. */
4178 reset_modifiers ();
4179 goto dflt;
4180
4181 case WM_INITMENU:
4182 /* We must ensure menu bar is fully constructed and up to date
4183 before allowing user interaction with it. To achieve this
4184 we send this message to the lisp thread and wait for a
4185 reply (whose value is not actually needed) to indicate that
4186 the menu bar is now ready for use, so we can now return.
4187
4188 To remain responsive in the meantime, we enter a nested message
4189 loop that can process all other messages.
4190
4191 However, we skip all this if the message results from calling
4192 TrackPopupMenu - in fact, we must NOT attempt to send the lisp
4193 thread a message because it is blocked on us at this point. We
4194 set menubar_active before calling TrackPopupMenu to indicate
4195 this (there is no possibility of confusion with real menubar
4196 being active). */
4197
4198 f = x_window_to_frame (dpyinfo, hwnd);
4199 if (f
4200 && (f->output_data.w32->menubar_active
4201 /* We can receive this message even in the absence of a
4202 menubar (ie. when the system menu is activated) - in this
4203 case we do NOT want to forward the message, otherwise it
4204 will cause the menubar to suddenly appear when the user
4205 had requested it to be turned off! */
4206 || f->output_data.w32->menubar_widget == NULL))
4207 return 0;
4208
4209 {
4210 deferred_msg msg_buf;
4211
4212 /* Detect if message has already been deferred; in this case
4213 we cannot return any sensible value to ignore this. */
4214 if (find_deferred_msg (hwnd, msg) != NULL)
4215 abort ();
4216
4217 return send_deferred_msg (&msg_buf, hwnd, msg, wParam, lParam);
4218 }
4219
4220 case WM_EXITMENULOOP:
4221 f = x_window_to_frame (dpyinfo, hwnd);
4222
4223 /* Indicate that menubar can be modified again. */
4224 if (f)
4225 f->output_data.w32->menubar_active = 0;
4226 goto dflt;
4227
4228 case WM_MEASUREITEM:
4229 f = x_window_to_frame (dpyinfo, hwnd);
4230 if (f)
4231 {
4232 MEASUREITEMSTRUCT * pMis = (MEASUREITEMSTRUCT *) lParam;
4233
4234 if (pMis->CtlType == ODT_MENU)
4235 {
4236 /* Work out dimensions for popup menu titles. */
4237 char * title = (char *) pMis->itemData;
4238 HDC hdc = GetDC (hwnd);
4239 HFONT menu_font = GetCurrentObject (hdc, OBJ_FONT);
4240 LOGFONT menu_logfont;
4241 HFONT old_font;
4242 SIZE size;
4243
4244 GetObject (menu_font, sizeof (menu_logfont), &menu_logfont);
4245 menu_logfont.lfWeight = FW_BOLD;
4246 menu_font = CreateFontIndirect (&menu_logfont);
4247 old_font = SelectObject (hdc, menu_font);
4248
4249 GetTextExtentPoint32 (hdc, title, strlen (title), &size);
4250 pMis->itemWidth = size.cx;
4251 pMis->itemHeight = GetSystemMetrics (SM_CYMENUSIZE);
4252 if (pMis->itemHeight < size.cy)
4253 pMis->itemHeight = size.cy;
4254
4255 SelectObject (hdc, old_font);
4256 DeleteObject (menu_font);
4257 ReleaseDC (hwnd, hdc);
4258 return TRUE;
4259 }
4260 }
4261 return 0;
4262
4263 case WM_DRAWITEM:
4264 f = x_window_to_frame (dpyinfo, hwnd);
4265 if (f)
4266 {
4267 DRAWITEMSTRUCT * pDis = (DRAWITEMSTRUCT *) lParam;
4268
4269 if (pDis->CtlType == ODT_MENU)
4270 {
4271 /* Draw popup menu title. */
4272 char * title = (char *) pDis->itemData;
4273 HDC hdc = pDis->hDC;
4274 HFONT menu_font = GetCurrentObject (hdc, OBJ_FONT);
4275 LOGFONT menu_logfont;
4276 HFONT old_font;
4277
4278 GetObject (menu_font, sizeof (menu_logfont), &menu_logfont);
4279 menu_logfont.lfWeight = FW_BOLD;
4280 menu_font = CreateFontIndirect (&menu_logfont);
4281 old_font = SelectObject (hdc, menu_font);
4282
4283 /* Always draw title as if not selected. */
4284 ExtTextOut (hdc,
4285 pDis->rcItem.left + GetSystemMetrics (SM_CXMENUCHECK),
4286 pDis->rcItem.top,
4287 ETO_OPAQUE, &pDis->rcItem,
4288 title, strlen (title), NULL);
4289
4290 SelectObject (hdc, old_font);
4291 DeleteObject (menu_font);
4292 return TRUE;
4293 }
4294 }
4295 return 0;
4296
4297 #if 0
4298 /* Still not right - can't distinguish between clicks in the
4299 client area of the frame from clicks forwarded from the scroll
4300 bars - may have to hook WM_NCHITTEST to remember the mouse
4301 position and then check if it is in the client area ourselves. */
4302 case WM_MOUSEACTIVATE:
4303 /* Discard the mouse click that activates a frame, allowing the
4304 user to click anywhere without changing point (or worse!).
4305 Don't eat mouse clicks on scrollbars though!! */
4306 if (LOWORD (lParam) == HTCLIENT )
4307 return MA_ACTIVATEANDEAT;
4308 goto dflt;
4309 #endif
4310
4311 case WM_ACTIVATEAPP:
4312 case WM_ACTIVATE:
4313 case WM_WINDOWPOSCHANGED:
4314 case WM_SHOWWINDOW:
4315 /* Inform lisp thread that a frame might have just been obscured
4316 or exposed, so should recheck visibility of all frames. */
4317 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4318 goto dflt;
4319
4320 case WM_SETFOCUS:
4321 dpyinfo->faked_key = 0;
4322 reset_modifiers ();
4323 register_hot_keys (hwnd);
4324 goto command;
4325 case WM_KILLFOCUS:
4326 unregister_hot_keys (hwnd);
4327 case WM_MOVE:
4328 case WM_SIZE:
4329 case WM_COMMAND:
4330 command:
4331 wmsg.dwModifiers = w32_get_modifiers ();
4332 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4333 goto dflt;
4334
4335 case WM_CLOSE:
4336 wmsg.dwModifiers = w32_get_modifiers ();
4337 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4338 return 0;
4339
4340 case WM_WINDOWPOSCHANGING:
4341 {
4342 WINDOWPLACEMENT wp;
4343 LPWINDOWPOS lppos = (WINDOWPOS *) lParam;
4344
4345 wp.length = sizeof (WINDOWPLACEMENT);
4346 GetWindowPlacement (hwnd, &wp);
4347
4348 if (wp.showCmd != SW_SHOWMINIMIZED && (lppos->flags & SWP_NOSIZE) == 0)
4349 {
4350 RECT rect;
4351 int wdiff;
4352 int hdiff;
4353 DWORD font_width;
4354 DWORD line_height;
4355 DWORD internal_border;
4356 DWORD scrollbar_extra;
4357 RECT wr;
4358
4359 wp.length = sizeof(wp);
4360 GetWindowRect (hwnd, &wr);
4361
4362 enter_crit ();
4363
4364 font_width = GetWindowLong (hwnd, WND_FONTWIDTH_INDEX);
4365 line_height = GetWindowLong (hwnd, WND_LINEHEIGHT_INDEX);
4366 internal_border = GetWindowLong (hwnd, WND_BORDER_INDEX);
4367 scrollbar_extra = GetWindowLong (hwnd, WND_SCROLLBAR_INDEX);
4368
4369 leave_crit ();
4370
4371 memset (&rect, 0, sizeof (rect));
4372 AdjustWindowRect (&rect, GetWindowLong (hwnd, GWL_STYLE),
4373 GetMenu (hwnd) != NULL);
4374
4375 /* Force width and height of client area to be exact
4376 multiples of the character cell dimensions. */
4377 wdiff = (lppos->cx - (rect.right - rect.left)
4378 - 2 * internal_border - scrollbar_extra)
4379 % font_width;
4380 hdiff = (lppos->cy - (rect.bottom - rect.top)
4381 - 2 * internal_border)
4382 % line_height;
4383
4384 if (wdiff || hdiff)
4385 {
4386 /* For right/bottom sizing we can just fix the sizes.
4387 However for top/left sizing we will need to fix the X
4388 and Y positions as well. */
4389
4390 lppos->cx -= wdiff;
4391 lppos->cy -= hdiff;
4392
4393 if (wp.showCmd != SW_SHOWMAXIMIZED
4394 && (lppos->flags & SWP_NOMOVE) == 0)
4395 {
4396 if (lppos->x != wr.left || lppos->y != wr.top)
4397 {
4398 lppos->x += wdiff;
4399 lppos->y += hdiff;
4400 }
4401 else
4402 {
4403 lppos->flags |= SWP_NOMOVE;
4404 }
4405 }
4406
4407 return 0;
4408 }
4409 }
4410 }
4411
4412 goto dflt;
4413
4414 case WM_EMACS_CREATESCROLLBAR:
4415 return (LRESULT) w32_createscrollbar ((struct frame *) wParam,
4416 (struct scroll_bar *) lParam);
4417
4418 case WM_EMACS_SHOWWINDOW:
4419 return ShowWindow ((HWND) wParam, (WPARAM) lParam);
4420
4421 case WM_EMACS_SETFOREGROUND:
4422 return SetForegroundWindow ((HWND) wParam);
4423
4424 case WM_EMACS_SETWINDOWPOS:
4425 {
4426 WINDOWPOS * pos = (WINDOWPOS *) wParam;
4427 return SetWindowPos (hwnd, pos->hwndInsertAfter,
4428 pos->x, pos->y, pos->cx, pos->cy, pos->flags);
4429 }
4430
4431 case WM_EMACS_DESTROYWINDOW:
4432 DragAcceptFiles ((HWND) wParam, FALSE);
4433 return DestroyWindow ((HWND) wParam);
4434
4435 case WM_EMACS_TRACKPOPUPMENU:
4436 {
4437 UINT flags;
4438 POINT *pos;
4439 int retval;
4440 pos = (POINT *)lParam;
4441 flags = TPM_CENTERALIGN;
4442 if (button_state & LMOUSE)
4443 flags |= TPM_LEFTBUTTON;
4444 else if (button_state & RMOUSE)
4445 flags |= TPM_RIGHTBUTTON;
4446
4447 /* Remember we did a SetCapture on the initial mouse down event,
4448 so for safety, we make sure the capture is cancelled now. */
4449 ReleaseCapture ();
4450 button_state = 0;
4451
4452 /* Use menubar_active to indicate that WM_INITMENU is from
4453 TrackPopupMenu below, and should be ignored. */
4454 f = x_window_to_frame (dpyinfo, hwnd);
4455 if (f)
4456 f->output_data.w32->menubar_active = 1;
4457
4458 if (TrackPopupMenu ((HMENU)wParam, flags, pos->x, pos->y,
4459 0, hwnd, NULL))
4460 {
4461 MSG amsg;
4462 /* Eat any mouse messages during popupmenu */
4463 while (PeekMessage (&amsg, hwnd, WM_MOUSEFIRST, WM_MOUSELAST,
4464 PM_REMOVE));
4465 /* Get the menu selection, if any */
4466 if (PeekMessage (&amsg, hwnd, WM_COMMAND, WM_COMMAND, PM_REMOVE))
4467 {
4468 retval = LOWORD (amsg.wParam);
4469 }
4470 else
4471 {
4472 retval = 0;
4473 }
4474 }
4475 else
4476 {
4477 retval = -1;
4478 }
4479
4480 return retval;
4481 }
4482
4483 default:
4484 /* Check for messages registered at runtime. */
4485 if (msg == msh_mousewheel)
4486 {
4487 wmsg.dwModifiers = w32_get_modifiers ();
4488 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4489 return 0;
4490 }
4491
4492 dflt:
4493 return DefWindowProc (hwnd, msg, wParam, lParam);
4494 }
4495
4496
4497 /* The most common default return code for handled messages is 0. */
4498 return 0;
4499 }
4500
4501 void
4502 my_create_window (f)
4503 struct frame * f;
4504 {
4505 MSG msg;
4506
4507 if (!PostThreadMessage (dwWindowsThreadId, WM_EMACS_CREATEWINDOW, (WPARAM)f, 0))
4508 abort ();
4509 GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
4510 }
4511
4512 /* Create and set up the w32 window for frame F. */
4513
4514 static void
4515 w32_window (f, window_prompting, minibuffer_only)
4516 struct frame *f;
4517 long window_prompting;
4518 int minibuffer_only;
4519 {
4520 BLOCK_INPUT;
4521
4522 /* Use the resource name as the top-level window name
4523 for looking up resources. Make a non-Lisp copy
4524 for the window manager, so GC relocation won't bother it.
4525
4526 Elsewhere we specify the window name for the window manager. */
4527
4528 {
4529 char *str = (char *) XSTRING (Vx_resource_name)->data;
4530 f->namebuf = (char *) xmalloc (strlen (str) + 1);
4531 strcpy (f->namebuf, str);
4532 }
4533
4534 my_create_window (f);
4535
4536 validate_x_resource_name ();
4537
4538 /* x_set_name normally ignores requests to set the name if the
4539 requested name is the same as the current name. This is the one
4540 place where that assumption isn't correct; f->name is set, but
4541 the server hasn't been told. */
4542 {
4543 Lisp_Object name;
4544 int explicit = f->explicit_name;
4545
4546 f->explicit_name = 0;
4547 name = f->name;
4548 f->name = Qnil;
4549 x_set_name (f, name, explicit);
4550 }
4551
4552 UNBLOCK_INPUT;
4553
4554 if (!minibuffer_only && FRAME_EXTERNAL_MENU_BAR (f))
4555 initialize_frame_menubar (f);
4556
4557 if (FRAME_W32_WINDOW (f) == 0)
4558 error ("Unable to create window");
4559 }
4560
4561 /* Handle the icon stuff for this window. Perhaps later we might
4562 want an x_set_icon_position which can be called interactively as
4563 well. */
4564
4565 static void
4566 x_icon (f, parms)
4567 struct frame *f;
4568 Lisp_Object parms;
4569 {
4570 Lisp_Object icon_x, icon_y;
4571
4572 /* Set the position of the icon. Note that Windows 95 groups all
4573 icons in the tray. */
4574 icon_x = x_get_arg (parms, Qicon_left, 0, 0, number);
4575 icon_y = x_get_arg (parms, Qicon_top, 0, 0, number);
4576 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
4577 {
4578 CHECK_NUMBER (icon_x, 0);
4579 CHECK_NUMBER (icon_y, 0);
4580 }
4581 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
4582 error ("Both left and top icon corners of icon must be specified");
4583
4584 BLOCK_INPUT;
4585
4586 if (! EQ (icon_x, Qunbound))
4587 x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y));
4588
4589 #if 0 /* TODO */
4590 /* Start up iconic or window? */
4591 x_wm_set_window_state
4592 (f, (EQ (x_get_arg (parms, Qvisibility, 0, 0, symbol), Qicon)
4593 ? IconicState
4594 : NormalState));
4595
4596 x_text_icon (f, (char *) XSTRING ((!NILP (f->icon_name)
4597 ? f->icon_name
4598 : f->name))->data);
4599 #endif
4600
4601 UNBLOCK_INPUT;
4602 }
4603
4604 DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
4605 1, 1, 0,
4606 "Make a new window, which is called a \"frame\" in Emacs terms.\n\
4607 Returns an Emacs frame object.\n\
4608 ALIST is an alist of frame parameters.\n\
4609 If the parameters specify that the frame should not have a minibuffer,\n\
4610 and do not specify a specific minibuffer window to use,\n\
4611 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
4612 be shared by the new frame.\n\
4613 \n\
4614 This function is an internal primitive--use `make-frame' instead.")
4615 (parms)
4616 Lisp_Object parms;
4617 {
4618 struct frame *f;
4619 Lisp_Object frame, tem;
4620 Lisp_Object name;
4621 int minibuffer_only = 0;
4622 long window_prompting = 0;
4623 int width, height;
4624 int count = specpdl_ptr - specpdl;
4625 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
4626 Lisp_Object display;
4627 struct w32_display_info *dpyinfo;
4628 Lisp_Object parent;
4629 struct kboard *kb;
4630
4631 check_w32 ();
4632
4633 /* Use this general default value to start with
4634 until we know if this frame has a specified name. */
4635 Vx_resource_name = Vinvocation_name;
4636
4637 display = x_get_arg (parms, Qdisplay, 0, 0, string);
4638 if (EQ (display, Qunbound))
4639 display = Qnil;
4640 dpyinfo = check_x_display_info (display);
4641 #ifdef MULTI_KBOARD
4642 kb = dpyinfo->kboard;
4643 #else
4644 kb = &the_only_kboard;
4645 #endif
4646
4647 name = x_get_arg (parms, Qname, "name", "Name", string);
4648 if (!STRINGP (name)
4649 && ! EQ (name, Qunbound)
4650 && ! NILP (name))
4651 error ("Invalid frame name--not a string or nil");
4652
4653 if (STRINGP (name))
4654 Vx_resource_name = name;
4655
4656 /* See if parent window is specified. */
4657 parent = x_get_arg (parms, Qparent_id, NULL, NULL, number);
4658 if (EQ (parent, Qunbound))
4659 parent = Qnil;
4660 if (! NILP (parent))
4661 CHECK_NUMBER (parent, 0);
4662
4663 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
4664 /* No need to protect DISPLAY because that's not used after passing
4665 it to make_frame_without_minibuffer. */
4666 frame = Qnil;
4667 GCPRO4 (parms, parent, name, frame);
4668 tem = x_get_arg (parms, Qminibuffer, 0, 0, symbol);
4669 if (EQ (tem, Qnone) || NILP (tem))
4670 f = make_frame_without_minibuffer (Qnil, kb, display);
4671 else if (EQ (tem, Qonly))
4672 {
4673 f = make_minibuffer_frame ();
4674 minibuffer_only = 1;
4675 }
4676 else if (WINDOWP (tem))
4677 f = make_frame_without_minibuffer (tem, kb, display);
4678 else
4679 f = make_frame (1);
4680
4681 XSETFRAME (frame, f);
4682
4683 /* Note that Windows does support scroll bars. */
4684 FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
4685 /* By default, make scrollbars the system standard width. */
4686 f->scroll_bar_pixel_width = GetSystemMetrics (SM_CXVSCROLL);
4687
4688 f->output_method = output_w32;
4689 f->output_data.w32 = (struct w32_output *) xmalloc (sizeof (struct w32_output));
4690 bzero (f->output_data.w32, sizeof (struct w32_output));
4691
4692 FRAME_FONTSET (f) = -1;
4693
4694 f->icon_name
4695 = x_get_arg (parms, Qicon_name, "iconName", "Title", string);
4696 if (! STRINGP (f->icon_name))
4697 f->icon_name = Qnil;
4698
4699 /* FRAME_W32_DISPLAY_INFO (f) = dpyinfo; */
4700 #ifdef MULTI_KBOARD
4701 FRAME_KBOARD (f) = kb;
4702 #endif
4703
4704 /* Specify the parent under which to make this window. */
4705
4706 if (!NILP (parent))
4707 {
4708 f->output_data.w32->parent_desc = (Window) parent;
4709 f->output_data.w32->explicit_parent = 1;
4710 }
4711 else
4712 {
4713 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
4714 f->output_data.w32->explicit_parent = 0;
4715 }
4716
4717 /* Note that the frame has no physical cursor right now. */
4718 f->phys_cursor_x = -1;
4719
4720 /* Set the name; the functions to which we pass f expect the name to
4721 be set. */
4722 if (EQ (name, Qunbound) || NILP (name))
4723 {
4724 f->name = build_string (dpyinfo->w32_id_name);
4725 f->explicit_name = 0;
4726 }
4727 else
4728 {
4729 f->name = name;
4730 f->explicit_name = 1;
4731 /* use the frame's title when getting resources for this frame. */
4732 specbind (Qx_resource_name, name);
4733 }
4734
4735 /* Create fontsets from `global_fontset_alist' before handling fonts. */
4736 for (tem = Vglobal_fontset_alist; CONSP (tem); tem = XCONS (tem)->cdr)
4737 fs_register_fontset (f, XCONS (tem)->car);
4738
4739 /* Extract the window parameters from the supplied values
4740 that are needed to determine window geometry. */
4741 {
4742 Lisp_Object font;
4743
4744 font = x_get_arg (parms, Qfont, "font", "Font", string);
4745 BLOCK_INPUT;
4746 /* First, try whatever font the caller has specified. */
4747 if (STRINGP (font))
4748 {
4749 tem = Fquery_fontset (font, Qnil);
4750 if (STRINGP (tem))
4751 font = x_new_fontset (f, XSTRING (tem)->data);
4752 else
4753 font = x_new_font (f, XSTRING (font)->data);
4754 }
4755 /* Try out a font which we hope has bold and italic variations. */
4756 if (!STRINGP (font))
4757 font = x_new_font (f, "-*-Courier New-normal-r-*-*-13-*-*-*-c-*-iso8859-1");
4758 if (! STRINGP (font))
4759 font = x_new_font (f, "-*-Courier-normal-r-*-*-*-97-*-*-c-*-iso8859-1");
4760 /* If those didn't work, look for something which will at least work. */
4761 if (! STRINGP (font))
4762 font = x_new_font (f, "-*-Fixedsys-normal-r-*-*-*-*-90-*-c-*-iso8859-1");
4763 UNBLOCK_INPUT;
4764 if (! STRINGP (font))
4765 font = build_string ("Fixedsys");
4766
4767 x_default_parameter (f, parms, Qfont, font,
4768 "font", "Font", string);
4769 }
4770
4771 x_default_parameter (f, parms, Qborder_width, make_number (2),
4772 "borderwidth", "BorderWidth", number);
4773 /* This defaults to 2 in order to match xterm. We recognize either
4774 internalBorderWidth or internalBorder (which is what xterm calls
4775 it). */
4776 if (NILP (Fassq (Qinternal_border_width, parms)))
4777 {
4778 Lisp_Object value;
4779
4780 value = x_get_arg (parms, Qinternal_border_width,
4781 "internalBorder", "BorderWidth", number);
4782 if (! EQ (value, Qunbound))
4783 parms = Fcons (Fcons (Qinternal_border_width, value),
4784 parms);
4785 }
4786 /* Default internalBorderWidth to 0 on Windows to match other programs. */
4787 x_default_parameter (f, parms, Qinternal_border_width, make_number (0),
4788 "internalBorderWidth", "BorderWidth", number);
4789 x_default_parameter (f, parms, Qvertical_scroll_bars, Qt,
4790 "verticalScrollBars", "ScrollBars", boolean);
4791
4792 /* Also do the stuff which must be set before the window exists. */
4793 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
4794 "foreground", "Foreground", string);
4795 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
4796 "background", "Background", string);
4797 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
4798 "pointerColor", "Foreground", string);
4799 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
4800 "cursorColor", "Foreground", string);
4801 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
4802 "borderColor", "BorderColor", string);
4803
4804 x_default_parameter (f, parms, Qmenu_bar_lines, make_number (1),
4805 "menuBar", "MenuBar", number);
4806 x_default_parameter (f, parms, Qscroll_bar_width, Qnil,
4807 "scrollBarWidth", "ScrollBarWidth", number);
4808 x_default_parameter (f, parms, Qbuffer_predicate, Qnil,
4809 "bufferPredicate", "BufferPredicate", symbol);
4810 x_default_parameter (f, parms, Qtitle, Qnil,
4811 "title", "Title", string);
4812
4813 f->output_data.w32->dwStyle = WS_OVERLAPPEDWINDOW;
4814 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
4815 window_prompting = x_figure_window_size (f, parms);
4816
4817 if (window_prompting & XNegative)
4818 {
4819 if (window_prompting & YNegative)
4820 f->output_data.w32->win_gravity = SouthEastGravity;
4821 else
4822 f->output_data.w32->win_gravity = NorthEastGravity;
4823 }
4824 else
4825 {
4826 if (window_prompting & YNegative)
4827 f->output_data.w32->win_gravity = SouthWestGravity;
4828 else
4829 f->output_data.w32->win_gravity = NorthWestGravity;
4830 }
4831
4832 f->output_data.w32->size_hint_flags = window_prompting;
4833
4834 w32_window (f, window_prompting, minibuffer_only);
4835 x_icon (f, parms);
4836 init_frame_faces (f);
4837
4838 /* We need to do this after creating the window, so that the
4839 icon-creation functions can say whose icon they're describing. */
4840 x_default_parameter (f, parms, Qicon_type, Qnil,
4841 "bitmapIcon", "BitmapIcon", symbol);
4842
4843 x_default_parameter (f, parms, Qauto_raise, Qnil,
4844 "autoRaise", "AutoRaiseLower", boolean);
4845 x_default_parameter (f, parms, Qauto_lower, Qnil,
4846 "autoLower", "AutoRaiseLower", boolean);
4847 x_default_parameter (f, parms, Qcursor_type, Qbox,
4848 "cursorType", "CursorType", symbol);
4849
4850 /* Dimensions, especially f->height, must be done via change_frame_size.
4851 Change will not be effected unless different from the current
4852 f->height. */
4853 width = f->width;
4854 height = f->height;
4855 f->height = 0;
4856 SET_FRAME_WIDTH (f, 0);
4857 change_frame_size (f, height, width, 1, 0);
4858
4859 /* Tell the server what size and position, etc, we want,
4860 and how badly we want them. */
4861 BLOCK_INPUT;
4862 x_wm_set_size_hint (f, window_prompting, 0);
4863 UNBLOCK_INPUT;
4864
4865 tem = x_get_arg (parms, Qunsplittable, 0, 0, boolean);
4866 f->no_split = minibuffer_only || EQ (tem, Qt);
4867
4868 UNGCPRO;
4869
4870 /* It is now ok to make the frame official
4871 even if we get an error below.
4872 And the frame needs to be on Vframe_list
4873 or making it visible won't work. */
4874 Vframe_list = Fcons (frame, Vframe_list);
4875
4876 /* Now that the frame is official, it counts as a reference to
4877 its display. */
4878 FRAME_W32_DISPLAY_INFO (f)->reference_count++;
4879
4880 /* Make the window appear on the frame and enable display,
4881 unless the caller says not to. However, with explicit parent,
4882 Emacs cannot control visibility, so don't try. */
4883 if (! f->output_data.w32->explicit_parent)
4884 {
4885 Lisp_Object visibility;
4886
4887 visibility = x_get_arg (parms, Qvisibility, 0, 0, symbol);
4888 if (EQ (visibility, Qunbound))
4889 visibility = Qt;
4890
4891 if (EQ (visibility, Qicon))
4892 x_iconify_frame (f);
4893 else if (! NILP (visibility))
4894 x_make_frame_visible (f);
4895 else
4896 /* Must have been Qnil. */
4897 ;
4898 }
4899
4900 return unbind_to (count, frame);
4901 }
4902
4903 /* FRAME is used only to get a handle on the X display. We don't pass the
4904 display info directly because we're called from frame.c, which doesn't
4905 know about that structure. */
4906 Lisp_Object
4907 x_get_focus_frame (frame)
4908 struct frame *frame;
4909 {
4910 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (frame);
4911 Lisp_Object xfocus;
4912 if (! dpyinfo->w32_focus_frame)
4913 return Qnil;
4914
4915 XSETFRAME (xfocus, dpyinfo->w32_focus_frame);
4916 return xfocus;
4917 }
4918
4919 DEFUN ("w32-focus-frame", Fw32_focus_frame, Sw32_focus_frame, 1, 1, 0,
4920 "Give FRAME input focus, raising to foreground if necessary.")
4921 (frame)
4922 Lisp_Object frame;
4923 {
4924 x_focus_on_frame (check_x_frame (frame));
4925 return Qnil;
4926 }
4927
4928 \f
4929 struct font_info *w32_load_bdf_font (struct frame *f, char *fontname,
4930 int size, char* filename);
4931
4932 struct font_info *
4933 w32_load_system_font (f,fontname,size)
4934 struct frame *f;
4935 char * fontname;
4936 int size;
4937 {
4938 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
4939 Lisp_Object font_names;
4940
4941 /* Get a list of all the fonts that match this name. Once we
4942 have a list of matching fonts, we compare them against the fonts
4943 we already have loaded by comparing names. */
4944 font_names = w32_list_fonts (f, build_string (fontname), size, 100);
4945
4946 if (!NILP (font_names))
4947 {
4948 Lisp_Object tail;
4949 int i;
4950 #if 0 /* This code has nasty side effects that cause Emacs to crash. */
4951
4952 /* First check if any are already loaded, as that is cheaper
4953 than loading another one. */
4954 for (i = 0; i < dpyinfo->n_fonts; i++)
4955 for (tail = font_names; CONSP (tail); tail = XCONS (tail)->cdr)
4956 if (!strcmp (dpyinfo->font_table[i].name,
4957 XSTRING (XCONS (tail)->car)->data)
4958 || !strcmp (dpyinfo->font_table[i].full_name,
4959 XSTRING (XCONS (tail)->car)->data))
4960 return (dpyinfo->font_table + i);
4961 #endif
4962 fontname = (char *) XSTRING (XCONS (font_names)->car)->data;
4963 }
4964 /* Because we need to support NT 3.x, we can't use EnumFontFamiliesEx
4965 so if fonts of the same name are available with several
4966 alternative character sets, the w32_list_fonts can fail to find a
4967 match even if the font exists. Try loading it anyway.
4968 */
4969 #if 0
4970 else
4971 return NULL;
4972 #endif
4973
4974 /* Load the font and add it to the table. */
4975 {
4976 char *full_name, *encoding;
4977 XFontStruct *font;
4978 struct font_info *fontp;
4979 LOGFONT lf;
4980 BOOL ok;
4981
4982 if (!fontname || !x_to_w32_font (fontname, &lf))
4983 return (NULL);
4984
4985 if (!*lf.lfFaceName)
4986 /* If no name was specified for the font, we get a random font
4987 from CreateFontIndirect - this is not particularly
4988 desirable, especially since CreateFontIndirect does not
4989 fill out the missing name in lf, so we never know what we
4990 ended up with. */
4991 return NULL;
4992
4993 font = (XFontStruct *) xmalloc (sizeof (XFontStruct));
4994
4995 /* Set bdf to NULL to indicate that this is a Windows font. */
4996 font->bdf = NULL;
4997
4998 BLOCK_INPUT;
4999
5000 font->hfont = CreateFontIndirect (&lf);
5001
5002 if (font->hfont == NULL)
5003 {
5004 ok = FALSE;
5005 }
5006 else
5007 {
5008 HDC hdc;
5009 HANDLE oldobj;
5010
5011 hdc = GetDC (dpyinfo->root_window);
5012 oldobj = SelectObject (hdc, font->hfont);
5013 ok = GetTextMetrics (hdc, &font->tm);
5014 SelectObject (hdc, oldobj);
5015 ReleaseDC (dpyinfo->root_window, hdc);
5016 }
5017
5018 UNBLOCK_INPUT;
5019
5020 if (!ok)
5021 {
5022 w32_unload_font (dpyinfo, font);
5023 return (NULL);
5024 }
5025
5026 /* Do we need to create the table? */
5027 if (dpyinfo->font_table_size == 0)
5028 {
5029 dpyinfo->font_table_size = 16;
5030 dpyinfo->font_table
5031 = (struct font_info *) xmalloc (dpyinfo->font_table_size
5032 * sizeof (struct font_info));
5033 }
5034 /* Do we need to grow the table? */
5035 else if (dpyinfo->n_fonts
5036 >= dpyinfo->font_table_size)
5037 {
5038 dpyinfo->font_table_size *= 2;
5039 dpyinfo->font_table
5040 = (struct font_info *) xrealloc (dpyinfo->font_table,
5041 (dpyinfo->font_table_size
5042 * sizeof (struct font_info)));
5043 }
5044
5045 fontp = dpyinfo->font_table + dpyinfo->n_fonts;
5046
5047 /* Now fill in the slots of *FONTP. */
5048 BLOCK_INPUT;
5049 fontp->font = font;
5050 fontp->font_idx = dpyinfo->n_fonts;
5051 fontp->name = (char *) xmalloc (strlen (fontname) + 1);
5052 bcopy (fontname, fontp->name, strlen (fontname) + 1);
5053
5054 /* Work out the font's full name. */
5055 full_name = (char *)xmalloc (100);
5056 if (full_name && w32_to_x_font (&lf, full_name, 100))
5057 fontp->full_name = full_name;
5058 else
5059 {
5060 /* If all else fails - just use the name we used to load it. */
5061 xfree (full_name);
5062 fontp->full_name = fontp->name;
5063 }
5064
5065 fontp->size = FONT_WIDTH (font);
5066 fontp->height = FONT_HEIGHT (font);
5067
5068 /* The slot `encoding' specifies how to map a character
5069 code-points (0x20..0x7F or 0x2020..0x7F7F) of each charset to
5070 the font code-points (0:0x20..0x7F, 1:0xA0..0xFF, 0:0x2020..0x7F7F,
5071 the font code-points (0:0x20..0x7F, 1:0xA0..0xFF,
5072 0:0x2020..0x7F7F, 1:0xA0A0..0xFFFF, 3:0x20A0..0x7FFF, or
5073 2:0xA020..0xFF7F). For the moment, we don't know which charset
5074 uses this font. So, we set informatoin in fontp->encoding[1]
5075 which is never used by any charset. If mapping can't be
5076 decided, set FONT_ENCODING_NOT_DECIDED. */
5077
5078 /* SJIS fonts need to be set to type 4, all others seem to work as
5079 type FONT_ENCODING_NOT_DECIDED. */
5080 encoding = strrchr (fontp->name, '-');
5081 if (encoding && stricmp (encoding+1, "sjis") == 0)
5082 fontp->encoding[1] = 4;
5083 else
5084 fontp->encoding[1] = FONT_ENCODING_NOT_DECIDED;
5085
5086 /* The following three values are set to 0 under W32, which is
5087 what they get set to if XGetFontProperty fails under X. */
5088 fontp->baseline_offset = 0;
5089 fontp->relative_compose = 0;
5090 fontp->default_ascent = 0;
5091
5092 UNBLOCK_INPUT;
5093 dpyinfo->n_fonts++;
5094
5095 return fontp;
5096 }
5097 }
5098
5099 /* Load font named FONTNAME of size SIZE for frame F, and return a
5100 pointer to the structure font_info while allocating it dynamically.
5101 If loading fails, return NULL. */
5102 struct font_info *
5103 w32_load_font (f,fontname,size)
5104 struct frame *f;
5105 char * fontname;
5106 int size;
5107 {
5108 Lisp_Object bdf_fonts;
5109 struct font_info *retval = NULL;
5110
5111 bdf_fonts = w32_list_bdf_fonts (build_string (fontname));
5112
5113 while (!retval && CONSP (bdf_fonts))
5114 {
5115 char *bdf_name, *bdf_file;
5116 Lisp_Object bdf_pair;
5117
5118 bdf_name = XSTRING (XCONS (bdf_fonts)->car)->data;
5119 bdf_pair = Fassoc (XCONS (bdf_fonts)->car, Vw32_bdf_filename_alist);
5120 bdf_file = XSTRING (XCONS (bdf_pair)->cdr)->data;
5121
5122 retval = w32_load_bdf_font (f, bdf_name, size, bdf_file);
5123
5124 bdf_fonts = XCONS (bdf_fonts)->cdr;
5125 }
5126
5127 if (retval)
5128 return retval;
5129
5130 return w32_load_system_font(f, fontname, size);
5131 }
5132
5133
5134 void
5135 w32_unload_font (dpyinfo, font)
5136 struct w32_display_info *dpyinfo;
5137 XFontStruct * font;
5138 {
5139 if (font)
5140 {
5141 if (font->bdf) w32_free_bdf_font (font->bdf);
5142
5143 if (font->hfont) DeleteObject(font->hfont);
5144 xfree (font);
5145 }
5146 }
5147
5148 /* The font conversion stuff between x and w32 */
5149
5150 /* X font string is as follows (from faces.el)
5151 * (let ((- "[-?]")
5152 * (foundry "[^-]+")
5153 * (family "[^-]+")
5154 * (weight "\\(bold\\|demibold\\|medium\\)") ; 1
5155 * (weight\? "\\([^-]*\\)") ; 1
5156 * (slant "\\([ior]\\)") ; 2
5157 * (slant\? "\\([^-]?\\)") ; 2
5158 * (swidth "\\([^-]*\\)") ; 3
5159 * (adstyle "[^-]*") ; 4
5160 * (pixelsize "[0-9]+")
5161 * (pointsize "[0-9][0-9]+")
5162 * (resx "[0-9][0-9]+")
5163 * (resy "[0-9][0-9]+")
5164 * (spacing "[cmp?*]")
5165 * (avgwidth "[0-9]+")
5166 * (registry "[^-]+")
5167 * (encoding "[^-]+")
5168 * )
5169 * (setq x-font-regexp
5170 * (concat "\\`\\*?[-?*]"
5171 * foundry - family - weight\? - slant\? - swidth - adstyle -
5172 * pixelsize - pointsize - resx - resy - spacing - registry -
5173 * encoding "[-?*]\\*?\\'"
5174 * ))
5175 * (setq x-font-regexp-head
5176 * (concat "\\`[-?*]" foundry - family - weight\? - slant\?
5177 * "\\([-*?]\\|\\'\\)"))
5178 * (setq x-font-regexp-slant (concat - slant -))
5179 * (setq x-font-regexp-weight (concat - weight -))
5180 * nil)
5181 */
5182
5183 #define FONT_START "[-?]"
5184 #define FONT_FOUNDRY "[^-]+"
5185 #define FONT_FAMILY "\\([^-]+\\)" /* 1 */
5186 #define FONT_WEIGHT "\\(bold\\|demibold\\|medium\\)" /* 2 */
5187 #define FONT_WEIGHT_Q "\\([^-]*\\)" /* 2 */
5188 #define FONT_SLANT "\\([ior]\\)" /* 3 */
5189 #define FONT_SLANT_Q "\\([^-]?\\)" /* 3 */
5190 #define FONT_SWIDTH "\\([^-]*\\)" /* 4 */
5191 #define FONT_ADSTYLE "[^-]*"
5192 #define FONT_PIXELSIZE "[^-]*"
5193 #define FONT_POINTSIZE "\\([0-9][0-9]+\\|\\*\\)" /* 5 */
5194 #define FONT_RESX "[0-9][0-9]+"
5195 #define FONT_RESY "[0-9][0-9]+"
5196 #define FONT_SPACING "[cmp?*]"
5197 #define FONT_AVGWIDTH "[0-9]+"
5198 #define FONT_REGISTRY "[^-]+"
5199 #define FONT_ENCODING "[^-]+"
5200
5201 #define FONT_REGEXP ("\\`\\*?[-?*]" \
5202 FONT_FOUNDRY "-" \
5203 FONT_FAMILY "-" \
5204 FONT_WEIGHT_Q "-" \
5205 FONT_SLANT_Q "-" \
5206 FONT_SWIDTH "-" \
5207 FONT_ADSTYLE "-" \
5208 FONT_PIXELSIZE "-" \
5209 FONT_POINTSIZE "-" \
5210 "[-?*]\\|\\'")
5211
5212 #define FONT_REGEXP_HEAD ("\\`[-?*]" \
5213 FONT_FOUNDRY "-" \
5214 FONT_FAMILY "-" \
5215 FONT_WEIGHT_Q "-" \
5216 FONT_SLANT_Q \
5217 "\\([-*?]\\|\\'\\)")
5218
5219 #define FONT_REGEXP_SLANT "-" FONT_SLANT "-"
5220 #define FONT_REGEXP_WEIGHT "-" FONT_WEIGHT "-"
5221
5222 LONG
5223 x_to_w32_weight (lpw)
5224 char * lpw;
5225 {
5226 if (!lpw) return (FW_DONTCARE);
5227
5228 if (stricmp (lpw,"heavy") == 0) return FW_HEAVY;
5229 else if (stricmp (lpw,"extrabold") == 0) return FW_EXTRABOLD;
5230 else if (stricmp (lpw,"bold") == 0) return FW_BOLD;
5231 else if (stricmp (lpw,"demibold") == 0) return FW_SEMIBOLD;
5232 else if (stricmp (lpw,"semibold") == 0) return FW_SEMIBOLD;
5233 else if (stricmp (lpw,"medium") == 0) return FW_MEDIUM;
5234 else if (stricmp (lpw,"normal") == 0) return FW_NORMAL;
5235 else if (stricmp (lpw,"light") == 0) return FW_LIGHT;
5236 else if (stricmp (lpw,"extralight") == 0) return FW_EXTRALIGHT;
5237 else if (stricmp (lpw,"thin") == 0) return FW_THIN;
5238 else
5239 return FW_DONTCARE;
5240 }
5241
5242
5243 char *
5244 w32_to_x_weight (fnweight)
5245 int fnweight;
5246 {
5247 if (fnweight >= FW_HEAVY) return "heavy";
5248 if (fnweight >= FW_EXTRABOLD) return "extrabold";
5249 if (fnweight >= FW_BOLD) return "bold";
5250 if (fnweight >= FW_SEMIBOLD) return "semibold";
5251 if (fnweight >= FW_MEDIUM) return "medium";
5252 if (fnweight >= FW_NORMAL) return "normal";
5253 if (fnweight >= FW_LIGHT) return "light";
5254 if (fnweight >= FW_EXTRALIGHT) return "extralight";
5255 if (fnweight >= FW_THIN) return "thin";
5256 else
5257 return "*";
5258 }
5259
5260 LONG
5261 x_to_w32_charset (lpcs)
5262 char * lpcs;
5263 {
5264 if (!lpcs) return (0);
5265
5266 if (stricmp (lpcs,"ansi") == 0) return ANSI_CHARSET;
5267 else if (stricmp (lpcs,"iso8859-1") == 0) return ANSI_CHARSET;
5268 else if (stricmp (lpcs, "ms-symbol") == 0) return SYMBOL_CHARSET;
5269 else if (stricmp (lpcs, "jis") == 0) return SHIFTJIS_CHARSET;
5270 else if (stricmp (lpcs, "ksc5601.1987") == 0) return HANGEUL_CHARSET;
5271 else if (stricmp (lpcs, "gb2312") == 0) return GB2312_CHARSET;
5272 else if (stricmp (lpcs, "big5") == 0) return CHINESEBIG5_CHARSET;
5273 else if (stricmp (lpcs, "ms-oem") == 0) return OEM_CHARSET;
5274
5275 #ifdef EASTEUROPE_CHARSET
5276 else if (stricmp (lpcs, "iso8859-2") == 0) return EASTEUROPE_CHARSET;
5277 else if (stricmp (lpcs, "iso8859-3") == 0) return TURKISH_CHARSET;
5278 else if (stricmp (lpcs, "iso8859-4") == 0) return BALTIC_CHARSET;
5279 else if (stricmp (lpcs, "iso8859-5") == 0) return RUSSIAN_CHARSET;
5280 else if (stricmp (lpcs, "koi8") == 0) return RUSSIAN_CHARSET;
5281 else if (stricmp (lpcs, "iso8859-6") == 0) return ARABIC_CHARSET;
5282 else if (stricmp (lpcs, "iso8859-7") == 0) return GREEK_CHARSET;
5283 else if (stricmp (lpcs, "iso8859-8") == 0) return HEBREW_CHARSET;
5284 else if (stricmp (lpcs, "iso8859-9") == 0) return TURKISH_CHARSET;
5285 else if (stricmp (lpcs, "viscii") == 0) return VIETNAMESE_CHARSET;
5286 else if (stricmp (lpcs, "vscii") == 0) return VIETNAMESE_CHARSET;
5287 else if (stricmp (lpcs, "tis620") == 0) return THAI_CHARSET;
5288 else if (stricmp (lpcs, "mac") == 0) return MAC_CHARSET;
5289 else if (stricmp (lpcs, "ksc5601.1992") == 0) return JOHAB_CHARSET;
5290 /* For backwards compatibility with previous 20.4 pretests. */
5291 else if (stricmp (lpcs, "ksc5601") == 0) return HANGEUL_CHARSET;
5292 else if (stricmp (lpcs, "johab") == 0) return JOHAB_CHARSET;
5293 #endif
5294
5295 #ifdef UNICODE_CHARSET
5296 else if (stricmp (lpcs,"iso10646") == 0) return UNICODE_CHARSET;
5297 else if (stricmp (lpcs, "unicode") == 0) return UNICODE_CHARSET;
5298 #endif
5299 else if (lpcs[0] == '#') return atoi (lpcs + 1);
5300 else
5301 return DEFAULT_CHARSET;
5302 }
5303
5304 char *
5305 w32_to_x_charset (fncharset)
5306 int fncharset;
5307 {
5308 static char buf[16];
5309
5310 switch (fncharset)
5311 {
5312 /* ansi is considered iso8859-1, as most modern ansi fonts are. */
5313 case ANSI_CHARSET: return "iso8859-1";
5314 case DEFAULT_CHARSET: return "ascii-*";
5315 case SYMBOL_CHARSET: return "ms-symbol";
5316 case SHIFTJIS_CHARSET: return "jisx0208-sjis";
5317 case HANGEUL_CHARSET: return "ksc5601.1987-*";
5318 case GB2312_CHARSET: return "gb2312-*";
5319 case CHINESEBIG5_CHARSET: return "big5-*";
5320 case OEM_CHARSET: return "ms-oem";
5321
5322 /* More recent versions of Windows (95 and NT4.0) define more
5323 character sets. */
5324 #ifdef EASTEUROPE_CHARSET
5325 case EASTEUROPE_CHARSET: return "iso8859-2";
5326 case TURKISH_CHARSET: return "iso8859-9";
5327 case BALTIC_CHARSET: return "iso8859-4";
5328
5329 /* W95 with international support but not IE4 often has the
5330 KOI8-R codepage but not ISO8859-5. */
5331 case RUSSIAN_CHARSET:
5332 if (!IsValidCodePage(28595) && IsValidCodePage(20886))
5333 return "koi8-r";
5334 else
5335 return "iso8859-5";
5336 case ARABIC_CHARSET: return "iso8859-6";
5337 case GREEK_CHARSET: return "iso8859-7";
5338 case HEBREW_CHARSET: return "iso8859-8";
5339 case VIETNAMESE_CHARSET: return "viscii1.1-*";
5340 case THAI_CHARSET: return "tis620-*";
5341 case MAC_CHARSET: return "mac-*";
5342 case JOHAB_CHARSET: return "ksc5601.1992-*";
5343
5344 #endif
5345
5346 #ifdef UNICODE_CHARSET
5347 case UNICODE_CHARSET: return "iso10646-unicode";
5348 #endif
5349 }
5350 /* Encode numerical value of unknown charset. */
5351 sprintf (buf, "*-#%u", fncharset);
5352 return buf;
5353 }
5354
5355 BOOL
5356 w32_to_x_font (lplogfont, lpxstr, len)
5357 LOGFONT * lplogfont;
5358 char * lpxstr;
5359 int len;
5360 {
5361 char fontname[50];
5362 char height_pixels[8];
5363 char height_dpi[8];
5364 char width_pixels[8];
5365 char *fontname_dash;
5366 int display_resy = one_w32_display_info.height_in;
5367 int display_resx = one_w32_display_info.width_in;
5368
5369 if (!lpxstr) abort ();
5370
5371 if (!lplogfont)
5372 return FALSE;
5373
5374 strncpy (fontname, lplogfont->lfFaceName, 50);
5375 fontname[49] = '\0'; /* Just in case */
5376
5377 /* Replace dashes with underscores so the dashes are not
5378 misinterpreted */
5379 fontname_dash = fontname;
5380 while (fontname_dash = strchr (fontname_dash, '-'))
5381 *fontname_dash = '_';
5382
5383 if (lplogfont->lfHeight)
5384 {
5385 sprintf (height_pixels, "%u", abs (lplogfont->lfHeight));
5386 sprintf (height_dpi, "%u",
5387 abs (lplogfont->lfHeight) * 720 / display_resy);
5388 }
5389 else
5390 {
5391 strcpy (height_pixels, "*");
5392 strcpy (height_dpi, "*");
5393 }
5394 if (lplogfont->lfWidth)
5395 sprintf (width_pixels, "%u", lplogfont->lfWidth * 10);
5396 else
5397 strcpy (width_pixels, "*");
5398
5399 _snprintf (lpxstr, len - 1,
5400 "-*-%s-%s-%c-*-*-%s-%s-%d-%d-%c-%s-%s",
5401 /* foundry */
5402 fontname, /* family */
5403 w32_to_x_weight (lplogfont->lfWeight), /* weight */
5404 lplogfont->lfItalic?'i':'r', /* slant */
5405 /* setwidth name */
5406 /* add style name */
5407 height_pixels, /* pixel size */
5408 height_dpi, /* point size */
5409 display_resx, /* resx */
5410 display_resy, /* resy */
5411 ((lplogfont->lfPitchAndFamily & 0x3) == VARIABLE_PITCH)
5412 ? 'p' : 'c', /* spacing */
5413 width_pixels, /* avg width */
5414 w32_to_x_charset (lplogfont->lfCharSet) /* charset registry
5415 and encoding*/
5416 );
5417
5418 lpxstr[len - 1] = 0; /* just to be sure */
5419 return (TRUE);
5420 }
5421
5422 BOOL
5423 x_to_w32_font (lpxstr, lplogfont)
5424 char * lpxstr;
5425 LOGFONT * lplogfont;
5426 {
5427 if (!lplogfont) return (FALSE);
5428
5429 memset (lplogfont, 0, sizeof (*lplogfont));
5430
5431 /* Set default value for each field. */
5432 #if 1
5433 lplogfont->lfOutPrecision = OUT_DEFAULT_PRECIS;
5434 lplogfont->lfClipPrecision = CLIP_DEFAULT_PRECIS;
5435 lplogfont->lfQuality = DEFAULT_QUALITY;
5436 #else
5437 /* go for maximum quality */
5438 lplogfont->lfOutPrecision = OUT_STROKE_PRECIS;
5439 lplogfont->lfClipPrecision = CLIP_STROKE_PRECIS;
5440 lplogfont->lfQuality = PROOF_QUALITY;
5441 #endif
5442
5443 lplogfont->lfCharSet = DEFAULT_CHARSET;
5444 lplogfont->lfWeight = FW_DONTCARE;
5445 lplogfont->lfPitchAndFamily = DEFAULT_PITCH | FF_DONTCARE;
5446
5447 if (!lpxstr)
5448 return FALSE;
5449
5450 /* Provide a simple escape mechanism for specifying Windows font names
5451 * directly -- if font spec does not beginning with '-', assume this
5452 * format:
5453 * "<font name>[:height in pixels[:width in pixels[:weight]]]"
5454 */
5455
5456 if (*lpxstr == '-')
5457 {
5458 int fields, tem;
5459 char name[50], weight[20], slant, pitch, pixels[10], height[10],
5460 width[10], resy[10], remainder[20];
5461 char * encoding;
5462 int dpi = one_w32_display_info.height_in;
5463
5464 fields = sscanf (lpxstr,
5465 "-%*[^-]-%49[^-]-%19[^-]-%c-%*[^-]-%*[^-]-%9[^-]-%9[^-]-%*[^-]-%9[^-]-%c-%9[^-]-%19s",
5466 name, weight, &slant, pixels, height, resy, &pitch, width, remainder);
5467 if (fields == EOF) return (FALSE);
5468
5469 if (fields > 0 && name[0] != '*')
5470 {
5471 strncpy (lplogfont->lfFaceName,name, LF_FACESIZE);
5472 lplogfont->lfFaceName[LF_FACESIZE-1] = 0;
5473 }
5474 else
5475 {
5476 lplogfont->lfFaceName[0] = 0;
5477 }
5478
5479 fields--;
5480
5481 lplogfont->lfWeight = x_to_w32_weight ((fields > 0 ? weight : ""));
5482
5483 fields--;
5484
5485 if (!NILP (Vw32_enable_italics))
5486 lplogfont->lfItalic = (fields > 0 && slant == 'i');
5487
5488 fields--;
5489
5490 if (fields > 0 && pixels[0] != '*')
5491 lplogfont->lfHeight = atoi (pixels);
5492
5493 fields--;
5494 fields--;
5495 if (fields > 0 && resy[0] != '*')
5496 {
5497 tem = atoi (pixels);
5498 if (tem > 0) dpi = tem;
5499 }
5500
5501 if (fields > -1 && lplogfont->lfHeight == 0 && height[0] != '*')
5502 lplogfont->lfHeight = atoi (height) * dpi / 720;
5503
5504 if (fields > 0)
5505 lplogfont->lfPitchAndFamily =
5506 (fields > 0 && pitch == 'p') ? VARIABLE_PITCH : FIXED_PITCH;
5507
5508 fields--;
5509
5510 if (fields > 0 && width[0] != '*')
5511 lplogfont->lfWidth = atoi (width) / 10;
5512
5513 fields--;
5514
5515 /* Strip the trailing '-' if present. (it shouldn't be, as it
5516 fails the test against xlfn-tight-regexp in fontset.el). */
5517 {
5518 int len = strlen (remainder);
5519 if (len > 0 && remainder[len-1] == '-')
5520 remainder[len-1] = 0;
5521 }
5522 encoding = remainder;
5523 if (strncmp (encoding, "*-", 2) == 0)
5524 encoding += 2;
5525 lplogfont->lfCharSet = x_to_w32_charset (fields > 0 ? encoding : "");
5526 }
5527 else
5528 {
5529 int fields;
5530 char name[100], height[10], width[10], weight[20];
5531
5532 fields = sscanf (lpxstr,
5533 "%99[^:]:%9[^:]:%9[^:]:%19s",
5534 name, height, width, weight);
5535
5536 if (fields == EOF) return (FALSE);
5537
5538 if (fields > 0)
5539 {
5540 strncpy (lplogfont->lfFaceName,name, LF_FACESIZE);
5541 lplogfont->lfFaceName[LF_FACESIZE-1] = 0;
5542 }
5543 else
5544 {
5545 lplogfont->lfFaceName[0] = 0;
5546 }
5547
5548 fields--;
5549
5550 if (fields > 0)
5551 lplogfont->lfHeight = atoi (height);
5552
5553 fields--;
5554
5555 if (fields > 0)
5556 lplogfont->lfWidth = atoi (width);
5557
5558 fields--;
5559
5560 lplogfont->lfWeight = x_to_w32_weight ((fields > 0 ? weight : ""));
5561 }
5562
5563 /* This makes TrueType fonts work better. */
5564 lplogfont->lfHeight = - abs (lplogfont->lfHeight);
5565
5566 return (TRUE);
5567 }
5568
5569 BOOL
5570 w32_font_match (lpszfont1, lpszfont2)
5571 char * lpszfont1;
5572 char * lpszfont2;
5573 {
5574 char * s1 = lpszfont1, *e1, *w1;
5575 char * s2 = lpszfont2, *e2, *w2;
5576
5577 if (s1 == NULL || s2 == NULL) return (FALSE);
5578
5579 if (*s1 == '-') s1++;
5580 if (*s2 == '-') s2++;
5581
5582 while (1)
5583 {
5584 int len1, len2, len3=0;
5585
5586 e1 = strchr (s1, '-');
5587 e2 = strchr (s2, '-');
5588 w1 = strchr (s1, '*');
5589 w2 = strchr (s2, '*');
5590
5591 if (e1 == NULL)
5592 len1 = strlen (s1);
5593 else
5594 len1 = e1 - s1;
5595 if (e2 == NULL)
5596 len2 = strlen (s1);
5597 else
5598 len2 = e2 - s2;
5599
5600 if (w1 && w1 < e1)
5601 len3 = w1 - s1;
5602 if (w2 && w2 < e2 && ( len3 == 0 || (w2 - s2) < len3))
5603 len3 = w2 - s2;
5604
5605 /* Whole field is not a wildcard, and ...*/
5606 if (*s1 != '*' && *s2 != '*' && *s1 != '-' && *s2 != '-'
5607 /* Lengths are different and there are no wildcards, or ... */
5608 && ((len1 != len2 && len3 == 0) ||
5609 /* strings don't match up until first wildcard or end. */
5610 strnicmp (s1, s2, len3 > 0 ? len3 : len1) != 0))
5611 return (FALSE);
5612
5613 if (e1 == NULL || e2 == NULL)
5614 return (TRUE);
5615
5616 s1 = e1 + 1;
5617 s2 = e2 + 1;
5618 }
5619 }
5620
5621 typedef struct enumfont_t
5622 {
5623 HDC hdc;
5624 int numFonts;
5625 LOGFONT logfont;
5626 XFontStruct *size_ref;
5627 Lisp_Object *pattern;
5628 Lisp_Object *tail;
5629 } enumfont_t;
5630
5631 int CALLBACK
5632 enum_font_cb2 (lplf, lptm, FontType, lpef)
5633 ENUMLOGFONT * lplf;
5634 NEWTEXTMETRIC * lptm;
5635 int FontType;
5636 enumfont_t * lpef;
5637 {
5638 if (lplf->elfLogFont.lfStrikeOut || lplf->elfLogFont.lfUnderline)
5639 return (1);
5640
5641 /* Check that the character set matches if it was specified */
5642 if (lpef->logfont.lfCharSet != DEFAULT_CHARSET &&
5643 lplf->elfLogFont.lfCharSet != lpef->logfont.lfCharSet)
5644 return (1);
5645
5646 /* We want all fonts cached, so don't compare sizes just yet */
5647 /* if (!lpef->size_ref || lptm->tmMaxCharWidth == FONT_WIDTH (lpef->size_ref)) */
5648 {
5649 char buf[100];
5650 Lisp_Object width = Qnil;
5651
5652 if (!NILP (*(lpef->pattern)) && FontType != RASTER_FONTTYPE)
5653 {
5654 /* Scalable fonts are as big as you want them to be. */
5655 lplf->elfLogFont.lfHeight = lpef->logfont.lfHeight;
5656 lplf->elfLogFont.lfWidth = lpef->logfont.lfWidth;
5657 }
5658
5659 /* The MaxCharWidth is not valid at this stage for scalable fonts. */
5660 if (FontType == RASTER_FONTTYPE)
5661 width = make_number (lptm->tmMaxCharWidth);
5662
5663 if (!w32_to_x_font (&(lplf->elfLogFont), buf, 100))
5664 return (0);
5665
5666 if (NILP (*(lpef->pattern)) ||
5667 w32_font_match (buf, XSTRING (*(lpef->pattern))->data))
5668 {
5669 *lpef->tail = Fcons (Fcons (build_string (buf), width), Qnil);
5670 lpef->tail = &(XCONS (*lpef->tail)->cdr);
5671 lpef->numFonts++;
5672 }
5673 }
5674
5675 return (1);
5676 }
5677
5678 int CALLBACK
5679 enum_font_cb1 (lplf, lptm, FontType, lpef)
5680 ENUMLOGFONT * lplf;
5681 NEWTEXTMETRIC * lptm;
5682 int FontType;
5683 enumfont_t * lpef;
5684 {
5685 return EnumFontFamilies (lpef->hdc,
5686 lplf->elfLogFont.lfFaceName,
5687 (FONTENUMPROC) enum_font_cb2,
5688 (LPARAM) lpef);
5689 }
5690
5691
5692 /* Interface to fontset handler. (adapted from mw32font.c in Meadow
5693 and xterm.c in Emacs 20.3) */
5694
5695 Lisp_Object w32_list_bdf_fonts (Lisp_Object pattern)
5696 {
5697 char *fontname, *ptnstr;
5698 Lisp_Object list, tem, newlist = Qnil;
5699
5700 list = Vw32_bdf_filename_alist;
5701 ptnstr = XSTRING (pattern)->data;
5702
5703 for ( ; CONSP (list); list = XCONS (list)->cdr)
5704 {
5705 tem = XCONS (list)->car;
5706 if (CONSP (tem))
5707 fontname = XSTRING (XCONS (tem)->car)->data;
5708 else if (STRINGP (tem))
5709 fontname = XSTRING (tem)->data;
5710 else
5711 continue;
5712
5713 if (w32_font_match (fontname, ptnstr))
5714 newlist = Fcons (XCONS (tem)->car, newlist);
5715 }
5716
5717 return newlist;
5718 }
5719
5720 /* Return a list of names of available fonts matching PATTERN on frame
5721 F. If SIZE is not 0, it is the size (maximum bound width) of fonts
5722 to be listed. Frame F NULL means we have not yet created any
5723 frame, which means we can't get proper size info, as we don't have
5724 a device context to use for GetTextMetrics.
5725 MAXNAMES sets a limit on how many fonts to match. */
5726
5727 Lisp_Object
5728 w32_list_fonts (FRAME_PTR f, Lisp_Object pattern, int size, int maxnames )
5729 {
5730 Lisp_Object patterns, key, tem, tpat;
5731 Lisp_Object list = Qnil, newlist = Qnil, second_best = Qnil;
5732 struct w32_display_info *dpyinfo = &one_w32_display_info;
5733
5734 patterns = Fassoc (pattern, Valternate_fontname_alist);
5735 if (NILP (patterns))
5736 patterns = Fcons (pattern, Qnil);
5737
5738 for (; CONSP (patterns); patterns = XCONS (patterns)->cdr)
5739 {
5740 enumfont_t ef;
5741
5742 tpat = XCONS (patterns)->car;
5743
5744 /* See if we cached the result for this particular query.
5745 The cache is an alist of the form:
5746 ((PATTERN (FONTNAME . WIDTH) ...) ...)
5747 */
5748 if (tem = XCONS (dpyinfo->name_list_element)->cdr,
5749 !NILP (list = Fassoc (tpat, tem)))
5750 {
5751 list = Fcdr_safe (list);
5752 /* We have a cached list. Don't have to get the list again. */
5753 goto label_cached;
5754 }
5755
5756 BLOCK_INPUT;
5757 /* At first, put PATTERN in the cache. */
5758 list = Qnil;
5759 ef.pattern = &tpat;
5760 ef.tail = &list;
5761 ef.numFonts = 0;
5762
5763 x_to_w32_font (STRINGP (tpat) ? XSTRING (tpat)->data :
5764 NULL, &ef.logfont);
5765 {
5766 ef.hdc = GetDC (dpyinfo->root_window);
5767
5768 EnumFontFamilies (ef.hdc, NULL, (FONTENUMPROC) enum_font_cb1,
5769 (LPARAM)&ef);
5770
5771 ReleaseDC (dpyinfo->root_window, ef.hdc);
5772 }
5773
5774 UNBLOCK_INPUT;
5775
5776 /* Make a list of the fonts we got back.
5777 Store that in the font cache for the display. */
5778 XCONS (dpyinfo->name_list_element)->cdr
5779 = Fcons (Fcons (tpat, list),
5780 XCONS (dpyinfo->name_list_element)->cdr);
5781
5782 label_cached:
5783 if (NILP (list)) continue; /* Try the remaining alternatives. */
5784
5785 newlist = second_best = Qnil;
5786
5787 /* Make a list of the fonts that have the right width. */
5788 for (; CONSP (list); list = XCONS (list)->cdr)
5789 {
5790 int found_size;
5791 tem = XCONS (list)->car;
5792
5793 if (!CONSP (tem))
5794 continue;
5795 if (NILP (XCONS (tem)->car))
5796 continue;
5797 if (!size)
5798 {
5799 newlist = Fcons (XCONS (tem)->car, newlist);
5800 continue;
5801 }
5802 if (!INTEGERP (XCONS (tem)->cdr))
5803 {
5804 /* Since we don't yet know the size of the font, we must
5805 load it and try GetTextMetrics. */
5806 W32FontStruct thisinfo;
5807 LOGFONT lf;
5808 HDC hdc;
5809 HANDLE oldobj;
5810
5811 if (!x_to_w32_font (XSTRING (XCONS (tem)->car)->data, &lf))
5812 continue;
5813
5814 BLOCK_INPUT;
5815 thisinfo.bdf = NULL;
5816 thisinfo.hfont = CreateFontIndirect (&lf);
5817 if (thisinfo.hfont == NULL)
5818 continue;
5819
5820 hdc = GetDC (dpyinfo->root_window);
5821 oldobj = SelectObject (hdc, thisinfo.hfont);
5822 if (GetTextMetrics (hdc, &thisinfo.tm))
5823 XCONS (tem)->cdr = make_number (FONT_WIDTH (&thisinfo));
5824 else
5825 XCONS (tem)->cdr = make_number (0);
5826 SelectObject (hdc, oldobj);
5827 ReleaseDC (dpyinfo->root_window, hdc);
5828 DeleteObject(thisinfo.hfont);
5829 UNBLOCK_INPUT;
5830 }
5831 found_size = XINT (XCONS (tem)->cdr);
5832 if (found_size == size)
5833 newlist = Fcons (XCONS (tem)->car, newlist);
5834
5835 /* keep track of the closest matching size in case
5836 no exact match is found. */
5837 else if (found_size > 0)
5838 {
5839 if (NILP (second_best))
5840 second_best = tem;
5841 else if (found_size < size)
5842 {
5843 if (XINT (XCONS (second_best)->cdr) > size
5844 || XINT (XCONS (second_best)->cdr) < found_size)
5845 second_best = tem;
5846 }
5847 else
5848 {
5849 if (XINT (XCONS (second_best)->cdr) > size
5850 && XINT (XCONS (second_best)->cdr) >
5851 found_size)
5852 second_best = tem;
5853 }
5854 }
5855 }
5856
5857 if (!NILP (newlist))
5858 break;
5859 else if (!NILP (second_best))
5860 {
5861 newlist = Fcons (XCONS (second_best)->car, Qnil);
5862 break;
5863 }
5864 }
5865
5866 /* Include any bdf fonts. */
5867 {
5868 Lisp_Object combined[2];
5869 combined[0] = w32_list_bdf_fonts (pattern);
5870 combined[1] = newlist;
5871 newlist = Fnconc(2, combined);
5872 }
5873
5874 return newlist;
5875 }
5876
5877 /* Return a pointer to struct font_info of font FONT_IDX of frame F. */
5878 struct font_info *
5879 w32_get_font_info (f, font_idx)
5880 FRAME_PTR f;
5881 int font_idx;
5882 {
5883 return (FRAME_W32_FONT_TABLE (f) + font_idx);
5884 }
5885
5886
5887 struct font_info*
5888 w32_query_font (struct frame *f, char *fontname)
5889 {
5890 int i;
5891 struct font_info *pfi;
5892
5893 pfi = FRAME_W32_FONT_TABLE (f);
5894
5895 for (i = 0; i < one_w32_display_info.n_fonts ;i++, pfi++)
5896 {
5897 if (strcmp(pfi->name, fontname) == 0) return pfi;
5898 }
5899
5900 return NULL;
5901 }
5902
5903 /* Find a CCL program for a font specified by FONTP, and set the member
5904 `encoder' of the structure. */
5905
5906 void
5907 w32_find_ccl_program (fontp)
5908 struct font_info *fontp;
5909 {
5910 extern Lisp_Object Vfont_ccl_encoder_alist, Vccl_program_table;
5911 extern Lisp_Object Qccl_program_idx;
5912 extern Lisp_Object resolve_symbol_ccl_program ();
5913 Lisp_Object list, elt, ccl_prog, ccl_id;
5914
5915 for (list = Vfont_ccl_encoder_alist; CONSP (list); list = XCONS (list)->cdr)
5916 {
5917 elt = XCONS (list)->car;
5918 if (CONSP (elt)
5919 && STRINGP (XCONS (elt)->car)
5920 && (fast_c_string_match_ignore_case (XCONS (elt)->car, fontp->name)
5921 >= 0))
5922 {
5923 if (SYMBOLP (XCONS (elt)->cdr) &&
5924 (!NILP (ccl_id = Fget (XCONS (elt)->cdr, Qccl_program_idx))))
5925 {
5926 ccl_prog = XVECTOR (Vccl_program_table)->contents[XUINT (ccl_id)];
5927 if (!CONSP (ccl_prog)) continue;
5928 ccl_prog = XCONS (ccl_prog)->cdr;
5929 }
5930 else
5931 {
5932 ccl_prog = XCONS (elt)->cdr;
5933 if (!VECTORP (ccl_prog)) continue;
5934 }
5935
5936 fontp->font_encoder
5937 = (struct ccl_program *) xmalloc (sizeof (struct ccl_program));
5938 setup_ccl_program (fontp->font_encoder,
5939 resolve_symbol_ccl_program (ccl_prog));
5940 break;
5941 }
5942 }
5943 }
5944
5945 \f
5946 #if 1
5947 #include "x-list-font.c"
5948 #else
5949 DEFUN ("x-list-fonts", Fx_list_fonts, Sx_list_fonts, 1, 4, 0,
5950 "Return a list of the names of available fonts matching PATTERN.\n\
5951 If optional arguments FACE and FRAME are specified, return only fonts\n\
5952 the same size as FACE on FRAME.\n\
5953 \n\
5954 PATTERN is a string, perhaps with wildcard characters;\n\
5955 the * character matches any substring, and\n\
5956 the ? character matches any single character.\n\
5957 PATTERN is case-insensitive.\n\
5958 FACE is a face name--a symbol.\n\
5959 \n\
5960 The return value is a list of strings, suitable as arguments to\n\
5961 set-face-font.\n\
5962 \n\
5963 Fonts Emacs can't use (i.e. proportional fonts) may or may not be excluded\n\
5964 even if they match PATTERN and FACE.\n\
5965 \n\
5966 The optional fourth argument MAXIMUM sets a limit on how many\n\
5967 fonts to match. The first MAXIMUM fonts are reported.")
5968 (pattern, face, frame, maximum)
5969 Lisp_Object pattern, face, frame, maximum;
5970 {
5971 int num_fonts;
5972 char **names;
5973 XFontStruct *info;
5974 XFontStruct *size_ref;
5975 Lisp_Object namelist;
5976 Lisp_Object list;
5977 FRAME_PTR f;
5978 enumfont_t ef;
5979
5980 CHECK_STRING (pattern, 0);
5981 if (!NILP (face))
5982 CHECK_SYMBOL (face, 1);
5983
5984 f = check_x_frame (frame);
5985
5986 /* Determine the width standard for comparison with the fonts we find. */
5987
5988 if (NILP (face))
5989 size_ref = 0;
5990 else
5991 {
5992 int face_id;
5993
5994 /* Don't die if we get called with a terminal frame. */
5995 if (! FRAME_W32_P (f))
5996 error ("non-w32 frame used in `x-list-fonts'");
5997
5998 face_id = face_name_id_number (f, face);
5999
6000 if (face_id < 0 || face_id >= FRAME_N_PARAM_FACES (f)
6001 || FRAME_PARAM_FACES (f) [face_id] == 0)
6002 size_ref = f->output_data.w32->font;
6003 else
6004 {
6005 size_ref = FRAME_PARAM_FACES (f) [face_id]->font;
6006 if (size_ref == (XFontStruct *) (~0))
6007 size_ref = f->output_data.w32->font;
6008 }
6009 }
6010
6011 /* See if we cached the result for this particular query. */
6012 list = Fassoc (pattern,
6013 XCONS (FRAME_W32_DISPLAY_INFO (f)->name_list_element)->cdr);
6014
6015 /* We have info in the cache for this PATTERN. */
6016 if (!NILP (list))
6017 {
6018 Lisp_Object tem, newlist;
6019
6020 /* We have info about this pattern. */
6021 list = XCONS (list)->cdr;
6022
6023 if (size_ref == 0)
6024 return list;
6025
6026 BLOCK_INPUT;
6027
6028 /* Filter the cached info and return just the fonts that match FACE. */
6029 newlist = Qnil;
6030 for (tem = list; CONSP (tem); tem = XCONS (tem)->cdr)
6031 {
6032 struct font_info *fontinf;
6033 XFontStruct *thisinfo = NULL;
6034
6035 fontinf = w32_load_font (f, XSTRING (XCONS (tem)->car)->data, 0);
6036 if (fontinf)
6037 thisinfo = (XFontStruct *)fontinf->font;
6038 if (thisinfo && same_size_fonts (thisinfo, size_ref))
6039 newlist = Fcons (XCONS (tem)->car, newlist);
6040
6041 w32_unload_font (FRAME_W32_DISPLAY_INFO (f), thisinfo);
6042 }
6043
6044 UNBLOCK_INPUT;
6045
6046 return newlist;
6047 }
6048
6049 BLOCK_INPUT;
6050
6051 namelist = Qnil;
6052 ef.pattern = &pattern;
6053 ef.tail &namelist;
6054 ef.numFonts = 0;
6055 x_to_w32_font (STRINGP (pattern) ? XSTRING (pattern)->data : NULL, &ef.logfont);
6056
6057 {
6058 ef.hdc = GetDC (FRAME_W32_WINDOW (f));
6059
6060 EnumFontFamilies (ef.hdc, NULL, (FONTENUMPROC) enum_font_cb1, (LPARAM)&ef);
6061
6062 ReleaseDC (FRAME_W32_WINDOW (f), ef.hdc);
6063 }
6064
6065 UNBLOCK_INPUT;
6066
6067 if (ef.numFonts)
6068 {
6069 int i;
6070 Lisp_Object cur;
6071
6072 /* Make a list of all the fonts we got back.
6073 Store that in the font cache for the display. */
6074 XCONS (FRAME_W32_DISPLAY_INFO (f)->name_list_element)->cdr
6075 = Fcons (Fcons (pattern, namelist),
6076 XCONS (FRAME_W32_DISPLAY_INFO (f)->name_list_element)->cdr);
6077
6078 /* Make a list of the fonts that have the right width. */
6079 list = Qnil;
6080 cur=namelist;
6081 for (i = 0; i < ef.numFonts; i++)
6082 {
6083 int keeper;
6084
6085 if (!size_ref)
6086 keeper = 1;
6087 else
6088 {
6089 struct font_info *fontinf;
6090 XFontStruct *thisinfo = NULL;
6091
6092 BLOCK_INPUT;
6093 fontinf = w32_load_font (f, XSTRING (Fcar (cur))->data, 0);
6094 if (fontinf)
6095 thisinfo = (XFontStruct *)fontinf->font;
6096
6097 keeper = thisinfo && same_size_fonts (thisinfo, size_ref);
6098
6099 w32_unload_font (FRAME_W32_DISPLAY_INFO (f), thisinfo);
6100
6101 UNBLOCK_INPUT;
6102 }
6103 if (keeper)
6104 list = Fcons (build_string (XSTRING (Fcar (cur))->data), list);
6105
6106 cur = Fcdr (cur);
6107 }
6108 list = Fnreverse (list);
6109 }
6110
6111 return list;
6112 }
6113 #endif
6114 \f
6115 DEFUN ("w32-find-bdf-fonts", Fw32_find_bdf_fonts, Sw32_find_bdf_fonts,
6116 1, 1, 0,
6117 "Return a list of BDF fonts in DIR, suitable for appending to\n\
6118 w32-bdf-filename-alist. Fonts which do not contain an xfld description\n\
6119 will not be included in the list. DIR may be a list of directories.")
6120 (directory)
6121 Lisp_Object directory;
6122 {
6123 Lisp_Object list = Qnil;
6124 struct gcpro gcpro1, gcpro2;
6125
6126 if (!CONSP (directory))
6127 return w32_find_bdf_fonts_in_dir (directory);
6128
6129 for ( ; CONSP (directory); directory = XCONS (directory)->cdr)
6130 {
6131 Lisp_Object pair[2];
6132 pair[0] = list;
6133 pair[1] = Qnil;
6134 GCPRO2 (directory, list);
6135 pair[1] = w32_find_bdf_fonts_in_dir( XCONS (directory)->car );
6136 list = Fnconc( 2, pair );
6137 UNGCPRO;
6138 }
6139 return list;
6140 }
6141
6142 /* Find BDF files in a specified directory. (use GCPRO when calling,
6143 as this calls lisp to get a directory listing). */
6144 Lisp_Object w32_find_bdf_fonts_in_dir( Lisp_Object directory )
6145 {
6146 Lisp_Object filelist, list = Qnil;
6147 char fontname[100];
6148
6149 if (!STRINGP(directory))
6150 return Qnil;
6151
6152 filelist = Fdirectory_files (directory, Qt,
6153 build_string (".*\\.[bB][dD][fF]"), Qt);
6154
6155 for ( ; CONSP(filelist); filelist = XCONS (filelist)->cdr)
6156 {
6157 Lisp_Object filename = XCONS (filelist)->car;
6158 if (w32_BDF_to_x_font (XSTRING (filename)->data, fontname, 100))
6159 store_in_alist (&list, build_string (fontname), filename);
6160 }
6161 return list;
6162 }
6163
6164 \f
6165 DEFUN ("x-color-defined-p", Fx_color_defined_p, Sx_color_defined_p, 1, 2, 0,
6166 "Return non-nil if color COLOR is supported on frame FRAME.\n\
6167 If FRAME is omitted or nil, use the selected frame.")
6168 (color, frame)
6169 Lisp_Object color, frame;
6170 {
6171 COLORREF foo;
6172 FRAME_PTR f = check_x_frame (frame);
6173
6174 CHECK_STRING (color, 1);
6175
6176 if (defined_color (f, XSTRING (color)->data, &foo, 0))
6177 return Qt;
6178 else
6179 return Qnil;
6180 }
6181
6182 DEFUN ("x-color-values", Fx_color_values, Sx_color_values, 1, 2, 0,
6183 "Return a description of the color named COLOR on frame FRAME.\n\
6184 The value is a list of integer RGB values--(RED GREEN BLUE).\n\
6185 These values appear to range from 0 to 65280 or 65535, depending\n\
6186 on the system; white is (65280 65280 65280) or (65535 65535 65535).\n\
6187 If FRAME is omitted or nil, use the selected frame.")
6188 (color, frame)
6189 Lisp_Object color, frame;
6190 {
6191 COLORREF foo;
6192 FRAME_PTR f = check_x_frame (frame);
6193
6194 CHECK_STRING (color, 1);
6195
6196 if (defined_color (f, XSTRING (color)->data, &foo, 0))
6197 {
6198 Lisp_Object rgb[3];
6199
6200 rgb[0] = make_number ((GetRValue (foo) << 8) | GetRValue (foo));
6201 rgb[1] = make_number ((GetGValue (foo) << 8) | GetGValue (foo));
6202 rgb[2] = make_number ((GetBValue (foo) << 8) | GetBValue (foo));
6203 return Flist (3, rgb);
6204 }
6205 else
6206 return Qnil;
6207 }
6208
6209 DEFUN ("x-display-color-p", Fx_display_color_p, Sx_display_color_p, 0, 1, 0,
6210 "Return t if the X display supports color.\n\
6211 The optional argument DISPLAY specifies which display to ask about.\n\
6212 DISPLAY should be either a frame or a display name (a string).\n\
6213 If omitted or nil, that stands for the selected frame's display.")
6214 (display)
6215 Lisp_Object display;
6216 {
6217 struct w32_display_info *dpyinfo = check_x_display_info (display);
6218
6219 if ((dpyinfo->n_planes * dpyinfo->n_cbits) <= 2)
6220 return Qnil;
6221
6222 return Qt;
6223 }
6224
6225 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p, Sx_display_grayscale_p,
6226 0, 1, 0,
6227 "Return t if the X display supports shades of gray.\n\
6228 Note that color displays do support shades of gray.\n\
6229 The optional argument DISPLAY specifies which display to ask about.\n\
6230 DISPLAY should be either a frame or a display name (a string).\n\
6231 If omitted or nil, that stands for the selected frame's display.")
6232 (display)
6233 Lisp_Object display;
6234 {
6235 struct w32_display_info *dpyinfo = check_x_display_info (display);
6236
6237 if ((dpyinfo->n_planes * dpyinfo->n_cbits) <= 1)
6238 return Qnil;
6239
6240 return Qt;
6241 }
6242
6243 DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width,
6244 0, 1, 0,
6245 "Returns the width in pixels of the X display DISPLAY.\n\
6246 The optional argument DISPLAY specifies which display to ask about.\n\
6247 DISPLAY should be either a frame or a display name (a string).\n\
6248 If omitted or nil, that stands for the selected frame's display.")
6249 (display)
6250 Lisp_Object display;
6251 {
6252 struct w32_display_info *dpyinfo = check_x_display_info (display);
6253
6254 return make_number (dpyinfo->width);
6255 }
6256
6257 DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
6258 Sx_display_pixel_height, 0, 1, 0,
6259 "Returns the height in pixels of the X display DISPLAY.\n\
6260 The optional argument DISPLAY specifies which display to ask about.\n\
6261 DISPLAY should be either a frame or a display name (a string).\n\
6262 If omitted or nil, that stands for the selected frame's display.")
6263 (display)
6264 Lisp_Object display;
6265 {
6266 struct w32_display_info *dpyinfo = check_x_display_info (display);
6267
6268 return make_number (dpyinfo->height);
6269 }
6270
6271 DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
6272 0, 1, 0,
6273 "Returns the number of bitplanes of the display DISPLAY.\n\
6274 The optional argument DISPLAY specifies which display to ask about.\n\
6275 DISPLAY should be either a frame or a display name (a string).\n\
6276 If omitted or nil, that stands for the selected frame's display.")
6277 (display)
6278 Lisp_Object display;
6279 {
6280 struct w32_display_info *dpyinfo = check_x_display_info (display);
6281
6282 return make_number (dpyinfo->n_planes * dpyinfo->n_cbits);
6283 }
6284
6285 DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
6286 0, 1, 0,
6287 "Returns the number of color cells of the display DISPLAY.\n\
6288 The optional argument DISPLAY specifies which display to ask about.\n\
6289 DISPLAY should be either a frame or a display name (a string).\n\
6290 If omitted or nil, that stands for the selected frame's display.")
6291 (display)
6292 Lisp_Object display;
6293 {
6294 struct w32_display_info *dpyinfo = check_x_display_info (display);
6295 HDC hdc;
6296 int cap;
6297
6298 hdc = GetDC (dpyinfo->root_window);
6299 if (dpyinfo->has_palette)
6300 cap = GetDeviceCaps (hdc,SIZEPALETTE);
6301 else
6302 cap = GetDeviceCaps (hdc,NUMCOLORS);
6303
6304 ReleaseDC (dpyinfo->root_window, hdc);
6305
6306 return make_number (cap);
6307 }
6308
6309 DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
6310 Sx_server_max_request_size,
6311 0, 1, 0,
6312 "Returns the maximum request size of the server of display DISPLAY.\n\
6313 The optional argument DISPLAY specifies which display to ask about.\n\
6314 DISPLAY should be either a frame or a display name (a string).\n\
6315 If omitted or nil, that stands for the selected frame's display.")
6316 (display)
6317 Lisp_Object display;
6318 {
6319 struct w32_display_info *dpyinfo = check_x_display_info (display);
6320
6321 return make_number (1);
6322 }
6323
6324 DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
6325 "Returns the vendor ID string of the W32 system (Microsoft).\n\
6326 The optional argument DISPLAY specifies which display to ask about.\n\
6327 DISPLAY should be either a frame or a display name (a string).\n\
6328 If omitted or nil, that stands for the selected frame's display.")
6329 (display)
6330 Lisp_Object display;
6331 {
6332 struct w32_display_info *dpyinfo = check_x_display_info (display);
6333 char *vendor = "Microsoft Corp.";
6334
6335 if (! vendor) vendor = "";
6336 return build_string (vendor);
6337 }
6338
6339 DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
6340 "Returns the version numbers of the server of display DISPLAY.\n\
6341 The value is a list of three integers: the major and minor\n\
6342 version numbers, and the vendor-specific release\n\
6343 number. See also the function `x-server-vendor'.\n\n\
6344 The optional argument DISPLAY specifies which display to ask about.\n\
6345 DISPLAY should be either a frame or a display name (a string).\n\
6346 If omitted or nil, that stands for the selected frame's display.")
6347 (display)
6348 Lisp_Object display;
6349 {
6350 struct w32_display_info *dpyinfo = check_x_display_info (display);
6351
6352 return Fcons (make_number (w32_major_version),
6353 Fcons (make_number (w32_minor_version), Qnil));
6354 }
6355
6356 DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
6357 "Returns the number of screens on the server of display DISPLAY.\n\
6358 The optional argument DISPLAY specifies which display to ask about.\n\
6359 DISPLAY should be either a frame or a display name (a string).\n\
6360 If omitted or nil, that stands for the selected frame's display.")
6361 (display)
6362 Lisp_Object display;
6363 {
6364 struct w32_display_info *dpyinfo = check_x_display_info (display);
6365
6366 return make_number (1);
6367 }
6368
6369 DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, 0,
6370 "Returns the height in millimeters of the X display DISPLAY.\n\
6371 The optional argument DISPLAY specifies which display to ask about.\n\
6372 DISPLAY should be either a frame or a display name (a string).\n\
6373 If omitted or nil, that stands for the selected frame's display.")
6374 (display)
6375 Lisp_Object display;
6376 {
6377 struct w32_display_info *dpyinfo = check_x_display_info (display);
6378 HDC hdc;
6379 int cap;
6380
6381 hdc = GetDC (dpyinfo->root_window);
6382
6383 cap = GetDeviceCaps (hdc, VERTSIZE);
6384
6385 ReleaseDC (dpyinfo->root_window, hdc);
6386
6387 return make_number (cap);
6388 }
6389
6390 DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
6391 "Returns the width in millimeters of the X display DISPLAY.\n\
6392 The optional argument DISPLAY specifies which display to ask about.\n\
6393 DISPLAY should be either a frame or a display name (a string).\n\
6394 If omitted or nil, that stands for the selected frame's display.")
6395 (display)
6396 Lisp_Object display;
6397 {
6398 struct w32_display_info *dpyinfo = check_x_display_info (display);
6399
6400 HDC hdc;
6401 int cap;
6402
6403 hdc = GetDC (dpyinfo->root_window);
6404
6405 cap = GetDeviceCaps (hdc, HORZSIZE);
6406
6407 ReleaseDC (dpyinfo->root_window, hdc);
6408
6409 return make_number (cap);
6410 }
6411
6412 DEFUN ("x-display-backing-store", Fx_display_backing_store,
6413 Sx_display_backing_store, 0, 1, 0,
6414 "Returns an indication of whether display DISPLAY does backing store.\n\
6415 The value may be `always', `when-mapped', or `not-useful'.\n\
6416 The optional argument DISPLAY specifies which display to ask about.\n\
6417 DISPLAY should be either a frame or a display name (a string).\n\
6418 If omitted or nil, that stands for the selected frame's display.")
6419 (display)
6420 Lisp_Object display;
6421 {
6422 return intern ("not-useful");
6423 }
6424
6425 DEFUN ("x-display-visual-class", Fx_display_visual_class,
6426 Sx_display_visual_class, 0, 1, 0,
6427 "Returns the visual class of the display DISPLAY.\n\
6428 The value is one of the symbols `static-gray', `gray-scale',\n\
6429 `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
6430 The optional argument DISPLAY specifies which display to ask about.\n\
6431 DISPLAY should be either a frame or a display name (a string).\n\
6432 If omitted or nil, that stands for the selected frame's display.")
6433 (display)
6434 Lisp_Object display;
6435 {
6436 struct w32_display_info *dpyinfo = check_x_display_info (display);
6437
6438 #if 0
6439 switch (dpyinfo->visual->class)
6440 {
6441 case StaticGray: return (intern ("static-gray"));
6442 case GrayScale: return (intern ("gray-scale"));
6443 case StaticColor: return (intern ("static-color"));
6444 case PseudoColor: return (intern ("pseudo-color"));
6445 case TrueColor: return (intern ("true-color"));
6446 case DirectColor: return (intern ("direct-color"));
6447 default:
6448 error ("Display has an unknown visual class");
6449 }
6450 #endif
6451
6452 error ("Display has an unknown visual class");
6453 }
6454
6455 DEFUN ("x-display-save-under", Fx_display_save_under,
6456 Sx_display_save_under, 0, 1, 0,
6457 "Returns t if the display DISPLAY supports the save-under feature.\n\
6458 The optional argument DISPLAY specifies which display to ask about.\n\
6459 DISPLAY should be either a frame or a display name (a string).\n\
6460 If omitted or nil, that stands for the selected frame's display.")
6461 (display)
6462 Lisp_Object display;
6463 {
6464 struct w32_display_info *dpyinfo = check_x_display_info (display);
6465
6466 return Qnil;
6467 }
6468 \f
6469 int
6470 x_pixel_width (f)
6471 register struct frame *f;
6472 {
6473 return PIXEL_WIDTH (f);
6474 }
6475
6476 int
6477 x_pixel_height (f)
6478 register struct frame *f;
6479 {
6480 return PIXEL_HEIGHT (f);
6481 }
6482
6483 int
6484 x_char_width (f)
6485 register struct frame *f;
6486 {
6487 return FONT_WIDTH (f->output_data.w32->font);
6488 }
6489
6490 int
6491 x_char_height (f)
6492 register struct frame *f;
6493 {
6494 return f->output_data.w32->line_height;
6495 }
6496
6497 int
6498 x_screen_planes (frame)
6499 Lisp_Object frame;
6500 {
6501 return (FRAME_W32_DISPLAY_INFO (XFRAME (frame))->n_planes *
6502 FRAME_W32_DISPLAY_INFO (XFRAME (frame))->n_cbits);
6503 }
6504 \f
6505 /* Return the display structure for the display named NAME.
6506 Open a new connection if necessary. */
6507
6508 struct w32_display_info *
6509 x_display_info_for_name (name)
6510 Lisp_Object name;
6511 {
6512 Lisp_Object names;
6513 struct w32_display_info *dpyinfo;
6514
6515 CHECK_STRING (name, 0);
6516
6517 for (dpyinfo = &one_w32_display_info, names = w32_display_name_list;
6518 dpyinfo;
6519 dpyinfo = dpyinfo->next, names = XCONS (names)->cdr)
6520 {
6521 Lisp_Object tem;
6522 tem = Fstring_equal (XCONS (XCONS (names)->car)->car, name);
6523 if (!NILP (tem))
6524 return dpyinfo;
6525 }
6526
6527 /* Use this general default value to start with. */
6528 Vx_resource_name = Vinvocation_name;
6529
6530 validate_x_resource_name ();
6531
6532 dpyinfo = w32_term_init (name, (unsigned char *)0,
6533 (char *) XSTRING (Vx_resource_name)->data);
6534
6535 if (dpyinfo == 0)
6536 error ("Cannot connect to server %s", XSTRING (name)->data);
6537
6538 w32_in_use = 1;
6539 XSETFASTINT (Vwindow_system_version, 3);
6540
6541 return dpyinfo;
6542 }
6543
6544 DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
6545 1, 3, 0, "Open a connection to a server.\n\
6546 DISPLAY is the name of the display to connect to.\n\
6547 Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
6548 If the optional third arg MUST-SUCCEED is non-nil,\n\
6549 terminate Emacs if we can't open the connection.")
6550 (display, xrm_string, must_succeed)
6551 Lisp_Object display, xrm_string, must_succeed;
6552 {
6553 unsigned int n_planes;
6554 unsigned char *xrm_option;
6555 struct w32_display_info *dpyinfo;
6556
6557 CHECK_STRING (display, 0);
6558 if (! NILP (xrm_string))
6559 CHECK_STRING (xrm_string, 1);
6560
6561 if (! EQ (Vwindow_system, intern ("w32")))
6562 error ("Not using Microsoft Windows");
6563
6564 /* Allow color mapping to be defined externally; first look in user's
6565 HOME directory, then in Emacs etc dir for a file called rgb.txt. */
6566 {
6567 Lisp_Object color_file;
6568 struct gcpro gcpro1;
6569
6570 color_file = build_string("~/rgb.txt");
6571
6572 GCPRO1 (color_file);
6573
6574 if (NILP (Ffile_readable_p (color_file)))
6575 color_file =
6576 Fexpand_file_name (build_string ("rgb.txt"),
6577 Fsymbol_value (intern ("data-directory")));
6578
6579 Vw32_color_map = Fw32_load_color_file (color_file);
6580
6581 UNGCPRO;
6582 }
6583 if (NILP (Vw32_color_map))
6584 Vw32_color_map = Fw32_default_color_map ();
6585
6586 if (! NILP (xrm_string))
6587 xrm_option = (unsigned char *) XSTRING (xrm_string)->data;
6588 else
6589 xrm_option = (unsigned char *) 0;
6590
6591 /* Use this general default value to start with. */
6592 /* First remove .exe suffix from invocation-name - it looks ugly. */
6593 {
6594 char basename[ MAX_PATH ], *str;
6595
6596 strcpy (basename, XSTRING (Vinvocation_name)->data);
6597 str = strrchr (basename, '.');
6598 if (str) *str = 0;
6599 Vinvocation_name = build_string (basename);
6600 }
6601 Vx_resource_name = Vinvocation_name;
6602
6603 validate_x_resource_name ();
6604
6605 /* This is what opens the connection and sets x_current_display.
6606 This also initializes many symbols, such as those used for input. */
6607 dpyinfo = w32_term_init (display, xrm_option,
6608 (char *) XSTRING (Vx_resource_name)->data);
6609
6610 if (dpyinfo == 0)
6611 {
6612 if (!NILP (must_succeed))
6613 fatal ("Cannot connect to server %s.\n",
6614 XSTRING (display)->data);
6615 else
6616 error ("Cannot connect to server %s", XSTRING (display)->data);
6617 }
6618
6619 w32_in_use = 1;
6620
6621 XSETFASTINT (Vwindow_system_version, 3);
6622 return Qnil;
6623 }
6624
6625 DEFUN ("x-close-connection", Fx_close_connection,
6626 Sx_close_connection, 1, 1, 0,
6627 "Close the connection to DISPLAY's server.\n\
6628 For DISPLAY, specify either a frame or a display name (a string).\n\
6629 If DISPLAY is nil, that stands for the selected frame's display.")
6630 (display)
6631 Lisp_Object display;
6632 {
6633 struct w32_display_info *dpyinfo = check_x_display_info (display);
6634 struct w32_display_info *tail;
6635 int i;
6636
6637 if (dpyinfo->reference_count > 0)
6638 error ("Display still has frames on it");
6639
6640 BLOCK_INPUT;
6641 /* Free the fonts in the font table. */
6642 for (i = 0; i < dpyinfo->n_fonts; i++)
6643 {
6644 if (dpyinfo->font_table[i].name)
6645 free (dpyinfo->font_table[i].name);
6646 /* Don't free the full_name string;
6647 it is always shared with something else. */
6648 w32_unload_font (dpyinfo, dpyinfo->font_table[i].font);
6649 }
6650 x_destroy_all_bitmaps (dpyinfo);
6651
6652 x_delete_display (dpyinfo);
6653 UNBLOCK_INPUT;
6654
6655 return Qnil;
6656 }
6657
6658 DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0,
6659 "Return the list of display names that Emacs has connections to.")
6660 ()
6661 {
6662 Lisp_Object tail, result;
6663
6664 result = Qnil;
6665 for (tail = w32_display_name_list; ! NILP (tail); tail = XCONS (tail)->cdr)
6666 result = Fcons (XCONS (XCONS (tail)->car)->car, result);
6667
6668 return result;
6669 }
6670
6671 DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize, 1, 2, 0,
6672 "If ON is non-nil, report errors as soon as the erring request is made.\n\
6673 If ON is nil, allow buffering of requests.\n\
6674 This is a noop on W32 systems.\n\
6675 The optional second argument DISPLAY specifies which display to act on.\n\
6676 DISPLAY should be either a frame or a display name (a string).\n\
6677 If DISPLAY is omitted or nil, that stands for the selected frame's display.")
6678 (on, display)
6679 Lisp_Object display, on;
6680 {
6681 struct w32_display_info *dpyinfo = check_x_display_info (display);
6682
6683 return Qnil;
6684 }
6685
6686 \f
6687 /* These are the w32 specialized functions */
6688
6689 DEFUN ("w32-select-font", Fw32_select_font, Sw32_select_font, 0, 1, 0,
6690 "This will display the W32 font dialog and return an X font string corresponding to the selection.")
6691 (frame)
6692 Lisp_Object frame;
6693 {
6694 FRAME_PTR f = check_x_frame (frame);
6695 CHOOSEFONT cf;
6696 LOGFONT lf;
6697 char buf[100];
6698
6699 bzero (&cf, sizeof (cf));
6700
6701 cf.lStructSize = sizeof (cf);
6702 cf.hwndOwner = FRAME_W32_WINDOW (f);
6703 cf.Flags = CF_FIXEDPITCHONLY | CF_FORCEFONTEXIST | CF_SCREENFONTS;
6704 cf.lpLogFont = &lf;
6705
6706 if (!ChooseFont (&cf) || !w32_to_x_font (&lf, buf, 100))
6707 return Qnil;
6708
6709 return build_string (buf);
6710 }
6711
6712 DEFUN ("w32-send-sys-command", Fw32_send_sys_command, Sw32_send_sys_command, 1, 2, 0,
6713 "Send frame a Windows WM_SYSCOMMAND message of type COMMAND.\n\
6714 Some useful values for command are 0xf030 to maximise frame (0xf020\n\
6715 to minimize), 0xf120 to restore frame to original size, and 0xf100\n\
6716 to activate the menubar for keyboard access. 0xf140 activates the\n\
6717 screen saver if defined.\n\
6718 \n\
6719 If optional parameter FRAME is not specified, use selected frame.")
6720 (command, frame)
6721 Lisp_Object command, frame;
6722 {
6723 WPARAM code;
6724 FRAME_PTR f = check_x_frame (frame);
6725
6726 CHECK_NUMBER (command, 0);
6727
6728 SendMessage (FRAME_W32_WINDOW (f), WM_SYSCOMMAND, XINT (command), 0);
6729
6730 return Qnil;
6731 }
6732
6733 /* Lookup virtual keycode from string representing the name of a
6734 non-ascii keystroke into the corresponding virtual key, using
6735 lispy_function_keys. */
6736 static int
6737 lookup_vk_code (char *key)
6738 {
6739 int i;
6740
6741 for (i = 0; i < 256; i++)
6742 if (lispy_function_keys[i] != 0
6743 && strcmp (lispy_function_keys[i], key) == 0)
6744 return i;
6745
6746 return -1;
6747 }
6748
6749 /* Convert a one-element vector style key sequence to a hot key
6750 definition. */
6751 static int
6752 w32_parse_hot_key (key)
6753 Lisp_Object key;
6754 {
6755 /* Copied from Fdefine_key and store_in_keymap. */
6756 register Lisp_Object c;
6757 int vk_code;
6758 int lisp_modifiers;
6759 int w32_modifiers;
6760 struct gcpro gcpro1;
6761
6762 CHECK_VECTOR (key, 0);
6763
6764 if (XFASTINT (Flength (key)) != 1)
6765 return Qnil;
6766
6767 GCPRO1 (key);
6768
6769 c = Faref (key, make_number (0));
6770
6771 if (CONSP (c) && lucid_event_type_list_p (c))
6772 c = Fevent_convert_list (c);
6773
6774 UNGCPRO;
6775
6776 if (! INTEGERP (c) && ! SYMBOLP (c))
6777 error ("Key definition is invalid");
6778
6779 /* Work out the base key and the modifiers. */
6780 if (SYMBOLP (c))
6781 {
6782 c = parse_modifiers (c);
6783 lisp_modifiers = Fcar (Fcdr (c));
6784 c = Fcar (c);
6785 if (!SYMBOLP (c))
6786 abort ();
6787 vk_code = lookup_vk_code (XSYMBOL (c)->name->data);
6788 }
6789 else if (INTEGERP (c))
6790 {
6791 lisp_modifiers = XINT (c) & ~CHARACTERBITS;
6792 /* Many ascii characters are their own virtual key code. */
6793 vk_code = XINT (c) & CHARACTERBITS;
6794 }
6795
6796 if (vk_code < 0 || vk_code > 255)
6797 return Qnil;
6798
6799 if ((lisp_modifiers & meta_modifier) != 0
6800 && !NILP (Vw32_alt_is_meta))
6801 lisp_modifiers |= alt_modifier;
6802
6803 /* Convert lisp modifiers to Windows hot-key form. */
6804 w32_modifiers = (lisp_modifiers & hyper_modifier) ? MOD_WIN : 0;
6805 w32_modifiers |= (lisp_modifiers & alt_modifier) ? MOD_ALT : 0;
6806 w32_modifiers |= (lisp_modifiers & ctrl_modifier) ? MOD_CONTROL : 0;
6807 w32_modifiers |= (lisp_modifiers & shift_modifier) ? MOD_SHIFT : 0;
6808
6809 return HOTKEY (vk_code, w32_modifiers);
6810 }
6811
6812 DEFUN ("w32-register-hot-key", Fw32_register_hot_key, Sw32_register_hot_key, 1, 1, 0,
6813 "Register KEY as a hot-key combination.\n\
6814 Certain key combinations like Alt-Tab are reserved for system use on\n\
6815 Windows, and therefore are normally intercepted by the system. However,\n\
6816 most of these key combinations can be received by registering them as\n\
6817 hot-keys, overriding their special meaning.\n\
6818 \n\
6819 KEY must be a one element key definition in vector form that would be\n\
6820 acceptable to `define-key' (e.g. [A-tab] for Alt-Tab). The meta\n\
6821 modifier is interpreted as Alt if `w32-alt-is-meta' is t, and hyper\n\
6822 is always interpreted as the Windows modifier keys.\n\
6823 \n\
6824 The return value is the hotkey-id if registered, otherwise nil.")
6825 (key)
6826 Lisp_Object key;
6827 {
6828 key = w32_parse_hot_key (key);
6829
6830 if (NILP (Fmemq (key, w32_grabbed_keys)))
6831 {
6832 /* Reuse an empty slot if possible. */
6833 Lisp_Object item = Fmemq (Qnil, w32_grabbed_keys);
6834
6835 /* Safe to add new key to list, even if we have focus. */
6836 if (NILP (item))
6837 w32_grabbed_keys = Fcons (key, w32_grabbed_keys);
6838 else
6839 XCAR (item) = key;
6840
6841 /* Notify input thread about new hot-key definition, so that it
6842 takes effect without needing to switch focus. */
6843 PostThreadMessage (dwWindowsThreadId, WM_EMACS_REGISTER_HOT_KEY,
6844 (WPARAM) key, 0);
6845 }
6846
6847 return key;
6848 }
6849
6850 DEFUN ("w32-unregister-hot-key", Fw32_unregister_hot_key, Sw32_unregister_hot_key, 1, 1, 0,
6851 "Unregister HOTKEY as a hot-key combination.")
6852 (key)
6853 Lisp_Object key;
6854 {
6855 Lisp_Object item;
6856
6857 if (!INTEGERP (key))
6858 key = w32_parse_hot_key (key);
6859
6860 item = Fmemq (key, w32_grabbed_keys);
6861
6862 if (!NILP (item))
6863 {
6864 /* Notify input thread about hot-key definition being removed, so
6865 that it takes effect without needing focus switch. */
6866 if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_UNREGISTER_HOT_KEY,
6867 (WPARAM) XINT (XCAR (item)), (LPARAM) item))
6868 {
6869 MSG msg;
6870 GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
6871 }
6872 return Qt;
6873 }
6874 return Qnil;
6875 }
6876
6877 DEFUN ("w32-registered-hot-keys", Fw32_registered_hot_keys, Sw32_registered_hot_keys, 0, 0, 0,
6878 "Return list of registered hot-key IDs.")
6879 ()
6880 {
6881 return Fcopy_sequence (w32_grabbed_keys);
6882 }
6883
6884 DEFUN ("w32-reconstruct-hot-key", Fw32_reconstruct_hot_key, Sw32_reconstruct_hot_key, 1, 1, 0,
6885 "Convert hot-key ID to a lisp key combination.")
6886 (hotkeyid)
6887 Lisp_Object hotkeyid;
6888 {
6889 int vk_code, w32_modifiers;
6890 Lisp_Object key;
6891
6892 CHECK_NUMBER (hotkeyid, 0);
6893
6894 vk_code = HOTKEY_VK_CODE (hotkeyid);
6895 w32_modifiers = HOTKEY_MODIFIERS (hotkeyid);
6896
6897 if (lispy_function_keys[vk_code])
6898 key = intern (lispy_function_keys[vk_code]);
6899 else
6900 key = make_number (vk_code);
6901
6902 key = Fcons (key, Qnil);
6903 if (w32_modifiers & MOD_SHIFT)
6904 key = Fcons (Qshift, key);
6905 if (w32_modifiers & MOD_CONTROL)
6906 key = Fcons (Qctrl, key);
6907 if (w32_modifiers & MOD_ALT)
6908 key = Fcons (NILP (Vw32_alt_is_meta) ? Qalt : Qmeta, key);
6909 if (w32_modifiers & MOD_WIN)
6910 key = Fcons (Qhyper, key);
6911
6912 return key;
6913 }
6914
6915 DEFUN ("w32-toggle-lock-key", Fw32_toggle_lock_key, Sw32_toggle_lock_key, 1, 2, 0,
6916 "Toggle the state of the lock key KEY.\n\
6917 KEY can be `capslock', `kp-numlock', or `scroll'.\n\
6918 If the optional parameter NEW-STATE is a number, then the state of KEY\n\
6919 is set to off if the low bit of NEW-STATE is zero, otherwise on.")
6920 (key, new_state)
6921 Lisp_Object key, new_state;
6922 {
6923 int vk_code;
6924 int cur_state;
6925
6926 if (EQ (key, intern ("capslock")))
6927 vk_code = VK_CAPITAL;
6928 else if (EQ (key, intern ("kp-numlock")))
6929 vk_code = VK_NUMLOCK;
6930 else if (EQ (key, intern ("scroll")))
6931 vk_code = VK_SCROLL;
6932 else
6933 return Qnil;
6934
6935 if (!dwWindowsThreadId)
6936 return make_number (w32_console_toggle_lock_key (vk_code, new_state));
6937
6938 if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_TOGGLE_LOCK_KEY,
6939 (WPARAM) vk_code, (LPARAM) new_state))
6940 {
6941 MSG msg;
6942 GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
6943 return make_number (msg.wParam);
6944 }
6945 return Qnil;
6946 }
6947 \f
6948 syms_of_w32fns ()
6949 {
6950 /* This is zero if not using MS-Windows. */
6951 w32_in_use = 0;
6952
6953 /* The section below is built by the lisp expression at the top of the file,
6954 just above where these variables are declared. */
6955 /*&&& init symbols here &&&*/
6956 Qauto_raise = intern ("auto-raise");
6957 staticpro (&Qauto_raise);
6958 Qauto_lower = intern ("auto-lower");
6959 staticpro (&Qauto_lower);
6960 Qbackground_color = intern ("background-color");
6961 staticpro (&Qbackground_color);
6962 Qbar = intern ("bar");
6963 staticpro (&Qbar);
6964 Qborder_color = intern ("border-color");
6965 staticpro (&Qborder_color);
6966 Qborder_width = intern ("border-width");
6967 staticpro (&Qborder_width);
6968 Qbox = intern ("box");
6969 staticpro (&Qbox);
6970 Qcursor_color = intern ("cursor-color");
6971 staticpro (&Qcursor_color);
6972 Qcursor_type = intern ("cursor-type");
6973 staticpro (&Qcursor_type);
6974 Qforeground_color = intern ("foreground-color");
6975 staticpro (&Qforeground_color);
6976 Qgeometry = intern ("geometry");
6977 staticpro (&Qgeometry);
6978 Qicon_left = intern ("icon-left");
6979 staticpro (&Qicon_left);
6980 Qicon_top = intern ("icon-top");
6981 staticpro (&Qicon_top);
6982 Qicon_type = intern ("icon-type");
6983 staticpro (&Qicon_type);
6984 Qicon_name = intern ("icon-name");
6985 staticpro (&Qicon_name);
6986 Qinternal_border_width = intern ("internal-border-width");
6987 staticpro (&Qinternal_border_width);
6988 Qleft = intern ("left");
6989 staticpro (&Qleft);
6990 Qright = intern ("right");
6991 staticpro (&Qright);
6992 Qmouse_color = intern ("mouse-color");
6993 staticpro (&Qmouse_color);
6994 Qnone = intern ("none");
6995 staticpro (&Qnone);
6996 Qparent_id = intern ("parent-id");
6997 staticpro (&Qparent_id);
6998 Qscroll_bar_width = intern ("scroll-bar-width");
6999 staticpro (&Qscroll_bar_width);
7000 Qsuppress_icon = intern ("suppress-icon");
7001 staticpro (&Qsuppress_icon);
7002 Qtop = intern ("top");
7003 staticpro (&Qtop);
7004 Qundefined_color = intern ("undefined-color");
7005 staticpro (&Qundefined_color);
7006 Qvertical_scroll_bars = intern ("vertical-scroll-bars");
7007 staticpro (&Qvertical_scroll_bars);
7008 Qvisibility = intern ("visibility");
7009 staticpro (&Qvisibility);
7010 Qwindow_id = intern ("window-id");
7011 staticpro (&Qwindow_id);
7012 Qx_frame_parameter = intern ("x-frame-parameter");
7013 staticpro (&Qx_frame_parameter);
7014 Qx_resource_name = intern ("x-resource-name");
7015 staticpro (&Qx_resource_name);
7016 Quser_position = intern ("user-position");
7017 staticpro (&Quser_position);
7018 Quser_size = intern ("user-size");
7019 staticpro (&Quser_size);
7020 Qdisplay = intern ("display");
7021 staticpro (&Qdisplay);
7022 /* This is the end of symbol initialization. */
7023
7024 Qhyper = intern ("hyper");
7025 staticpro (&Qhyper);
7026 Qsuper = intern ("super");
7027 staticpro (&Qsuper);
7028 Qmeta = intern ("meta");
7029 staticpro (&Qmeta);
7030 Qalt = intern ("alt");
7031 staticpro (&Qalt);
7032 Qctrl = intern ("ctrl");
7033 staticpro (&Qctrl);
7034 Qcontrol = intern ("control");
7035 staticpro (&Qcontrol);
7036 Qshift = intern ("shift");
7037 staticpro (&Qshift);
7038
7039 Qface_set_after_frame_default = intern ("face-set-after-frame-default");
7040 staticpro (&Qface_set_after_frame_default);
7041
7042 Fput (Qundefined_color, Qerror_conditions,
7043 Fcons (Qundefined_color, Fcons (Qerror, Qnil)));
7044 Fput (Qundefined_color, Qerror_message,
7045 build_string ("Undefined color"));
7046
7047 staticpro (&w32_grabbed_keys);
7048 w32_grabbed_keys = Qnil;
7049
7050 DEFVAR_LISP ("w32-color-map", &Vw32_color_map,
7051 "An array of color name mappings for windows.");
7052 Vw32_color_map = Qnil;
7053
7054 DEFVAR_LISP ("w32-pass-alt-to-system", &Vw32_pass_alt_to_system,
7055 "Non-nil if alt key presses are passed on to Windows.\n\
7056 When non-nil, for example, alt pressed and released and then space will\n\
7057 open the System menu. When nil, Emacs silently swallows alt key events.");
7058 Vw32_pass_alt_to_system = Qnil;
7059
7060 DEFVAR_LISP ("w32-alt-is-meta", &Vw32_alt_is_meta,
7061 "Non-nil if the alt key is to be considered the same as the meta key.\n\
7062 When nil, Emacs will translate the alt key to the Alt modifier, and not Meta.");
7063 Vw32_alt_is_meta = Qt;
7064
7065 DEFVAR_LISP ("w32-pass-lwindow-to-system",
7066 &Vw32_pass_lwindow_to_system,
7067 "Non-nil if the left \"Windows\" key is passed on to Windows.\n\
7068 When non-nil, the Start menu is opened by tapping the key.");
7069 Vw32_pass_lwindow_to_system = Qt;
7070
7071 DEFVAR_LISP ("w32-pass-rwindow-to-system",
7072 &Vw32_pass_rwindow_to_system,
7073 "Non-nil if the right \"Windows\" key is passed on to Windows.\n\
7074 When non-nil, the Start menu is opened by tapping the key.");
7075 Vw32_pass_rwindow_to_system = Qt;
7076
7077 DEFVAR_INT ("w32-phantom-key-code",
7078 &Vw32_phantom_key_code,
7079 "Virtual key code used to generate \"phantom\" key presses.\n\
7080 Value is a number between 0 and 255.\n\
7081 \n\
7082 Phantom key presses are generated in order to stop the system from\n\
7083 acting on \"Windows\" key events when `w32-pass-lwindow-to-system' or\n\
7084 `w32-pass-rwindow-to-system' is nil.");
7085 Vw32_phantom_key_code = VK_SPACE;
7086
7087 DEFVAR_LISP ("w32-enable-num-lock",
7088 &Vw32_enable_num_lock,
7089 "Non-nil if Num Lock should act normally.\n\
7090 Set to nil to see Num Lock as the key `kp-numlock'.");
7091 Vw32_enable_num_lock = Qt;
7092
7093 DEFVAR_LISP ("w32-enable-caps-lock",
7094 &Vw32_enable_caps_lock,
7095 "Non-nil if Caps Lock should act normally.\n\
7096 Set to nil to see Caps Lock as the key `capslock'.");
7097 Vw32_enable_caps_lock = Qt;
7098
7099 DEFVAR_LISP ("w32-scroll-lock-modifier",
7100 &Vw32_scroll_lock_modifier,
7101 "Modifier to use for the Scroll Lock on state.\n\
7102 The value can be hyper, super, meta, alt, control or shift for the\n\
7103 respective modifier, or nil to see Scroll Lock as the key `scroll'.\n\
7104 Any other value will cause the key to be ignored.");
7105 Vw32_scroll_lock_modifier = Qt;
7106
7107 DEFVAR_LISP ("w32-lwindow-modifier",
7108 &Vw32_lwindow_modifier,
7109 "Modifier to use for the left \"Windows\" key.\n\
7110 The value can be hyper, super, meta, alt, control or shift for the\n\
7111 respective modifier, or nil to appear as the key `lwindow'.\n\
7112 Any other value will cause the key to be ignored.");
7113 Vw32_lwindow_modifier = Qnil;
7114
7115 DEFVAR_LISP ("w32-rwindow-modifier",
7116 &Vw32_rwindow_modifier,
7117 "Modifier to use for the right \"Windows\" key.\n\
7118 The value can be hyper, super, meta, alt, control or shift for the\n\
7119 respective modifier, or nil to appear as the key `rwindow'.\n\
7120 Any other value will cause the key to be ignored.");
7121 Vw32_rwindow_modifier = Qnil;
7122
7123 DEFVAR_LISP ("w32-apps-modifier",
7124 &Vw32_apps_modifier,
7125 "Modifier to use for the \"Apps\" key.\n\
7126 The value can be hyper, super, meta, alt, control or shift for the\n\
7127 respective modifier, or nil to appear as the key `apps'.\n\
7128 Any other value will cause the key to be ignored.");
7129 Vw32_apps_modifier = Qnil;
7130
7131 DEFVAR_LISP ("w32-enable-italics", &Vw32_enable_italics,
7132 "Non-nil enables selection of artificially italicized fonts.");
7133 Vw32_enable_italics = Qnil;
7134
7135 DEFVAR_LISP ("w32-enable-palette", &Vw32_enable_palette,
7136 "Non-nil enables Windows palette management to map colors exactly.");
7137 Vw32_enable_palette = Qt;
7138
7139 DEFVAR_INT ("w32-mouse-button-tolerance",
7140 &Vw32_mouse_button_tolerance,
7141 "Analogue of double click interval for faking middle mouse events.\n\
7142 The value is the minimum time in milliseconds that must elapse between\n\
7143 left/right button down events before they are considered distinct events.\n\
7144 If both mouse buttons are depressed within this interval, a middle mouse\n\
7145 button down event is generated instead.");
7146 XSETINT (Vw32_mouse_button_tolerance, GetDoubleClickTime () / 2);
7147
7148 DEFVAR_INT ("w32-mouse-move-interval",
7149 &Vw32_mouse_move_interval,
7150 "Minimum interval between mouse move events.\n\
7151 The value is the minimum time in milliseconds that must elapse between\n\
7152 successive mouse move (or scroll bar drag) events before they are\n\
7153 reported as lisp events.");
7154 XSETINT (Vw32_mouse_move_interval, 50);
7155
7156 init_x_parm_symbols ();
7157
7158 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path,
7159 "List of directories to search for bitmap files for w32.");
7160 Vx_bitmap_file_path = decode_env_path ((char *) 0, "PATH");
7161
7162 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape,
7163 "The shape of the pointer when over text.\n\
7164 Changing the value does not affect existing frames\n\
7165 unless you set the mouse color.");
7166 Vx_pointer_shape = Qnil;
7167
7168 DEFVAR_LISP ("x-resource-name", &Vx_resource_name,
7169 "The name Emacs uses to look up resources; for internal use only.\n\
7170 `x-get-resource' uses this as the first component of the instance name\n\
7171 when requesting resource values.\n\
7172 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
7173 was invoked, or to the value specified with the `-name' or `-rn'\n\
7174 switches, if present.");
7175 Vx_resource_name = Qnil;
7176
7177 Vx_nontext_pointer_shape = Qnil;
7178
7179 Vx_mode_pointer_shape = Qnil;
7180
7181 DEFVAR_INT ("x-sensitive-text-pointer-shape",
7182 &Vx_sensitive_text_pointer_shape,
7183 "The shape of the pointer when over mouse-sensitive text.\n\
7184 This variable takes effect when you create a new frame\n\
7185 or when you set the mouse color.");
7186 Vx_sensitive_text_pointer_shape = Qnil;
7187
7188 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel,
7189 "A string indicating the foreground color of the cursor box.");
7190 Vx_cursor_fore_pixel = Qnil;
7191
7192 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager,
7193 "Non-nil if no window manager is in use.\n\
7194 Emacs doesn't try to figure this out; this is always nil\n\
7195 unless you set it to something else.");
7196 /* We don't have any way to find this out, so set it to nil
7197 and maybe the user would like to set it to t. */
7198 Vx_no_window_manager = Qnil;
7199
7200 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
7201 &Vx_pixel_size_width_font_regexp,
7202 "Regexp matching a font name whose width is the same as `PIXEL_SIZE'.\n\
7203 \n\
7204 Since Emacs gets width of a font matching with this regexp from\n\
7205 PIXEL_SIZE field of the name, font finding mechanism gets faster for\n\
7206 such a font. This is especially effective for such large fonts as\n\
7207 Chinese, Japanese, and Korean.");
7208 Vx_pixel_size_width_font_regexp = Qnil;
7209
7210 DEFVAR_BOOL ("unibyte-display-via-language-environment",
7211 &unibyte_display_via_language_environment,
7212 "*Non-nil means display unibyte text according to language environment.\n\
7213 Specifically this means that unibyte non-ASCII characters\n\
7214 are displayed by converting them to the equivalent multibyte characters\n\
7215 according to the current language environment. As a result, they are\n\
7216 displayed according to the current fontset.");
7217 unibyte_display_via_language_environment = 0;
7218
7219 DEFVAR_LISP ("w32-bdf-filename-alist",
7220 &Vw32_bdf_filename_alist,
7221 "List of bdf fonts and their corresponding filenames.");
7222 Vw32_bdf_filename_alist = Qnil;
7223
7224 defsubr (&Sx_get_resource);
7225 defsubr (&Sx_list_fonts);
7226 defsubr (&Sx_display_color_p);
7227 defsubr (&Sx_display_grayscale_p);
7228 defsubr (&Sx_color_defined_p);
7229 defsubr (&Sx_color_values);
7230 defsubr (&Sx_server_max_request_size);
7231 defsubr (&Sx_server_vendor);
7232 defsubr (&Sx_server_version);
7233 defsubr (&Sx_display_pixel_width);
7234 defsubr (&Sx_display_pixel_height);
7235 defsubr (&Sx_display_mm_width);
7236 defsubr (&Sx_display_mm_height);
7237 defsubr (&Sx_display_screens);
7238 defsubr (&Sx_display_planes);
7239 defsubr (&Sx_display_color_cells);
7240 defsubr (&Sx_display_visual_class);
7241 defsubr (&Sx_display_backing_store);
7242 defsubr (&Sx_display_save_under);
7243 defsubr (&Sx_parse_geometry);
7244 defsubr (&Sx_create_frame);
7245 defsubr (&Sx_open_connection);
7246 defsubr (&Sx_close_connection);
7247 defsubr (&Sx_display_list);
7248 defsubr (&Sx_synchronize);
7249
7250 /* W32 specific functions */
7251
7252 defsubr (&Sw32_focus_frame);
7253 defsubr (&Sw32_select_font);
7254 defsubr (&Sw32_define_rgb_color);
7255 defsubr (&Sw32_default_color_map);
7256 defsubr (&Sw32_load_color_file);
7257 defsubr (&Sw32_send_sys_command);
7258 defsubr (&Sw32_register_hot_key);
7259 defsubr (&Sw32_unregister_hot_key);
7260 defsubr (&Sw32_registered_hot_keys);
7261 defsubr (&Sw32_reconstruct_hot_key);
7262 defsubr (&Sw32_toggle_lock_key);
7263 defsubr (&Sw32_find_bdf_fonts);
7264
7265 /* Setting callback functions for fontset handler. */
7266 get_font_info_func = w32_get_font_info;
7267 list_fonts_func = w32_list_fonts;
7268 load_font_func = w32_load_font;
7269 find_ccl_program_func = w32_find_ccl_program;
7270 query_font_func = w32_query_font;
7271 set_frame_fontset_func = x_set_font;
7272 check_window_system_func = check_w32;
7273 }
7274
7275 #undef abort
7276
7277 void
7278 w32_abort()
7279 {
7280 int button;
7281 button = MessageBox (NULL,
7282 "A fatal error has occurred!\n\n"
7283 "Select Abort to exit, Retry to debug, Ignore to continue",
7284 "Emacs Abort Dialog",
7285 MB_ICONEXCLAMATION | MB_TASKMODAL
7286 | MB_SETFOREGROUND | MB_ABORTRETRYIGNORE);
7287 switch (button)
7288 {
7289 case IDRETRY:
7290 DebugBreak ();
7291 break;
7292 case IDIGNORE:
7293 break;
7294 case IDABORT:
7295 default:
7296 abort ();
7297 break;
7298 }
7299 }
7300
7301 /* For convenience when debugging. */
7302 int
7303 w32_last_error()
7304 {
7305 return GetLastError ();
7306 }
Unnamed repository; edit this file 'description' to name the repository.