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