src/w32fns.c

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