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