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