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