HCoop / bpt / emacs.git / blob
? search:
summary | shortlog | log | commit | commitdiff | tree
blame | history | raw | HEAD
Merge from emacs--rel--22
[bpt/emacs.git] / src / w32fns.c
1 /* Graphical user interface functions for the Microsoft W32 API.
2 Copyright (C) 1989, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
3 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
4
5 This file is part of GNU Emacs.
6
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 3, or (at your option)
10 any later version.
11
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
16
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
20 Boston, MA 02110-1301, USA. */
21
22 /* Added by Kevin Gallo */
23
24 #include <config.h>
25
26 #include <signal.h>
27 #include <stdio.h>
28 #include <limits.h>
29 #include <errno.h>
30 #include <math.h>
31
32 #include "lisp.h"
33 #include "charset.h"
34 #include "dispextern.h"
35 #include "w32term.h"
36 #include "keyboard.h"
37 #include "frame.h"
38 #include "window.h"
39 #include "buffer.h"
40 #include "fontset.h"
41 #include "intervals.h"
42 #include "blockinput.h"
43 #include "epaths.h"
44 #include "w32heap.h"
45 #include "termhooks.h"
46 #include "coding.h"
47 #include "ccl.h"
48 #include "systime.h"
49
50 #include "bitmaps/gray.xbm"
51
52 #include <commctrl.h>
53 #include <commdlg.h>
54 #include <shellapi.h>
55 #include <ctype.h>
56 #include <winspool.h>
57 #include <objbase.h>
58
59 #include <dlgs.h>
60 #define FILE_NAME_TEXT_FIELD edt1
61
62 void syms_of_w32fns ();
63 void globals_of_w32fns ();
64
65 extern void free_frame_menubar ();
66 extern double atof ();
67 extern int w32_console_toggle_lock_key P_ ((int, Lisp_Object));
68 extern void w32_menu_display_help P_ ((HWND, HMENU, UINT, UINT));
69 extern void w32_free_menu_strings P_ ((HWND));
70 extern XCharStruct *w32_per_char_metric P_ ((XFontStruct *, wchar_t *, int));
71
72 extern int quit_char;
73
74 extern char *lispy_function_keys[];
75
76 /* The colormap for converting color names to RGB values */
77 Lisp_Object Vw32_color_map;
78
79 /* Non nil if alt key presses are passed on to Windows. */
80 Lisp_Object Vw32_pass_alt_to_system;
81
82 /* Non nil if alt key is translated to meta_modifier, nil if it is translated
83 to alt_modifier. */
84 Lisp_Object Vw32_alt_is_meta;
85
86 /* If non-zero, the windows virtual key code for an alternative quit key. */
87 int w32_quit_key;
88
89 /* Non nil if left window key events are passed on to Windows (this only
90 affects whether "tapping" the key opens the Start menu). */
91 Lisp_Object Vw32_pass_lwindow_to_system;
92
93 /* Non nil if right window key events are passed on to Windows (this
94 only affects whether "tapping" the key opens the Start menu). */
95 Lisp_Object Vw32_pass_rwindow_to_system;
96
97 /* Virtual key code used to generate "phantom" key presses in order
98 to stop system from acting on Windows key events. */
99 Lisp_Object Vw32_phantom_key_code;
100
101 /* Modifier associated with the left "Windows" key, or nil to act as a
102 normal key. */
103 Lisp_Object Vw32_lwindow_modifier;
104
105 /* Modifier associated with the right "Windows" key, or nil to act as a
106 normal key. */
107 Lisp_Object Vw32_rwindow_modifier;
108
109 /* Modifier associated with the "Apps" key, or nil to act as a normal
110 key. */
111 Lisp_Object Vw32_apps_modifier;
112
113 /* Value is nil if Num Lock acts as a function key. */
114 Lisp_Object Vw32_enable_num_lock;
115
116 /* Value is nil if Caps Lock acts as a function key. */
117 Lisp_Object Vw32_enable_caps_lock;
118
119 /* Modifier associated with Scroll Lock, or nil to act as a normal key. */
120 Lisp_Object Vw32_scroll_lock_modifier;
121
122 /* Switch to control whether we inhibit requests for synthesized bold
123 and italic versions of fonts. */
124 int w32_enable_synthesized_fonts;
125
126 /* Enable palette management. */
127 Lisp_Object Vw32_enable_palette;
128
129 /* Control how close left/right button down events must be to
130 be converted to a middle button down event. */
131 int w32_mouse_button_tolerance;
132
133 /* Minimum interval between mouse movement (and scroll bar drag)
134 events that are passed on to the event loop. */
135 int w32_mouse_move_interval;
136
137 /* Flag to indicate if XBUTTON events should be passed on to Windows. */
138 static int w32_pass_extra_mouse_buttons_to_system;
139
140 /* Flag to indicate if media keys should be passed on to Windows. */
141 static int w32_pass_multimedia_buttons_to_system;
142
143 /* Non nil if no window manager is in use. */
144 Lisp_Object Vx_no_window_manager;
145
146 /* Non-zero means we're allowed to display a hourglass pointer. */
147
148 int display_hourglass_p;
149
150 /* The background and shape of the mouse pointer, and shape when not
151 over text or in the modeline. */
152
153 Lisp_Object Vx_pointer_shape, Vx_nontext_pointer_shape, Vx_mode_pointer_shape;
154 Lisp_Object Vx_hourglass_pointer_shape, Vx_window_horizontal_drag_shape;
155
156 /* The shape when over mouse-sensitive text. */
157
158 Lisp_Object Vx_sensitive_text_pointer_shape;
159
160 #ifndef IDC_HAND
161 #define IDC_HAND MAKEINTRESOURCE(32649)
162 #endif
163
164 /* Color of chars displayed in cursor box. */
165
166 Lisp_Object Vx_cursor_fore_pixel;
167
168 /* Nonzero if using Windows. */
169
170 static int w32_in_use;
171
172 /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
173
174 Lisp_Object Vx_pixel_size_width_font_regexp;
175
176 /* Alist of bdf fonts and the files that define them. */
177 Lisp_Object Vw32_bdf_filename_alist;
178
179 /* A flag to control whether fonts are matched strictly or not. */
180 static int w32_strict_fontnames;
181
182 /* A flag to control whether we should only repaint if GetUpdateRect
183 indicates there is an update region. */
184 static int w32_strict_painting;
185
186 /* Associative list linking character set strings to Windows codepages. */
187 static Lisp_Object Vw32_charset_info_alist;
188
189 /* VIETNAMESE_CHARSET is not defined in some versions of MSVC. */
190 #ifndef VIETNAMESE_CHARSET
191 #define VIETNAMESE_CHARSET 163
192 #endif
193
194 Lisp_Object Qnone;
195 Lisp_Object Qsuppress_icon;
196 Lisp_Object Qundefined_color;
197 Lisp_Object Qcancel_timer;
198 Lisp_Object Qhyper;
199 Lisp_Object Qsuper;
200 Lisp_Object Qmeta;
201 Lisp_Object Qalt;
202 Lisp_Object Qctrl;
203 Lisp_Object Qcontrol;
204 Lisp_Object Qshift;
205
206 Lisp_Object Qw32_charset_ansi;
207 Lisp_Object Qw32_charset_default;
208 Lisp_Object Qw32_charset_symbol;
209 Lisp_Object Qw32_charset_shiftjis;
210 Lisp_Object Qw32_charset_hangeul;
211 Lisp_Object Qw32_charset_gb2312;
212 Lisp_Object Qw32_charset_chinesebig5;
213 Lisp_Object Qw32_charset_oem;
214
215 #ifndef JOHAB_CHARSET
216 #define JOHAB_CHARSET 130
217 #endif
218 #ifdef JOHAB_CHARSET
219 Lisp_Object Qw32_charset_easteurope;
220 Lisp_Object Qw32_charset_turkish;
221 Lisp_Object Qw32_charset_baltic;
222 Lisp_Object Qw32_charset_russian;
223 Lisp_Object Qw32_charset_arabic;
224 Lisp_Object Qw32_charset_greek;
225 Lisp_Object Qw32_charset_hebrew;
226 Lisp_Object Qw32_charset_vietnamese;
227 Lisp_Object Qw32_charset_thai;
228 Lisp_Object Qw32_charset_johab;
229 Lisp_Object Qw32_charset_mac;
230 #endif
231
232 #ifdef UNICODE_CHARSET
233 Lisp_Object Qw32_charset_unicode;
234 #endif
235
236 /* The ANSI codepage. */
237 int w32_ansi_code_page;
238
239 /* Prefix for system colors. */
240 #define SYSTEM_COLOR_PREFIX "System"
241 #define SYSTEM_COLOR_PREFIX_LEN (sizeof (SYSTEM_COLOR_PREFIX) - 1)
242
243 /* State variables for emulating a three button mouse. */
244 #define LMOUSE 1
245 #define MMOUSE 2
246 #define RMOUSE 4
247
248 static int button_state = 0;
249 static W32Msg saved_mouse_button_msg;
250 static unsigned mouse_button_timer = 0; /* non-zero when timer is active */
251 static W32Msg saved_mouse_move_msg;
252 static unsigned mouse_move_timer = 0;
253
254 /* Window that is tracking the mouse. */
255 static HWND track_mouse_window;
256
257 typedef BOOL (WINAPI * TrackMouseEvent_Proc)
258 (IN OUT LPTRACKMOUSEEVENT lpEventTrack);
259
260 TrackMouseEvent_Proc track_mouse_event_fn = NULL;
261 ClipboardSequence_Proc clipboard_sequence_fn = NULL;
262 extern AppendMenuW_Proc unicode_append_menu;
263
264 /* W95 mousewheel handler */
265 unsigned int msh_mousewheel = 0;
266
267 /* Timers */
268 #define MOUSE_BUTTON_ID 1
269 #define MOUSE_MOVE_ID 2
270 #define MENU_FREE_ID 3
271 /* The delay (milliseconds) before a menu is freed after WM_EXITMENULOOP
272 is received. */
273 #define MENU_FREE_DELAY 1000
274 static unsigned menu_free_timer = 0;
275
276 /* The below are defined in frame.c. */
277
278 extern Lisp_Object Vwindow_system_version;
279
280 #ifdef GLYPH_DEBUG
281 int image_cache_refcount, dpyinfo_refcount;
282 #endif
283
284
285 /* From w32term.c. */
286 extern int w32_num_mouse_buttons;
287 extern Lisp_Object Vw32_recognize_altgr;
288
289 extern HWND w32_system_caret_hwnd;
290
291 extern int w32_system_caret_height;
292 extern int w32_system_caret_x;
293 extern int w32_system_caret_y;
294 extern int w32_use_visible_system_caret;
295
296 static HWND w32_visible_system_caret_hwnd;
297
298 /* From w32menu.c */
299 extern HMENU current_popup_menu;
300 static int menubar_in_use = 0;
301
302 \f
303 /* Error if we are not connected to MS-Windows. */
304 void
305 check_w32 ()
306 {
307 if (! w32_in_use)
308 error ("MS-Windows not in use or not initialized");
309 }
310
311 /* Nonzero if we can use mouse menus.
312 You should not call this unless HAVE_MENUS is defined. */
313
314 int
315 have_menus_p ()
316 {
317 return w32_in_use;
318 }
319
320 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
321 and checking validity for W32. */
322
323 FRAME_PTR
324 check_x_frame (frame)
325 Lisp_Object frame;
326 {
327 FRAME_PTR f;
328
329 if (NILP (frame))
330 frame = selected_frame;
331 CHECK_LIVE_FRAME (frame);
332 f = XFRAME (frame);
333 if (! FRAME_W32_P (f))
334 error ("Non-W32 frame used");
335 return f;
336 }
337
338 /* Let the user specify a display with a frame.
339 nil stands for the selected frame--or, if that is not a w32 frame,
340 the first display on the list. */
341
342 struct w32_display_info *
343 check_x_display_info (frame)
344 Lisp_Object frame;
345 {
346 if (NILP (frame))
347 {
348 struct frame *sf = XFRAME (selected_frame);
349
350 if (FRAME_W32_P (sf) && FRAME_LIVE_P (sf))
351 return FRAME_W32_DISPLAY_INFO (sf);
352 else
353 return &one_w32_display_info;
354 }
355 else if (STRINGP (frame))
356 return x_display_info_for_name (frame);
357 else
358 {
359 FRAME_PTR f;
360
361 CHECK_LIVE_FRAME (frame);
362 f = XFRAME (frame);
363 if (! FRAME_W32_P (f))
364 error ("Non-W32 frame used");
365 return FRAME_W32_DISPLAY_INFO (f);
366 }
367 }
368 \f
369 /* Return the Emacs frame-object corresponding to an w32 window.
370 It could be the frame's main window or an icon window. */
371
372 /* This function can be called during GC, so use GC_xxx type test macros. */
373
374 struct frame *
375 x_window_to_frame (dpyinfo, wdesc)
376 struct w32_display_info *dpyinfo;
377 HWND wdesc;
378 {
379 Lisp_Object tail, frame;
380 struct frame *f;
381
382 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
383 {
384 frame = XCAR (tail);
385 if (!GC_FRAMEP (frame))
386 continue;
387 f = XFRAME (frame);
388 if (!FRAME_W32_P (f) || FRAME_W32_DISPLAY_INFO (f) != dpyinfo)
389 continue;
390 if (f->output_data.w32->hourglass_window == wdesc)
391 return f;
392
393 if (FRAME_W32_WINDOW (f) == wdesc)
394 return f;
395 }
396 return 0;
397 }
398
399 \f
400 static Lisp_Object unwind_create_frame P_ ((Lisp_Object));
401 static Lisp_Object unwind_create_tip_frame P_ ((Lisp_Object));
402 static void my_create_window P_ ((struct frame *));
403 static void my_create_tip_window P_ ((struct frame *));
404
405 /* TODO: Native Input Method support; see x_create_im. */
406 void x_set_foreground_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
407 void x_set_background_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
408 void x_set_mouse_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
409 void x_set_cursor_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
410 void x_set_border_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
411 void x_set_cursor_type P_ ((struct frame *, Lisp_Object, Lisp_Object));
412 void x_set_icon_type P_ ((struct frame *, Lisp_Object, Lisp_Object));
413 void x_set_icon_name P_ ((struct frame *, Lisp_Object, Lisp_Object));
414 void x_explicitly_set_name P_ ((struct frame *, Lisp_Object, Lisp_Object));
415 void x_set_menu_bar_lines P_ ((struct frame *, Lisp_Object, Lisp_Object));
416 void x_set_title P_ ((struct frame *, Lisp_Object, Lisp_Object));
417 void x_set_tool_bar_lines P_ ((struct frame *, Lisp_Object, Lisp_Object));
418 static void x_edge_detection P_ ((struct frame *, struct image *, Lisp_Object,
419 Lisp_Object));
420
421
422 \f
423
424 /* Store the screen positions of frame F into XPTR and YPTR.
425 These are the positions of the containing window manager window,
426 not Emacs's own window. */
427
428 void
429 x_real_positions (f, xptr, yptr)
430 FRAME_PTR f;
431 int *xptr, *yptr;
432 {
433 POINT pt;
434 RECT rect;
435
436 /* Get the bounds of the WM window. */
437 GetWindowRect (FRAME_W32_WINDOW (f), &rect);
438
439 pt.x = 0;
440 pt.y = 0;
441
442 /* Convert (0, 0) in the client area to screen co-ordinates. */
443 ClientToScreen (FRAME_W32_WINDOW (f), &pt);
444
445 /* Remember x_pixels_diff and y_pixels_diff. */
446 f->x_pixels_diff = pt.x - rect.left;
447 f->y_pixels_diff = pt.y - rect.top;
448
449 *xptr = rect.left;
450 *yptr = rect.top;
451 }
452
453 \f
454
455 DEFUN ("w32-define-rgb-color", Fw32_define_rgb_color,
456 Sw32_define_rgb_color, 4, 4, 0,
457 doc: /* Convert RGB numbers to a windows color reference and associate with NAME.
458 This adds or updates a named color to `w32-color-map', making it
459 available for use. The original entry's RGB ref is returned, or nil
460 if the entry is new. */)
461 (red, green, blue, name)
462 Lisp_Object red, green, blue, name;
463 {
464 Lisp_Object rgb;
465 Lisp_Object oldrgb = Qnil;
466 Lisp_Object entry;
467
468 CHECK_NUMBER (red);
469 CHECK_NUMBER (green);
470 CHECK_NUMBER (blue);
471 CHECK_STRING (name);
472
473 XSETINT (rgb, RGB (XUINT (red), XUINT (green), XUINT (blue)));
474
475 BLOCK_INPUT;
476
477 /* replace existing entry in w32-color-map or add new entry. */
478 entry = Fassoc (name, Vw32_color_map);
479 if (NILP (entry))
480 {
481 entry = Fcons (name, rgb);
482 Vw32_color_map = Fcons (entry, Vw32_color_map);
483 }
484 else
485 {
486 oldrgb = Fcdr (entry);
487 Fsetcdr (entry, rgb);
488 }
489
490 UNBLOCK_INPUT;
491
492 return (oldrgb);
493 }
494
495 DEFUN ("w32-load-color-file", Fw32_load_color_file,
496 Sw32_load_color_file, 1, 1, 0,
497 doc: /* Create an alist of color entries from an external file.
498 Assign this value to `w32-color-map' to replace the existing color map.
499
500 The file should define one named RGB color per line like so:
501 R G B name
502 where R,G,B are numbers between 0 and 255 and name is an arbitrary string. */)
503 (filename)
504 Lisp_Object filename;
505 {
506 FILE *fp;
507 Lisp_Object cmap = Qnil;
508 Lisp_Object abspath;
509
510 CHECK_STRING (filename);
511 abspath = Fexpand_file_name (filename, Qnil);
512
513 fp = fopen (SDATA (filename), "rt");
514 if (fp)
515 {
516 char buf[512];
517 int red, green, blue;
518 int num;
519
520 BLOCK_INPUT;
521
522 while (fgets (buf, sizeof (buf), fp) != NULL) {
523 if (sscanf (buf, "%u %u %u %n", &red, &green, &blue, &num) == 3)
524 {
525 char *name = buf + num;
526 num = strlen (name) - 1;
527 if (name[num] == '\n')
528 name[num] = 0;
529 cmap = Fcons (Fcons (build_string (name),
530 make_number (RGB (red, green, blue))),
531 cmap);
532 }
533 }
534 fclose (fp);
535
536 UNBLOCK_INPUT;
537 }
538
539 return cmap;
540 }
541
542 /* The default colors for the w32 color map */
543 typedef struct colormap_t
544 {
545 char *name;
546 COLORREF colorref;
547 } colormap_t;
548
549 colormap_t w32_color_map[] =
550 {
551 {"snow" , PALETTERGB (255,250,250)},
552 {"ghost white" , PALETTERGB (248,248,255)},
553 {"GhostWhite" , PALETTERGB (248,248,255)},
554 {"white smoke" , PALETTERGB (245,245,245)},
555 {"WhiteSmoke" , PALETTERGB (245,245,245)},
556 {"gainsboro" , PALETTERGB (220,220,220)},
557 {"floral white" , PALETTERGB (255,250,240)},
558 {"FloralWhite" , PALETTERGB (255,250,240)},
559 {"old lace" , PALETTERGB (253,245,230)},
560 {"OldLace" , PALETTERGB (253,245,230)},
561 {"linen" , PALETTERGB (250,240,230)},
562 {"antique white" , PALETTERGB (250,235,215)},
563 {"AntiqueWhite" , PALETTERGB (250,235,215)},
564 {"papaya whip" , PALETTERGB (255,239,213)},
565 {"PapayaWhip" , PALETTERGB (255,239,213)},
566 {"blanched almond" , PALETTERGB (255,235,205)},
567 {"BlanchedAlmond" , PALETTERGB (255,235,205)},
568 {"bisque" , PALETTERGB (255,228,196)},
569 {"peach puff" , PALETTERGB (255,218,185)},
570 {"PeachPuff" , PALETTERGB (255,218,185)},
571 {"navajo white" , PALETTERGB (255,222,173)},
572 {"NavajoWhite" , PALETTERGB (255,222,173)},
573 {"moccasin" , PALETTERGB (255,228,181)},
574 {"cornsilk" , PALETTERGB (255,248,220)},
575 {"ivory" , PALETTERGB (255,255,240)},
576 {"lemon chiffon" , PALETTERGB (255,250,205)},
577 {"LemonChiffon" , PALETTERGB (255,250,205)},
578 {"seashell" , PALETTERGB (255,245,238)},
579 {"honeydew" , PALETTERGB (240,255,240)},
580 {"mint cream" , PALETTERGB (245,255,250)},
581 {"MintCream" , PALETTERGB (245,255,250)},
582 {"azure" , PALETTERGB (240,255,255)},
583 {"alice blue" , PALETTERGB (240,248,255)},
584 {"AliceBlue" , PALETTERGB (240,248,255)},
585 {"lavender" , PALETTERGB (230,230,250)},
586 {"lavender blush" , PALETTERGB (255,240,245)},
587 {"LavenderBlush" , PALETTERGB (255,240,245)},
588 {"misty rose" , PALETTERGB (255,228,225)},
589 {"MistyRose" , PALETTERGB (255,228,225)},
590 {"white" , PALETTERGB (255,255,255)},
591 {"black" , PALETTERGB ( 0, 0, 0)},
592 {"dark slate gray" , PALETTERGB ( 47, 79, 79)},
593 {"DarkSlateGray" , PALETTERGB ( 47, 79, 79)},
594 {"dark slate grey" , PALETTERGB ( 47, 79, 79)},
595 {"DarkSlateGrey" , PALETTERGB ( 47, 79, 79)},
596 {"dim gray" , PALETTERGB (105,105,105)},
597 {"DimGray" , PALETTERGB (105,105,105)},
598 {"dim grey" , PALETTERGB (105,105,105)},
599 {"DimGrey" , PALETTERGB (105,105,105)},
600 {"slate gray" , PALETTERGB (112,128,144)},
601 {"SlateGray" , PALETTERGB (112,128,144)},
602 {"slate grey" , PALETTERGB (112,128,144)},
603 {"SlateGrey" , PALETTERGB (112,128,144)},
604 {"light slate gray" , PALETTERGB (119,136,153)},
605 {"LightSlateGray" , PALETTERGB (119,136,153)},
606 {"light slate grey" , PALETTERGB (119,136,153)},
607 {"LightSlateGrey" , PALETTERGB (119,136,153)},
608 {"gray" , PALETTERGB (190,190,190)},
609 {"grey" , PALETTERGB (190,190,190)},
610 {"light grey" , PALETTERGB (211,211,211)},
611 {"LightGrey" , PALETTERGB (211,211,211)},
612 {"light gray" , PALETTERGB (211,211,211)},
613 {"LightGray" , PALETTERGB (211,211,211)},
614 {"midnight blue" , PALETTERGB ( 25, 25,112)},
615 {"MidnightBlue" , PALETTERGB ( 25, 25,112)},
616 {"navy" , PALETTERGB ( 0, 0,128)},
617 {"navy blue" , PALETTERGB ( 0, 0,128)},
618 {"NavyBlue" , PALETTERGB ( 0, 0,128)},
619 {"cornflower blue" , PALETTERGB (100,149,237)},
620 {"CornflowerBlue" , PALETTERGB (100,149,237)},
621 {"dark slate blue" , PALETTERGB ( 72, 61,139)},
622 {"DarkSlateBlue" , PALETTERGB ( 72, 61,139)},
623 {"slate blue" , PALETTERGB (106, 90,205)},
624 {"SlateBlue" , PALETTERGB (106, 90,205)},
625 {"medium slate blue" , PALETTERGB (123,104,238)},
626 {"MediumSlateBlue" , PALETTERGB (123,104,238)},
627 {"light slate blue" , PALETTERGB (132,112,255)},
628 {"LightSlateBlue" , PALETTERGB (132,112,255)},
629 {"medium blue" , PALETTERGB ( 0, 0,205)},
630 {"MediumBlue" , PALETTERGB ( 0, 0,205)},
631 {"royal blue" , PALETTERGB ( 65,105,225)},
632 {"RoyalBlue" , PALETTERGB ( 65,105,225)},
633 {"blue" , PALETTERGB ( 0, 0,255)},
634 {"dodger blue" , PALETTERGB ( 30,144,255)},
635 {"DodgerBlue" , PALETTERGB ( 30,144,255)},
636 {"deep sky blue" , PALETTERGB ( 0,191,255)},
637 {"DeepSkyBlue" , PALETTERGB ( 0,191,255)},
638 {"sky blue" , PALETTERGB (135,206,235)},
639 {"SkyBlue" , PALETTERGB (135,206,235)},
640 {"light sky blue" , PALETTERGB (135,206,250)},
641 {"LightSkyBlue" , PALETTERGB (135,206,250)},
642 {"steel blue" , PALETTERGB ( 70,130,180)},
643 {"SteelBlue" , PALETTERGB ( 70,130,180)},
644 {"light steel blue" , PALETTERGB (176,196,222)},
645 {"LightSteelBlue" , PALETTERGB (176,196,222)},
646 {"light blue" , PALETTERGB (173,216,230)},
647 {"LightBlue" , PALETTERGB (173,216,230)},
648 {"powder blue" , PALETTERGB (176,224,230)},
649 {"PowderBlue" , PALETTERGB (176,224,230)},
650 {"pale turquoise" , PALETTERGB (175,238,238)},
651 {"PaleTurquoise" , PALETTERGB (175,238,238)},
652 {"dark turquoise" , PALETTERGB ( 0,206,209)},
653 {"DarkTurquoise" , PALETTERGB ( 0,206,209)},
654 {"medium turquoise" , PALETTERGB ( 72,209,204)},
655 {"MediumTurquoise" , PALETTERGB ( 72,209,204)},
656 {"turquoise" , PALETTERGB ( 64,224,208)},
657 {"cyan" , PALETTERGB ( 0,255,255)},
658 {"light cyan" , PALETTERGB (224,255,255)},
659 {"LightCyan" , PALETTERGB (224,255,255)},
660 {"cadet blue" , PALETTERGB ( 95,158,160)},
661 {"CadetBlue" , PALETTERGB ( 95,158,160)},
662 {"medium aquamarine" , PALETTERGB (102,205,170)},
663 {"MediumAquamarine" , PALETTERGB (102,205,170)},
664 {"aquamarine" , PALETTERGB (127,255,212)},
665 {"dark green" , PALETTERGB ( 0,100, 0)},
666 {"DarkGreen" , PALETTERGB ( 0,100, 0)},
667 {"dark olive green" , PALETTERGB ( 85,107, 47)},
668 {"DarkOliveGreen" , PALETTERGB ( 85,107, 47)},
669 {"dark sea green" , PALETTERGB (143,188,143)},
670 {"DarkSeaGreen" , PALETTERGB (143,188,143)},
671 {"sea green" , PALETTERGB ( 46,139, 87)},
672 {"SeaGreen" , PALETTERGB ( 46,139, 87)},
673 {"medium sea green" , PALETTERGB ( 60,179,113)},
674 {"MediumSeaGreen" , PALETTERGB ( 60,179,113)},
675 {"light sea green" , PALETTERGB ( 32,178,170)},
676 {"LightSeaGreen" , PALETTERGB ( 32,178,170)},
677 {"pale green" , PALETTERGB (152,251,152)},
678 {"PaleGreen" , PALETTERGB (152,251,152)},
679 {"spring green" , PALETTERGB ( 0,255,127)},
680 {"SpringGreen" , PALETTERGB ( 0,255,127)},
681 {"lawn green" , PALETTERGB (124,252, 0)},
682 {"LawnGreen" , PALETTERGB (124,252, 0)},
683 {"green" , PALETTERGB ( 0,255, 0)},
684 {"chartreuse" , PALETTERGB (127,255, 0)},
685 {"medium spring green" , PALETTERGB ( 0,250,154)},
686 {"MediumSpringGreen" , PALETTERGB ( 0,250,154)},
687 {"green yellow" , PALETTERGB (173,255, 47)},
688 {"GreenYellow" , PALETTERGB (173,255, 47)},
689 {"lime green" , PALETTERGB ( 50,205, 50)},
690 {"LimeGreen" , PALETTERGB ( 50,205, 50)},
691 {"yellow green" , PALETTERGB (154,205, 50)},
692 {"YellowGreen" , PALETTERGB (154,205, 50)},
693 {"forest green" , PALETTERGB ( 34,139, 34)},
694 {"ForestGreen" , PALETTERGB ( 34,139, 34)},
695 {"olive drab" , PALETTERGB (107,142, 35)},
696 {"OliveDrab" , PALETTERGB (107,142, 35)},
697 {"dark khaki" , PALETTERGB (189,183,107)},
698 {"DarkKhaki" , PALETTERGB (189,183,107)},
699 {"khaki" , PALETTERGB (240,230,140)},
700 {"pale goldenrod" , PALETTERGB (238,232,170)},
701 {"PaleGoldenrod" , PALETTERGB (238,232,170)},
702 {"light goldenrod yellow" , PALETTERGB (250,250,210)},
703 {"LightGoldenrodYellow" , PALETTERGB (250,250,210)},
704 {"light yellow" , PALETTERGB (255,255,224)},
705 {"LightYellow" , PALETTERGB (255,255,224)},
706 {"yellow" , PALETTERGB (255,255, 0)},
707 {"gold" , PALETTERGB (255,215, 0)},
708 {"light goldenrod" , PALETTERGB (238,221,130)},
709 {"LightGoldenrod" , PALETTERGB (238,221,130)},
710 {"goldenrod" , PALETTERGB (218,165, 32)},
711 {"dark goldenrod" , PALETTERGB (184,134, 11)},
712 {"DarkGoldenrod" , PALETTERGB (184,134, 11)},
713 {"rosy brown" , PALETTERGB (188,143,143)},
714 {"RosyBrown" , PALETTERGB (188,143,143)},
715 {"indian red" , PALETTERGB (205, 92, 92)},
716 {"IndianRed" , PALETTERGB (205, 92, 92)},
717 {"saddle brown" , PALETTERGB (139, 69, 19)},
718 {"SaddleBrown" , PALETTERGB (139, 69, 19)},
719 {"sienna" , PALETTERGB (160, 82, 45)},
720 {"peru" , PALETTERGB (205,133, 63)},
721 {"burlywood" , PALETTERGB (222,184,135)},
722 {"beige" , PALETTERGB (245,245,220)},
723 {"wheat" , PALETTERGB (245,222,179)},
724 {"sandy brown" , PALETTERGB (244,164, 96)},
725 {"SandyBrown" , PALETTERGB (244,164, 96)},
726 {"tan" , PALETTERGB (210,180,140)},
727 {"chocolate" , PALETTERGB (210,105, 30)},
728 {"firebrick" , PALETTERGB (178,34, 34)},
729 {"brown" , PALETTERGB (165,42, 42)},
730 {"dark salmon" , PALETTERGB (233,150,122)},
731 {"DarkSalmon" , PALETTERGB (233,150,122)},
732 {"salmon" , PALETTERGB (250,128,114)},
733 {"light salmon" , PALETTERGB (255,160,122)},
734 {"LightSalmon" , PALETTERGB (255,160,122)},
735 {"orange" , PALETTERGB (255,165, 0)},
736 {"dark orange" , PALETTERGB (255,140, 0)},
737 {"DarkOrange" , PALETTERGB (255,140, 0)},
738 {"coral" , PALETTERGB (255,127, 80)},
739 {"light coral" , PALETTERGB (240,128,128)},
740 {"LightCoral" , PALETTERGB (240,128,128)},
741 {"tomato" , PALETTERGB (255, 99, 71)},
742 {"orange red" , PALETTERGB (255, 69, 0)},
743 {"OrangeRed" , PALETTERGB (255, 69, 0)},
744 {"red" , PALETTERGB (255, 0, 0)},
745 {"hot pink" , PALETTERGB (255,105,180)},
746 {"HotPink" , PALETTERGB (255,105,180)},
747 {"deep pink" , PALETTERGB (255, 20,147)},
748 {"DeepPink" , PALETTERGB (255, 20,147)},
749 {"pink" , PALETTERGB (255,192,203)},
750 {"light pink" , PALETTERGB (255,182,193)},
751 {"LightPink" , PALETTERGB (255,182,193)},
752 {"pale violet red" , PALETTERGB (219,112,147)},
753 {"PaleVioletRed" , PALETTERGB (219,112,147)},
754 {"maroon" , PALETTERGB (176, 48, 96)},
755 {"medium violet red" , PALETTERGB (199, 21,133)},
756 {"MediumVioletRed" , PALETTERGB (199, 21,133)},
757 {"violet red" , PALETTERGB (208, 32,144)},
758 {"VioletRed" , PALETTERGB (208, 32,144)},
759 {"magenta" , PALETTERGB (255, 0,255)},
760 {"violet" , PALETTERGB (238,130,238)},
761 {"plum" , PALETTERGB (221,160,221)},
762 {"orchid" , PALETTERGB (218,112,214)},
763 {"medium orchid" , PALETTERGB (186, 85,211)},
764 {"MediumOrchid" , PALETTERGB (186, 85,211)},
765 {"dark orchid" , PALETTERGB (153, 50,204)},
766 {"DarkOrchid" , PALETTERGB (153, 50,204)},
767 {"dark violet" , PALETTERGB (148, 0,211)},
768 {"DarkViolet" , PALETTERGB (148, 0,211)},
769 {"blue violet" , PALETTERGB (138, 43,226)},
770 {"BlueViolet" , PALETTERGB (138, 43,226)},
771 {"purple" , PALETTERGB (160, 32,240)},
772 {"medium purple" , PALETTERGB (147,112,219)},
773 {"MediumPurple" , PALETTERGB (147,112,219)},
774 {"thistle" , PALETTERGB (216,191,216)},
775 {"gray0" , PALETTERGB ( 0, 0, 0)},
776 {"grey0" , PALETTERGB ( 0, 0, 0)},
777 {"dark grey" , PALETTERGB (169,169,169)},
778 {"DarkGrey" , PALETTERGB (169,169,169)},
779 {"dark gray" , PALETTERGB (169,169,169)},
780 {"DarkGray" , PALETTERGB (169,169,169)},
781 {"dark blue" , PALETTERGB ( 0, 0,139)},
782 {"DarkBlue" , PALETTERGB ( 0, 0,139)},
783 {"dark cyan" , PALETTERGB ( 0,139,139)},
784 {"DarkCyan" , PALETTERGB ( 0,139,139)},
785 {"dark magenta" , PALETTERGB (139, 0,139)},
786 {"DarkMagenta" , PALETTERGB (139, 0,139)},
787 {"dark red" , PALETTERGB (139, 0, 0)},
788 {"DarkRed" , PALETTERGB (139, 0, 0)},
789 {"light green" , PALETTERGB (144,238,144)},
790 {"LightGreen" , PALETTERGB (144,238,144)},
791 };
792
793 DEFUN ("w32-default-color-map", Fw32_default_color_map, Sw32_default_color_map,
794 0, 0, 0, doc: /* Return the default color map. */)
795 ()
796 {
797 int i;
798 colormap_t *pc = w32_color_map;
799 Lisp_Object cmap;
800
801 BLOCK_INPUT;
802
803 cmap = Qnil;
804
805 for (i = 0; i < sizeof (w32_color_map) / sizeof (w32_color_map[0]);
806 pc++, i++)
807 cmap = Fcons (Fcons (build_string (pc->name),
808 make_number (pc->colorref)),
809 cmap);
810
811 UNBLOCK_INPUT;
812
813 return (cmap);
814 }
815
816 static Lisp_Object
817 w32_to_x_color (rgb)
818 Lisp_Object rgb;
819 {
820 Lisp_Object color;
821
822 CHECK_NUMBER (rgb);
823
824 BLOCK_INPUT;
825
826 color = Frassq (rgb, Vw32_color_map);
827
828 UNBLOCK_INPUT;
829
830 if (!NILP (color))
831 return (Fcar (color));
832 else
833 return Qnil;
834 }
835
836 static Lisp_Object
837 w32_color_map_lookup (colorname)
838 char *colorname;
839 {
840 Lisp_Object tail, ret = Qnil;
841
842 BLOCK_INPUT;
843
844 for (tail = Vw32_color_map; CONSP (tail); tail = XCDR (tail))
845 {
846 register Lisp_Object elt, tem;
847
848 elt = XCAR (tail);
849 if (!CONSP (elt)) continue;
850
851 tem = Fcar (elt);
852
853 if (lstrcmpi (SDATA (tem), colorname) == 0)
854 {
855 ret = Fcdr (elt);
856 break;
857 }
858
859 QUIT;
860 }
861
862
863 UNBLOCK_INPUT;
864
865 return ret;
866 }
867
868
869 static void
870 add_system_logical_colors_to_map (system_colors)
871 Lisp_Object *system_colors;
872 {
873 HKEY colors_key;
874
875 /* Other registry operations are done with input blocked. */
876 BLOCK_INPUT;
877
878 /* Look for "Control Panel/Colors" under User and Machine registry
879 settings. */
880 if (RegOpenKeyEx (HKEY_CURRENT_USER, "Control Panel\\Colors", 0,
881 KEY_READ, &colors_key) == ERROR_SUCCESS
882 || RegOpenKeyEx (HKEY_LOCAL_MACHINE, "Control Panel\\Colors", 0,
883 KEY_READ, &colors_key) == ERROR_SUCCESS)
884 {
885 /* List all keys. */
886 char color_buffer[64];
887 char full_name_buffer[MAX_PATH + SYSTEM_COLOR_PREFIX_LEN];
888 int index = 0;
889 DWORD name_size, color_size;
890 char *name_buffer = full_name_buffer + SYSTEM_COLOR_PREFIX_LEN;
891
892 name_size = sizeof (full_name_buffer) - SYSTEM_COLOR_PREFIX_LEN;
893 color_size = sizeof (color_buffer);
894
895 strcpy (full_name_buffer, SYSTEM_COLOR_PREFIX);
896
897 while (RegEnumValueA (colors_key, index, name_buffer, &name_size,
898 NULL, NULL, color_buffer, &color_size)
899 == ERROR_SUCCESS)
900 {
901 int r, g, b;
902 if (sscanf (color_buffer, " %u %u %u", &r, &g, &b) == 3)
903 *system_colors = Fcons (Fcons (build_string (full_name_buffer),
904 make_number (RGB (r, g, b))),
905 *system_colors);
906
907 name_size = sizeof (full_name_buffer) - SYSTEM_COLOR_PREFIX_LEN;
908 color_size = sizeof (color_buffer);
909 index++;
910 }
911 RegCloseKey (colors_key);
912 }
913
914 UNBLOCK_INPUT;
915 }
916
917
918 static Lisp_Object
919 x_to_w32_color (colorname)
920 char * colorname;
921 {
922 register Lisp_Object ret = Qnil;
923
924 BLOCK_INPUT;
925
926 if (colorname[0] == '#')
927 {
928 /* Could be an old-style RGB Device specification. */
929 char *color;
930 int size;
931 color = colorname + 1;
932
933 size = strlen (color);
934 if (size == 3 || size == 6 || size == 9 || size == 12)
935 {
936 UINT colorval;
937 int i, pos;
938 pos = 0;
939 size /= 3;
940 colorval = 0;
941
942 for (i = 0; i < 3; i++)
943 {
944 char *end;
945 char t;
946 unsigned long value;
947
948 /* The check for 'x' in the following conditional takes into
949 account the fact that strtol allows a "0x" in front of
950 our numbers, and we don't. */
951 if (!isxdigit (color[0]) || color[1] == 'x')
952 break;
953 t = color[size];
954 color[size] = '\0';
955 value = strtoul (color, &end, 16);
956 color[size] = t;
957 if (errno == ERANGE || end - color != size)
958 break;
959 switch (size)
960 {
961 case 1:
962 value = value * 0x10;
963 break;
964 case 2:
965 break;
966 case 3:
967 value /= 0x10;
968 break;
969 case 4:
970 value /= 0x100;
971 break;
972 }
973 colorval |= (value << pos);
974 pos += 0x8;
975 if (i == 2)
976 {
977 UNBLOCK_INPUT;
978 XSETINT (ret, colorval);
979 return ret;
980 }
981 color = end;
982 }
983 }
984 }
985 else if (strnicmp (colorname, "rgb:", 4) == 0)
986 {
987 char *color;
988 UINT colorval;
989 int i, pos;
990 pos = 0;
991
992 colorval = 0;
993 color = colorname + 4;
994 for (i = 0; i < 3; i++)
995 {
996 char *end;
997 unsigned long value;
998
999 /* The check for 'x' in the following conditional takes into
1000 account the fact that strtol allows a "0x" in front of
1001 our numbers, and we don't. */
1002 if (!isxdigit (color[0]) || color[1] == 'x')
1003 break;
1004 value = strtoul (color, &end, 16);
1005 if (errno == ERANGE)
1006 break;
1007 switch (end - color)
1008 {
1009 case 1:
1010 value = value * 0x10 + value;
1011 break;
1012 case 2:
1013 break;
1014 case 3:
1015 value /= 0x10;
1016 break;
1017 case 4:
1018 value /= 0x100;
1019 break;
1020 default:
1021 value = ULONG_MAX;
1022 }
1023 if (value == ULONG_MAX)
1024 break;
1025 colorval |= (value << pos);
1026 pos += 0x8;
1027 if (i == 2)
1028 {
1029 if (*end != '\0')
1030 break;
1031 UNBLOCK_INPUT;
1032 XSETINT (ret, colorval);
1033 return ret;
1034 }
1035 if (*end != '/')
1036 break;
1037 color = end + 1;
1038 }
1039 }
1040 else if (strnicmp (colorname, "rgbi:", 5) == 0)
1041 {
1042 /* This is an RGB Intensity specification. */
1043 char *color;
1044 UINT colorval;
1045 int i, pos;
1046 pos = 0;
1047
1048 colorval = 0;
1049 color = colorname + 5;
1050 for (i = 0; i < 3; i++)
1051 {
1052 char *end;
1053 double value;
1054 UINT val;
1055
1056 value = strtod (color, &end);
1057 if (errno == ERANGE)
1058 break;
1059 if (value < 0.0 || value > 1.0)
1060 break;
1061 val = (UINT)(0x100 * value);
1062 /* We used 0x100 instead of 0xFF to give a continuous
1063 range between 0.0 and 1.0 inclusive. The next statement
1064 fixes the 1.0 case. */
1065 if (val == 0x100)
1066 val = 0xFF;
1067 colorval |= (val << pos);
1068 pos += 0x8;
1069 if (i == 2)
1070 {
1071 if (*end != '\0')
1072 break;
1073 UNBLOCK_INPUT;
1074 XSETINT (ret, colorval);
1075 return ret;
1076 }
1077 if (*end != '/')
1078 break;
1079 color = end + 1;
1080 }
1081 }
1082 /* I am not going to attempt to handle any of the CIE color schemes
1083 or TekHVC, since I don't know the algorithms for conversion to
1084 RGB. */
1085
1086 /* If we fail to lookup the color name in w32_color_map, then check the
1087 colorname to see if it can be crudely approximated: If the X color
1088 ends in a number (e.g., "darkseagreen2"), strip the number and
1089 return the result of looking up the base color name. */
1090 ret = w32_color_map_lookup (colorname);
1091 if (NILP (ret))
1092 {
1093 int len = strlen (colorname);
1094
1095 if (isdigit (colorname[len - 1]))
1096 {
1097 char *ptr, *approx = alloca (len + 1);
1098
1099 strcpy (approx, colorname);
1100 ptr = &approx[len - 1];
1101 while (ptr > approx && isdigit (*ptr))
1102 *ptr-- = '\0';
1103
1104 ret = w32_color_map_lookup (approx);
1105 }
1106 }
1107
1108 UNBLOCK_INPUT;
1109 return ret;
1110 }
1111
1112 void
1113 w32_regenerate_palette (FRAME_PTR f)
1114 {
1115 struct w32_palette_entry * list;
1116 LOGPALETTE * log_palette;
1117 HPALETTE new_palette;
1118 int i;
1119
1120 /* don't bother trying to create palette if not supported */
1121 if (! FRAME_W32_DISPLAY_INFO (f)->has_palette)
1122 return;
1123
1124 log_palette = (LOGPALETTE *)
1125 alloca (sizeof (LOGPALETTE) +
1126 FRAME_W32_DISPLAY_INFO (f)->num_colors * sizeof (PALETTEENTRY));
1127 log_palette->palVersion = 0x300;
1128 log_palette->palNumEntries = FRAME_W32_DISPLAY_INFO (f)->num_colors;
1129
1130 list = FRAME_W32_DISPLAY_INFO (f)->color_list;
1131 for (i = 0;
1132 i < FRAME_W32_DISPLAY_INFO (f)->num_colors;
1133 i++, list = list->next)
1134 log_palette->palPalEntry[i] = list->entry;
1135
1136 new_palette = CreatePalette (log_palette);
1137
1138 enter_crit ();
1139
1140 if (FRAME_W32_DISPLAY_INFO (f)->palette)
1141 DeleteObject (FRAME_W32_DISPLAY_INFO (f)->palette);
1142 FRAME_W32_DISPLAY_INFO (f)->palette = new_palette;
1143
1144 /* Realize display palette and garbage all frames. */
1145 release_frame_dc (f, get_frame_dc (f));
1146
1147 leave_crit ();
1148 }
1149
1150 #define W32_COLOR(pe) RGB (pe.peRed, pe.peGreen, pe.peBlue)
1151 #define SET_W32_COLOR(pe, color) \
1152 do \
1153 { \
1154 pe.peRed = GetRValue (color); \
1155 pe.peGreen = GetGValue (color); \
1156 pe.peBlue = GetBValue (color); \
1157 pe.peFlags = 0; \
1158 } while (0)
1159
1160 #if 0
1161 /* Keep these around in case we ever want to track color usage. */
1162 void
1163 w32_map_color (FRAME_PTR f, COLORREF color)
1164 {
1165 struct w32_palette_entry * list = FRAME_W32_DISPLAY_INFO (f)->color_list;
1166
1167 if (NILP (Vw32_enable_palette))
1168 return;
1169
1170 /* check if color is already mapped */
1171 while (list)
1172 {
1173 if (W32_COLOR (list->entry) == color)
1174 {
1175 ++list->refcount;
1176 return;
1177 }
1178 list = list->next;
1179 }
1180
1181 /* not already mapped, so add to list and recreate Windows palette */
1182 list = (struct w32_palette_entry *)
1183 xmalloc (sizeof (struct w32_palette_entry));
1184 SET_W32_COLOR (list->entry, color);
1185 list->refcount = 1;
1186 list->next = FRAME_W32_DISPLAY_INFO (f)->color_list;
1187 FRAME_W32_DISPLAY_INFO (f)->color_list = list;
1188 FRAME_W32_DISPLAY_INFO (f)->num_colors++;
1189
1190 /* set flag that palette must be regenerated */
1191 FRAME_W32_DISPLAY_INFO (f)->regen_palette = TRUE;
1192 }
1193
1194 void
1195 w32_unmap_color (FRAME_PTR f, COLORREF color)
1196 {
1197 struct w32_palette_entry * list = FRAME_W32_DISPLAY_INFO (f)->color_list;
1198 struct w32_palette_entry **prev = &FRAME_W32_DISPLAY_INFO (f)->color_list;
1199
1200 if (NILP (Vw32_enable_palette))
1201 return;
1202
1203 /* check if color is already mapped */
1204 while (list)
1205 {
1206 if (W32_COLOR (list->entry) == color)
1207 {
1208 if (--list->refcount == 0)
1209 {
1210 *prev = list->next;
1211 xfree (list);
1212 FRAME_W32_DISPLAY_INFO (f)->num_colors--;
1213 break;
1214 }
1215 else
1216 return;
1217 }
1218 prev = &list->next;
1219 list = list->next;
1220 }
1221
1222 /* set flag that palette must be regenerated */
1223 FRAME_W32_DISPLAY_INFO (f)->regen_palette = TRUE;
1224 }
1225 #endif
1226
1227
1228 /* Gamma-correct COLOR on frame F. */
1229
1230 void
1231 gamma_correct (f, color)
1232 struct frame *f;
1233 COLORREF *color;
1234 {
1235 if (f->gamma)
1236 {
1237 *color = PALETTERGB (
1238 pow (GetRValue (*color) / 255.0, f->gamma) * 255.0 + 0.5,
1239 pow (GetGValue (*color) / 255.0, f->gamma) * 255.0 + 0.5,
1240 pow (GetBValue (*color) / 255.0, f->gamma) * 255.0 + 0.5);
1241 }
1242 }
1243
1244
1245 /* Decide if color named COLOR is valid for the display associated with
1246 the selected frame; if so, return the rgb values in COLOR_DEF.
1247 If ALLOC is nonzero, allocate a new colormap cell. */
1248
1249 int
1250 w32_defined_color (f, color, color_def, alloc)
1251 FRAME_PTR f;
1252 char *color;
1253 XColor *color_def;
1254 int alloc;
1255 {
1256 register Lisp_Object tem;
1257 COLORREF w32_color_ref;
1258
1259 tem = x_to_w32_color (color);
1260
1261 if (!NILP (tem))
1262 {
1263 if (f)
1264 {
1265 /* Apply gamma correction. */
1266 w32_color_ref = XUINT (tem);
1267 gamma_correct (f, &w32_color_ref);
1268 XSETINT (tem, w32_color_ref);
1269 }
1270
1271 /* Map this color to the palette if it is enabled. */
1272 if (!NILP (Vw32_enable_palette))
1273 {
1274 struct w32_palette_entry * entry =
1275 one_w32_display_info.color_list;
1276 struct w32_palette_entry ** prev =
1277 &one_w32_display_info.color_list;
1278
1279 /* check if color is already mapped */
1280 while (entry)
1281 {
1282 if (W32_COLOR (entry->entry) == XUINT (tem))
1283 break;
1284 prev = &entry->next;
1285 entry = entry->next;
1286 }
1287
1288 if (entry == NULL && alloc)
1289 {
1290 /* not already mapped, so add to list */
1291 entry = (struct w32_palette_entry *)
1292 xmalloc (sizeof (struct w32_palette_entry));
1293 SET_W32_COLOR (entry->entry, XUINT (tem));
1294 entry->next = NULL;
1295 *prev = entry;
1296 one_w32_display_info.num_colors++;
1297
1298 /* set flag that palette must be regenerated */
1299 one_w32_display_info.regen_palette = TRUE;
1300 }
1301 }
1302 /* Ensure COLORREF value is snapped to nearest color in (default)
1303 palette by simulating the PALETTERGB macro. This works whether
1304 or not the display device has a palette. */
1305 w32_color_ref = XUINT (tem) | 0x2000000;
1306
1307 color_def->pixel = w32_color_ref;
1308 color_def->red = GetRValue (w32_color_ref) * 256;
1309 color_def->green = GetGValue (w32_color_ref) * 256;
1310 color_def->blue = GetBValue (w32_color_ref) * 256;
1311
1312 return 1;
1313 }
1314 else
1315 {
1316 return 0;
1317 }
1318 }
1319
1320 /* Given a string ARG naming a color, compute a pixel value from it
1321 suitable for screen F.
1322 If F is not a color screen, return DEF (default) regardless of what
1323 ARG says. */
1324
1325 int
1326 x_decode_color (f, arg, def)
1327 FRAME_PTR f;
1328 Lisp_Object arg;
1329 int def;
1330 {
1331 XColor cdef;
1332
1333 CHECK_STRING (arg);
1334
1335 if (strcmp (SDATA (arg), "black") == 0)
1336 return BLACK_PIX_DEFAULT (f);
1337 else if (strcmp (SDATA (arg), "white") == 0)
1338 return WHITE_PIX_DEFAULT (f);
1339
1340 if ((FRAME_W32_DISPLAY_INFO (f)->n_planes * FRAME_W32_DISPLAY_INFO (f)->n_cbits) == 1)
1341 return def;
1342
1343 /* w32_defined_color is responsible for coping with failures
1344 by looking for a near-miss. */
1345 if (w32_defined_color (f, SDATA (arg), &cdef, 1))
1346 return cdef.pixel;
1347
1348 /* defined_color failed; return an ultimate default. */
1349 return def;
1350 }
1351 \f
1352
1353
1354 /* Functions called only from `x_set_frame_param'
1355 to set individual parameters.
1356
1357 If FRAME_W32_WINDOW (f) is 0,
1358 the frame is being created and its window does not exist yet.
1359 In that case, just record the parameter's new value
1360 in the standard place; do not attempt to change the window. */
1361
1362 void
1363 x_set_foreground_color (f, arg, oldval)
1364 struct frame *f;
1365 Lisp_Object arg, oldval;
1366 {
1367 struct w32_output *x = f->output_data.w32;
1368 PIX_TYPE fg, old_fg;
1369
1370 fg = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1371 old_fg = FRAME_FOREGROUND_PIXEL (f);
1372 FRAME_FOREGROUND_PIXEL (f) = fg;
1373
1374 if (FRAME_W32_WINDOW (f) != 0)
1375 {
1376 if (x->cursor_pixel == old_fg)
1377 x->cursor_pixel = fg;
1378
1379 update_face_from_frame_parameter (f, Qforeground_color, arg);
1380 if (FRAME_VISIBLE_P (f))
1381 redraw_frame (f);
1382 }
1383 }
1384
1385 void
1386 x_set_background_color (f, arg, oldval)
1387 struct frame *f;
1388 Lisp_Object arg, oldval;
1389 {
1390 FRAME_BACKGROUND_PIXEL (f)
1391 = x_decode_color (f, arg, WHITE_PIX_DEFAULT (f));
1392
1393 if (FRAME_W32_WINDOW (f) != 0)
1394 {
1395 SetWindowLong (FRAME_W32_WINDOW (f), WND_BACKGROUND_INDEX,
1396 FRAME_BACKGROUND_PIXEL (f));
1397
1398 update_face_from_frame_parameter (f, Qbackground_color, arg);
1399
1400 if (FRAME_VISIBLE_P (f))
1401 redraw_frame (f);
1402 }
1403 }
1404
1405 void
1406 x_set_mouse_color (f, arg, oldval)
1407 struct frame *f;
1408 Lisp_Object arg, oldval;
1409 {
1410 Cursor cursor, nontext_cursor, mode_cursor, hand_cursor;
1411 int count;
1412 int mask_color;
1413
1414 if (!EQ (Qnil, arg))
1415 f->output_data.w32->mouse_pixel
1416 = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1417 mask_color = FRAME_BACKGROUND_PIXEL (f);
1418
1419 /* Don't let pointers be invisible. */
1420 if (mask_color == f->output_data.w32->mouse_pixel
1421 && mask_color == FRAME_BACKGROUND_PIXEL (f))
1422 f->output_data.w32->mouse_pixel = FRAME_FOREGROUND_PIXEL (f);
1423
1424 #if 0 /* TODO : cursor changes */
1425 BLOCK_INPUT;
1426
1427 /* It's not okay to crash if the user selects a screwy cursor. */
1428 count = x_catch_errors (FRAME_W32_DISPLAY (f));
1429
1430 if (!EQ (Qnil, Vx_pointer_shape))
1431 {
1432 CHECK_NUMBER (Vx_pointer_shape);
1433 cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XINT (Vx_pointer_shape));
1434 }
1435 else
1436 cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_xterm);
1437 x_check_errors (FRAME_W32_DISPLAY (f), "bad text pointer cursor: %s");
1438
1439 if (!EQ (Qnil, Vx_nontext_pointer_shape))
1440 {
1441 CHECK_NUMBER (Vx_nontext_pointer_shape);
1442 nontext_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f),
1443 XINT (Vx_nontext_pointer_shape));
1444 }
1445 else
1446 nontext_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_left_ptr);
1447 x_check_errors (FRAME_W32_DISPLAY (f), "bad nontext pointer cursor: %s");
1448
1449 if (!EQ (Qnil, Vx_hourglass_pointer_shape))
1450 {
1451 CHECK_NUMBER (Vx_hourglass_pointer_shape);
1452 hourglass_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f),
1453 XINT (Vx_hourglass_pointer_shape));
1454 }
1455 else
1456 hourglass_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_watch);
1457 x_check_errors (FRAME_W32_DISPLAY (f), "bad busy pointer cursor: %s");
1458
1459 x_check_errors (FRAME_W32_DISPLAY (f), "bad nontext pointer cursor: %s");
1460 if (!EQ (Qnil, Vx_mode_pointer_shape))
1461 {
1462 CHECK_NUMBER (Vx_mode_pointer_shape);
1463 mode_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f),
1464 XINT (Vx_mode_pointer_shape));
1465 }
1466 else
1467 mode_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_xterm);
1468 x_check_errors (FRAME_W32_DISPLAY (f), "bad modeline pointer cursor: %s");
1469
1470 if (!EQ (Qnil, Vx_sensitive_text_pointer_shape))
1471 {
1472 CHECK_NUMBER (Vx_sensitive_text_pointer_shape);
1473 hand_cursor
1474 = XCreateFontCursor (FRAME_W32_DISPLAY (f),
1475 XINT (Vx_sensitive_text_pointer_shape));
1476 }
1477 else
1478 hand_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_crosshair);
1479
1480 if (!NILP (Vx_window_horizontal_drag_shape))
1481 {
1482 CHECK_NUMBER (Vx_window_horizontal_drag_shape);
1483 horizontal_drag_cursor
1484 = XCreateFontCursor (FRAME_X_DISPLAY (f),
1485 XINT (Vx_window_horizontal_drag_shape));
1486 }
1487 else
1488 horizontal_drag_cursor
1489 = XCreateFontCursor (FRAME_X_DISPLAY (f), XC_sb_h_double_arrow);
1490
1491 /* Check and report errors with the above calls. */
1492 x_check_errors (FRAME_W32_DISPLAY (f), "can't set cursor shape: %s");
1493 x_uncatch_errors (FRAME_W32_DISPLAY (f), count);
1494
1495 {
1496 XColor fore_color, back_color;
1497
1498 fore_color.pixel = f->output_data.w32->mouse_pixel;
1499 back_color.pixel = mask_color;
1500 XQueryColor (FRAME_W32_DISPLAY (f),
1501 DefaultColormap (FRAME_W32_DISPLAY (f),
1502 DefaultScreen (FRAME_W32_DISPLAY (f))),
1503 &fore_color);
1504 XQueryColor (FRAME_W32_DISPLAY (f),
1505 DefaultColormap (FRAME_W32_DISPLAY (f),
1506 DefaultScreen (FRAME_W32_DISPLAY (f))),
1507 &back_color);
1508 XRecolorCursor (FRAME_W32_DISPLAY (f), cursor,
1509 &fore_color, &back_color);
1510 XRecolorCursor (FRAME_W32_DISPLAY (f), nontext_cursor,
1511 &fore_color, &back_color);
1512 XRecolorCursor (FRAME_W32_DISPLAY (f), mode_cursor,
1513 &fore_color, &back_color);
1514 XRecolorCursor (FRAME_W32_DISPLAY (f), hand_cursor,
1515 &fore_color, &back_color);
1516 XRecolorCursor (FRAME_W32_DISPLAY (f), hourglass_cursor,
1517 &fore_color, &back_color);
1518 }
1519
1520 if (FRAME_W32_WINDOW (f) != 0)
1521 XDefineCursor (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f), cursor);
1522
1523 if (cursor != f->output_data.w32->text_cursor && f->output_data.w32->text_cursor != 0)
1524 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->text_cursor);
1525 f->output_data.w32->text_cursor = cursor;
1526
1527 if (nontext_cursor != f->output_data.w32->nontext_cursor
1528 && f->output_data.w32->nontext_cursor != 0)
1529 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->nontext_cursor);
1530 f->output_data.w32->nontext_cursor = nontext_cursor;
1531
1532 if (hourglass_cursor != f->output_data.w32->hourglass_cursor
1533 && f->output_data.w32->hourglass_cursor != 0)
1534 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->hourglass_cursor);
1535 f->output_data.w32->hourglass_cursor = hourglass_cursor;
1536
1537 if (mode_cursor != f->output_data.w32->modeline_cursor
1538 && f->output_data.w32->modeline_cursor != 0)
1539 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->modeline_cursor);
1540 f->output_data.w32->modeline_cursor = mode_cursor;
1541
1542 if (hand_cursor != f->output_data.w32->hand_cursor
1543 && f->output_data.w32->hand_cursor != 0)
1544 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->hand_cursor);
1545 f->output_data.w32->hand_cursor = hand_cursor;
1546
1547 XFlush (FRAME_W32_DISPLAY (f));
1548 UNBLOCK_INPUT;
1549
1550 update_face_from_frame_parameter (f, Qmouse_color, arg);
1551 #endif /* TODO */
1552 }
1553
1554 void
1555 x_set_cursor_color (f, arg, oldval)
1556 struct frame *f;
1557 Lisp_Object arg, oldval;
1558 {
1559 unsigned long fore_pixel, pixel;
1560
1561 if (!NILP (Vx_cursor_fore_pixel))
1562 fore_pixel = x_decode_color (f, Vx_cursor_fore_pixel,
1563 WHITE_PIX_DEFAULT (f));
1564 else
1565 fore_pixel = FRAME_BACKGROUND_PIXEL (f);
1566
1567 pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1568
1569 /* Make sure that the cursor color differs from the background color. */
1570 if (pixel == FRAME_BACKGROUND_PIXEL (f))
1571 {
1572 pixel = f->output_data.w32->mouse_pixel;
1573 if (pixel == fore_pixel)
1574 fore_pixel = FRAME_BACKGROUND_PIXEL (f);
1575 }
1576
1577 f->output_data.w32->cursor_foreground_pixel = fore_pixel;
1578 f->output_data.w32->cursor_pixel = pixel;
1579
1580 if (FRAME_W32_WINDOW (f) != 0)
1581 {
1582 BLOCK_INPUT;
1583 /* Update frame's cursor_gc. */
1584 f->output_data.w32->cursor_gc->foreground = fore_pixel;
1585 f->output_data.w32->cursor_gc->background = pixel;
1586
1587 UNBLOCK_INPUT;
1588
1589 if (FRAME_VISIBLE_P (f))
1590 {
1591 x_update_cursor (f, 0);
1592 x_update_cursor (f, 1);
1593 }
1594 }
1595
1596 update_face_from_frame_parameter (f, Qcursor_color, arg);
1597 }
1598
1599 /* Set the border-color of frame F to pixel value PIX.
1600 Note that this does not fully take effect if done before
1601 F has a window. */
1602
1603 void
1604 x_set_border_pixel (f, pix)
1605 struct frame *f;
1606 int pix;
1607 {
1608
1609 f->output_data.w32->border_pixel = pix;
1610
1611 if (FRAME_W32_WINDOW (f) != 0 && f->border_width > 0)
1612 {
1613 if (FRAME_VISIBLE_P (f))
1614 redraw_frame (f);
1615 }
1616 }
1617
1618 /* Set the border-color of frame F to value described by ARG.
1619 ARG can be a string naming a color.
1620 The border-color is used for the border that is drawn by the server.
1621 Note that this does not fully take effect if done before
1622 F has a window; it must be redone when the window is created. */
1623
1624 void
1625 x_set_border_color (f, arg, oldval)
1626 struct frame *f;
1627 Lisp_Object arg, oldval;
1628 {
1629 int pix;
1630
1631 CHECK_STRING (arg);
1632 pix = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1633 x_set_border_pixel (f, pix);
1634 update_face_from_frame_parameter (f, Qborder_color, arg);
1635 }
1636
1637
1638 void
1639 x_set_cursor_type (f, arg, oldval)
1640 FRAME_PTR f;
1641 Lisp_Object arg, oldval;
1642 {
1643 set_frame_cursor_types (f, arg);
1644
1645 /* Make sure the cursor gets redrawn. */
1646 cursor_type_changed = 1;
1647 }
1648 \f
1649 void
1650 x_set_icon_type (f, arg, oldval)
1651 struct frame *f;
1652 Lisp_Object arg, oldval;
1653 {
1654 int result;
1655
1656 if (NILP (arg) && NILP (oldval))
1657 return;
1658
1659 if (STRINGP (arg) && STRINGP (oldval)
1660 && EQ (Fstring_equal (oldval, arg), Qt))
1661 return;
1662
1663 if (SYMBOLP (arg) && SYMBOLP (oldval) && EQ (arg, oldval))
1664 return;
1665
1666 BLOCK_INPUT;
1667
1668 result = x_bitmap_icon (f, arg);
1669 if (result)
1670 {
1671 UNBLOCK_INPUT;
1672 error ("No icon window available");
1673 }
1674
1675 UNBLOCK_INPUT;
1676 }
1677
1678 void
1679 x_set_icon_name (f, arg, oldval)
1680 struct frame *f;
1681 Lisp_Object arg, oldval;
1682 {
1683 if (STRINGP (arg))
1684 {
1685 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
1686 return;
1687 }
1688 else if (!NILP (arg) || NILP (oldval))
1689 return;
1690
1691 f->icon_name = arg;
1692
1693 #if 0
1694 if (f->output_data.w32->icon_bitmap != 0)
1695 return;
1696
1697 BLOCK_INPUT;
1698
1699 result = x_text_icon (f,
1700 (char *) SDATA ((!NILP (f->icon_name)
1701 ? f->icon_name
1702 : !NILP (f->title)
1703 ? f->title
1704 : f->name)));
1705
1706 if (result)
1707 {
1708 UNBLOCK_INPUT;
1709 error ("No icon window available");
1710 }
1711
1712 /* If the window was unmapped (and its icon was mapped),
1713 the new icon is not mapped, so map the window in its stead. */
1714 if (FRAME_VISIBLE_P (f))
1715 {
1716 #ifdef USE_X_TOOLKIT
1717 XtPopup (f->output_data.w32->widget, XtGrabNone);
1718 #endif
1719 XMapWindow (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f));
1720 }
1721
1722 XFlush (FRAME_W32_DISPLAY (f));
1723 UNBLOCK_INPUT;
1724 #endif
1725 }
1726
1727 \f
1728 void
1729 x_set_menu_bar_lines (f, value, oldval)
1730 struct frame *f;
1731 Lisp_Object value, oldval;
1732 {
1733 int nlines;
1734 int olines = FRAME_MENU_BAR_LINES (f);
1735
1736 /* Right now, menu bars don't work properly in minibuf-only frames;
1737 most of the commands try to apply themselves to the minibuffer
1738 frame itself, and get an error because you can't switch buffers
1739 in or split the minibuffer window. */
1740 if (FRAME_MINIBUF_ONLY_P (f))
1741 return;
1742
1743 if (INTEGERP (value))
1744 nlines = XINT (value);
1745 else
1746 nlines = 0;
1747
1748 FRAME_MENU_BAR_LINES (f) = 0;
1749 if (nlines)
1750 FRAME_EXTERNAL_MENU_BAR (f) = 1;
1751 else
1752 {
1753 if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
1754 free_frame_menubar (f);
1755 FRAME_EXTERNAL_MENU_BAR (f) = 0;
1756
1757 /* Adjust the frame size so that the client (text) dimensions
1758 remain the same. This depends on FRAME_EXTERNAL_MENU_BAR being
1759 set correctly. */
1760 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
1761 do_pending_window_change (0);
1762 }
1763 adjust_glyphs (f);
1764 }
1765
1766
1767 /* Set the number of lines used for the tool bar of frame F to VALUE.
1768 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
1769 is the old number of tool bar lines. This function changes the
1770 height of all windows on frame F to match the new tool bar height.
1771 The frame's height doesn't change. */
1772
1773 void
1774 x_set_tool_bar_lines (f, value, oldval)
1775 struct frame *f;
1776 Lisp_Object value, oldval;
1777 {
1778 int delta, nlines, root_height;
1779 Lisp_Object root_window;
1780
1781 /* Treat tool bars like menu bars. */
1782 if (FRAME_MINIBUF_ONLY_P (f))
1783 return;
1784
1785 /* Use VALUE only if an integer >= 0. */
1786 if (INTEGERP (value) && XINT (value) >= 0)
1787 nlines = XFASTINT (value);
1788 else
1789 nlines = 0;
1790
1791 /* Make sure we redisplay all windows in this frame. */
1792 ++windows_or_buffers_changed;
1793
1794 delta = nlines - FRAME_TOOL_BAR_LINES (f);
1795
1796 /* Don't resize the tool-bar to more than we have room for. */
1797 root_window = FRAME_ROOT_WINDOW (f);
1798 root_height = WINDOW_TOTAL_LINES (XWINDOW (root_window));
1799 if (root_height - delta < 1)
1800 {
1801 delta = root_height - 1;
1802 nlines = FRAME_TOOL_BAR_LINES (f) + delta;
1803 }
1804
1805 FRAME_TOOL_BAR_LINES (f) = nlines;
1806 change_window_heights (root_window, delta);
1807 adjust_glyphs (f);
1808
1809 /* We also have to make sure that the internal border at the top of
1810 the frame, below the menu bar or tool bar, is redrawn when the
1811 tool bar disappears. This is so because the internal border is
1812 below the tool bar if one is displayed, but is below the menu bar
1813 if there isn't a tool bar. The tool bar draws into the area
1814 below the menu bar. */
1815 if (FRAME_W32_WINDOW (f) && FRAME_TOOL_BAR_LINES (f) == 0)
1816 {
1817 clear_frame (f);
1818 clear_current_matrices (f);
1819 }
1820
1821 /* If the tool bar gets smaller, the internal border below it
1822 has to be cleared. It was formerly part of the display
1823 of the larger tool bar, and updating windows won't clear it. */
1824 if (delta < 0)
1825 {
1826 int height = FRAME_INTERNAL_BORDER_WIDTH (f);
1827 int width = FRAME_PIXEL_WIDTH (f);
1828 int y = nlines * FRAME_LINE_HEIGHT (f);
1829
1830 BLOCK_INPUT;
1831 {
1832 HDC hdc = get_frame_dc (f);
1833 w32_clear_area (f, hdc, 0, y, width, height);
1834 release_frame_dc (f, hdc);
1835 }
1836 UNBLOCK_INPUT;
1837
1838 if (WINDOWP (f->tool_bar_window))
1839 clear_glyph_matrix (XWINDOW (f->tool_bar_window)->current_matrix);
1840 }
1841 }
1842
1843
1844 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
1845 w32_id_name.
1846
1847 If EXPLICIT is non-zero, that indicates that lisp code is setting the
1848 name; if NAME is a string, set F's name to NAME and set
1849 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
1850
1851 If EXPLICIT is zero, that indicates that Emacs redisplay code is
1852 suggesting a new name, which lisp code should override; if
1853 F->explicit_name is set, ignore the new name; otherwise, set it. */
1854
1855 void
1856 x_set_name (f, name, explicit)
1857 struct frame *f;
1858 Lisp_Object name;
1859 int explicit;
1860 {
1861 /* Make sure that requests from lisp code override requests from
1862 Emacs redisplay code. */
1863 if (explicit)
1864 {
1865 /* If we're switching from explicit to implicit, we had better
1866 update the mode lines and thereby update the title. */
1867 if (f->explicit_name && NILP (name))
1868 update_mode_lines = 1;
1869
1870 f->explicit_name = ! NILP (name);
1871 }
1872 else if (f->explicit_name)
1873 return;
1874
1875 /* If NAME is nil, set the name to the w32_id_name. */
1876 if (NILP (name))
1877 {
1878 /* Check for no change needed in this very common case
1879 before we do any consing. */
1880 if (!strcmp (FRAME_W32_DISPLAY_INFO (f)->w32_id_name,
1881 SDATA (f->name)))
1882 return;
1883 name = build_string (FRAME_W32_DISPLAY_INFO (f)->w32_id_name);
1884 }
1885 else
1886 CHECK_STRING (name);
1887
1888 /* Don't change the name if it's already NAME. */
1889 if (! NILP (Fstring_equal (name, f->name)))
1890 return;
1891
1892 f->name = name;
1893
1894 /* For setting the frame title, the title parameter should override
1895 the name parameter. */
1896 if (! NILP (f->title))
1897 name = f->title;
1898
1899 if (FRAME_W32_WINDOW (f))
1900 {
1901 if (STRING_MULTIBYTE (name))
1902 name = ENCODE_SYSTEM (name);
1903
1904 BLOCK_INPUT;
1905 SetWindowText (FRAME_W32_WINDOW (f), SDATA (name));
1906 UNBLOCK_INPUT;
1907 }
1908 }
1909
1910 /* This function should be called when the user's lisp code has
1911 specified a name for the frame; the name will override any set by the
1912 redisplay code. */
1913 void
1914 x_explicitly_set_name (f, arg, oldval)
1915 FRAME_PTR f;
1916 Lisp_Object arg, oldval;
1917 {
1918 x_set_name (f, arg, 1);
1919 }
1920
1921 /* This function should be called by Emacs redisplay code to set the
1922 name; names set this way will never override names set by the user's
1923 lisp code. */
1924 void
1925 x_implicitly_set_name (f, arg, oldval)
1926 FRAME_PTR f;
1927 Lisp_Object arg, oldval;
1928 {
1929 x_set_name (f, arg, 0);
1930 }
1931 \f
1932 /* Change the title of frame F to NAME.
1933 If NAME is nil, use the frame name as the title. */
1934
1935 void
1936 x_set_title (f, name, old_name)
1937 struct frame *f;
1938 Lisp_Object name, old_name;
1939 {
1940 /* Don't change the title if it's already NAME. */
1941 if (EQ (name, f->title))
1942 return;
1943
1944 update_mode_lines = 1;
1945
1946 f->title = name;
1947
1948 if (NILP (name))
1949 name = f->name;
1950
1951 if (FRAME_W32_WINDOW (f))
1952 {
1953 if (STRING_MULTIBYTE (name))
1954 name = ENCODE_SYSTEM (name);
1955
1956 BLOCK_INPUT;
1957 SetWindowText (FRAME_W32_WINDOW (f), SDATA (name));
1958 UNBLOCK_INPUT;
1959 }
1960 }
1961
1962
1963 void x_set_scroll_bar_default_width (f)
1964 struct frame *f;
1965 {
1966 int wid = FRAME_COLUMN_WIDTH (f);
1967
1968 FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = GetSystemMetrics (SM_CXVSCROLL);
1969 FRAME_CONFIG_SCROLL_BAR_COLS (f) = (FRAME_CONFIG_SCROLL_BAR_WIDTH (f) +
1970 wid - 1) / wid;
1971 }
1972
1973 \f
1974 /* Subroutines of creating a frame. */
1975
1976
1977 /* Return the value of parameter PARAM.
1978
1979 First search ALIST, then Vdefault_frame_alist, then the X defaults
1980 database, using ATTRIBUTE as the attribute name and CLASS as its class.
1981
1982 Convert the resource to the type specified by desired_type.
1983
1984 If no default is specified, return Qunbound. If you call
1985 w32_get_arg, make sure you deal with Qunbound in a reasonable way,
1986 and don't let it get stored in any Lisp-visible variables! */
1987
1988 static Lisp_Object
1989 w32_get_arg (alist, param, attribute, class, type)
1990 Lisp_Object alist, param;
1991 char *attribute;
1992 char *class;
1993 enum resource_types type;
1994 {
1995 return x_get_arg (check_x_display_info (Qnil),
1996 alist, param, attribute, class, type);
1997 }
1998
1999 \f
2000 Cursor
2001 w32_load_cursor (LPCTSTR name)
2002 {
2003 /* Try first to load cursor from application resource. */
2004 Cursor cursor = LoadImage ((HINSTANCE) GetModuleHandle (NULL),
2005 name, IMAGE_CURSOR, 0, 0,
2006 LR_DEFAULTCOLOR | LR_DEFAULTSIZE | LR_SHARED);
2007 if (!cursor)
2008 {
2009 /* Then try to load a shared predefined cursor. */
2010 cursor = LoadImage (NULL, name, IMAGE_CURSOR, 0, 0,
2011 LR_DEFAULTCOLOR | LR_DEFAULTSIZE | LR_SHARED);
2012 }
2013 return cursor;
2014 }
2015
2016 extern LRESULT CALLBACK w32_wnd_proc ();
2017
2018 static BOOL
2019 w32_init_class (hinst)
2020 HINSTANCE hinst;
2021 {
2022 WNDCLASS wc;
2023
2024 wc.style = CS_HREDRAW | CS_VREDRAW;
2025 wc.lpfnWndProc = (WNDPROC) w32_wnd_proc;
2026 wc.cbClsExtra = 0;
2027 wc.cbWndExtra = WND_EXTRA_BYTES;
2028 wc.hInstance = hinst;
2029 wc.hIcon = LoadIcon (hinst, EMACS_CLASS);
2030 wc.hCursor = w32_load_cursor (IDC_ARROW);
2031 wc.hbrBackground = NULL; /* GetStockObject (WHITE_BRUSH); */
2032 wc.lpszMenuName = NULL;
2033 wc.lpszClassName = EMACS_CLASS;
2034
2035 return (RegisterClass (&wc));
2036 }
2037
2038 static HWND
2039 w32_createscrollbar (f, bar)
2040 struct frame *f;
2041 struct scroll_bar * bar;
2042 {
2043 return (CreateWindow ("SCROLLBAR", "", SBS_VERT | WS_CHILD | WS_VISIBLE,
2044 /* Position and size of scroll bar. */
2045 XINT (bar->left) + VERTICAL_SCROLL_BAR_WIDTH_TRIM,
2046 XINT (bar->top),
2047 XINT (bar->width) - VERTICAL_SCROLL_BAR_WIDTH_TRIM * 2,
2048 XINT (bar->height),
2049 FRAME_W32_WINDOW (f),
2050 NULL,
2051 hinst,
2052 NULL));
2053 }
2054
2055 static void
2056 w32_createwindow (f)
2057 struct frame *f;
2058 {
2059 HWND hwnd;
2060 RECT rect;
2061 Lisp_Object top = Qunbound;
2062 Lisp_Object left = Qunbound;
2063
2064 rect.left = rect.top = 0;
2065 rect.right = FRAME_PIXEL_WIDTH (f);
2066 rect.bottom = FRAME_PIXEL_HEIGHT (f);
2067
2068 AdjustWindowRect (&rect, f->output_data.w32->dwStyle,
2069 FRAME_EXTERNAL_MENU_BAR (f));
2070
2071 /* Do first time app init */
2072
2073 if (!hprevinst)
2074 {
2075 w32_init_class (hinst);
2076 }
2077
2078 if (f->size_hint_flags & USPosition || f->size_hint_flags & PPosition)
2079 {
2080 XSETINT (left, f->left_pos);
2081 XSETINT (top, f->top_pos);
2082 }
2083 else if (EQ (left, Qunbound) && EQ (top, Qunbound))
2084 {
2085 /* When called with RES_TYPE_NUMBER, w32_get_arg will return zero
2086 for anything that is not a number and is not Qunbound. */
2087 left = w32_get_arg (Qnil, Qleft, "left", "Left", RES_TYPE_NUMBER);
2088 top = w32_get_arg (Qnil, Qtop, "top", "Top", RES_TYPE_NUMBER);
2089 }
2090
2091 FRAME_W32_WINDOW (f) = hwnd
2092 = CreateWindow (EMACS_CLASS,
2093 f->namebuf,
2094 f->output_data.w32->dwStyle | WS_CLIPCHILDREN,
2095 EQ (left, Qunbound) ? CW_USEDEFAULT : XINT (left),
2096 EQ (top, Qunbound) ? CW_USEDEFAULT : XINT (top),
2097 rect.right - rect.left,
2098 rect.bottom - rect.top,
2099 NULL,
2100 NULL,
2101 hinst,
2102 NULL);
2103
2104 if (hwnd)
2105 {
2106 SetWindowLong (hwnd, WND_FONTWIDTH_INDEX, FRAME_COLUMN_WIDTH (f));
2107 SetWindowLong (hwnd, WND_LINEHEIGHT_INDEX, FRAME_LINE_HEIGHT (f));
2108 SetWindowLong (hwnd, WND_BORDER_INDEX, FRAME_INTERNAL_BORDER_WIDTH (f));
2109 SetWindowLong (hwnd, WND_SCROLLBAR_INDEX, f->scroll_bar_actual_width);
2110 SetWindowLong (hwnd, WND_BACKGROUND_INDEX, FRAME_BACKGROUND_PIXEL (f));
2111
2112 /* Enable drag-n-drop. */
2113 DragAcceptFiles (hwnd, TRUE);
2114
2115 /* Do this to discard the default setting specified by our parent. */
2116 ShowWindow (hwnd, SW_HIDE);
2117
2118 /* Update frame positions. */
2119 GetWindowRect (hwnd, &rect);
2120 f->left_pos = rect.left;
2121 f->top_pos = rect.top;
2122 }
2123 }
2124
2125 static void
2126 my_post_msg (wmsg, hwnd, msg, wParam, lParam)
2127 W32Msg * wmsg;
2128 HWND hwnd;
2129 UINT msg;
2130 WPARAM wParam;
2131 LPARAM lParam;
2132 {
2133 wmsg->msg.hwnd = hwnd;
2134 wmsg->msg.message = msg;
2135 wmsg->msg.wParam = wParam;
2136 wmsg->msg.lParam = lParam;
2137 wmsg->msg.time = GetMessageTime ();
2138
2139 post_msg (wmsg);
2140 }
2141
2142 /* GetKeyState and MapVirtualKey on Windows 95 do not actually distinguish
2143 between left and right keys as advertised. We test for this
2144 support dynamically, and set a flag when the support is absent. If
2145 absent, we keep track of the left and right control and alt keys
2146 ourselves. This is particularly necessary on keyboards that rely
2147 upon the AltGr key, which is represented as having the left control
2148 and right alt keys pressed. For these keyboards, we need to know
2149 when the left alt key has been pressed in addition to the AltGr key
2150 so that we can properly support M-AltGr-key sequences (such as M-@
2151 on Swedish keyboards). */
2152
2153 #define EMACS_LCONTROL 0
2154 #define EMACS_RCONTROL 1
2155 #define EMACS_LMENU 2
2156 #define EMACS_RMENU 3
2157
2158 static int modifiers[4];
2159 static int modifiers_recorded;
2160 static int modifier_key_support_tested;
2161
2162 static void
2163 test_modifier_support (unsigned int wparam)
2164 {
2165 unsigned int l, r;
2166
2167 if (wparam != VK_CONTROL && wparam != VK_MENU)
2168 return;
2169 if (wparam == VK_CONTROL)
2170 {
2171 l = VK_LCONTROL;
2172 r = VK_RCONTROL;
2173 }
2174 else
2175 {
2176 l = VK_LMENU;
2177 r = VK_RMENU;
2178 }
2179 if (!(GetKeyState (l) & 0x8000) && !(GetKeyState (r) & 0x8000))
2180 modifiers_recorded = 1;
2181 else
2182 modifiers_recorded = 0;
2183 modifier_key_support_tested = 1;
2184 }
2185
2186 static void
2187 record_keydown (unsigned int wparam, unsigned int lparam)
2188 {
2189 int i;
2190
2191 if (!modifier_key_support_tested)
2192 test_modifier_support (wparam);
2193
2194 if ((wparam != VK_CONTROL && wparam != VK_MENU) || !modifiers_recorded)
2195 return;
2196
2197 if (wparam == VK_CONTROL)
2198 i = (lparam & 0x1000000) ? EMACS_RCONTROL : EMACS_LCONTROL;
2199 else
2200 i = (lparam & 0x1000000) ? EMACS_RMENU : EMACS_LMENU;
2201
2202 modifiers[i] = 1;
2203 }
2204
2205 static void
2206 record_keyup (unsigned int wparam, unsigned int lparam)
2207 {
2208 int i;
2209
2210 if ((wparam != VK_CONTROL && wparam != VK_MENU) || !modifiers_recorded)
2211 return;
2212
2213 if (wparam == VK_CONTROL)
2214 i = (lparam & 0x1000000) ? EMACS_RCONTROL : EMACS_LCONTROL;
2215 else
2216 i = (lparam & 0x1000000) ? EMACS_RMENU : EMACS_LMENU;
2217
2218 modifiers[i] = 0;
2219 }
2220
2221 /* Emacs can lose focus while a modifier key has been pressed. When
2222 it regains focus, be conservative and clear all modifiers since
2223 we cannot reconstruct the left and right modifier state. */
2224 static void
2225 reset_modifiers ()
2226 {
2227 SHORT ctrl, alt;
2228
2229 if (GetFocus () == NULL)
2230 /* Emacs doesn't have keyboard focus. Do nothing. */
2231 return;
2232
2233 ctrl = GetAsyncKeyState (VK_CONTROL);
2234 alt = GetAsyncKeyState (VK_MENU);
2235
2236 if (!(ctrl & 0x08000))
2237 /* Clear any recorded control modifier state. */
2238 modifiers[EMACS_RCONTROL] = modifiers[EMACS_LCONTROL] = 0;
2239
2240 if (!(alt & 0x08000))
2241 /* Clear any recorded alt modifier state. */
2242 modifiers[EMACS_RMENU] = modifiers[EMACS_LMENU] = 0;
2243
2244 /* Update the state of all modifier keys, because modifiers used in
2245 hot-key combinations can get stuck on if Emacs loses focus as a
2246 result of a hot-key being pressed. */
2247 {
2248 BYTE keystate[256];
2249
2250 #define CURRENT_STATE(key) ((GetAsyncKeyState (key) & 0x8000) >> 8)
2251
2252 GetKeyboardState (keystate);
2253 keystate[VK_SHIFT] = CURRENT_STATE (VK_SHIFT);
2254 keystate[VK_CONTROL] = CURRENT_STATE (VK_CONTROL);
2255 keystate[VK_LCONTROL] = CURRENT_STATE (VK_LCONTROL);
2256 keystate[VK_RCONTROL] = CURRENT_STATE (VK_RCONTROL);
2257 keystate[VK_MENU] = CURRENT_STATE (VK_MENU);
2258 keystate[VK_LMENU] = CURRENT_STATE (VK_LMENU);
2259 keystate[VK_RMENU] = CURRENT_STATE (VK_RMENU);
2260 keystate[VK_LWIN] = CURRENT_STATE (VK_LWIN);
2261 keystate[VK_RWIN] = CURRENT_STATE (VK_RWIN);
2262 keystate[VK_APPS] = CURRENT_STATE (VK_APPS);
2263 SetKeyboardState (keystate);
2264 }
2265 }
2266
2267 /* Synchronize modifier state with what is reported with the current
2268 keystroke. Even if we cannot distinguish between left and right
2269 modifier keys, we know that, if no modifiers are set, then neither
2270 the left or right modifier should be set. */
2271 static void
2272 sync_modifiers ()
2273 {
2274 if (!modifiers_recorded)
2275 return;
2276
2277 if (!(GetKeyState (VK_CONTROL) & 0x8000))
2278 modifiers[EMACS_RCONTROL] = modifiers[EMACS_LCONTROL] = 0;
2279
2280 if (!(GetKeyState (VK_MENU) & 0x8000))
2281 modifiers[EMACS_RMENU] = modifiers[EMACS_LMENU] = 0;
2282 }
2283
2284 static int
2285 modifier_set (int vkey)
2286 {
2287 if (vkey == VK_CAPITAL || vkey == VK_SCROLL)
2288 return (GetKeyState (vkey) & 0x1);
2289 if (!modifiers_recorded)
2290 return (GetKeyState (vkey) & 0x8000);
2291
2292 switch (vkey)
2293 {
2294 case VK_LCONTROL:
2295 return modifiers[EMACS_LCONTROL];
2296 case VK_RCONTROL:
2297 return modifiers[EMACS_RCONTROL];
2298 case VK_LMENU:
2299 return modifiers[EMACS_LMENU];
2300 case VK_RMENU:
2301 return modifiers[EMACS_RMENU];
2302 }
2303 return (GetKeyState (vkey) & 0x8000);
2304 }
2305
2306 /* Convert between the modifier bits W32 uses and the modifier bits
2307 Emacs uses. */
2308
2309 unsigned int
2310 w32_key_to_modifier (int key)
2311 {
2312 Lisp_Object key_mapping;
2313
2314 switch (key)
2315 {
2316 case VK_LWIN:
2317 key_mapping = Vw32_lwindow_modifier;
2318 break;
2319 case VK_RWIN:
2320 key_mapping = Vw32_rwindow_modifier;
2321 break;
2322 case VK_APPS:
2323 key_mapping = Vw32_apps_modifier;
2324 break;
2325 case VK_SCROLL:
2326 key_mapping = Vw32_scroll_lock_modifier;
2327 break;
2328 default:
2329 key_mapping = Qnil;
2330 }
2331
2332 /* NB. This code runs in the input thread, asychronously to the lisp
2333 thread, so we must be careful to ensure access to lisp data is
2334 thread-safe. The following code is safe because the modifier
2335 variable values are updated atomically from lisp and symbols are
2336 not relocated by GC. Also, we don't have to worry about seeing GC
2337 markbits here. */
2338 if (EQ (key_mapping, Qhyper))
2339 return hyper_modifier;
2340 if (EQ (key_mapping, Qsuper))
2341 return super_modifier;
2342 if (EQ (key_mapping, Qmeta))
2343 return meta_modifier;
2344 if (EQ (key_mapping, Qalt))
2345 return alt_modifier;
2346 if (EQ (key_mapping, Qctrl))
2347 return ctrl_modifier;
2348 if (EQ (key_mapping, Qcontrol)) /* synonym for ctrl */
2349 return ctrl_modifier;
2350 if (EQ (key_mapping, Qshift))
2351 return shift_modifier;
2352
2353 /* Don't generate any modifier if not explicitly requested. */
2354 return 0;
2355 }
2356
2357 static unsigned int
2358 w32_get_modifiers ()
2359 {
2360 return ((modifier_set (VK_SHIFT) ? shift_modifier : 0) |
2361 (modifier_set (VK_CONTROL) ? ctrl_modifier : 0) |
2362 (modifier_set (VK_LWIN) ? w32_key_to_modifier (VK_LWIN) : 0) |
2363 (modifier_set (VK_RWIN) ? w32_key_to_modifier (VK_RWIN) : 0) |
2364 (modifier_set (VK_APPS) ? w32_key_to_modifier (VK_APPS) : 0) |
2365 (modifier_set (VK_SCROLL) ? w32_key_to_modifier (VK_SCROLL) : 0) |
2366 (modifier_set (VK_MENU) ?
2367 ((NILP (Vw32_alt_is_meta)) ? alt_modifier : meta_modifier) : 0));
2368 }
2369
2370 /* We map the VK_* modifiers into console modifier constants
2371 so that we can use the same routines to handle both console
2372 and window input. */
2373
2374 static int
2375 construct_console_modifiers ()
2376 {
2377 int mods;
2378
2379 mods = 0;
2380 mods |= (modifier_set (VK_SHIFT)) ? SHIFT_PRESSED : 0;
2381 mods |= (modifier_set (VK_CAPITAL)) ? CAPSLOCK_ON : 0;
2382 mods |= (modifier_set (VK_SCROLL)) ? SCROLLLOCK_ON : 0;
2383 mods |= (modifier_set (VK_NUMLOCK)) ? NUMLOCK_ON : 0;
2384 mods |= (modifier_set (VK_LCONTROL)) ? LEFT_CTRL_PRESSED : 0;
2385 mods |= (modifier_set (VK_RCONTROL)) ? RIGHT_CTRL_PRESSED : 0;
2386 mods |= (modifier_set (VK_LMENU)) ? LEFT_ALT_PRESSED : 0;
2387 mods |= (modifier_set (VK_RMENU)) ? RIGHT_ALT_PRESSED : 0;
2388 mods |= (modifier_set (VK_LWIN)) ? LEFT_WIN_PRESSED : 0;
2389 mods |= (modifier_set (VK_RWIN)) ? RIGHT_WIN_PRESSED : 0;
2390 mods |= (modifier_set (VK_APPS)) ? APPS_PRESSED : 0;
2391
2392 return mods;
2393 }
2394
2395 static int
2396 w32_get_key_modifiers (unsigned int wparam, unsigned int lparam)
2397 {
2398 int mods;
2399
2400 /* Convert to emacs modifiers. */
2401 mods = w32_kbd_mods_to_emacs (construct_console_modifiers (), wparam);
2402
2403 return mods;
2404 }
2405
2406 unsigned int
2407 map_keypad_keys (unsigned int virt_key, unsigned int extended)
2408 {
2409 if (virt_key < VK_CLEAR || virt_key > VK_DELETE)
2410 return virt_key;
2411
2412 if (virt_key == VK_RETURN)
2413 return (extended ? VK_NUMPAD_ENTER : VK_RETURN);
2414
2415 if (virt_key >= VK_PRIOR && virt_key <= VK_DOWN)
2416 return (!extended ? (VK_NUMPAD_PRIOR + (virt_key - VK_PRIOR)) : virt_key);
2417
2418 if (virt_key == VK_INSERT || virt_key == VK_DELETE)
2419 return (!extended ? (VK_NUMPAD_INSERT + (virt_key - VK_INSERT)) : virt_key);
2420
2421 if (virt_key == VK_CLEAR)
2422 return (!extended ? VK_NUMPAD_CLEAR : virt_key);
2423
2424 return virt_key;
2425 }
2426
2427 /* List of special key combinations which w32 would normally capture,
2428 but Emacs should grab instead. Not directly visible to lisp, to
2429 simplify synchronization. Each item is an integer encoding a virtual
2430 key code and modifier combination to capture. */
2431 static Lisp_Object w32_grabbed_keys;
2432
2433 #define HOTKEY(vk, mods) make_number (((vk) & 255) | ((mods) << 8))
2434 #define HOTKEY_ID(k) (XFASTINT (k) & 0xbfff)
2435 #define HOTKEY_VK_CODE(k) (XFASTINT (k) & 255)
2436 #define HOTKEY_MODIFIERS(k) (XFASTINT (k) >> 8)
2437
2438 #define RAW_HOTKEY_ID(k) ((k) & 0xbfff)
2439 #define RAW_HOTKEY_VK_CODE(k) ((k) & 255)
2440 #define RAW_HOTKEY_MODIFIERS(k) ((k) >> 8)
2441
2442 /* Register hot-keys for reserved key combinations when Emacs has
2443 keyboard focus, since this is the only way Emacs can receive key
2444 combinations like Alt-Tab which are used by the system. */
2445
2446 static void
2447 register_hot_keys (hwnd)
2448 HWND hwnd;
2449 {
2450 Lisp_Object keylist;
2451
2452 /* Use GC_CONSP, since we are called asynchronously. */
2453 for (keylist = w32_grabbed_keys; GC_CONSP (keylist); keylist = XCDR (keylist))
2454 {
2455 Lisp_Object key = XCAR (keylist);
2456
2457 /* Deleted entries get set to nil. */
2458 if (!INTEGERP (key))
2459 continue;
2460
2461 RegisterHotKey (hwnd, HOTKEY_ID (key),
2462 HOTKEY_MODIFIERS (key), HOTKEY_VK_CODE (key));
2463 }
2464 }
2465
2466 static void
2467 unregister_hot_keys (hwnd)
2468 HWND hwnd;
2469 {
2470 Lisp_Object keylist;
2471
2472 /* Use GC_CONSP, since we are called asynchronously. */
2473 for (keylist = w32_grabbed_keys; GC_CONSP (keylist); keylist = XCDR (keylist))
2474 {
2475 Lisp_Object key = XCAR (keylist);
2476
2477 if (!INTEGERP (key))
2478 continue;
2479
2480 UnregisterHotKey (hwnd, HOTKEY_ID (key));
2481 }
2482 }
2483
2484 /* Main message dispatch loop. */
2485
2486 static void
2487 w32_msg_pump (deferred_msg * msg_buf)
2488 {
2489 MSG msg;
2490 int result;
2491 HWND focus_window;
2492
2493 msh_mousewheel = RegisterWindowMessage (MSH_MOUSEWHEEL);
2494
2495 while (GetMessage (&msg, NULL, 0, 0))
2496 {
2497 if (msg.hwnd == NULL)
2498 {
2499 switch (msg.message)
2500 {
2501 case WM_NULL:
2502 /* Produced by complete_deferred_msg; just ignore. */
2503 break;
2504 case WM_EMACS_CREATEWINDOW:
2505 /* Initialize COM for this window. Even though we don't use it,
2506 some third party shell extensions can cause it to be used in
2507 system dialogs, which causes a crash if it is not initialized.
2508 This is a known bug in Windows, which was fixed long ago, but
2509 the patch for XP is not publically available until XP SP3,
2510 and older versions will never be patched. */
2511 CoInitialize (NULL);
2512 w32_createwindow ((struct frame *) msg.wParam);
2513 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0))
2514 abort ();
2515 break;
2516 case WM_EMACS_SETLOCALE:
2517 SetThreadLocale (msg.wParam);
2518 /* Reply is not expected. */
2519 break;
2520 case WM_EMACS_SETKEYBOARDLAYOUT:
2521 result = (int) ActivateKeyboardLayout ((HKL) msg.wParam, 0);
2522 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE,
2523 result, 0))
2524 abort ();
2525 break;
2526 case WM_EMACS_REGISTER_HOT_KEY:
2527 focus_window = GetFocus ();
2528 if (focus_window != NULL)
2529 RegisterHotKey (focus_window,
2530 RAW_HOTKEY_ID (msg.wParam),
2531 RAW_HOTKEY_MODIFIERS (msg.wParam),
2532 RAW_HOTKEY_VK_CODE (msg.wParam));
2533 /* Reply is not expected. */
2534 break;
2535 case WM_EMACS_UNREGISTER_HOT_KEY:
2536 focus_window = GetFocus ();
2537 if (focus_window != NULL)
2538 UnregisterHotKey (focus_window, RAW_HOTKEY_ID (msg.wParam));
2539 /* Mark item as erased. NB: this code must be
2540 thread-safe. The next line is okay because the cons
2541 cell is never made into garbage and is not relocated by
2542 GC. */
2543 XSETCAR ((Lisp_Object) ((EMACS_INT) msg.lParam), Qnil);
2544 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0))
2545 abort ();
2546 break;
2547 case WM_EMACS_TOGGLE_LOCK_KEY:
2548 {
2549 int vk_code = (int) msg.wParam;
2550 int cur_state = (GetKeyState (vk_code) & 1);
2551 Lisp_Object new_state = (Lisp_Object) ((EMACS_INT) msg.lParam);
2552
2553 /* NB: This code must be thread-safe. It is safe to
2554 call NILP because symbols are not relocated by GC,
2555 and pointer here is not touched by GC (so the markbit
2556 can't be set). Numbers are safe because they are
2557 immediate values. */
2558 if (NILP (new_state)
2559 || (NUMBERP (new_state)
2560 && ((XUINT (new_state)) & 1) != cur_state))
2561 {
2562 one_w32_display_info.faked_key = vk_code;
2563
2564 keybd_event ((BYTE) vk_code,
2565 (BYTE) MapVirtualKey (vk_code, 0),
2566 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
2567 keybd_event ((BYTE) vk_code,
2568 (BYTE) MapVirtualKey (vk_code, 0),
2569 KEYEVENTF_EXTENDEDKEY | 0, 0);
2570 keybd_event ((BYTE) vk_code,
2571 (BYTE) MapVirtualKey (vk_code, 0),
2572 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
2573 cur_state = !cur_state;
2574 }
2575 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE,
2576 cur_state, 0))
2577 abort ();
2578 }
2579 break;
2580 default:
2581 DebPrint (("msg %x not expected by w32_msg_pump\n", msg.message));
2582 }
2583 }
2584 else
2585 {
2586 DispatchMessage (&msg);
2587 }
2588
2589 /* Exit nested loop when our deferred message has completed. */
2590 if (msg_buf->completed)
2591 break;
2592 }
2593 }
2594
2595 deferred_msg * deferred_msg_head;
2596
2597 static deferred_msg *
2598 find_deferred_msg (HWND hwnd, UINT msg)
2599 {
2600 deferred_msg * item;
2601
2602 /* Don't actually need synchronization for read access, since
2603 modification of single pointer is always atomic. */
2604 /* enter_crit (); */
2605
2606 for (item = deferred_msg_head; item != NULL; item = item->next)
2607 if (item->w32msg.msg.hwnd == hwnd
2608 && item->w32msg.msg.message == msg)
2609 break;
2610
2611 /* leave_crit (); */
2612
2613 return item;
2614 }
2615
2616 static LRESULT
2617 send_deferred_msg (deferred_msg * msg_buf,
2618 HWND hwnd,
2619 UINT msg,
2620 WPARAM wParam,
2621 LPARAM lParam)
2622 {
2623 /* Only input thread can send deferred messages. */
2624 if (GetCurrentThreadId () != dwWindowsThreadId)
2625 abort ();
2626
2627 /* It is an error to send a message that is already deferred. */
2628 if (find_deferred_msg (hwnd, msg) != NULL)
2629 abort ();
2630
2631 /* Enforced synchronization is not needed because this is the only
2632 function that alters deferred_msg_head, and the following critical
2633 section is guaranteed to only be serially reentered (since only the
2634 input thread can call us). */
2635
2636 /* enter_crit (); */
2637
2638 msg_buf->completed = 0;
2639 msg_buf->next = deferred_msg_head;
2640 deferred_msg_head = msg_buf;
2641 my_post_msg (&msg_buf->w32msg, hwnd, msg, wParam, lParam);
2642
2643 /* leave_crit (); */
2644
2645 /* Start a new nested message loop to process other messages until
2646 this one is completed. */
2647 w32_msg_pump (msg_buf);
2648
2649 deferred_msg_head = msg_buf->next;
2650
2651 return msg_buf->result;
2652 }
2653
2654 void
2655 complete_deferred_msg (HWND hwnd, UINT msg, LRESULT result)
2656 {
2657 deferred_msg * msg_buf = find_deferred_msg (hwnd, msg);
2658
2659 if (msg_buf == NULL)
2660 /* Message may have been cancelled, so don't abort. */
2661 return;
2662
2663 msg_buf->result = result;
2664 msg_buf->completed = 1;
2665
2666 /* Ensure input thread is woken so it notices the completion. */
2667 PostThreadMessage (dwWindowsThreadId, WM_NULL, 0, 0);
2668 }
2669
2670 static void
2671 cancel_all_deferred_msgs ()
2672 {
2673 deferred_msg * item;
2674
2675 /* Don't actually need synchronization for read access, since
2676 modification of single pointer is always atomic. */
2677 /* enter_crit (); */
2678
2679 for (item = deferred_msg_head; item != NULL; item = item->next)
2680 {
2681 item->result = 0;
2682 item->completed = 1;
2683 }
2684
2685 /* leave_crit (); */
2686
2687 /* Ensure input thread is woken so it notices the completion. */
2688 PostThreadMessage (dwWindowsThreadId, WM_NULL, 0, 0);
2689 }
2690
2691 DWORD WINAPI
2692 w32_msg_worker (void *arg)
2693 {
2694 MSG msg;
2695 deferred_msg dummy_buf;
2696
2697 /* Ensure our message queue is created */
2698
2699 PeekMessage (&msg, NULL, 0, 0, PM_NOREMOVE);
2700
2701 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0))
2702 abort ();
2703
2704 memset (&dummy_buf, 0, sizeof (dummy_buf));
2705 dummy_buf.w32msg.msg.hwnd = NULL;
2706 dummy_buf.w32msg.msg.message = WM_NULL;
2707
2708 /* This is the inital message loop which should only exit when the
2709 application quits. */
2710 w32_msg_pump (&dummy_buf);
2711
2712 return 0;
2713 }
2714
2715 static void
2716 signal_user_input ()
2717 {
2718 /* Interrupt any lisp that wants to be interrupted by input. */
2719 if (!NILP (Vthrow_on_input))
2720 {
2721 Vquit_flag = Vthrow_on_input;
2722 /* If we're inside a function that wants immediate quits,
2723 do it now. */
2724 if (immediate_quit && NILP (Vinhibit_quit))
2725 {
2726 immediate_quit = 0;
2727 QUIT;
2728 }
2729 }
2730 }
2731
2732
2733 static void
2734 post_character_message (hwnd, msg, wParam, lParam, modifiers)
2735 HWND hwnd;
2736 UINT msg;
2737 WPARAM wParam;
2738 LPARAM lParam;
2739 DWORD modifiers;
2740
2741 {
2742 W32Msg wmsg;
2743
2744 wmsg.dwModifiers = modifiers;
2745
2746 /* Detect quit_char and set quit-flag directly. Note that we
2747 still need to post a message to ensure the main thread will be
2748 woken up if blocked in sys_select, but we do NOT want to post
2749 the quit_char message itself (because it will usually be as if
2750 the user had typed quit_char twice). Instead, we post a dummy
2751 message that has no particular effect. */
2752 {
2753 int c = wParam;
2754 if (isalpha (c) && wmsg.dwModifiers == ctrl_modifier)
2755 c = make_ctrl_char (c) & 0377;
2756 if (c == quit_char
2757 || (wmsg.dwModifiers == 0 &&
2758 w32_quit_key && wParam == w32_quit_key))
2759 {
2760 Vquit_flag = Qt;
2761
2762 /* The choice of message is somewhat arbitrary, as long as
2763 the main thread handler just ignores it. */
2764 msg = WM_NULL;
2765
2766 /* Interrupt any blocking system calls. */
2767 signal_quit ();
2768
2769 /* As a safety precaution, forcibly complete any deferred
2770 messages. This is a kludge, but I don't see any particularly
2771 clean way to handle the situation where a deferred message is
2772 "dropped" in the lisp thread, and will thus never be
2773 completed, eg. by the user trying to activate the menubar
2774 when the lisp thread is busy, and then typing C-g when the
2775 menubar doesn't open promptly (with the result that the
2776 menubar never responds at all because the deferred
2777 WM_INITMENU message is never completed). Another problem
2778 situation is when the lisp thread calls SendMessage (to send
2779 a window manager command) when a message has been deferred;
2780 the lisp thread gets blocked indefinitely waiting for the
2781 deferred message to be completed, which itself is waiting for
2782 the lisp thread to respond.
2783
2784 Note that we don't want to block the input thread waiting for
2785 a reponse from the lisp thread (although that would at least
2786 solve the deadlock problem above), because we want to be able
2787 to receive C-g to interrupt the lisp thread. */
2788 cancel_all_deferred_msgs ();
2789 }
2790 else
2791 signal_user_input ();
2792 }
2793
2794 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
2795 }
2796
2797 /* Main window procedure */
2798
2799 LRESULT CALLBACK
2800 w32_wnd_proc (hwnd, msg, wParam, lParam)
2801 HWND hwnd;
2802 UINT msg;
2803 WPARAM wParam;
2804 LPARAM lParam;
2805 {
2806 struct frame *f;
2807 struct w32_display_info *dpyinfo = &one_w32_display_info;
2808 W32Msg wmsg;
2809 int windows_translate;
2810 int key;
2811
2812 /* Note that it is okay to call x_window_to_frame, even though we are
2813 not running in the main lisp thread, because frame deletion
2814 requires the lisp thread to synchronize with this thread. Thus, if
2815 a frame struct is returned, it can be used without concern that the
2816 lisp thread might make it disappear while we are using it.
2817
2818 NB. Walking the frame list in this thread is safe (as long as
2819 writes of Lisp_Object slots are atomic, which they are on Windows).
2820 Although delete-frame can destructively modify the frame list while
2821 we are walking it, a garbage collection cannot occur until after
2822 delete-frame has synchronized with this thread.
2823
2824 It is also safe to use functions that make GDI calls, such as
2825 w32_clear_rect, because these functions must obtain a DC handle
2826 from the frame struct using get_frame_dc which is thread-aware. */
2827
2828 switch (msg)
2829 {
2830 case WM_ERASEBKGND:
2831 f = x_window_to_frame (dpyinfo, hwnd);
2832 if (f)
2833 {
2834 HDC hdc = get_frame_dc (f);
2835 GetUpdateRect (hwnd, &wmsg.rect, FALSE);
2836 w32_clear_rect (f, hdc, &wmsg.rect);
2837 release_frame_dc (f, hdc);
2838
2839 #if defined (W32_DEBUG_DISPLAY)
2840 DebPrint (("WM_ERASEBKGND (frame %p): erasing %d,%d-%d,%d\n",
2841 f,
2842 wmsg.rect.left, wmsg.rect.top,
2843 wmsg.rect.right, wmsg.rect.bottom));
2844 #endif /* W32_DEBUG_DISPLAY */
2845 }
2846 return 1;
2847 case WM_PALETTECHANGED:
2848 /* ignore our own changes */
2849 if ((HWND)wParam != hwnd)
2850 {
2851 f = x_window_to_frame (dpyinfo, hwnd);
2852 if (f)
2853 /* get_frame_dc will realize our palette and force all
2854 frames to be redrawn if needed. */
2855 release_frame_dc (f, get_frame_dc (f));
2856 }
2857 return 0;
2858 case WM_PAINT:
2859 {
2860 PAINTSTRUCT paintStruct;
2861 RECT update_rect;
2862 bzero (&update_rect, sizeof (update_rect));
2863
2864 f = x_window_to_frame (dpyinfo, hwnd);
2865 if (f == 0)
2866 {
2867 DebPrint (("WM_PAINT received for unknown window %p\n", hwnd));
2868 return 0;
2869 }
2870
2871 /* MSDN Docs say not to call BeginPaint if GetUpdateRect
2872 fails. Apparently this can happen under some
2873 circumstances. */
2874 if (GetUpdateRect (hwnd, &update_rect, FALSE) || !w32_strict_painting)
2875 {
2876 enter_crit ();
2877 BeginPaint (hwnd, &paintStruct);
2878
2879 /* The rectangles returned by GetUpdateRect and BeginPaint
2880 do not always match. Play it safe by assuming both areas
2881 are invalid. */
2882 UnionRect (&(wmsg.rect), &update_rect, &(paintStruct.rcPaint));
2883
2884 #if defined (W32_DEBUG_DISPLAY)
2885 DebPrint (("WM_PAINT (frame %p): painting %d,%d-%d,%d\n",
2886 f,
2887 wmsg.rect.left, wmsg.rect.top,
2888 wmsg.rect.right, wmsg.rect.bottom));
2889 DebPrint ((" [update region is %d,%d-%d,%d]\n",
2890 update_rect.left, update_rect.top,
2891 update_rect.right, update_rect.bottom));
2892 #endif
2893 EndPaint (hwnd, &paintStruct);
2894 leave_crit ();
2895
2896 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
2897
2898 return 0;
2899 }
2900
2901 /* If GetUpdateRect returns 0 (meaning there is no update
2902 region), assume the whole window needs to be repainted. */
2903 GetClientRect (hwnd, &wmsg.rect);
2904 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
2905 return 0;
2906 }
2907
2908 case WM_INPUTLANGCHANGE:
2909 /* Inform lisp thread of keyboard layout changes. */
2910 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
2911
2912 /* Clear dead keys in the keyboard state; for simplicity only
2913 preserve modifier key states. */
2914 {
2915 int i;
2916 BYTE keystate[256];
2917
2918 GetKeyboardState (keystate);
2919 for (i = 0; i < 256; i++)
2920 if (1
2921 && i != VK_SHIFT
2922 && i != VK_LSHIFT
2923 && i != VK_RSHIFT
2924 && i != VK_CAPITAL
2925 && i != VK_NUMLOCK
2926 && i != VK_SCROLL
2927 && i != VK_CONTROL
2928 && i != VK_LCONTROL
2929 && i != VK_RCONTROL
2930 && i != VK_MENU
2931 && i != VK_LMENU
2932 && i != VK_RMENU
2933 && i != VK_LWIN
2934 && i != VK_RWIN)
2935 keystate[i] = 0;
2936 SetKeyboardState (keystate);
2937 }
2938 goto dflt;
2939
2940 case WM_HOTKEY:
2941 /* Synchronize hot keys with normal input. */
2942 PostMessage (hwnd, WM_KEYDOWN, HIWORD (lParam), 0);
2943 return (0);
2944
2945 case WM_KEYUP:
2946 case WM_SYSKEYUP:
2947 record_keyup (wParam, lParam);
2948 goto dflt;
2949
2950 case WM_KEYDOWN:
2951 case WM_SYSKEYDOWN:
2952 /* Ignore keystrokes we fake ourself; see below. */
2953 if (dpyinfo->faked_key == wParam)
2954 {
2955 dpyinfo->faked_key = 0;
2956 /* Make sure TranslateMessage sees them though (as long as
2957 they don't produce WM_CHAR messages). This ensures that
2958 indicator lights are toggled promptly on Windows 9x, for
2959 example. */
2960 if (lispy_function_keys[wParam] != 0)
2961 {
2962 windows_translate = 1;
2963 goto translate;
2964 }
2965 return 0;
2966 }
2967
2968 /* Synchronize modifiers with current keystroke. */
2969 sync_modifiers ();
2970 record_keydown (wParam, lParam);
2971 wParam = map_keypad_keys (wParam, (lParam & 0x1000000L) != 0);
2972
2973 windows_translate = 0;
2974
2975 switch (wParam)
2976 {
2977 case VK_LWIN:
2978 if (NILP (Vw32_pass_lwindow_to_system))
2979 {
2980 /* Prevent system from acting on keyup (which opens the
2981 Start menu if no other key was pressed) by simulating a
2982 press of Space which we will ignore. */
2983 if (GetAsyncKeyState (wParam) & 1)
2984 {
2985 if (NUMBERP (Vw32_phantom_key_code))
2986 key = XUINT (Vw32_phantom_key_code) & 255;
2987 else
2988 key = VK_SPACE;
2989 dpyinfo->faked_key = key;
2990 keybd_event (key, (BYTE) MapVirtualKey (key, 0), 0, 0);
2991 }
2992 }
2993 if (!NILP (Vw32_lwindow_modifier))
2994 return 0;
2995 break;
2996 case VK_RWIN:
2997 if (NILP (Vw32_pass_rwindow_to_system))
2998 {
2999 if (GetAsyncKeyState (wParam) & 1)
3000 {
3001 if (NUMBERP (Vw32_phantom_key_code))
3002 key = XUINT (Vw32_phantom_key_code) & 255;
3003 else
3004 key = VK_SPACE;
3005 dpyinfo->faked_key = key;
3006 keybd_event (key, (BYTE) MapVirtualKey (key, 0), 0, 0);
3007 }
3008 }
3009 if (!NILP (Vw32_rwindow_modifier))
3010 return 0;
3011 break;
3012 case VK_APPS:
3013 if (!NILP (Vw32_apps_modifier))
3014 return 0;
3015 break;
3016 case VK_MENU:
3017 if (NILP (Vw32_pass_alt_to_system))
3018 /* Prevent DefWindowProc from activating the menu bar if an
3019 Alt key is pressed and released by itself. */
3020 return 0;
3021 windows_translate = 1;
3022 break;
3023 case VK_CAPITAL:
3024 /* Decide whether to treat as modifier or function key. */
3025 if (NILP (Vw32_enable_caps_lock))
3026 goto disable_lock_key;
3027 windows_translate = 1;
3028 break;
3029 case VK_NUMLOCK:
3030 /* Decide whether to treat as modifier or function key. */
3031 if (NILP (Vw32_enable_num_lock))
3032 goto disable_lock_key;
3033 windows_translate = 1;
3034 break;
3035 case VK_SCROLL:
3036 /* Decide whether to treat as modifier or function key. */
3037 if (NILP (Vw32_scroll_lock_modifier))
3038 goto disable_lock_key;
3039 windows_translate = 1;
3040 break;
3041 disable_lock_key:
3042 /* Ensure the appropriate lock key state (and indicator light)
3043 remains in the same state. We do this by faking another
3044 press of the relevant key. Apparently, this really is the
3045 only way to toggle the state of the indicator lights. */
3046 dpyinfo->faked_key = wParam;
3047 keybd_event ((BYTE) wParam, (BYTE) MapVirtualKey (wParam, 0),
3048 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
3049 keybd_event ((BYTE) wParam, (BYTE) MapVirtualKey (wParam, 0),
3050 KEYEVENTF_EXTENDEDKEY | 0, 0);
3051 keybd_event ((BYTE) wParam, (BYTE) MapVirtualKey (wParam, 0),
3052 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
3053 /* Ensure indicator lights are updated promptly on Windows 9x
3054 (TranslateMessage apparently does this), after forwarding
3055 input event. */
3056 post_character_message (hwnd, msg, wParam, lParam,
3057 w32_get_key_modifiers (wParam, lParam));
3058 windows_translate = 1;
3059 break;
3060 case VK_CONTROL:
3061 case VK_SHIFT:
3062 case VK_PROCESSKEY: /* Generated by IME. */
3063 windows_translate = 1;
3064 break;
3065 case VK_CANCEL:
3066 /* Windows maps Ctrl-Pause (aka Ctrl-Break) into VK_CANCEL,
3067 which is confusing for purposes of key binding; convert
3068 VK_CANCEL events into VK_PAUSE events. */
3069 wParam = VK_PAUSE;
3070 break;
3071 case VK_PAUSE:
3072 /* Windows maps Ctrl-NumLock into VK_PAUSE, which is confusing
3073 for purposes of key binding; convert these back into
3074 VK_NUMLOCK events, at least when we want to see NumLock key
3075 presses. (Note that there is never any possibility that
3076 VK_PAUSE with Ctrl really is C-Pause as per above.) */
3077 if (NILP (Vw32_enable_num_lock) && modifier_set (VK_CONTROL))
3078 wParam = VK_NUMLOCK;
3079 break;
3080 default:
3081 /* If not defined as a function key, change it to a WM_CHAR message. */
3082 if (lispy_function_keys[wParam] == 0)
3083 {
3084 DWORD modifiers = construct_console_modifiers ();
3085
3086 if (!NILP (Vw32_recognize_altgr)
3087 && modifier_set (VK_LCONTROL) && modifier_set (VK_RMENU))
3088 {
3089 /* Always let TranslateMessage handle AltGr key chords;
3090 for some reason, ToAscii doesn't always process AltGr
3091 chords correctly. */
3092 windows_translate = 1;
3093 }
3094 else if ((modifiers & (~SHIFT_PRESSED & ~CAPSLOCK_ON)) != 0)
3095 {
3096 /* Handle key chords including any modifiers other
3097 than shift directly, in order to preserve as much
3098 modifier information as possible. */
3099 if ('A' <= wParam && wParam <= 'Z')
3100 {
3101 /* Don't translate modified alphabetic keystrokes,
3102 so the user doesn't need to constantly switch
3103 layout to type control or meta keystrokes when
3104 the normal layout translates alphabetic
3105 characters to non-ascii characters. */
3106 if (!modifier_set (VK_SHIFT))
3107 wParam += ('a' - 'A');
3108 msg = WM_CHAR;
3109 }
3110 else
3111 {
3112 /* Try to handle other keystrokes by determining the
3113 base character (ie. translating the base key plus
3114 shift modifier). */
3115 int add;
3116 int isdead = 0;
3117 KEY_EVENT_RECORD key;
3118
3119 key.bKeyDown = TRUE;
3120 key.wRepeatCount = 1;
3121 key.wVirtualKeyCode = wParam;
3122 key.wVirtualScanCode = (lParam & 0xFF0000) >> 16;
3123 key.uChar.AsciiChar = 0;
3124 key.dwControlKeyState = modifiers;
3125
3126 add = w32_kbd_patch_key (&key);
3127 /* 0 means an unrecognised keycode, negative means
3128 dead key. Ignore both. */
3129 while (--add >= 0)
3130 {
3131 /* Forward asciified character sequence. */
3132 post_character_message
3133 (hwnd, WM_CHAR, key.uChar.AsciiChar, lParam,
3134 w32_get_key_modifiers (wParam, lParam));
3135 w32_kbd_patch_key (&key);
3136 }
3137 return 0;
3138 }
3139 }
3140 else
3141 {
3142 /* Let TranslateMessage handle everything else. */
3143 windows_translate = 1;
3144 }
3145 }
3146 }
3147
3148 translate:
3149 if (windows_translate)
3150 {
3151 MSG windows_msg = { hwnd, msg, wParam, lParam, 0, {0,0} };
3152
3153 windows_msg.time = GetMessageTime ();
3154 TranslateMessage (&windows_msg);
3155 goto dflt;
3156 }
3157
3158 /* Fall through */
3159
3160 case WM_SYSCHAR:
3161 case WM_CHAR:
3162 post_character_message (hwnd, msg, wParam, lParam,
3163 w32_get_key_modifiers (wParam, lParam));
3164 break;
3165
3166 /* Simulate middle mouse button events when left and right buttons
3167 are used together, but only if user has two button mouse. */
3168 case WM_LBUTTONDOWN:
3169 case WM_RBUTTONDOWN:
3170 if (w32_num_mouse_buttons > 2)
3171 goto handle_plain_button;
3172
3173 {
3174 int this = (msg == WM_LBUTTONDOWN) ? LMOUSE : RMOUSE;
3175 int other = (msg == WM_LBUTTONDOWN) ? RMOUSE : LMOUSE;
3176
3177 if (button_state & this)
3178 return 0;
3179
3180 if (button_state == 0)
3181 SetCapture (hwnd);
3182
3183 button_state |= this;
3184
3185 if (button_state & other)
3186 {
3187 if (mouse_button_timer)
3188 {
3189 KillTimer (hwnd, mouse_button_timer);
3190 mouse_button_timer = 0;
3191
3192 /* Generate middle mouse event instead. */
3193 msg = WM_MBUTTONDOWN;
3194 button_state |= MMOUSE;
3195 }
3196 else if (button_state & MMOUSE)
3197 {
3198 /* Ignore button event if we've already generated a
3199 middle mouse down event. This happens if the
3200 user releases and press one of the two buttons
3201 after we've faked a middle mouse event. */
3202 return 0;
3203 }
3204 else
3205 {
3206 /* Flush out saved message. */
3207 post_msg (&saved_mouse_button_msg);
3208 }
3209 wmsg.dwModifiers = w32_get_modifiers ();
3210 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3211 signal_user_input ();
3212
3213 /* Clear message buffer. */
3214 saved_mouse_button_msg.msg.hwnd = 0;
3215 }
3216 else
3217 {
3218 /* Hold onto message for now. */
3219 mouse_button_timer =
3220 SetTimer (hwnd, MOUSE_BUTTON_ID,
3221 w32_mouse_button_tolerance, NULL);
3222 saved_mouse_button_msg.msg.hwnd = hwnd;
3223 saved_mouse_button_msg.msg.message = msg;
3224 saved_mouse_button_msg.msg.wParam = wParam;
3225 saved_mouse_button_msg.msg.lParam = lParam;
3226 saved_mouse_button_msg.msg.time = GetMessageTime ();
3227 saved_mouse_button_msg.dwModifiers = w32_get_modifiers ();
3228 }
3229 }
3230 return 0;
3231
3232 case WM_LBUTTONUP:
3233 case WM_RBUTTONUP:
3234 if (w32_num_mouse_buttons > 2)
3235 goto handle_plain_button;
3236
3237 {
3238 int this = (msg == WM_LBUTTONUP) ? LMOUSE : RMOUSE;
3239 int other = (msg == WM_LBUTTONUP) ? RMOUSE : LMOUSE;
3240
3241 if ((button_state & this) == 0)
3242 return 0;
3243
3244 button_state &= ~this;
3245
3246 if (button_state & MMOUSE)
3247 {
3248 /* Only generate event when second button is released. */
3249 if ((button_state & other) == 0)
3250 {
3251 msg = WM_MBUTTONUP;
3252 button_state &= ~MMOUSE;
3253
3254 if (button_state) abort ();
3255 }
3256 else
3257 return 0;
3258 }
3259 else
3260 {
3261 /* Flush out saved message if necessary. */
3262 if (saved_mouse_button_msg.msg.hwnd)
3263 {
3264 post_msg (&saved_mouse_button_msg);
3265 }
3266 }
3267 wmsg.dwModifiers = w32_get_modifiers ();
3268 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3269 signal_user_input ();
3270
3271 /* Always clear message buffer and cancel timer. */
3272 saved_mouse_button_msg.msg.hwnd = 0;
3273 KillTimer (hwnd, mouse_button_timer);
3274 mouse_button_timer = 0;
3275
3276 if (button_state == 0)
3277 ReleaseCapture ();
3278 }
3279 return 0;
3280
3281 case WM_XBUTTONDOWN:
3282 case WM_XBUTTONUP:
3283 if (w32_pass_extra_mouse_buttons_to_system)
3284 goto dflt;
3285 /* else fall through and process them. */
3286 case WM_MBUTTONDOWN:
3287 case WM_MBUTTONUP:
3288 handle_plain_button:
3289 {
3290 BOOL up;
3291 int button;
3292
3293 /* Ignore middle and extra buttons as long as the menu is active. */
3294 f = x_window_to_frame (dpyinfo, hwnd);
3295 if (f && f->output_data.w32->menubar_active)
3296 return 0;
3297
3298 if (parse_button (msg, HIWORD (wParam), &button, &up))
3299 {
3300 if (up) ReleaseCapture ();
3301 else SetCapture (hwnd);
3302 button = (button == 0) ? LMOUSE :
3303 ((button == 1) ? MMOUSE : RMOUSE);
3304 if (up)
3305 button_state &= ~button;
3306 else
3307 button_state |= button;
3308 }
3309 }
3310
3311 wmsg.dwModifiers = w32_get_modifiers ();
3312 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3313 signal_user_input ();
3314
3315 /* Need to return true for XBUTTON messages, false for others,
3316 to indicate that we processed the message. */
3317 return (msg == WM_XBUTTONDOWN || msg == WM_XBUTTONUP);
3318
3319 case WM_MOUSEMOVE:
3320 /* Ignore mouse movements as long as the menu is active. These
3321 movements are processed by the window manager anyway, and
3322 it's wrong to handle them as if they happened on the
3323 underlying frame. */
3324 f = x_window_to_frame (dpyinfo, hwnd);
3325 if (f && f->output_data.w32->menubar_active)
3326 return 0;
3327
3328 /* If the mouse has just moved into the frame, start tracking
3329 it, so we will be notified when it leaves the frame. Mouse
3330 tracking only works under W98 and NT4 and later. On earlier
3331 versions, there is no way of telling when the mouse leaves the
3332 frame, so we just have to put up with help-echo and mouse
3333 highlighting remaining while the frame is not active. */
3334 if (track_mouse_event_fn && !track_mouse_window)
3335 {
3336 TRACKMOUSEEVENT tme;
3337 tme.cbSize = sizeof (tme);
3338 tme.dwFlags = TME_LEAVE;
3339 tme.hwndTrack = hwnd;
3340
3341 track_mouse_event_fn (&tme);
3342 track_mouse_window = hwnd;
3343 }
3344 case WM_VSCROLL:
3345 if (w32_mouse_move_interval <= 0
3346 || (msg == WM_MOUSEMOVE && button_state == 0))
3347 {
3348 wmsg.dwModifiers = w32_get_modifiers ();
3349 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3350 return 0;
3351 }
3352
3353 /* Hang onto mouse move and scroll messages for a bit, to avoid
3354 sending such events to Emacs faster than it can process them.
3355 If we get more events before the timer from the first message
3356 expires, we just replace the first message. */
3357
3358 if (saved_mouse_move_msg.msg.hwnd == 0)
3359 mouse_move_timer =
3360 SetTimer (hwnd, MOUSE_MOVE_ID,
3361 w32_mouse_move_interval, NULL);
3362
3363 /* Hold onto message for now. */
3364 saved_mouse_move_msg.msg.hwnd = hwnd;
3365 saved_mouse_move_msg.msg.message = msg;
3366 saved_mouse_move_msg.msg.wParam = wParam;
3367 saved_mouse_move_msg.msg.lParam = lParam;
3368 saved_mouse_move_msg.msg.time = GetMessageTime ();
3369 saved_mouse_move_msg.dwModifiers = w32_get_modifiers ();
3370
3371 return 0;
3372
3373 case WM_MOUSEWHEEL:
3374 case WM_DROPFILES:
3375 wmsg.dwModifiers = w32_get_modifiers ();
3376 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3377 signal_user_input ();
3378 return 0;
3379
3380 case WM_APPCOMMAND:
3381 if (w32_pass_multimedia_buttons_to_system)
3382 goto dflt;
3383 /* Otherwise, pass to lisp, the same way we do with mousehwheel. */
3384 case WM_MOUSEHWHEEL:
3385 wmsg.dwModifiers = w32_get_modifiers ();
3386 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3387 signal_user_input ();
3388 /* Non-zero must be returned when WM_MOUSEHWHEEL messages are
3389 handled, to prevent the system trying to handle it by faking
3390 scroll bar events. */
3391 return 1;
3392
3393 case WM_TIMER:
3394 /* Flush out saved messages if necessary. */
3395 if (wParam == mouse_button_timer)
3396 {
3397 if (saved_mouse_button_msg.msg.hwnd)
3398 {
3399 post_msg (&saved_mouse_button_msg);
3400 signal_user_input ();
3401 saved_mouse_button_msg.msg.hwnd = 0;
3402 }
3403 KillTimer (hwnd, mouse_button_timer);
3404 mouse_button_timer = 0;
3405 }
3406 else if (wParam == mouse_move_timer)
3407 {
3408 if (saved_mouse_move_msg.msg.hwnd)
3409 {
3410 post_msg (&saved_mouse_move_msg);
3411 saved_mouse_move_msg.msg.hwnd = 0;
3412 }
3413 KillTimer (hwnd, mouse_move_timer);
3414 mouse_move_timer = 0;
3415 }
3416 else if (wParam == menu_free_timer)
3417 {
3418 KillTimer (hwnd, menu_free_timer);
3419 menu_free_timer = 0;
3420 f = x_window_to_frame (dpyinfo, hwnd);
3421 /* If a popup menu is active, don't wipe its strings. */
3422 if (menubar_in_use
3423 && current_popup_menu == NULL)
3424 {
3425 /* Free memory used by owner-drawn and help-echo strings. */
3426 w32_free_menu_strings (hwnd);
3427 f->output_data.w32->menubar_active = 0;
3428 menubar_in_use = 0;
3429 }
3430 }
3431 return 0;
3432
3433 case WM_NCACTIVATE:
3434 /* Windows doesn't send us focus messages when putting up and
3435 taking down a system popup dialog as for Ctrl-Alt-Del on Windows 95.
3436 The only indication we get that something happened is receiving
3437 this message afterwards. So this is a good time to reset our
3438 keyboard modifiers' state. */
3439 reset_modifiers ();
3440 goto dflt;
3441
3442 case WM_INITMENU:
3443 button_state = 0;
3444 ReleaseCapture ();
3445 /* We must ensure menu bar is fully constructed and up to date
3446 before allowing user interaction with it. To achieve this
3447 we send this message to the lisp thread and wait for a
3448 reply (whose value is not actually needed) to indicate that
3449 the menu bar is now ready for use, so we can now return.
3450
3451 To remain responsive in the meantime, we enter a nested message
3452 loop that can process all other messages.
3453
3454 However, we skip all this if the message results from calling
3455 TrackPopupMenu - in fact, we must NOT attempt to send the lisp
3456 thread a message because it is blocked on us at this point. We
3457 set menubar_active before calling TrackPopupMenu to indicate
3458 this (there is no possibility of confusion with real menubar
3459 being active). */
3460
3461 f = x_window_to_frame (dpyinfo, hwnd);
3462 if (f
3463 && (f->output_data.w32->menubar_active
3464 /* We can receive this message even in the absence of a
3465 menubar (ie. when the system menu is activated) - in this
3466 case we do NOT want to forward the message, otherwise it
3467 will cause the menubar to suddenly appear when the user
3468 had requested it to be turned off! */
3469 || f->output_data.w32->menubar_widget == NULL))
3470 return 0;
3471
3472 {
3473 deferred_msg msg_buf;
3474
3475 /* Detect if message has already been deferred; in this case
3476 we cannot return any sensible value to ignore this. */
3477 if (find_deferred_msg (hwnd, msg) != NULL)
3478 abort ();
3479
3480 menubar_in_use = 1;
3481
3482 return send_deferred_msg (&msg_buf, hwnd, msg, wParam, lParam);
3483 }
3484
3485 case WM_EXITMENULOOP:
3486 f = x_window_to_frame (dpyinfo, hwnd);
3487
3488 /* If a menu is still active, check again after a short delay,
3489 since Windows often (always?) sends the WM_EXITMENULOOP
3490 before the corresponding WM_COMMAND message.
3491 Don't do this if a popup menu is active, since it is only
3492 menubar menus that require cleaning up in this way.
3493 */
3494 if (f && menubar_in_use && current_popup_menu == NULL)
3495 menu_free_timer = SetTimer (hwnd, MENU_FREE_ID, MENU_FREE_DELAY, NULL);
3496 goto dflt;
3497
3498 case WM_MENUSELECT:
3499 /* Direct handling of help_echo in menus. Should be safe now
3500 that we generate the help_echo by placing a help event in the
3501 keyboard buffer. */
3502 {
3503 HMENU menu = (HMENU) lParam;
3504 UINT menu_item = (UINT) LOWORD (wParam);
3505 UINT flags = (UINT) HIWORD (wParam);
3506
3507 w32_menu_display_help (hwnd, menu, menu_item, flags);
3508 }
3509 return 0;
3510
3511 case WM_MEASUREITEM:
3512 f = x_window_to_frame (dpyinfo, hwnd);
3513 if (f)
3514 {
3515 MEASUREITEMSTRUCT * pMis = (MEASUREITEMSTRUCT *) lParam;
3516
3517 if (pMis->CtlType == ODT_MENU)
3518 {
3519 /* Work out dimensions for popup menu titles. */
3520 char * title = (char *) pMis->itemData;
3521 HDC hdc = GetDC (hwnd);
3522 HFONT menu_font = GetCurrentObject (hdc, OBJ_FONT);
3523 LOGFONT menu_logfont;
3524 HFONT old_font;
3525 SIZE size;
3526
3527 GetObject (menu_font, sizeof (menu_logfont), &menu_logfont);
3528 menu_logfont.lfWeight = FW_BOLD;
3529 menu_font = CreateFontIndirect (&menu_logfont);
3530 old_font = SelectObject (hdc, menu_font);
3531
3532 pMis->itemHeight = GetSystemMetrics (SM_CYMENUSIZE);
3533 if (title)
3534 {
3535 if (unicode_append_menu)
3536 GetTextExtentPoint32W (hdc, (WCHAR *) title,
3537 wcslen ((WCHAR *) title),
3538 &size);
3539 else
3540 GetTextExtentPoint32 (hdc, title, strlen (title), &size);
3541
3542 pMis->itemWidth = size.cx;
3543 if (pMis->itemHeight < size.cy)
3544 pMis->itemHeight = size.cy;
3545 }
3546 else
3547 pMis->itemWidth = 0;
3548
3549 SelectObject (hdc, old_font);
3550 DeleteObject (menu_font);
3551 ReleaseDC (hwnd, hdc);
3552 return TRUE;
3553 }
3554 }
3555 return 0;
3556
3557 case WM_DRAWITEM:
3558 f = x_window_to_frame (dpyinfo, hwnd);
3559 if (f)
3560 {
3561 DRAWITEMSTRUCT * pDis = (DRAWITEMSTRUCT *) lParam;
3562
3563 if (pDis->CtlType == ODT_MENU)
3564 {
3565 /* Draw popup menu title. */
3566 char * title = (char *) pDis->itemData;
3567 if (title)
3568 {
3569 HDC hdc = pDis->hDC;
3570 HFONT menu_font = GetCurrentObject (hdc, OBJ_FONT);
3571 LOGFONT menu_logfont;
3572 HFONT old_font;
3573
3574 GetObject (menu_font, sizeof (menu_logfont), &menu_logfont);
3575 menu_logfont.lfWeight = FW_BOLD;
3576 menu_font = CreateFontIndirect (&menu_logfont);
3577 old_font = SelectObject (hdc, menu_font);
3578
3579 /* Always draw title as if not selected. */
3580 if (unicode_append_menu)
3581 ExtTextOutW (hdc,
3582 pDis->rcItem.left
3583 + GetSystemMetrics (SM_CXMENUCHECK),
3584 pDis->rcItem.top,
3585 ETO_OPAQUE, &pDis->rcItem,
3586 (WCHAR *) title,
3587 wcslen ((WCHAR *) title), NULL);
3588 else
3589 ExtTextOut (hdc,
3590 pDis->rcItem.left
3591 + GetSystemMetrics (SM_CXMENUCHECK),
3592 pDis->rcItem.top,
3593 ETO_OPAQUE, &pDis->rcItem,
3594 title, strlen (title), NULL);
3595
3596 SelectObject (hdc, old_font);
3597 DeleteObject (menu_font);
3598 }
3599 return TRUE;
3600 }
3601 }
3602 return 0;
3603
3604 #if 0
3605 /* Still not right - can't distinguish between clicks in the
3606 client area of the frame from clicks forwarded from the scroll
3607 bars - may have to hook WM_NCHITTEST to remember the mouse
3608 position and then check if it is in the client area ourselves. */
3609 case WM_MOUSEACTIVATE:
3610 /* Discard the mouse click that activates a frame, allowing the
3611 user to click anywhere without changing point (or worse!).
3612 Don't eat mouse clicks on scrollbars though!! */
3613 if (LOWORD (lParam) == HTCLIENT )
3614 return MA_ACTIVATEANDEAT;
3615 goto dflt;
3616 #endif
3617
3618 case WM_MOUSELEAVE:
3619 /* No longer tracking mouse. */
3620 track_mouse_window = NULL;
3621
3622 case WM_ACTIVATEAPP:
3623 case WM_ACTIVATE:
3624 case WM_WINDOWPOSCHANGED:
3625 case WM_SHOWWINDOW:
3626 /* Inform lisp thread that a frame might have just been obscured
3627 or exposed, so should recheck visibility of all frames. */
3628 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3629 goto dflt;
3630
3631 case WM_SETFOCUS:
3632 dpyinfo->faked_key = 0;
3633 reset_modifiers ();
3634 register_hot_keys (hwnd);
3635 goto command;
3636 case WM_KILLFOCUS:
3637 unregister_hot_keys (hwnd);
3638 button_state = 0;
3639 ReleaseCapture ();
3640 /* Relinquish the system caret. */
3641 if (w32_system_caret_hwnd)
3642 {
3643 w32_visible_system_caret_hwnd = NULL;
3644 w32_system_caret_hwnd = NULL;
3645 DestroyCaret ();
3646 }
3647 goto command;
3648 case WM_COMMAND:
3649 menubar_in_use = 0;
3650 f = x_window_to_frame (dpyinfo, hwnd);
3651 if (f && HIWORD (wParam) == 0)
3652 {
3653 if (menu_free_timer)
3654 {
3655 KillTimer (hwnd, menu_free_timer);
3656 menu_free_timer = 0;
3657 }
3658 }
3659 case WM_MOVE:
3660 case WM_SIZE:
3661 command:
3662 wmsg.dwModifiers = w32_get_modifiers ();
3663 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3664 goto dflt;
3665
3666 case WM_DESTROY:
3667 CoUninitialize ();
3668 return 0;
3669
3670 case WM_CLOSE:
3671 wmsg.dwModifiers = w32_get_modifiers ();
3672 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3673 return 0;
3674
3675 case WM_WINDOWPOSCHANGING:
3676 /* Don't restrict the sizing of tip frames. */
3677 if (hwnd == tip_window)
3678 return 0;
3679 {
3680 WINDOWPLACEMENT wp;
3681 LPWINDOWPOS lppos = (WINDOWPOS *) lParam;
3682
3683 wp.length = sizeof (WINDOWPLACEMENT);
3684 GetWindowPlacement (hwnd, &wp);
3685
3686 if (wp.showCmd != SW_SHOWMINIMIZED && (lppos->flags & SWP_NOSIZE) == 0)
3687 {
3688 RECT rect;
3689 int wdiff;
3690 int hdiff;
3691 DWORD font_width;
3692 DWORD line_height;
3693 DWORD internal_border;
3694 DWORD scrollbar_extra;
3695 RECT wr;
3696
3697 wp.length = sizeof (wp);
3698 GetWindowRect (hwnd, &wr);
3699
3700 enter_crit ();
3701
3702 font_width = GetWindowLong (hwnd, WND_FONTWIDTH_INDEX);
3703 line_height = GetWindowLong (hwnd, WND_LINEHEIGHT_INDEX);
3704 internal_border = GetWindowLong (hwnd, WND_BORDER_INDEX);
3705 scrollbar_extra = GetWindowLong (hwnd, WND_SCROLLBAR_INDEX);
3706
3707 leave_crit ();
3708
3709 memset (&rect, 0, sizeof (rect));
3710 AdjustWindowRect (&rect, GetWindowLong (hwnd, GWL_STYLE),
3711 GetMenu (hwnd) != NULL);
3712
3713 /* Force width and height of client area to be exact
3714 multiples of the character cell dimensions. */
3715 wdiff = (lppos->cx - (rect.right - rect.left)
3716 - 2 * internal_border - scrollbar_extra)
3717 % font_width;
3718 hdiff = (lppos->cy - (rect.bottom - rect.top)
3719 - 2 * internal_border)
3720 % line_height;
3721
3722 if (wdiff || hdiff)
3723 {
3724 /* For right/bottom sizing we can just fix the sizes.
3725 However for top/left sizing we will need to fix the X
3726 and Y positions as well. */
3727
3728 int cx_mintrack = GetSystemMetrics (SM_CXMINTRACK);
3729 int cy_mintrack = GetSystemMetrics (SM_CYMINTRACK);
3730
3731 lppos->cx = max (lppos->cx - wdiff, cx_mintrack);
3732 lppos->cy = max (lppos->cy - hdiff, cy_mintrack);
3733
3734 if (wp.showCmd != SW_SHOWMAXIMIZED
3735 && (lppos->flags & SWP_NOMOVE) == 0)
3736 {
3737 if (lppos->x != wr.left || lppos->y != wr.top)
3738 {
3739 lppos->x += wdiff;
3740 lppos->y += hdiff;
3741 }
3742 else
3743 {
3744 lppos->flags |= SWP_NOMOVE;
3745 }
3746 }
3747
3748 return 0;
3749 }
3750 }
3751 }
3752
3753 goto dflt;
3754
3755 case WM_GETMINMAXINFO:
3756 /* Hack to allow resizing the Emacs frame above the screen size.
3757 Note that Windows 9x limits coordinates to 16-bits. */
3758 ((LPMINMAXINFO) lParam)->ptMaxTrackSize.x = 32767;
3759 ((LPMINMAXINFO) lParam)->ptMaxTrackSize.y = 32767;
3760 return 0;
3761
3762 case WM_SETCURSOR:
3763 if (LOWORD (lParam) == HTCLIENT)
3764 return 0;
3765
3766 goto dflt;
3767
3768 case WM_EMACS_SETCURSOR:
3769 {
3770 Cursor cursor = (Cursor) wParam;
3771 if (cursor)
3772 SetCursor (cursor);
3773 return 0;
3774 }
3775
3776 case WM_EMACS_CREATESCROLLBAR:
3777 return (LRESULT) w32_createscrollbar ((struct frame *) wParam,
3778 (struct scroll_bar *) lParam);
3779
3780 case WM_EMACS_SHOWWINDOW:
3781 return ShowWindow ((HWND) wParam, (WPARAM) lParam);
3782
3783 case WM_EMACS_SETFOREGROUND:
3784 {
3785 HWND foreground_window;
3786 DWORD foreground_thread, retval;
3787
3788 /* On NT 5.0, and apparently Windows 98, it is necessary to
3789 attach to the thread that currently has focus in order to
3790 pull the focus away from it. */
3791 foreground_window = GetForegroundWindow ();
3792 foreground_thread = GetWindowThreadProcessId (foreground_window, NULL);
3793 if (!foreground_window
3794 || foreground_thread == GetCurrentThreadId ()
3795 || !AttachThreadInput (GetCurrentThreadId (),
3796 foreground_thread, TRUE))
3797 foreground_thread = 0;
3798
3799 retval = SetForegroundWindow ((HWND) wParam);
3800
3801 /* Detach from the previous foreground thread. */
3802 if (foreground_thread)
3803 AttachThreadInput (GetCurrentThreadId (),
3804 foreground_thread, FALSE);
3805
3806 return retval;
3807 }
3808
3809 case WM_EMACS_SETWINDOWPOS:
3810 {
3811 WINDOWPOS * pos = (WINDOWPOS *) wParam;
3812 return SetWindowPos (hwnd, pos->hwndInsertAfter,
3813 pos->x, pos->y, pos->cx, pos->cy, pos->flags);
3814 }
3815
3816 case WM_EMACS_DESTROYWINDOW:
3817 DragAcceptFiles ((HWND) wParam, FALSE);
3818 return DestroyWindow ((HWND) wParam);
3819
3820 case WM_EMACS_HIDE_CARET:
3821 return HideCaret (hwnd);
3822
3823 case WM_EMACS_SHOW_CARET:
3824 return ShowCaret (hwnd);
3825
3826 case WM_EMACS_DESTROY_CARET:
3827 w32_system_caret_hwnd = NULL;
3828 w32_visible_system_caret_hwnd = NULL;
3829 return DestroyCaret ();
3830
3831 case WM_EMACS_TRACK_CARET:
3832 /* If there is currently no system caret, create one. */
3833 if (w32_system_caret_hwnd == NULL)
3834 {
3835 /* Use the default caret width, and avoid changing it
3836 unneccesarily, as it confuses screen reader software. */
3837 w32_system_caret_hwnd = hwnd;
3838 CreateCaret (hwnd, NULL, 0,
3839 w32_system_caret_height);
3840 }
3841
3842 if (!SetCaretPos (w32_system_caret_x, w32_system_caret_y))
3843 return 0;
3844 /* Ensure visible caret gets turned on when requested. */
3845 else if (w32_use_visible_system_caret
3846 && w32_visible_system_caret_hwnd != hwnd)
3847 {
3848 w32_visible_system_caret_hwnd = hwnd;
3849 return ShowCaret (hwnd);
3850 }
3851 /* Ensure visible caret gets turned off when requested. */
3852 else if (!w32_use_visible_system_caret
3853 && w32_visible_system_caret_hwnd)
3854 {
3855 w32_visible_system_caret_hwnd = NULL;
3856 return HideCaret (hwnd);
3857 }
3858 else
3859 return 1;
3860
3861 case WM_EMACS_TRACKPOPUPMENU:
3862 {
3863 UINT flags;
3864 POINT *pos;
3865 int retval;
3866 pos = (POINT *)lParam;
3867 flags = TPM_CENTERALIGN;
3868 if (button_state & LMOUSE)
3869 flags |= TPM_LEFTBUTTON;
3870 else if (button_state & RMOUSE)
3871 flags |= TPM_RIGHTBUTTON;
3872
3873 /* Remember we did a SetCapture on the initial mouse down event,
3874 so for safety, we make sure the capture is cancelled now. */
3875 ReleaseCapture ();
3876 button_state = 0;
3877
3878 /* Use menubar_active to indicate that WM_INITMENU is from
3879 TrackPopupMenu below, and should be ignored. */
3880 f = x_window_to_frame (dpyinfo, hwnd);
3881 if (f)
3882 f->output_data.w32->menubar_active = 1;
3883
3884 if (TrackPopupMenu ((HMENU)wParam, flags, pos->x, pos->y,
3885 0, hwnd, NULL))
3886 {
3887 MSG amsg;
3888 /* Eat any mouse messages during popupmenu */
3889 while (PeekMessage (&amsg, hwnd, WM_MOUSEFIRST, WM_MOUSELAST,
3890 PM_REMOVE));
3891 /* Get the menu selection, if any */
3892 if (PeekMessage (&amsg, hwnd, WM_COMMAND, WM_COMMAND, PM_REMOVE))
3893 {
3894 retval = LOWORD (amsg.wParam);
3895 }
3896 else
3897 {
3898 retval = 0;
3899 }
3900 }
3901 else
3902 {
3903 retval = -1;
3904 }
3905
3906 return retval;
3907 }
3908
3909 default:
3910 /* Check for messages registered at runtime. */
3911 if (msg == msh_mousewheel)
3912 {
3913 wmsg.dwModifiers = w32_get_modifiers ();
3914 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3915 signal_user_input ();
3916 return 0;
3917 }
3918
3919 dflt:
3920 return DefWindowProc (hwnd, msg, wParam, lParam);
3921 }
3922
3923
3924 /* The most common default return code for handled messages is 0. */
3925 return 0;
3926 }
3927
3928 static void
3929 my_create_window (f)
3930 struct frame * f;
3931 {
3932 MSG msg;
3933
3934 if (!PostThreadMessage (dwWindowsThreadId, WM_EMACS_CREATEWINDOW, (WPARAM)f, 0))
3935 abort ();
3936 GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
3937 }
3938
3939
3940 /* Create a tooltip window. Unlike my_create_window, we do not do this
3941 indirectly via the Window thread, as we do not need to process Window
3942 messages for the tooltip. Creating tooltips indirectly also creates
3943 deadlocks when tooltips are created for menu items. */
3944 static void
3945 my_create_tip_window (f)
3946 struct frame *f;
3947 {
3948 RECT rect;
3949
3950 rect.left = rect.top = 0;
3951 rect.right = FRAME_PIXEL_WIDTH (f);
3952 rect.bottom = FRAME_PIXEL_HEIGHT (f);
3953
3954 AdjustWindowRect (&rect, f->output_data.w32->dwStyle,
3955 FRAME_EXTERNAL_MENU_BAR (f));
3956
3957 tip_window = FRAME_W32_WINDOW (f)
3958 = CreateWindow (EMACS_CLASS,
3959 f->namebuf,
3960 f->output_data.w32->dwStyle,
3961 f->left_pos,
3962 f->top_pos,
3963 rect.right - rect.left,
3964 rect.bottom - rect.top,
3965 FRAME_W32_WINDOW (SELECTED_FRAME ()), /* owner */
3966 NULL,
3967 hinst,
3968 NULL);
3969
3970 if (tip_window)
3971 {
3972 SetWindowLong (tip_window, WND_FONTWIDTH_INDEX, FRAME_COLUMN_WIDTH (f));
3973 SetWindowLong (tip_window, WND_LINEHEIGHT_INDEX, FRAME_LINE_HEIGHT (f));
3974 SetWindowLong (tip_window, WND_BORDER_INDEX, FRAME_INTERNAL_BORDER_WIDTH (f));
3975 SetWindowLong (tip_window, WND_BACKGROUND_INDEX, FRAME_BACKGROUND_PIXEL (f));
3976
3977 /* Tip frames have no scrollbars. */
3978 SetWindowLong (tip_window, WND_SCROLLBAR_INDEX, 0);
3979
3980 /* Do this to discard the default setting specified by our parent. */
3981 ShowWindow (tip_window, SW_HIDE);
3982 }
3983 }
3984
3985
3986 /* Create and set up the w32 window for frame F. */
3987
3988 static void
3989 w32_window (f, window_prompting, minibuffer_only)
3990 struct frame *f;
3991 long window_prompting;
3992 int minibuffer_only;
3993 {
3994 BLOCK_INPUT;
3995
3996 /* Use the resource name as the top-level window name
3997 for looking up resources. Make a non-Lisp copy
3998 for the window manager, so GC relocation won't bother it.
3999
4000 Elsewhere we specify the window name for the window manager. */
4001
4002 {
4003 char *str = (char *) SDATA (Vx_resource_name);
4004 f->namebuf = (char *) xmalloc (strlen (str) + 1);
4005 strcpy (f->namebuf, str);
4006 }
4007
4008 my_create_window (f);
4009
4010 validate_x_resource_name ();
4011
4012 /* x_set_name normally ignores requests to set the name if the
4013 requested name is the same as the current name. This is the one
4014 place where that assumption isn't correct; f->name is set, but
4015 the server hasn't been told. */
4016 {
4017 Lisp_Object name;
4018 int explicit = f->explicit_name;
4019
4020 f->explicit_name = 0;
4021 name = f->name;
4022 f->name = Qnil;
4023 x_set_name (f, name, explicit);
4024 }
4025
4026 UNBLOCK_INPUT;
4027
4028 if (!minibuffer_only && FRAME_EXTERNAL_MENU_BAR (f))
4029 initialize_frame_menubar (f);
4030
4031 if (FRAME_W32_WINDOW (f) == 0)
4032 error ("Unable to create window");
4033 }
4034
4035 /* Handle the icon stuff for this window. Perhaps later we might
4036 want an x_set_icon_position which can be called interactively as
4037 well. */
4038
4039 static void
4040 x_icon (f, parms)
4041 struct frame *f;
4042 Lisp_Object parms;
4043 {
4044 Lisp_Object icon_x, icon_y;
4045
4046 /* Set the position of the icon. Note that Windows 95 groups all
4047 icons in the tray. */
4048 icon_x = w32_get_arg (parms, Qicon_left, 0, 0, RES_TYPE_NUMBER);
4049 icon_y = w32_get_arg (parms, Qicon_top, 0, 0, RES_TYPE_NUMBER);
4050 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
4051 {
4052 CHECK_NUMBER (icon_x);
4053 CHECK_NUMBER (icon_y);
4054 }
4055 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
4056 error ("Both left and top icon corners of icon must be specified");
4057
4058 BLOCK_INPUT;
4059
4060 if (! EQ (icon_x, Qunbound))
4061 x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y));
4062
4063 #if 0 /* TODO */
4064 /* Start up iconic or window? */
4065 x_wm_set_window_state
4066 (f, (EQ (w32_get_arg (parms, Qvisibility, 0, 0, RES_TYPE_SYMBOL), Qicon)
4067 ? IconicState
4068 : NormalState));
4069
4070 x_text_icon (f, (char *) SDATA ((!NILP (f->icon_name)
4071 ? f->icon_name
4072 : f->name)));
4073 #endif
4074
4075 UNBLOCK_INPUT;
4076 }
4077
4078
4079 static void
4080 x_make_gc (f)
4081 struct frame *f;
4082 {
4083 XGCValues gc_values;
4084
4085 BLOCK_INPUT;
4086
4087 /* Create the GC's of this frame.
4088 Note that many default values are used. */
4089
4090 /* Normal video */
4091 gc_values.font = FRAME_FONT (f);
4092
4093 /* Cursor has cursor-color background, background-color foreground. */
4094 gc_values.foreground = FRAME_BACKGROUND_PIXEL (f);
4095 gc_values.background = f->output_data.w32->cursor_pixel;
4096 f->output_data.w32->cursor_gc
4097 = XCreateGC (NULL, FRAME_W32_WINDOW (f),
4098 (GCFont | GCForeground | GCBackground),
4099 &gc_values);
4100
4101 /* Reliefs. */
4102 f->output_data.w32->white_relief.gc = 0;
4103 f->output_data.w32->black_relief.gc = 0;
4104
4105 UNBLOCK_INPUT;
4106 }
4107
4108
4109 /* Handler for signals raised during x_create_frame and
4110 x_create_top_frame. FRAME is the frame which is partially
4111 constructed. */
4112
4113 static Lisp_Object
4114 unwind_create_frame (frame)
4115 Lisp_Object frame;
4116 {
4117 struct frame *f = XFRAME (frame);
4118
4119 /* If frame is ``official'', nothing to do. */
4120 if (!CONSP (Vframe_list) || !EQ (XCAR (Vframe_list), frame))
4121 {
4122 #ifdef GLYPH_DEBUG
4123 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
4124 #endif
4125
4126 x_free_frame_resources (f);
4127
4128 /* Check that reference counts are indeed correct. */
4129 xassert (dpyinfo->reference_count == dpyinfo_refcount);
4130 xassert (dpyinfo->image_cache->refcount == image_cache_refcount);
4131
4132 return Qt;
4133 }
4134
4135 return Qnil;
4136 }
4137
4138
4139 DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
4140 1, 1, 0,
4141 doc: /* Make a new window, which is called a \"frame\" in Emacs terms.
4142 Return an Emacs frame object.
4143 PARAMETERS is an alist of frame parameters.
4144 If the parameters specify that the frame should not have a minibuffer,
4145 and do not specify a specific minibuffer window to use,
4146 then `default-minibuffer-frame' must be a frame whose minibuffer can
4147 be shared by the new frame.
4148
4149 This function is an internal primitive--use `make-frame' instead. */)
4150 (parameters)
4151 Lisp_Object parameters;
4152 {
4153 struct frame *f;
4154 Lisp_Object frame, tem;
4155 Lisp_Object name;
4156 int minibuffer_only = 0;
4157 long window_prompting = 0;
4158 int width, height;
4159 int count = SPECPDL_INDEX ();
4160 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
4161 Lisp_Object display;
4162 struct w32_display_info *dpyinfo = NULL;
4163 Lisp_Object parent;
4164 struct kboard *kb;
4165
4166 check_w32 ();
4167
4168 /* Use this general default value to start with
4169 until we know if this frame has a specified name. */
4170 Vx_resource_name = Vinvocation_name;
4171
4172 display = w32_get_arg (parameters, Qdisplay, 0, 0, RES_TYPE_STRING);
4173 if (EQ (display, Qunbound))
4174 display = Qnil;
4175 dpyinfo = check_x_display_info (display);
4176 #ifdef MULTI_KBOARD
4177 kb = dpyinfo->terminal->kboard;
4178 #else
4179 kb = &the_only_kboard;
4180 #endif
4181
4182 name = w32_get_arg (parameters, Qname, "name", "Name", RES_TYPE_STRING);
4183 if (!STRINGP (name)
4184 && ! EQ (name, Qunbound)
4185 && ! NILP (name))
4186 error ("Invalid frame name--not a string or nil");
4187
4188 if (STRINGP (name))
4189 Vx_resource_name = name;
4190
4191 /* See if parent window is specified. */
4192 parent = w32_get_arg (parameters, Qparent_id, NULL, NULL, RES_TYPE_NUMBER);
4193 if (EQ (parent, Qunbound))
4194 parent = Qnil;
4195 if (! NILP (parent))
4196 CHECK_NUMBER (parent);
4197
4198 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
4199 /* No need to protect DISPLAY because that's not used after passing
4200 it to make_frame_without_minibuffer. */
4201 frame = Qnil;
4202 GCPRO4 (parameters, parent, name, frame);
4203 tem = w32_get_arg (parameters, Qminibuffer, "minibuffer", "Minibuffer",
4204 RES_TYPE_SYMBOL);
4205 if (EQ (tem, Qnone) || NILP (tem))
4206 f = make_frame_without_minibuffer (Qnil, kb, display);
4207 else if (EQ (tem, Qonly))
4208 {
4209 f = make_minibuffer_frame ();
4210 minibuffer_only = 1;
4211 }
4212 else if (WINDOWP (tem))
4213 f = make_frame_without_minibuffer (tem, kb, display);
4214 else
4215 f = make_frame (1);
4216
4217 XSETFRAME (frame, f);
4218
4219 /* Note that Windows does support scroll bars. */
4220 FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
4221
4222 /* By default, make scrollbars the system standard width. */
4223 FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = GetSystemMetrics (SM_CXVSCROLL);
4224
4225 f->terminal = dpyinfo->terminal;
4226 f->terminal->reference_count++;
4227
4228 f->output_method = output_w32;
4229 f->output_data.w32 =
4230 (struct w32_output *) xmalloc (sizeof (struct w32_output));
4231 bzero (f->output_data.w32, sizeof (struct w32_output));
4232 FRAME_FONTSET (f) = -1;
4233 record_unwind_protect (unwind_create_frame, frame);
4234
4235 f->icon_name
4236 = w32_get_arg (parameters, Qicon_name, "iconName", "Title", RES_TYPE_STRING);
4237 if (! STRINGP (f->icon_name))
4238 f->icon_name = Qnil;
4239
4240 /* FRAME_W32_DISPLAY_INFO (f) = dpyinfo; */
4241 #ifdef MULTI_KBOARD
4242 FRAME_KBOARD (f) = kb;
4243 #endif
4244
4245 /* Specify the parent under which to make this window. */
4246
4247 if (!NILP (parent))
4248 {
4249 f->output_data.w32->parent_desc = (Window) XFASTINT (parent);
4250 f->output_data.w32->explicit_parent = 1;
4251 }
4252 else
4253 {
4254 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
4255 f->output_data.w32->explicit_parent = 0;
4256 }
4257
4258 /* Set the name; the functions to which we pass f expect the name to
4259 be set. */
4260 if (EQ (name, Qunbound) || NILP (name))
4261 {
4262 f->name = build_string (dpyinfo->w32_id_name);
4263 f->explicit_name = 0;
4264 }
4265 else
4266 {
4267 f->name = name;
4268 f->explicit_name = 1;
4269 /* use the frame's title when getting resources for this frame. */
4270 specbind (Qx_resource_name, name);
4271 }
4272
4273 /* Extract the window parameters from the supplied values
4274 that are needed to determine window geometry. */
4275 {
4276 Lisp_Object font;
4277
4278 font = w32_get_arg (parameters, Qfont, "font", "Font", RES_TYPE_STRING);
4279
4280 BLOCK_INPUT;
4281 /* First, try whatever font the caller has specified. */
4282 if (STRINGP (font))
4283 {
4284 tem = Fquery_fontset (font, Qnil);
4285 if (STRINGP (tem))
4286 font = x_new_fontset (f, SDATA (tem));
4287 else
4288 font = x_new_font (f, SDATA (font));
4289 }
4290 /* Try out a font which we hope has bold and italic variations. */
4291 if (!STRINGP (font))
4292 font = x_new_font (f, "-*-Courier New-normal-r-*-*-*-100-*-*-c-*-iso8859-1");
4293 if (! STRINGP (font))
4294 font = x_new_font (f, "-*-Courier-normal-r-*-*-13-*-*-*-c-*-iso8859-1");
4295 /* If those didn't work, look for something which will at least work. */
4296 if (! STRINGP (font))
4297 font = x_new_font (f, "-*-Fixedsys-normal-r-*-*-12-*-*-*-c-*-iso8859-1");
4298 UNBLOCK_INPUT;
4299 if (! STRINGP (font))
4300 font = build_string ("Fixedsys");
4301
4302 x_default_parameter (f, parameters, Qfont, font,
4303 "font", "Font", RES_TYPE_STRING);
4304 }
4305
4306 x_default_parameter (f, parameters, Qborder_width, make_number (2),
4307 "borderWidth", "BorderWidth", RES_TYPE_NUMBER);
4308 /* This defaults to 2 in order to match xterm. We recognize either
4309 internalBorderWidth or internalBorder (which is what xterm calls
4310 it). */
4311 if (NILP (Fassq (Qinternal_border_width, parameters)))
4312 {
4313 Lisp_Object value;
4314
4315 value = w32_get_arg (parameters, Qinternal_border_width,
4316 "internalBorder", "InternalBorder", RES_TYPE_NUMBER);
4317 if (! EQ (value, Qunbound))
4318 parameters = Fcons (Fcons (Qinternal_border_width, value),
4319 parameters);
4320 }
4321 /* Default internalBorderWidth to 0 on Windows to match other programs. */
4322 x_default_parameter (f, parameters, Qinternal_border_width, make_number (0),
4323 "internalBorderWidth", "InternalBorder", RES_TYPE_NUMBER);
4324 x_default_parameter (f, parameters, Qvertical_scroll_bars, Qright,
4325 "verticalScrollBars", "ScrollBars", RES_TYPE_SYMBOL);
4326
4327 /* Also do the stuff which must be set before the window exists. */
4328 x_default_parameter (f, parameters, Qforeground_color, build_string ("black"),
4329 "foreground", "Foreground", RES_TYPE_STRING);
4330 x_default_parameter (f, parameters, Qbackground_color, build_string ("white"),
4331 "background", "Background", RES_TYPE_STRING);
4332 x_default_parameter (f, parameters, Qmouse_color, build_string ("black"),
4333 "pointerColor", "Foreground", RES_TYPE_STRING);
4334 x_default_parameter (f, parameters, Qcursor_color, build_string ("black"),
4335 "cursorColor", "Foreground", RES_TYPE_STRING);
4336 x_default_parameter (f, parameters, Qborder_color, build_string ("black"),
4337 "borderColor", "BorderColor", RES_TYPE_STRING);
4338 x_default_parameter (f, parameters, Qscreen_gamma, Qnil,
4339 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT);
4340 x_default_parameter (f, parameters, Qline_spacing, Qnil,
4341 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER);
4342 x_default_parameter (f, parameters, Qleft_fringe, Qnil,
4343 "leftFringe", "LeftFringe", RES_TYPE_NUMBER);
4344 x_default_parameter (f, parameters, Qright_fringe, Qnil,
4345 "rightFringe", "RightFringe", RES_TYPE_NUMBER);
4346
4347
4348 /* Init faces before x_default_parameter is called for scroll-bar
4349 parameters because that function calls x_set_scroll_bar_width,
4350 which calls change_frame_size, which calls Fset_window_buffer,
4351 which runs hooks, which call Fvertical_motion. At the end, we
4352 end up in init_iterator with a null face cache, which should not
4353 happen. */
4354 init_frame_faces (f);
4355
4356 x_default_parameter (f, parameters, Qmenu_bar_lines, make_number (1),
4357 "menuBar", "MenuBar", RES_TYPE_NUMBER);
4358 x_default_parameter (f, parameters, Qtool_bar_lines, make_number (1),
4359 "toolBar", "ToolBar", RES_TYPE_NUMBER);
4360
4361 x_default_parameter (f, parameters, Qbuffer_predicate, Qnil,
4362 "bufferPredicate", "BufferPredicate", RES_TYPE_SYMBOL);
4363 x_default_parameter (f, parameters, Qtitle, Qnil,
4364 "title", "Title", RES_TYPE_STRING);
4365 x_default_parameter (f, parameters, Qfullscreen, Qnil,
4366 "fullscreen", "Fullscreen", RES_TYPE_SYMBOL);
4367
4368 f->output_data.w32->dwStyle = WS_OVERLAPPEDWINDOW;
4369 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
4370
4371 f->output_data.w32->text_cursor = w32_load_cursor (IDC_IBEAM);
4372 f->output_data.w32->nontext_cursor = w32_load_cursor (IDC_ARROW);
4373 f->output_data.w32->modeline_cursor = w32_load_cursor (IDC_ARROW);
4374 f->output_data.w32->hand_cursor = w32_load_cursor (IDC_HAND);
4375 f->output_data.w32->hourglass_cursor = w32_load_cursor (IDC_WAIT);
4376 f->output_data.w32->horizontal_drag_cursor = w32_load_cursor (IDC_SIZEWE);
4377
4378 window_prompting = x_figure_window_size (f, parameters, 1);
4379
4380 tem = w32_get_arg (parameters, Qunsplittable, 0, 0, RES_TYPE_BOOLEAN);
4381 f->no_split = minibuffer_only || EQ (tem, Qt);
4382
4383 w32_window (f, window_prompting, minibuffer_only);
4384 x_icon (f, parameters);
4385
4386 x_make_gc (f);
4387
4388 /* Now consider the frame official. */
4389 FRAME_W32_DISPLAY_INFO (f)->reference_count++;
4390 Vframe_list = Fcons (frame, Vframe_list);
4391
4392 /* We need to do this after creating the window, so that the
4393 icon-creation functions can say whose icon they're describing. */
4394 x_default_parameter (f, parameters, Qicon_type, Qnil,
4395 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL);
4396
4397 x_default_parameter (f, parameters, Qauto_raise, Qnil,
4398 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
4399 x_default_parameter (f, parameters, Qauto_lower, Qnil,
4400 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
4401 x_default_parameter (f, parameters, Qcursor_type, Qbox,
4402 "cursorType", "CursorType", RES_TYPE_SYMBOL);
4403 x_default_parameter (f, parameters, Qscroll_bar_width, Qnil,
4404 "scrollBarWidth", "ScrollBarWidth", RES_TYPE_NUMBER);
4405
4406 /* Dimensions, especially FRAME_LINES (f), must be done via change_frame_size.
4407 Change will not be effected unless different from the current
4408 FRAME_LINES (f). */
4409 width = FRAME_COLS (f);
4410 height = FRAME_LINES (f);
4411
4412 FRAME_LINES (f) = 0;
4413 SET_FRAME_COLS (f, 0);
4414 change_frame_size (f, height, width, 1, 0, 0);
4415
4416 /* Tell the server what size and position, etc, we want, and how
4417 badly we want them. This should be done after we have the menu
4418 bar so that its size can be taken into account. */
4419 BLOCK_INPUT;
4420 x_wm_set_size_hint (f, window_prompting, 0);
4421 UNBLOCK_INPUT;
4422
4423 /* Make the window appear on the frame and enable display, unless
4424 the caller says not to. However, with explicit parent, Emacs
4425 cannot control visibility, so don't try. */
4426 if (! f->output_data.w32->explicit_parent)
4427 {
4428 Lisp_Object visibility;
4429
4430 visibility = w32_get_arg (parameters, Qvisibility, 0, 0, RES_TYPE_SYMBOL);
4431 if (EQ (visibility, Qunbound))
4432 visibility = Qt;
4433
4434 if (EQ (visibility, Qicon))
4435 x_iconify_frame (f);
4436 else if (! NILP (visibility))
4437 x_make_frame_visible (f);
4438 else
4439 /* Must have been Qnil. */
4440 ;
4441 }
4442
4443 /* Initialize `default-minibuffer-frame' in case this is the first
4444 frame on this terminal. */
4445 if (FRAME_HAS_MINIBUF_P (f)
4446 && (!FRAMEP (kb->Vdefault_minibuffer_frame)
4447 || !FRAME_LIVE_P (XFRAME (kb->Vdefault_minibuffer_frame))))
4448 kb->Vdefault_minibuffer_frame = frame;
4449
4450 /* All remaining specified parameters, which have not been "used"
4451 by x_get_arg and friends, now go in the misc. alist of the frame. */
4452 for (tem = parameters; CONSP (tem); tem = XCDR (tem))
4453 if (CONSP (XCAR (tem)) && !NILP (XCAR (XCAR (tem))))
4454 f->param_alist = Fcons (XCAR (tem), f->param_alist);
4455
4456 UNGCPRO;
4457
4458 /* Make sure windows on this frame appear in calls to next-window
4459 and similar functions. */
4460 Vwindow_list = Qnil;
4461
4462 return unbind_to (count, frame);
4463 }
4464
4465 /* FRAME is used only to get a handle on the X display. We don't pass the
4466 display info directly because we're called from frame.c, which doesn't
4467 know about that structure. */
4468 Lisp_Object
4469 x_get_focus_frame (frame)
4470 struct frame *frame;
4471 {
4472 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (frame);
4473 Lisp_Object xfocus;
4474 if (! dpyinfo->w32_focus_frame)
4475 return Qnil;
4476
4477 XSETFRAME (xfocus, dpyinfo->w32_focus_frame);
4478 return xfocus;
4479 }
4480
4481 DEFUN ("x-focus-frame", Fx_focus_frame, Sx_focus_frame, 1, 1, 0,
4482 doc: /* Give FRAME input focus, raising to foreground if necessary. */)
4483 (frame)
4484 Lisp_Object frame;
4485 {
4486 x_focus_on_frame (check_x_frame (frame));
4487 return Qnil;
4488 }
4489
4490 \f
4491 /* Return the charset portion of a font name. */
4492 char *
4493 xlfd_charset_of_font (char * fontname)
4494 {
4495 char *charset, *encoding;
4496
4497 encoding = strrchr (fontname, '-');
4498 if (!encoding || encoding == fontname)
4499 return NULL;
4500
4501 for (charset = encoding - 1; charset >= fontname; charset--)
4502 if (*charset == '-')
4503 break;
4504
4505 if (charset == fontname || strcmp (charset, "-*-*") == 0)
4506 return NULL;
4507
4508 return charset + 1;
4509 }
4510
4511 struct font_info *w32_load_bdf_font (struct frame *f, char *fontname,
4512 int size, char* filename);
4513 static Lisp_Object w32_list_bdf_fonts (Lisp_Object pattern, int max_names);
4514 static BOOL w32_to_x_font (LOGFONT * lplf, char * lpxstr, int len,
4515 char * charset);
4516 static BOOL x_to_w32_font (char *lpxstr, LOGFONT *lplogfont);
4517
4518 static struct font_info *
4519 w32_load_system_font (f, fontname, size)
4520 struct frame *f;
4521 char * fontname;
4522 int size;
4523 {
4524 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
4525 Lisp_Object font_names;
4526
4527 /* Get a list of all the fonts that match this name. Once we
4528 have a list of matching fonts, we compare them against the fonts
4529 we already have loaded by comparing names. */
4530 font_names = w32_list_fonts (f, build_string (fontname), size, 100);
4531
4532 if (!NILP (font_names))
4533 {
4534 Lisp_Object tail;
4535 int i;
4536
4537 /* First check if any are already loaded, as that is cheaper
4538 than loading another one. */
4539 for (i = 0; i < dpyinfo->n_fonts; i++)
4540 for (tail = font_names; CONSP (tail); tail = XCDR (tail))
4541 if (dpyinfo->font_table[i].name
4542 && (!strcmp (dpyinfo->font_table[i].name,
4543 SDATA (XCAR (tail)))
4544 || !strcmp (dpyinfo->font_table[i].full_name,
4545 SDATA (XCAR (tail)))))
4546 return (dpyinfo->font_table + i);
4547
4548 fontname = (char *) SDATA (XCAR (font_names));
4549 }
4550 else if (w32_strict_fontnames)
4551 {
4552 /* If EnumFontFamiliesEx was available, we got a full list of
4553 fonts back so stop now to avoid the possibility of loading a
4554 random font. If we had to fall back to EnumFontFamilies, the
4555 list is incomplete, so continue whether the font we want was
4556 listed or not. */
4557 HMODULE gdi32 = GetModuleHandle ("gdi32.dll");
4558 FARPROC enum_font_families_ex
4559 = GetProcAddress (gdi32, "EnumFontFamiliesExA");
4560 if (enum_font_families_ex)
4561 return NULL;
4562 }
4563
4564 /* Load the font and add it to the table. */
4565 {
4566 char *full_name, *encoding, *charset;
4567 XFontStruct *font;
4568 struct font_info *fontp;
4569 LOGFONT lf;
4570 BOOL ok;
4571 int codepage;
4572 int i;
4573
4574 if (!fontname || !x_to_w32_font (fontname, &lf))
4575 return (NULL);
4576
4577 if (!*lf.lfFaceName)
4578 /* If no name was specified for the font, we get a random font
4579 from CreateFontIndirect - this is not particularly
4580 desirable, especially since CreateFontIndirect does not
4581 fill out the missing name in lf, so we never know what we
4582 ended up with. */
4583 return NULL;
4584
4585 lf.lfQuality = DEFAULT_QUALITY;
4586
4587 font = (XFontStruct *) xmalloc (sizeof (XFontStruct));
4588 bzero (font, sizeof (*font));
4589
4590 /* Set bdf to NULL to indicate that this is a Windows font. */
4591 font->bdf = NULL;
4592
4593 BLOCK_INPUT;
4594
4595 font->hfont = CreateFontIndirect (&lf);
4596
4597 if (font->hfont == NULL)
4598 {
4599 ok = FALSE;
4600 }
4601 else
4602 {
4603 HDC hdc;
4604 HANDLE oldobj;
4605
4606 codepage = w32_codepage_for_font (fontname);
4607
4608 hdc = GetDC (dpyinfo->root_window);
4609 oldobj = SelectObject (hdc, font->hfont);
4610
4611 ok = GetTextMetrics (hdc, &font->tm);
4612 if (codepage == CP_UNICODE)
4613 font->double_byte_p = 1;
4614 else
4615 {
4616 /* Unfortunately, some fonts (eg. MingLiU, a big5 ttf font)
4617 don't report themselves as double byte fonts, when
4618 patently they are. So instead of trusting
4619 GetFontLanguageInfo, we check the properties of the
4620 codepage directly, since that is ultimately what we are
4621 working from anyway. */
4622 /* font->double_byte_p = GetFontLanguageInfo (hdc) & GCP_DBCS; */
4623 CPINFO cpi = {0};
4624 GetCPInfo (codepage, &cpi);
4625 font->double_byte_p = cpi.MaxCharSize > 1;
4626 }
4627
4628 SelectObject (hdc, oldobj);
4629 ReleaseDC (dpyinfo->root_window, hdc);
4630 /* Fill out details in lf according to the font that was
4631 actually loaded. */
4632 lf.lfHeight = font->tm.tmInternalLeading - font->tm.tmHeight;
4633 lf.lfWidth = font->tm.tmMaxCharWidth;
4634 lf.lfWeight = font->tm.tmWeight;
4635 lf.lfItalic = font->tm.tmItalic;
4636 lf.lfCharSet = font->tm.tmCharSet;
4637 lf.lfPitchAndFamily = ((font->tm.tmPitchAndFamily & TMPF_FIXED_PITCH)
4638 ? VARIABLE_PITCH : FIXED_PITCH);
4639 lf.lfOutPrecision = ((font->tm.tmPitchAndFamily & TMPF_VECTOR)
4640 ? OUT_STROKE_PRECIS : OUT_STRING_PRECIS);
4641
4642 w32_cache_char_metrics (font);
4643 }
4644
4645 UNBLOCK_INPUT;
4646
4647 if (!ok)
4648 {
4649 w32_unload_font (dpyinfo, font);
4650 return (NULL);
4651 }
4652
4653 /* Find a free slot in the font table. */
4654 for (i = 0; i < dpyinfo->n_fonts; ++i)
4655 if (dpyinfo->font_table[i].name == NULL)
4656 break;
4657
4658 /* If no free slot found, maybe enlarge the font table. */
4659 if (i == dpyinfo->n_fonts
4660 && dpyinfo->n_fonts == dpyinfo->font_table_size)
4661 {
4662 int sz;
4663 dpyinfo->font_table_size = max (16, 2 * dpyinfo->font_table_size);
4664 sz = dpyinfo->font_table_size * sizeof *dpyinfo->font_table;
4665 dpyinfo->font_table
4666 = (struct font_info *) xrealloc (dpyinfo->font_table, sz);
4667 }
4668
4669 fontp = dpyinfo->font_table + i;
4670 if (i == dpyinfo->n_fonts)
4671 ++dpyinfo->n_fonts;
4672
4673 /* Now fill in the slots of *FONTP. */
4674 BLOCK_INPUT;
4675 bzero (fontp, sizeof (*fontp));
4676 fontp->font = font;
4677 fontp->font_idx = i;
4678 fontp->name = (char *) xmalloc (strlen (fontname) + 1);
4679 bcopy (fontname, fontp->name, strlen (fontname) + 1);
4680
4681 if (lf.lfPitchAndFamily == FIXED_PITCH)
4682 {
4683 /* Fixed width font. */
4684 fontp->average_width = fontp->space_width = FONT_WIDTH (font);
4685 }
4686 else
4687 {
4688 wchar_t space = 32;
4689 XCharStruct* pcm;
4690 pcm = w32_per_char_metric (font, &space, ANSI_FONT);
4691 if (pcm)
4692 fontp->space_width = pcm->width;
4693 else
4694 fontp->space_width = FONT_WIDTH (font);
4695
4696 fontp->average_width = font->tm.tmAveCharWidth;
4697 }
4698
4699 charset = xlfd_charset_of_font (fontname);
4700
4701 /* Cache the W32 codepage for a font. This makes w32_encode_char
4702 (called for every glyph during redisplay) much faster. */
4703 fontp->codepage = codepage;
4704
4705 /* Work out the font's full name. */
4706 full_name = (char *)xmalloc (100);
4707 if (full_name && w32_to_x_font (&lf, full_name, 100, charset))
4708 fontp->full_name = full_name;
4709 else
4710 {
4711 /* If all else fails - just use the name we used to load it. */
4712 xfree (full_name);
4713 fontp->full_name = fontp->name;
4714 }
4715
4716 fontp->size = FONT_WIDTH (font);
4717 fontp->height = FONT_HEIGHT (font);
4718
4719 /* The slot `encoding' specifies how to map a character
4720 code-points (0x20..0x7F or 0x2020..0x7F7F) of each charset to
4721 the font code-points (0:0x20..0x7F, 1:0xA0..0xFF), or
4722 (0:0x20..0x7F, 1:0xA0..0xFF,
4723 (0:0x2020..0x7F7F, 1:0xA0A0..0xFFFF, 3:0x20A0..0x7FFF,
4724 2:0xA020..0xFF7F). For the moment, we don't know which charset
4725 uses this font. So, we set information in fontp->encoding[1]
4726 which is never used by any charset. If mapping can't be
4727 decided, set FONT_ENCODING_NOT_DECIDED. */
4728
4729 /* SJIS fonts need to be set to type 4, all others seem to work as
4730 type FONT_ENCODING_NOT_DECIDED. */
4731 encoding = strrchr (fontp->name, '-');
4732 if (encoding && strnicmp (encoding+1, "sjis", 4) == 0)
4733 fontp->encoding[1] = 4;
4734 else
4735 fontp->encoding[1] = FONT_ENCODING_NOT_DECIDED;
4736
4737 /* The following three values are set to 0 under W32, which is
4738 what they get set to if XGetFontProperty fails under X. */
4739 fontp->baseline_offset = 0;
4740 fontp->relative_compose = 0;
4741 fontp->default_ascent = 0;
4742
4743 /* Set global flag fonts_changed_p to non-zero if the font loaded
4744 has a character with a smaller width than any other character
4745 before, or if the font loaded has a smaller height than any
4746 other font loaded before. If this happens, it will make a
4747 glyph matrix reallocation necessary. */
4748 fonts_changed_p |= x_compute_min_glyph_bounds (f);
4749 UNBLOCK_INPUT;
4750 return fontp;
4751 }
4752 }
4753
4754 /* Load font named FONTNAME of size SIZE for frame F, and return a
4755 pointer to the structure font_info while allocating it dynamically.
4756 If loading fails, return NULL. */
4757 struct font_info *
4758 w32_load_font (f, fontname, size)
4759 struct frame *f;
4760 char * fontname;
4761 int size;
4762 {
4763 Lisp_Object bdf_fonts;
4764 struct font_info *retval = NULL;
4765 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
4766
4767 bdf_fonts = w32_list_bdf_fonts (build_string (fontname), 1);
4768
4769 while (!retval && CONSP (bdf_fonts))
4770 {
4771 char *bdf_name, *bdf_file;
4772 Lisp_Object bdf_pair;
4773 int i;
4774
4775 bdf_name = SDATA (XCAR (bdf_fonts));
4776 bdf_pair = Fassoc (XCAR (bdf_fonts), Vw32_bdf_filename_alist);
4777 bdf_file = SDATA (XCDR (bdf_pair));
4778
4779 // If the font is already loaded, do not load it again.
4780 for (i = 0; i < dpyinfo->n_fonts; i++)
4781 {
4782 if ((dpyinfo->font_table[i].name
4783 && !strcmp (dpyinfo->font_table[i].name, bdf_name))
4784 || (dpyinfo->font_table[i].full_name
4785 && !strcmp (dpyinfo->font_table[i].full_name, bdf_name)))
4786 return dpyinfo->font_table + i;
4787 }
4788
4789 retval = w32_load_bdf_font (f, bdf_name, size, bdf_file);
4790
4791 bdf_fonts = XCDR (bdf_fonts);
4792 }
4793
4794 if (retval)
4795 return retval;
4796
4797 return w32_load_system_font (f, fontname, size);
4798 }
4799
4800
4801 void
4802 w32_unload_font (dpyinfo, font)
4803 struct w32_display_info *dpyinfo;
4804 XFontStruct * font;
4805 {
4806 if (font)
4807 {
4808 if (font->per_char) xfree (font->per_char);
4809 if (font->bdf) w32_free_bdf_font (font->bdf);
4810
4811 if (font->hfont) DeleteObject (font->hfont);
4812 xfree (font);
4813 }
4814 }
4815
4816 /* The font conversion stuff between x and w32 */
4817
4818 /* X font string is as follows (from faces.el)
4819 * (let ((- "[-?]")
4820 * (foundry "[^-]+")
4821 * (family "[^-]+")
4822 * (weight "\\(bold\\|demibold\\|medium\\)") ; 1
4823 * (weight\? "\\([^-]*\\)") ; 1
4824 * (slant "\\([ior]\\)") ; 2
4825 * (slant\? "\\([^-]?\\)") ; 2
4826 * (swidth "\\([^-]*\\)") ; 3
4827 * (adstyle "[^-]*") ; 4
4828 * (pixelsize "[0-9]+")
4829 * (pointsize "[0-9][0-9]+")
4830 * (resx "[0-9][0-9]+")
4831 * (resy "[0-9][0-9]+")
4832 * (spacing "[cmp?*]")
4833 * (avgwidth "[0-9]+")
4834 * (registry "[^-]+")
4835 * (encoding "[^-]+")
4836 * )
4837 */
4838
4839 static LONG
4840 x_to_w32_weight (lpw)
4841 char * lpw;
4842 {
4843 if (!lpw) return (FW_DONTCARE);
4844
4845 if (stricmp (lpw, "heavy") == 0) return FW_HEAVY;
4846 else if (stricmp (lpw, "extrabold") == 0) return FW_EXTRABOLD;
4847 else if (stricmp (lpw, "bold") == 0) return FW_BOLD;
4848 else if (stricmp (lpw, "demibold") == 0) return FW_SEMIBOLD;
4849 else if (stricmp (lpw, "semibold") == 0) return FW_SEMIBOLD;
4850 else if (stricmp (lpw, "medium") == 0) return FW_MEDIUM;
4851 else if (stricmp (lpw, "normal") == 0) return FW_NORMAL;
4852 else if (stricmp (lpw, "light") == 0) return FW_LIGHT;
4853 else if (stricmp (lpw, "extralight") == 0) return FW_EXTRALIGHT;
4854 else if (stricmp (lpw, "thin") == 0) return FW_THIN;
4855 else
4856 return FW_DONTCARE;
4857 }
4858
4859
4860 static char *
4861 w32_to_x_weight (fnweight)
4862 int fnweight;
4863 {
4864 if (fnweight >= FW_HEAVY) return "heavy";
4865 if (fnweight >= FW_EXTRABOLD) return "extrabold";
4866 if (fnweight >= FW_BOLD) return "bold";
4867 if (fnweight >= FW_SEMIBOLD) return "demibold";
4868 if (fnweight >= FW_MEDIUM) return "medium";
4869 if (fnweight >= FW_NORMAL) return "normal";
4870 if (fnweight >= FW_LIGHT) return "light";
4871 if (fnweight >= FW_EXTRALIGHT) return "extralight";
4872 if (fnweight >= FW_THIN) return "thin";
4873 else
4874 return "*";
4875 }
4876
4877 static LONG
4878 x_to_w32_charset (lpcs)
4879 char * lpcs;
4880 {
4881 Lisp_Object this_entry, w32_charset;
4882 char *charset;
4883 int len = strlen (lpcs);
4884
4885 /* Support "*-#nnn" format for unknown charsets. */
4886 if (strncmp (lpcs, "*-#", 3) == 0)
4887 return atoi (lpcs + 3);
4888
4889 /* Handle wildcards by ignoring them; eg. treat "big5*-*" as "big5". */
4890 charset = alloca (len + 1);
4891 strcpy (charset, lpcs);
4892 lpcs = strchr (charset, '*');
4893 if (lpcs)
4894 *lpcs = 0;
4895
4896 /* Look through w32-charset-info-alist for the character set.
4897 Format of each entry is
4898 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
4899 */
4900 this_entry = Fassoc (build_string (charset), Vw32_charset_info_alist);
4901
4902 if (NILP (this_entry))
4903 {
4904 /* At startup, we want iso8859-1 fonts to come up properly. */
4905 if (stricmp (charset, "iso8859-1") == 0)
4906 return ANSI_CHARSET;
4907 else
4908 return DEFAULT_CHARSET;
4909 }
4910
4911 w32_charset = Fcar (Fcdr (this_entry));
4912
4913 /* Translate Lisp symbol to number. */
4914 if (EQ (w32_charset, Qw32_charset_ansi))
4915 return ANSI_CHARSET;
4916 if (EQ (w32_charset, Qw32_charset_symbol))
4917 return SYMBOL_CHARSET;
4918 if (EQ (w32_charset, Qw32_charset_shiftjis))
4919 return SHIFTJIS_CHARSET;
4920 if (EQ (w32_charset, Qw32_charset_hangeul))
4921 return HANGEUL_CHARSET;
4922 if (EQ (w32_charset, Qw32_charset_chinesebig5))
4923 return CHINESEBIG5_CHARSET;
4924 if (EQ (w32_charset, Qw32_charset_gb2312))
4925 return GB2312_CHARSET;
4926 if (EQ (w32_charset, Qw32_charset_oem))
4927 return OEM_CHARSET;
4928 #ifdef JOHAB_CHARSET
4929 if (EQ (w32_charset, Qw32_charset_johab))
4930 return JOHAB_CHARSET;
4931 if (EQ (w32_charset, Qw32_charset_easteurope))
4932 return EASTEUROPE_CHARSET;
4933 if (EQ (w32_charset, Qw32_charset_turkish))
4934 return TURKISH_CHARSET;
4935 if (EQ (w32_charset, Qw32_charset_baltic))
4936 return BALTIC_CHARSET;
4937 if (EQ (w32_charset, Qw32_charset_russian))
4938 return RUSSIAN_CHARSET;
4939 if (EQ (w32_charset, Qw32_charset_arabic))
4940 return ARABIC_CHARSET;
4941 if (EQ (w32_charset, Qw32_charset_greek))
4942 return GREEK_CHARSET;
4943 if (EQ (w32_charset, Qw32_charset_hebrew))
4944 return HEBREW_CHARSET;
4945 if (EQ (w32_charset, Qw32_charset_vietnamese))
4946 return VIETNAMESE_CHARSET;
4947 if (EQ (w32_charset, Qw32_charset_thai))
4948 return THAI_CHARSET;
4949 if (EQ (w32_charset, Qw32_charset_mac))
4950 return MAC_CHARSET;
4951 #endif /* JOHAB_CHARSET */
4952 #ifdef UNICODE_CHARSET
4953 if (EQ (w32_charset, Qw32_charset_unicode))
4954 return UNICODE_CHARSET;
4955 #endif
4956
4957 return DEFAULT_CHARSET;
4958 }
4959
4960
4961 static char *
4962 w32_to_x_charset (fncharset)
4963 int fncharset;
4964 {
4965 static char buf[32];
4966 Lisp_Object charset_type;
4967
4968 switch (fncharset)
4969 {
4970 case ANSI_CHARSET:
4971 /* Handle startup case of w32-charset-info-alist not
4972 being set up yet. */
4973 if (NILP (Vw32_charset_info_alist))
4974 return "iso8859-1";
4975 charset_type = Qw32_charset_ansi;
4976 break;
4977 case DEFAULT_CHARSET:
4978 charset_type = Qw32_charset_default;
4979 break;
4980 case SYMBOL_CHARSET:
4981 charset_type = Qw32_charset_symbol;
4982 break;
4983 case SHIFTJIS_CHARSET:
4984 charset_type = Qw32_charset_shiftjis;
4985 break;
4986 case HANGEUL_CHARSET:
4987 charset_type = Qw32_charset_hangeul;
4988 break;
4989 case GB2312_CHARSET:
4990 charset_type = Qw32_charset_gb2312;
4991 break;
4992 case CHINESEBIG5_CHARSET:
4993 charset_type = Qw32_charset_chinesebig5;
4994 break;
4995 case OEM_CHARSET:
4996 charset_type = Qw32_charset_oem;
4997 break;
4998
4999 /* More recent versions of Windows (95 and NT4.0) define more
5000 character sets. */
5001 #ifdef EASTEUROPE_CHARSET
5002 case EASTEUROPE_CHARSET:
5003 charset_type = Qw32_charset_easteurope;
5004 break;
5005 case TURKISH_CHARSET:
5006 charset_type = Qw32_charset_turkish;
5007 break;
5008 case BALTIC_CHARSET:
5009 charset_type = Qw32_charset_baltic;
5010 break;
5011 case RUSSIAN_CHARSET:
5012 charset_type = Qw32_charset_russian;
5013 break;
5014 case ARABIC_CHARSET:
5015 charset_type = Qw32_charset_arabic;
5016 break;
5017 case GREEK_CHARSET:
5018 charset_type = Qw32_charset_greek;
5019 break;
5020 case HEBREW_CHARSET:
5021 charset_type = Qw32_charset_hebrew;
5022 break;
5023 case VIETNAMESE_CHARSET:
5024 charset_type = Qw32_charset_vietnamese;
5025 break;
5026 case THAI_CHARSET:
5027 charset_type = Qw32_charset_thai;
5028 break;
5029 case MAC_CHARSET:
5030 charset_type = Qw32_charset_mac;
5031 break;
5032 case JOHAB_CHARSET:
5033 charset_type = Qw32_charset_johab;
5034 break;
5035 #endif
5036
5037 #ifdef UNICODE_CHARSET
5038 case UNICODE_CHARSET:
5039 charset_type = Qw32_charset_unicode;
5040 break;
5041 #endif
5042 default:
5043 /* Encode numerical value of unknown charset. */
5044 sprintf (buf, "*-#%u", fncharset);
5045 return buf;
5046 }
5047
5048 {
5049 Lisp_Object rest;
5050 char * best_match = NULL;
5051
5052 /* Look through w32-charset-info-alist for the character set.
5053 Prefer ISO codepages, and prefer lower numbers in the ISO
5054 range. Only return charsets for codepages which are installed.
5055
5056 Format of each entry is
5057 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
5058 */
5059 for (rest = Vw32_charset_info_alist; CONSP (rest); rest = XCDR (rest))
5060 {
5061 char * x_charset;
5062 Lisp_Object w32_charset;
5063 Lisp_Object codepage;
5064
5065 Lisp_Object this_entry = XCAR (rest);
5066
5067 /* Skip invalid entries in alist. */
5068 if (!CONSP (this_entry) || !STRINGP (XCAR (this_entry))
5069 || !CONSP (XCDR (this_entry))
5070 || !SYMBOLP (XCAR (XCDR (this_entry))))
5071 continue;
5072
5073 x_charset = SDATA (XCAR (this_entry));
5074 w32_charset = XCAR (XCDR (this_entry));
5075 codepage = XCDR (XCDR (this_entry));
5076
5077 /* Look for Same charset and a valid codepage (or non-int
5078 which means ignore). */
5079 if (EQ (w32_charset, charset_type)
5080 && (!INTEGERP (codepage) || XINT (codepage) == CP_DEFAULT
5081 || IsValidCodePage (XINT (codepage))))
5082 {
5083 /* If we don't have a match already, then this is the
5084 best. */
5085 if (!best_match)
5086 best_match = x_charset;
5087 /* If this is an ISO codepage, and the best so far isn't,
5088 then this is better. */
5089 else if (strnicmp (best_match, "iso", 3) != 0
5090 && strnicmp (x_charset, "iso", 3) == 0)
5091 best_match = x_charset;
5092 /* If both are ISO8859 codepages, choose the one with the
5093 lowest number in the encoding field. */
5094 else if (strnicmp (best_match, "iso8859-", 8) == 0
5095 && strnicmp (x_charset, "iso8859-", 8) == 0)
5096 {
5097 int best_enc = atoi (best_match + 8);
5098 int this_enc = atoi (x_charset + 8);
5099 if (this_enc > 0 && this_enc < best_enc)
5100 best_match = x_charset;
5101 }
5102 }
5103 }
5104
5105 /* If no match, encode the numeric value. */
5106 if (!best_match)
5107 {
5108 sprintf (buf, "*-#%u", fncharset);
5109 return buf;
5110 }
5111
5112 strncpy (buf, best_match, 31);
5113 buf[31] = '\0';
5114 return buf;
5115 }
5116 }
5117
5118
5119 /* Return all the X charsets that map to a font. */
5120 static Lisp_Object
5121 w32_to_all_x_charsets (fncharset)
5122 int fncharset;
5123 {
5124 static char buf[32];
5125 Lisp_Object charset_type;
5126 Lisp_Object retval = Qnil;
5127
5128 switch (fncharset)
5129 {
5130 case ANSI_CHARSET:
5131 /* Handle startup case of w32-charset-info-alist not
5132 being set up yet. */
5133 if (NILP (Vw32_charset_info_alist))
5134 return Fcons (build_string ("iso8859-1"), Qnil);
5135
5136 charset_type = Qw32_charset_ansi;
5137 break;
5138 case DEFAULT_CHARSET:
5139 charset_type = Qw32_charset_default;
5140 break;
5141 case SYMBOL_CHARSET:
5142 charset_type = Qw32_charset_symbol;
5143 break;
5144 case SHIFTJIS_CHARSET:
5145 charset_type = Qw32_charset_shiftjis;
5146 break;
5147 case HANGEUL_CHARSET:
5148 charset_type = Qw32_charset_hangeul;
5149 break;
5150 case GB2312_CHARSET:
5151 charset_type = Qw32_charset_gb2312;
5152 break;
5153 case CHINESEBIG5_CHARSET:
5154 charset_type = Qw32_charset_chinesebig5;
5155 break;
5156 case OEM_CHARSET:
5157 charset_type = Qw32_charset_oem;
5158 break;
5159
5160 /* More recent versions of Windows (95 and NT4.0) define more
5161 character sets. */
5162 #ifdef EASTEUROPE_CHARSET
5163 case EASTEUROPE_CHARSET:
5164 charset_type = Qw32_charset_easteurope;
5165 break;
5166 case TURKISH_CHARSET:
5167 charset_type = Qw32_charset_turkish;
5168 break;
5169 case BALTIC_CHARSET:
5170 charset_type = Qw32_charset_baltic;
5171 break;
5172 case RUSSIAN_CHARSET:
5173 charset_type = Qw32_charset_russian;
5174 break;
5175 case ARABIC_CHARSET:
5176 charset_type = Qw32_charset_arabic;
5177 break;
5178 case GREEK_CHARSET:
5179 charset_type = Qw32_charset_greek;
5180 break;
5181 case HEBREW_CHARSET:
5182 charset_type = Qw32_charset_hebrew;
5183 break;
5184 case VIETNAMESE_CHARSET:
5185 charset_type = Qw32_charset_vietnamese;
5186 break;
5187 case THAI_CHARSET:
5188 charset_type = Qw32_charset_thai;
5189 break;
5190 case MAC_CHARSET:
5191 charset_type = Qw32_charset_mac;
5192 break;
5193 case JOHAB_CHARSET:
5194 charset_type = Qw32_charset_johab;
5195 break;
5196 #endif
5197
5198 #ifdef UNICODE_CHARSET
5199 case UNICODE_CHARSET:
5200 charset_type = Qw32_charset_unicode;
5201 break;
5202 #endif
5203 default:
5204 /* Encode numerical value of unknown charset. */
5205 sprintf (buf, "*-#%u", fncharset);
5206 return Fcons (build_string (buf), Qnil);
5207 }
5208
5209 {
5210 Lisp_Object rest;
5211 /* Look through w32-charset-info-alist for the character set.
5212 Only return charsets for codepages which are installed.
5213
5214 Format of each entry in Vw32_charset_info_alist is
5215 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
5216 */
5217 for (rest = Vw32_charset_info_alist; CONSP (rest); rest = XCDR (rest))
5218 {
5219 Lisp_Object x_charset;
5220 Lisp_Object w32_charset;
5221 Lisp_Object codepage;
5222
5223 Lisp_Object this_entry = XCAR (rest);
5224
5225 /* Skip invalid entries in alist. */
5226 if (!CONSP (this_entry) || !STRINGP (XCAR (this_entry))
5227 || !CONSP (XCDR (this_entry))
5228 || !SYMBOLP (XCAR (XCDR (this_entry))))
5229 continue;
5230
5231 x_charset = XCAR (this_entry);
5232 w32_charset = XCAR (XCDR (this_entry));
5233 codepage = XCDR (XCDR (this_entry));
5234
5235 /* Look for Same charset and a valid codepage (or non-int
5236 which means ignore). */
5237 if (EQ (w32_charset, charset_type)
5238 && (!INTEGERP (codepage) || XINT (codepage) == CP_DEFAULT
5239 || IsValidCodePage (XINT (codepage))))
5240 {
5241 retval = Fcons (x_charset, retval);
5242 }
5243 }
5244
5245 /* If no match, encode the numeric value. */
5246 if (NILP (retval))
5247 {
5248 sprintf (buf, "*-#%u", fncharset);
5249 return Fcons (build_string (buf), Qnil);
5250 }
5251
5252 return retval;
5253 }
5254 }
5255
5256 /* Get the Windows codepage corresponding to the specified font. The
5257 charset info in the font name is used to look up
5258 w32-charset-to-codepage-alist. */
5259 int
5260 w32_codepage_for_font (char *fontname)
5261 {
5262 Lisp_Object codepage, entry;
5263 char *charset_str, *charset, *end;
5264
5265 if (NILP (Vw32_charset_info_alist))
5266 return CP_DEFAULT;
5267
5268 /* Extract charset part of font string. */
5269 charset = xlfd_charset_of_font (fontname);
5270
5271 if (!charset)
5272 return CP_UNKNOWN;
5273
5274 charset_str = (char *) alloca (strlen (charset) + 1);
5275 strcpy (charset_str, charset);
5276
5277 #if 0
5278 /* Remove leading "*-". */
5279 if (strncmp ("*-", charset_str, 2) == 0)
5280 charset = charset_str + 2;
5281 else
5282 #endif
5283 charset = charset_str;
5284
5285 /* Stop match at wildcard (including preceding '-'). */
5286 if (end = strchr (charset, '*'))
5287 {
5288 if (end > charset && *(end-1) == '-')
5289 end--;
5290 *end = '\0';
5291 }
5292
5293 entry = Fassoc (build_string (charset), Vw32_charset_info_alist);
5294 if (NILP (entry))
5295 return CP_UNKNOWN;
5296
5297 codepage = Fcdr (Fcdr (entry));
5298
5299 if (NILP (codepage))
5300 return CP_8BIT;
5301 else if (XFASTINT (codepage) == XFASTINT (Qt))
5302 return CP_UNICODE;
5303 else if (INTEGERP (codepage))
5304 return XINT (codepage);
5305 else
5306 return CP_UNKNOWN;
5307 }
5308
5309
5310 static BOOL
5311 w32_to_x_font (lplogfont, lpxstr, len, specific_charset)
5312 LOGFONT * lplogfont;
5313 char * lpxstr;
5314 int len;
5315 char * specific_charset;
5316 {
5317 char* fonttype;
5318 char *fontname;
5319 char height_pixels[8];
5320 char height_dpi[8];
5321 char width_pixels[8];
5322 char *fontname_dash;
5323 int display_resy = (int) one_w32_display_info.resy;
5324 int display_resx = (int) one_w32_display_info.resx;
5325 int bufsz;
5326 struct coding_system coding;
5327
5328 if (!lpxstr) abort ();
5329
5330 if (!lplogfont)
5331 return FALSE;
5332
5333 if (lplogfont->lfOutPrecision == OUT_STRING_PRECIS)
5334 fonttype = "raster";
5335 else if (lplogfont->lfOutPrecision == OUT_STROKE_PRECIS)
5336 fonttype = "outline";
5337 else
5338 fonttype = "unknown";
5339
5340 setup_coding_system (Fcheck_coding_system (Vlocale_coding_system),
5341 &coding);
5342 coding.src_multibyte = 0;
5343 coding.dst_multibyte = 1;
5344 coding.mode |= CODING_MODE_LAST_BLOCK;
5345 /* We explicitely disable composition handling because selection
5346 data should not contain any composition sequence. */
5347 coding.composing = COMPOSITION_DISABLED;
5348 bufsz = decoding_buffer_size (&coding, LF_FACESIZE);
5349
5350 fontname = alloca (sizeof (*fontname) * bufsz);
5351 decode_coding (&coding, lplogfont->lfFaceName, fontname,
5352 strlen (lplogfont->lfFaceName), bufsz - 1);
5353 *(fontname + coding.produced) = '\0';
5354
5355 /* Replace dashes with underscores so the dashes are not
5356 misinterpreted. */
5357 fontname_dash = fontname;
5358 while (fontname_dash = strchr (fontname_dash, '-'))
5359 *fontname_dash = '_';
5360
5361 if (lplogfont->lfHeight)
5362 {
5363 sprintf (height_pixels, "%u", eabs (lplogfont->lfHeight));
5364 sprintf (height_dpi, "%u",
5365 eabs (lplogfont->lfHeight) * 720 / display_resy);
5366 }
5367 else
5368 {
5369 strcpy (height_pixels, "*");
5370 strcpy (height_dpi, "*");
5371 }
5372
5373 #if 0 /* Never put the width in the xfld. It fails on fonts with
5374 double-width characters. */
5375 if (lplogfont->lfWidth)
5376 sprintf (width_pixels, "%u", lplogfont->lfWidth * 10);
5377 else
5378 #endif
5379 strcpy (width_pixels, "*");
5380
5381 _snprintf (lpxstr, len - 1,
5382 "-%s-%s-%s-%c-normal-normal-%s-%s-%d-%d-%c-%s-%s",
5383 fonttype, /* foundry */
5384 fontname, /* family */
5385 w32_to_x_weight (lplogfont->lfWeight), /* weight */
5386 lplogfont->lfItalic?'i':'r', /* slant */
5387 /* setwidth name */
5388 /* add style name */
5389 height_pixels, /* pixel size */
5390 height_dpi, /* point size */
5391 display_resx, /* resx */
5392 display_resy, /* resy */
5393 ((lplogfont->lfPitchAndFamily & 0x3) == VARIABLE_PITCH)
5394 ? 'p' : 'c', /* spacing */
5395 width_pixels, /* avg width */
5396 specific_charset ? specific_charset
5397 : w32_to_x_charset (lplogfont->lfCharSet)
5398 /* charset registry and encoding */
5399 );
5400
5401 lpxstr[len - 1] = 0; /* just to be sure */
5402 return (TRUE);
5403 }
5404
5405 static BOOL
5406 x_to_w32_font (lpxstr, lplogfont)
5407 char * lpxstr;
5408 LOGFONT * lplogfont;
5409 {
5410 struct coding_system coding;
5411
5412 if (!lplogfont) return (FALSE);
5413
5414 memset (lplogfont, 0, sizeof (*lplogfont));
5415
5416 /* Set default value for each field. */
5417 #if 1
5418 lplogfont->lfOutPrecision = OUT_DEFAULT_PRECIS;
5419 lplogfont->lfClipPrecision = CLIP_DEFAULT_PRECIS;
5420 lplogfont->lfQuality = DEFAULT_QUALITY;
5421 #else
5422 /* go for maximum quality */
5423 lplogfont->lfOutPrecision = OUT_STROKE_PRECIS;
5424 lplogfont->lfClipPrecision = CLIP_STROKE_PRECIS;
5425 lplogfont->lfQuality = PROOF_QUALITY;
5426 #endif
5427
5428 lplogfont->lfCharSet = DEFAULT_CHARSET;
5429 lplogfont->lfWeight = FW_DONTCARE;
5430 lplogfont->lfPitchAndFamily = DEFAULT_PITCH | FF_DONTCARE;
5431
5432 if (!lpxstr)
5433 return FALSE;
5434
5435 /* Provide a simple escape mechanism for specifying Windows font names
5436 * directly -- if font spec does not beginning with '-', assume this
5437 * format:
5438 * "<font name>[:height in pixels[:width in pixels[:weight]]]"
5439 */
5440
5441 if (*lpxstr == '-')
5442 {
5443 int fields, tem;
5444 char name[50], weight[20], slant, pitch, pixels[10], height[10],
5445 width[10], resy[10], remainder[50];
5446 char * encoding;
5447 int dpi = (int) one_w32_display_info.resy;
5448
5449 fields = sscanf (lpxstr,
5450 "-%*[^-]-%49[^-]-%19[^-]-%c-%*[^-]-%*[^-]-%9[^-]-%9[^-]-%*[^-]-%9[^-]-%c-%9[^-]-%49s",
5451 name, weight, &slant, pixels, height, resy, &pitch, width, remainder);
5452 if (fields == EOF)
5453 return (FALSE);
5454
5455 /* In the general case when wildcards cover more than one field,
5456 we don't know which field is which, so don't fill any in.
5457 However, we need to cope with this particular form, which is
5458 generated by font_list_1 (invoked by try_font_list):
5459 "-raster-6x10-*-gb2312*-*"
5460 and make sure to correctly parse the charset field. */
5461 if (fields == 3)
5462 {
5463 fields = sscanf (lpxstr,
5464 "-%*[^-]-%49[^-]-*-%49s",
5465 name, remainder);
5466 }
5467 else if (fields < 9)
5468 {
5469 fields = 0;
5470 remainder[0] = 0;
5471 }
5472
5473 if (fields > 0 && name[0] != '*')
5474 {
5475 int bufsize;
5476 unsigned char *buf;
5477
5478 setup_coding_system
5479 (Fcheck_coding_system (Vlocale_coding_system), &coding);
5480 coding.src_multibyte = 1;
5481 coding.dst_multibyte = 0;
5482 /* Need to set COMPOSITION_DISABLED, otherwise Emacs crashes in
5483 encode_coding_iso2022 trying to dereference a null pointer. */
5484 coding.composing = COMPOSITION_DISABLED;
5485 if (coding.type == coding_type_iso2022)
5486 coding.flags |= CODING_FLAG_ISO_SAFE;
5487 bufsize = encoding_buffer_size (&coding, strlen (name));
5488 buf = (unsigned char *) alloca (bufsize);
5489 coding.mode |= CODING_MODE_LAST_BLOCK;
5490 encode_coding (&coding, name, buf, strlen (name), bufsize);
5491 if (coding.produced >= LF_FACESIZE)
5492 coding.produced = LF_FACESIZE - 1;
5493 buf[coding.produced] = 0;
5494 strcpy (lplogfont->lfFaceName, buf);
5495 }
5496 else
5497 {
5498 lplogfont->lfFaceName[0] = '\0';
5499 }
5500
5501 fields--;
5502
5503 lplogfont->lfWeight = x_to_w32_weight ((fields > 0 ? weight : ""));
5504
5505 fields--;
5506
5507 lplogfont->lfItalic = (fields > 0 && slant == 'i');
5508
5509 fields--;
5510
5511 if (fields > 0 && pixels[0] != '*')
5512 lplogfont->lfHeight = atoi (pixels);
5513
5514 fields--;
5515 fields--;
5516 if (fields > 0 && resy[0] != '*')
5517 {
5518 tem = atoi (resy);
5519 if (tem > 0) dpi = tem;
5520 }
5521
5522 if (fields > -1 && lplogfont->lfHeight == 0 && height[0] != '*')
5523 lplogfont->lfHeight = atoi (height) * dpi / 720;
5524
5525 if (fields > 0)
5526 lplogfont->lfPitchAndFamily =
5527 (fields > 0 && pitch == 'p') ? VARIABLE_PITCH : FIXED_PITCH;
5528
5529 fields--;
5530
5531 if (fields > 0 && width[0] != '*')
5532 lplogfont->lfWidth = atoi (width) / 10;
5533
5534 fields--;
5535
5536 /* Strip the trailing '-' if present. (it shouldn't be, as it
5537 fails the test against xlfd-tight-regexp in fontset.el). */
5538 {
5539 int len = strlen (remainder);
5540 if (len > 0 && remainder[len-1] == '-')
5541 remainder[len-1] = 0;
5542 }
5543 encoding = remainder;
5544 #if 0
5545 if (strncmp (encoding, "*-", 2) == 0)
5546 encoding += 2;
5547 #endif
5548 lplogfont->lfCharSet = x_to_w32_charset (encoding);
5549 }
5550 else
5551 {
5552 int fields;
5553 char name[100], height[10], width[10], weight[20];
5554
5555 fields = sscanf (lpxstr,
5556 "%99[^:]:%9[^:]:%9[^:]:%19s",
5557 name, height, width, weight);
5558
5559 if (fields == EOF) return (FALSE);
5560
5561 if (fields > 0)
5562 {
5563 strncpy (lplogfont->lfFaceName, name, LF_FACESIZE);
5564 lplogfont->lfFaceName[LF_FACESIZE-1] = 0;
5565 }
5566 else
5567 {
5568 lplogfont->lfFaceName[0] = 0;
5569 }
5570
5571 fields--;
5572
5573 if (fields > 0)
5574 lplogfont->lfHeight = atoi (height);
5575
5576 fields--;
5577
5578 if (fields > 0)
5579 lplogfont->lfWidth = atoi (width);
5580
5581 fields--;
5582
5583 lplogfont->lfWeight = x_to_w32_weight ((fields > 0 ? weight : ""));
5584 }
5585
5586 /* This makes TrueType fonts work better. */
5587 lplogfont->lfHeight = - eabs (lplogfont->lfHeight);
5588
5589 return (TRUE);
5590 }
5591
5592 /* Strip the pixel height and point height from the given xlfd, and
5593 return the pixel height. If no pixel height is specified, calculate
5594 one from the point height, or if that isn't defined either, return
5595 0 (which usually signifies a scalable font).
5596 */
5597 static int
5598 xlfd_strip_height (char *fontname)
5599 {
5600 int pixel_height, field_number;
5601 char *read_from, *write_to;
5602
5603 xassert (fontname);
5604
5605 pixel_height = field_number = 0;
5606 write_to = NULL;
5607
5608 /* Look for height fields. */
5609 for (read_from = fontname; *read_from; read_from++)
5610 {
5611 if (*read_from == '-')
5612 {
5613 field_number++;
5614 if (field_number == 7) /* Pixel height. */
5615 {
5616 read_from++;
5617 write_to = read_from;
5618
5619 /* Find end of field. */
5620 for (;*read_from && *read_from != '-'; read_from++)
5621 ;
5622
5623 /* Split the fontname at end of field. */
5624 if (*read_from)
5625 {
5626 *read_from = '\0';
5627 read_from++;
5628 }
5629 pixel_height = atoi (write_to);
5630 /* Blank out field. */
5631 if (read_from > write_to)
5632 {
5633 *write_to = '-';
5634 write_to++;
5635 }
5636 /* If the pixel height field is at the end (partial xlfd),
5637 return now. */
5638 else
5639 return pixel_height;
5640
5641 /* If we got a pixel height, the point height can be
5642 ignored. Just blank it out and break now. */
5643 if (pixel_height)
5644 {
5645 /* Find end of point size field. */
5646 for (; *read_from && *read_from != '-'; read_from++)
5647 ;
5648
5649 if (*read_from)
5650 read_from++;
5651
5652 /* Blank out the point size field. */
5653 if (read_from > write_to)
5654 {
5655 *write_to = '-';
5656 write_to++;
5657 }
5658 else
5659 return pixel_height;
5660
5661 break;
5662 }
5663 /* If the point height is already blank, break now. */
5664 if (*read_from == '-')
5665 {
5666 read_from++;
5667 break;
5668 }
5669 }
5670 else if (field_number == 8)
5671 {
5672 /* If we didn't get a pixel height, try to get the point
5673 height and convert that. */
5674 int point_size;
5675 char *point_size_start = read_from++;
5676
5677 /* Find end of field. */
5678 for (; *read_from && *read_from != '-'; read_from++)
5679 ;
5680
5681 if (*read_from)
5682 {
5683 *read_from = '\0';
5684 read_from++;
5685 }
5686
5687 point_size = atoi (point_size_start);
5688
5689 /* Convert to pixel height. */
5690 pixel_height = point_size
5691 * one_w32_display_info.height_in / 720;
5692
5693 /* Blank out this field and break. */
5694 *write_to = '-';
5695 write_to++;
5696 break;
5697 }
5698 }
5699 }
5700
5701 /* Shift the rest of the font spec into place. */
5702 if (write_to && read_from > write_to)
5703 {
5704 for (; *read_from; read_from++, write_to++)
5705 *write_to = *read_from;
5706 *write_to = '\0';
5707 }
5708
5709 return pixel_height;
5710 }
5711
5712 /* Assume parameter 1 is fully qualified, no wildcards. */
5713 static BOOL
5714 w32_font_match (fontname, pattern)
5715 char * fontname;
5716 char * pattern;
5717 {
5718 char *ptr;
5719 char *font_name_copy;
5720 char *regex = alloca (strlen (pattern) * 2 + 3);
5721
5722 font_name_copy = alloca (strlen (fontname) + 1);
5723 strcpy (font_name_copy, fontname);
5724
5725 ptr = regex;
5726 *ptr++ = '^';
5727
5728 /* Turn pattern into a regexp and do a regexp match. */
5729 for (; *pattern; pattern++)
5730 {
5731 if (*pattern == '?')
5732 *ptr++ = '.';
5733 else if (*pattern == '*')
5734 {
5735 *ptr++ = '.';
5736 *ptr++ = '*';
5737 }
5738 else
5739 *ptr++ = *pattern;
5740 }
5741 *ptr = '$';
5742 *(ptr + 1) = '\0';
5743
5744 /* Strip out font heights and compare them seperately, since
5745 rounding error can cause mismatches. This also allows a
5746 comparison between a font that declares only a pixel height and a
5747 pattern that declares the point height.
5748 */
5749 {
5750 int font_height, pattern_height;
5751
5752 font_height = xlfd_strip_height (font_name_copy);
5753 pattern_height = xlfd_strip_height (regex);
5754
5755 /* Compare now, and don't bother doing expensive regexp matching
5756 if the heights differ. */
5757 if (font_height && pattern_height && (font_height != pattern_height))
5758 return FALSE;
5759 }
5760
5761 return (fast_string_match_ignore_case (build_string (regex),
5762 build_string (font_name_copy)) >= 0);
5763 }
5764
5765 /* Callback functions, and a structure holding info they need, for
5766 listing system fonts on W32. We need one set of functions to do the
5767 job properly, but these don't work on NT 3.51 and earlier, so we
5768 have a second set which don't handle character sets properly to
5769 fall back on.
5770
5771 In both cases, there are two passes made. The first pass gets one
5772 font from each family, the second pass lists all the fonts from
5773 each family. */
5774
5775 typedef struct enumfont_t
5776 {
5777 HDC hdc;
5778 int numFonts;
5779 LOGFONT logfont;
5780 XFontStruct *size_ref;
5781 Lisp_Object pattern;
5782 Lisp_Object list;
5783 } enumfont_t;
5784
5785
5786 static void
5787 enum_font_maybe_add_to_list (enumfont_t *, LOGFONT *, char *, Lisp_Object);
5788
5789
5790 static int CALLBACK
5791 enum_font_cb2 (lplf, lptm, FontType, lpef)
5792 ENUMLOGFONT * lplf;
5793 NEWTEXTMETRIC * lptm;
5794 int FontType;
5795 enumfont_t * lpef;
5796 {
5797 /* Ignore struck out and underlined versions of fonts. */
5798 if (lplf->elfLogFont.lfStrikeOut || lplf->elfLogFont.lfUnderline)
5799 return 1;
5800
5801 /* Only return fonts with names starting with @ if they were
5802 explicitly specified, since Microsoft uses an initial @ to
5803 denote fonts for vertical writing, without providing a more
5804 convenient way of identifying them. */
5805 if (lplf->elfLogFont.lfFaceName[0] == '@'
5806 && lpef->logfont.lfFaceName[0] != '@')
5807 return 1;
5808
5809 /* Check that the character set matches if it was specified */
5810 if (lpef->logfont.lfCharSet != DEFAULT_CHARSET &&
5811 lplf->elfLogFont.lfCharSet != lpef->logfont.lfCharSet)
5812 return 1;
5813
5814 if (FontType == RASTER_FONTTYPE)
5815 {
5816 /* DBCS raster fonts have problems displaying, so skip them. */
5817 int charset = lplf->elfLogFont.lfCharSet;
5818 if (charset == SHIFTJIS_CHARSET
5819 || charset == HANGEUL_CHARSET
5820 || charset == CHINESEBIG5_CHARSET
5821 || charset == GB2312_CHARSET
5822 #ifdef JOHAB_CHARSET
5823 || charset == JOHAB_CHARSET
5824 #endif
5825 )
5826 return 1;
5827 }
5828
5829 {
5830 char buf[100];
5831 Lisp_Object width = Qnil;
5832 Lisp_Object charset_list = Qnil;
5833 char *charset = NULL;
5834
5835 /* Truetype fonts do not report their true metrics until loaded */
5836 if (FontType != RASTER_FONTTYPE)
5837 {
5838 if (!NILP (lpef->pattern))
5839 {
5840 /* Scalable fonts are as big as you want them to be. */
5841 lplf->elfLogFont.lfHeight = lpef->logfont.lfHeight;
5842 lplf->elfLogFont.lfWidth = lpef->logfont.lfWidth;
5843 width = make_number (lpef->logfont.lfWidth);
5844 }
5845 else
5846 {
5847 lplf->elfLogFont.lfHeight = 0;
5848 lplf->elfLogFont.lfWidth = 0;
5849 }
5850 }
5851
5852 /* Make sure the height used here is the same as everywhere
5853 else (ie character height, not cell height). */
5854 if (lplf->elfLogFont.lfHeight > 0)
5855 {
5856 /* lptm can be trusted for RASTER fonts, but not scalable ones. */
5857 if (FontType == RASTER_FONTTYPE)
5858 lplf->elfLogFont.lfHeight = lptm->tmInternalLeading - lptm->tmHeight;
5859 else
5860 lplf->elfLogFont.lfHeight = -lplf->elfLogFont.lfHeight;
5861 }
5862
5863 if (!NILP (lpef->pattern))
5864 {
5865 charset = xlfd_charset_of_font (SDATA (lpef->pattern));
5866
5867 /* We already checked charsets above, but DEFAULT_CHARSET
5868 slipped through. So only allow exact matches for DEFAULT_CHARSET. */
5869 if (charset
5870 && strncmp (charset, "*-*", 3) != 0
5871 && lpef->logfont.lfCharSet == DEFAULT_CHARSET
5872 && strcmp (charset, w32_to_x_charset (DEFAULT_CHARSET)) != 0)
5873 return 1;
5874 }
5875
5876 if (charset)
5877 charset_list = Fcons (build_string (charset), Qnil);
5878 else
5879 charset_list = w32_to_all_x_charsets (lplf->elfLogFont.lfCharSet);
5880
5881 /* Loop through the charsets. */
5882 for ( ; CONSP (charset_list); charset_list = Fcdr (charset_list))
5883 {
5884 Lisp_Object this_charset = Fcar (charset_list);
5885 charset = SDATA (this_charset);
5886
5887 /* List bold and italic variations if w32-enable-synthesized-fonts
5888 is non-nil and this is a plain font. */
5889 if (w32_enable_synthesized_fonts
5890 && lplf->elfLogFont.lfWeight == FW_NORMAL
5891 && lplf->elfLogFont.lfItalic == FALSE)
5892 {
5893 enum_font_maybe_add_to_list (lpef, &(lplf->elfLogFont),
5894 charset, width);
5895 /* bold. */
5896 lplf->elfLogFont.lfWeight = FW_BOLD;
5897 enum_font_maybe_add_to_list (lpef, &(lplf->elfLogFont),
5898 charset, width);
5899 /* bold italic. */
5900 lplf->elfLogFont.lfItalic = TRUE;
5901 enum_font_maybe_add_to_list (lpef, &(lplf->elfLogFont),
5902 charset, width);
5903 /* italic. */
5904 lplf->elfLogFont.lfWeight = FW_NORMAL;
5905 enum_font_maybe_add_to_list (lpef, &(lplf->elfLogFont),
5906 charset, width);
5907 }
5908 else
5909 enum_font_maybe_add_to_list (lpef, &(lplf->elfLogFont),
5910 charset, width);
5911 }
5912 }
5913
5914 return 1;
5915 }
5916
5917 static void
5918 enum_font_maybe_add_to_list (lpef, logfont, match_charset, width)
5919 enumfont_t * lpef;
5920 LOGFONT * logfont;
5921 char * match_charset;
5922 Lisp_Object width;
5923 {
5924 char buf[100];
5925
5926 if (!w32_to_x_font (logfont, buf, 100, match_charset))
5927 return;
5928
5929 if (NILP (lpef->pattern)
5930 || w32_font_match (buf, SDATA (lpef->pattern)))
5931 {
5932 /* Check if we already listed this font. This may happen if
5933 w32_enable_synthesized_fonts is non-nil, and there are real
5934 bold and italic versions of the font. */
5935 Lisp_Object font_name = build_string (buf);
5936 if (NILP (Fmember (font_name, lpef->list)))
5937 {
5938 Lisp_Object entry = Fcons (font_name, width);
5939 lpef->list = Fcons (entry, lpef->list);
5940 lpef->numFonts++;
5941 }
5942 }
5943 }
5944
5945
5946 static int CALLBACK
5947 enum_font_cb1 (lplf, lptm, FontType, lpef)
5948 ENUMLOGFONT * lplf;
5949 NEWTEXTMETRIC * lptm;
5950 int FontType;
5951 enumfont_t * lpef;
5952 {
5953 return EnumFontFamilies (lpef->hdc,
5954 lplf->elfLogFont.lfFaceName,
5955 (FONTENUMPROC) enum_font_cb2,
5956 (LPARAM) lpef);
5957 }
5958
5959
5960 static int CALLBACK
5961 enum_fontex_cb2 (lplf, lptm, font_type, lpef)
5962 ENUMLOGFONTEX * lplf;
5963 NEWTEXTMETRICEX * lptm;
5964 int font_type;
5965 enumfont_t * lpef;
5966 {
5967 /* We are not interested in the extra info we get back from the 'Ex
5968 version - only the fact that we get character set variations
5969 enumerated seperately. */
5970 return enum_font_cb2 ((ENUMLOGFONT *) lplf, (NEWTEXTMETRIC *) lptm,
5971 font_type, lpef);
5972 }
5973
5974 static int CALLBACK
5975 enum_fontex_cb1 (lplf, lptm, font_type, lpef)
5976 ENUMLOGFONTEX * lplf;
5977 NEWTEXTMETRICEX * lptm;
5978 int font_type;
5979 enumfont_t * lpef;
5980 {
5981 HMODULE gdi32 = GetModuleHandle ("gdi32.dll");
5982 FARPROC enum_font_families_ex
5983 = GetProcAddress ( gdi32, "EnumFontFamiliesExA");
5984 /* We don't really expect EnumFontFamiliesEx to disappear once we
5985 get here, so don't bother handling it gracefully. */
5986 if (enum_font_families_ex == NULL)
5987 error ("gdi32.dll has disappeared!");
5988 return enum_font_families_ex (lpef->hdc,
5989 &lplf->elfLogFont,
5990 (FONTENUMPROC) enum_fontex_cb2,
5991 (LPARAM) lpef, 0);
5992 }
5993
5994 /* Interface to fontset handler. (adapted from mw32font.c in Meadow
5995 and xterm.c in Emacs 20.3) */
5996
5997 static Lisp_Object
5998 w32_list_bdf_fonts (Lisp_Object pattern, int max_names)
5999 {
6000 char *fontname, *ptnstr;
6001 Lisp_Object list, tem, newlist = Qnil;
6002 int n_fonts = 0;
6003
6004 list = Vw32_bdf_filename_alist;
6005 ptnstr = SDATA (pattern);
6006
6007 for ( ; CONSP (list); list = XCDR (list))
6008 {
6009 tem = XCAR (list);
6010 if (CONSP (tem))
6011 fontname = SDATA (XCAR (tem));
6012 else if (STRINGP (tem))
6013 fontname = SDATA (tem);
6014 else
6015 continue;
6016
6017 if (w32_font_match (fontname, ptnstr))
6018 {
6019 newlist = Fcons (XCAR (tem), newlist);
6020 n_fonts++;
6021 if (max_names >= 0 && n_fonts >= max_names)
6022 break;
6023 }
6024 }
6025
6026 return newlist;
6027 }
6028
6029
6030 /* Return a list of names of available fonts matching PATTERN on frame
6031 F. If SIZE is not 0, it is the size (maximum bound width) of fonts
6032 to be listed. Frame F NULL means we have not yet created any
6033 frame, which means we can't get proper size info, as we don't have
6034 a device context to use for GetTextMetrics.
6035 MAXNAMES sets a limit on how many fonts to match. If MAXNAMES is
6036 negative, then all matching fonts are returned. */
6037
6038 Lisp_Object
6039 w32_list_fonts (f, pattern, size, maxnames)
6040 struct frame *f;
6041 Lisp_Object pattern;
6042 int size;
6043 int maxnames;
6044 {
6045 Lisp_Object patterns, key = Qnil, tem, tpat;
6046 Lisp_Object list = Qnil, newlist = Qnil, second_best = Qnil;
6047 struct w32_display_info *dpyinfo = &one_w32_display_info;
6048 int n_fonts = 0;
6049
6050 patterns = Fassoc (pattern, Valternate_fontname_alist);
6051 if (NILP (patterns))
6052 patterns = Fcons (pattern, Qnil);
6053
6054 for (; CONSP (patterns); patterns = XCDR (patterns))
6055 {
6056 enumfont_t ef;
6057 int codepage;
6058
6059 tpat = XCAR (patterns);
6060
6061 if (!STRINGP (tpat))
6062 continue;
6063
6064 /* Avoid expensive EnumFontFamilies functions if we are not
6065 going to be able to output one of these anyway. */
6066 codepage = w32_codepage_for_font (SDATA (tpat));
6067 if (codepage != CP_8BIT && codepage != CP_UNICODE
6068 && codepage != CP_DEFAULT && codepage != CP_UNKNOWN
6069 && !IsValidCodePage (codepage))
6070 continue;
6071
6072 /* See if we cached the result for this particular query.
6073 The cache is an alist of the form:
6074 ((PATTERN (FONTNAME . WIDTH) ...) ...)
6075 */
6076 if (tem = XCDR (dpyinfo->name_list_element),
6077 !NILP (list = Fassoc (tpat, tem)))
6078 {
6079 list = Fcdr_safe (list);
6080 /* We have a cached list. Don't have to get the list again. */
6081 goto label_cached;
6082 }
6083
6084 BLOCK_INPUT;
6085 /* At first, put PATTERN in the cache. */
6086 ef.pattern = tpat;
6087 ef.list = Qnil;
6088 ef.numFonts = 0;
6089
6090 /* Use EnumFontFamiliesEx where it is available, as it knows
6091 about character sets. Fall back to EnumFontFamilies for
6092 older versions of NT that don't support the 'Ex function. */
6093 x_to_w32_font (SDATA (tpat), &ef.logfont);
6094 {
6095 LOGFONT font_match_pattern;
6096 HMODULE gdi32 = GetModuleHandle ("gdi32.dll");
6097 FARPROC enum_font_families_ex
6098 = GetProcAddress ( gdi32, "EnumFontFamiliesExA");
6099
6100 /* We do our own pattern matching so we can handle wildcards. */
6101 font_match_pattern.lfFaceName[0] = 0;
6102 font_match_pattern.lfPitchAndFamily = 0;
6103 /* We can use the charset, because if it is a wildcard it will
6104 be DEFAULT_CHARSET anyway. */
6105 font_match_pattern.lfCharSet = ef.logfont.lfCharSet;
6106
6107 ef.hdc = GetDC (dpyinfo->root_window);
6108
6109 if (enum_font_families_ex)
6110 enum_font_families_ex (ef.hdc,
6111 &font_match_pattern,
6112 (FONTENUMPROC) enum_fontex_cb1,
6113 (LPARAM) &ef, 0);
6114 else
6115 EnumFontFamilies (ef.hdc, NULL, (FONTENUMPROC) enum_font_cb1,
6116 (LPARAM)&ef);
6117
6118 ReleaseDC (dpyinfo->root_window, ef.hdc);
6119 }
6120
6121 UNBLOCK_INPUT;
6122 list = ef.list;
6123
6124 /* Make a list of the fonts we got back.
6125 Store that in the font cache for the display. */
6126 XSETCDR (dpyinfo->name_list_element,
6127 Fcons (Fcons (tpat, list),
6128 XCDR (dpyinfo->name_list_element)));
6129
6130 label_cached:
6131 if (NILP (list)) continue; /* Try the remaining alternatives. */
6132
6133 newlist = second_best = Qnil;
6134
6135 /* Make a list of the fonts that have the right width. */
6136 for (; CONSP (list); list = XCDR (list))
6137 {
6138 int found_size;
6139 tem = XCAR (list);
6140
6141 if (!CONSP (tem))
6142 continue;
6143 if (NILP (XCAR (tem)))
6144 continue;
6145 if (!size)
6146 {
6147 newlist = Fcons (XCAR (tem), newlist);
6148 n_fonts++;
6149 if (maxnames >= 0 && n_fonts >= maxnames)
6150 break;
6151 else
6152 continue;
6153 }
6154 if (!INTEGERP (XCDR (tem)))
6155 {
6156 /* Since we don't yet know the size of the font, we must
6157 load it and try GetTextMetrics. */
6158 W32FontStruct thisinfo;
6159 LOGFONT lf;
6160 HDC hdc;
6161 HANDLE oldobj;
6162
6163 if (!x_to_w32_font (SDATA (XCAR (tem)), &lf))
6164 continue;
6165
6166 BLOCK_INPUT;
6167 thisinfo.bdf = NULL;
6168 thisinfo.hfont = CreateFontIndirect (&lf);
6169 if (thisinfo.hfont == NULL)
6170 continue;
6171
6172 hdc = GetDC (dpyinfo->root_window);
6173 oldobj = SelectObject (hdc, thisinfo.hfont);
6174 if (GetTextMetrics (hdc, &thisinfo.tm))
6175 XSETCDR (tem, make_number (FONT_WIDTH (&thisinfo)));
6176 else
6177 XSETCDR (tem, make_number (0));
6178 SelectObject (hdc, oldobj);
6179 ReleaseDC (dpyinfo->root_window, hdc);
6180 DeleteObject (thisinfo.hfont);
6181 UNBLOCK_INPUT;
6182 }
6183 found_size = XINT (XCDR (tem));
6184 if (found_size == size)
6185 {
6186 newlist = Fcons (XCAR (tem), newlist);
6187 n_fonts++;
6188 if (maxnames >= 0 && n_fonts >= maxnames)
6189 break;
6190 }
6191 /* keep track of the closest matching size in case
6192 no exact match is found. */
6193 else if (found_size > 0)
6194 {
6195 if (NILP (second_best))
6196 second_best = tem;
6197
6198 else if (found_size < size)
6199 {
6200 if (XINT (XCDR (second_best)) > size
6201 || XINT (XCDR (second_best)) < found_size)
6202 second_best = tem;
6203 }
6204 else
6205 {
6206 if (XINT (XCDR (second_best)) > size
6207 && XINT (XCDR (second_best)) >
6208 found_size)
6209 second_best = tem;
6210 }
6211 }
6212 }
6213
6214 if (!NILP (newlist))
6215 break;
6216 else if (!NILP (second_best))
6217 {
6218 newlist = Fcons (XCAR (second_best), Qnil);
6219 break;
6220 }
6221 }
6222
6223 /* Include any bdf fonts. */
6224 if (n_fonts < maxnames || maxnames < 0)
6225 {
6226 Lisp_Object combined[2];
6227 combined[0] = w32_list_bdf_fonts (pattern, maxnames - n_fonts);
6228 combined[1] = newlist;
6229 newlist = Fnconc (2, combined);
6230 }
6231
6232 return newlist;
6233 }
6234
6235
6236 /* Return a pointer to struct font_info of font FONT_IDX of frame F. */
6237 struct font_info *
6238 w32_get_font_info (f, font_idx)
6239 FRAME_PTR f;
6240 int font_idx;
6241 {
6242 return (FRAME_W32_FONT_TABLE (f) + font_idx);
6243 }
6244
6245
6246 struct font_info*
6247 w32_query_font (struct frame *f, char *fontname)
6248 {
6249 int i;
6250 struct font_info *pfi;
6251
6252 pfi = FRAME_W32_FONT_TABLE (f);
6253
6254 for (i = 0; i < one_w32_display_info.n_fonts ;i++, pfi++)
6255 {
6256 if (stricmp (pfi->name, fontname) == 0) return pfi;
6257 }
6258
6259 return NULL;
6260 }
6261
6262 /* Find a CCL program for a font specified by FONTP, and set the member
6263 `encoder' of the structure. */
6264
6265 void
6266 w32_find_ccl_program (fontp)
6267 struct font_info *fontp;
6268 {
6269 Lisp_Object list, elt;
6270
6271 for (list = Vfont_ccl_encoder_alist; CONSP (list); list = XCDR (list))
6272 {
6273 elt = XCAR (list);
6274 if (CONSP (elt)
6275 && STRINGP (XCAR (elt))
6276 && (fast_c_string_match_ignore_case (XCAR (elt), fontp->name)
6277 >= 0))
6278 break;
6279 }
6280 if (! NILP (list))
6281 {
6282 struct ccl_program *ccl
6283 = (struct ccl_program *) xmalloc (sizeof (struct ccl_program));
6284
6285 if (setup_ccl_program (ccl, XCDR (elt)) < 0)
6286 xfree (ccl);
6287 else
6288 fontp->font_encoder = ccl;
6289 }
6290 }
6291
6292 /* directory-files from dired.c. */
6293 Lisp_Object Fdirectory_files P_ ((Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object));
6294
6295 \f
6296 /* Find BDF files in a specified directory. (use GCPRO when calling,
6297 as this calls lisp to get a directory listing). */
6298 static Lisp_Object
6299 w32_find_bdf_fonts_in_dir (Lisp_Object directory)
6300 {
6301 Lisp_Object filelist, list = Qnil;
6302 char fontname[100];
6303
6304 if (!STRINGP (directory))
6305 return Qnil;
6306
6307 filelist = Fdirectory_files (directory, Qt,
6308 build_string (".*\\.[bB][dD][fF]"), Qt);
6309
6310 for ( ; CONSP (filelist); filelist = XCDR (filelist))
6311 {
6312 Lisp_Object filename = XCAR (filelist);
6313 if (w32_BDF_to_x_font (SDATA (filename), fontname, 100))
6314 store_in_alist (&list, build_string (fontname), filename);
6315 }
6316 return list;
6317 }
6318
6319 DEFUN ("w32-find-bdf-fonts", Fw32_find_bdf_fonts, Sw32_find_bdf_fonts,
6320 1, 1, 0,
6321 doc: /* Return a list of BDF fonts in DIRECTORY.
6322 The list is suitable for appending to `w32-bdf-filename-alist'.
6323 Fonts which do not contain an xlfd description will not be included
6324 in the list. DIRECTORY may be a list of directories. */)
6325 (directory)
6326 Lisp_Object directory;
6327 {
6328 Lisp_Object list = Qnil;
6329 struct gcpro gcpro1, gcpro2;
6330
6331 if (!CONSP (directory))
6332 return w32_find_bdf_fonts_in_dir (directory);
6333
6334 for ( ; CONSP (directory); directory = XCDR (directory))
6335 {
6336 Lisp_Object pair[2];
6337 pair[0] = list;
6338 pair[1] = Qnil;
6339 GCPRO2 (directory, list);
6340 pair[1] = w32_find_bdf_fonts_in_dir ( XCAR (directory) );
6341 list = Fnconc ( 2, pair );
6342 UNGCPRO;
6343 }
6344 return list;
6345 }
6346
6347 \f
6348 DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0,
6349 doc: /* Internal function called by `color-defined-p', which see. */)
6350 (color, frame)
6351 Lisp_Object color, frame;
6352 {
6353 XColor foo;
6354 FRAME_PTR f = check_x_frame (frame);
6355
6356 CHECK_STRING (color);
6357
6358 if (w32_defined_color (f, SDATA (color), &foo, 0))
6359 return Qt;
6360 else
6361 return Qnil;
6362 }
6363
6364 DEFUN ("xw-color-values", Fxw_color_values, Sxw_color_values, 1, 2, 0,
6365 doc: /* Internal function called by `color-values', which see. */)
6366 (color, frame)
6367 Lisp_Object color, frame;
6368 {
6369 XColor foo;
6370 FRAME_PTR f = check_x_frame (frame);
6371
6372 CHECK_STRING (color);
6373
6374 if (w32_defined_color (f, SDATA (color), &foo, 0))
6375 return list3 (make_number ((GetRValue (foo.pixel) << 8)
6376 | GetRValue (foo.pixel)),
6377 make_number ((GetGValue (foo.pixel) << 8)
6378 | GetGValue (foo.pixel)),
6379 make_number ((GetBValue (foo.pixel) << 8)
6380 | GetBValue (foo.pixel)));
6381 else
6382 return Qnil;
6383 }
6384
6385 DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0,
6386 doc: /* Internal function called by `display-color-p', which see. */)
6387 (display)
6388 Lisp_Object display;
6389 {
6390 struct w32_display_info *dpyinfo = check_x_display_info (display);
6391
6392 if ((dpyinfo->n_planes * dpyinfo->n_cbits) <= 2)
6393 return Qnil;
6394
6395 return Qt;
6396 }
6397
6398 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p,
6399 Sx_display_grayscale_p, 0, 1, 0,
6400 doc: /* Return t if DISPLAY supports shades of gray.
6401 Note that color displays do support shades of gray.
6402 The optional argument DISPLAY specifies which display to ask about.
6403 DISPLAY should be either a frame or a display name (a string).
6404 If omitted or nil, that stands for the selected frame's display. */)
6405 (display)
6406 Lisp_Object display;
6407 {
6408 struct w32_display_info *dpyinfo = check_x_display_info (display);
6409
6410 if ((dpyinfo->n_planes * dpyinfo->n_cbits) <= 1)
6411 return Qnil;
6412
6413 return Qt;
6414 }
6415
6416 DEFUN ("x-display-pixel-width", Fx_display_pixel_width,
6417 Sx_display_pixel_width, 0, 1, 0,
6418 doc: /* Return the width in pixels of DISPLAY.
6419 The optional argument DISPLAY specifies which display to ask about.
6420 DISPLAY should be either a frame or a display name (a string).
6421 If omitted or nil, that stands for the selected frame's display. */)
6422 (display)
6423 Lisp_Object display;
6424 {
6425 struct w32_display_info *dpyinfo = check_x_display_info (display);
6426
6427 return make_number (dpyinfo->width);
6428 }
6429
6430 DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
6431 Sx_display_pixel_height, 0, 1, 0,
6432 doc: /* Return the height in pixels of DISPLAY.
6433 The optional argument DISPLAY specifies which display to ask about.
6434 DISPLAY should be either a frame or a display name (a string).
6435 If omitted or nil, that stands for the selected frame's display. */)
6436 (display)
6437 Lisp_Object display;
6438 {
6439 struct w32_display_info *dpyinfo = check_x_display_info (display);
6440
6441 return make_number (dpyinfo->height);
6442 }
6443
6444 DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
6445 0, 1, 0,
6446 doc: /* Return the number of bitplanes of DISPLAY.
6447 The optional argument DISPLAY specifies which display to ask about.
6448 DISPLAY should be either a frame or a display name (a string).
6449 If omitted or nil, that stands for the selected frame's display. */)
6450 (display)
6451 Lisp_Object display;
6452 {
6453 struct w32_display_info *dpyinfo = check_x_display_info (display);
6454
6455 return make_number (dpyinfo->n_planes * dpyinfo->n_cbits);
6456 }
6457
6458 DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
6459 0, 1, 0,
6460 doc: /* Return the number of color cells of DISPLAY.
6461 The optional argument DISPLAY specifies which display to ask about.
6462 DISPLAY should be either a frame or a display name (a string).
6463 If omitted or nil, that stands for the selected frame's display. */)
6464 (display)
6465 Lisp_Object display;
6466 {
6467 struct w32_display_info *dpyinfo = check_x_display_info (display);
6468 HDC hdc;
6469 int cap;
6470
6471 hdc = GetDC (dpyinfo->root_window);
6472 if (dpyinfo->has_palette)
6473 cap = GetDeviceCaps (hdc, SIZEPALETTE);
6474 else
6475 cap = GetDeviceCaps (hdc, NUMCOLORS);
6476
6477 /* We force 24+ bit depths to 24-bit, both to prevent an overflow
6478 and because probably is more meaningful on Windows anyway */
6479 if (cap < 0)
6480 cap = 1 << min (dpyinfo->n_planes * dpyinfo->n_cbits, 24);
6481
6482 ReleaseDC (dpyinfo->root_window, hdc);
6483
6484 return make_number (cap);
6485 }
6486
6487 DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
6488 Sx_server_max_request_size,
6489 0, 1, 0,
6490 doc: /* Return the maximum request size of the server of DISPLAY.
6491 The optional argument DISPLAY specifies which display to ask about.
6492 DISPLAY should be either a frame or a display name (a string).
6493 If omitted or nil, that stands for the selected frame's display. */)
6494 (display)
6495 Lisp_Object display;
6496 {
6497 struct w32_display_info *dpyinfo = check_x_display_info (display);
6498
6499 return make_number (1);
6500 }
6501
6502 DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
6503 doc: /* Return the "vendor ID" string of the W32 system (Microsoft).
6504 The optional argument DISPLAY specifies which display to ask about.
6505 DISPLAY should be either a frame or a display name (a string).
6506 If omitted or nil, that stands for the selected frame's display. */)
6507 (display)
6508 Lisp_Object display;
6509 {
6510 return build_string ("Microsoft Corp.");
6511 }
6512
6513 DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
6514 doc: /* Return the version numbers of the server of DISPLAY.
6515 The value is a list of three integers: the major and minor
6516 version numbers of the X Protocol in use, and the distributor-specific
6517 release number. See also the function `x-server-vendor'.
6518
6519 The optional argument DISPLAY specifies which display to ask about.
6520 DISPLAY should be either a frame or a display name (a string).
6521 If omitted or nil, that stands for the selected frame's display. */)
6522 (display)
6523 Lisp_Object display;
6524 {
6525 return Fcons (make_number (w32_major_version),
6526 Fcons (make_number (w32_minor_version),
6527 Fcons (make_number (w32_build_number), Qnil)));
6528 }
6529
6530 DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
6531 doc: /* Return the number of screens on the server of DISPLAY.
6532 The optional argument DISPLAY specifies which display to ask about.
6533 DISPLAY should be either a frame or a display name (a string).
6534 If omitted or nil, that stands for the selected frame's display. */)
6535 (display)
6536 Lisp_Object display;
6537 {
6538 return make_number (1);
6539 }
6540
6541 DEFUN ("x-display-mm-height", Fx_display_mm_height,
6542 Sx_display_mm_height, 0, 1, 0,
6543 doc: /* Return the height in millimeters of DISPLAY.
6544 The optional argument DISPLAY specifies which display to ask about.
6545 DISPLAY should be either a frame or a display name (a string).
6546 If omitted or nil, that stands for the selected frame's display. */)
6547 (display)
6548 Lisp_Object display;
6549 {
6550 struct w32_display_info *dpyinfo = check_x_display_info (display);
6551 HDC hdc;
6552 int cap;
6553
6554 hdc = GetDC (dpyinfo->root_window);
6555
6556 cap = GetDeviceCaps (hdc, VERTSIZE);
6557
6558 ReleaseDC (dpyinfo->root_window, hdc);
6559
6560 return make_number (cap);
6561 }
6562
6563 DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
6564 doc: /* Return the width in millimeters of DISPLAY.
6565 The optional argument DISPLAY specifies which display to ask about.
6566 DISPLAY should be either a frame or a display name (a string).
6567 If omitted or nil, that stands for the selected frame's display. */)
6568 (display)
6569 Lisp_Object display;
6570 {
6571 struct w32_display_info *dpyinfo = check_x_display_info (display);
6572
6573 HDC hdc;
6574 int cap;
6575
6576 hdc = GetDC (dpyinfo->root_window);
6577
6578 cap = GetDeviceCaps (hdc, HORZSIZE);
6579
6580 ReleaseDC (dpyinfo->root_window, hdc);
6581
6582 return make_number (cap);
6583 }
6584
6585 DEFUN ("x-display-backing-store", Fx_display_backing_store,
6586 Sx_display_backing_store, 0, 1, 0,
6587 doc: /* Return an indication of whether DISPLAY does backing store.
6588 The value may be `always', `when-mapped', or `not-useful'.
6589 The optional argument DISPLAY specifies which display to ask about.
6590 DISPLAY should be either a frame or a display name (a string).
6591 If omitted or nil, that stands for the selected frame's display. */)
6592 (display)
6593 Lisp_Object display;
6594 {
6595 return intern ("not-useful");
6596 }
6597
6598 DEFUN ("x-display-visual-class", Fx_display_visual_class,
6599 Sx_display_visual_class, 0, 1, 0,
6600 doc: /* Return the visual class of DISPLAY.
6601 The value is one of the symbols `static-gray', `gray-scale',
6602 `static-color', `pseudo-color', `true-color', or `direct-color'.
6603
6604 The optional argument DISPLAY specifies which display to ask about.
6605 DISPLAY should be either a frame or a display name (a string).
6606 If omitted or nil, that stands for the selected frame's display. */)
6607 (display)
6608 Lisp_Object display;
6609 {
6610 struct w32_display_info *dpyinfo = check_x_display_info (display);
6611 Lisp_Object result = Qnil;
6612
6613 if (dpyinfo->has_palette)
6614 result = intern ("pseudo-color");
6615 else if (dpyinfo->n_planes * dpyinfo->n_cbits == 1)
6616 result = intern ("static-grey");
6617 else if (dpyinfo->n_planes * dpyinfo->n_cbits == 4)
6618 result = intern ("static-color");
6619 else if (dpyinfo->n_planes * dpyinfo->n_cbits > 8)
6620 result = intern ("true-color");
6621
6622 return result;
6623 }
6624
6625 DEFUN ("x-display-save-under", Fx_display_save_under,
6626 Sx_display_save_under, 0, 1, 0,
6627 doc: /* Return t if DISPLAY supports the save-under feature.
6628 The optional argument DISPLAY specifies which display to ask about.
6629 DISPLAY should be either a frame or a display name (a string).
6630 If omitted or nil, that stands for the selected frame's display. */)
6631 (display)
6632 Lisp_Object display;
6633 {
6634 return Qnil;
6635 }
6636 \f
6637 int
6638 x_pixel_width (f)
6639 register struct frame *f;
6640 {
6641 return FRAME_PIXEL_WIDTH (f);
6642 }
6643
6644 int
6645 x_pixel_height (f)
6646 register struct frame *f;
6647 {
6648 return FRAME_PIXEL_HEIGHT (f);
6649 }
6650
6651 int
6652 x_char_width (f)
6653 register struct frame *f;
6654 {
6655 return FRAME_COLUMN_WIDTH (f);
6656 }
6657
6658 int
6659 x_char_height (f)
6660 register struct frame *f;
6661 {
6662 return FRAME_LINE_HEIGHT (f);
6663 }
6664
6665 int
6666 x_screen_planes (f)
6667 register struct frame *f;
6668 {
6669 return FRAME_W32_DISPLAY_INFO (f)->n_planes;
6670 }
6671 \f
6672 /* Return the display structure for the display named NAME.
6673 Open a new connection if necessary. */
6674
6675 struct w32_display_info *
6676 x_display_info_for_name (name)
6677 Lisp_Object name;
6678 {
6679 Lisp_Object names;
6680 struct w32_display_info *dpyinfo;
6681
6682 CHECK_STRING (name);
6683
6684 for (dpyinfo = &one_w32_display_info, names = w32_display_name_list;
6685 dpyinfo;
6686 dpyinfo = dpyinfo->next, names = XCDR (names))
6687 {
6688 Lisp_Object tem;
6689 tem = Fstring_equal (XCAR (XCAR (names)), name);
6690 if (!NILP (tem))
6691 return dpyinfo;
6692 }
6693
6694 /* Use this general default value to start with. */
6695 Vx_resource_name = Vinvocation_name;
6696
6697 validate_x_resource_name ();
6698
6699 dpyinfo = w32_term_init (name, (unsigned char *)0,
6700 (char *) SDATA (Vx_resource_name));
6701
6702 if (dpyinfo == 0)
6703 error ("Cannot connect to server %s", SDATA (name));
6704
6705 w32_in_use = 1;
6706 XSETFASTINT (Vwindow_system_version, 3);
6707
6708 return dpyinfo;
6709 }
6710
6711 DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
6712 1, 3, 0, doc: /* Open a connection to a server.
6713 DISPLAY is the name of the display to connect to.
6714 Optional second arg XRM-STRING is a string of resources in xrdb format.
6715 If the optional third arg MUST-SUCCEED is non-nil,
6716 terminate Emacs if we can't open the connection. */)
6717 (display, xrm_string, must_succeed)
6718 Lisp_Object display, xrm_string, must_succeed;
6719 {
6720 unsigned char *xrm_option;
6721 struct w32_display_info *dpyinfo;
6722
6723 /* If initialization has already been done, return now to avoid
6724 overwriting critical parts of one_w32_display_info. */
6725 if (w32_in_use)
6726 return Qnil;
6727
6728 CHECK_STRING (display);
6729 if (! NILP (xrm_string))
6730 CHECK_STRING (xrm_string);
6731
6732 #if 0
6733 if (! EQ (Vwindow_system, intern ("w32")))
6734 error ("Not using Microsoft Windows");
6735 #endif
6736
6737 /* Allow color mapping to be defined externally; first look in user's
6738 HOME directory, then in Emacs etc dir for a file called rgb.txt. */
6739 {
6740 Lisp_Object color_file;
6741 struct gcpro gcpro1;
6742
6743 color_file = build_string ("~/rgb.txt");
6744
6745 GCPRO1 (color_file);
6746
6747 if (NILP (Ffile_readable_p (color_file)))
6748 color_file =
6749 Fexpand_file_name (build_string ("rgb.txt"),
6750 Fsymbol_value (intern ("data-directory")));
6751
6752 Vw32_color_map = Fw32_load_color_file (color_file);
6753
6754 UNGCPRO;
6755 }
6756 if (NILP (Vw32_color_map))
6757 Vw32_color_map = Fw32_default_color_map ();
6758
6759 /* Merge in system logical colors. */
6760 add_system_logical_colors_to_map (&Vw32_color_map);
6761
6762 if (! NILP (xrm_string))
6763 xrm_option = (unsigned char *) SDATA (xrm_string);
6764 else
6765 xrm_option = (unsigned char *) 0;
6766
6767 /* Use this general default value to start with. */
6768 /* First remove .exe suffix from invocation-name - it looks ugly. */
6769 {
6770 char basename[ MAX_PATH ], *str;
6771
6772 strcpy (basename, SDATA (Vinvocation_name));
6773 str = strrchr (basename, '.');
6774 if (str) *str = 0;
6775 Vinvocation_name = build_string (basename);
6776 }
6777 Vx_resource_name = Vinvocation_name;
6778
6779 validate_x_resource_name ();
6780
6781 /* This is what opens the connection and sets x_current_display.
6782 This also initializes many symbols, such as those used for input. */
6783 dpyinfo = w32_term_init (display, xrm_option,
6784 (char *) SDATA (Vx_resource_name));
6785
6786 if (dpyinfo == 0)
6787 {
6788 if (!NILP (must_succeed))
6789 fatal ("Cannot connect to server %s.\n",
6790 SDATA (display));
6791 else
6792 error ("Cannot connect to server %s", SDATA (display));
6793 }
6794
6795 w32_in_use = 1;
6796
6797 XSETFASTINT (Vwindow_system_version, 3);
6798 return Qnil;
6799 }
6800
6801 DEFUN ("x-close-connection", Fx_close_connection,
6802 Sx_close_connection, 1, 1, 0,
6803 doc: /* Close the connection to DISPLAY's server.
6804 For DISPLAY, specify either a frame or a display name (a string).
6805 If DISPLAY is nil, that stands for the selected frame's display. */)
6806 (display)
6807 Lisp_Object display;
6808 {
6809 struct w32_display_info *dpyinfo = check_x_display_info (display);
6810 int i;
6811
6812 if (dpyinfo->reference_count > 0)
6813 error ("Display still has frames on it");
6814
6815 BLOCK_INPUT;
6816 /* Free the fonts in the font table. */
6817 for (i = 0; i < dpyinfo->n_fonts; i++)
6818 if (dpyinfo->font_table[i].name)
6819 {
6820 if (dpyinfo->font_table[i].name != dpyinfo->font_table[i].full_name)
6821 xfree (dpyinfo->font_table[i].full_name);
6822 xfree (dpyinfo->font_table[i].name);
6823 w32_unload_font (dpyinfo, dpyinfo->font_table[i].font);
6824 }
6825 x_destroy_all_bitmaps (dpyinfo);
6826
6827 x_delete_display (dpyinfo);
6828 UNBLOCK_INPUT;
6829
6830 return Qnil;
6831 }
6832
6833 DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0,
6834 doc: /* Return the list of display names that Emacs has connections to. */)
6835 ()
6836 {
6837 Lisp_Object tail, result;
6838
6839 result = Qnil;
6840 for (tail = w32_display_name_list; CONSP (tail); tail = XCDR (tail))
6841 result = Fcons (XCAR (XCAR (tail)), result);
6842
6843 return result;
6844 }
6845
6846 DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize, 1, 2, 0,
6847 doc: /* This is a noop on W32 systems. */)
6848 (on, display)
6849 Lisp_Object display, on;
6850 {
6851 return Qnil;
6852 }
6853
6854
6855 \f
6856 /***********************************************************************
6857 Window properties
6858 ***********************************************************************/
6859
6860 DEFUN ("x-change-window-property", Fx_change_window_property,
6861 Sx_change_window_property, 2, 6, 0,
6862 doc: /* Change window property PROP to VALUE on the X window of FRAME.
6863 VALUE may be a string or a list of conses, numbers and/or strings.
6864 If an element in the list is a string, it is converted to
6865 an Atom and the value of the Atom is used. If an element is a cons,
6866 it is converted to a 32 bit number where the car is the 16 top bits and the
6867 cdr is the lower 16 bits.
6868 FRAME nil or omitted means use the selected frame.
6869 If TYPE is given and non-nil, it is the name of the type of VALUE.
6870 If TYPE is not given or nil, the type is STRING.
6871 FORMAT gives the size in bits of each element if VALUE is a list.
6872 It must be one of 8, 16 or 32.
6873 If VALUE is a string or FORMAT is nil or not given, FORMAT defaults to 8.
6874 If OUTER_P is non-nil, the property is changed for the outer X window of
6875 FRAME. Default is to change on the edit X window.
6876
6877 Value is VALUE. */)
6878 (prop, value, frame, type, format, outer_p)
6879 Lisp_Object prop, value, frame, type, format, outer_p;
6880 {
6881 #if 0 /* TODO : port window properties to W32 */
6882 struct frame *f = check_x_frame (frame);
6883 Atom prop_atom;
6884
6885 CHECK_STRING (prop);
6886 CHECK_STRING (value);
6887
6888 BLOCK_INPUT;
6889 prop_atom = XInternAtom (FRAME_W32_DISPLAY (f), SDATA (prop), False);
6890 XChangeProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
6891 prop_atom, XA_STRING, 8, PropModeReplace,
6892 SDATA (value), SCHARS (value));
6893
6894 /* Make sure the property is set when we return. */
6895 XFlush (FRAME_W32_DISPLAY (f));
6896 UNBLOCK_INPUT;
6897
6898 #endif /* TODO */
6899
6900 return value;
6901 }
6902
6903
6904 DEFUN ("x-delete-window-property", Fx_delete_window_property,
6905 Sx_delete_window_property, 1, 2, 0,
6906 doc: /* Remove window property PROP from X window of FRAME.
6907 FRAME nil or omitted means use the selected frame. Value is PROP. */)
6908 (prop, frame)
6909 Lisp_Object prop, frame;
6910 {
6911 #if 0 /* TODO : port window properties to W32 */
6912
6913 struct frame *f = check_x_frame (frame);
6914 Atom prop_atom;
6915
6916 CHECK_STRING (prop);
6917 BLOCK_INPUT;
6918 prop_atom = XInternAtom (FRAME_W32_DISPLAY (f), SDATA (prop), False);
6919 XDeleteProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f), prop_atom);
6920
6921 /* Make sure the property is removed when we return. */
6922 XFlush (FRAME_W32_DISPLAY (f));
6923 UNBLOCK_INPUT;
6924 #endif /* TODO */
6925
6926 return prop;
6927 }
6928
6929
6930 DEFUN ("x-window-property", Fx_window_property, Sx_window_property,
6931 1, 2, 0,
6932 doc: /* Value is the value of window property PROP on FRAME.
6933 If FRAME is nil or omitted, use the selected frame. Value is nil
6934 if FRAME hasn't a property with name PROP or if PROP has no string
6935 value. */)
6936 (prop, frame)
6937 Lisp_Object prop, frame;
6938 {
6939 #if 0 /* TODO : port window properties to W32 */
6940
6941 struct frame *f = check_x_frame (frame);
6942 Atom prop_atom;
6943 int rc;
6944 Lisp_Object prop_value = Qnil;
6945 char *tmp_data = NULL;
6946 Atom actual_type;
6947 int actual_format;
6948 unsigned long actual_size, bytes_remaining;
6949
6950 CHECK_STRING (prop);
6951 BLOCK_INPUT;
6952 prop_atom = XInternAtom (FRAME_W32_DISPLAY (f), SDATA (prop), False);
6953 rc = XGetWindowProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
6954 prop_atom, 0, 0, False, XA_STRING,
6955 &actual_type, &actual_format, &actual_size,
6956 &bytes_remaining, (unsigned char **) &tmp_data);
6957 if (rc == Success)
6958 {
6959 int size = bytes_remaining;
6960
6961 XFree (tmp_data);
6962 tmp_data = NULL;
6963
6964 rc = XGetWindowProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
6965 prop_atom, 0, bytes_remaining,
6966 False, XA_STRING,
6967 &actual_type, &actual_format,
6968 &actual_size, &bytes_remaining,
6969 (unsigned char **) &tmp_data);
6970 if (rc == Success)
6971 prop_value = make_string (tmp_data, size);
6972
6973 XFree (tmp_data);
6974 }
6975
6976 UNBLOCK_INPUT;
6977
6978 return prop_value;
6979
6980 #endif /* TODO */
6981 return Qnil;
6982 }
6983
6984
6985 \f
6986 /***********************************************************************
6987 Busy cursor
6988 ***********************************************************************/
6989
6990 /* If non-null, an asynchronous timer that, when it expires, displays
6991 an hourglass cursor on all frames. */
6992
6993 static struct atimer *hourglass_atimer;
6994
6995 /* Non-zero means an hourglass cursor is currently shown. */
6996
6997 static int hourglass_shown_p;
6998
6999 /* Number of seconds to wait before displaying an hourglass cursor. */
7000
7001 static Lisp_Object Vhourglass_delay;
7002
7003 /* Default number of seconds to wait before displaying an hourglass
7004 cursor. */
7005
7006 #define DEFAULT_HOURGLASS_DELAY 1
7007
7008 /* Function prototypes. */
7009
7010 static void show_hourglass P_ ((struct atimer *));
7011 static void hide_hourglass P_ ((void));
7012
7013
7014 /* Cancel a currently active hourglass timer, and start a new one. */
7015
7016 void
7017 start_hourglass ()
7018 {
7019 #if 0 /* TODO: cursor shape changes. */
7020 EMACS_TIME delay;
7021 int secs, usecs = 0;
7022
7023 cancel_hourglass ();
7024
7025 if (INTEGERP (Vhourglass_delay)
7026 && XINT (Vhourglass_delay) > 0)
7027 secs = XFASTINT (Vhourglass_delay);
7028 else if (FLOATP (Vhourglass_delay)
7029 && XFLOAT_DATA (Vhourglass_delay) > 0)
7030 {
7031 Lisp_Object tem;
7032 tem = Ftruncate (Vhourglass_delay, Qnil);
7033 secs = XFASTINT (tem);
7034 usecs = (XFLOAT_DATA (Vhourglass_delay) - secs) * 1000000;
7035 }
7036 else
7037 secs = DEFAULT_HOURGLASS_DELAY;
7038
7039 EMACS_SET_SECS_USECS (delay, secs, usecs);
7040 hourglass_atimer = start_atimer (ATIMER_RELATIVE, delay,
7041 show_hourglass, NULL);
7042 #endif
7043 }
7044
7045
7046 /* Cancel the hourglass cursor timer if active, hide an hourglass
7047 cursor if shown. */
7048
7049 void
7050 cancel_hourglass ()
7051 {
7052 if (hourglass_atimer)
7053 {
7054 cancel_atimer (hourglass_atimer);
7055 hourglass_atimer = NULL;
7056 }
7057
7058 if (hourglass_shown_p)
7059 hide_hourglass ();
7060 }
7061
7062
7063 /* Timer function of hourglass_atimer. TIMER is equal to
7064 hourglass_atimer.
7065
7066 Display an hourglass cursor on all frames by mapping the frames'
7067 hourglass_window. Set the hourglass_p flag in the frames'
7068 output_data.x structure to indicate that an hourglass cursor is
7069 shown on the frames. */
7070
7071 static void
7072 show_hourglass (timer)
7073 struct atimer *timer;
7074 {
7075 #if 0 /* TODO: cursor shape changes. */
7076 /* The timer implementation will cancel this timer automatically
7077 after this function has run. Set hourglass_atimer to null
7078 so that we know the timer doesn't have to be canceled. */
7079 hourglass_atimer = NULL;
7080
7081 if (!hourglass_shown_p)
7082 {
7083 Lisp_Object rest, frame;
7084
7085 BLOCK_INPUT;
7086
7087 FOR_EACH_FRAME (rest, frame)
7088 if (FRAME_W32_P (XFRAME (frame)))
7089 {
7090 struct frame *f = XFRAME (frame);
7091
7092 f->output_data.w32->hourglass_p = 1;
7093
7094 if (!f->output_data.w32->hourglass_window)
7095 {
7096 unsigned long mask = CWCursor;
7097 XSetWindowAttributes attrs;
7098
7099 attrs.cursor = f->output_data.w32->hourglass_cursor;
7100
7101 f->output_data.w32->hourglass_window
7102 = XCreateWindow (FRAME_X_DISPLAY (f),
7103 FRAME_OUTER_WINDOW (f),
7104 0, 0, 32000, 32000, 0, 0,
7105 InputOnly,
7106 CopyFromParent,
7107 mask, &attrs);
7108 }
7109
7110 XMapRaised (FRAME_X_DISPLAY (f),
7111 f->output_data.w32->hourglass_window);
7112 XFlush (FRAME_X_DISPLAY (f));
7113 }
7114
7115 hourglass_shown_p = 1;
7116 UNBLOCK_INPUT;
7117 }
7118 #endif
7119 }
7120
7121
7122 /* Hide the hourglass cursor on all frames, if it is currently shown. */
7123
7124 static void
7125 hide_hourglass ()
7126 {
7127 #if 0 /* TODO: cursor shape changes. */
7128 if (hourglass_shown_p)
7129 {
7130 Lisp_Object rest, frame;
7131
7132 BLOCK_INPUT;
7133 FOR_EACH_FRAME (rest, frame)
7134 {
7135 struct frame *f = XFRAME (frame);
7136
7137 if (FRAME_W32_P (f)
7138 /* Watch out for newly created frames. */
7139 && f->output_data.x->hourglass_window)
7140 {
7141 XUnmapWindow (FRAME_X_DISPLAY (f),
7142 f->output_data.x->hourglass_window);
7143 /* Sync here because XTread_socket looks at the
7144 hourglass_p flag that is reset to zero below. */
7145 XSync (FRAME_X_DISPLAY (f), False);
7146 f->output_data.x->hourglass_p = 0;
7147 }
7148 }
7149
7150 hourglass_shown_p = 0;
7151 UNBLOCK_INPUT;
7152 }
7153 #endif
7154 }
7155
7156
7157 \f
7158 /***********************************************************************
7159 Tool tips
7160 ***********************************************************************/
7161
7162 static Lisp_Object x_create_tip_frame P_ ((struct w32_display_info *,
7163 Lisp_Object, Lisp_Object));
7164 static void compute_tip_xy P_ ((struct frame *, Lisp_Object, Lisp_Object,
7165 Lisp_Object, int, int, int *, int *));
7166
7167 /* The frame of a currently visible tooltip. */
7168
7169 Lisp_Object tip_frame;
7170
7171 /* If non-nil, a timer started that hides the last tooltip when it
7172 fires. */
7173
7174 Lisp_Object tip_timer;
7175 Window tip_window;
7176
7177 /* If non-nil, a vector of 3 elements containing the last args
7178 with which x-show-tip was called. See there. */
7179
7180 Lisp_Object last_show_tip_args;
7181
7182 /* Maximum size for tooltips; a cons (COLUMNS . ROWS). */
7183
7184 Lisp_Object Vx_max_tooltip_size;
7185
7186
7187 static Lisp_Object
7188 unwind_create_tip_frame (frame)
7189 Lisp_Object frame;
7190 {
7191 Lisp_Object deleted;
7192
7193 deleted = unwind_create_frame (frame);
7194 if (EQ (deleted, Qt))
7195 {
7196 tip_window = NULL;
7197 tip_frame = Qnil;
7198 }
7199
7200 return deleted;
7201 }
7202
7203
7204 /* Create a frame for a tooltip on the display described by DPYINFO.
7205 PARMS is a list of frame parameters. TEXT is the string to
7206 display in the tip frame. Value is the frame.
7207
7208 Note that functions called here, esp. x_default_parameter can
7209 signal errors, for instance when a specified color name is
7210 undefined. We have to make sure that we're in a consistent state
7211 when this happens. */
7212
7213 static Lisp_Object
7214 x_create_tip_frame (dpyinfo, parms, text)
7215 struct w32_display_info *dpyinfo;
7216 Lisp_Object parms, text;
7217 {
7218 struct frame *f;
7219 Lisp_Object frame, tem;
7220 Lisp_Object name;
7221 long window_prompting = 0;
7222 int width, height;
7223 int count = SPECPDL_INDEX ();
7224 struct gcpro gcpro1, gcpro2, gcpro3;
7225 struct kboard *kb;
7226 int face_change_count_before = face_change_count;
7227 Lisp_Object buffer;
7228 struct buffer *old_buffer;
7229
7230 check_w32 ();
7231
7232 /* Use this general default value to start with until we know if
7233 this frame has a specified name. */
7234 Vx_resource_name = Vinvocation_name;
7235
7236 #ifdef MULTI_KBOARD
7237 kb = dpyinfo->terminal->kboard;
7238 #else
7239 kb = &the_only_kboard;
7240 #endif
7241
7242 /* Get the name of the frame to use for resource lookup. */
7243 name = w32_get_arg (parms, Qname, "name", "Name", RES_TYPE_STRING);
7244 if (!STRINGP (name)
7245 && !EQ (name, Qunbound)
7246 && !NILP (name))
7247 error ("Invalid frame name--not a string or nil");
7248 Vx_resource_name = name;
7249
7250 frame = Qnil;
7251 GCPRO3 (parms, name, frame);
7252 /* Make a frame without minibuffer nor mode-line. */
7253 f = make_frame (0);
7254 f->wants_modeline = 0;
7255 XSETFRAME (frame, f);
7256
7257 buffer = Fget_buffer_create (build_string (" *tip*"));
7258 Fset_window_buffer (FRAME_ROOT_WINDOW (f), buffer, Qnil);
7259 old_buffer = current_buffer;
7260 set_buffer_internal_1 (XBUFFER (buffer));
7261 current_buffer->truncate_lines = Qnil;
7262 specbind (Qinhibit_read_only, Qt);
7263 specbind (Qinhibit_modification_hooks, Qt);
7264 Ferase_buffer ();
7265 Finsert (1, &text);
7266 set_buffer_internal_1 (old_buffer);
7267
7268 FRAME_CAN_HAVE_SCROLL_BARS (f) = 0;
7269 record_unwind_protect (unwind_create_tip_frame, frame);
7270
7271 /* By setting the output method, we're essentially saying that
7272 the frame is live, as per FRAME_LIVE_P. If we get a signal
7273 from this point on, x_destroy_window might screw up reference
7274 counts etc. */
7275 f->terminal = dpyinfo->terminal;
7276 f->terminal->reference_count++;
7277 f->output_method = output_w32;
7278 f->output_data.w32 =
7279 (struct w32_output *) xmalloc (sizeof (struct w32_output));
7280 bzero (f->output_data.w32, sizeof (struct w32_output));
7281
7282 FRAME_FONTSET (f) = -1;
7283 f->icon_name = Qnil;
7284
7285 #if 0 /* GLYPH_DEBUG TODO: image support. */
7286 image_cache_refcount = FRAME_X_IMAGE_CACHE (f)->refcount;
7287 dpyinfo_refcount = dpyinfo->reference_count;
7288 #endif /* GLYPH_DEBUG */
7289 #ifdef MULTI_KBOARD
7290 FRAME_KBOARD (f) = kb;
7291 #endif
7292 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
7293 f->output_data.w32->explicit_parent = 0;
7294
7295 /* Set the name; the functions to which we pass f expect the name to
7296 be set. */
7297 if (EQ (name, Qunbound) || NILP (name))
7298 {
7299 f->name = build_string (dpyinfo->w32_id_name);
7300 f->explicit_name = 0;
7301 }
7302 else
7303 {
7304 f->name = name;
7305 f->explicit_name = 1;
7306 /* use the frame's title when getting resources for this frame. */
7307 specbind (Qx_resource_name, name);
7308 }
7309
7310 /* Extract the window parameters from the supplied values
7311 that are needed to determine window geometry. */
7312 {
7313 Lisp_Object font;
7314
7315 font = w32_get_arg (parms, Qfont, "font", "Font", RES_TYPE_STRING);
7316
7317 BLOCK_INPUT;
7318 /* First, try whatever font the caller has specified. */
7319 if (STRINGP (font))
7320 {
7321 tem = Fquery_fontset (font, Qnil);
7322 if (STRINGP (tem))
7323 font = x_new_fontset (f, SDATA (tem));
7324 else
7325 font = x_new_font (f, SDATA (font));
7326 }
7327
7328 /* Try out a font which we hope has bold and italic variations. */
7329 if (!STRINGP (font))
7330 font = x_new_font (f, "-*-Courier New-normal-r-*-*-*-100-*-*-c-*-iso8859-1");
7331 if (! STRINGP (font))
7332 font = x_new_font (f, "-*-Courier-normal-r-*-*-13-*-*-*-c-*-iso8859-1");
7333 /* If those didn't work, look for something which will at least work. */
7334 if (! STRINGP (font))
7335 font = x_new_font (f, "-*-Fixedsys-normal-r-*-*-12-*-*-*-c-*-iso8859-1");
7336 UNBLOCK_INPUT;
7337 if (! STRINGP (font))
7338 font = build_string ("Fixedsys");
7339
7340 x_default_parameter (f, parms, Qfont, font,
7341 "font", "Font", RES_TYPE_STRING);
7342 }
7343
7344 x_default_parameter (f, parms, Qborder_width, make_number (2),
7345 "borderWidth", "BorderWidth", RES_TYPE_NUMBER);
7346 /* This defaults to 2 in order to match xterm. We recognize either
7347 internalBorderWidth or internalBorder (which is what xterm calls
7348 it). */
7349 if (NILP (Fassq (Qinternal_border_width, parms)))
7350 {
7351 Lisp_Object value;
7352
7353 value = w32_get_arg (parms, Qinternal_border_width,
7354 "internalBorder", "internalBorder", RES_TYPE_NUMBER);
7355 if (! EQ (value, Qunbound))
7356 parms = Fcons (Fcons (Qinternal_border_width, value),
7357 parms);
7358 }
7359 x_default_parameter (f, parms, Qinternal_border_width, make_number (1),
7360 "internalBorderWidth", "internalBorderWidth",
7361 RES_TYPE_NUMBER);
7362
7363 /* Also do the stuff which must be set before the window exists. */
7364 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
7365 "foreground", "Foreground", RES_TYPE_STRING);
7366 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
7367 "background", "Background", RES_TYPE_STRING);
7368 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
7369 "pointerColor", "Foreground", RES_TYPE_STRING);
7370 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
7371 "cursorColor", "Foreground", RES_TYPE_STRING);
7372 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
7373 "borderColor", "BorderColor", RES_TYPE_STRING);
7374
7375 /* Init faces before x_default_parameter is called for scroll-bar
7376 parameters because that function calls x_set_scroll_bar_width,
7377 which calls change_frame_size, which calls Fset_window_buffer,
7378 which runs hooks, which call Fvertical_motion. At the end, we
7379 end up in init_iterator with a null face cache, which should not
7380 happen. */
7381 init_frame_faces (f);
7382
7383 f->output_data.w32->dwStyle = WS_BORDER | WS_POPUP | WS_DISABLED;
7384 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
7385
7386 window_prompting = x_figure_window_size (f, parms, 0);
7387
7388 /* No fringes on tip frame. */
7389 f->fringe_cols = 0;
7390 f->left_fringe_width = 0;
7391 f->right_fringe_width = 0;
7392
7393 BLOCK_INPUT;
7394 my_create_tip_window (f);
7395 UNBLOCK_INPUT;
7396
7397 x_make_gc (f);
7398
7399 x_default_parameter (f, parms, Qauto_raise, Qnil,
7400 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
7401 x_default_parameter (f, parms, Qauto_lower, Qnil,
7402 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
7403 x_default_parameter (f, parms, Qcursor_type, Qbox,
7404 "cursorType", "CursorType", RES_TYPE_SYMBOL);
7405
7406 /* Dimensions, especially FRAME_LINES (f), must be done via change_frame_size.
7407 Change will not be effected unless different from the current
7408 FRAME_LINES (f). */
7409 width = FRAME_COLS (f);
7410 height = FRAME_LINES (f);
7411 FRAME_LINES (f) = 0;
7412 SET_FRAME_COLS (f, 0);
7413 change_frame_size (f, height, width, 1, 0, 0);
7414
7415 /* Add `tooltip' frame parameter's default value. */
7416 if (NILP (Fframe_parameter (frame, intern ("tooltip"))))
7417 Fmodify_frame_parameters (frame, Fcons (Fcons (intern ("tooltip"), Qt),
7418 Qnil));
7419
7420 /* Set up faces after all frame parameters are known. This call
7421 also merges in face attributes specified for new frames.
7422
7423 Frame parameters may be changed if .Xdefaults contains
7424 specifications for the default font. For example, if there is an
7425 `Emacs.default.attributeBackground: pink', the `background-color'
7426 attribute of the frame get's set, which let's the internal border
7427 of the tooltip frame appear in pink. Prevent this. */
7428 {
7429 Lisp_Object bg = Fframe_parameter (frame, Qbackground_color);
7430
7431 /* Set tip_frame here, so that */
7432 tip_frame = frame;
7433 call1 (Qface_set_after_frame_default, frame);
7434
7435 if (!EQ (bg, Fframe_parameter (frame, Qbackground_color)))
7436 Fmodify_frame_parameters (frame, Fcons (Fcons (Qbackground_color, bg),
7437 Qnil));
7438 }
7439
7440 f->no_split = 1;
7441
7442 UNGCPRO;
7443
7444 /* It is now ok to make the frame official even if we get an error
7445 below. And the frame needs to be on Vframe_list or making it
7446 visible won't work. */
7447 Vframe_list = Fcons (frame, Vframe_list);
7448
7449 /* Now that the frame is official, it counts as a reference to
7450 its display. */
7451 FRAME_W32_DISPLAY_INFO (f)->reference_count++;
7452
7453 /* Setting attributes of faces of the tooltip frame from resources
7454 and similar will increment face_change_count, which leads to the
7455 clearing of all current matrices. Since this isn't necessary
7456 here, avoid it by resetting face_change_count to the value it
7457 had before we created the tip frame. */
7458 face_change_count = face_change_count_before;
7459
7460 /* Discard the unwind_protect. */
7461 return unbind_to (count, frame);
7462 }
7463
7464
7465 /* Compute where to display tip frame F. PARMS is the list of frame
7466 parameters for F. DX and DY are specified offsets from the current
7467 location of the mouse. WIDTH and HEIGHT are the width and height
7468 of the tooltip. Return coordinates relative to the root window of
7469 the display in *ROOT_X, and *ROOT_Y. */
7470
7471 static void
7472 compute_tip_xy (f, parms, dx, dy, width, height, root_x, root_y)
7473 struct frame *f;
7474 Lisp_Object parms, dx, dy;
7475 int width, height;
7476 int *root_x, *root_y;
7477 {
7478 Lisp_Object left, top;
7479
7480 /* User-specified position? */
7481 left = Fcdr (Fassq (Qleft, parms));
7482 top = Fcdr (Fassq (Qtop, parms));
7483
7484 /* Move the tooltip window where the mouse pointer is. Resize and
7485 show it. */
7486 if (!INTEGERP (left) || !INTEGERP (top))
7487 {
7488 POINT pt;
7489
7490 BLOCK_INPUT;
7491 GetCursorPos (&pt);
7492 *root_x = pt.x;
7493 *root_y = pt.y;
7494 UNBLOCK_INPUT;
7495 }
7496
7497 if (INTEGERP (top))
7498 *root_y = XINT (top);
7499 else if (*root_y + XINT (dy) <= 0)
7500 *root_y = 0; /* Can happen for negative dy */
7501 else if (*root_y + XINT (dy) + height <= FRAME_W32_DISPLAY_INFO (f)->height)
7502 /* It fits below the pointer */
7503 *root_y += XINT (dy);
7504 else if (height + XINT (dy) <= *root_y)
7505 /* It fits above the pointer. */
7506 *root_y -= height + XINT (dy);
7507 else
7508 /* Put it on the top. */
7509 *root_y = 0;
7510
7511 if (INTEGERP (left))
7512 *root_x = XINT (left);
7513 else if (*root_x + XINT (dx) <= 0)
7514 *root_x = 0; /* Can happen for negative dx */
7515 else if (*root_x + XINT (dx) + width <= FRAME_W32_DISPLAY_INFO (f)->width)
7516 /* It fits to the right of the pointer. */
7517 *root_x += XINT (dx);
7518 else if (width + XINT (dx) <= *root_x)
7519 /* It fits to the left of the pointer. */
7520 *root_x -= width + XINT (dx);
7521 else
7522 /* Put it left justified on the screen -- it ought to fit that way. */
7523 *root_x = 0;
7524 }
7525
7526
7527 DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
7528 doc: /* Show STRING in a \"tooltip\" window on frame FRAME.
7529 A tooltip window is a small window displaying a string.
7530
7531 This is an internal function; Lisp code should call `tooltip-show'.
7532
7533 FRAME nil or omitted means use the selected frame.
7534
7535 PARMS is an optional list of frame parameters which can be
7536 used to change the tooltip's appearance.
7537
7538 Automatically hide the tooltip after TIMEOUT seconds. TIMEOUT nil
7539 means use the default timeout of 5 seconds.
7540
7541 If the list of frame parameters PARMS contains a `left' parameter,
7542 the tooltip is displayed at that x-position. Otherwise it is
7543 displayed at the mouse position, with offset DX added (default is 5 if
7544 DX isn't specified). Likewise for the y-position; if a `top' frame
7545 parameter is specified, it determines the y-position of the tooltip
7546 window, otherwise it is displayed at the mouse position, with offset
7547 DY added (default is -10).
7548
7549 A tooltip's maximum size is specified by `x-max-tooltip-size'.
7550 Text larger than the specified size is clipped. */)
7551 (string, frame, parms, timeout, dx, dy)
7552 Lisp_Object string, frame, parms, timeout, dx, dy;
7553 {
7554 struct frame *f;
7555 struct window *w;
7556 int root_x, root_y;
7557 struct buffer *old_buffer;
7558 struct text_pos pos;
7559 int i, width, height;
7560 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
7561 int old_windows_or_buffers_changed = windows_or_buffers_changed;
7562 int count = SPECPDL_INDEX ();
7563
7564 specbind (Qinhibit_redisplay, Qt);
7565
7566 GCPRO4 (string, parms, frame, timeout);
7567
7568 CHECK_STRING (string);
7569 f = check_x_frame (frame);
7570 if (NILP (timeout))
7571 timeout = make_number (5);
7572 else
7573 CHECK_NATNUM (timeout);
7574
7575 if (NILP (dx))
7576 dx = make_number (5);
7577 else
7578 CHECK_NUMBER (dx);
7579
7580 if (NILP (dy))
7581 dy = make_number (-10);
7582 else
7583 CHECK_NUMBER (dy);
7584
7585 if (NILP (last_show_tip_args))
7586 last_show_tip_args = Fmake_vector (make_number (3), Qnil);
7587
7588 if (!NILP (tip_frame))
7589 {
7590 Lisp_Object last_string = AREF (last_show_tip_args, 0);
7591 Lisp_Object last_frame = AREF (last_show_tip_args, 1);
7592 Lisp_Object last_parms = AREF (last_show_tip_args, 2);
7593
7594 if (EQ (frame, last_frame)
7595 && !NILP (Fequal (last_string, string))
7596 && !NILP (Fequal (last_parms, parms)))
7597 {
7598 struct frame *f = XFRAME (tip_frame);
7599
7600 /* Only DX and DY have changed. */
7601 if (!NILP (tip_timer))
7602 {
7603 Lisp_Object timer = tip_timer;
7604 tip_timer = Qnil;
7605 call1 (Qcancel_timer, timer);
7606 }
7607
7608 BLOCK_INPUT;
7609 compute_tip_xy (f, parms, dx, dy, FRAME_PIXEL_WIDTH (f),
7610 FRAME_PIXEL_HEIGHT (f), &root_x, &root_y);
7611
7612 /* Put tooltip in topmost group and in position. */
7613 SetWindowPos (FRAME_W32_WINDOW (f), HWND_TOPMOST,
7614 root_x, root_y, 0, 0,
7615 SWP_NOSIZE | SWP_NOACTIVATE);
7616
7617 /* Ensure tooltip is on top of other topmost windows (eg menus). */
7618 SetWindowPos (FRAME_W32_WINDOW (f), HWND_TOP,
7619 0, 0, 0, 0,
7620 SWP_NOMOVE | SWP_NOSIZE | SWP_NOACTIVATE);
7621
7622 UNBLOCK_INPUT;
7623 goto start_timer;
7624 }
7625 }
7626
7627 /* Hide a previous tip, if any. */
7628 Fx_hide_tip ();
7629
7630 ASET (last_show_tip_args, 0, string);
7631 ASET (last_show_tip_args, 1, frame);
7632 ASET (last_show_tip_args, 2, parms);
7633
7634 /* Add default values to frame parameters. */
7635 if (NILP (Fassq (Qname, parms)))
7636 parms = Fcons (Fcons (Qname, build_string ("tooltip")), parms);
7637 if (NILP (Fassq (Qinternal_border_width, parms)))
7638 parms = Fcons (Fcons (Qinternal_border_width, make_number (3)), parms);
7639 if (NILP (Fassq (Qborder_width, parms)))
7640 parms = Fcons (Fcons (Qborder_width, make_number (1)), parms);
7641 if (NILP (Fassq (Qborder_color, parms)))
7642 parms = Fcons (Fcons (Qborder_color, build_string ("lightyellow")), parms);
7643 if (NILP (Fassq (Qbackground_color, parms)))
7644 parms = Fcons (Fcons (Qbackground_color, build_string ("lightyellow")),
7645 parms);
7646
7647 /* Block input until the tip has been fully drawn, to avoid crashes
7648 when drawing tips in menus. */
7649 BLOCK_INPUT;
7650
7651 /* Create a frame for the tooltip, and record it in the global
7652 variable tip_frame. */
7653 frame = x_create_tip_frame (FRAME_W32_DISPLAY_INFO (f), parms, string);
7654 f = XFRAME (frame);
7655
7656 /* Set up the frame's root window. */
7657 w = XWINDOW (FRAME_ROOT_WINDOW (f));
7658 w->left_col = w->top_line = make_number (0);
7659
7660 if (CONSP (Vx_max_tooltip_size)
7661 && INTEGERP (XCAR (Vx_max_tooltip_size))
7662 && XINT (XCAR (Vx_max_tooltip_size)) > 0
7663 && INTEGERP (XCDR (Vx_max_tooltip_size))
7664 && XINT (XCDR (Vx_max_tooltip_size)) > 0)
7665 {
7666 w->total_cols = XCAR (Vx_max_tooltip_size);
7667 w->total_lines = XCDR (Vx_max_tooltip_size);
7668 }
7669 else
7670 {
7671 w->total_cols = make_number (80);
7672 w->total_lines = make_number (40);
7673 }
7674
7675 FRAME_TOTAL_COLS (f) = XINT (w->total_cols);
7676 adjust_glyphs (f);
7677 w->pseudo_window_p = 1;
7678
7679 /* Display the tooltip text in a temporary buffer. */
7680 old_buffer = current_buffer;
7681 set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f))->buffer));
7682 current_buffer->truncate_lines = Qnil;
7683 clear_glyph_matrix (w->desired_matrix);
7684 clear_glyph_matrix (w->current_matrix);
7685 SET_TEXT_POS (pos, BEGV, BEGV_BYTE);
7686 try_window (FRAME_ROOT_WINDOW (f), pos, 0);
7687
7688 /* Compute width and height of the tooltip. */
7689 width = height = 0;
7690 for (i = 0; i < w->desired_matrix->nrows; ++i)
7691 {
7692 struct glyph_row *row = &w->desired_matrix->rows[i];
7693 struct glyph *last;
7694 int row_width;
7695
7696 /* Stop at the first empty row at the end. */
7697 if (!row->enabled_p || !row->displays_text_p)
7698 break;
7699
7700 /* Let the row go over the full width of the frame. */
7701 row->full_width_p = 1;
7702
7703 #ifdef TODO /* Investigate why some fonts need more width than is
7704 calculated for some tooltips. */
7705 /* There's a glyph at the end of rows that is use to place
7706 the cursor there. Don't include the width of this glyph. */
7707 if (row->used[TEXT_AREA])
7708 {
7709 last = &row->glyphs[TEXT_AREA][row->used[TEXT_AREA] - 1];
7710 row_width = row->pixel_width - last->pixel_width;
7711 }
7712 else
7713 #endif
7714 row_width = row->pixel_width;
7715
7716 /* TODO: find why tips do not draw along baseline as instructed. */
7717 height += row->height;
7718 width = max (width, row_width);
7719 }
7720
7721 /* Add the frame's internal border to the width and height the X
7722 window should have. */
7723 height += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
7724 width += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
7725
7726 /* Move the tooltip window where the mouse pointer is. Resize and
7727 show it. */
7728 compute_tip_xy (f, parms, dx, dy, width, height, &root_x, &root_y);
7729
7730 {
7731 /* Adjust Window size to take border into account. */
7732 RECT rect;
7733 rect.left = rect.top = 0;
7734 rect.right = width;
7735 rect.bottom = height;
7736 AdjustWindowRect (&rect, f->output_data.w32->dwStyle,
7737 FRAME_EXTERNAL_MENU_BAR (f));
7738
7739 /* Position and size tooltip, and put it in the topmost group.
7740 The add-on of 3 to the 5th argument is a kludge: without it,
7741 some fonts cause the last character of the tip to be truncated,
7742 for some obscure reason. */
7743 SetWindowPos (FRAME_W32_WINDOW (f), HWND_TOPMOST,
7744 root_x, root_y, rect.right - rect.left + 3,
7745 rect.bottom - rect.top, SWP_NOACTIVATE);
7746
7747 /* Ensure tooltip is on top of other topmost windows (eg menus). */
7748 SetWindowPos (FRAME_W32_WINDOW (f), HWND_TOP,
7749 0, 0, 0, 0,
7750 SWP_NOMOVE | SWP_NOSIZE | SWP_NOACTIVATE);
7751
7752 /* Let redisplay know that we have made the frame visible already. */
7753 f->async_visible = 1;
7754
7755 ShowWindow (FRAME_W32_WINDOW (f), SW_SHOWNOACTIVATE);
7756 }
7757
7758 /* Draw into the window. */
7759 w->must_be_updated_p = 1;
7760 update_single_window (w, 1);
7761
7762 UNBLOCK_INPUT;
7763
7764 /* Restore original current buffer. */
7765 set_buffer_internal_1 (old_buffer);
7766 windows_or_buffers_changed = old_windows_or_buffers_changed;
7767
7768 start_timer:
7769 /* Let the tip disappear after timeout seconds. */
7770 tip_timer = call3 (intern ("run-at-time"), timeout, Qnil,
7771 intern ("x-hide-tip"));
7772
7773 UNGCPRO;
7774 return unbind_to (count, Qnil);
7775 }
7776
7777
7778 DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0,
7779 doc: /* Hide the current tooltip window, if there is any.
7780 Value is t if tooltip was open, nil otherwise. */)
7781 ()
7782 {
7783 int count;
7784 Lisp_Object deleted, frame, timer;
7785 struct gcpro gcpro1, gcpro2;
7786
7787 /* Return quickly if nothing to do. */
7788 if (NILP (tip_timer) && NILP (tip_frame))
7789 return Qnil;
7790
7791 frame = tip_frame;
7792 timer = tip_timer;
7793 GCPRO2 (frame, timer);
7794 tip_frame = tip_timer = deleted = Qnil;
7795
7796 count = SPECPDL_INDEX ();
7797 specbind (Qinhibit_redisplay, Qt);
7798 specbind (Qinhibit_quit, Qt);
7799
7800 if (!NILP (timer))
7801 call1 (Qcancel_timer, timer);
7802
7803 if (FRAMEP (frame))
7804 {
7805 Fdelete_frame (frame, Qnil);
7806 deleted = Qt;
7807 }
7808
7809 UNGCPRO;
7810 return unbind_to (count, deleted);
7811 }
7812
7813
7814 \f
7815 /***********************************************************************
7816 File selection dialog
7817 ***********************************************************************/
7818 extern Lisp_Object Qfile_name_history;
7819
7820 /* Callback for altering the behaviour of the Open File dialog.
7821 Makes the Filename text field contain "Current Directory" and be
7822 read-only when "Directories" is selected in the filter. This
7823 allows us to work around the fact that the standard Open File
7824 dialog does not support directories. */
7825 UINT CALLBACK
7826 file_dialog_callback (hwnd, msg, wParam, lParam)
7827 HWND hwnd;
7828 UINT msg;
7829 WPARAM wParam;
7830 LPARAM lParam;
7831 {
7832 if (msg == WM_NOTIFY)
7833 {
7834 OFNOTIFY * notify = (OFNOTIFY *)lParam;
7835 /* Detect when the Filter dropdown is changed. */
7836 if (notify->hdr.code == CDN_TYPECHANGE
7837 || notify->hdr.code == CDN_INITDONE)
7838 {
7839 HWND dialog = GetParent (hwnd);
7840 HWND edit_control = GetDlgItem (dialog, FILE_NAME_TEXT_FIELD);
7841
7842 /* Directories is in index 2. */
7843 if (notify->lpOFN->nFilterIndex == 2)
7844 {
7845 CommDlg_OpenSave_SetControlText (dialog, FILE_NAME_TEXT_FIELD,
7846 "Current Directory");
7847 EnableWindow (edit_control, FALSE);
7848 }
7849 else
7850 {
7851 /* Don't override default filename on init done. */
7852 if (notify->hdr.code == CDN_TYPECHANGE)
7853 CommDlg_OpenSave_SetControlText (dialog,
7854 FILE_NAME_TEXT_FIELD, "");
7855 EnableWindow (edit_control, TRUE);
7856 }
7857 }
7858 }
7859 return 0;
7860 }
7861
7862 /* Since we compile with _WIN32_WINNT set to 0x0400 (for NT4 compatibility)
7863 we end up with the old file dialogs. Define a big enough struct for the
7864 new dialog to trick GetOpenFileName into giving us the new dialogs on
7865 Windows 2000 and XP. */
7866 typedef struct
7867 {
7868 OPENFILENAME real_details;
7869 void * pReserved;
7870 DWORD dwReserved;
7871 DWORD FlagsEx;
7872 } NEWOPENFILENAME;
7873
7874
7875 DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 5, 0,
7876 doc: /* Read file name, prompting with PROMPT in directory DIR.
7877 Use a file selection dialog.
7878 Select DEFAULT-FILENAME in the dialog's file selection box, if
7879 specified. Ensure that file exists if MUSTMATCH is non-nil.
7880 If ONLY-DIR-P is non-nil, the user can only select directories. */)
7881 (prompt, dir, default_filename, mustmatch, only_dir_p)
7882 Lisp_Object prompt, dir, default_filename, mustmatch, only_dir_p;
7883 {
7884 struct frame *f = SELECTED_FRAME ();
7885 Lisp_Object file = Qnil;
7886 int count = SPECPDL_INDEX ();
7887 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
7888 char filename[MAX_PATH + 1];
7889 char init_dir[MAX_PATH + 1];
7890 int default_filter_index = 1; /* 1: All Files, 2: Directories only */
7891
7892 GCPRO6 (prompt, dir, default_filename, mustmatch, only_dir_p, file);
7893 CHECK_STRING (prompt);
7894 CHECK_STRING (dir);
7895
7896 /* Create the dialog with PROMPT as title, using DIR as initial
7897 directory and using "*" as pattern. */
7898 dir = Fexpand_file_name (dir, Qnil);
7899 strncpy (init_dir, SDATA (ENCODE_FILE (dir)), MAX_PATH);
7900 init_dir[MAX_PATH] = '\0';
7901 unixtodos_filename (init_dir);
7902
7903 if (STRINGP (default_filename))
7904 {
7905 char *file_name_only;
7906 char *full_path_name = SDATA (ENCODE_FILE (default_filename));
7907
7908 unixtodos_filename (full_path_name);
7909
7910 file_name_only = strrchr (full_path_name, '\\');
7911 if (!file_name_only)
7912 file_name_only = full_path_name;
7913 else
7914 file_name_only++;
7915
7916 strncpy (filename, file_name_only, MAX_PATH);
7917 filename[MAX_PATH] = '\0';
7918 }
7919 else
7920 filename[0] = '\0';
7921
7922 {
7923 NEWOPENFILENAME new_file_details;
7924 BOOL file_opened = FALSE;
7925 OPENFILENAME * file_details = &new_file_details.real_details;
7926
7927 /* Prevent redisplay. */
7928 specbind (Qinhibit_redisplay, Qt);
7929 BLOCK_INPUT;
7930
7931 bzero (&new_file_details, sizeof (new_file_details));
7932 /* Apparently NT4 crashes if you give it an unexpected size.
7933 I'm not sure about Windows 9x, so play it safe. */
7934 if (w32_major_version > 4 && w32_major_version < 95)
7935 file_details->lStructSize = sizeof (NEWOPENFILENAME);
7936 else
7937 file_details->lStructSize = sizeof (OPENFILENAME);
7938
7939 file_details->hwndOwner = FRAME_W32_WINDOW (f);
7940 /* Undocumented Bug in Common File Dialog:
7941 If a filter is not specified, shell links are not resolved. */
7942 file_details->lpstrFilter = "All Files (*.*)\0*.*\0Directories\0*|*\0\0";
7943 file_details->lpstrFile = filename;
7944 file_details->nMaxFile = sizeof (filename);
7945 file_details->lpstrInitialDir = init_dir;
7946 file_details->lpstrTitle = SDATA (prompt);
7947
7948 if (! NILP (only_dir_p))
7949 default_filter_index = 2;
7950
7951 file_details->nFilterIndex = default_filter_index;
7952
7953 file_details->Flags = (OFN_HIDEREADONLY | OFN_NOCHANGEDIR
7954 | OFN_EXPLORER | OFN_ENABLEHOOK);
7955 if (!NILP (mustmatch))
7956 {
7957 /* Require that the path to the parent directory exists. */
7958 file_details->Flags |= OFN_PATHMUSTEXIST;
7959 /* If we are looking for a file, require that it exists. */
7960 if (NILP (only_dir_p))
7961 file_details->Flags |= OFN_FILEMUSTEXIST;
7962 }
7963
7964 file_details->lpfnHook = (LPOFNHOOKPROC) file_dialog_callback;
7965
7966 file_opened = GetOpenFileName (file_details);
7967
7968 UNBLOCK_INPUT;
7969
7970 if (file_opened)
7971 {
7972 dostounix_filename (filename);
7973
7974 if (file_details->nFilterIndex == 2)
7975 {
7976 /* "Directories" selected - strip dummy file name. */
7977 char * last = strrchr (filename, '/');
7978 *last = '\0';
7979 }
7980
7981 file = DECODE_FILE (build_string (filename));
7982 }
7983 /* User cancelled the dialog without making a selection. */
7984 else if (!CommDlgExtendedError ())
7985 file = Qnil;
7986 /* An error occurred, fallback on reading from the mini-buffer. */
7987 else
7988 file = Fcompleting_read (prompt, intern ("read-file-name-internal"),
7989 dir, mustmatch, dir, Qfile_name_history,
7990 default_filename, Qnil);
7991
7992 file = unbind_to (count, file);
7993 }
7994
7995 UNGCPRO;
7996
7997 /* Make "Cancel" equivalent to C-g. */
7998 if (NILP (file))
7999 Fsignal (Qquit, Qnil);
8000
8001 return unbind_to (count, file);
8002 }
8003
8004
8005 \f
8006 /***********************************************************************
8007 w32 specialized functions
8008 ***********************************************************************/
8009
8010 DEFUN ("w32-select-font", Fw32_select_font, Sw32_select_font, 0, 2, 0,
8011 doc: /* Select a font for the named FRAME using the W32 font dialog.
8012 Return an X-style font string corresponding to the selection.
8013
8014 If FRAME is omitted or nil, it defaults to the selected frame.
8015 If INCLUDE-PROPORTIONAL is non-nil, include proportional fonts
8016 in the font selection dialog. */)
8017 (frame, include_proportional)
8018 Lisp_Object frame, include_proportional;
8019 {
8020 FRAME_PTR f = check_x_frame (frame);
8021 CHOOSEFONT cf;
8022 LOGFONT lf;
8023 TEXTMETRIC tm;
8024 HDC hdc;
8025 HANDLE oldobj;
8026 char buf[100];
8027
8028 bzero (&cf, sizeof (cf));
8029 bzero (&lf, sizeof (lf));
8030
8031 cf.lStructSize = sizeof (cf);
8032 cf.hwndOwner = FRAME_W32_WINDOW (f);
8033 cf.Flags = CF_FORCEFONTEXIST | CF_SCREENFONTS | CF_NOVERTFONTS;
8034
8035 /* Unless include_proportional is non-nil, limit the selection to
8036 monospaced fonts. */
8037 if (NILP (include_proportional))
8038 cf.Flags |= CF_FIXEDPITCHONLY;
8039
8040 cf.lpLogFont = &lf;
8041
8042 /* Initialize as much of the font details as we can from the current
8043 default font. */
8044 hdc = GetDC (FRAME_W32_WINDOW (f));
8045 oldobj = SelectObject (hdc, FRAME_FONT (f)->hfont);
8046 GetTextFace (hdc, LF_FACESIZE, lf.lfFaceName);
8047 if (GetTextMetrics (hdc, &tm))
8048 {
8049 lf.lfHeight = tm.tmInternalLeading - tm.tmHeight;
8050 lf.lfWeight = tm.tmWeight;
8051 lf.lfItalic = tm.tmItalic;
8052 lf.lfUnderline = tm.tmUnderlined;
8053 lf.lfStrikeOut = tm.tmStruckOut;
8054 lf.lfCharSet = tm.tmCharSet;
8055 cf.Flags |= CF_INITTOLOGFONTSTRUCT;
8056 }
8057 SelectObject (hdc, oldobj);
8058 ReleaseDC (FRAME_W32_WINDOW (f), hdc);
8059
8060 if (!ChooseFont (&cf) || !w32_to_x_font (&lf, buf, 100, NULL))
8061 return Qnil;
8062
8063 return build_string (buf);
8064 }
8065
8066 DEFUN ("w32-send-sys-command", Fw32_send_sys_command,
8067 Sw32_send_sys_command, 1, 2, 0,
8068 doc: /* Send frame a Windows WM_SYSCOMMAND message of type COMMAND.
8069 Some useful values for COMMAND are #xf030 to maximize frame (#xf020
8070 to minimize), #xf120 to restore frame to original size, and #xf100
8071 to activate the menubar for keyboard access. #xf140 activates the
8072 screen saver if defined.
8073
8074 If optional parameter FRAME is not specified, use selected frame. */)
8075 (command, frame)
8076 Lisp_Object command, frame;
8077 {
8078 FRAME_PTR f = check_x_frame (frame);
8079
8080 CHECK_NUMBER (command);
8081
8082 PostMessage (FRAME_W32_WINDOW (f), WM_SYSCOMMAND, XINT (command), 0);
8083
8084 return Qnil;
8085 }
8086
8087 DEFUN ("w32-shell-execute", Fw32_shell_execute, Sw32_shell_execute, 2, 4, 0,
8088 doc: /* Get Windows to perform OPERATION on DOCUMENT.
8089 This is a wrapper around the ShellExecute system function, which
8090 invokes the application registered to handle OPERATION for DOCUMENT.
8091
8092 OPERATION is either nil or a string that names a supported operation.
8093 What operations can be used depends on the particular DOCUMENT and its
8094 handler application, but typically it is one of the following common
8095 operations:
8096
8097 \"open\" - open DOCUMENT, which could be a file, a directory, or an
8098 executable program. If it is an application, that
8099 application is launched in the current buffer's default
8100 directory. Otherwise, the application associated with
8101 DOCUMENT is launched in the buffer's default directory.
8102 \"print\" - print DOCUMENT, which must be a file
8103 \"explore\" - start the Windows Explorer on DOCUMENT
8104 \"edit\" - launch an editor and open DOCUMENT for editing; which
8105 editor is launched depends on the association for the
8106 specified DOCUMENT
8107 \"find\" - initiate search starting from DOCUMENT which must specify
8108 a directory
8109 nil - invoke the default OPERATION, or \"open\" if default is
8110 not defined or unavailable
8111
8112 DOCUMENT is typically the name of a document file or a URL, but can
8113 also be a program executable to run, or a directory to open in the
8114 Windows Explorer.
8115
8116 If DOCUMENT is a program executable, the optional third arg PARAMETERS
8117 can be a string containing command line parameters that will be passed
8118 to the program; otherwise, PARAMETERS should be nil or unspecified.
8119
8120 Optional fourth argument SHOW-FLAG can be used to control how the
8121 application will be displayed when it is invoked. If SHOW-FLAG is nil
8122 or unspecified, the application is displayed normally, otherwise it is
8123 an integer representing a ShowWindow flag:
8124
8125 0 - start hidden
8126 1 - start normally
8127 3 - start maximized
8128 6 - start minimized */)
8129 (operation, document, parameters, show_flag)
8130 Lisp_Object operation, document, parameters, show_flag;
8131 {
8132 Lisp_Object current_dir;
8133
8134 CHECK_STRING (document);
8135
8136 /* Encode filename and current directory. */
8137 current_dir = ENCODE_FILE (current_buffer->directory);
8138 document = ENCODE_FILE (document);
8139 if ((int) ShellExecute (NULL,
8140 (STRINGP (operation) ?
8141 SDATA (operation) : NULL),
8142 SDATA (document),
8143 (STRINGP (parameters) ?
8144 SDATA (parameters) : NULL),
8145 SDATA (current_dir),
8146 (INTEGERP (show_flag) ?
8147 XINT (show_flag) : SW_SHOWDEFAULT))
8148 > 32)
8149 return Qt;
8150 error ("ShellExecute failed: %s", w32_strerror (0));
8151 }
8152
8153 /* Lookup virtual keycode from string representing the name of a
8154 non-ascii keystroke into the corresponding virtual key, using
8155 lispy_function_keys. */
8156 static int
8157 lookup_vk_code (char *key)
8158 {
8159 int i;
8160
8161 for (i = 0; i < 256; i++)
8162 if (lispy_function_keys[i] != 0
8163 && strcmp (lispy_function_keys[i], key) == 0)
8164 return i;
8165
8166 return -1;
8167 }
8168
8169 /* Convert a one-element vector style key sequence to a hot key
8170 definition. */
8171 static Lisp_Object
8172 w32_parse_hot_key (key)
8173 Lisp_Object key;
8174 {
8175 /* Copied from Fdefine_key and store_in_keymap. */
8176 register Lisp_Object c;
8177 int vk_code;
8178 int lisp_modifiers;
8179 int w32_modifiers;
8180 struct gcpro gcpro1;
8181
8182 CHECK_VECTOR (key);
8183
8184 if (XFASTINT (Flength (key)) != 1)
8185 return Qnil;
8186
8187 GCPRO1 (key);
8188
8189 c = Faref (key, make_number (0));
8190
8191 if (CONSP (c) && lucid_event_type_list_p (c))
8192 c = Fevent_convert_list (c);
8193
8194 UNGCPRO;
8195
8196 if (! INTEGERP (c) && ! SYMBOLP (c))
8197 error ("Key definition is invalid");
8198
8199 /* Work out the base key and the modifiers. */
8200 if (SYMBOLP (c))
8201 {
8202 c = parse_modifiers (c);
8203 lisp_modifiers = XINT (Fcar (Fcdr (c)));
8204 c = Fcar (c);
8205 if (!SYMBOLP (c))
8206 abort ();
8207 vk_code = lookup_vk_code (SDATA (SYMBOL_NAME (c)));
8208 }
8209 else if (INTEGERP (c))
8210 {
8211 lisp_modifiers = XINT (c) & ~CHARACTERBITS;
8212 /* Many ascii characters are their own virtual key code. */
8213 vk_code = XINT (c) & CHARACTERBITS;
8214 }
8215
8216 if (vk_code < 0 || vk_code > 255)
8217 return Qnil;
8218
8219 if ((lisp_modifiers & meta_modifier) != 0
8220 && !NILP (Vw32_alt_is_meta))
8221 lisp_modifiers |= alt_modifier;
8222
8223 /* Supply defs missing from mingw32. */
8224 #ifndef MOD_ALT
8225 #define MOD_ALT 0x0001
8226 #define MOD_CONTROL 0x0002
8227 #define MOD_SHIFT 0x0004
8228 #define MOD_WIN 0x0008
8229 #endif
8230
8231 /* Convert lisp modifiers to Windows hot-key form. */
8232 w32_modifiers = (lisp_modifiers & hyper_modifier) ? MOD_WIN : 0;
8233 w32_modifiers |= (lisp_modifiers & alt_modifier) ? MOD_ALT : 0;
8234 w32_modifiers |= (lisp_modifiers & ctrl_modifier) ? MOD_CONTROL : 0;
8235 w32_modifiers |= (lisp_modifiers & shift_modifier) ? MOD_SHIFT : 0;
8236
8237 return HOTKEY (vk_code, w32_modifiers);
8238 }
8239
8240 DEFUN ("w32-register-hot-key", Fw32_register_hot_key,
8241 Sw32_register_hot_key, 1, 1, 0,
8242 doc: /* Register KEY as a hot-key combination.
8243 Certain key combinations like Alt-Tab are reserved for system use on
8244 Windows, and therefore are normally intercepted by the system. However,
8245 most of these key combinations can be received by registering them as
8246 hot-keys, overriding their special meaning.
8247
8248 KEY must be a one element key definition in vector form that would be
8249 acceptable to `define-key' (e.g. [A-tab] for Alt-Tab). The meta
8250 modifier is interpreted as Alt if `w32-alt-is-meta' is t, and hyper
8251 is always interpreted as the Windows modifier keys.
8252
8253 The return value is the hotkey-id if registered, otherwise nil. */)
8254 (key)
8255 Lisp_Object key;
8256 {
8257 key = w32_parse_hot_key (key);
8258
8259 if (!NILP (key) && NILP (Fmemq (key, w32_grabbed_keys)))
8260 {
8261 /* Reuse an empty slot if possible. */
8262 Lisp_Object item = Fmemq (Qnil, w32_grabbed_keys);
8263
8264 /* Safe to add new key to list, even if we have focus. */
8265 if (NILP (item))
8266 w32_grabbed_keys = Fcons (key, w32_grabbed_keys);
8267 else
8268 XSETCAR (item, key);
8269
8270 /* Notify input thread about new hot-key definition, so that it
8271 takes effect without needing to switch focus. */
8272 #ifdef USE_LISP_UNION_TYPE
8273 PostThreadMessage (dwWindowsThreadId, WM_EMACS_REGISTER_HOT_KEY,
8274 (WPARAM) key.i, 0);
8275 #else
8276 PostThreadMessage (dwWindowsThreadId, WM_EMACS_REGISTER_HOT_KEY,
8277 (WPARAM) key, 0);
8278 #endif
8279 }
8280
8281 return key;
8282 }
8283
8284 DEFUN ("w32-unregister-hot-key", Fw32_unregister_hot_key,
8285 Sw32_unregister_hot_key, 1, 1, 0,
8286 doc: /* Unregister KEY as a hot-key combination. */)
8287 (key)
8288 Lisp_Object key;
8289 {
8290 Lisp_Object item;
8291
8292 if (!INTEGERP (key))
8293 key = w32_parse_hot_key (key);
8294
8295 item = Fmemq (key, w32_grabbed_keys);
8296
8297 if (!NILP (item))
8298 {
8299 /* Notify input thread about hot-key definition being removed, so
8300 that it takes effect without needing focus switch. */
8301 #ifdef USE_LISP_UNION_TYPE
8302 if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_UNREGISTER_HOT_KEY,
8303 (WPARAM) XINT (XCAR (item)), (LPARAM) item.i))
8304 #else
8305 if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_UNREGISTER_HOT_KEY,
8306 (WPARAM) XINT (XCAR (item)), (LPARAM) item))
8307 #endif
8308 {
8309 MSG msg;
8310 GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
8311 }
8312 return Qt;
8313 }
8314 return Qnil;
8315 }
8316
8317 DEFUN ("w32-registered-hot-keys", Fw32_registered_hot_keys,
8318 Sw32_registered_hot_keys, 0, 0, 0,
8319 doc: /* Return list of registered hot-key IDs. */)
8320 ()
8321 {
8322 return Fdelq (Qnil, Fcopy_sequence (w32_grabbed_keys));
8323 }
8324
8325 DEFUN ("w32-reconstruct-hot-key", Fw32_reconstruct_hot_key,
8326 Sw32_reconstruct_hot_key, 1, 1, 0,
8327 doc: /* Convert hot-key ID to a lisp key combination.
8328 usage: (w32-reconstruct-hot-key ID) */)
8329 (hotkeyid)
8330 Lisp_Object hotkeyid;
8331 {
8332 int vk_code, w32_modifiers;
8333 Lisp_Object key;
8334
8335 CHECK_NUMBER (hotkeyid);
8336
8337 vk_code = HOTKEY_VK_CODE (hotkeyid);
8338 w32_modifiers = HOTKEY_MODIFIERS (hotkeyid);
8339
8340 if (lispy_function_keys[vk_code])
8341 key = intern (lispy_function_keys[vk_code]);
8342 else
8343 key = make_number (vk_code);
8344
8345 key = Fcons (key, Qnil);
8346 if (w32_modifiers & MOD_SHIFT)
8347 key = Fcons (Qshift, key);
8348 if (w32_modifiers & MOD_CONTROL)
8349 key = Fcons (Qctrl, key);
8350 if (w32_modifiers & MOD_ALT)
8351 key = Fcons (NILP (Vw32_alt_is_meta) ? Qalt : Qmeta, key);
8352 if (w32_modifiers & MOD_WIN)
8353 key = Fcons (Qhyper, key);
8354
8355 return key;
8356 }
8357
8358 DEFUN ("w32-toggle-lock-key", Fw32_toggle_lock_key,
8359 Sw32_toggle_lock_key, 1, 2, 0,
8360 doc: /* Toggle the state of the lock key KEY.
8361 KEY can be `capslock', `kp-numlock', or `scroll'.
8362 If the optional parameter NEW-STATE is a number, then the state of KEY
8363 is set to off if the low bit of NEW-STATE is zero, otherwise on. */)
8364 (key, new_state)
8365 Lisp_Object key, new_state;
8366 {
8367 int vk_code;
8368
8369 if (EQ (key, intern ("capslock")))
8370 vk_code = VK_CAPITAL;
8371 else if (EQ (key, intern ("kp-numlock")))
8372 vk_code = VK_NUMLOCK;
8373 else if (EQ (key, intern ("scroll")))
8374 vk_code = VK_SCROLL;
8375 else
8376 return Qnil;
8377
8378 if (!dwWindowsThreadId)
8379 return make_number (w32_console_toggle_lock_key (vk_code, new_state));
8380
8381 #ifdef USE_LISP_UNION_TYPE
8382 if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_TOGGLE_LOCK_KEY,
8383 (WPARAM) vk_code, (LPARAM) new_state.i))
8384 #else
8385 if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_TOGGLE_LOCK_KEY,
8386 (WPARAM) vk_code, (LPARAM) new_state))
8387 #endif
8388 {
8389 MSG msg;
8390 GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
8391 return make_number (msg.wParam);
8392 }
8393 return Qnil;
8394 }
8395
8396 DEFUN ("w32-window-exists-p", Fw32_window_exists_p, Sw32_window_exists_p,
8397 2, 2, 0,
8398 doc: /* Return non-nil if a window exists with the specified CLASS and NAME.
8399
8400 This is a direct interface to the Windows API FindWindow function. */)
8401 (class, name)
8402 Lisp_Object class, name;
8403 {
8404 HWND hnd;
8405
8406 if (!NILP (class))
8407 CHECK_STRING (class);
8408 if (!NILP (name))
8409 CHECK_STRING (name);
8410
8411 hnd = FindWindow (STRINGP (class) ? ((LPCTSTR) SDATA (class)) : NULL,
8412 STRINGP (name) ? ((LPCTSTR) SDATA (name)) : NULL);
8413 if (!hnd)
8414 return Qnil;
8415 return Qt;
8416 }
8417
8418
8419 \f
8420 DEFUN ("file-system-info", Ffile_system_info, Sfile_system_info, 1, 1, 0,
8421 doc: /* Return storage information about the file system FILENAME is on.
8422 Value is a list of floats (TOTAL FREE AVAIL), where TOTAL is the total
8423 storage of the file system, FREE is the free storage, and AVAIL is the
8424 storage available to a non-superuser. All 3 numbers are in bytes.
8425 If the underlying system call fails, value is nil. */)
8426 (filename)
8427 Lisp_Object filename;
8428 {
8429 Lisp_Object encoded, value;
8430
8431 CHECK_STRING (filename);
8432 filename = Fexpand_file_name (filename, Qnil);
8433 encoded = ENCODE_FILE (filename);
8434
8435 value = Qnil;
8436
8437 /* Determining the required information on Windows turns out, sadly,
8438 to be more involved than one would hope. The original Win32 api
8439 call for this will return bogus information on some systems, but we
8440 must dynamically probe for the replacement api, since that was
8441 added rather late on. */
8442 {
8443 HMODULE hKernel = GetModuleHandle ("kernel32");
8444 BOOL (*pfn_GetDiskFreeSpaceEx)
8445 (char *, PULARGE_INTEGER, PULARGE_INTEGER, PULARGE_INTEGER)
8446 = (void *) GetProcAddress (hKernel, "GetDiskFreeSpaceEx");
8447
8448 /* On Windows, we may need to specify the root directory of the
8449 volume holding FILENAME. */
8450 char rootname[MAX_PATH];
8451 char *name = SDATA (encoded);
8452
8453 /* find the root name of the volume if given */
8454 if (isalpha (name[0]) && name[1] == ':')
8455 {
8456 rootname[0] = name[0];
8457 rootname[1] = name[1];
8458 rootname[2] = '\\';
8459 rootname[3] = 0;
8460 }
8461 else if (IS_DIRECTORY_SEP (name[0]) && IS_DIRECTORY_SEP (name[1]))
8462 {
8463 char *str = rootname;
8464 int slashes = 4;
8465 do
8466 {
8467 if (IS_DIRECTORY_SEP (*name) && --slashes == 0)
8468 break;
8469 *str++ = *name++;
8470 }
8471 while ( *name );
8472
8473 *str++ = '\\';
8474 *str = 0;
8475 }
8476
8477 if (pfn_GetDiskFreeSpaceEx)
8478 {
8479 /* Unsigned large integers cannot be cast to double, so
8480 use signed ones instead. */
8481 LARGE_INTEGER availbytes;
8482 LARGE_INTEGER freebytes;
8483 LARGE_INTEGER totalbytes;
8484
8485 if (pfn_GetDiskFreeSpaceEx (rootname,
8486 (ULARGE_INTEGER *)&availbytes,
8487 (ULARGE_INTEGER *)&totalbytes,
8488 (ULARGE_INTEGER *)&freebytes))
8489 value = list3 (make_float ((double) totalbytes.QuadPart),
8490 make_float ((double) freebytes.QuadPart),
8491 make_float ((double) availbytes.QuadPart));
8492 }
8493 else
8494 {
8495 DWORD sectors_per_cluster;
8496 DWORD bytes_per_sector;
8497 DWORD free_clusters;
8498 DWORD total_clusters;
8499
8500 if (GetDiskFreeSpace (rootname,
8501 &sectors_per_cluster,
8502 &bytes_per_sector,
8503 &free_clusters,
8504 &total_clusters))
8505 value = list3 (make_float ((double) total_clusters
8506 * sectors_per_cluster * bytes_per_sector),
8507 make_float ((double) free_clusters
8508 * sectors_per_cluster * bytes_per_sector),
8509 make_float ((double) free_clusters
8510 * sectors_per_cluster * bytes_per_sector));
8511 }
8512 }
8513
8514 return value;
8515 }
8516 \f
8517 DEFUN ("default-printer-name", Fdefault_printer_name, Sdefault_printer_name,
8518 0, 0, 0, doc: /* Return the name of Windows default printer device. */)
8519 ()
8520 {
8521 static char pname_buf[256];
8522 int err;
8523 HANDLE hPrn;
8524 PRINTER_INFO_2 *ppi2 = NULL;
8525 DWORD dwNeeded = 0, dwReturned = 0;
8526
8527 /* Retrieve the default string from Win.ini (the registry).
8528 * String will be in form "printername,drivername,portname".
8529 * This is the most portable way to get the default printer. */
8530 if (GetProfileString ("windows", "device", ",,", pname_buf, sizeof (pname_buf)) <= 0)
8531 return Qnil;
8532 /* printername precedes first "," character */
8533 strtok (pname_buf, ",");
8534 /* We want to know more than the printer name */
8535 if (!OpenPrinter (pname_buf, &hPrn, NULL))
8536 return Qnil;
8537 GetPrinter (hPrn, 2, NULL, 0, &dwNeeded);
8538 if (dwNeeded == 0)
8539 {
8540 ClosePrinter (hPrn);
8541 return Qnil;
8542 }
8543 /* Allocate memory for the PRINTER_INFO_2 struct */
8544 ppi2 = (PRINTER_INFO_2 *) xmalloc (dwNeeded);
8545 if (!ppi2)
8546 {
8547 ClosePrinter (hPrn);
8548 return Qnil;
8549 }
8550 /* Call GetPrinter again with big enouth memory block */
8551 err = GetPrinter (hPrn, 2, (LPBYTE)ppi2, dwNeeded, &dwReturned);
8552 ClosePrinter (hPrn);
8553 if (!err)
8554 {
8555 xfree (ppi2);
8556 return Qnil;
8557 }
8558
8559 if (ppi2)
8560 {
8561 if (ppi2->Attributes & PRINTER_ATTRIBUTE_SHARED && ppi2->pServerName)
8562 {
8563 /* a remote printer */
8564 if (*ppi2->pServerName == '\\')
8565 _snprintf (pname_buf, sizeof (pname_buf), "%s\\%s", ppi2->pServerName,
8566 ppi2->pShareName);
8567 else
8568 _snprintf (pname_buf, sizeof (pname_buf), "\\\\%s\\%s", ppi2->pServerName,
8569 ppi2->pShareName);
8570 pname_buf[sizeof (pname_buf) - 1] = '\0';
8571 }
8572 else
8573 {
8574 /* a local printer */
8575 strncpy (pname_buf, ppi2->pPortName, sizeof (pname_buf));
8576 pname_buf[sizeof (pname_buf) - 1] = '\0';
8577 /* `pPortName' can include several ports, delimited by ','.
8578 * we only use the first one. */
8579 strtok (pname_buf, ",");
8580 }
8581 xfree (ppi2);
8582 }
8583
8584 return build_string (pname_buf);
8585 }
8586 \f
8587 /***********************************************************************
8588 Initialization
8589 ***********************************************************************/
8590
8591 /* Keep this list in the same order as frame_parms in frame.c.
8592 Use 0 for unsupported frame parameters. */
8593
8594 frame_parm_handler w32_frame_parm_handlers[] =
8595 {
8596 x_set_autoraise,
8597 x_set_autolower,
8598 x_set_background_color,
8599 x_set_border_color,
8600 x_set_border_width,
8601 x_set_cursor_color,
8602 x_set_cursor_type,
8603 x_set_font,
8604 x_set_foreground_color,
8605 x_set_icon_name,
8606 x_set_icon_type,
8607 x_set_internal_border_width,
8608 x_set_menu_bar_lines,
8609 x_set_mouse_color,
8610 x_explicitly_set_name,
8611 x_set_scroll_bar_width,
8612 x_set_title,
8613 x_set_unsplittable,
8614 x_set_vertical_scroll_bars,
8615 x_set_visibility,
8616 x_set_tool_bar_lines,
8617 0, /* x_set_scroll_bar_foreground, */
8618 0, /* x_set_scroll_bar_background, */
8619 x_set_screen_gamma,
8620 x_set_line_spacing,
8621 x_set_fringe_width,
8622 x_set_fringe_width,
8623 0, /* x_set_wait_for_wm, */
8624 x_set_fullscreen,
8625 };
8626
8627 void
8628 syms_of_w32fns ()
8629 {
8630 globals_of_w32fns ();
8631 /* This is zero if not using MS-Windows. */
8632 w32_in_use = 0;
8633 track_mouse_window = NULL;
8634
8635 w32_visible_system_caret_hwnd = NULL;
8636
8637 Qnone = intern ("none");
8638 staticpro (&Qnone);
8639 Qsuppress_icon = intern ("suppress-icon");
8640 staticpro (&Qsuppress_icon);
8641 Qundefined_color = intern ("undefined-color");
8642 staticpro (&Qundefined_color);
8643 Qcancel_timer = intern ("cancel-timer");
8644 staticpro (&Qcancel_timer);
8645
8646 Qhyper = intern ("hyper");
8647 staticpro (&Qhyper);
8648 Qsuper = intern ("super");
8649 staticpro (&Qsuper);
8650 Qmeta = intern ("meta");
8651 staticpro (&Qmeta);
8652 Qalt = intern ("alt");
8653 staticpro (&Qalt);
8654 Qctrl = intern ("ctrl");
8655 staticpro (&Qctrl);
8656 Qcontrol = intern ("control");
8657 staticpro (&Qcontrol);
8658 Qshift = intern ("shift");
8659 staticpro (&Qshift);
8660 /* This is the end of symbol initialization. */
8661
8662 /* Text property `display' should be nonsticky by default. */
8663 Vtext_property_default_nonsticky
8664 = Fcons (Fcons (Qdisplay, Qt), Vtext_property_default_nonsticky);
8665
8666
8667 Fput (Qundefined_color, Qerror_conditions,
8668 Fcons (Qundefined_color, Fcons (Qerror, Qnil)));
8669 Fput (Qundefined_color, Qerror_message,
8670 build_string ("Undefined color"));
8671
8672 staticpro (&w32_grabbed_keys);
8673 w32_grabbed_keys = Qnil;
8674
8675 DEFVAR_LISP ("w32-color-map", &Vw32_color_map,
8676 doc: /* An array of color name mappings for Windows. */);
8677 Vw32_color_map = Qnil;
8678
8679 DEFVAR_LISP ("w32-pass-alt-to-system", &Vw32_pass_alt_to_system,
8680 doc: /* Non-nil if Alt key presses are passed on to Windows.
8681 When non-nil, for example, Alt pressed and released and then space will
8682 open the System menu. When nil, Emacs processes the Alt key events, and
8683 then silently swallows them. */);
8684 Vw32_pass_alt_to_system = Qnil;
8685
8686 DEFVAR_LISP ("w32-alt-is-meta", &Vw32_alt_is_meta,
8687 doc: /* Non-nil if the Alt key is to be considered the same as the META key.
8688 When nil, Emacs will translate the Alt key to the ALT modifier, not to META. */);
8689 Vw32_alt_is_meta = Qt;
8690
8691 DEFVAR_INT ("w32-quit-key", &w32_quit_key,
8692 doc: /* If non-zero, the virtual key code for an alternative quit key. */);
8693 w32_quit_key = 0;
8694
8695 DEFVAR_LISP ("w32-pass-lwindow-to-system",
8696 &Vw32_pass_lwindow_to_system,
8697 doc: /* If non-nil, the left \"Windows\" key is passed on to Windows.
8698
8699 When non-nil, the Start menu is opened by tapping the key.
8700 If you set this to nil, the left \"Windows\" key is processed by Emacs
8701 according to the value of `w32-lwindow-modifier', which see.
8702
8703 Note that some combinations of the left \"Windows\" key with other keys are
8704 caught by Windows at low level, and so binding them in Emacs will have no
8705 effect. For example, <lwindow>-r always pops up the Windows Run dialog,
8706 <lwindow>-<Pause> pops up the "System Properties" dialog, etc. However, see
8707 the doc string of `w32-phantom-key-code'. */);
8708 Vw32_pass_lwindow_to_system = Qt;
8709
8710 DEFVAR_LISP ("w32-pass-rwindow-to-system",
8711 &Vw32_pass_rwindow_to_system,
8712 doc: /* If non-nil, the right \"Windows\" key is passed on to Windows.
8713
8714 When non-nil, the Start menu is opened by tapping the key.
8715 If you set this to nil, the right \"Windows\" key is processed by Emacs
8716 according to the value of `w32-rwindow-modifier', which see.
8717
8718 Note that some combinations of the right \"Windows\" key with other keys are
8719 caught by Windows at low level, and so binding them in Emacs will have no
8720 effect. For example, <rwindow>-r always pops up the Windows Run dialog,
8721 <rwindow>-<Pause> pops up the "System Properties" dialog, etc. However, see
8722 the doc string of `w32-phantom-key-code'. */);
8723 Vw32_pass_rwindow_to_system = Qt;
8724
8725 DEFVAR_LISP ("w32-phantom-key-code",
8726 &Vw32_phantom_key_code,
8727 doc: /* Virtual key code used to generate \"phantom\" key presses.
8728 Value is a number between 0 and 255.
8729
8730 Phantom key presses are generated in order to stop the system from
8731 acting on \"Windows\" key events when `w32-pass-lwindow-to-system' or
8732 `w32-pass-rwindow-to-system' is nil. */);
8733 /* Although 255 is technically not a valid key code, it works and
8734 means that this hack won't interfere with any real key code. */
8735 XSETINT (Vw32_phantom_key_code, 255);
8736
8737 DEFVAR_LISP ("w32-enable-num-lock",
8738 &Vw32_enable_num_lock,
8739 doc: /* If non-nil, the Num Lock key acts normally.
8740 Set to nil to handle Num Lock as the `kp-numlock' key. */);
8741 Vw32_enable_num_lock = Qt;
8742
8743 DEFVAR_LISP ("w32-enable-caps-lock",
8744 &Vw32_enable_caps_lock,
8745 doc: /* If non-nil, the Caps Lock key acts normally.
8746 Set to nil to handle Caps Lock as the `capslock' key. */);
8747 Vw32_enable_caps_lock = Qt;
8748
8749 DEFVAR_LISP ("w32-scroll-lock-modifier",
8750 &Vw32_scroll_lock_modifier,
8751 doc: /* Modifier to use for the Scroll Lock ON state.
8752 The value can be hyper, super, meta, alt, control or shift for the
8753 respective modifier, or nil to handle Scroll Lock as the `scroll' key.
8754 Any other value will cause the Scroll Lock key to be ignored. */);
8755 Vw32_scroll_lock_modifier = Qt;
8756
8757 DEFVAR_LISP ("w32-lwindow-modifier",
8758 &Vw32_lwindow_modifier,
8759 doc: /* Modifier to use for the left \"Windows\" key.
8760 The value can be hyper, super, meta, alt, control or shift for the
8761 respective modifier, or nil to appear as the `lwindow' key.
8762 Any other value will cause the key to be ignored. */);
8763 Vw32_lwindow_modifier = Qnil;
8764
8765 DEFVAR_LISP ("w32-rwindow-modifier",
8766 &Vw32_rwindow_modifier,
8767 doc: /* Modifier to use for the right \"Windows\" key.
8768 The value can be hyper, super, meta, alt, control or shift for the
8769 respective modifier, or nil to appear as the `rwindow' key.
8770 Any other value will cause the key to be ignored. */);
8771 Vw32_rwindow_modifier = Qnil;
8772
8773 DEFVAR_LISP ("w32-apps-modifier",
8774 &Vw32_apps_modifier,
8775 doc: /* Modifier to use for the \"Apps\" key.
8776 The value can be hyper, super, meta, alt, control or shift for the
8777 respective modifier, or nil to appear as the `apps' key.
8778 Any other value will cause the key to be ignored. */);
8779 Vw32_apps_modifier = Qnil;
8780
8781 DEFVAR_BOOL ("w32-enable-synthesized-fonts", &w32_enable_synthesized_fonts,
8782 doc: /* Non-nil enables selection of artificially italicized and bold fonts. */);
8783 w32_enable_synthesized_fonts = 0;
8784
8785 DEFVAR_LISP ("w32-enable-palette", &Vw32_enable_palette,
8786 doc: /* Non-nil enables Windows palette management to map colors exactly. */);
8787 Vw32_enable_palette = Qt;
8788
8789 DEFVAR_INT ("w32-mouse-button-tolerance",
8790 &w32_mouse_button_tolerance,
8791 doc: /* Analogue of double click interval for faking middle mouse events.
8792 The value is the minimum time in milliseconds that must elapse between
8793 left and right button down events before they are considered distinct events.
8794 If both mouse buttons are depressed within this interval, a middle mouse
8795 button down event is generated instead. */);
8796 w32_mouse_button_tolerance = GetDoubleClickTime () / 2;
8797
8798 DEFVAR_INT ("w32-mouse-move-interval",
8799 &w32_mouse_move_interval,
8800 doc: /* Minimum interval between mouse move events.
8801 The value is the minimum time in milliseconds that must elapse between
8802 successive mouse move (or scroll bar drag) events before they are
8803 reported as lisp events. */);
8804 w32_mouse_move_interval = 0;
8805
8806 DEFVAR_BOOL ("w32-pass-extra-mouse-buttons-to-system",
8807 &w32_pass_extra_mouse_buttons_to_system,
8808 doc: /* If non-nil, the fourth and fifth mouse buttons are passed to Windows.
8809 Recent versions of Windows support mice with up to five buttons.
8810 Since most applications don't support these extra buttons, most mouse
8811 drivers will allow you to map them to functions at the system level.
8812 If this variable is non-nil, Emacs will pass them on, allowing the
8813 system to handle them. */);
8814 w32_pass_extra_mouse_buttons_to_system = 0;
8815
8816 DEFVAR_BOOL ("w32-pass-multimedia-buttons-to-system",
8817 &w32_pass_multimedia_buttons_to_system,
8818 doc: /* If non-nil, media buttons are passed to Windows.
8819 Some modern keyboards contain buttons for controlling media players, web
8820 browsers and other applications. Generally these buttons are handled on a
8821 system wide basis, but by setting this to nil they are made available
8822 to Emacs for binding. Depending on your keyboard, additional keys that
8823 may be available are:
8824
8825 browser-back, browser-forward, browser-refresh, browser-stop,
8826 browser-search, browser-favorites, browser-home,
8827 mail, mail-reply, mail-forward, mail-send,
8828 app-1, app-2,
8829 help, find, new, open, close, save, print, undo, redo, copy, cut, paste,
8830 spell-check, correction-list, toggle-dictate-command,
8831 media-next, media-previous, media-stop, media-play-pause, media-select,
8832 media-play, media-pause, media-record, media-fast-forward, media-rewind,
8833 media-channel-up, media-channel-down,
8834 volume-mute, volume-up, volume-down,
8835 mic-volume-mute, mic-volume-down, mic-volume-up, mic-toggle,
8836 bass-down, bass-boost, bass-up, treble-down, treble-up */);
8837 w32_pass_multimedia_buttons_to_system = 1;
8838
8839 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape,
8840 doc: /* The shape of the pointer when over text.
8841 Changing the value does not affect existing frames
8842 unless you set the mouse color. */);
8843 Vx_pointer_shape = Qnil;
8844
8845 Vx_nontext_pointer_shape = Qnil;
8846
8847 Vx_mode_pointer_shape = Qnil;
8848
8849 DEFVAR_LISP ("x-hourglass-pointer-shape", &Vx_hourglass_pointer_shape,
8850 doc: /* The shape of the pointer when Emacs is busy.
8851 This variable takes effect when you create a new frame
8852 or when you set the mouse color. */);
8853 Vx_hourglass_pointer_shape = Qnil;
8854
8855 DEFVAR_BOOL ("display-hourglass", &display_hourglass_p,
8856 doc: /* Non-zero means Emacs displays an hourglass pointer on window systems. */);
8857 display_hourglass_p = 1;
8858
8859 DEFVAR_LISP ("hourglass-delay", &Vhourglass_delay,
8860 doc: /* *Seconds to wait before displaying an hourglass pointer.
8861 Value must be an integer or float. */);
8862 Vhourglass_delay = make_number (DEFAULT_HOURGLASS_DELAY);
8863
8864 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
8865 &Vx_sensitive_text_pointer_shape,
8866 doc: /* The shape of the pointer when over mouse-sensitive text.
8867 This variable takes effect when you create a new frame
8868 or when you set the mouse color. */);
8869 Vx_sensitive_text_pointer_shape = Qnil;
8870
8871 DEFVAR_LISP ("x-window-horizontal-drag-cursor",
8872 &Vx_window_horizontal_drag_shape,
8873 doc: /* Pointer shape to use for indicating a window can be dragged horizontally.
8874 This variable takes effect when you create a new frame
8875 or when you set the mouse color. */);
8876 Vx_window_horizontal_drag_shape = Qnil;
8877
8878 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel,
8879 doc: /* A string indicating the foreground color of the cursor box. */);
8880 Vx_cursor_fore_pixel = Qnil;
8881
8882 DEFVAR_LISP ("x-max-tooltip-size", &Vx_max_tooltip_size,
8883 doc: /* Maximum size for tooltips.
8884 Value is a pair (COLUMNS . ROWS). Text larger than this is clipped. */);
8885 Vx_max_tooltip_size = Fcons (make_number (80), make_number (40));
8886
8887 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager,
8888 doc: /* Non-nil if no window manager is in use.
8889 Emacs doesn't try to figure this out; this is always nil
8890 unless you set it to something else. */);
8891 /* We don't have any way to find this out, so set it to nil
8892 and maybe the user would like to set it to t. */
8893 Vx_no_window_manager = Qnil;
8894
8895 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
8896 &Vx_pixel_size_width_font_regexp,
8897 doc: /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'.
8898
8899 Since Emacs gets width of a font matching with this regexp from
8900 PIXEL_SIZE field of the name, font finding mechanism gets faster for
8901 such a font. This is especially effective for such large fonts as
8902 Chinese, Japanese, and Korean. */);
8903 Vx_pixel_size_width_font_regexp = Qnil;
8904
8905 DEFVAR_LISP ("w32-bdf-filename-alist",
8906 &Vw32_bdf_filename_alist,
8907 doc: /* List of bdf fonts and their corresponding filenames. */);
8908 Vw32_bdf_filename_alist = Qnil;
8909
8910 DEFVAR_BOOL ("w32-strict-fontnames",
8911 &w32_strict_fontnames,
8912 doc: /* Non-nil means only use fonts that are exact matches for those requested.
8913 Default is nil, which allows old fontnames that are not XLFD compliant,
8914 and allows third-party CJK display to work by specifying false charset
8915 fields to trick Emacs into translating to Big5, SJIS etc.
8916 Setting this to t will prevent wrong fonts being selected when
8917 fontsets are automatically created. */);
8918 w32_strict_fontnames = 0;
8919
8920 DEFVAR_BOOL ("w32-strict-painting",
8921 &w32_strict_painting,
8922 doc: /* Non-nil means use strict rules for repainting frames.
8923 Set this to nil to get the old behavior for repainting; this should
8924 only be necessary if the default setting causes problems. */);
8925 w32_strict_painting = 1;
8926
8927 DEFVAR_LISP ("w32-charset-info-alist",
8928 &Vw32_charset_info_alist,
8929 doc: /* Alist linking Emacs character sets to Windows fonts and codepages.
8930 Each entry should be of the form:
8931
8932 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE))
8933
8934 where CHARSET_NAME is a string used in font names to identify the charset,
8935 WINDOWS_CHARSET is a symbol that can be one of:
8936 w32-charset-ansi, w32-charset-default, w32-charset-symbol,
8937 w32-charset-shiftjis, w32-charset-hangeul, w32-charset-gb2312,
8938 w32-charset-chinesebig5,
8939 w32-charset-johab, w32-charset-hebrew,
8940 w32-charset-arabic, w32-charset-greek, w32-charset-turkish,
8941 w32-charset-vietnamese, w32-charset-thai, w32-charset-easteurope,
8942 w32-charset-russian, w32-charset-mac, w32-charset-baltic,
8943 w32-charset-unicode,
8944 or w32-charset-oem.
8945 CODEPAGE should be an integer specifying the codepage that should be used
8946 to display the character set, t to do no translation and output as Unicode,
8947 or nil to do no translation and output as 8 bit (or multibyte on far-east
8948 versions of Windows) characters. */);
8949 Vw32_charset_info_alist = Qnil;
8950
8951 staticpro (&Qw32_charset_ansi);
8952 Qw32_charset_ansi = intern ("w32-charset-ansi");
8953 staticpro (&Qw32_charset_symbol);
8954 Qw32_charset_default = intern ("w32-charset-default");
8955 staticpro (&Qw32_charset_default);
8956 Qw32_charset_symbol = intern ("w32-charset-symbol");
8957 staticpro (&Qw32_charset_shiftjis);
8958 Qw32_charset_shiftjis = intern ("w32-charset-shiftjis");
8959 staticpro (&Qw32_charset_hangeul);
8960 Qw32_charset_hangeul = intern ("w32-charset-hangeul");
8961 staticpro (&Qw32_charset_chinesebig5);
8962 Qw32_charset_chinesebig5 = intern ("w32-charset-chinesebig5");
8963 staticpro (&Qw32_charset_gb2312);
8964 Qw32_charset_gb2312 = intern ("w32-charset-gb2312");
8965 staticpro (&Qw32_charset_oem);
8966 Qw32_charset_oem = intern ("w32-charset-oem");
8967
8968 #ifdef JOHAB_CHARSET
8969 {
8970 static int w32_extra_charsets_defined = 1;
8971 DEFVAR_BOOL ("w32-extra-charsets-defined", &w32_extra_charsets_defined,
8972 doc: /* Internal variable. */);
8973
8974 staticpro (&Qw32_charset_johab);
8975 Qw32_charset_johab = intern ("w32-charset-johab");
8976 staticpro (&Qw32_charset_easteurope);
8977 Qw32_charset_easteurope = intern ("w32-charset-easteurope");
8978 staticpro (&Qw32_charset_turkish);
8979 Qw32_charset_turkish = intern ("w32-charset-turkish");
8980 staticpro (&Qw32_charset_baltic);
8981 Qw32_charset_baltic = intern ("w32-charset-baltic");
8982 staticpro (&Qw32_charset_russian);
8983 Qw32_charset_russian = intern ("w32-charset-russian");
8984 staticpro (&Qw32_charset_arabic);
8985 Qw32_charset_arabic = intern ("w32-charset-arabic");
8986 staticpro (&Qw32_charset_greek);
8987 Qw32_charset_greek = intern ("w32-charset-greek");
8988 staticpro (&Qw32_charset_hebrew);
8989 Qw32_charset_hebrew = intern ("w32-charset-hebrew");
8990 staticpro (&Qw32_charset_vietnamese);
8991 Qw32_charset_vietnamese = intern ("w32-charset-vietnamese");
8992 staticpro (&Qw32_charset_thai);
8993 Qw32_charset_thai = intern ("w32-charset-thai");
8994 staticpro (&Qw32_charset_mac);
8995 Qw32_charset_mac = intern ("w32-charset-mac");
8996 }
8997 #endif
8998
8999 #ifdef UNICODE_CHARSET
9000 {
9001 static int w32_unicode_charset_defined = 1;
9002 DEFVAR_BOOL ("w32-unicode-charset-defined",
9003 &w32_unicode_charset_defined,
9004 doc: /* Internal variable. */);
9005
9006 staticpro (&Qw32_charset_unicode);
9007 Qw32_charset_unicode = intern ("w32-charset-unicode");
9008 }
9009 #endif
9010
9011 #if 0 /* TODO: Port to W32 */
9012 defsubr (&Sx_change_window_property);
9013 defsubr (&Sx_delete_window_property);
9014 defsubr (&Sx_window_property);
9015 #endif
9016 defsubr (&Sxw_display_color_p);
9017 defsubr (&Sx_display_grayscale_p);
9018 defsubr (&Sxw_color_defined_p);
9019 defsubr (&Sxw_color_values);
9020 defsubr (&Sx_server_max_request_size);
9021 defsubr (&Sx_server_vendor);
9022 defsubr (&Sx_server_version);
9023 defsubr (&Sx_display_pixel_width);
9024 defsubr (&Sx_display_pixel_height);
9025 defsubr (&Sx_display_mm_width);
9026 defsubr (&Sx_display_mm_height);
9027 defsubr (&Sx_display_screens);
9028 defsubr (&Sx_display_planes);
9029 defsubr (&Sx_display_color_cells);
9030 defsubr (&Sx_display_visual_class);
9031 defsubr (&Sx_display_backing_store);
9032 defsubr (&Sx_display_save_under);
9033 defsubr (&Sx_create_frame);
9034 defsubr (&Sx_open_connection);
9035 defsubr (&Sx_close_connection);
9036 defsubr (&Sx_display_list);
9037 defsubr (&Sx_synchronize);
9038 defsubr (&Sx_focus_frame);
9039
9040 /* W32 specific functions */
9041
9042 defsubr (&Sw32_select_font);
9043 defsubr (&Sw32_define_rgb_color);
9044 defsubr (&Sw32_default_color_map);
9045 defsubr (&Sw32_load_color_file);
9046 defsubr (&Sw32_send_sys_command);
9047 defsubr (&Sw32_shell_execute);
9048 defsubr (&Sw32_register_hot_key);
9049 defsubr (&Sw32_unregister_hot_key);
9050 defsubr (&Sw32_registered_hot_keys);
9051 defsubr (&Sw32_reconstruct_hot_key);
9052 defsubr (&Sw32_toggle_lock_key);
9053 defsubr (&Sw32_window_exists_p);
9054 defsubr (&Sw32_find_bdf_fonts);
9055
9056 defsubr (&Sfile_system_info);
9057 defsubr (&Sdefault_printer_name);
9058
9059 /* Setting callback functions for fontset handler. */
9060 get_font_info_func = w32_get_font_info;
9061
9062 #if 0 /* This function pointer doesn't seem to be used anywhere.
9063 And the pointer assigned has the wrong type, anyway. */
9064 list_fonts_func = w32_list_fonts;
9065 #endif
9066
9067 load_font_func = w32_load_font;
9068 find_ccl_program_func = w32_find_ccl_program;
9069 query_font_func = w32_query_font;
9070 set_frame_fontset_func = x_set_font;
9071 check_window_system_func = check_w32;
9072
9073
9074 hourglass_atimer = NULL;
9075 hourglass_shown_p = 0;
9076 defsubr (&Sx_show_tip);
9077 defsubr (&Sx_hide_tip);
9078 tip_timer = Qnil;
9079 staticpro (&tip_timer);
9080 tip_frame = Qnil;
9081 staticpro (&tip_frame);
9082
9083 last_show_tip_args = Qnil;
9084 staticpro (&last_show_tip_args);
9085
9086 defsubr (&Sx_file_dialog);
9087 }
9088
9089
9090 /*
9091 globals_of_w32fns is used to initialize those global variables that
9092 must always be initialized on startup even when the global variable
9093 initialized is non zero (see the function main in emacs.c).
9094 globals_of_w32fns is called from syms_of_w32fns when the global
9095 variable initialized is 0 and directly from main when initialized
9096 is non zero.
9097 */
9098 void
9099 globals_of_w32fns ()
9100 {
9101 HMODULE user32_lib = GetModuleHandle ("user32.dll");
9102 /*
9103 TrackMouseEvent not available in all versions of Windows, so must load
9104 it dynamically. Do it once, here, instead of every time it is used.
9105 */
9106 track_mouse_event_fn = (TrackMouseEvent_Proc)
9107 GetProcAddress (user32_lib, "TrackMouseEvent");
9108 /* ditto for GetClipboardSequenceNumber. */
9109 clipboard_sequence_fn = (ClipboardSequence_Proc)
9110 GetProcAddress (user32_lib, "GetClipboardSequenceNumber");
9111
9112 DEFVAR_INT ("w32-ansi-code-page",
9113 &w32_ansi_code_page,
9114 doc: /* The ANSI code page used by the system. */);
9115 w32_ansi_code_page = GetACP ();
9116
9117 /* MessageBox does not work without this when linked to comctl32.dll 6.0. */
9118 InitCommonControls ();
9119 }
9120
9121 #undef abort
9122
9123 void
9124 w32_abort ()
9125 {
9126 int button;
9127 button = MessageBox (NULL,
9128 "A fatal error has occurred!\n\n"
9129 "Would you like to attach a debugger?\n\n"
9130 "Select YES to debug, NO to abort Emacs"
9131 #if __GNUC__
9132 "\n\n(type \"gdb -p <emacs-PID>\" and\n"
9133 "\"continue\" inside GDB before clicking YES.)"
9134 #endif
9135 , "Emacs Abort Dialog",
9136 MB_ICONEXCLAMATION | MB_TASKMODAL
9137 | MB_SETFOREGROUND | MB_YESNO);
9138 switch (button)
9139 {
9140 case IDYES:
9141 DebugBreak ();
9142 exit (2); /* tell the compiler we will never return */
9143 case IDNO:
9144 default:
9145 abort ();
9146 break;
9147 }
9148 }
9149
9150 /* For convenience when debugging. */
9151 int
9152 w32_last_error ()
9153 {
9154 return GetLastError ();
9155 }
9156
9157 /* arch-tag: 707589ab-b9be-4638-8cdd-74629cc9b446
9158 (do not change this comment) */
Unnamed repository; edit this file 'description' to name the repository.