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