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