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