HCoop / bpt / emacs.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
(iso-languages): For Portuguese ~c and
[bpt/emacs.git] / src / w32fns.c
CommitLineData
e9e23e23 1/* Graphical user interface functions for the Microsoft W32 API.
8681157a 2 Copyright (C) 1989, 92, 93, 94, 95, 1996 Free Software Foundation, Inc.
ee78dc32
GV		 3
4This file is part of GNU Emacs.
5
6GNU Emacs is free software; you can redistribute it and/or modify
7it under the terms of the GNU General Public License as published by
8the Free Software Foundation; either version 2, or (at your option)
9any later version.
10
11GNU Emacs is distributed in the hope that it will be useful,
12but WITHOUT ANY WARRANTY; without even the implied warranty of
13MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14GNU General Public License for more details.
15
16You should have received a copy of the GNU General Public License
17along with GNU Emacs; see the file COPYING. If not, write to
3b7ad313
EN		 18the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19Boston, MA 02111-1307, USA. */
ee78dc32
GV		 20
21/* Added by Kevin Gallo */
22
ee78dc32 23#include <config.h>
1edf84e7
GV		 24
25#include <signal.h>
ee78dc32 26#include <stdio.h>
1edf84e7
GV		 27#include <limits.h>
28#include <errno.h>
ee78dc32
GV		 29
30#include "lisp.h"
4587b026
GV		 31#include "charset.h"
32#include "fontset.h"
ee78dc32
GV		 33#include "w32term.h"
34#include "frame.h"
35#include "window.h"
36#include "buffer.h"
37#include "dispextern.h"
38#include "keyboard.h"
39#include "blockinput.h"
40#include "paths.h"
489f9371 41#include "w32heap.h"
ee78dc32 42#include "termhooks.h"
4587b026 43#include "coding.h"
ee78dc32
GV		 44
45#include <commdlg.h>
cb9e33d4 46#include <shellapi.h>
ee78dc32
GV		 47
48extern void abort ();
49extern void free_frame_menubar ();
50extern struct scroll_bar *x_window_to_scroll_bar ();
adcc3809 51extern int w32_console_toggle_lock_key (int vk_code, Lisp_Object new_state);
5ac45f98 52extern int quit_char;
ee78dc32 53
ccc2d29c
GV		 54extern char *lispy_function_keys[];
55
ee78dc32 56/* The colormap for converting color names to RGB values */
fbd6baed 57Lisp_Object Vw32_color_map;
ee78dc32 58
da36a4d6 59/* Non nil if alt key presses are passed on to Windows. */
fbd6baed 60Lisp_Object Vw32_pass_alt_to_system;
da36a4d6 61
8c205c63
RS		 62/* Non nil if alt key is translated to meta_modifier, nil if it is translated
63 to alt_modifier. */
fbd6baed 64Lisp_Object Vw32_alt_is_meta;
8c205c63 65
ccc2d29c
GV		 66/* Non nil if left window key events are passed on to Windows (this only
67 affects whether "tapping" the key opens the Start menu). */
68Lisp_Object Vw32_pass_lwindow_to_system;
69
70/* Non nil if right window key events are passed on to Windows (this
71 only affects whether "tapping" the key opens the Start menu). */
72Lisp_Object Vw32_pass_rwindow_to_system;
73
adcc3809
GV		 74/* Virtual key code used to generate "phantom" key presses in order
75 to stop system from acting on Windows key events. */
76Lisp_Object Vw32_phantom_key_code;
77
ccc2d29c
GV		 78/* Modifier associated with the left "Windows" key, or nil to act as a
79 normal key. */
80Lisp_Object Vw32_lwindow_modifier;
81
82/* Modifier associated with the right "Windows" key, or nil to act as a
83 normal key. */
84Lisp_Object Vw32_rwindow_modifier;
85
86/* Modifier associated with the "Apps" key, or nil to act as a normal
87 key. */
88Lisp_Object Vw32_apps_modifier;
89
90/* Value is nil if Num Lock acts as a function key. */
91Lisp_Object Vw32_enable_num_lock;
92
93/* Value is nil if Caps Lock acts as a function key. */
94Lisp_Object Vw32_enable_caps_lock;
95
96/* Modifier associated with Scroll Lock, or nil to act as a normal key. */
97Lisp_Object Vw32_scroll_lock_modifier;
da36a4d6 98
5ac45f98
GV		 99/* Switch to control whether we inhibit requests for italicised fonts (which
100 are synthesized, look ugly, and are trashed by cursor movement under NT). */
fbd6baed 101Lisp_Object Vw32_enable_italics;
5ac45f98
GV		 102
103/* Enable palette management. */
fbd6baed 104Lisp_Object Vw32_enable_palette;
5ac45f98
GV		 105
106/* Control how close left/right button down events must be to
107 be converted to a middle button down event. */
fbd6baed 108Lisp_Object Vw32_mouse_button_tolerance;
5ac45f98 109
84fb1139
KH		 110/* Minimum interval between mouse movement (and scroll bar drag)
111 events that are passed on to the event loop. */
fbd6baed 112Lisp_Object Vw32_mouse_move_interval;
84fb1139 113
ee78dc32
GV		 114/* The name we're using in resource queries. */
115Lisp_Object Vx_resource_name;
116
117/* Non nil if no window manager is in use. */
118Lisp_Object Vx_no_window_manager;
119
120/* The background and shape of the mouse pointer, and shape when not
121 over text or in the modeline. */
122Lisp_Object Vx_pointer_shape, Vx_nontext_pointer_shape, Vx_mode_pointer_shape;
123/* The shape when over mouse-sensitive text. */
124Lisp_Object Vx_sensitive_text_pointer_shape;
125
126/* Color of chars displayed in cursor box. */
127Lisp_Object Vx_cursor_fore_pixel;
128
1edf84e7
GV		 129/* Nonzero if using Windows. */
130static int w32_in_use;
131
ee78dc32
GV		 132/* Search path for bitmap files. */
133Lisp_Object Vx_bitmap_file_path;
134
4587b026
GV		 135/* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
136Lisp_Object Vx_pixel_size_width_font_regexp;
137
138/* A flag to control how to display unibyte 8-bit character. */
139int unibyte_display_via_language_environment;
140
ee78dc32
GV		 141/* Evaluate this expression to rebuild the section of syms_of_w32fns
142 that initializes and staticpros the symbols declared below. Note
143 that Emacs 18 has a bug that keeps C-x C-e from being able to
144 evaluate this expression.
145
146(progn
147 ;; Accumulate a list of the symbols we want to initialize from the
148 ;; declarations at the top of the file.
149 (goto-char (point-min))
150 (search-forward "/\*&&& symbols declared here &&&*\/\n")
151 (let (symbol-list)
152 (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)")
153 (setq symbol-list
154 (cons (buffer-substring (match-beginning 1) (match-end 1))
155 symbol-list))
156 (forward-line 1))
157 (setq symbol-list (nreverse symbol-list))
158 ;; Delete the section of syms_of_... where we initialize the symbols.
159 (search-forward "\n /\*&&& init symbols here &&&*\/\n")
160 (let ((start (point)))
161 (while (looking-at "^ Q")
162 (forward-line 2))
163 (kill-region start (point)))
164 ;; Write a new symbol initialization section.
165 (while symbol-list
166 (insert (format " %s = intern (\"" (car symbol-list)))
167 (let ((start (point)))
168 (insert (substring (car symbol-list) 1))
169 (subst-char-in-region start (point) ?_ ?-))
170 (insert (format "\");\n staticpro (&%s);\n" (car symbol-list)))
171 (setq symbol-list (cdr symbol-list)))))
172
173 */
174
175/*&&& symbols declared here &&&*/
176Lisp_Object Qauto_raise;
177Lisp_Object Qauto_lower;
178Lisp_Object Qbackground_color;
179Lisp_Object Qbar;
180Lisp_Object Qborder_color;
181Lisp_Object Qborder_width;
182Lisp_Object Qbox;
183Lisp_Object Qcursor_color;
184Lisp_Object Qcursor_type;
ee78dc32
GV		 185Lisp_Object Qforeground_color;
186Lisp_Object Qgeometry;
187Lisp_Object Qicon_left;
188Lisp_Object Qicon_top;
189Lisp_Object Qicon_type;
190Lisp_Object Qicon_name;
191Lisp_Object Qinternal_border_width;
192Lisp_Object Qleft;
1026b400 193Lisp_Object Qright;
ee78dc32
GV		 194Lisp_Object Qmouse_color;
195Lisp_Object Qnone;
196Lisp_Object Qparent_id;
197Lisp_Object Qscroll_bar_width;
198Lisp_Object Qsuppress_icon;
199Lisp_Object Qtop;
200Lisp_Object Qundefined_color;
201Lisp_Object Qvertical_scroll_bars;
202Lisp_Object Qvisibility;
203Lisp_Object Qwindow_id;
204Lisp_Object Qx_frame_parameter;
205Lisp_Object Qx_resource_name;
206Lisp_Object Quser_position;
207Lisp_Object Quser_size;
208Lisp_Object Qdisplay;
209
adcc3809
GV		 210Lisp_Object Qhyper;
211Lisp_Object Qsuper;
212Lisp_Object Qmeta;
213Lisp_Object Qalt;
214Lisp_Object Qctrl;
215Lisp_Object Qcontrol;
216Lisp_Object Qshift;
217
5ac45f98
GV		 218/* State variables for emulating a three button mouse. */
219#define LMOUSE 1
220#define MMOUSE 2
221#define RMOUSE 4
222
223static int button_state = 0;
fbd6baed 224static W32Msg saved_mouse_button_msg;
84fb1139 225static unsigned mouse_button_timer; /* non-zero when timer is active */
fbd6baed 226static W32Msg saved_mouse_move_msg;
84fb1139
KH		 227static unsigned mouse_move_timer;
228
93fbe8b7
GV		 229/* W95 mousewheel handler */
230unsigned int msh_mousewheel = 0;
231
84fb1139
KH		 232#define MOUSE_BUTTON_ID 1
233#define MOUSE_MOVE_ID 2
5ac45f98 234
ee78dc32
GV		 235/* The below are defined in frame.c. */
236extern Lisp_Object Qheight, Qminibuffer, Qname, Qonly, Qwidth;
1edf84e7 237extern Lisp_Object Qunsplittable, Qmenu_bar_lines, Qbuffer_predicate, Qtitle;
ee78dc32
GV		 238
239extern Lisp_Object Vwindow_system_version;
240
4b817373
RS		 241Lisp_Object Qface_set_after_frame_default;
242
ee78dc32
GV		 243extern Lisp_Object last_mouse_scroll_bar;
244extern int last_mouse_scroll_bar_pos;
5ac45f98 245
fbd6baed
GV		 246/* From w32term.c. */
247extern Lisp_Object Vw32_num_mouse_buttons;
ccc2d29c 248extern Lisp_Object Vw32_recognize_altgr;
5ac45f98 249
ee78dc32 250\f
1edf84e7
GV		 251/* Error if we are not connected to MS-Windows. */
252void
253check_w32 ()
254{
255 if (! w32_in_use)
256 error ("MS-Windows not in use or not initialized");
257}
258
259/* Nonzero if we can use mouse menus.
260 You should not call this unless HAVE_MENUS is defined. */
261
262int
263have_menus_p ()
264{
265 return w32_in_use;
266}
267
ee78dc32 268/* Extract a frame as a FRAME_PTR, defaulting to the selected frame
fbd6baed 269 and checking validity for W32. */
ee78dc32
GV		 270
271FRAME_PTR
272check_x_frame (frame)
273 Lisp_Object frame;
274{
275 FRAME_PTR f;
276
277 if (NILP (frame))
278 f = selected_frame;
279 else
280 {
281 CHECK_LIVE_FRAME (frame, 0);
282 f = XFRAME (frame);
283 }
fbd6baed
GV		 284 if (! FRAME_W32_P (f))
285 error ("non-w32 frame used");
ee78dc32
GV		 286 return f;
287}
288
289/* Let the user specify an display with a frame.
fbd6baed 290 nil stands for the selected frame--or, if that is not a w32 frame,
ee78dc32
GV		 291 the first display on the list. */
292
fbd6baed 293static struct w32_display_info *
ee78dc32
GV		 294check_x_display_info (frame)
295 Lisp_Object frame;
296{
297 if (NILP (frame))
298 {
fbd6baed
GV		 299 if (FRAME_W32_P (selected_frame))
300 return FRAME_W32_DISPLAY_INFO (selected_frame);
ee78dc32 301 else
fbd6baed 302 return &one_w32_display_info;
ee78dc32
GV		 303 }
304 else if (STRINGP (frame))
305 return x_display_info_for_name (frame);
306 else
307 {
308 FRAME_PTR f;
309
310 CHECK_LIVE_FRAME (frame, 0);
311 f = XFRAME (frame);
fbd6baed
GV		 312 if (! FRAME_W32_P (f))
313 error ("non-w32 frame used");
314 return FRAME_W32_DISPLAY_INFO (f);
ee78dc32
GV		 315 }
316}
317\f
fbd6baed 318/* Return the Emacs frame-object corresponding to an w32 window.
ee78dc32
GV		 319 It could be the frame's main window or an icon window. */
320
321/* This function can be called during GC, so use GC_xxx type test macros. */
322
323struct frame *
324x_window_to_frame (dpyinfo, wdesc)
fbd6baed 325 struct w32_display_info *dpyinfo;
ee78dc32
GV		 326 HWND wdesc;
327{
328 Lisp_Object tail, frame;
329 struct frame *f;
330
331 for (tail = Vframe_list; GC_CONSP (tail); tail = XCONS (tail)->cdr)
332 {
333 frame = XCONS (tail)->car;
334 if (!GC_FRAMEP (frame))
335 continue;
336 f = XFRAME (frame);
337 if (f->output_data.nothing == 1
fbd6baed 338 || FRAME_W32_DISPLAY_INFO (f) != dpyinfo)
ee78dc32 339 continue;
fbd6baed 340 if (FRAME_W32_WINDOW (f) == wdesc)
ee78dc32
GV		 341 return f;
342 }
343 return 0;
344}
345
346\f
347
348/* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
349 id, which is just an int that this section returns. Bitmaps are
350 reference counted so they can be shared among frames.
351
352 Bitmap indices are guaranteed to be > 0, so a negative number can
353 be used to indicate no bitmap.
354
355 If you use x_create_bitmap_from_data, then you must keep track of
356 the bitmaps yourself. That is, creating a bitmap from the same
357 data more than once will not be caught. */
358
359
360/* Functions to access the contents of a bitmap, given an id. */
361
362int
363x_bitmap_height (f, id)
364 FRAME_PTR f;
365 int id;
366{
fbd6baed 367 return FRAME_W32_DISPLAY_INFO (f)->bitmaps[id - 1].height;
ee78dc32
GV		 368}
369
370int
371x_bitmap_width (f, id)
372 FRAME_PTR f;
373 int id;
374{
fbd6baed 375 return FRAME_W32_DISPLAY_INFO (f)->bitmaps[id - 1].width;
ee78dc32
GV		 376}
377
378int
379x_bitmap_pixmap (f, id)
380 FRAME_PTR f;
381 int id;
382{
fbd6baed 383 return (int) FRAME_W32_DISPLAY_INFO (f)->bitmaps[id - 1].pixmap;
ee78dc32
GV		 384}
385
386
387/* Allocate a new bitmap record. Returns index of new record. */
388
389static int
390x_allocate_bitmap_record (f)
391 FRAME_PTR f;
392{
fbd6baed 393 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
ee78dc32
GV		 394 int i;
395
396 if (dpyinfo->bitmaps == NULL)
397 {
398 dpyinfo->bitmaps_size = 10;
399 dpyinfo->bitmaps
fbd6baed 400 = (struct w32_bitmap_record *) xmalloc (dpyinfo->bitmaps_size * sizeof (struct w32_bitmap_record));
ee78dc32
GV		 401 dpyinfo->bitmaps_last = 1;
402 return 1;
403 }
404
405 if (dpyinfo->bitmaps_last < dpyinfo->bitmaps_size)
406 return ++dpyinfo->bitmaps_last;
407
408 for (i = 0; i < dpyinfo->bitmaps_size; ++i)
409 if (dpyinfo->bitmaps[i].refcount == 0)
410 return i + 1;
411
412 dpyinfo->bitmaps_size *= 2;
413 dpyinfo->bitmaps
fbd6baed
GV		 414 = (struct w32_bitmap_record *) xrealloc (dpyinfo->bitmaps,
415 dpyinfo->bitmaps_size * sizeof (struct w32_bitmap_record));
ee78dc32
GV		 416 return ++dpyinfo->bitmaps_last;
417}
418
419/* Add one reference to the reference count of the bitmap with id ID. */
420
421void
422x_reference_bitmap (f, id)
423 FRAME_PTR f;
424 int id;
425{
fbd6baed 426 ++FRAME_W32_DISPLAY_INFO (f)->bitmaps[id - 1].refcount;
ee78dc32
GV		 427}
428
429/* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
430
431int
432x_create_bitmap_from_data (f, bits, width, height)
433 struct frame *f;
434 char *bits;
435 unsigned int width, height;
436{
fbd6baed 437 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
ee78dc32
GV		 438 Pixmap bitmap;
439 int id;
440
441 bitmap = CreateBitmap (width, height,
fbd6baed
GV		 442 FRAME_W32_DISPLAY_INFO (XFRAME (frame))->n_planes,
443 FRAME_W32_DISPLAY_INFO (XFRAME (frame))->n_cbits,
ee78dc32
GV		 444 bits);
445
446 if (! bitmap)
447 return -1;
448
449 id = x_allocate_bitmap_record (f);
450 dpyinfo->bitmaps[id - 1].pixmap = bitmap;
451 dpyinfo->bitmaps[id - 1].file = NULL;
452 dpyinfo->bitmaps[id - 1].hinst = NULL;
453 dpyinfo->bitmaps[id - 1].refcount = 1;
454 dpyinfo->bitmaps[id - 1].depth = 1;
455 dpyinfo->bitmaps[id - 1].height = height;
456 dpyinfo->bitmaps[id - 1].width = width;
457
458 return id;
459}
460
461/* Create bitmap from file FILE for frame F. */
462
463int
464x_create_bitmap_from_file (f, file)
465 struct frame *f;
466 Lisp_Object file;
467{
468 return -1;
469#if 0
fbd6baed 470 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
ee78dc32
GV		 471 unsigned int width, height;
472 Pixmap bitmap;
473 int xhot, yhot, result, id;
474 Lisp_Object found;
475 int fd;
476 char *filename;
477 HINSTANCE hinst;
478
479 /* Look for an existing bitmap with the same name. */
480 for (id = 0; id < dpyinfo->bitmaps_last; ++id)
481 {
482 if (dpyinfo->bitmaps[id].refcount
483 && dpyinfo->bitmaps[id].file
484 && !strcmp (dpyinfo->bitmaps[id].file, (char *) XSTRING (file)->data))
485 {
486 ++dpyinfo->bitmaps[id].refcount;
487 return id + 1;
488 }
489 }
490
491 /* Search bitmap-file-path for the file, if appropriate. */
492 fd = openp (Vx_bitmap_file_path, file, "", &found, 0);
493 if (fd < 0)
494 return -1;
5d7fed93
GV		 495 /* LoadLibraryEx won't handle special files handled by Emacs handler. */
496 if (fd == 0)
497 return -1;
ee78dc32
GV		 498 close (fd);
499
500 filename = (char *) XSTRING (found)->data;
501
502 hinst = LoadLibraryEx (filename, NULL, LOAD_LIBRARY_AS_DATAFILE);
503
504 if (hinst == NULL)
505 return -1;
506
507
fbd6baed 508 result = XReadBitmapFile (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
ee78dc32
GV		 509 filename, &width, &height, &bitmap, &xhot, &yhot);
510 if (result != BitmapSuccess)
511 return -1;
512
513 id = x_allocate_bitmap_record (f);
514 dpyinfo->bitmaps[id - 1].pixmap = bitmap;
515 dpyinfo->bitmaps[id - 1].refcount = 1;
516 dpyinfo->bitmaps[id - 1].file = (char *) xmalloc (XSTRING (file)->size + 1);
517 dpyinfo->bitmaps[id - 1].depth = 1;
518 dpyinfo->bitmaps[id - 1].height = height;
519 dpyinfo->bitmaps[id - 1].width = width;
520 strcpy (dpyinfo->bitmaps[id - 1].file, XSTRING (file)->data);
521
522 return id;
523#endif
524}
525
526/* Remove reference to bitmap with id number ID. */
527
528int
529x_destroy_bitmap (f, id)
530 FRAME_PTR f;
531 int id;
532{
fbd6baed 533 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
ee78dc32
GV		 534
535 if (id > 0)
536 {
537 --dpyinfo->bitmaps[id - 1].refcount;
538 if (dpyinfo->bitmaps[id - 1].refcount == 0)
539 {
540 BLOCK_INPUT;
541 DeleteObject (dpyinfo->bitmaps[id - 1].pixmap);
542 if (dpyinfo->bitmaps[id - 1].file)
543 {
544 free (dpyinfo->bitmaps[id - 1].file);
545 dpyinfo->bitmaps[id - 1].file = NULL;
546 }
547 UNBLOCK_INPUT;
548 }
549 }
550}
551
552/* Free all the bitmaps for the display specified by DPYINFO. */
553
554static void
555x_destroy_all_bitmaps (dpyinfo)
fbd6baed 556 struct w32_display_info *dpyinfo;
ee78dc32
GV		 557{
558 int i;
559 for (i = 0; i < dpyinfo->bitmaps_last; i++)
560 if (dpyinfo->bitmaps[i].refcount > 0)
561 {
562 DeleteObject (dpyinfo->bitmaps[i].pixmap);
563 if (dpyinfo->bitmaps[i].file)
564 free (dpyinfo->bitmaps[i].file);
565 }
566 dpyinfo->bitmaps_last = 0;
567}
568\f
fbd6baed 569/* Connect the frame-parameter names for W32 frames
ee78dc32
GV		 570 to the ways of passing the parameter values to the window system.
571
572 The name of a parameter, as a Lisp symbol,
573 has an `x-frame-parameter' property which is an integer in Lisp
574 but can be interpreted as an `enum x_frame_parm' in C. */
575
576enum x_frame_parm
577{
578 X_PARM_FOREGROUND_COLOR,
579 X_PARM_BACKGROUND_COLOR,
580 X_PARM_MOUSE_COLOR,
581 X_PARM_CURSOR_COLOR,
582 X_PARM_BORDER_COLOR,
583 X_PARM_ICON_TYPE,
584 X_PARM_FONT,
585 X_PARM_BORDER_WIDTH,
586 X_PARM_INTERNAL_BORDER_WIDTH,
587 X_PARM_NAME,
588 X_PARM_AUTORAISE,
589 X_PARM_AUTOLOWER,
590 X_PARM_VERT_SCROLL_BAR,
591 X_PARM_VISIBILITY,
592 X_PARM_MENU_BAR_LINES
593};
594
595
596struct x_frame_parm_table
597{
598 char *name;
599 void (*setter)( /* struct frame *frame, Lisp_Object val, oldval */ );
600};
601
602void x_set_foreground_color ();
603void x_set_background_color ();
604void x_set_mouse_color ();
605void x_set_cursor_color ();
606void x_set_border_color ();
607void x_set_cursor_type ();
608void x_set_icon_type ();
609void x_set_icon_name ();
610void x_set_font ();
611void x_set_border_width ();
612void x_set_internal_border_width ();
613void x_explicitly_set_name ();
614void x_set_autoraise ();
615void x_set_autolower ();
616void x_set_vertical_scroll_bars ();
617void x_set_visibility ();
618void x_set_menu_bar_lines ();
619void x_set_scroll_bar_width ();
1edf84e7 620void x_set_title ();
ee78dc32
GV		 621void x_set_unsplittable ();
622
623static struct x_frame_parm_table x_frame_parms[] =
624{
1edf84e7
GV		 625 "auto-raise", x_set_autoraise,
626 "auto-lower", x_set_autolower,
ee78dc32 627 "background-color", x_set_background_color,
ee78dc32 628 "border-color", x_set_border_color,
1edf84e7
GV		 629 "border-width", x_set_border_width,
630 "cursor-color", x_set_cursor_color,
ee78dc32 631 "cursor-type", x_set_cursor_type,
ee78dc32 632 "font", x_set_font,
1edf84e7
GV		 633 "foreground-color", x_set_foreground_color,
634 "icon-name", x_set_icon_name,
635 "icon-type", x_set_icon_type,
ee78dc32 636 "internal-border-width", x_set_internal_border_width,
ee78dc32 637 "menu-bar-lines", x_set_menu_bar_lines,
1edf84e7
GV		 638 "mouse-color", x_set_mouse_color,
639 "name", x_explicitly_set_name,
ee78dc32 640 "scroll-bar-width", x_set_scroll_bar_width,
1edf84e7 641 "title", x_set_title,
ee78dc32 642 "unsplittable", x_set_unsplittable,
1edf84e7
GV		 643 "vertical-scroll-bars", x_set_vertical_scroll_bars,
644 "visibility", x_set_visibility,
ee78dc32
GV		 645};
646
647/* Attach the `x-frame-parameter' properties to
fbd6baed 648 the Lisp symbol names of parameters relevant to W32. */
ee78dc32
GV		 649
650init_x_parm_symbols ()
651{
652 int i;
653
654 for (i = 0; i < sizeof (x_frame_parms) / sizeof (x_frame_parms[0]); i++)
655 Fput (intern (x_frame_parms[i].name), Qx_frame_parameter,
656 make_number (i));
657}
658\f
659/* Change the parameters of FRAME as specified by ALIST.
660 If a parameter is not specially recognized, do nothing;
661 otherwise call the `x_set_...' function for that parameter. */
662
663void
664x_set_frame_parameters (f, alist)
665 FRAME_PTR f;
666 Lisp_Object alist;
667{
668 Lisp_Object tail;
669
670 /* If both of these parameters are present, it's more efficient to
671 set them both at once. So we wait until we've looked at the
672 entire list before we set them. */
b839712d 673 int width, height;
ee78dc32
GV		 674
675 /* Same here. */
676 Lisp_Object left, top;
677
678 /* Same with these. */
679 Lisp_Object icon_left, icon_top;
680
681 /* Record in these vectors all the parms specified. */
682 Lisp_Object *parms;
683 Lisp_Object *values;
684 int i;
685 int left_no_change = 0, top_no_change = 0;
686 int icon_left_no_change = 0, icon_top_no_change = 0;
687
688 i = 0;
689 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
690 i++;
691
692 parms = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
693 values = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
694
695 /* Extract parm names and values into those vectors. */
696
697 i = 0;
698 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
699 {
700 Lisp_Object elt, prop, val;
701
702 elt = Fcar (tail);
703 parms[i] = Fcar (elt);
704 values[i] = Fcdr (elt);
705 i++;
706 }
707
b839712d 708 top = left = Qunbound;
ee78dc32
GV		 709 icon_left = icon_top = Qunbound;
710
b839712d
RS		 711 /* Provide default values for HEIGHT and WIDTH. */
712 width = FRAME_WIDTH (f);
713 height = FRAME_HEIGHT (f);
714
ee78dc32
GV		 715 /* Now process them in reverse of specified order. */
716 for (i--; i >= 0; i--)
717 {
718 Lisp_Object prop, val;
719
720 prop = parms[i];
721 val = values[i];
722
b839712d
RS		 723 if (EQ (prop, Qwidth) && NUMBERP (val))
724 width = XFASTINT (val);
725 else if (EQ (prop, Qheight) && NUMBERP (val))
726 height = XFASTINT (val);
ee78dc32
GV		 727 else if (EQ (prop, Qtop))
728 top = val;
729 else if (EQ (prop, Qleft))
730 left = val;
731 else if (EQ (prop, Qicon_top))
732 icon_top = val;
733 else if (EQ (prop, Qicon_left))
734 icon_left = val;
735 else
736 {
737 register Lisp_Object param_index, old_value;
738
739 param_index = Fget (prop, Qx_frame_parameter);
740 old_value = get_frame_param (f, prop);
741 store_frame_param (f, prop, val);
742 if (NATNUMP (param_index)
743 && (XFASTINT (param_index)
744 < sizeof (x_frame_parms)/sizeof (x_frame_parms[0])))
3c190163 745 (*x_frame_parms[XINT (param_index)].setter)(f, val, old_value);
ee78dc32
GV		 746 }
747 }
748
749 /* Don't die if just one of these was set. */
750 if (EQ (left, Qunbound))
751 {
752 left_no_change = 1;
fbd6baed
GV		 753 if (f->output_data.w32->left_pos < 0)
754 left = Fcons (Qplus, Fcons (make_number (f->output_data.w32->left_pos), Qnil));
ee78dc32 755 else
fbd6baed 756 XSETINT (left, f->output_data.w32->left_pos);
ee78dc32
GV		 757 }
758 if (EQ (top, Qunbound))
759 {
760 top_no_change = 1;
fbd6baed
GV		 761 if (f->output_data.w32->top_pos < 0)
762 top = Fcons (Qplus, Fcons (make_number (f->output_data.w32->top_pos), Qnil));
ee78dc32 763 else
fbd6baed 764 XSETINT (top, f->output_data.w32->top_pos);
ee78dc32
GV		 765 }
766
767 /* If one of the icon positions was not set, preserve or default it. */
768 if (EQ (icon_left, Qunbound) || ! INTEGERP (icon_left))
769 {
770 icon_left_no_change = 1;
771 icon_left = Fcdr (Fassq (Qicon_left, f->param_alist));
772 if (NILP (icon_left))
773 XSETINT (icon_left, 0);
774 }
775 if (EQ (icon_top, Qunbound) || ! INTEGERP (icon_top))
776 {
777 icon_top_no_change = 1;
778 icon_top = Fcdr (Fassq (Qicon_top, f->param_alist));
779 if (NILP (icon_top))
780 XSETINT (icon_top, 0);
781 }
782
ee78dc32
GV		 783 /* Don't set these parameters unless they've been explicitly
784 specified. The window might be mapped or resized while we're in
785 this function, and we don't want to override that unless the lisp
786 code has asked for it.
787
788 Don't set these parameters unless they actually differ from the
789 window's current parameters; the window may not actually exist
790 yet. */
791 {
792 Lisp_Object frame;
793
794 check_frame_size (f, &height, &width);
795
796 XSETFRAME (frame, f);
797
b839712d
RS		 798 if (XINT (width) != FRAME_WIDTH (f)
799 || XINT (height) != FRAME_HEIGHT (f))
800 Fset_frame_size (frame, make_number (width), make_number (height));
ee78dc32
GV		 801
802 if ((!NILP (left) || !NILP (top))
803 && ! (left_no_change && top_no_change)
fbd6baed
GV		 804 && ! (NUMBERP (left) && XINT (left) == f->output_data.w32->left_pos
805 && NUMBERP (top) && XINT (top) == f->output_data.w32->top_pos))
ee78dc32
GV		 806 {
807 int leftpos = 0;
808 int toppos = 0;
809
810 /* Record the signs. */
fbd6baed 811 f->output_data.w32->size_hint_flags &= ~ (XNegative | YNegative);
ee78dc32 812 if (EQ (left, Qminus))
fbd6baed 813 f->output_data.w32->size_hint_flags |= XNegative;
ee78dc32
GV		 814 else if (INTEGERP (left))
815 {
816 leftpos = XINT (left);
817 if (leftpos < 0)
fbd6baed 818 f->output_data.w32->size_hint_flags |= XNegative;
ee78dc32
GV		 819 }
820 else if (CONSP (left) && EQ (XCONS (left)->car, Qminus)
821 && CONSP (XCONS (left)->cdr)
822 && INTEGERP (XCONS (XCONS (left)->cdr)->car))
823 {
824 leftpos = - XINT (XCONS (XCONS (left)->cdr)->car);
fbd6baed 825 f->output_data.w32->size_hint_flags |= XNegative;
ee78dc32
GV		 826 }
827 else if (CONSP (left) && EQ (XCONS (left)->car, Qplus)
828 && CONSP (XCONS (left)->cdr)
829 && INTEGERP (XCONS (XCONS (left)->cdr)->car))
830 {
831 leftpos = XINT (XCONS (XCONS (left)->cdr)->car);
832 }
833
834 if (EQ (top, Qminus))
fbd6baed 835 f->output_data.w32->size_hint_flags |= YNegative;
ee78dc32
GV		 836 else if (INTEGERP (top))
837 {
838 toppos = XINT (top);
839 if (toppos < 0)
fbd6baed 840 f->output_data.w32->size_hint_flags |= YNegative;
ee78dc32
GV		 841 }
842 else if (CONSP (top) && EQ (XCONS (top)->car, Qminus)
843 && CONSP (XCONS (top)->cdr)
844 && INTEGERP (XCONS (XCONS (top)->cdr)->car))
845 {
846 toppos = - XINT (XCONS (XCONS (top)->cdr)->car);
fbd6baed 847 f->output_data.w32->size_hint_flags |= YNegative;
ee78dc32
GV		 848 }
849 else if (CONSP (top) && EQ (XCONS (top)->car, Qplus)
850 && CONSP (XCONS (top)->cdr)
851 && INTEGERP (XCONS (XCONS (top)->cdr)->car))
852 {
853 toppos = XINT (XCONS (XCONS (top)->cdr)->car);
854 }
855
856
857 /* Store the numeric value of the position. */
fbd6baed
GV		 858 f->output_data.w32->top_pos = toppos;
859 f->output_data.w32->left_pos = leftpos;
ee78dc32 860
fbd6baed 861 f->output_data.w32->win_gravity = NorthWestGravity;
ee78dc32
GV		 862
863 /* Actually set that position, and convert to absolute. */
864 x_set_offset (f, leftpos, toppos, -1);
865 }
866
867 if ((!NILP (icon_left) || !NILP (icon_top))
868 && ! (icon_left_no_change && icon_top_no_change))
869 x_wm_set_icon_position (f, XINT (icon_left), XINT (icon_top));
870 }
871}
872
873/* Store the screen positions of frame F into XPTR and YPTR.
874 These are the positions of the containing window manager window,
875 not Emacs's own window. */
876
877void
878x_real_positions (f, xptr, yptr)
879 FRAME_PTR f;
880 int *xptr, *yptr;
881{
882 POINT pt;
3c190163
GV		 883
884 {
885 RECT rect;
ee78dc32 886
fbd6baed
GV		 887 GetClientRect(FRAME_W32_WINDOW(f), &rect);
888 AdjustWindowRect(&rect, f->output_data.w32->dwStyle, FRAME_EXTERNAL_MENU_BAR(f));
ee78dc32 889
3c190163
GV		 890 pt.x = rect.left;
891 pt.y = rect.top;
892 }
ee78dc32 893
fbd6baed 894 ClientToScreen (FRAME_W32_WINDOW(f), &pt);
ee78dc32
GV		 895
896 *xptr = pt.x;
897 *yptr = pt.y;
898}
899
900/* Insert a description of internally-recorded parameters of frame X
901 into the parameter alist *ALISTPTR that is to be given to the user.
fbd6baed 902 Only parameters that are specific to W32
ee78dc32
GV		 903 and whose values are not correctly recorded in the frame's
904 param_alist need to be considered here. */
905
906x_report_frame_params (f, alistptr)
907 struct frame *f;
908 Lisp_Object *alistptr;
909{
910 char buf[16];
911 Lisp_Object tem;
912
913 /* Represent negative positions (off the top or left screen edge)
914 in a way that Fmodify_frame_parameters will understand correctly. */
fbd6baed
GV		 915 XSETINT (tem, f->output_data.w32->left_pos);
916 if (f->output_data.w32->left_pos >= 0)
ee78dc32
GV		 917 store_in_alist (alistptr, Qleft, tem);
918 else
919 store_in_alist (alistptr, Qleft, Fcons (Qplus, Fcons (tem, Qnil)));
920
fbd6baed
GV		 921 XSETINT (tem, f->output_data.w32->top_pos);
922 if (f->output_data.w32->top_pos >= 0)
ee78dc32
GV		 923 store_in_alist (alistptr, Qtop, tem);
924 else
925 store_in_alist (alistptr, Qtop, Fcons (Qplus, Fcons (tem, Qnil)));
926
927 store_in_alist (alistptr, Qborder_width,
fbd6baed 928 make_number (f->output_data.w32->border_width));
ee78dc32 929 store_in_alist (alistptr, Qinternal_border_width,
fbd6baed
GV		 930 make_number (f->output_data.w32->internal_border_width));
931 sprintf (buf, "%ld", (long) FRAME_W32_WINDOW (f));
ee78dc32
GV		 932 store_in_alist (alistptr, Qwindow_id,
933 build_string (buf));
934 store_in_alist (alistptr, Qicon_name, f->icon_name);
935 FRAME_SAMPLE_VISIBILITY (f);
936 store_in_alist (alistptr, Qvisibility,
937 (FRAME_VISIBLE_P (f) ? Qt
938 : FRAME_ICONIFIED_P (f) ? Qicon : Qnil));
939 store_in_alist (alistptr, Qdisplay,
fbd6baed 940 XCONS (FRAME_W32_DISPLAY_INFO (f)->name_list_element)->car);
ee78dc32
GV		 941}
942\f
943
fbd6baed 944DEFUN ("w32-define-rgb-color", Fw32_define_rgb_color, Sw32_define_rgb_color, 4, 4, 0,
5ac45f98 945 "Convert RGB numbers to a windows color reference and associate with NAME (a string).\n\
fbd6baed 946This adds or updates a named color to w32-color-map, making it available for use.\n\
5ac45f98
GV		 947The original entry's RGB ref is returned, or nil if the entry is new.")
948 (red, green, blue, name)
949 Lisp_Object red, green, blue, name;
ee78dc32 950{
5ac45f98
GV		 951 Lisp_Object rgb;
952 Lisp_Object oldrgb = Qnil;
953 Lisp_Object entry;
954
955 CHECK_NUMBER (red, 0);
956 CHECK_NUMBER (green, 0);
957 CHECK_NUMBER (blue, 0);
958 CHECK_STRING (name, 0);
ee78dc32 959
5ac45f98 960 XSET (rgb, Lisp_Int, RGB(XUINT (red), XUINT (green), XUINT (blue)));
ee78dc32 961
5ac45f98 962 BLOCK_INPUT;
ee78dc32 963
fbd6baed
GV		 964 /* replace existing entry in w32-color-map or add new entry. */
965 entry = Fassoc (name, Vw32_color_map);
5ac45f98
GV		 966 if (NILP (entry))
967 {
968 entry = Fcons (name, rgb);
fbd6baed 969 Vw32_color_map = Fcons (entry, Vw32_color_map);
5ac45f98
GV		 970 }
971 else
972 {
973 oldrgb = Fcdr (entry);
974 Fsetcdr (entry, rgb);
975 }
976
977 UNBLOCK_INPUT;
978
979 return (oldrgb);
ee78dc32
GV		 980}
981
fbd6baed 982DEFUN ("w32-load-color-file", Fw32_load_color_file, Sw32_load_color_file, 1, 1, 0,
5ac45f98 983 "Create an alist of color entries from an external file (ie. rgb.txt).\n\
fbd6baed 984Assign this value to w32-color-map to replace the existing color map.\n\
5ac45f98
GV		 985\
986The file should define one named RGB color per line like so:\
987 R G B name\n\
988where R,G,B are numbers between 0 and 255 and name is an arbitrary string.")
989 (filename)
990 Lisp_Object filename;
991{
992 FILE *fp;
993 Lisp_Object cmap = Qnil;
994 Lisp_Object abspath;
995
996 CHECK_STRING (filename, 0);
997 abspath = Fexpand_file_name (filename, Qnil);
998
999 fp = fopen (XSTRING (filename)->data, "rt");
1000 if (fp)
1001 {
1002 char buf[512];
1003 int red, green, blue;
1004 int num;
1005
1006 BLOCK_INPUT;
1007
1008 while (fgets (buf, sizeof (buf), fp) != NULL) {
1009 if (sscanf (buf, "%u %u %u %n", &red, &green, &blue, &num) == 3)
1010 {
1011 char *name = buf + num;
1012 num = strlen (name) - 1;
1013 if (name[num] == '\n')
1014 name[num] = 0;
1015 cmap = Fcons (Fcons (build_string (name),
1016 make_number (RGB (red, green, blue))),
1017 cmap);
1018 }
1019 }
1020 fclose (fp);
1021
1022 UNBLOCK_INPUT;
1023 }
1024
1025 return cmap;
1026}
ee78dc32 1027
fbd6baed 1028/* The default colors for the w32 color map */
ee78dc32
GV		 1029typedef struct colormap_t
1030{
1031 char *name;
1032 COLORREF colorref;
1033} colormap_t;
1034
fbd6baed 1035colormap_t w32_color_map[] =
ee78dc32 1036{
1da8a614
GV		 1037 {"snow" , PALETTERGB (255,250,250)},
1038 {"ghost white" , PALETTERGB (248,248,255)},
1039 {"GhostWhite" , PALETTERGB (248,248,255)},
1040 {"white smoke" , PALETTERGB (245,245,245)},
1041 {"WhiteSmoke" , PALETTERGB (245,245,245)},
1042 {"gainsboro" , PALETTERGB (220,220,220)},
1043 {"floral white" , PALETTERGB (255,250,240)},
1044 {"FloralWhite" , PALETTERGB (255,250,240)},
1045 {"old lace" , PALETTERGB (253,245,230)},
1046 {"OldLace" , PALETTERGB (253,245,230)},
1047 {"linen" , PALETTERGB (250,240,230)},
1048 {"antique white" , PALETTERGB (250,235,215)},
1049 {"AntiqueWhite" , PALETTERGB (250,235,215)},
1050 {"papaya whip" , PALETTERGB (255,239,213)},
1051 {"PapayaWhip" , PALETTERGB (255,239,213)},
1052 {"blanched almond" , PALETTERGB (255,235,205)},
1053 {"BlanchedAlmond" , PALETTERGB (255,235,205)},
1054 {"bisque" , PALETTERGB (255,228,196)},
1055 {"peach puff" , PALETTERGB (255,218,185)},
1056 {"PeachPuff" , PALETTERGB (255,218,185)},
1057 {"navajo white" , PALETTERGB (255,222,173)},
1058 {"NavajoWhite" , PALETTERGB (255,222,173)},
1059 {"moccasin" , PALETTERGB (255,228,181)},
1060 {"cornsilk" , PALETTERGB (255,248,220)},
1061 {"ivory" , PALETTERGB (255,255,240)},
1062 {"lemon chiffon" , PALETTERGB (255,250,205)},
1063 {"LemonChiffon" , PALETTERGB (255,250,205)},
1064 {"seashell" , PALETTERGB (255,245,238)},
1065 {"honeydew" , PALETTERGB (240,255,240)},
1066 {"mint cream" , PALETTERGB (245,255,250)},
1067 {"MintCream" , PALETTERGB (245,255,250)},
1068 {"azure" , PALETTERGB (240,255,255)},
1069 {"alice blue" , PALETTERGB (240,248,255)},
1070 {"AliceBlue" , PALETTERGB (240,248,255)},
1071 {"lavender" , PALETTERGB (230,230,250)},
1072 {"lavender blush" , PALETTERGB (255,240,245)},
1073 {"LavenderBlush" , PALETTERGB (255,240,245)},
1074 {"misty rose" , PALETTERGB (255,228,225)},
1075 {"MistyRose" , PALETTERGB (255,228,225)},
1076 {"white" , PALETTERGB (255,255,255)},
1077 {"black" , PALETTERGB ( 0, 0, 0)},
1078 {"dark slate gray" , PALETTERGB ( 47, 79, 79)},
1079 {"DarkSlateGray" , PALETTERGB ( 47, 79, 79)},
1080 {"dark slate grey" , PALETTERGB ( 47, 79, 79)},
1081 {"DarkSlateGrey" , PALETTERGB ( 47, 79, 79)},
1082 {"dim gray" , PALETTERGB (105,105,105)},
1083 {"DimGray" , PALETTERGB (105,105,105)},
1084 {"dim grey" , PALETTERGB (105,105,105)},
1085 {"DimGrey" , PALETTERGB (105,105,105)},
1086 {"slate gray" , PALETTERGB (112,128,144)},
1087 {"SlateGray" , PALETTERGB (112,128,144)},
1088 {"slate grey" , PALETTERGB (112,128,144)},
1089 {"SlateGrey" , PALETTERGB (112,128,144)},
1090 {"light slate gray" , PALETTERGB (119,136,153)},
1091 {"LightSlateGray" , PALETTERGB (119,136,153)},
1092 {"light slate grey" , PALETTERGB (119,136,153)},
1093 {"LightSlateGrey" , PALETTERGB (119,136,153)},
1094 {"gray" , PALETTERGB (190,190,190)},
1095 {"grey" , PALETTERGB (190,190,190)},
1096 {"light grey" , PALETTERGB (211,211,211)},
1097 {"LightGrey" , PALETTERGB (211,211,211)},
1098 {"light gray" , PALETTERGB (211,211,211)},
1099 {"LightGray" , PALETTERGB (211,211,211)},
1100 {"midnight blue" , PALETTERGB ( 25, 25,112)},
1101 {"MidnightBlue" , PALETTERGB ( 25, 25,112)},
1102 {"navy" , PALETTERGB ( 0, 0,128)},
1103 {"navy blue" , PALETTERGB ( 0, 0,128)},
1104 {"NavyBlue" , PALETTERGB ( 0, 0,128)},
1105 {"cornflower blue" , PALETTERGB (100,149,237)},
1106 {"CornflowerBlue" , PALETTERGB (100,149,237)},
1107 {"dark slate blue" , PALETTERGB ( 72, 61,139)},
1108 {"DarkSlateBlue" , PALETTERGB ( 72, 61,139)},
1109 {"slate blue" , PALETTERGB (106, 90,205)},
1110 {"SlateBlue" , PALETTERGB (106, 90,205)},
1111 {"medium slate blue" , PALETTERGB (123,104,238)},
1112 {"MediumSlateBlue" , PALETTERGB (123,104,238)},
1113 {"light slate blue" , PALETTERGB (132,112,255)},
1114 {"LightSlateBlue" , PALETTERGB (132,112,255)},
1115 {"medium blue" , PALETTERGB ( 0, 0,205)},
1116 {"MediumBlue" , PALETTERGB ( 0, 0,205)},
1117 {"royal blue" , PALETTERGB ( 65,105,225)},
1118 {"RoyalBlue" , PALETTERGB ( 65,105,225)},
1119 {"blue" , PALETTERGB ( 0, 0,255)},
1120 {"dodger blue" , PALETTERGB ( 30,144,255)},
1121 {"DodgerBlue" , PALETTERGB ( 30,144,255)},
1122 {"deep sky blue" , PALETTERGB ( 0,191,255)},
1123 {"DeepSkyBlue" , PALETTERGB ( 0,191,255)},
1124 {"sky blue" , PALETTERGB (135,206,235)},
1125 {"SkyBlue" , PALETTERGB (135,206,235)},
1126 {"light sky blue" , PALETTERGB (135,206,250)},
1127 {"LightSkyBlue" , PALETTERGB (135,206,250)},
1128 {"steel blue" , PALETTERGB ( 70,130,180)},
1129 {"SteelBlue" , PALETTERGB ( 70,130,180)},
1130 {"light steel blue" , PALETTERGB (176,196,222)},
1131 {"LightSteelBlue" , PALETTERGB (176,196,222)},
1132 {"light blue" , PALETTERGB (173,216,230)},
1133 {"LightBlue" , PALETTERGB (173,216,230)},
1134 {"powder blue" , PALETTERGB (176,224,230)},
1135 {"PowderBlue" , PALETTERGB (176,224,230)},
1136 {"pale turquoise" , PALETTERGB (175,238,238)},
1137 {"PaleTurquoise" , PALETTERGB (175,238,238)},
1138 {"dark turquoise" , PALETTERGB ( 0,206,209)},
1139 {"DarkTurquoise" , PALETTERGB ( 0,206,209)},
1140 {"medium turquoise" , PALETTERGB ( 72,209,204)},
1141 {"MediumTurquoise" , PALETTERGB ( 72,209,204)},
1142 {"turquoise" , PALETTERGB ( 64,224,208)},
1143 {"cyan" , PALETTERGB ( 0,255,255)},
1144 {"light cyan" , PALETTERGB (224,255,255)},
1145 {"LightCyan" , PALETTERGB (224,255,255)},
1146 {"cadet blue" , PALETTERGB ( 95,158,160)},
1147 {"CadetBlue" , PALETTERGB ( 95,158,160)},
1148 {"medium aquamarine" , PALETTERGB (102,205,170)},
1149 {"MediumAquamarine" , PALETTERGB (102,205,170)},
1150 {"aquamarine" , PALETTERGB (127,255,212)},
1151 {"dark green" , PALETTERGB ( 0,100, 0)},
1152 {"DarkGreen" , PALETTERGB ( 0,100, 0)},
1153 {"dark olive green" , PALETTERGB ( 85,107, 47)},
1154 {"DarkOliveGreen" , PALETTERGB ( 85,107, 47)},
1155 {"dark sea green" , PALETTERGB (143,188,143)},
1156 {"DarkSeaGreen" , PALETTERGB (143,188,143)},
1157 {"sea green" , PALETTERGB ( 46,139, 87)},
1158 {"SeaGreen" , PALETTERGB ( 46,139, 87)},
1159 {"medium sea green" , PALETTERGB ( 60,179,113)},
1160 {"MediumSeaGreen" , PALETTERGB ( 60,179,113)},
1161 {"light sea green" , PALETTERGB ( 32,178,170)},
1162 {"LightSeaGreen" , PALETTERGB ( 32,178,170)},
1163 {"pale green" , PALETTERGB (152,251,152)},
1164 {"PaleGreen" , PALETTERGB (152,251,152)},
1165 {"spring green" , PALETTERGB ( 0,255,127)},
1166 {"SpringGreen" , PALETTERGB ( 0,255,127)},
1167 {"lawn green" , PALETTERGB (124,252, 0)},
1168 {"LawnGreen" , PALETTERGB (124,252, 0)},
1169 {"green" , PALETTERGB ( 0,255, 0)},
1170 {"chartreuse" , PALETTERGB (127,255, 0)},
1171 {"medium spring green" , PALETTERGB ( 0,250,154)},
1172 {"MediumSpringGreen" , PALETTERGB ( 0,250,154)},
1173 {"green yellow" , PALETTERGB (173,255, 47)},
1174 {"GreenYellow" , PALETTERGB (173,255, 47)},
1175 {"lime green" , PALETTERGB ( 50,205, 50)},
1176 {"LimeGreen" , PALETTERGB ( 50,205, 50)},
1177 {"yellow green" , PALETTERGB (154,205, 50)},
1178 {"YellowGreen" , PALETTERGB (154,205, 50)},
1179 {"forest green" , PALETTERGB ( 34,139, 34)},
1180 {"ForestGreen" , PALETTERGB ( 34,139, 34)},
1181 {"olive drab" , PALETTERGB (107,142, 35)},
1182 {"OliveDrab" , PALETTERGB (107,142, 35)},
1183 {"dark khaki" , PALETTERGB (189,183,107)},
1184 {"DarkKhaki" , PALETTERGB (189,183,107)},
1185 {"khaki" , PALETTERGB (240,230,140)},
1186 {"pale goldenrod" , PALETTERGB (238,232,170)},
1187 {"PaleGoldenrod" , PALETTERGB (238,232,170)},
1188 {"light goldenrod yellow" , PALETTERGB (250,250,210)},
1189 {"LightGoldenrodYellow" , PALETTERGB (250,250,210)},
1190 {"light yellow" , PALETTERGB (255,255,224)},
1191 {"LightYellow" , PALETTERGB (255,255,224)},
1192 {"yellow" , PALETTERGB (255,255, 0)},
1193 {"gold" , PALETTERGB (255,215, 0)},
1194 {"light goldenrod" , PALETTERGB (238,221,130)},
1195 {"LightGoldenrod" , PALETTERGB (238,221,130)},
1196 {"goldenrod" , PALETTERGB (218,165, 32)},
1197 {"dark goldenrod" , PALETTERGB (184,134, 11)},
1198 {"DarkGoldenrod" , PALETTERGB (184,134, 11)},
1199 {"rosy brown" , PALETTERGB (188,143,143)},
1200 {"RosyBrown" , PALETTERGB (188,143,143)},
1201 {"indian red" , PALETTERGB (205, 92, 92)},
1202 {"IndianRed" , PALETTERGB (205, 92, 92)},
1203 {"saddle brown" , PALETTERGB (139, 69, 19)},
1204 {"SaddleBrown" , PALETTERGB (139, 69, 19)},
1205 {"sienna" , PALETTERGB (160, 82, 45)},
1206 {"peru" , PALETTERGB (205,133, 63)},
1207 {"burlywood" , PALETTERGB (222,184,135)},
1208 {"beige" , PALETTERGB (245,245,220)},
1209 {"wheat" , PALETTERGB (245,222,179)},
1210 {"sandy brown" , PALETTERGB (244,164, 96)},
1211 {"SandyBrown" , PALETTERGB (244,164, 96)},
1212 {"tan" , PALETTERGB (210,180,140)},
1213 {"chocolate" , PALETTERGB (210,105, 30)},
1214 {"firebrick" , PALETTERGB (178,34, 34)},
1215 {"brown" , PALETTERGB (165,42, 42)},
1216 {"dark salmon" , PALETTERGB (233,150,122)},
1217 {"DarkSalmon" , PALETTERGB (233,150,122)},
1218 {"salmon" , PALETTERGB (250,128,114)},
1219 {"light salmon" , PALETTERGB (255,160,122)},
1220 {"LightSalmon" , PALETTERGB (255,160,122)},
1221 {"orange" , PALETTERGB (255,165, 0)},
1222 {"dark orange" , PALETTERGB (255,140, 0)},
1223 {"DarkOrange" , PALETTERGB (255,140, 0)},
1224 {"coral" , PALETTERGB (255,127, 80)},
1225 {"light coral" , PALETTERGB (240,128,128)},
1226 {"LightCoral" , PALETTERGB (240,128,128)},
1227 {"tomato" , PALETTERGB (255, 99, 71)},
1228 {"orange red" , PALETTERGB (255, 69, 0)},
1229 {"OrangeRed" , PALETTERGB (255, 69, 0)},
1230 {"red" , PALETTERGB (255, 0, 0)},
1231 {"hot pink" , PALETTERGB (255,105,180)},
1232 {"HotPink" , PALETTERGB (255,105,180)},
1233 {"deep pink" , PALETTERGB (255, 20,147)},
1234 {"DeepPink" , PALETTERGB (255, 20,147)},
1235 {"pink" , PALETTERGB (255,192,203)},
1236 {"light pink" , PALETTERGB (255,182,193)},
1237 {"LightPink" , PALETTERGB (255,182,193)},
1238 {"pale violet red" , PALETTERGB (219,112,147)},
1239 {"PaleVioletRed" , PALETTERGB (219,112,147)},
1240 {"maroon" , PALETTERGB (176, 48, 96)},
1241 {"medium violet red" , PALETTERGB (199, 21,133)},
1242 {"MediumVioletRed" , PALETTERGB (199, 21,133)},
1243 {"violet red" , PALETTERGB (208, 32,144)},
1244 {"VioletRed" , PALETTERGB (208, 32,144)},
1245 {"magenta" , PALETTERGB (255, 0,255)},
1246 {"violet" , PALETTERGB (238,130,238)},
1247 {"plum" , PALETTERGB (221,160,221)},
1248 {"orchid" , PALETTERGB (218,112,214)},
1249 {"medium orchid" , PALETTERGB (186, 85,211)},
1250 {"MediumOrchid" , PALETTERGB (186, 85,211)},
1251 {"dark orchid" , PALETTERGB (153, 50,204)},
1252 {"DarkOrchid" , PALETTERGB (153, 50,204)},
1253 {"dark violet" , PALETTERGB (148, 0,211)},
1254 {"DarkViolet" , PALETTERGB (148, 0,211)},
1255 {"blue violet" , PALETTERGB (138, 43,226)},
1256 {"BlueViolet" , PALETTERGB (138, 43,226)},
1257 {"purple" , PALETTERGB (160, 32,240)},
1258 {"medium purple" , PALETTERGB (147,112,219)},
1259 {"MediumPurple" , PALETTERGB (147,112,219)},
1260 {"thistle" , PALETTERGB (216,191,216)},
1261 {"gray0" , PALETTERGB ( 0, 0, 0)},
1262 {"grey0" , PALETTERGB ( 0, 0, 0)},
1263 {"dark grey" , PALETTERGB (169,169,169)},
1264 {"DarkGrey" , PALETTERGB (169,169,169)},
1265 {"dark gray" , PALETTERGB (169,169,169)},
1266 {"DarkGray" , PALETTERGB (169,169,169)},
1267 {"dark blue" , PALETTERGB ( 0, 0,139)},
1268 {"DarkBlue" , PALETTERGB ( 0, 0,139)},
1269 {"dark cyan" , PALETTERGB ( 0,139,139)},
1270 {"DarkCyan" , PALETTERGB ( 0,139,139)},
1271 {"dark magenta" , PALETTERGB (139, 0,139)},
1272 {"DarkMagenta" , PALETTERGB (139, 0,139)},
1273 {"dark red" , PALETTERGB (139, 0, 0)},
1274 {"DarkRed" , PALETTERGB (139, 0, 0)},
1275 {"light green" , PALETTERGB (144,238,144)},
1276 {"LightGreen" , PALETTERGB (144,238,144)},
ee78dc32
GV		 1277};
1278
fbd6baed 1279DEFUN ("w32-default-color-map", Fw32_default_color_map, Sw32_default_color_map,
ee78dc32
GV		 1280 0, 0, 0, "Return the default color map.")
1281 ()
1282{
1283 int i;
fbd6baed 1284 colormap_t *pc = w32_color_map;
ee78dc32
GV		 1285 Lisp_Object cmap;
1286
1287 BLOCK_INPUT;
1288
1289 cmap = Qnil;
1290
fbd6baed 1291 for (i = 0; i < sizeof (w32_color_map) / sizeof (w32_color_map[0]);
ee78dc32
GV		 1292 pc++, i++)
1293 cmap = Fcons (Fcons (build_string (pc->name),
1294 make_number (pc->colorref)),
1295 cmap);
1296
1297 UNBLOCK_INPUT;
1298
1299 return (cmap);
1300}
ee78dc32
GV		 1301
1302Lisp_Object
fbd6baed 1303w32_to_x_color (rgb)
ee78dc32
GV		 1304 Lisp_Object rgb;
1305{
1306 Lisp_Object color;
1307
1308 CHECK_NUMBER (rgb, 0);
1309
1310 BLOCK_INPUT;
1311
fbd6baed 1312 color = Frassq (rgb, Vw32_color_map);
ee78dc32
GV		 1313
1314 UNBLOCK_INPUT;
1315
1316 if (!NILP (color))
1317 return (Fcar (color));
1318 else
1319 return Qnil;
1320}
1321
5d7fed93
GV		 1322COLORREF
1323w32_color_map_lookup (colorname)
1324 char *colorname;
1325{
1326 Lisp_Object tail, ret = Qnil;
1327
1328 BLOCK_INPUT;
1329
1330 for (tail = Vw32_color_map; !NILP (tail); tail = Fcdr (tail))
1331 {
1332 register Lisp_Object elt, tem;
1333
1334 elt = Fcar (tail);
1335 if (!CONSP (elt)) continue;
1336
1337 tem = Fcar (elt);
1338
1339 if (lstrcmpi (XSTRING (tem)->data, colorname) == 0)
1340 {
1341 ret = XUINT (Fcdr (elt));
1342 break;
1343 }
1344
1345 QUIT;
1346 }
1347
1348
1349 UNBLOCK_INPUT;
1350
1351 return ret;
1352}
1353
ee78dc32 1354COLORREF
fbd6baed 1355x_to_w32_color (colorname)
ee78dc32
GV		 1356 char * colorname;
1357{
1358 register Lisp_Object tail, ret = Qnil;
1359
1360 BLOCK_INPUT;
1edf84e7
GV		 1361
1362 if (colorname[0] == '#')
1363 {
1364 /* Could be an old-style RGB Device specification. */
1365 char *color;
1366 int size;
1367 color = colorname + 1;
1368
1369 size = strlen(color);
1370 if (size == 3 || size == 6 || size == 9 || size == 12)
1371 {
1372 UINT colorval;
1373 int i, pos;
1374 pos = 0;
1375 size /= 3;
1376 colorval = 0;
1377
1378 for (i = 0; i < 3; i++)
1379 {
1380 char *end;
1381 char t;
1382 unsigned long value;
1383
1384 /* The check for 'x' in the following conditional takes into
1385 account the fact that strtol allows a "0x" in front of
1386 our numbers, and we don't. */
1387 if (!isxdigit(color[0]) || color[1] == 'x')
1388 break;
1389 t = color[size];
1390 color[size] = '\0';
1391 value = strtoul(color, &end, 16);
1392 color[size] = t;
1393 if (errno == ERANGE || end - color != size)
1394 break;
1395 switch (size)
1396 {
1397 case 1:
1398 value = value * 0x10;
1399 break;
1400 case 2:
1401 break;
1402 case 3:
1403 value /= 0x10;
1404 break;
1405 case 4:
1406 value /= 0x100;
1407 break;
1408 }
1409 colorval |= (value << pos);
1410 pos += 0x8;
1411 if (i == 2)
1412 {
1413 UNBLOCK_INPUT;
1414 return (colorval);
1415 }
1416 color = end;
1417 }
1418 }
1419 }
1420 else if (strnicmp(colorname, "rgb:", 4) == 0)
1421 {
1422 char *color;
1423 UINT colorval;
1424 int i, pos;
1425 pos = 0;
1426
1427 colorval = 0;
1428 color = colorname + 4;
1429 for (i = 0; i < 3; i++)
1430 {
1431 char *end;
1432 unsigned long value;
1433
1434 /* The check for 'x' in the following conditional takes into
1435 account the fact that strtol allows a "0x" in front of
1436 our numbers, and we don't. */
1437 if (!isxdigit(color[0]) || color[1] == 'x')
1438 break;
1439 value = strtoul(color, &end, 16);
1440 if (errno == ERANGE)
1441 break;
1442 switch (end - color)
1443 {
1444 case 1:
1445 value = value * 0x10 + value;
1446 break;
1447 case 2:
1448 break;
1449 case 3:
1450 value /= 0x10;
1451 break;
1452 case 4:
1453 value /= 0x100;
1454 break;
1455 default:
1456 value = ULONG_MAX;
1457 }
1458 if (value == ULONG_MAX)
1459 break;
1460 colorval |= (value << pos);
1461 pos += 0x8;
1462 if (i == 2)
1463 {
1464 if (*end != '\0')
1465 break;
1466 UNBLOCK_INPUT;
1467 return (colorval);
1468 }
1469 if (*end != '/')
1470 break;
1471 color = end + 1;
1472 }
1473 }
1474 else if (strnicmp(colorname, "rgbi:", 5) == 0)
1475 {
1476 /* This is an RGB Intensity specification. */
1477 char *color;
1478 UINT colorval;
1479 int i, pos;
1480 pos = 0;
1481
1482 colorval = 0;
1483 color = colorname + 5;
1484 for (i = 0; i < 3; i++)
1485 {
1486 char *end;
1487 double value;
1488 UINT val;
1489
1490 value = strtod(color, &end);
1491 if (errno == ERANGE)
1492 break;
1493 if (value < 0.0 || value > 1.0)
1494 break;
1495 val = (UINT)(0x100 * value);
1496 /* We used 0x100 instead of 0xFF to give an continuous
1497 range between 0.0 and 1.0 inclusive. The next statement
1498 fixes the 1.0 case. */
1499 if (val == 0x100)
1500 val = 0xFF;
1501 colorval |= (val << pos);
1502 pos += 0x8;
1503 if (i == 2)
1504 {
1505 if (*end != '\0')
1506 break;
1507 UNBLOCK_INPUT;
1508 return (colorval);
1509 }
1510 if (*end != '/')
1511 break;
1512 color = end + 1;
1513 }
1514 }
1515 /* I am not going to attempt to handle any of the CIE color schemes
1516 or TekHVC, since I don't know the algorithms for conversion to
1517 RGB. */
f695b4b1
GV		 1518
1519 /* If we fail to lookup the color name in w32_color_map, then check the
1520 colorname to see if it can be crudely approximated: If the X color
1521 ends in a number (e.g., "darkseagreen2"), strip the number and
1522 return the result of looking up the base color name. */
1523 ret = w32_color_map_lookup (colorname);
1524 if (NILP (ret))
ee78dc32 1525 {
f695b4b1 1526 int len = strlen (colorname);
ee78dc32 1527
f695b4b1
GV		 1528 if (isdigit (colorname[len - 1]))
1529 {
1530 char *ptr, *approx = alloca (len);
ee78dc32 1531
f695b4b1
GV		 1532 strcpy (approx, colorname);
1533 ptr = &approx[len - 1];
1534 while (ptr > approx && isdigit (*ptr))
1535 *ptr-- = '\0';
ee78dc32 1536
f695b4b1 1537 ret = w32_color_map_lookup (approx);
ee78dc32 1538 }
ee78dc32
GV		 1539 }
1540
1541 UNBLOCK_INPUT;
ee78dc32
GV		 1542 return ret;
1543}
1544
5ac45f98
GV		 1545
1546void
fbd6baed 1547w32_regenerate_palette (FRAME_PTR f)
5ac45f98 1548{
fbd6baed 1549 struct w32_palette_entry * list;
5ac45f98
GV		 1550 LOGPALETTE * log_palette;
1551 HPALETTE new_palette;
1552 int i;
1553
1554 /* don't bother trying to create palette if not supported */
fbd6baed 1555 if (! FRAME_W32_DISPLAY_INFO (f)->has_palette)
5ac45f98
GV		 1556 return;
1557
1558 log_palette = (LOGPALETTE *)
1559 alloca (sizeof (LOGPALETTE) +
fbd6baed 1560 FRAME_W32_DISPLAY_INFO (f)->num_colors * sizeof (PALETTEENTRY));
5ac45f98 1561 log_palette->palVersion = 0x300;
fbd6baed 1562 log_palette->palNumEntries = FRAME_W32_DISPLAY_INFO (f)->num_colors;
5ac45f98 1563
fbd6baed 1564 list = FRAME_W32_DISPLAY_INFO (f)->color_list;
5ac45f98 1565 for (i = 0;
fbd6baed 1566 i < FRAME_W32_DISPLAY_INFO (f)->num_colors;
5ac45f98
GV		 1567 i++, list = list->next)
1568 log_palette->palPalEntry[i] = list->entry;
1569
1570 new_palette = CreatePalette (log_palette);
1571
1572 enter_crit ();
1573
fbd6baed
GV		 1574 if (FRAME_W32_DISPLAY_INFO (f)->palette)
1575 DeleteObject (FRAME_W32_DISPLAY_INFO (f)->palette);
1576 FRAME_W32_DISPLAY_INFO (f)->palette = new_palette;
5ac45f98
GV		 1577
1578 /* Realize display palette and garbage all frames. */
1579 release_frame_dc (f, get_frame_dc (f));
1580
1581 leave_crit ();
1582}
1583
fbd6baed
GV		 1584#define W32_COLOR(pe) RGB (pe.peRed, pe.peGreen, pe.peBlue)
1585#define SET_W32_COLOR(pe, color) \
5ac45f98
GV		 1586 do \
1587 { \
1588 pe.peRed = GetRValue (color); \
1589 pe.peGreen = GetGValue (color); \
1590 pe.peBlue = GetBValue (color); \
1591 pe.peFlags = 0; \
1592 } while (0)
1593
1594#if 0
1595/* Keep these around in case we ever want to track color usage. */
1596void
fbd6baed 1597w32_map_color (FRAME_PTR f, COLORREF color)
5ac45f98 1598{
fbd6baed 1599 struct w32_palette_entry * list = FRAME_W32_DISPLAY_INFO (f)->color_list;
5ac45f98 1600
fbd6baed 1601 if (NILP (Vw32_enable_palette))
5ac45f98
GV		 1602 return;
1603
1604 /* check if color is already mapped */
1605 while (list)
1606 {
fbd6baed 1607 if (W32_COLOR (list->entry) == color)
5ac45f98
GV		 1608 {
1609 ++list->refcount;
1610 return;
1611 }
1612 list = list->next;
1613 }
1614
1615 /* not already mapped, so add to list and recreate Windows palette */
fbd6baed
GV		 1616 list = (struct w32_palette_entry *)
1617 xmalloc (sizeof (struct w32_palette_entry));
1618 SET_W32_COLOR (list->entry, color);
5ac45f98 1619 list->refcount = 1;
fbd6baed
GV		 1620 list->next = FRAME_W32_DISPLAY_INFO (f)->color_list;
1621 FRAME_W32_DISPLAY_INFO (f)->color_list = list;
1622 FRAME_W32_DISPLAY_INFO (f)->num_colors++;
5ac45f98
GV		 1623
1624 /* set flag that palette must be regenerated */
fbd6baed 1625 FRAME_W32_DISPLAY_INFO (f)->regen_palette = TRUE;
5ac45f98
GV		 1626}
1627
1628void
fbd6baed 1629w32_unmap_color (FRAME_PTR f, COLORREF color)
5ac45f98 1630{
fbd6baed
GV		 1631 struct w32_palette_entry * list = FRAME_W32_DISPLAY_INFO (f)->color_list;
1632 struct w32_palette_entry **prev = &FRAME_W32_DISPLAY_INFO (f)->color_list;
5ac45f98 1633
fbd6baed 1634 if (NILP (Vw32_enable_palette))
5ac45f98
GV		 1635 return;
1636
1637 /* check if color is already mapped */
1638 while (list)
1639 {
fbd6baed 1640 if (W32_COLOR (list->entry) == color)
5ac45f98
GV		 1641 {
1642 if (--list->refcount == 0)
1643 {
1644 *prev = list->next;
1645 xfree (list);
fbd6baed 1646 FRAME_W32_DISPLAY_INFO (f)->num_colors--;
5ac45f98
GV		 1647 break;
1648 }
1649 else
1650 return;
1651 }
1652 prev = &list->next;
1653 list = list->next;
1654 }
1655
1656 /* set flag that palette must be regenerated */
fbd6baed 1657 FRAME_W32_DISPLAY_INFO (f)->regen_palette = TRUE;
5ac45f98
GV		 1658}
1659#endif
1660
ee78dc32
GV		 1661/* Decide if color named COLOR is valid for the display associated with
1662 the selected frame; if so, return the rgb values in COLOR_DEF.
1663 If ALLOC is nonzero, allocate a new colormap cell. */
1664
1665int
1666defined_color (f, color, color_def, alloc)
1667 FRAME_PTR f;
1668 char *color;
1669 COLORREF *color_def;
1670 int alloc;
1671{
1672 register Lisp_Object tem;
3c190163 1673
fbd6baed 1674 tem = x_to_w32_color (color);
3c190163 1675
ee78dc32
GV		 1676 if (!NILP (tem))
1677 {
fbd6baed 1678 if (!NILP (Vw32_enable_palette))
5ac45f98 1679 {
fbd6baed
GV		 1680 struct w32_palette_entry * entry =
1681 FRAME_W32_DISPLAY_INFO (f)->color_list;
1682 struct w32_palette_entry ** prev =
1683 &FRAME_W32_DISPLAY_INFO (f)->color_list;
5ac45f98
GV		 1684
1685 /* check if color is already mapped */
1686 while (entry)
1687 {
fbd6baed 1688 if (W32_COLOR (entry->entry) == XUINT (tem))
5ac45f98
GV		 1689 break;
1690 prev = &entry->next;
1691 entry = entry->next;
1692 }
1693
1694 if (entry == NULL && alloc)
1695 {
1696 /* not already mapped, so add to list */
fbd6baed
GV		 1697 entry = (struct w32_palette_entry *)
1698 xmalloc (sizeof (struct w32_palette_entry));
1699 SET_W32_COLOR (entry->entry, XUINT (tem));
5ac45f98
GV		 1700 entry->next = NULL;
1701 *prev = entry;
fbd6baed 1702 FRAME_W32_DISPLAY_INFO (f)->num_colors++;
5ac45f98
GV		 1703
1704 /* set flag that palette must be regenerated */
fbd6baed 1705 FRAME_W32_DISPLAY_INFO (f)->regen_palette = TRUE;
5ac45f98
GV		 1706 }
1707 }
1708 /* Ensure COLORREF value is snapped to nearest color in (default)
1709 palette by simulating the PALETTERGB macro. This works whether
1710 or not the display device has a palette. */
8847d890 1711 *color_def = XUINT (tem) | 0x2000000;
ee78dc32 1712 return 1;
5ac45f98 1713 }
7fb46567 1714 else
3c190163
GV		 1715 {
1716 return 0;
1717 }
ee78dc32
GV		 1718}
1719
1720/* Given a string ARG naming a color, compute a pixel value from it
1721 suitable for screen F.
1722 If F is not a color screen, return DEF (default) regardless of what
1723 ARG says. */
1724
1725int
1726x_decode_color (f, arg, def)
1727 FRAME_PTR f;
1728 Lisp_Object arg;
1729 int def;
1730{
1731 COLORREF cdef;
1732
1733 CHECK_STRING (arg, 0);
1734
1735 if (strcmp (XSTRING (arg)->data, "black") == 0)
1736 return BLACK_PIX_DEFAULT (f);
1737 else if (strcmp (XSTRING (arg)->data, "white") == 0)
1738 return WHITE_PIX_DEFAULT (f);
1739
fbd6baed 1740 if ((FRAME_W32_DISPLAY_INFO (f)->n_planes * FRAME_W32_DISPLAY_INFO (f)->n_cbits) == 1)
ee78dc32
GV		 1741 return def;
1742
1743 /* defined_color is responsible for coping with failures
1744 by looking for a near-miss. */
1745 if (defined_color (f, XSTRING (arg)->data, &cdef, 1))
1746 return cdef;
1747
1748 /* defined_color failed; return an ultimate default. */
1749 return def;
1750}
1751\f
1752/* Functions called only from `x_set_frame_param'
1753 to set individual parameters.
1754
fbd6baed 1755 If FRAME_W32_WINDOW (f) is 0,
ee78dc32
GV		 1756 the frame is being created and its window does not exist yet.
1757 In that case, just record the parameter's new value
1758 in the standard place; do not attempt to change the window. */
1759
1760void
1761x_set_foreground_color (f, arg, oldval)
1762 struct frame *f;
1763 Lisp_Object arg, oldval;
1764{
fbd6baed 1765 f->output_data.w32->foreground_pixel
ee78dc32 1766 = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
5ac45f98 1767
fbd6baed 1768 if (FRAME_W32_WINDOW (f) != 0)
ee78dc32
GV		 1769 {
1770 recompute_basic_faces (f);
1771 if (FRAME_VISIBLE_P (f))
1772 redraw_frame (f);
1773 }
1774}
1775
1776void
1777x_set_background_color (f, arg, oldval)
1778 struct frame *f;
1779 Lisp_Object arg, oldval;
1780{
1781 Pixmap temp;
1782 int mask;
1783
fbd6baed 1784 f->output_data.w32->background_pixel
ee78dc32
GV		 1785 = x_decode_color (f, arg, WHITE_PIX_DEFAULT (f));
1786
fbd6baed 1787 if (FRAME_W32_WINDOW (f) != 0)
ee78dc32 1788 {
fbd6baed 1789 SetWindowLong (FRAME_W32_WINDOW (f), WND_BACKGROUND_INDEX, f->output_data.w32->background_pixel);
ee78dc32
GV		 1790
1791 recompute_basic_faces (f);
1792
1793 if (FRAME_VISIBLE_P (f))
1794 redraw_frame (f);
1795 }
1796}
1797
1798void
1799x_set_mouse_color (f, arg, oldval)
1800 struct frame *f;
1801 Lisp_Object arg, oldval;
1802{
1803#if 0
1804 Cursor cursor, nontext_cursor, mode_cursor, cross_cursor;
1805#endif
dfc465d3 1806 int count;
ee78dc32
GV		 1807 int mask_color;
1808
1809 if (!EQ (Qnil, arg))
fbd6baed 1810 f->output_data.w32->mouse_pixel
ee78dc32 1811 = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
fbd6baed 1812 mask_color = f->output_data.w32->background_pixel;
ee78dc32 1813 /* No invisible pointers. */
fbd6baed
GV		 1814 if (mask_color == f->output_data.w32->mouse_pixel
1815 && mask_color == f->output_data.w32->background_pixel)
1816 f->output_data.w32->mouse_pixel = f->output_data.w32->foreground_pixel;
ee78dc32
GV		 1817
1818#if 0
1819 BLOCK_INPUT;
1820
1821 /* It's not okay to crash if the user selects a screwy cursor. */
fadca6c6 1822 count = x_catch_errors (FRAME_W32_DISPLAY (f));
ee78dc32
GV		 1823
1824 if (!EQ (Qnil, Vx_pointer_shape))
1825 {
1826 CHECK_NUMBER (Vx_pointer_shape, 0);
fbd6baed 1827 cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XINT (Vx_pointer_shape));
ee78dc32
GV		 1828 }
1829 else
fbd6baed
GV		 1830 cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_xterm);
1831 x_check_errors (FRAME_W32_DISPLAY (f), "bad text pointer cursor: %s");
ee78dc32
GV		 1832
1833 if (!EQ (Qnil, Vx_nontext_pointer_shape))
1834 {
1835 CHECK_NUMBER (Vx_nontext_pointer_shape, 0);
fbd6baed 1836 nontext_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f),
ee78dc32
GV		 1837 XINT (Vx_nontext_pointer_shape));
1838 }
1839 else
fbd6baed
GV		 1840 nontext_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_left_ptr);
1841 x_check_errors (FRAME_W32_DISPLAY (f), "bad nontext pointer cursor: %s");
ee78dc32
GV		 1842
1843 if (!EQ (Qnil, Vx_mode_pointer_shape))
1844 {
1845 CHECK_NUMBER (Vx_mode_pointer_shape, 0);
fbd6baed 1846 mode_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f),
ee78dc32
GV		 1847 XINT (Vx_mode_pointer_shape));
1848 }
1849 else
fbd6baed
GV		 1850 mode_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_xterm);
1851 x_check_errors (FRAME_W32_DISPLAY (f), "bad modeline pointer cursor: %s");
ee78dc32
GV		 1852
1853 if (!EQ (Qnil, Vx_sensitive_text_pointer_shape))
1854 {
1855 CHECK_NUMBER (Vx_sensitive_text_pointer_shape, 0);
1856 cross_cursor
fbd6baed 1857 = XCreateFontCursor (FRAME_W32_DISPLAY (f),
ee78dc32
GV		 1858 XINT (Vx_sensitive_text_pointer_shape));
1859 }
1860 else
fbd6baed 1861 cross_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_crosshair);
ee78dc32
GV		 1862
1863 /* Check and report errors with the above calls. */
fbd6baed 1864 x_check_errors (FRAME_W32_DISPLAY (f), "can't set cursor shape: %s");
fadca6c6 1865 x_uncatch_errors (FRAME_W32_DISPLAY (f), count);
ee78dc32
GV		 1866
1867 {
1868 XColor fore_color, back_color;
1869
fbd6baed 1870 fore_color.pixel = f->output_data.w32->mouse_pixel;
ee78dc32 1871 back_color.pixel = mask_color;
fbd6baed
GV		 1872 XQueryColor (FRAME_W32_DISPLAY (f),
1873 DefaultColormap (FRAME_W32_DISPLAY (f),
1874 DefaultScreen (FRAME_W32_DISPLAY (f))),
ee78dc32 1875 &fore_color);
fbd6baed
GV		 1876 XQueryColor (FRAME_W32_DISPLAY (f),
1877 DefaultColormap (FRAME_W32_DISPLAY (f),
1878 DefaultScreen (FRAME_W32_DISPLAY (f))),
ee78dc32 1879 &back_color);
fbd6baed 1880 XRecolorCursor (FRAME_W32_DISPLAY (f), cursor,
ee78dc32 1881 &fore_color, &back_color);
fbd6baed 1882 XRecolorCursor (FRAME_W32_DISPLAY (f), nontext_cursor,
ee78dc32 1883 &fore_color, &back_color);
fbd6baed 1884 XRecolorCursor (FRAME_W32_DISPLAY (f), mode_cursor,
ee78dc32 1885 &fore_color, &back_color);
fbd6baed 1886 XRecolorCursor (FRAME_W32_DISPLAY (f), cross_cursor,
ee78dc32
GV		 1887 &fore_color, &back_color);
1888 }
1889
fbd6baed 1890 if (FRAME_W32_WINDOW (f) != 0)
ee78dc32 1891 {
fbd6baed 1892 XDefineCursor (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f), cursor);
ee78dc32
GV		 1893 }
1894
fbd6baed
GV		 1895 if (cursor != f->output_data.w32->text_cursor && f->output_data.w32->text_cursor != 0)
1896 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->text_cursor);
1897 f->output_data.w32->text_cursor = cursor;
1898
1899 if (nontext_cursor != f->output_data.w32->nontext_cursor
1900 && f->output_data.w32->nontext_cursor != 0)
1901 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->nontext_cursor);
1902 f->output_data.w32->nontext_cursor = nontext_cursor;
1903
1904 if (mode_cursor != f->output_data.w32->modeline_cursor
1905 && f->output_data.w32->modeline_cursor != 0)
1906 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->modeline_cursor);
1907 f->output_data.w32->modeline_cursor = mode_cursor;
1908 if (cross_cursor != f->output_data.w32->cross_cursor
1909 && f->output_data.w32->cross_cursor != 0)
1910 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->cross_cursor);
1911 f->output_data.w32->cross_cursor = cross_cursor;
1912
1913 XFlush (FRAME_W32_DISPLAY (f));
ee78dc32
GV		 1914 UNBLOCK_INPUT;
1915#endif
1916}
1917
1918void
1919x_set_cursor_color (f, arg, oldval)
1920 struct frame *f;
1921 Lisp_Object arg, oldval;
1922{
1923 unsigned long fore_pixel;
1924
1925 if (!EQ (Vx_cursor_fore_pixel, Qnil))
1926 fore_pixel = x_decode_color (f, Vx_cursor_fore_pixel,
1927 WHITE_PIX_DEFAULT (f));
1928 else
fbd6baed
GV		 1929 fore_pixel = f->output_data.w32->background_pixel;
1930 f->output_data.w32->cursor_pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
ee78dc32
GV		 1931
1932 /* Make sure that the cursor color differs from the background color. */
fbd6baed 1933 if (f->output_data.w32->cursor_pixel == f->output_data.w32->background_pixel)
ee78dc32 1934 {
fbd6baed
GV		 1935 f->output_data.w32->cursor_pixel = f->output_data.w32->mouse_pixel;
1936 if (f->output_data.w32->cursor_pixel == fore_pixel)
1937 fore_pixel = f->output_data.w32->background_pixel;
ee78dc32 1938 }
fbd6baed 1939 f->output_data.w32->cursor_foreground_pixel = fore_pixel;
ee78dc32 1940
fbd6baed 1941 if (FRAME_W32_WINDOW (f) != 0)
ee78dc32
GV		 1942 {
1943 if (FRAME_VISIBLE_P (f))
1944 {
1945 x_display_cursor (f, 0);
1946 x_display_cursor (f, 1);
1947 }
1948 }
1949}
1950
1951/* Set the border-color of frame F to value described by ARG.
1952 ARG can be a string naming a color.
1953 The border-color is used for the border that is drawn by the server.
1954 Note that this does not fully take effect if done before
1955 F has a window; it must be redone when the window is created. */
1956
1957void
1958x_set_border_color (f, arg, oldval)
1959 struct frame *f;
1960 Lisp_Object arg, oldval;
1961{
1962 unsigned char *str;
1963 int pix;
1964
1965 CHECK_STRING (arg, 0);
1966 str = XSTRING (arg)->data;
1967
1968 pix = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1969
1970 x_set_border_pixel (f, pix);
1971}
1972
1973/* Set the border-color of frame F to pixel value PIX.
1974 Note that this does not fully take effect if done before
1975 F has an window. */
1976
1977x_set_border_pixel (f, pix)
1978 struct frame *f;
1979 int pix;
1980{
fbd6baed 1981 f->output_data.w32->border_pixel = pix;
ee78dc32 1982
fbd6baed 1983 if (FRAME_W32_WINDOW (f) != 0 && f->output_data.w32->border_width > 0)
ee78dc32
GV		 1984 {
1985 if (FRAME_VISIBLE_P (f))
1986 redraw_frame (f);
1987 }
1988}
1989
1990void
1991x_set_cursor_type (f, arg, oldval)
1992 FRAME_PTR f;
1993 Lisp_Object arg, oldval;
1994{
1995 if (EQ (arg, Qbar))
1996 {
1997 FRAME_DESIRED_CURSOR (f) = bar_cursor;
fbd6baed 1998 f->output_data.w32->cursor_width = 2;
ee78dc32
GV		 1999 }
2000 else if (CONSP (arg) && EQ (XCONS (arg)->car, Qbar)
2001 && INTEGERP (XCONS (arg)->cdr))
2002 {
2003 FRAME_DESIRED_CURSOR (f) = bar_cursor;
fbd6baed 2004 f->output_data.w32->cursor_width = XINT (XCONS (arg)->cdr);
ee78dc32
GV		 2005 }
2006 else
2007 /* Treat anything unknown as "box cursor".
2008 It was bad to signal an error; people have trouble fixing
2009 .Xdefaults with Emacs, when it has something bad in it. */
2010 FRAME_DESIRED_CURSOR (f) = filled_box_cursor;
2011
2012 /* Make sure the cursor gets redrawn. This is overkill, but how
2013 often do people change cursor types? */
2014 update_mode_lines++;
2015}
2016
2017void
2018x_set_icon_type (f, arg, oldval)
2019 struct frame *f;
2020 Lisp_Object arg, oldval;
2021{
2022#if 0
2023 Lisp_Object tem;
2024 int result;
2025
2026 if (STRINGP (arg))
2027 {
2028 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
2029 return;
2030 }
2031 else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
2032 return;
2033
2034 BLOCK_INPUT;
2035 if (NILP (arg))
2036 result = x_text_icon (f,
2037 (char *) XSTRING ((!NILP (f->icon_name)
2038 ? f->icon_name
2039 : f->name))->data);
2040 else
2041 result = x_bitmap_icon (f, arg);
2042
2043 if (result)
2044 {
2045 UNBLOCK_INPUT;
2046 error ("No icon window available");
2047 }
2048
2049 /* If the window was unmapped (and its icon was mapped),
2050 the new icon is not mapped, so map the window in its stead. */
2051 if (FRAME_VISIBLE_P (f))
2052 {
2053#ifdef USE_X_TOOLKIT
fbd6baed 2054 XtPopup (f->output_data.w32->widget, XtGrabNone);
ee78dc32 2055#endif
fbd6baed 2056 XMapWindow (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f));
ee78dc32
GV		 2057 }
2058
fbd6baed 2059 XFlush (FRAME_W32_DISPLAY (f));
ee78dc32
GV		 2060 UNBLOCK_INPUT;
2061#endif
2062}
2063
2064/* Return non-nil if frame F wants a bitmap icon. */
2065
2066Lisp_Object
2067x_icon_type (f)
2068 FRAME_PTR f;
2069{
2070 Lisp_Object tem;
2071
2072 tem = assq_no_quit (Qicon_type, f->param_alist);
2073 if (CONSP (tem))
2074 return XCONS (tem)->cdr;
2075 else
2076 return Qnil;
2077}
2078
2079void
2080x_set_icon_name (f, arg, oldval)
2081 struct frame *f;
2082 Lisp_Object arg, oldval;
2083{
2084 Lisp_Object tem;
2085 int result;
2086
2087 if (STRINGP (arg))
2088 {
2089 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
2090 return;
2091 }
2092 else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
2093 return;
2094
2095 f->icon_name = arg;
2096
2097#if 0
fbd6baed 2098 if (f->output_data.w32->icon_bitmap != 0)
ee78dc32
GV		 2099 return;
2100
2101 BLOCK_INPUT;
2102
2103 result = x_text_icon (f,
1edf84e7 2104 (char *) XSTRING ((!NILP (f->icon_name)
ee78dc32 2105 ? f->icon_name
1edf84e7
GV		 2106 : !NILP (f->title)
2107 ? f->title
ee78dc32
GV		 2108 : f->name))->data);
2109
2110 if (result)
2111 {
2112 UNBLOCK_INPUT;
2113 error ("No icon window available");
2114 }
2115
2116 /* If the window was unmapped (and its icon was mapped),
2117 the new icon is not mapped, so map the window in its stead. */
2118 if (FRAME_VISIBLE_P (f))
2119 {
2120#ifdef USE_X_TOOLKIT
fbd6baed 2121 XtPopup (f->output_data.w32->widget, XtGrabNone);
ee78dc32 2122#endif
fbd6baed 2123 XMapWindow (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f));
ee78dc32
GV		 2124 }
2125
fbd6baed 2126 XFlush (FRAME_W32_DISPLAY (f));
ee78dc32
GV		 2127 UNBLOCK_INPUT;
2128#endif
2129}
2130
2131extern Lisp_Object x_new_font ();
4587b026 2132extern Lisp_Object x_new_fontset();
ee78dc32
GV		 2133
2134void
2135x_set_font (f, arg, oldval)
2136 struct frame *f;
2137 Lisp_Object arg, oldval;
2138{
2139 Lisp_Object result;
4587b026 2140 Lisp_Object fontset_name;
4b817373 2141 Lisp_Object frame;
ee78dc32
GV		 2142
2143 CHECK_STRING (arg, 1);
2144
4587b026
GV		 2145 fontset_name = Fquery_fontset (arg, Qnil);
2146
ee78dc32 2147 BLOCK_INPUT;
4587b026
GV		 2148 result = (STRINGP (fontset_name)
2149 ? x_new_fontset (f, XSTRING (fontset_name)->data)
2150 : x_new_font (f, XSTRING (arg)->data));
ee78dc32
GV		 2151 UNBLOCK_INPUT;
2152
2153 if (EQ (result, Qnil))
2154 error ("Font \"%s\" is not defined", XSTRING (arg)->data);
2155 else if (EQ (result, Qt))
2156 error ("the characters of the given font have varying widths");
2157 else if (STRINGP (result))
2158 {
2159 recompute_basic_faces (f);
2160 store_frame_param (f, Qfont, result);
2161 }
2162 else
2163 abort ();
4b817373
RS		 2164
2165 XSETFRAME (frame, f);
2166 call1 (Qface_set_after_frame_default, frame);
ee78dc32
GV		 2167}
2168
2169void
2170x_set_border_width (f, arg, oldval)
2171 struct frame *f;
2172 Lisp_Object arg, oldval;
2173{
2174 CHECK_NUMBER (arg, 0);
2175
fbd6baed 2176 if (XINT (arg) == f->output_data.w32->border_width)
ee78dc32
GV		 2177 return;
2178
fbd6baed 2179 if (FRAME_W32_WINDOW (f) != 0)
ee78dc32
GV		 2180 error ("Cannot change the border width of a window");
2181
fbd6baed 2182 f->output_data.w32->border_width = XINT (arg);
ee78dc32
GV		 2183}
2184
2185void
2186x_set_internal_border_width (f, arg, oldval)
2187 struct frame *f;
2188 Lisp_Object arg, oldval;
2189{
2190 int mask;
fbd6baed 2191 int old = f->output_data.w32->internal_border_width;
ee78dc32
GV		 2192
2193 CHECK_NUMBER (arg, 0);
fbd6baed
GV		 2194 f->output_data.w32->internal_border_width = XINT (arg);
2195 if (f->output_data.w32->internal_border_width < 0)
2196 f->output_data.w32->internal_border_width = 0;
ee78dc32 2197
fbd6baed 2198 if (f->output_data.w32->internal_border_width == old)
ee78dc32
GV		 2199 return;
2200
fbd6baed 2201 if (FRAME_W32_WINDOW (f) != 0)
ee78dc32
GV		 2202 {
2203 BLOCK_INPUT;
2204 x_set_window_size (f, 0, f->width, f->height);
2205 UNBLOCK_INPUT;
2206 SET_FRAME_GARBAGED (f);
2207 }
2208}
2209
2210void
2211x_set_visibility (f, value, oldval)
2212 struct frame *f;
2213 Lisp_Object value, oldval;
2214{
2215 Lisp_Object frame;
2216 XSETFRAME (frame, f);
2217
2218 if (NILP (value))
2219 Fmake_frame_invisible (frame, Qt);
2220 else if (EQ (value, Qicon))
2221 Ficonify_frame (frame);
2222 else
2223 Fmake_frame_visible (frame);
2224}
2225
2226void
2227x_set_menu_bar_lines (f, value, oldval)
2228 struct frame *f;
2229 Lisp_Object value, oldval;
2230{
2231 int nlines;
2232 int olines = FRAME_MENU_BAR_LINES (f);
2233
2234 /* Right now, menu bars don't work properly in minibuf-only frames;
2235 most of the commands try to apply themselves to the minibuffer
2236 frame itslef, and get an error because you can't switch buffers
2237 in or split the minibuffer window. */
2238 if (FRAME_MINIBUF_ONLY_P (f))
2239 return;
2240
2241 if (INTEGERP (value))
2242 nlines = XINT (value);
2243 else
2244 nlines = 0;
2245
2246 FRAME_MENU_BAR_LINES (f) = 0;
2247 if (nlines)
2248 FRAME_EXTERNAL_MENU_BAR (f) = 1;
2249 else
2250 {
2251 if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
2252 free_frame_menubar (f);
2253 FRAME_EXTERNAL_MENU_BAR (f) = 0;
1edf84e7
GV		 2254
2255 /* Adjust the frame size so that the client (text) dimensions
2256 remain the same. This depends on FRAME_EXTERNAL_MENU_BAR being
2257 set correctly. */
2258 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
ee78dc32
GV		 2259 }
2260}
2261
2262/* Change the name of frame F to NAME. If NAME is nil, set F's name to
fbd6baed 2263 w32_id_name.
ee78dc32
GV		 2264
2265 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2266 name; if NAME is a string, set F's name to NAME and set
2267 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2268
2269 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2270 suggesting a new name, which lisp code should override; if
2271 F->explicit_name is set, ignore the new name; otherwise, set it. */
2272
2273void
2274x_set_name (f, name, explicit)
2275 struct frame *f;
2276 Lisp_Object name;
2277 int explicit;
2278{
2279 /* Make sure that requests from lisp code override requests from
2280 Emacs redisplay code. */
2281 if (explicit)
2282 {
2283 /* If we're switching from explicit to implicit, we had better
2284 update the mode lines and thereby update the title. */
2285 if (f->explicit_name && NILP (name))
2286 update_mode_lines = 1;
2287
2288 f->explicit_name = ! NILP (name);
2289 }
2290 else if (f->explicit_name)
2291 return;
2292
fbd6baed 2293 /* If NAME is nil, set the name to the w32_id_name. */
ee78dc32
GV		 2294 if (NILP (name))
2295 {
2296 /* Check for no change needed in this very common case
2297 before we do any consing. */
fbd6baed 2298 if (!strcmp (FRAME_W32_DISPLAY_INFO (f)->w32_id_name,
ee78dc32
GV		 2299 XSTRING (f->name)->data))
2300 return;
fbd6baed 2301 name = build_string (FRAME_W32_DISPLAY_INFO (f)->w32_id_name);
ee78dc32
GV		 2302 }
2303 else
2304 CHECK_STRING (name, 0);
2305
2306 /* Don't change the name if it's already NAME. */
2307 if (! NILP (Fstring_equal (name, f->name)))
2308 return;
2309
1edf84e7
GV		 2310 f->name = name;
2311
2312 /* For setting the frame title, the title parameter should override
2313 the name parameter. */
2314 if (! NILP (f->title))
2315 name = f->title;
2316
fbd6baed 2317 if (FRAME_W32_WINDOW (f))
ee78dc32
GV		 2318 {
2319 BLOCK_INPUT;
fbd6baed 2320 SetWindowText(FRAME_W32_WINDOW (f), XSTRING (name)->data);
ee78dc32
GV		 2321 UNBLOCK_INPUT;
2322 }
ee78dc32
GV		 2323}
2324
2325/* This function should be called when the user's lisp code has
2326 specified a name for the frame; the name will override any set by the
2327 redisplay code. */
2328void
2329x_explicitly_set_name (f, arg, oldval)
2330 FRAME_PTR f;
2331 Lisp_Object arg, oldval;
2332{
2333 x_set_name (f, arg, 1);
2334}
2335
2336/* This function should be called by Emacs redisplay code to set the
2337 name; names set this way will never override names set by the user's
2338 lisp code. */
2339void
2340x_implicitly_set_name (f, arg, oldval)
2341 FRAME_PTR f;
2342 Lisp_Object arg, oldval;
2343{
2344 x_set_name (f, arg, 0);
2345}
1edf84e7
GV		 2346\f
2347/* Change the title of frame F to NAME.
2348 If NAME is nil, use the frame name as the title.
2349
2350 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2351 name; if NAME is a string, set F's name to NAME and set
2352 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2353
2354 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2355 suggesting a new name, which lisp code should override; if
2356 F->explicit_name is set, ignore the new name; otherwise, set it. */
ee78dc32 2357
1edf84e7
GV		 2358void
2359x_set_title (f, name)
2360 struct frame *f;
2361 Lisp_Object name;
2362{
2363 /* Don't change the title if it's already NAME. */
2364 if (EQ (name, f->title))
2365 return;
2366
2367 update_mode_lines = 1;
2368
2369 f->title = name;
2370
2371 if (NILP (name))
2372 name = f->name;
2373
2374 if (FRAME_W32_WINDOW (f))
2375 {
2376 BLOCK_INPUT;
2377 SetWindowText(FRAME_W32_WINDOW (f), XSTRING (name)->data);
2378 UNBLOCK_INPUT;
2379 }
2380}
2381\f
ee78dc32
GV		 2382void
2383x_set_autoraise (f, arg, oldval)
2384 struct frame *f;
2385 Lisp_Object arg, oldval;
2386{
2387 f->auto_raise = !EQ (Qnil, arg);
2388}
2389
2390void
2391x_set_autolower (f, arg, oldval)
2392 struct frame *f;
2393 Lisp_Object arg, oldval;
2394{
2395 f->auto_lower = !EQ (Qnil, arg);
2396}
2397
2398void
2399x_set_unsplittable (f, arg, oldval)
2400 struct frame *f;
2401 Lisp_Object arg, oldval;
2402{
2403 f->no_split = !NILP (arg);
2404}
2405
2406void
2407x_set_vertical_scroll_bars (f, arg, oldval)
2408 struct frame *f;
2409 Lisp_Object arg, oldval;
2410{
1026b400
RS		 2411 if ((EQ (arg, Qleft) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f))
2412 || (EQ (arg, Qright) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f))
2413 || (NILP (arg) && FRAME_HAS_VERTICAL_SCROLL_BARS (f))
2414 || (!NILP (arg) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f)))
ee78dc32 2415 {
1026b400
RS		 2416 FRAME_VERTICAL_SCROLL_BAR_TYPE (f) = NILP (arg) ?
2417 vertical_scroll_bar_none :
87996783
GV		 2418 /* Put scroll bars on the right by default, as is conventional
2419 on MS-Windows. */
2420 EQ (Qleft, arg)
2421 ? vertical_scroll_bar_left
2422 : vertical_scroll_bar_right;
ee78dc32
GV		 2423
2424 /* We set this parameter before creating the window for the
2425 frame, so we can get the geometry right from the start.
2426 However, if the window hasn't been created yet, we shouldn't
2427 call x_set_window_size. */
fbd6baed 2428 if (FRAME_W32_WINDOW (f))
ee78dc32
GV		 2429 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
2430 }
2431}
2432
2433void
2434x_set_scroll_bar_width (f, arg, oldval)
2435 struct frame *f;
2436 Lisp_Object arg, oldval;
2437{
2438 if (NILP (arg))
2439 {
2440 FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = 0;
2441 FRAME_SCROLL_BAR_COLS (f) = 2;
2442 }
2443 else if (INTEGERP (arg) && XINT (arg) > 0
2444 && XFASTINT (arg) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f))
2445 {
fbd6baed 2446 int wid = FONT_WIDTH (f->output_data.w32->font);
ee78dc32
GV		 2447 FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = XFASTINT (arg);
2448 FRAME_SCROLL_BAR_COLS (f) = (XFASTINT (arg) + wid-1) / wid;
fbd6baed 2449 if (FRAME_W32_WINDOW (f))
ee78dc32
GV		 2450 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
2451 }
2452}
2453\f
2454/* Subroutines of creating an frame. */
2455
2456/* Make sure that Vx_resource_name is set to a reasonable value.
2457 Fix it up, or set it to `emacs' if it is too hopeless. */
2458
2459static void
2460validate_x_resource_name ()
2461{
2462 int len;
2463 /* Number of valid characters in the resource name. */
2464 int good_count = 0;
2465 /* Number of invalid characters in the resource name. */
2466 int bad_count = 0;
2467 Lisp_Object new;
2468 int i;
2469
2470 if (STRINGP (Vx_resource_name))
2471 {
2472 unsigned char *p = XSTRING (Vx_resource_name)->data;
2473 int i;
2474
2475 len = XSTRING (Vx_resource_name)->size;
2476
2477 /* Only letters, digits, - and _ are valid in resource names.
2478 Count the valid characters and count the invalid ones. */
2479 for (i = 0; i < len; i++)
2480 {
2481 int c = p[i];
2482 if (! ((c >= 'a' && c <= 'z')
2483 || (c >= 'A' && c <= 'Z')
2484 || (c >= '0' && c <= '9')
2485 || c == '-' || c == '_'))
2486 bad_count++;
2487 else
2488 good_count++;
2489 }
2490 }
2491 else
2492 /* Not a string => completely invalid. */
2493 bad_count = 5, good_count = 0;
2494
2495 /* If name is valid already, return. */
2496 if (bad_count == 0)
2497 return;
2498
2499 /* If name is entirely invalid, or nearly so, use `emacs'. */
2500 if (good_count == 0
2501 || (good_count == 1 && bad_count > 0))
2502 {
2503 Vx_resource_name = build_string ("emacs");
2504 return;
2505 }
2506
2507 /* Name is partly valid. Copy it and replace the invalid characters
2508 with underscores. */
2509
2510 Vx_resource_name = new = Fcopy_sequence (Vx_resource_name);
2511
2512 for (i = 0; i < len; i++)
2513 {
2514 int c = XSTRING (new)->data[i];
2515 if (! ((c >= 'a' && c <= 'z')
2516 || (c >= 'A' && c <= 'Z')
2517 || (c >= '0' && c <= '9')
2518 || c == '-' || c == '_'))
2519 XSTRING (new)->data[i] = '_';
2520 }
2521}
2522
2523
2524extern char *x_get_string_resource ();
2525
2526DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 2, 4, 0,
2527 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
2528This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
2529class, where INSTANCE is the name under which Emacs was invoked, or\n\
2530the name specified by the `-name' or `-rn' command-line arguments.\n\
2531\n\
2532The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
2533class, respectively. You must specify both of them or neither.\n\
2534If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
2535and the class is `Emacs.CLASS.SUBCLASS'.")
2536 (attribute, class, component, subclass)
2537 Lisp_Object attribute, class, component, subclass;
2538{
2539 register char *value;
2540 char *name_key;
2541 char *class_key;
2542
2543 CHECK_STRING (attribute, 0);
2544 CHECK_STRING (class, 0);
2545
2546 if (!NILP (component))
2547 CHECK_STRING (component, 1);
2548 if (!NILP (subclass))
2549 CHECK_STRING (subclass, 2);
2550 if (NILP (component) != NILP (subclass))
2551 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2552
2553 validate_x_resource_name ();
2554
2555 /* Allocate space for the components, the dots which separate them,
2556 and the final '\0'. Make them big enough for the worst case. */
2557 name_key = (char *) alloca (XSTRING (Vx_resource_name)->size
2558 + (STRINGP (component)
2559 ? XSTRING (component)->size : 0)
2560 + XSTRING (attribute)->size
2561 + 3);
2562
2563 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
2564 + XSTRING (class)->size
2565 + (STRINGP (subclass)
2566 ? XSTRING (subclass)->size : 0)
2567 + 3);
2568
2569 /* Start with emacs.FRAMENAME for the name (the specific one)
2570 and with `Emacs' for the class key (the general one). */
2571 strcpy (name_key, XSTRING (Vx_resource_name)->data);
2572 strcpy (class_key, EMACS_CLASS);
2573
2574 strcat (class_key, ".");
2575 strcat (class_key, XSTRING (class)->data);
2576
2577 if (!NILP (component))
2578 {
2579 strcat (class_key, ".");
2580 strcat (class_key, XSTRING (subclass)->data);
2581
2582 strcat (name_key, ".");
2583 strcat (name_key, XSTRING (component)->data);
2584 }
2585
2586 strcat (name_key, ".");
2587 strcat (name_key, XSTRING (attribute)->data);
2588
2589 value = x_get_string_resource (Qnil,
2590 name_key, class_key);
2591
2592 if (value != (char *) 0)
2593 return build_string (value);
2594 else
2595 return Qnil;
2596}
2597
2598/* Used when C code wants a resource value. */
2599
2600char *
2601x_get_resource_string (attribute, class)
2602 char *attribute, *class;
2603{
2604 register char *value;
2605 char *name_key;
2606 char *class_key;
2607
2608 /* Allocate space for the components, the dots which separate them,
2609 and the final '\0'. */
2610 name_key = (char *) alloca (XSTRING (Vinvocation_name)->size
2611 + strlen (attribute) + 2);
2612 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
2613 + strlen (class) + 2);
2614
2615 sprintf (name_key, "%s.%s",
2616 XSTRING (Vinvocation_name)->data,
2617 attribute);
2618 sprintf (class_key, "%s.%s", EMACS_CLASS, class);
2619
2620 return x_get_string_resource (selected_frame,
2621 name_key, class_key);
2622}
2623
2624/* Types we might convert a resource string into. */
2625enum resource_types
2626 {
2627 number, boolean, string, symbol
2628 };
2629
2630/* Return the value of parameter PARAM.
2631
2632 First search ALIST, then Vdefault_frame_alist, then the X defaults
2633 database, using ATTRIBUTE as the attribute name and CLASS as its class.
2634
2635 Convert the resource to the type specified by desired_type.
2636
2637 If no default is specified, return Qunbound. If you call
2638 x_get_arg, make sure you deal with Qunbound in a reasonable way,
2639 and don't let it get stored in any Lisp-visible variables! */
2640
2641static Lisp_Object
2642x_get_arg (alist, param, attribute, class, type)
2643 Lisp_Object alist, param;
2644 char *attribute;
2645 char *class;
2646 enum resource_types type;
2647{
2648 register Lisp_Object tem;
2649
2650 tem = Fassq (param, alist);
2651 if (EQ (tem, Qnil))
2652 tem = Fassq (param, Vdefault_frame_alist);
2653 if (EQ (tem, Qnil))
2654 {
2655
2656 if (attribute)
2657 {
2658 tem = Fx_get_resource (build_string (attribute),
2659 build_string (class),
2660 Qnil, Qnil);
2661
2662 if (NILP (tem))
2663 return Qunbound;
2664
2665 switch (type)
2666 {
2667 case number:
2668 return make_number (atoi (XSTRING (tem)->data));
2669
2670 case boolean:
2671 tem = Fdowncase (tem);
2672 if (!strcmp (XSTRING (tem)->data, "on")
2673 || !strcmp (XSTRING (tem)->data, "true"))
2674 return Qt;
2675 else
2676 return Qnil;
2677
2678 case string:
2679 return tem;
2680
2681 case symbol:
2682 /* As a special case, we map the values `true' and `on'
2683 to Qt, and `false' and `off' to Qnil. */
2684 {
2685 Lisp_Object lower;
2686 lower = Fdowncase (tem);
2687 if (!strcmp (XSTRING (lower)->data, "on")
2688 || !strcmp (XSTRING (lower)->data, "true"))
2689 return Qt;
2690 else if (!strcmp (XSTRING (lower)->data, "off")
2691 || !strcmp (XSTRING (lower)->data, "false"))
2692 return Qnil;
2693 else
2694 return Fintern (tem, Qnil);
2695 }
2696
2697 default:
2698 abort ();
2699 }
2700 }
2701 else
2702 return Qunbound;
2703 }
2704 return Fcdr (tem);
2705}
2706
2707/* Record in frame F the specified or default value according to ALIST
2708 of the parameter named PARAM (a Lisp symbol).
2709 If no value is specified for PARAM, look for an X default for XPROP
2710 on the frame named NAME.
2711 If that is not found either, use the value DEFLT. */
2712
2713static Lisp_Object
2714x_default_parameter (f, alist, prop, deflt, xprop, xclass, type)
2715 struct frame *f;
2716 Lisp_Object alist;
2717 Lisp_Object prop;
2718 Lisp_Object deflt;
2719 char *xprop;
2720 char *xclass;
2721 enum resource_types type;
2722{
2723 Lisp_Object tem;
2724
2725 tem = x_get_arg (alist, prop, xprop, xclass, type);
2726 if (EQ (tem, Qunbound))
2727 tem = deflt;
2728 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
2729 return tem;
2730}
2731\f
2732DEFUN ("x-parse-geometry", Fx_parse_geometry, Sx_parse_geometry, 1, 1, 0,
2733 "Parse an X-style geometry string STRING.\n\
2734Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
2735The properties returned may include `top', `left', `height', and `width'.\n\
2736The value of `left' or `top' may be an integer,\n\
2737or a list (+ N) meaning N pixels relative to top/left corner,\n\
2738or a list (- N) meaning -N pixels relative to bottom/right corner.")
2739 (string)
2740 Lisp_Object string;
2741{
2742 int geometry, x, y;
2743 unsigned int width, height;
2744 Lisp_Object result;
2745
2746 CHECK_STRING (string, 0);
2747
2748 geometry = XParseGeometry ((char *) XSTRING (string)->data,
2749 &x, &y, &width, &height);
2750
2751 result = Qnil;
2752 if (geometry & XValue)
2753 {
2754 Lisp_Object element;
2755
2756 if (x >= 0 && (geometry & XNegative))
2757 element = Fcons (Qleft, Fcons (Qminus, Fcons (make_number (-x), Qnil)));
2758 else if (x < 0 && ! (geometry & XNegative))
2759 element = Fcons (Qleft, Fcons (Qplus, Fcons (make_number (x), Qnil)));
2760 else
2761 element = Fcons (Qleft, make_number (x));
2762 result = Fcons (element, result);
2763 }
2764
2765 if (geometry & YValue)
2766 {
2767 Lisp_Object element;
2768
2769 if (y >= 0 && (geometry & YNegative))
2770 element = Fcons (Qtop, Fcons (Qminus, Fcons (make_number (-y), Qnil)));
2771 else if (y < 0 && ! (geometry & YNegative))
2772 element = Fcons (Qtop, Fcons (Qplus, Fcons (make_number (y), Qnil)));
2773 else
2774 element = Fcons (Qtop, make_number (y));
2775 result = Fcons (element, result);
2776 }
2777
2778 if (geometry & WidthValue)
2779 result = Fcons (Fcons (Qwidth, make_number (width)), result);
2780 if (geometry & HeightValue)
2781 result = Fcons (Fcons (Qheight, make_number (height)), result);
2782
2783 return result;
2784}
2785
2786/* Calculate the desired size and position of this window,
2787 and return the flags saying which aspects were specified.
2788
2789 This function does not make the coordinates positive. */
2790
2791#define DEFAULT_ROWS 40
2792#define DEFAULT_COLS 80
2793
2794static int
2795x_figure_window_size (f, parms)
2796 struct frame *f;
2797 Lisp_Object parms;
2798{
2799 register Lisp_Object tem0, tem1, tem2;
2800 int height, width, left, top;
2801 register int geometry;
2802 long window_prompting = 0;
2803
2804 /* Default values if we fall through.
2805 Actually, if that happens we should get
2806 window manager prompting. */
1026b400 2807 SET_FRAME_WIDTH (f, DEFAULT_COLS);
ee78dc32
GV		 2808 f->height = DEFAULT_ROWS;
2809 /* Window managers expect that if program-specified
2810 positions are not (0,0), they're intentional, not defaults. */
fbd6baed
GV		 2811 f->output_data.w32->top_pos = 0;
2812 f->output_data.w32->left_pos = 0;
ee78dc32
GV		 2813
2814 tem0 = x_get_arg (parms, Qheight, 0, 0, number);
2815 tem1 = x_get_arg (parms, Qwidth, 0, 0, number);
2816 tem2 = x_get_arg (parms, Quser_size, 0, 0, number);
2817 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
2818 {
2819 if (!EQ (tem0, Qunbound))
2820 {
2821 CHECK_NUMBER (tem0, 0);
2822 f->height = XINT (tem0);
2823 }
2824 if (!EQ (tem1, Qunbound))
2825 {
2826 CHECK_NUMBER (tem1, 0);
1026b400 2827 SET_FRAME_WIDTH (f, XINT (tem1));
ee78dc32
GV		 2828 }
2829 if (!NILP (tem2) && !EQ (tem2, Qunbound))
2830 window_prompting |= USSize;
2831 else
2832 window_prompting |= PSize;
2833 }
2834
fbd6baed 2835 f->output_data.w32->vertical_scroll_bar_extra
ee78dc32
GV		 2836 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f)
2837 ? 0
2838 : FRAME_SCROLL_BAR_PIXEL_WIDTH (f) > 0
2839 ? FRAME_SCROLL_BAR_PIXEL_WIDTH (f)
fbd6baed
GV		 2840 : (FRAME_SCROLL_BAR_COLS (f) * FONT_WIDTH (f->output_data.w32->font)));
2841 f->output_data.w32->pixel_width = CHAR_TO_PIXEL_WIDTH (f, f->width);
2842 f->output_data.w32->pixel_height = CHAR_TO_PIXEL_HEIGHT (f, f->height);
ee78dc32
GV		 2843
2844 tem0 = x_get_arg (parms, Qtop, 0, 0, number);
2845 tem1 = x_get_arg (parms, Qleft, 0, 0, number);
2846 tem2 = x_get_arg (parms, Quser_position, 0, 0, number);
2847 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
2848 {
2849 if (EQ (tem0, Qminus))
2850 {
fbd6baed 2851 f->output_data.w32->top_pos = 0;
ee78dc32
GV		 2852 window_prompting |= YNegative;
2853 }
2854 else if (CONSP (tem0) && EQ (XCONS (tem0)->car, Qminus)
2855 && CONSP (XCONS (tem0)->cdr)
2856 && INTEGERP (XCONS (XCONS (tem0)->cdr)->car))
2857 {
fbd6baed 2858 f->output_data.w32->top_pos = - XINT (XCONS (XCONS (tem0)->cdr)->car);
ee78dc32
GV		 2859 window_prompting |= YNegative;
2860 }
2861 else if (CONSP (tem0) && EQ (XCONS (tem0)->car, Qplus)
2862 && CONSP (XCONS (tem0)->cdr)
2863 && INTEGERP (XCONS (XCONS (tem0)->cdr)->car))
2864 {
fbd6baed 2865 f->output_data.w32->top_pos = XINT (XCONS (XCONS (tem0)->cdr)->car);
ee78dc32
GV		 2866 }
2867 else if (EQ (tem0, Qunbound))
fbd6baed 2868 f->output_data.w32->top_pos = 0;
ee78dc32
GV		 2869 else
2870 {
2871 CHECK_NUMBER (tem0, 0);
fbd6baed
GV		 2872 f->output_data.w32->top_pos = XINT (tem0);
2873 if (f->output_data.w32->top_pos < 0)
ee78dc32
GV		 2874 window_prompting |= YNegative;
2875 }
2876
2877 if (EQ (tem1, Qminus))
2878 {
fbd6baed 2879 f->output_data.w32->left_pos = 0;
ee78dc32
GV		 2880 window_prompting |= XNegative;
2881 }
2882 else if (CONSP (tem1) && EQ (XCONS (tem1)->car, Qminus)
2883 && CONSP (XCONS (tem1)->cdr)
2884 && INTEGERP (XCONS (XCONS (tem1)->cdr)->car))
2885 {
fbd6baed 2886 f->output_data.w32->left_pos = - XINT (XCONS (XCONS (tem1)->cdr)->car);
ee78dc32
GV		 2887 window_prompting |= XNegative;
2888 }
2889 else if (CONSP (tem1) && EQ (XCONS (tem1)->car, Qplus)
2890 && CONSP (XCONS (tem1)->cdr)
2891 && INTEGERP (XCONS (XCONS (tem1)->cdr)->car))
2892 {
fbd6baed 2893 f->output_data.w32->left_pos = XINT (XCONS (XCONS (tem1)->cdr)->car);
ee78dc32
GV		 2894 }
2895 else if (EQ (tem1, Qunbound))
fbd6baed 2896 f->output_data.w32->left_pos = 0;
ee78dc32
GV		 2897 else
2898 {
2899 CHECK_NUMBER (tem1, 0);
fbd6baed
GV		 2900 f->output_data.w32->left_pos = XINT (tem1);
2901 if (f->output_data.w32->left_pos < 0)
ee78dc32
GV		 2902 window_prompting |= XNegative;
2903 }
2904
2905 if (!NILP (tem2) && ! EQ (tem2, Qunbound))
2906 window_prompting |= USPosition;
2907 else
2908 window_prompting |= PPosition;
2909 }
2910
2911 return window_prompting;
2912}
2913
2914\f
2915
fbd6baed 2916extern LRESULT CALLBACK w32_wnd_proc ();
ee78dc32
GV		 2917
2918BOOL
fbd6baed 2919w32_init_class (hinst)
ee78dc32
GV		 2920 HINSTANCE hinst;
2921{
2922 WNDCLASS wc;
2923
5ac45f98 2924 wc.style = CS_HREDRAW | CS_VREDRAW;
fbd6baed 2925 wc.lpfnWndProc = (WNDPROC) w32_wnd_proc;
ee78dc32
GV		 2926 wc.cbClsExtra = 0;
2927 wc.cbWndExtra = WND_EXTRA_BYTES;
2928 wc.hInstance = hinst;
2929 wc.hIcon = LoadIcon (hinst, EMACS_CLASS);
2930 wc.hCursor = LoadCursor (NULL, IDC_ARROW);
4587b026 2931 wc.hbrBackground = NULL; /* GetStockObject (WHITE_BRUSH); */
ee78dc32
GV		 2932 wc.lpszMenuName = NULL;
2933 wc.lpszClassName = EMACS_CLASS;
2934
2935 return (RegisterClass (&wc));
2936}
2937
2938HWND
fbd6baed 2939w32_createscrollbar (f, bar)
ee78dc32
GV		 2940 struct frame *f;
2941 struct scroll_bar * bar;
2942{
2943 return (CreateWindow ("SCROLLBAR", "", SBS_VERT | WS_CHILD | WS_VISIBLE,
2944 /* Position and size of scroll bar. */
2945 XINT(bar->left), XINT(bar->top),
2946 XINT(bar->width), XINT(bar->height),
fbd6baed 2947 FRAME_W32_WINDOW (f),
ee78dc32
GV		 2948 NULL,
2949 hinst,
2950 NULL));
2951}
2952
2953void
fbd6baed 2954w32_createwindow (f)
ee78dc32
GV		 2955 struct frame *f;
2956{
2957 HWND hwnd;
1edf84e7
GV		 2958 RECT rect;
2959
2960 rect.left = rect.top = 0;
2961 rect.right = PIXEL_WIDTH (f);
2962 rect.bottom = PIXEL_HEIGHT (f);
2963
2964 AdjustWindowRect (&rect, f->output_data.w32->dwStyle,
2965 FRAME_EXTERNAL_MENU_BAR (f));
ee78dc32
GV		 2966
2967 /* Do first time app init */
2968
2969 if (!hprevinst)
2970 {
fbd6baed 2971 w32_init_class (hinst);
ee78dc32
GV		 2972 }
2973
1edf84e7
GV		 2974 FRAME_W32_WINDOW (f) = hwnd
2975 = CreateWindow (EMACS_CLASS,
2976 f->namebuf,
2977 f->output_data.w32->dwStyle | WS_CLIPCHILDREN,
2978 f->output_data.w32->left_pos,
2979 f->output_data.w32->top_pos,
2980 rect.right - rect.left,
2981 rect.bottom - rect.top,
2982 NULL,
2983 NULL,
2984 hinst,
2985 NULL);
2986
ee78dc32
GV		 2987 if (hwnd)
2988 {
1edf84e7
GV		 2989 SetWindowLong (hwnd, WND_FONTWIDTH_INDEX, FONT_WIDTH (f->output_data.w32->font));
2990 SetWindowLong (hwnd, WND_LINEHEIGHT_INDEX, f->output_data.w32->line_height);
2991 SetWindowLong (hwnd, WND_BORDER_INDEX, f->output_data.w32->internal_border_width);
2992 SetWindowLong (hwnd, WND_SCROLLBAR_INDEX, f->output_data.w32->vertical_scroll_bar_extra);
fbd6baed 2993 SetWindowLong (hwnd, WND_BACKGROUND_INDEX, f->output_data.w32->background_pixel);
ee78dc32 2994
cb9e33d4
RS		 2995 /* Enable drag-n-drop. */
2996 DragAcceptFiles (hwnd, TRUE);
2997
5ac45f98
GV		 2998 /* Do this to discard the default setting specified by our parent. */
2999 ShowWindow (hwnd, SW_HIDE);
3c190163 3000 }
3c190163
GV		 3001}
3002
ee78dc32
GV		 3003void
3004my_post_msg (wmsg, hwnd, msg, wParam, lParam)
fbd6baed 3005 W32Msg * wmsg;
ee78dc32
GV		 3006 HWND hwnd;
3007 UINT msg;
3008 WPARAM wParam;
3009 LPARAM lParam;
3010{
3011 wmsg->msg.hwnd = hwnd;
3012 wmsg->msg.message = msg;
3013 wmsg->msg.wParam = wParam;
3014 wmsg->msg.lParam = lParam;
3015 wmsg->msg.time = GetMessageTime ();
3016
3017 post_msg (wmsg);
3018}
3019
e9e23e23 3020/* GetKeyState and MapVirtualKey on Windows 95 do not actually distinguish
a1a80b40
GV		 3021 between left and right keys as advertised. We test for this
3022 support dynamically, and set a flag when the support is absent. If
3023 absent, we keep track of the left and right control and alt keys
3024 ourselves. This is particularly necessary on keyboards that rely
3025 upon the AltGr key, which is represented as having the left control
3026 and right alt keys pressed. For these keyboards, we need to know
3027 when the left alt key has been pressed in addition to the AltGr key
3028 so that we can properly support M-AltGr-key sequences (such as M-@
3029 on Swedish keyboards). */
3030
3031#define EMACS_LCONTROL 0
3032#define EMACS_RCONTROL 1
3033#define EMACS_LMENU 2
3034#define EMACS_RMENU 3
3035
3036static int modifiers[4];
3037static int modifiers_recorded;
3038static int modifier_key_support_tested;
3039
3040static void
3041test_modifier_support (unsigned int wparam)
3042{
3043 unsigned int l, r;
3044
3045 if (wparam != VK_CONTROL && wparam != VK_MENU)
3046 return;
3047 if (wparam == VK_CONTROL)
3048 {
3049 l = VK_LCONTROL;
3050 r = VK_RCONTROL;
3051 }
3052 else
3053 {
3054 l = VK_LMENU;
3055 r = VK_RMENU;
3056 }
3057 if (!(GetKeyState (l) & 0x8000) && !(GetKeyState (r) & 0x8000))
3058 modifiers_recorded = 1;
3059 else
3060 modifiers_recorded = 0;
3061 modifier_key_support_tested = 1;
3062}
3063
3064static void
3065record_keydown (unsigned int wparam, unsigned int lparam)
3066{
3067 int i;
3068
3069 if (!modifier_key_support_tested)
3070 test_modifier_support (wparam);
3071
3072 if ((wparam != VK_CONTROL && wparam != VK_MENU) || !modifiers_recorded)
3073 return;
3074
3075 if (wparam == VK_CONTROL)
3076 i = (lparam & 0x1000000) ? EMACS_RCONTROL : EMACS_LCONTROL;
3077 else
3078 i = (lparam & 0x1000000) ? EMACS_RMENU : EMACS_LMENU;
3079
3080 modifiers[i] = 1;
3081}
3082
3083static void
3084record_keyup (unsigned int wparam, unsigned int lparam)
3085{
3086 int i;
3087
3088 if ((wparam != VK_CONTROL && wparam != VK_MENU) || !modifiers_recorded)
3089 return;
3090
3091 if (wparam == VK_CONTROL)
3092 i = (lparam & 0x1000000) ? EMACS_RCONTROL : EMACS_LCONTROL;
3093 else
3094 i = (lparam & 0x1000000) ? EMACS_RMENU : EMACS_LMENU;
3095
3096 modifiers[i] = 0;
3097}
3098
da36a4d6
GV		 3099/* Emacs can lose focus while a modifier key has been pressed. When
3100 it regains focus, be conservative and clear all modifiers since
3101 we cannot reconstruct the left and right modifier state. */
3102static void
3103reset_modifiers ()
3104{
8681157a
RS		 3105 SHORT ctrl, alt;
3106
adcc3809
GV		 3107 if (GetFocus () == NULL)
3108 /* Emacs doesn't have keyboard focus. Do nothing. */
da36a4d6 3109 return;
8681157a
RS		 3110
3111 ctrl = GetAsyncKeyState (VK_CONTROL);
3112 alt = GetAsyncKeyState (VK_MENU);
3113
8681157a
RS		 3114 if (!(ctrl & 0x08000))
3115 /* Clear any recorded control modifier state. */
3116 modifiers[EMACS_RCONTROL] = modifiers[EMACS_LCONTROL] = 0;
3117
3118 if (!(alt & 0x08000))
3119 /* Clear any recorded alt modifier state. */
3120 modifiers[EMACS_RMENU] = modifiers[EMACS_LMENU] = 0;
3121
adcc3809
GV		 3122 /* Update the state of all modifier keys, because modifiers used in
3123 hot-key combinations can get stuck on if Emacs loses focus as a
3124 result of a hot-key being pressed. */
3125 {
3126 BYTE keystate[256];
3127
3128#define CURRENT_STATE(key) ((GetAsyncKeyState (key) & 0x8000) >> 8)
3129
3130 GetKeyboardState (keystate);
3131 keystate[VK_SHIFT] = CURRENT_STATE (VK_SHIFT);
3132 keystate[VK_CONTROL] = CURRENT_STATE (VK_CONTROL);
3133 keystate[VK_LCONTROL] = CURRENT_STATE (VK_LCONTROL);
3134 keystate[VK_RCONTROL] = CURRENT_STATE (VK_RCONTROL);
3135 keystate[VK_MENU] = CURRENT_STATE (VK_MENU);
3136 keystate[VK_LMENU] = CURRENT_STATE (VK_LMENU);
3137 keystate[VK_RMENU] = CURRENT_STATE (VK_RMENU);
3138 keystate[VK_LWIN] = CURRENT_STATE (VK_LWIN);
3139 keystate[VK_RWIN] = CURRENT_STATE (VK_RWIN);
3140 keystate[VK_APPS] = CURRENT_STATE (VK_APPS);
3141 SetKeyboardState (keystate);
3142 }
da36a4d6
GV		 3143}
3144
7830e24b
RS		 3145/* Synchronize modifier state with what is reported with the current
3146 keystroke. Even if we cannot distinguish between left and right
3147 modifier keys, we know that, if no modifiers are set, then neither
3148 the left or right modifier should be set. */
3149static void
3150sync_modifiers ()
3151{
3152 if (!modifiers_recorded)
3153 return;
3154
3155 if (!(GetKeyState (VK_CONTROL) & 0x8000))
3156 modifiers[EMACS_RCONTROL] = modifiers[EMACS_LCONTROL] = 0;
3157
3158 if (!(GetKeyState (VK_MENU) & 0x8000))
3159 modifiers[EMACS_RMENU] = modifiers[EMACS_LMENU] = 0;
3160}
3161
a1a80b40
GV		 3162static int
3163modifier_set (int vkey)
3164{
ccc2d29c 3165 if (vkey == VK_CAPITAL || vkey == VK_SCROLL)
891560d6 3166 return (GetKeyState (vkey) & 0x1);
a1a80b40
GV		 3167 if (!modifiers_recorded)
3168 return (GetKeyState (vkey) & 0x8000);
3169
3170 switch (vkey)
3171 {
3172 case VK_LCONTROL:
3173 return modifiers[EMACS_LCONTROL];
3174 case VK_RCONTROL:
3175 return modifiers[EMACS_RCONTROL];
3176 case VK_LMENU:
3177 return modifiers[EMACS_LMENU];
3178 case VK_RMENU:
3179 return modifiers[EMACS_RMENU];
a1a80b40
GV		 3180 }
3181 return (GetKeyState (vkey) & 0x8000);
3182}
3183
ccc2d29c
GV		 3184/* Convert between the modifier bits W32 uses and the modifier bits
3185 Emacs uses. */
3186
3187unsigned int
3188w32_key_to_modifier (int key)
3189{
3190 Lisp_Object key_mapping;
3191
3192 switch (key)
3193 {
3194 case VK_LWIN:
3195 key_mapping = Vw32_lwindow_modifier;
3196 break;
3197 case VK_RWIN:
3198 key_mapping = Vw32_rwindow_modifier;
3199 break;
3200 case VK_APPS:
3201 key_mapping = Vw32_apps_modifier;
3202 break;
3203 case VK_SCROLL:
3204 key_mapping = Vw32_scroll_lock_modifier;
3205 break;
3206 default:
3207 key_mapping = Qnil;
3208 }
3209
adcc3809
GV		 3210 /* NB. This code runs in the input thread, asychronously to the lisp
3211 thread, so we must be careful to ensure access to lisp data is
3212 thread-safe. The following code is safe because the modifier
3213 variable values are updated atomically from lisp and symbols are
3214 not relocated by GC. Also, we don't have to worry about seeing GC
3215 markbits here. */
3216 if (EQ (key_mapping, Qhyper))
ccc2d29c 3217 return hyper_modifier;
adcc3809 3218 if (EQ (key_mapping, Qsuper))
ccc2d29c 3219 return super_modifier;
adcc3809 3220 if (EQ (key_mapping, Qmeta))
ccc2d29c 3221 return meta_modifier;
adcc3809 3222 if (EQ (key_mapping, Qalt))
ccc2d29c 3223 return alt_modifier;
adcc3809 3224 if (EQ (key_mapping, Qctrl))
ccc2d29c 3225 return ctrl_modifier;
adcc3809 3226 if (EQ (key_mapping, Qcontrol)) /* synonym for ctrl */
ccc2d29c 3227 return ctrl_modifier;
adcc3809 3228 if (EQ (key_mapping, Qshift))
ccc2d29c
GV		 3229 return shift_modifier;
3230
3231 /* Don't generate any modifier if not explicitly requested. */
3232 return 0;
3233}
3234
3235unsigned int
3236w32_get_modifiers ()
3237{
3238 return ((modifier_set (VK_SHIFT) ? shift_modifier : 0) |
3239 (modifier_set (VK_CONTROL) ? ctrl_modifier : 0) |
3240 (modifier_set (VK_LWIN) ? w32_key_to_modifier (VK_LWIN) : 0) |
3241 (modifier_set (VK_RWIN) ? w32_key_to_modifier (VK_RWIN) : 0) |
3242 (modifier_set (VK_APPS) ? w32_key_to_modifier (VK_APPS) : 0) |
3243 (modifier_set (VK_SCROLL) ? w32_key_to_modifier (VK_SCROLL) : 0) |
3244 (modifier_set (VK_MENU) ?
3245 ((NILP (Vw32_alt_is_meta)) ? alt_modifier : meta_modifier) : 0));
3246}
3247
a1a80b40
GV		 3248/* We map the VK_* modifiers into console modifier constants
3249 so that we can use the same routines to handle both console
3250 and window input. */
3251
3252static int
ccc2d29c 3253construct_console_modifiers ()
a1a80b40
GV		 3254{
3255 int mods;
3256
a1a80b40
GV		 3257 mods = 0;
3258 mods |= (modifier_set (VK_SHIFT)) ? SHIFT_PRESSED : 0;
3259 mods |= (modifier_set (VK_CAPITAL)) ? CAPSLOCK_ON : 0;
ccc2d29c
GV		 3260 mods |= (modifier_set (VK_SCROLL)) ? SCROLLLOCK_ON : 0;
3261 mods |= (modifier_set (VK_NUMLOCK)) ? NUMLOCK_ON : 0;
a1a80b40
GV		 3262 mods |= (modifier_set (VK_LCONTROL)) ? LEFT_CTRL_PRESSED : 0;
3263 mods |= (modifier_set (VK_RCONTROL)) ? RIGHT_CTRL_PRESSED : 0;
3264 mods |= (modifier_set (VK_LMENU)) ? LEFT_ALT_PRESSED : 0;
3265 mods |= (modifier_set (VK_RMENU)) ? RIGHT_ALT_PRESSED : 0;
ccc2d29c
GV		 3266 mods |= (modifier_set (VK_LWIN)) ? LEFT_WIN_PRESSED : 0;
3267 mods |= (modifier_set (VK_RWIN)) ? RIGHT_WIN_PRESSED : 0;
3268 mods |= (modifier_set (VK_APPS)) ? APPS_PRESSED : 0;
a1a80b40
GV		 3269
3270 return mods;
3271}
3272
ccc2d29c
GV		 3273static int
3274w32_get_key_modifiers (unsigned int wparam, unsigned int lparam)
da36a4d6 3275{
ccc2d29c
GV		 3276 int mods;
3277
3278 /* Convert to emacs modifiers. */
3279 mods = w32_kbd_mods_to_emacs (construct_console_modifiers (), wparam);
3280
3281 return mods;
3282}
da36a4d6 3283
ccc2d29c
GV		 3284unsigned int
3285map_keypad_keys (unsigned int virt_key, unsigned int extended)
3286{
3287 if (virt_key < VK_CLEAR || virt_key > VK_DELETE)
3288 return virt_key;
da36a4d6 3289
ccc2d29c 3290 if (virt_key == VK_RETURN)
da36a4d6
GV		 3291 return (extended ? VK_NUMPAD_ENTER : VK_RETURN);
3292
ccc2d29c
GV		 3293 if (virt_key >= VK_PRIOR && virt_key <= VK_DOWN)
3294 return (!extended ? (VK_NUMPAD_PRIOR + (virt_key - VK_PRIOR)) : virt_key);
3295
3296 if (virt_key == VK_INSERT || virt_key == VK_DELETE)
3297 return (!extended ? (VK_NUMPAD_INSERT + (virt_key - VK_INSERT)) : virt_key);
3298
3299 if (virt_key == VK_CLEAR)
3300 return (!extended ? VK_NUMPAD_CLEAR : virt_key);
3301
3302 return virt_key;
3303}
3304
3305/* List of special key combinations which w32 would normally capture,
3306 but emacs should grab instead. Not directly visible to lisp, to
3307 simplify synchronization. Each item is an integer encoding a virtual
3308 key code and modifier combination to capture. */
3309Lisp_Object w32_grabbed_keys;
3310
3311#define HOTKEY(vk,mods) make_number (((vk) & 255) | ((mods) << 8))
3312#define HOTKEY_ID(k) (XFASTINT (k) & 0xbfff)
3313#define HOTKEY_VK_CODE(k) (XFASTINT (k) & 255)
3314#define HOTKEY_MODIFIERS(k) (XFASTINT (k) >> 8)
3315
3316/* Register hot-keys for reserved key combinations when Emacs has
3317 keyboard focus, since this is the only way Emacs can receive key
3318 combinations like Alt-Tab which are used by the system. */
3319
3320static void
3321register_hot_keys (hwnd)
3322 HWND hwnd;
3323{
3324 Lisp_Object keylist;
3325
3326 /* Use GC_CONSP, since we are called asynchronously. */
3327 for (keylist = w32_grabbed_keys; GC_CONSP (keylist); keylist = XCDR (keylist))
3328 {
3329 Lisp_Object key = XCAR (keylist);
3330
3331 /* Deleted entries get set to nil. */
3332 if (!INTEGERP (key))
3333 continue;
3334
3335 RegisterHotKey (hwnd, HOTKEY_ID (key),
3336 HOTKEY_MODIFIERS (key), HOTKEY_VK_CODE (key));
3337 }
3338}
3339
3340static void
3341unregister_hot_keys (hwnd)
3342 HWND hwnd;
3343{
3344 Lisp_Object keylist;
3345
3346 /* Use GC_CONSP, since we are called asynchronously. */
3347 for (keylist = w32_grabbed_keys; GC_CONSP (keylist); keylist = XCDR (keylist))
3348 {
3349 Lisp_Object key = XCAR (keylist);
3350
3351 if (!INTEGERP (key))
3352 continue;
3353
3354 UnregisterHotKey (hwnd, HOTKEY_ID (key));
3355 }
3356}
3357
3358static void
3359post_character_message (hwnd, msg, wParam, lParam, modifiers)
3360 HWND hwnd;
3361 UINT msg;
3362 WPARAM wParam;
3363 LPARAM lParam;
3364 DWORD modifiers;
3365
3366{
3367 W32Msg wmsg;
da36a4d6 3368
ccc2d29c 3369 wmsg.dwModifiers = modifiers;
da36a4d6 3370
ccc2d29c
GV		 3371 /* Detect quit_char and set quit-flag directly. Note that we
3372 still need to post a message to ensure the main thread will be
3373 woken up if blocked in sys_select(), but we do NOT want to post
3374 the quit_char message itself (because it will usually be as if
3375 the user had typed quit_char twice). Instead, we post a dummy
3376 message that has no particular effect. */
3377 {
3378 int c = wParam;
3379 if (isalpha (c) && wmsg.dwModifiers == ctrl_modifier)
3380 c = make_ctrl_char (c) & 0377;
3381 if (c == quit_char)
3382 {
3383 Vquit_flag = Qt;
3384
3385 /* The choice of message is somewhat arbitrary, as long as
3386 the main thread handler just ignores it. */
3387 msg = WM_NULL;
3388
3389 /* Interrupt any blocking system calls. */
3390 signal_quit ();
3391 }
3392 }
da36a4d6 3393
ccc2d29c 3394 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
da36a4d6
GV		 3395}
3396
5ac45f98
GV		 3397/* Main message dispatch loop. */
3398
1edf84e7
GV		 3399static void
3400w32_msg_pump (deferred_msg * msg_buf)
5ac45f98
GV		 3401{
3402 MSG msg;
ccc2d29c
GV		 3403 int result;
3404 HWND focus_window;
93fbe8b7
GV		 3405
3406 msh_mousewheel = RegisterWindowMessage (MSH_MOUSEWHEEL);
5ac45f98 3407
5ac45f98
GV		 3408 while (GetMessage (&msg, NULL, 0, 0))
3409 {
3410 if (msg.hwnd == NULL)
3411 {
3412 switch (msg.message)
3413 {
5ac45f98 3414 case WM_EMACS_CREATEWINDOW:
fbd6baed 3415 w32_createwindow ((struct frame *) msg.wParam);
1edf84e7
GV		 3416 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0))
3417 abort ();
5ac45f98 3418 break;
dfdb4047
GV		 3419 case WM_EMACS_SETLOCALE:
3420 SetThreadLocale (msg.wParam);
3421 /* Reply is not expected. */
3422 break;
ccc2d29c
GV		 3423 case WM_EMACS_SETKEYBOARDLAYOUT:
3424 result = (int) ActivateKeyboardLayout ((HKL) msg.wParam, 0);
3425 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE,
3426 result, 0))
3427 abort ();
3428 break;
3429 case WM_EMACS_REGISTER_HOT_KEY:
3430 focus_window = GetFocus ();
3431 if (focus_window != NULL)
3432 RegisterHotKey (focus_window,
3433 HOTKEY_ID (msg.wParam),
3434 HOTKEY_MODIFIERS (msg.wParam),
3435 HOTKEY_VK_CODE (msg.wParam));
3436 /* Reply is not expected. */
3437 break;
3438 case WM_EMACS_UNREGISTER_HOT_KEY:
3439 focus_window = GetFocus ();
3440 if (focus_window != NULL)
3441 UnregisterHotKey (focus_window, HOTKEY_ID (msg.wParam));
adcc3809
GV		 3442 /* Mark item as erased. NB: this code must be
3443 thread-safe. The next line is okay because the cons
3444 cell is never made into garbage and is not relocated by
3445 GC. */
ccc2d29c
GV		 3446 XCAR ((Lisp_Object) msg.lParam) = Qnil;
3447 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0))
3448 abort ();
3449 break;
adcc3809
GV		 3450 case WM_EMACS_TOGGLE_LOCK_KEY:
3451 {
3452 int vk_code = (int) msg.wParam;
3453 int cur_state = (GetKeyState (vk_code) & 1);
3454 Lisp_Object new_state = (Lisp_Object) msg.lParam;
3455
3456 /* NB: This code must be thread-safe. It is safe to
3457 call NILP because symbols are not relocated by GC,
3458 and pointer here is not touched by GC (so the markbit
3459 can't be set). Numbers are safe because they are
3460 immediate values. */
3461 if (NILP (new_state)
3462 || (NUMBERP (new_state)
3463 && (XUINT (new_state)) & 1 != cur_state))
3464 {
3465 one_w32_display_info.faked_key = vk_code;
3466
3467 keybd_event ((BYTE) vk_code,
3468 (BYTE) MapVirtualKey (vk_code, 0),
3469 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
3470 keybd_event ((BYTE) vk_code,
3471 (BYTE) MapVirtualKey (vk_code, 0),
3472 KEYEVENTF_EXTENDEDKEY | 0, 0);
3473 keybd_event ((BYTE) vk_code,
3474 (BYTE) MapVirtualKey (vk_code, 0),
3475 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
3476 cur_state = !cur_state;
3477 }
3478 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE,
3479 cur_state, 0))
3480 abort ();
3481 }
3482 break;
1edf84e7 3483 default:
1edf84e7 3484 DebPrint (("msg %x not expected by w32_msg_pump\n", msg.message));
5ac45f98
GV		 3485 }
3486 }
3487 else
3488 {
3489 DispatchMessage (&msg);
3490 }
1edf84e7
GV		 3491
3492 /* Exit nested loop when our deferred message has completed. */
3493 if (msg_buf->completed)
3494 break;
5ac45f98 3495 }
1edf84e7
GV		 3496}
3497
3498deferred_msg * deferred_msg_head;
3499
3500static deferred_msg *
3501find_deferred_msg (HWND hwnd, UINT msg)
3502{
3503 deferred_msg * item;
3504
3505 /* Don't actually need synchronization for read access, since
3506 modification of single pointer is always atomic. */
3507 /* enter_crit (); */
3508
3509 for (item = deferred_msg_head; item != NULL; item = item->next)
3510 if (item->w32msg.msg.hwnd == hwnd
3511 && item->w32msg.msg.message == msg)
3512 break;
3513
3514 /* leave_crit (); */
3515
3516 return item;
3517}
3518
3519static LRESULT
3520send_deferred_msg (deferred_msg * msg_buf,
3521 HWND hwnd,
3522 UINT msg,
3523 WPARAM wParam,
3524 LPARAM lParam)
3525{
3526 /* Only input thread can send deferred messages. */
3527 if (GetCurrentThreadId () != dwWindowsThreadId)
3528 abort ();
3529
3530 /* It is an error to send a message that is already deferred. */
3531 if (find_deferred_msg (hwnd, msg) != NULL)
3532 abort ();
3533
3534 /* Enforced synchronization is not needed because this is the only
3535 function that alters deferred_msg_head, and the following critical
3536 section is guaranteed to only be serially reentered (since only the
3537 input thread can call us). */
3538
3539 /* enter_crit (); */
3540
3541 msg_buf->completed = 0;
3542 msg_buf->next = deferred_msg_head;
3543 deferred_msg_head = msg_buf;
3544 my_post_msg (&msg_buf->w32msg, hwnd, msg, wParam, lParam);
3545
3546 /* leave_crit (); */
3547
3548 /* Start a new nested message loop to process other messages until
3549 this one is completed. */
3550 w32_msg_pump (msg_buf);
3551
3552 deferred_msg_head = msg_buf->next;
3553
3554 return msg_buf->result;
3555}
3556
3557void
3558complete_deferred_msg (HWND hwnd, UINT msg, LRESULT result)
3559{
3560 deferred_msg * msg_buf = find_deferred_msg (hwnd, msg);
3561
3562 if (msg_buf == NULL)
3563 abort ();
3564
3565 msg_buf->result = result;
3566 msg_buf->completed = 1;
3567
3568 /* Ensure input thread is woken so it notices the completion. */
3569 PostThreadMessage (dwWindowsThreadId, WM_NULL, 0, 0);
3570}
3571
3572
3573DWORD
3574w32_msg_worker (dw)
3575 DWORD dw;
3576{
3577 MSG msg;
3578 deferred_msg dummy_buf;
3579
3580 /* Ensure our message queue is created */
3581
3582 PeekMessage (&msg, NULL, 0, 0, PM_NOREMOVE);
5ac45f98 3583
1edf84e7
GV		 3584 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0))
3585 abort ();
3586
3587 memset (&dummy_buf, 0, sizeof (dummy_buf));
3588 dummy_buf.w32msg.msg.hwnd = NULL;
3589 dummy_buf.w32msg.msg.message = WM_NULL;
3590
3591 /* This is the inital message loop which should only exit when the
3592 application quits. */
3593 w32_msg_pump (&dummy_buf);
3594
3595 return 0;
5ac45f98
GV		 3596}
3597
ee78dc32
GV		 3598/* Main window procedure */
3599
ee78dc32 3600LRESULT CALLBACK
fbd6baed 3601w32_wnd_proc (hwnd, msg, wParam, lParam)
ee78dc32
GV		 3602 HWND hwnd;
3603 UINT msg;
3604 WPARAM wParam;
3605 LPARAM lParam;
3606{
3607 struct frame *f;
fbd6baed
GV		 3608 struct w32_display_info *dpyinfo = &one_w32_display_info;
3609 W32Msg wmsg;
84fb1139
KH		 3610 int windows_translate;
3611
a6085637
KH		 3612 /* Note that it is okay to call x_window_to_frame, even though we are
3613 not running in the main lisp thread, because frame deletion
3614 requires the lisp thread to synchronize with this thread. Thus, if
3615 a frame struct is returned, it can be used without concern that the
3616 lisp thread might make it disappear while we are using it.
3617
3618 NB. Walking the frame list in this thread is safe (as long as
3619 writes of Lisp_Object slots are atomic, which they are on Windows).
3620 Although delete-frame can destructively modify the frame list while
3621 we are walking it, a garbage collection cannot occur until after
3622 delete-frame has synchronized with this thread.
3623
3624 It is also safe to use functions that make GDI calls, such as
fbd6baed 3625 w32_clear_rect, because these functions must obtain a DC handle
a6085637
KH		 3626 from the frame struct using get_frame_dc which is thread-aware. */
3627
ee78dc32
GV		 3628 switch (msg)
3629 {
3630 case WM_ERASEBKGND:
a6085637
KH		 3631 f = x_window_to_frame (dpyinfo, hwnd);
3632 if (f)
3633 {
3634 GetUpdateRect (hwnd, &wmsg.rect, FALSE);
fbd6baed 3635 w32_clear_rect (f, NULL, &wmsg.rect);
a6085637 3636 }
5ac45f98
GV		 3637 return 1;
3638 case WM_PALETTECHANGED:
3639 /* ignore our own changes */
3640 if ((HWND)wParam != hwnd)
3641 {
a6085637
KH		 3642 f = x_window_to_frame (dpyinfo, hwnd);
3643 if (f)
3644 /* get_frame_dc will realize our palette and force all
3645 frames to be redrawn if needed. */
3646 release_frame_dc (f, get_frame_dc (f));
5ac45f98
GV		 3647 }
3648 return 0;
ee78dc32
GV		 3649 case WM_PAINT:
3650 {
3651 PAINTSTRUCT paintStruct;
5ac45f98
GV		 3652
3653 enter_crit ();
ee78dc32
GV		 3654 BeginPaint (hwnd, &paintStruct);
3655 wmsg.rect = paintStruct.rcPaint;
3656 EndPaint (hwnd, &paintStruct);
5ac45f98
GV		 3657 leave_crit ();
3658
ee78dc32
GV		 3659 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3660
3661 return (0);
3662 }
a1a80b40 3663
ccc2d29c
GV		 3664 case WM_INPUTLANGCHANGE:
3665 /* Inform lisp thread of keyboard layout changes. */
3666 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3667
3668 /* Clear dead keys in the keyboard state; for simplicity only
3669 preserve modifier key states. */
3670 {
3671 int i;
3672 BYTE keystate[256];
3673
3674 GetKeyboardState (keystate);
3675 for (i = 0; i < 256; i++)
3676 if (1
3677 && i != VK_SHIFT
3678 && i != VK_LSHIFT
3679 && i != VK_RSHIFT
3680 && i != VK_CAPITAL
3681 && i != VK_NUMLOCK
3682 && i != VK_SCROLL
3683 && i != VK_CONTROL
3684 && i != VK_LCONTROL
3685 && i != VK_RCONTROL
3686 && i != VK_MENU
3687 && i != VK_LMENU
3688 && i != VK_RMENU
3689 && i != VK_LWIN
3690 && i != VK_RWIN)
3691 keystate[i] = 0;
3692 SetKeyboardState (keystate);
3693 }
3694 goto dflt;
3695
3696 case WM_HOTKEY:
3697 /* Synchronize hot keys with normal input. */
3698 PostMessage (hwnd, WM_KEYDOWN, HIWORD (lParam), 0);
3699 return (0);
3700
a1a80b40
GV		 3701 case WM_KEYUP:
3702 case WM_SYSKEYUP:
3703 record_keyup (wParam, lParam);
3704 goto dflt;
3705
ee78dc32
GV		 3706 case WM_KEYDOWN:
3707 case WM_SYSKEYDOWN:
ccc2d29c
GV		 3708 /* Ignore keystrokes we fake ourself; see below. */
3709 if (dpyinfo->faked_key == wParam)
3710 {
3711 dpyinfo->faked_key = 0;
adcc3809
GV		 3712 /* Make sure TranslateMessage sees them though. */
3713 windows_translate = 1;
3714 goto translate;
ccc2d29c
GV		 3715 }
3716
7830e24b
RS		 3717 /* Synchronize modifiers with current keystroke. */
3718 sync_modifiers ();
a1a80b40 3719 record_keydown (wParam, lParam);
ccc2d29c 3720 wParam = map_keypad_keys (wParam, (lParam & 0x1000000L) != 0);
84fb1139
KH		 3721
3722 windows_translate = 0;
ccc2d29c
GV		 3723
3724 switch (wParam)
3725 {
3726 case VK_LWIN:
3727 if (NILP (Vw32_pass_lwindow_to_system))
3728 {
3729 /* Prevent system from acting on keyup (which opens the
3730 Start menu if no other key was pressed) by simulating a
3731 press of Space which we will ignore. */
3732 if (GetAsyncKeyState (wParam) & 1)
3733 {
adcc3809
GV		 3734 if (NUMBERP (Vw32_phantom_key_code))
3735 wParam = XUINT (Vw32_phantom_key_code) & 255;
3736 else
3737 wParam = VK_SPACE;
3738 dpyinfo->faked_key = wParam;
3739 keybd_event (wParam, (BYTE) MapVirtualKey (wParam, 0), 0, 0);
ccc2d29c
GV		 3740 }
3741 }
3742 if (!NILP (Vw32_lwindow_modifier))
3743 return 0;
adcc3809 3744 windows_translate = 1;
ccc2d29c
GV		 3745 break;
3746 case VK_RWIN:
3747 if (NILP (Vw32_pass_rwindow_to_system))
3748 {
3749 if (GetAsyncKeyState (wParam) & 1)
3750 {
adcc3809
GV		 3751 if (NUMBERP (Vw32_phantom_key_code))
3752 wParam = XUINT (Vw32_phantom_key_code) & 255;
3753 else
3754 wParam = VK_SPACE;
3755 dpyinfo->faked_key = wParam;
3756 keybd_event (wParam, (BYTE) MapVirtualKey (wParam, 0), 0, 0);
ccc2d29c
GV		 3757 }
3758 }
3759 if (!NILP (Vw32_rwindow_modifier))
3760 return 0;
adcc3809 3761 windows_translate = 1;
ccc2d29c
GV		 3762 break;
3763 case VK_APPS:
3764 if (!NILP (Vw32_apps_modifier))
3765 return 0;
adcc3809 3766 windows_translate = 1;
ccc2d29c
GV		 3767 break;
3768 case VK_MENU:
3769 if (NILP (Vw32_pass_alt_to_system))
adcc3809
GV		 3770 /* Prevent DefWindowProc from activating the menu bar if an
3771 Alt key is pressed and released by itself. */
ccc2d29c 3772 return 0;
84fb1139 3773 windows_translate = 1;
ccc2d29c
GV		 3774 break;
3775 case VK_CAPITAL:
3776 /* Decide whether to treat as modifier or function key. */
3777 if (NILP (Vw32_enable_caps_lock))
3778 goto disable_lock_key;
adcc3809
GV		 3779 windows_translate = 1;
3780 break;
ccc2d29c
GV		 3781 case VK_NUMLOCK:
3782 /* Decide whether to treat as modifier or function key. */
3783 if (NILP (Vw32_enable_num_lock))
3784 goto disable_lock_key;
adcc3809
GV		 3785 windows_translate = 1;
3786 break;
ccc2d29c
GV		 3787 case VK_SCROLL:
3788 /* Decide whether to treat as modifier or function key. */
3789 if (NILP (Vw32_scroll_lock_modifier))
3790 goto disable_lock_key;
adcc3809
GV		 3791 windows_translate = 1;
3792 break;
ccc2d29c 3793 disable_lock_key:
adcc3809
GV		 3794 /* Ensure the appropriate lock key state (and indicator light)
3795 remains in the same state. We do this by faking another
3796 press of the relevant key. Apparently, this really is the
3797 only way to toggle the state of the indicator lights. */
3798 dpyinfo->faked_key = wParam;
3799 keybd_event ((BYTE) wParam, (BYTE) MapVirtualKey (wParam, 0),
3800 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
3801 keybd_event ((BYTE) wParam, (BYTE) MapVirtualKey (wParam, 0),
3802 KEYEVENTF_EXTENDEDKEY | 0, 0);
3803 keybd_event ((BYTE) wParam, (BYTE) MapVirtualKey (wParam, 0),
3804 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
3805 /* Ensure indicator lights are updated promptly on Windows 9x
3806 (TranslateMessage apparently does this), after forwarding
3807 input event. */
3808 post_character_message (hwnd, msg, wParam, lParam,
3809 w32_get_key_modifiers (wParam, lParam));
3810 windows_translate = 1;
ccc2d29c
GV		 3811 break;
3812 case VK_CONTROL:
3813 case VK_SHIFT:
3814 case VK_PROCESSKEY: /* Generated by IME. */
3815 windows_translate = 1;
3816 break;
adcc3809
GV		 3817 case VK_CANCEL:
3818 /* Windows maps Ctrl-Pause (aka Ctrl-Break) into VK_CANCEL,
3819 which is confusing for purposes of key binding; convert
3820 VK_CANCEL events into VK_PAUSE events. */
3821 wParam = VK_PAUSE;
3822 break;
3823 case VK_PAUSE:
3824 /* Windows maps Ctrl-NumLock into VK_PAUSE, which is confusing
3825 for purposes of key binding; convert these back into
3826 VK_NUMLOCK events, at least when we want to see NumLock key
3827 presses. (Note that there is never any possibility that
3828 VK_PAUSE with Ctrl really is C-Pause as per above.) */
3829 if (NILP (Vw32_enable_num_lock) && modifier_set (VK_CONTROL))
3830 wParam = VK_NUMLOCK;
3831 break;
ccc2d29c
GV		 3832 default:
3833 /* If not defined as a function key, change it to a WM_CHAR message. */
3834 if (lispy_function_keys[wParam] == 0)
3835 {
adcc3809
GV		 3836 DWORD modifiers = construct_console_modifiers ();
3837
ccc2d29c
GV		 3838 if (!NILP (Vw32_recognize_altgr)
3839 && modifier_set (VK_LCONTROL) && modifier_set (VK_RMENU))
3840 {
3841 /* Always let TranslateMessage handle AltGr key chords;
3842 for some reason, ToAscii doesn't always process AltGr
3843 chords correctly. */
3844 windows_translate = 1;
3845 }
adcc3809 3846 else if ((modifiers & (~SHIFT_PRESSED & ~CAPSLOCK_ON)) != 0)
ccc2d29c 3847 {
adcc3809
GV		 3848 /* Handle key chords including any modifiers other
3849 than shift directly, in order to preserve as much
3850 modifier information as possible. */
ccc2d29c
GV		 3851 if ('A' <= wParam && wParam <= 'Z')
3852 {
3853 /* Don't translate modified alphabetic keystrokes,
3854 so the user doesn't need to constantly switch
3855 layout to type control or meta keystrokes when
3856 the normal layout translates alphabetic
3857 characters to non-ascii characters. */
3858 if (!modifier_set (VK_SHIFT))
3859 wParam += ('a' - 'A');
3860 msg = WM_CHAR;
3861 }
3862 else
3863 {
3864 /* Try to handle other keystrokes by determining the
3865 base character (ie. translating the base key plus
3866 shift modifier). */
3867 int add;
3868 int isdead = 0;
3869 KEY_EVENT_RECORD key;
3870
3871 key.bKeyDown = TRUE;
3872 key.wRepeatCount = 1;
3873 key.wVirtualKeyCode = wParam;
3874 key.wVirtualScanCode = (lParam & 0xFF0000) >> 16;
3875 key.uChar.AsciiChar = 0;
adcc3809 3876 key.dwControlKeyState = modifiers;
ccc2d29c
GV		 3877
3878 add = w32_kbd_patch_key (&key);
3879 /* 0 means an unrecognised keycode, negative means
3880 dead key. Ignore both. */
3881 while (--add >= 0)
3882 {
3883 /* Forward asciified character sequence. */
3884 post_character_message
3885 (hwnd, WM_CHAR, key.uChar.AsciiChar, lParam,
3886 w32_get_key_modifiers (wParam, lParam));
3887 w32_kbd_patch_key (&key);
3888 }
3889 return 0;
3890 }
3891 }
3892 else
3893 {
3894 /* Let TranslateMessage handle everything else. */
3895 windows_translate = 1;
3896 }
3897 }
3898 }
a1a80b40 3899
adcc3809 3900 translate:
84fb1139
KH		 3901 if (windows_translate)
3902 {
e9e23e23 3903 MSG windows_msg = { hwnd, msg, wParam, lParam, 0, {0,0} };
84fb1139 3904
e9e23e23
GV		 3905 windows_msg.time = GetMessageTime ();
3906 TranslateMessage (&windows_msg);
84fb1139
KH		 3907 goto dflt;
3908 }
3909
ee78dc32
GV		 3910 /* Fall through */
3911
3912 case WM_SYSCHAR:
3913 case WM_CHAR:
ccc2d29c
GV		 3914 post_character_message (hwnd, msg, wParam, lParam,
3915 w32_get_key_modifiers (wParam, lParam));
ee78dc32 3916 break;
da36a4d6 3917
5ac45f98
GV		 3918 /* Simulate middle mouse button events when left and right buttons
3919 are used together, but only if user has two button mouse. */
ee78dc32 3920 case WM_LBUTTONDOWN:
5ac45f98 3921 case WM_RBUTTONDOWN:
fbd6baed 3922 if (XINT (Vw32_num_mouse_buttons) == 3)
5ac45f98
GV		 3923 goto handle_plain_button;
3924
3925 {
3926 int this = (msg == WM_LBUTTONDOWN) ? LMOUSE : RMOUSE;
3927 int other = (msg == WM_LBUTTONDOWN) ? RMOUSE : LMOUSE;
3928
3cb20f4a
RS		 3929 if (button_state & this)
3930 return 0;
5ac45f98
GV		 3931
3932 if (button_state == 0)
3933 SetCapture (hwnd);
3934
3935 button_state |= this;
3936
3937 if (button_state & other)
3938 {
84fb1139 3939 if (mouse_button_timer)
5ac45f98 3940 {
84fb1139
KH		 3941 KillTimer (hwnd, mouse_button_timer);
3942 mouse_button_timer = 0;
5ac45f98
GV		 3943
3944 /* Generate middle mouse event instead. */
3945 msg = WM_MBUTTONDOWN;
3946 button_state |= MMOUSE;
3947 }
3948 else if (button_state & MMOUSE)
3949 {
3950 /* Ignore button event if we've already generated a
3951 middle mouse down event. This happens if the
3952 user releases and press one of the two buttons
3953 after we've faked a middle mouse event. */
3954 return 0;
3955 }
3956 else
3957 {
3958 /* Flush out saved message. */
84fb1139 3959 post_msg (&saved_mouse_button_msg);
5ac45f98 3960 }
fbd6baed 3961 wmsg.dwModifiers = w32_get_modifiers ();
5ac45f98
GV		 3962 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3963
3964 /* Clear message buffer. */
84fb1139 3965 saved_mouse_button_msg.msg.hwnd = 0;
5ac45f98
GV		 3966 }
3967 else
3968 {
3969 /* Hold onto message for now. */
84fb1139 3970 mouse_button_timer =
adcc3809
GV		 3971 SetTimer (hwnd, MOUSE_BUTTON_ID,
3972 XINT (Vw32_mouse_button_tolerance), NULL);
84fb1139
KH		 3973 saved_mouse_button_msg.msg.hwnd = hwnd;
3974 saved_mouse_button_msg.msg.message = msg;
3975 saved_mouse_button_msg.msg.wParam = wParam;
3976 saved_mouse_button_msg.msg.lParam = lParam;
3977 saved_mouse_button_msg.msg.time = GetMessageTime ();
fbd6baed 3978 saved_mouse_button_msg.dwModifiers = w32_get_modifiers ();
5ac45f98
GV		 3979 }
3980 }
3981 return 0;
3982
ee78dc32 3983 case WM_LBUTTONUP:
5ac45f98 3984 case WM_RBUTTONUP:
fbd6baed 3985 if (XINT (Vw32_num_mouse_buttons) == 3)
5ac45f98
GV		 3986 goto handle_plain_button;
3987
3988 {
3989 int this = (msg == WM_LBUTTONUP) ? LMOUSE : RMOUSE;
3990 int other = (msg == WM_LBUTTONUP) ? RMOUSE : LMOUSE;
3991
3cb20f4a
RS		 3992 if ((button_state & this) == 0)
3993 return 0;
5ac45f98
GV		 3994
3995 button_state &= ~this;
3996
3997 if (button_state & MMOUSE)
3998 {
3999 /* Only generate event when second button is released. */
4000 if ((button_state & other) == 0)
4001 {
4002 msg = WM_MBUTTONUP;
4003 button_state &= ~MMOUSE;
4004
4005 if (button_state) abort ();
4006 }
4007 else
4008 return 0;
4009 }
4010 else
4011 {
4012 /* Flush out saved message if necessary. */
84fb1139 4013 if (saved_mouse_button_msg.msg.hwnd)
5ac45f98 4014 {
84fb1139 4015 post_msg (&saved_mouse_button_msg);
5ac45f98
GV		 4016 }
4017 }
fbd6baed 4018 wmsg.dwModifiers = w32_get_modifiers ();
5ac45f98
GV		 4019 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4020
4021 /* Always clear message buffer and cancel timer. */
84fb1139
KH		 4022 saved_mouse_button_msg.msg.hwnd = 0;
4023 KillTimer (hwnd, mouse_button_timer);
4024 mouse_button_timer = 0;
5ac45f98
GV		 4025
4026 if (button_state == 0)
4027 ReleaseCapture ();
4028 }
4029 return 0;
4030
ee78dc32
GV		 4031 case WM_MBUTTONDOWN:
4032 case WM_MBUTTONUP:
5ac45f98 4033 handle_plain_button:
ee78dc32
GV		 4034 {
4035 BOOL up;
1edf84e7 4036 int button;
ee78dc32 4037
1edf84e7 4038 if (parse_button (msg, &button, &up))
ee78dc32
GV		 4039 {
4040 if (up) ReleaseCapture ();
4041 else SetCapture (hwnd);
1edf84e7
GV		 4042 button = (button == 0) ? LMOUSE :
4043 ((button == 1) ? MMOUSE : RMOUSE);
4044 if (up)
4045 button_state &= ~button;
4046 else
4047 button_state |= button;
ee78dc32
GV		 4048 }
4049 }
4050
fbd6baed 4051 wmsg.dwModifiers = w32_get_modifiers ();
ee78dc32 4052 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
5ac45f98
GV		 4053 return 0;
4054
84fb1139 4055 case WM_VSCROLL:
5ac45f98 4056 case WM_MOUSEMOVE:
fbd6baed 4057 if (XINT (Vw32_mouse_move_interval) <= 0
84fb1139
KH		 4058 || (msg == WM_MOUSEMOVE && button_state == 0))
4059 {
fbd6baed 4060 wmsg.dwModifiers = w32_get_modifiers ();
84fb1139
KH		 4061 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4062 return 0;
4063 }
4064
4065 /* Hang onto mouse move and scroll messages for a bit, to avoid
4066 sending such events to Emacs faster than it can process them.
4067 If we get more events before the timer from the first message
4068 expires, we just replace the first message. */
4069
4070 if (saved_mouse_move_msg.msg.hwnd == 0)
4071 mouse_move_timer =
adcc3809
GV		 4072 SetTimer (hwnd, MOUSE_MOVE_ID,
4073 XINT (Vw32_mouse_move_interval), NULL);
84fb1139
KH		 4074
4075 /* Hold onto message for now. */
4076 saved_mouse_move_msg.msg.hwnd = hwnd;
4077 saved_mouse_move_msg.msg.message = msg;
4078 saved_mouse_move_msg.msg.wParam = wParam;
4079 saved_mouse_move_msg.msg.lParam = lParam;
4080 saved_mouse_move_msg.msg.time = GetMessageTime ();
fbd6baed 4081 saved_mouse_move_msg.dwModifiers = w32_get_modifiers ();
84fb1139
KH		 4082
4083 return 0;
4084
1edf84e7
GV		 4085 case WM_MOUSEWHEEL:
4086 wmsg.dwModifiers = w32_get_modifiers ();
4087 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4088 return 0;
4089
cb9e33d4
RS		 4090 case WM_DROPFILES:
4091 wmsg.dwModifiers = w32_get_modifiers ();
4092 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4093 return 0;
4094
84fb1139
KH		 4095 case WM_TIMER:
4096 /* Flush out saved messages if necessary. */
4097 if (wParam == mouse_button_timer)
5ac45f98 4098 {
84fb1139
KH		 4099 if (saved_mouse_button_msg.msg.hwnd)
4100 {
4101 post_msg (&saved_mouse_button_msg);
4102 saved_mouse_button_msg.msg.hwnd = 0;
4103 }
4104 KillTimer (hwnd, mouse_button_timer);
4105 mouse_button_timer = 0;
4106 }
4107 else if (wParam == mouse_move_timer)
4108 {
4109 if (saved_mouse_move_msg.msg.hwnd)
4110 {
4111 post_msg (&saved_mouse_move_msg);
4112 saved_mouse_move_msg.msg.hwnd = 0;
4113 }
4114 KillTimer (hwnd, mouse_move_timer);
4115 mouse_move_timer = 0;
5ac45f98 4116 }
5ac45f98 4117 return 0;
84fb1139
KH		 4118
4119 case WM_NCACTIVATE:
4120 /* Windows doesn't send us focus messages when putting up and
e9e23e23 4121 taking down a system popup dialog as for Ctrl-Alt-Del on Windows 95.
84fb1139
KH		 4122 The only indication we get that something happened is receiving
4123 this message afterwards. So this is a good time to reset our
4124 keyboard modifiers' state. */
4125 reset_modifiers ();
4126 goto dflt;
da36a4d6 4127
1edf84e7
GV		 4128 case WM_INITMENU:
4129 /* We must ensure menu bar is fully constructed and up to date
4130 before allowing user interaction with it. To achieve this
4131 we send this message to the lisp thread and wait for a
4132 reply (whose value is not actually needed) to indicate that
4133 the menu bar is now ready for use, so we can now return.
4134
4135 To remain responsive in the meantime, we enter a nested message
4136 loop that can process all other messages.
4137
4138 However, we skip all this if the message results from calling
4139 TrackPopupMenu - in fact, we must NOT attempt to send the lisp
4140 thread a message because it is blocked on us at this point. We
4141 set menubar_active before calling TrackPopupMenu to indicate
4142 this (there is no possibility of confusion with real menubar
4143 being active). */
4144
4145 f = x_window_to_frame (dpyinfo, hwnd);
4146 if (f
4147 && (f->output_data.w32->menubar_active
4148 /* We can receive this message even in the absence of a
4149 menubar (ie. when the system menu is activated) - in this
4150 case we do NOT want to forward the message, otherwise it
4151 will cause the menubar to suddenly appear when the user
4152 had requested it to be turned off! */
4153 || f->output_data.w32->menubar_widget == NULL))
4154 return 0;
4155
4156 {
4157 deferred_msg msg_buf;
4158
4159 /* Detect if message has already been deferred; in this case
4160 we cannot return any sensible value to ignore this. */
4161 if (find_deferred_msg (hwnd, msg) != NULL)
4162 abort ();
4163
4164 return send_deferred_msg (&msg_buf, hwnd, msg, wParam, lParam);
4165 }
4166
4167 case WM_EXITMENULOOP:
4168 f = x_window_to_frame (dpyinfo, hwnd);
4169
4170 /* Indicate that menubar can be modified again. */
4171 if (f)
4172 f->output_data.w32->menubar_active = 0;
4173 goto dflt;
4174
87996783
GV		 4175 case WM_MEASUREITEM:
4176 f = x_window_to_frame (dpyinfo, hwnd);
4177 if (f)
4178 {
4179 MEASUREITEMSTRUCT * pMis = (MEASUREITEMSTRUCT *) lParam;
4180
4181 if (pMis->CtlType == ODT_MENU)
4182 {
4183 /* Work out dimensions for popup menu titles. */
4184 char * title = (char *) pMis->itemData;
4185 HDC hdc = GetDC (hwnd);
4186 HFONT menu_font = GetCurrentObject (hdc, OBJ_FONT);
4187 LOGFONT menu_logfont;
4188 HFONT old_font;
4189 SIZE size;
4190
4191 GetObject (menu_font, sizeof (menu_logfont), &menu_logfont);
4192 menu_logfont.lfWeight = FW_BOLD;
4193 menu_font = CreateFontIndirect (&menu_logfont);
4194 old_font = SelectObject (hdc, menu_font);
4195
4196 GetTextExtentPoint32 (hdc, title, strlen (title), &size);
4197 pMis->itemWidth = size.cx;
4198 pMis->itemHeight = GetSystemMetrics (SM_CYMENUSIZE);
4199 if (pMis->itemHeight < size.cy)
4200 pMis->itemHeight = size.cy;
4201
4202 SelectObject (hdc, old_font);
4203 DeleteObject (menu_font);
4204 ReleaseDC (hwnd, hdc);
4205 return TRUE;
4206 }
4207 }
4208 return 0;
4209
4210 case WM_DRAWITEM:
4211 f = x_window_to_frame (dpyinfo, hwnd);
4212 if (f)
4213 {
4214 DRAWITEMSTRUCT * pDis = (DRAWITEMSTRUCT *) lParam;
4215
4216 if (pDis->CtlType == ODT_MENU)
4217 {
4218 /* Draw popup menu title. */
4219 char * title = (char *) pDis->itemData;
4220 HDC hdc = pDis->hDC;
4221 HFONT menu_font = GetCurrentObject (hdc, OBJ_FONT);
4222 LOGFONT menu_logfont;
4223 HFONT old_font;
4224
4225 GetObject (menu_font, sizeof (menu_logfont), &menu_logfont);
4226 menu_logfont.lfWeight = FW_BOLD;
4227 menu_font = CreateFontIndirect (&menu_logfont);
4228 old_font = SelectObject (hdc, menu_font);
4229
4230 /* Always draw title as if not selected. */
4231 ExtTextOut (hdc,
4232 pDis->rcItem.left + GetSystemMetrics (SM_CXMENUCHECK),
4233 pDis->rcItem.top,
4234 ETO_OPAQUE, &pDis->rcItem,
4235 title, strlen (title), NULL);
4236
4237 SelectObject (hdc, old_font);
4238 DeleteObject (menu_font);
4239 return TRUE;
4240 }
4241 }
4242 return 0;
4243
1edf84e7
GV		 4244#if 0
4245 /* Still not right - can't distinguish between clicks in the
4246 client area of the frame from clicks forwarded from the scroll
4247 bars - may have to hook WM_NCHITTEST to remember the mouse
4248 position and then check if it is in the client area ourselves. */
4249 case WM_MOUSEACTIVATE:
4250 /* Discard the mouse click that activates a frame, allowing the
4251 user to click anywhere without changing point (or worse!).
4252 Don't eat mouse clicks on scrollbars though!! */
4253 if (LOWORD (lParam) == HTCLIENT )
4254 return MA_ACTIVATEANDEAT;
4255 goto dflt;
4256#endif
4257
1edf84e7 4258 case WM_ACTIVATEAPP:
ccc2d29c 4259 case WM_ACTIVATE:
1edf84e7
GV		 4260 case WM_WINDOWPOSCHANGED:
4261 case WM_SHOWWINDOW:
4262 /* Inform lisp thread that a frame might have just been obscured
4263 or exposed, so should recheck visibility of all frames. */
4264 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4265 goto dflt;
4266
da36a4d6 4267 case WM_SETFOCUS:
adcc3809
GV		 4268 dpyinfo->faked_key = 0;
4269 reset_modifiers ();
ccc2d29c
GV		 4270 register_hot_keys (hwnd);
4271 goto command;
8681157a 4272 case WM_KILLFOCUS:
ccc2d29c 4273 unregister_hot_keys (hwnd);
ee78dc32
GV		 4274 case WM_MOVE:
4275 case WM_SIZE:
ee78dc32 4276 case WM_COMMAND:
ccc2d29c 4277 command:
fbd6baed 4278 wmsg.dwModifiers = w32_get_modifiers ();
ee78dc32
GV		 4279 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4280 goto dflt;
8847d890
RS		 4281
4282 case WM_CLOSE:
fbd6baed 4283 wmsg.dwModifiers = w32_get_modifiers ();
8847d890
RS		 4284 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4285 return 0;
4286
ee78dc32
GV		 4287 case WM_WINDOWPOSCHANGING:
4288 {
4289 WINDOWPLACEMENT wp;
4290 LPWINDOWPOS lppos = (WINDOWPOS *) lParam;
1edf84e7
GV		 4291
4292 wp.length = sizeof (WINDOWPLACEMENT);
ee78dc32
GV		 4293 GetWindowPlacement (hwnd, &wp);
4294
1edf84e7 4295 if (wp.showCmd != SW_SHOWMINIMIZED && (lppos->flags & SWP_NOSIZE) == 0)
ee78dc32
GV		 4296 {
4297 RECT rect;
4298 int wdiff;
4299 int hdiff;
1edf84e7
GV		 4300 DWORD font_width;
4301 DWORD line_height;
4302 DWORD internal_border;
4303 DWORD scrollbar_extra;
ee78dc32
GV		 4304 RECT wr;
4305
5ac45f98 4306 wp.length = sizeof(wp);
ee78dc32
GV		 4307 GetWindowRect (hwnd, &wr);
4308
3c190163 4309 enter_crit ();
ee78dc32 4310
1edf84e7
GV		 4311 font_width = GetWindowLong (hwnd, WND_FONTWIDTH_INDEX);
4312 line_height = GetWindowLong (hwnd, WND_LINEHEIGHT_INDEX);
4313 internal_border = GetWindowLong (hwnd, WND_BORDER_INDEX);
4314 scrollbar_extra = GetWindowLong (hwnd, WND_SCROLLBAR_INDEX);
ee78dc32 4315
3c190163 4316 leave_crit ();
ee78dc32
GV		 4317
4318 memset (&rect, 0, sizeof (rect));
4319 AdjustWindowRect (&rect, GetWindowLong (hwnd, GWL_STYLE),
4320 GetMenu (hwnd) != NULL);
4321
1edf84e7
GV		 4322 /* Force width and height of client area to be exact
4323 multiples of the character cell dimensions. */
4324 wdiff = (lppos->cx - (rect.right - rect.left)
4325 - 2 * internal_border - scrollbar_extra)
4326 % font_width;
4327 hdiff = (lppos->cy - (rect.bottom - rect.top)
4328 - 2 * internal_border)
4329 % line_height;
ee78dc32
GV		 4330
4331 if (wdiff || hdiff)
4332 {
4333 /* For right/bottom sizing we can just fix the sizes.
4334 However for top/left sizing we will need to fix the X
4335 and Y positions as well. */
4336
4337 lppos->cx -= wdiff;
4338 lppos->cy -= hdiff;
4339
4340 if (wp.showCmd != SW_SHOWMAXIMIZED
1edf84e7 4341 && (lppos->flags & SWP_NOMOVE) == 0)
ee78dc32
GV		 4342 {
4343 if (lppos->x != wr.left || lppos->y != wr.top)
4344 {
4345 lppos->x += wdiff;
4346 lppos->y += hdiff;
4347 }
4348 else
4349 {
4350 lppos->flags |= SWP_NOMOVE;
4351 }
4352 }
4353
1edf84e7 4354 return 0;
ee78dc32
GV		 4355 }
4356 }
4357 }
ee78dc32
GV		 4358
4359 goto dflt;
1edf84e7
GV		 4360
4361 case WM_EMACS_CREATESCROLLBAR:
4362 return (LRESULT) w32_createscrollbar ((struct frame *) wParam,
4363 (struct scroll_bar *) lParam);
4364
5ac45f98 4365 case WM_EMACS_SHOWWINDOW:
1edf84e7
GV		 4366 return ShowWindow ((HWND) wParam, (WPARAM) lParam);
4367
dfdb4047
GV		 4368 case WM_EMACS_SETFOREGROUND:
4369 return SetForegroundWindow ((HWND) wParam);
4370
5ac45f98
GV		 4371 case WM_EMACS_SETWINDOWPOS:
4372 {
1edf84e7
GV		 4373 WINDOWPOS * pos = (WINDOWPOS *) wParam;
4374 return SetWindowPos (hwnd, pos->hwndInsertAfter,
5ac45f98
GV		 4375 pos->x, pos->y, pos->cx, pos->cy, pos->flags);
4376 }
1edf84e7 4377
ee78dc32 4378 case WM_EMACS_DESTROYWINDOW:
cb9e33d4 4379 DragAcceptFiles ((HWND) wParam, FALSE);
1edf84e7
GV		 4380 return DestroyWindow ((HWND) wParam);
4381
4382 case WM_EMACS_TRACKPOPUPMENU:
4383 {
4384 UINT flags;
4385 POINT *pos;
4386 int retval;
4387 pos = (POINT *)lParam;
4388 flags = TPM_CENTERALIGN;
4389 if (button_state & LMOUSE)
4390 flags |= TPM_LEFTBUTTON;
4391 else if (button_state & RMOUSE)
4392 flags |= TPM_RIGHTBUTTON;
4393
87996783
GV		 4394 /* Remember we did a SetCapture on the initial mouse down event,
4395 so for safety, we make sure the capture is cancelled now. */
4396 ReleaseCapture ();
490822ff 4397 button_state = 0;
87996783 4398
1edf84e7
GV		 4399 /* Use menubar_active to indicate that WM_INITMENU is from
4400 TrackPopupMenu below, and should be ignored. */
4401 f = x_window_to_frame (dpyinfo, hwnd);
4402 if (f)
4403 f->output_data.w32->menubar_active = 1;
4404
4405 if (TrackPopupMenu ((HMENU)wParam, flags, pos->x, pos->y,
4406 0, hwnd, NULL))
4407 {
4408 MSG amsg;
4409 /* Eat any mouse messages during popupmenu */
4410 while (PeekMessage (&amsg, hwnd, WM_MOUSEFIRST, WM_MOUSELAST,
4411 PM_REMOVE));
4412 /* Get the menu selection, if any */
4413 if (PeekMessage (&amsg, hwnd, WM_COMMAND, WM_COMMAND, PM_REMOVE))
4414 {
4415 retval = LOWORD (amsg.wParam);
4416 }
4417 else
4418 {
4419 retval = 0;
4420 }
1edf84e7
GV		 4421 }
4422 else
4423 {
4424 retval = -1;
4425 }
4426
4427 return retval;
4428 }
4429
ee78dc32 4430 default:
93fbe8b7
GV		 4431 /* Check for messages registered at runtime. */
4432 if (msg == msh_mousewheel)
4433 {
4434 wmsg.dwModifiers = w32_get_modifiers ();
4435 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4436 return 0;
4437 }
4438
ee78dc32
GV		 4439 dflt:
4440 return DefWindowProc (hwnd, msg, wParam, lParam);
4441 }
4442
1edf84e7
GV		 4443
4444 /* The most common default return code for handled messages is 0. */
4445 return 0;
ee78dc32
GV		 4446}
4447
4448void
4449my_create_window (f)
4450 struct frame * f;
4451{
4452 MSG msg;
4453
1edf84e7
GV		 4454 if (!PostThreadMessage (dwWindowsThreadId, WM_EMACS_CREATEWINDOW, (WPARAM)f, 0))
4455 abort ();
ee78dc32
GV		 4456 GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
4457}
4458
fbd6baed 4459/* Create and set up the w32 window for frame F. */
ee78dc32
GV		 4460
4461static void
fbd6baed 4462w32_window (f, window_prompting, minibuffer_only)
ee78dc32
GV		 4463 struct frame *f;
4464 long window_prompting;
4465 int minibuffer_only;
4466{
4467 BLOCK_INPUT;
4468
4469 /* Use the resource name as the top-level window name
4470 for looking up resources. Make a non-Lisp copy
4471 for the window manager, so GC relocation won't bother it.
4472
4473 Elsewhere we specify the window name for the window manager. */
4474
4475 {
4476 char *str = (char *) XSTRING (Vx_resource_name)->data;
4477 f->namebuf = (char *) xmalloc (strlen (str) + 1);
4478 strcpy (f->namebuf, str);
4479 }
4480
4481 my_create_window (f);
4482
4483 validate_x_resource_name ();
4484
4485 /* x_set_name normally ignores requests to set the name if the
4486 requested name is the same as the current name. This is the one
4487 place where that assumption isn't correct; f->name is set, but
4488 the server hasn't been told. */
4489 {
4490 Lisp_Object name;
4491 int explicit = f->explicit_name;
4492
4493 f->explicit_name = 0;
4494 name = f->name;
4495 f->name = Qnil;
4496 x_set_name (f, name, explicit);
4497 }
4498
4499 UNBLOCK_INPUT;
4500
4501 if (!minibuffer_only && FRAME_EXTERNAL_MENU_BAR (f))
4502 initialize_frame_menubar (f);
4503
fbd6baed 4504 if (FRAME_W32_WINDOW (f) == 0)
ee78dc32
GV		 4505 error ("Unable to create window");
4506}
4507
4508/* Handle the icon stuff for this window. Perhaps later we might
4509 want an x_set_icon_position which can be called interactively as
4510 well. */
4511
4512static void
4513x_icon (f, parms)
4514 struct frame *f;
4515 Lisp_Object parms;
4516{
4517 Lisp_Object icon_x, icon_y;
4518
e9e23e23 4519 /* Set the position of the icon. Note that Windows 95 groups all
ee78dc32
GV		 4520 icons in the tray. */
4521 icon_x = x_get_arg (parms, Qicon_left, 0, 0, number);
4522 icon_y = x_get_arg (parms, Qicon_top, 0, 0, number);
4523 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
4524 {
4525 CHECK_NUMBER (icon_x, 0);
4526 CHECK_NUMBER (icon_y, 0);
4527 }
4528 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
4529 error ("Both left and top icon corners of icon must be specified");
4530
4531 BLOCK_INPUT;
4532
4533 if (! EQ (icon_x, Qunbound))
4534 x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y));
4535
1edf84e7
GV		 4536#if 0 /* TODO */
4537 /* Start up iconic or window? */
4538 x_wm_set_window_state
4539 (f, (EQ (x_get_arg (parms, Qvisibility, 0, 0, symbol), Qicon)
4540 ? IconicState
4541 : NormalState));
4542
4543 x_text_icon (f, (char *) XSTRING ((!NILP (f->icon_name)
4544 ? f->icon_name
4545 : f->name))->data);
4546#endif
4547
ee78dc32
GV		 4548 UNBLOCK_INPUT;
4549}
4550
4551DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
4552 1, 1, 0,
4553 "Make a new window, which is called a \"frame\" in Emacs terms.\n\
4554Returns an Emacs frame object.\n\
4555ALIST is an alist of frame parameters.\n\
4556If the parameters specify that the frame should not have a minibuffer,\n\
4557and do not specify a specific minibuffer window to use,\n\
4558then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
4559be shared by the new frame.\n\
4560\n\
4561This function is an internal primitive--use `make-frame' instead.")
4562 (parms)
4563 Lisp_Object parms;
4564{
4565 struct frame *f;
4566 Lisp_Object frame, tem;
4567 Lisp_Object name;
4568 int minibuffer_only = 0;
4569 long window_prompting = 0;
4570 int width, height;
4571 int count = specpdl_ptr - specpdl;
1edf84e7 4572 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
ee78dc32 4573 Lisp_Object display;
fbd6baed 4574 struct w32_display_info *dpyinfo;
ee78dc32
GV		 4575 Lisp_Object parent;
4576 struct kboard *kb;
4577
4587b026
GV		 4578 check_w32 ();
4579
ee78dc32
GV		 4580 /* Use this general default value to start with
4581 until we know if this frame has a specified name. */
4582 Vx_resource_name = Vinvocation_name;
4583
4584 display = x_get_arg (parms, Qdisplay, 0, 0, string);
4585 if (EQ (display, Qunbound))
4586 display = Qnil;
4587 dpyinfo = check_x_display_info (display);
4588#ifdef MULTI_KBOARD
4589 kb = dpyinfo->kboard;
4590#else
4591 kb = &the_only_kboard;
4592#endif
4593
1edf84e7 4594 name = x_get_arg (parms, Qname, "name", "Name", string);
ee78dc32
GV		 4595 if (!STRINGP (name)
4596 && ! EQ (name, Qunbound)
4597 && ! NILP (name))
4598 error ("Invalid frame name--not a string or nil");
4599
4600 if (STRINGP (name))
4601 Vx_resource_name = name;
4602
4603 /* See if parent window is specified. */
4604 parent = x_get_arg (parms, Qparent_id, NULL, NULL, number);
4605 if (EQ (parent, Qunbound))
4606 parent = Qnil;
4607 if (! NILP (parent))
4608 CHECK_NUMBER (parent, 0);
4609
1edf84e7
GV		 4610 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
4611 /* No need to protect DISPLAY because that's not used after passing
4612 it to make_frame_without_minibuffer. */
4613 frame = Qnil;
4614 GCPRO4 (parms, parent, name, frame);
ee78dc32
GV		 4615 tem = x_get_arg (parms, Qminibuffer, 0, 0, symbol);
4616 if (EQ (tem, Qnone) || NILP (tem))
4617 f = make_frame_without_minibuffer (Qnil, kb, display);
4618 else if (EQ (tem, Qonly))
4619 {
4620 f = make_minibuffer_frame ();
4621 minibuffer_only = 1;
4622 }
4623 else if (WINDOWP (tem))
4624 f = make_frame_without_minibuffer (tem, kb, display);
4625 else
4626 f = make_frame (1);
4627
1edf84e7
GV		 4628 XSETFRAME (frame, f);
4629
ee78dc32
GV		 4630 /* Note that Windows does support scroll bars. */
4631 FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
5ac45f98
GV		 4632 /* By default, make scrollbars the system standard width. */
4633 f->scroll_bar_pixel_width = GetSystemMetrics (SM_CXVSCROLL);
ee78dc32 4634
fbd6baed
GV		 4635 f->output_method = output_w32;
4636 f->output_data.w32 = (struct w32_output *) xmalloc (sizeof (struct w32_output));
4637 bzero (f->output_data.w32, sizeof (struct w32_output));
ee78dc32 4638
4587b026
GV		 4639 FRAME_FONTSET (f) = -1;
4640
1edf84e7
GV		 4641 f->icon_name
4642 = x_get_arg (parms, Qicon_name, "iconName", "Title", string);
4643 if (! STRINGP (f->icon_name))
4644 f->icon_name = Qnil;
4645
fbd6baed 4646/* FRAME_W32_DISPLAY_INFO (f) = dpyinfo; */
ee78dc32
GV		 4647#ifdef MULTI_KBOARD
4648 FRAME_KBOARD (f) = kb;
4649#endif
4650
4651 /* Specify the parent under which to make this window. */
4652
4653 if (!NILP (parent))
4654 {
fbd6baed
GV		 4655 f->output_data.w32->parent_desc = (Window) parent;
4656 f->output_data.w32->explicit_parent = 1;
ee78dc32
GV		 4657 }
4658 else
4659 {
fbd6baed
GV		 4660 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
4661 f->output_data.w32->explicit_parent = 0;
ee78dc32
GV		 4662 }
4663
4664 /* Note that the frame has no physical cursor right now. */
4665 f->phys_cursor_x = -1;
4666
4667 /* Set the name; the functions to which we pass f expect the name to
4668 be set. */
4669 if (EQ (name, Qunbound) || NILP (name))
4670 {
fbd6baed 4671 f->name = build_string (dpyinfo->w32_id_name);
ee78dc32
GV		 4672 f->explicit_name = 0;
4673 }
4674 else
4675 {
4676 f->name = name;
4677 f->explicit_name = 1;
4678 /* use the frame's title when getting resources for this frame. */
4679 specbind (Qx_resource_name, name);
4680 }
4681
4587b026
GV		 4682 /* Create fontsets from `global_fontset_alist' before handling fonts. */
4683 for (tem = Vglobal_fontset_alist; CONSP (tem); tem = XCONS (tem)->cdr)
4684 fs_register_fontset (f, XCONS (tem)->car);
4685
ee78dc32
GV		 4686 /* Extract the window parameters from the supplied values
4687 that are needed to determine window geometry. */
4688 {
4689 Lisp_Object font;
4690
4691 font = x_get_arg (parms, Qfont, "font", "Font", string);
4692 BLOCK_INPUT;
4693 /* First, try whatever font the caller has specified. */
4694 if (STRINGP (font))
4587b026
GV		 4695 {
4696 tem = Fquery_fontset (font, Qnil);
4697 if (STRINGP (tem))
4698 font = x_new_fontset (f, XSTRING (tem)->data);
4699 else
ee78dc32 4700 font = x_new_font (f, XSTRING (font)->data);
4587b026 4701 }
ee78dc32
GV		 4702 /* Try out a font which we hope has bold and italic variations. */
4703 if (!STRINGP (font))
4587b026 4704 font = x_new_font (f, "-*-Courier New-normal-r-*-*-13-*-*-*-c-*-iso8859-1");
ee78dc32 4705 if (! STRINGP (font))
4587b026 4706 font = x_new_font (f, "-*-Courier-normal-r-*-*-*-97-*-*-c-*-iso8859-1");
ee78dc32
GV		 4707 /* If those didn't work, look for something which will at least work. */
4708 if (! STRINGP (font))
4587b026 4709 font = x_new_font (f, "-*-Fixedsys-normal-r-*-*-*-*-90-*-c-*-iso8859-1");
ee78dc32
GV		 4710 UNBLOCK_INPUT;
4711 if (! STRINGP (font))
1edf84e7 4712 font = build_string ("Fixedsys");
ee78dc32
GV		 4713
4714 x_default_parameter (f, parms, Qfont, font,
4715 "font", "Font", string);
4716 }
4717
4718 x_default_parameter (f, parms, Qborder_width, make_number (2),
4719 "borderwidth", "BorderWidth", number);
4720 /* This defaults to 2 in order to match xterm. We recognize either
4721 internalBorderWidth or internalBorder (which is what xterm calls
4722 it). */
4723 if (NILP (Fassq (Qinternal_border_width, parms)))
4724 {
4725 Lisp_Object value;
4726
4727 value = x_get_arg (parms, Qinternal_border_width,
4728 "internalBorder", "BorderWidth", number);
4729 if (! EQ (value, Qunbound))
4730 parms = Fcons (Fcons (Qinternal_border_width, value),
4731 parms);
4732 }
1edf84e7 4733 /* Default internalBorderWidth to 0 on Windows to match other programs. */
ee78dc32
GV		 4734 x_default_parameter (f, parms, Qinternal_border_width, make_number (0),
4735 "internalBorderWidth", "BorderWidth", number);
4736 x_default_parameter (f, parms, Qvertical_scroll_bars, Qt,
4737 "verticalScrollBars", "ScrollBars", boolean);
4738
4739 /* Also do the stuff which must be set before the window exists. */
4740 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
4741 "foreground", "Foreground", string);
4742 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
4743 "background", "Background", string);
4744 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
4745 "pointerColor", "Foreground", string);
4746 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
4747 "cursorColor", "Foreground", string);
4748 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
4749 "borderColor", "BorderColor", string);
4750
4751 x_default_parameter (f, parms, Qmenu_bar_lines, make_number (1),
4752 "menuBar", "MenuBar", number);
4753 x_default_parameter (f, parms, Qscroll_bar_width, Qnil,
4754 "scrollBarWidth", "ScrollBarWidth", number);
1edf84e7
GV		 4755 x_default_parameter (f, parms, Qbuffer_predicate, Qnil,
4756 "bufferPredicate", "BufferPredicate", symbol);
4757 x_default_parameter (f, parms, Qtitle, Qnil,
4758 "title", "Title", string);
ee78dc32 4759
fbd6baed
GV		 4760 f->output_data.w32->dwStyle = WS_OVERLAPPEDWINDOW;
4761 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
ee78dc32
GV		 4762 window_prompting = x_figure_window_size (f, parms);
4763
4764 if (window_prompting & XNegative)
4765 {
4766 if (window_prompting & YNegative)
fbd6baed 4767 f->output_data.w32->win_gravity = SouthEastGravity;
ee78dc32 4768 else
fbd6baed 4769 f->output_data.w32->win_gravity = NorthEastGravity;
ee78dc32
GV		 4770 }
4771 else
4772 {
4773 if (window_prompting & YNegative)
fbd6baed 4774 f->output_data.w32->win_gravity = SouthWestGravity;
ee78dc32 4775 else
fbd6baed 4776 f->output_data.w32->win_gravity = NorthWestGravity;
ee78dc32
GV		 4777 }
4778
fbd6baed 4779 f->output_data.w32->size_hint_flags = window_prompting;
ee78dc32 4780
fbd6baed 4781 w32_window (f, window_prompting, minibuffer_only);
ee78dc32
GV		 4782 x_icon (f, parms);
4783 init_frame_faces (f);
4784
4785 /* We need to do this after creating the window, so that the
4786 icon-creation functions can say whose icon they're describing. */
4787 x_default_parameter (f, parms, Qicon_type, Qnil,
4788 "bitmapIcon", "BitmapIcon", symbol);
4789
4790 x_default_parameter (f, parms, Qauto_raise, Qnil,
4791 "autoRaise", "AutoRaiseLower", boolean);
4792 x_default_parameter (f, parms, Qauto_lower, Qnil,
4793 "autoLower", "AutoRaiseLower", boolean);
4794 x_default_parameter (f, parms, Qcursor_type, Qbox,
4795 "cursorType", "CursorType", symbol);
4796
4797 /* Dimensions, especially f->height, must be done via change_frame_size.
4798 Change will not be effected unless different from the current
4799 f->height. */
4800 width = f->width;
4801 height = f->height;
1026b400
RS		 4802 f->height = 0;
4803 SET_FRAME_WIDTH (f, 0);
ee78dc32
GV		 4804 change_frame_size (f, height, width, 1, 0);
4805
4806 /* Tell the server what size and position, etc, we want,
4807 and how badly we want them. */
4808 BLOCK_INPUT;
4809 x_wm_set_size_hint (f, window_prompting, 0);
4810 UNBLOCK_INPUT;
4811
4812 tem = x_get_arg (parms, Qunsplittable, 0, 0, boolean);
4813 f->no_split = minibuffer_only || EQ (tem, Qt);
4814
4815 UNGCPRO;
4816
4817 /* It is now ok to make the frame official
4818 even if we get an error below.
4819 And the frame needs to be on Vframe_list
4820 or making it visible won't work. */
4821 Vframe_list = Fcons (frame, Vframe_list);
4822
4823 /* Now that the frame is official, it counts as a reference to
4824 its display. */
fbd6baed 4825 FRAME_W32_DISPLAY_INFO (f)->reference_count++;
ee78dc32
GV		 4826
4827 /* Make the window appear on the frame and enable display,
4828 unless the caller says not to. However, with explicit parent,
4829 Emacs cannot control visibility, so don't try. */
fbd6baed 4830 if (! f->output_data.w32->explicit_parent)
ee78dc32
GV		 4831 {
4832 Lisp_Object visibility;
4833
4834 visibility = x_get_arg (parms, Qvisibility, 0, 0, symbol);
4835 if (EQ (visibility, Qunbound))
4836 visibility = Qt;
4837
4838 if (EQ (visibility, Qicon))
4839 x_iconify_frame (f);
4840 else if (! NILP (visibility))
4841 x_make_frame_visible (f);
4842 else
4843 /* Must have been Qnil. */
4844 ;
4845 }
4846
4847 return unbind_to (count, frame);
4848}
4849
4850/* FRAME is used only to get a handle on the X display. We don't pass the
4851 display info directly because we're called from frame.c, which doesn't
4852 know about that structure. */
4853Lisp_Object
4854x_get_focus_frame (frame)
4855 struct frame *frame;
4856{
fbd6baed 4857 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (frame);
ee78dc32 4858 Lisp_Object xfocus;
fbd6baed 4859 if (! dpyinfo->w32_focus_frame)
ee78dc32
GV		 4860 return Qnil;
4861
fbd6baed 4862 XSETFRAME (xfocus, dpyinfo->w32_focus_frame);
ee78dc32
GV		 4863 return xfocus;
4864}
1edf84e7
GV		 4865
4866DEFUN ("w32-focus-frame", Fw32_focus_frame, Sw32_focus_frame, 1, 1, 0,
4867 "Give FRAME input focus, raising to foreground if necessary.")
4868 (frame)
4869 Lisp_Object frame;
4870{
4871 x_focus_on_frame (check_x_frame (frame));
4872 return Qnil;
4873}
4874
ee78dc32 4875\f
4587b026
GV		 4876/* Load font named FONTNAME of size SIZE for frame F, and return a
4877 pointer to the structure font_info while allocating it dynamically.
4878 If loading fails, return NULL. */
4879struct font_info *
4880w32_load_font (f,fontname,size)
4881struct frame *f;
4882char * fontname;
4883int size;
ee78dc32 4884{
4587b026
GV		 4885 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
4886 Lisp_Object font_names;
4887
4888#if 0 /* x_load_font attempts to get a list of fonts - presumably to
4889 allow a fuzzier fontname to be specified. w32_list_fonts
4890 appears to be a bit too fuzzy for this purpose. */
5ac45f98 4891
4587b026
GV		 4892 /* Get a list of all the fonts that match this name. Once we
4893 have a list of matching fonts, we compare them against the fonts
4894 we already have loaded by comparing names. */
4895 font_names = w32_list_fonts (f, build_string (fontname), size, 100);
4896
4897 if (!NILP (font_names))
3c190163 4898 {
4587b026
GV		 4899 Lisp_Object tail;
4900 int i;
4901
4902#if 0 /* This code has nasty side effects that cause Emacs to crash. */
4903
4904 /* First check if any are already loaded, as that is cheaper
4905 than loading another one. */
4906 for (i = 0; i < dpyinfo->n_fonts; i++)
4907 for (tail = font_names; CONSP (tail); tail = XCONS (tail)->cdr)
4908 if (!strcmp (dpyinfo->font_table[i].name,
4909 XSTRING (XCONS (tail)->car)->data)
4910 || !strcmp (dpyinfo->font_table[i].full_name,
4911 XSTRING (XCONS (tail)->car)->data))
4912 return (dpyinfo->font_table + i);
4913#endif
4914
4915 fontname = (char *) XSTRING (XCONS (font_names)->car)->data;
4916 }
4917 else
4918 return NULL;
4919#endif
4920
4921 /* Load the font and add it to the table. */
4922 {
4923 char *full_name;
4924 XFontStruct *font;
4925 struct font_info *fontp;
3c190163 4926 LOGFONT lf;
4587b026 4927 BOOL ok;
5ac45f98 4928
4587b026 4929 if (!fontname || !x_to_w32_font (fontname, &lf))
3c190163 4930 return (NULL);
5ac45f98 4931
4587b026
GV		 4932 if (!*lf.lfFaceName)
4933 /* If no name was specified for the font, we get a random font
4934 from CreateFontIndirect - this is not particularly
4935 desirable, especially since CreateFontIndirect does not
4936 fill out the missing name in lf, so we never know what we
4937 ended up with. */
4938 return NULL;
4939
3c190163 4940 font = (XFontStruct *) xmalloc (sizeof (XFontStruct));
5ac45f98 4941
3c190163 4942 if (!font) return (NULL);
5ac45f98 4943
3c190163 4944 BLOCK_INPUT;
5ac45f98
GV		 4945
4946 font->hfont = CreateFontIndirect (&lf);
ee78dc32 4947
1a292d24
AI		 4948 if (font->hfont == NULL)
4949 {
4950 ok = FALSE;
4951 }
4952 else
4953 {
4954 HDC hdc;
4955 HANDLE oldobj;
4956
4957 hdc = GetDC (dpyinfo->root_window);
4958 oldobj = SelectObject (hdc, font->hfont);
4959 ok = GetTextMetrics (hdc, &font->tm);
4960 SelectObject (hdc, oldobj);
4961 ReleaseDC (dpyinfo->root_window, hdc);
4962 }
5ac45f98 4963
1a292d24 4964 UNBLOCK_INPUT;
5ac45f98 4965
4587b026
GV		 4966 if (!ok)
4967 {
1a292d24
AI		 4968 w32_unload_font (dpyinfo, font);
4969 return (NULL);
4970 }
ee78dc32 4971
4587b026
GV		 4972 /* Do we need to create the table? */
4973 if (dpyinfo->font_table_size == 0)
4974 {
4975 dpyinfo->font_table_size = 16;
4976 dpyinfo->font_table
4977 = (struct font_info *) xmalloc (dpyinfo->font_table_size
4978 * sizeof (struct font_info));
4979 }
4980 /* Do we need to grow the table? */
4981 else if (dpyinfo->n_fonts
4982 >= dpyinfo->font_table_size)
4983 {
4984 dpyinfo->font_table_size *= 2;
4985 dpyinfo->font_table
4986 = (struct font_info *) xrealloc (dpyinfo->font_table,
4987 (dpyinfo->font_table_size
4988 * sizeof (struct font_info)));
4989 }
4990
4991 fontp = dpyinfo->font_table + dpyinfo->n_fonts;
4992
4993 /* Now fill in the slots of *FONTP. */
4994 BLOCK_INPUT;
4995 fontp->font = font;
4996 fontp->font_idx = dpyinfo->n_fonts;
4997 fontp->name = (char *) xmalloc (strlen (fontname) + 1);
4998 bcopy (fontname, fontp->name, strlen (fontname) + 1);
4999
5000 /* Work out the font's full name. */
5001 full_name = (char *)xmalloc (100);
5002 if (full_name && w32_to_x_font (&lf, full_name, 100))
5003 fontp->full_name = full_name;
5004 else
5005 {
5006 /* If all else fails - just use the name we used to load it. */
5007 xfree (full_name);
5008 fontp->full_name = fontp->name;
5009 }
5010
5011 fontp->size = FONT_WIDTH (font);
5012 fontp->height = FONT_HEIGHT (font);
5013
5014 /* The slot `encoding' specifies how to map a character
5015 code-points (0x20..0x7F or 0x2020..0x7F7F) of each charset to
5016 the font code-points (0:0x20..0x7F, 1:0xA0..0xFF, 0:0x2020..0x7F7F,
5017 the font code-points (0:0x20..0x7F, 1:0xA0..0xFF,
5018 0:0x2020..0x7F7F, 1:0xA0A0..0xFFFF, 3:0x20A0..0x7FFF, or
5019 2:0xA020..0xFF7F). For the moment, we don't know which charset
5020 uses this font. So, we set informatoin in fontp->encoding[1]
5021 which is never used by any charset. If mapping can't be
5022 decided, set FONT_ENCODING_NOT_DECIDED. */
5023 fontp->encoding[1] = FONT_ENCODING_NOT_DECIDED;
5024
5025 /* The following three values are set to 0 under W32, which is
5026 what they get set to if XGetFontProperty fails under X. */
5027 fontp->baseline_offset = 0;
5028 fontp->relative_compose = 0;
5029 fontp->default_ascent = FONT_BASE (font);
5030
5031 UNBLOCK_INPUT;
5032 dpyinfo->n_fonts++;
5033
5034 return fontp;
5035 }
5036}
5037
ee78dc32 5038void
fbd6baed
GV		 5039w32_unload_font (dpyinfo, font)
5040 struct w32_display_info *dpyinfo;
ee78dc32
GV		 5041 XFontStruct * font;
5042{
5043 if (font)
5044 {
3c190163 5045 if (font->hfont) DeleteObject(font->hfont);
ee78dc32
GV		 5046 xfree (font);
5047 }
5048}
5049
fbd6baed 5050/* The font conversion stuff between x and w32 */
ee78dc32
GV		 5051
5052/* X font string is as follows (from faces.el)
5053 * (let ((- "[-?]")
5054 * (foundry "[^-]+")
5055 * (family "[^-]+")
5056 * (weight "\\(bold\\|demibold\\|medium\\)") ; 1
5057 * (weight\? "\\([^-]*\\)") ; 1
5058 * (slant "\\([ior]\\)") ; 2
5059 * (slant\? "\\([^-]?\\)") ; 2
5060 * (swidth "\\([^-]*\\)") ; 3
5061 * (adstyle "[^-]*") ; 4
5062 * (pixelsize "[0-9]+")
5063 * (pointsize "[0-9][0-9]+")
5064 * (resx "[0-9][0-9]+")
5065 * (resy "[0-9][0-9]+")
5066 * (spacing "[cmp?*]")
5067 * (avgwidth "[0-9]+")
5068 * (registry "[^-]+")
5069 * (encoding "[^-]+")
5070 * )
5071 * (setq x-font-regexp
5072 * (concat "\\`\\*?[-?*]"
5073 * foundry - family - weight\? - slant\? - swidth - adstyle -
5074 * pixelsize - pointsize - resx - resy - spacing - registry -
5075 * encoding "[-?*]\\*?\\'"
5076 * ))
5077 * (setq x-font-regexp-head
5078 * (concat "\\`[-?*]" foundry - family - weight\? - slant\?
5079 * "\\([-*?]\\|\\'\\)"))
5080 * (setq x-font-regexp-slant (concat - slant -))
5081 * (setq x-font-regexp-weight (concat - weight -))
5082 * nil)
5083 */
5084
5085#define FONT_START "[-?]"
5086#define FONT_FOUNDRY "[^-]+"
5087#define FONT_FAMILY "\\([^-]+\\)" /* 1 */
5088#define FONT_WEIGHT "\\(bold\\|demibold\\|medium\\)" /* 2 */
5089#define FONT_WEIGHT_Q "\\([^-]*\\)" /* 2 */
5090#define FONT_SLANT "\\([ior]\\)" /* 3 */
5091#define FONT_SLANT_Q "\\([^-]?\\)" /* 3 */
5092#define FONT_SWIDTH "\\([^-]*\\)" /* 4 */
5093#define FONT_ADSTYLE "[^-]*"
5094#define FONT_PIXELSIZE "[^-]*"
5095#define FONT_POINTSIZE "\\([0-9][0-9]+\\|\\*\\)" /* 5 */
5096#define FONT_RESX "[0-9][0-9]+"
5097#define FONT_RESY "[0-9][0-9]+"
5098#define FONT_SPACING "[cmp?*]"
5099#define FONT_AVGWIDTH "[0-9]+"
5100#define FONT_REGISTRY "[^-]+"
5101#define FONT_ENCODING "[^-]+"
5102
5103#define FONT_REGEXP ("\\`\\*?[-?*]" \
5104 FONT_FOUNDRY "-" \
5105 FONT_FAMILY "-" \
5106 FONT_WEIGHT_Q "-" \
5107 FONT_SLANT_Q "-" \
5108 FONT_SWIDTH "-" \
5109 FONT_ADSTYLE "-" \
5110 FONT_PIXELSIZE "-" \
5111 FONT_POINTSIZE "-" \
5112 "[-?*]\\|\\'")
5113
5114#define FONT_REGEXP_HEAD ("\\`[-?*]" \
5115 FONT_FOUNDRY "-" \
5116 FONT_FAMILY "-" \
5117 FONT_WEIGHT_Q "-" \
5118 FONT_SLANT_Q \
5119 "\\([-*?]\\|\\'\\)")
5120
5121#define FONT_REGEXP_SLANT "-" FONT_SLANT "-"
5122#define FONT_REGEXP_WEIGHT "-" FONT_WEIGHT "-"
5123
5124LONG
fbd6baed 5125x_to_w32_weight (lpw)
ee78dc32
GV		 5126 char * lpw;
5127{
5128 if (!lpw) return (FW_DONTCARE);
5ac45f98
GV		 5129
5130 if (stricmp (lpw,"heavy") == 0) return FW_HEAVY;
5131 else if (stricmp (lpw,"extrabold") == 0) return FW_EXTRABOLD;
5132 else if (stricmp (lpw,"bold") == 0) return FW_BOLD;
5133 else if (stricmp (lpw,"demibold") == 0) return FW_SEMIBOLD;
1edf84e7 5134 else if (stricmp (lpw,"semibold") == 0) return FW_SEMIBOLD;
5ac45f98
GV		 5135 else if (stricmp (lpw,"medium") == 0) return FW_MEDIUM;
5136 else if (stricmp (lpw,"normal") == 0) return FW_NORMAL;
5137 else if (stricmp (lpw,"light") == 0) return FW_LIGHT;
5138 else if (stricmp (lpw,"extralight") == 0) return FW_EXTRALIGHT;
5139 else if (stricmp (lpw,"thin") == 0) return FW_THIN;
ee78dc32 5140 else
5ac45f98 5141 return FW_DONTCARE;
ee78dc32
GV		 5142}
5143
5ac45f98 5144
ee78dc32 5145char *
fbd6baed 5146w32_to_x_weight (fnweight)
ee78dc32
GV		 5147 int fnweight;
5148{
5ac45f98
GV		 5149 if (fnweight >= FW_HEAVY) return "heavy";
5150 if (fnweight >= FW_EXTRABOLD) return "extrabold";
5151 if (fnweight >= FW_BOLD) return "bold";
5152 if (fnweight >= FW_SEMIBOLD) return "semibold";
5153 if (fnweight >= FW_MEDIUM) return "medium";
5154 if (fnweight >= FW_NORMAL) return "normal";
5155 if (fnweight >= FW_LIGHT) return "light";
5156 if (fnweight >= FW_EXTRALIGHT) return "extralight";
5157 if (fnweight >= FW_THIN) return "thin";
5158 else
5159 return "*";
5160}
5161
5162LONG
fbd6baed 5163x_to_w32_charset (lpcs)
5ac45f98
GV		 5164 char * lpcs;
5165{
5166 if (!lpcs) return (0);
5167
1a292d24
AI		 5168 if (stricmp (lpcs,"ansi") == 0) return ANSI_CHARSET;
5169 else if (stricmp (lpcs,"iso8859-1") == 0) return ANSI_CHARSET;
5170 else if (stricmp (lpcs, "symbol") == 0) return SYMBOL_CHARSET;
5171 else if (stricmp (lpcs, "jis") == 0) return SHIFTJIS_CHARSET;
4587b026
GV		 5172 else if (stricmp (lpcs, "ksc5601") == 0) return HANGEUL_CHARSET;
5173 else if (stricmp (lpcs, "gb2312") == 0) return GB2312_CHARSET;
5174 else if (stricmp (lpcs, "big5") == 0) return CHINESEBIG5_CHARSET;
1a292d24 5175 else if (stricmp (lpcs, "oem") == 0) return OEM_CHARSET;
4587b026
GV		 5176
5177#ifdef EASTEUROPE_CHARSET
5178 else if (stricmp (lpcs, "iso8859-2") == 0) return EASTEUROPE_CHARSET;
5179 else if (stricmp (lpcs, "iso8859-3") == 0) return TURKISH_CHARSET;
5180 else if (stricmp (lpcs, "iso8859-4") == 0) return BALTIC_CHARSET;
5181 else if (stricmp (lpcs, "iso8859-5") == 0) return RUSSIAN_CHARSET;
5182 else if (stricmp (lpcs, "koi8") == 0) return RUSSIAN_CHARSET;
5183 else if (stricmp (lpcs, "iso8859-6") == 0) return ARABIC_CHARSET;
5184 else if (stricmp (lpcs, "iso8859-7") == 0) return GREEK_CHARSET;
5185 else if (stricmp (lpcs, "iso8859-8") == 0) return HEBREW_CHARSET;
5186 else if (stricmp (lpcs, "viscii") == 0) return VIETNAMESE_CHARSET;
5187 else if (stricmp (lpcs, "vscii") == 0) return VIETNAMESE_CHARSET;
5188 else if (stricmp (lpcs, "tis620") == 0) return THAI_CHARSET;
5189 else if (stricmp (lpcs, "mac") == 0) return MAC_CHARSET;
5190#endif
5191
5ac45f98 5192#ifdef UNICODE_CHARSET
1a292d24
AI		 5193 else if (stricmp (lpcs,"iso10646") == 0) return UNICODE_CHARSET;
5194 else if (stricmp (lpcs, "unicode") == 0) return UNICODE_CHARSET;
5ac45f98 5195#endif
1a292d24 5196 else if (lpcs[0] == '#') return atoi (lpcs + 1);
5ac45f98 5197 else
1edf84e7 5198 return DEFAULT_CHARSET;
5ac45f98
GV		 5199}
5200
5201char *
fbd6baed 5202w32_to_x_charset (fncharset)
5ac45f98
GV		 5203 int fncharset;
5204{
1edf84e7
GV		 5205 static char buf[16];
5206
5ac45f98
GV		 5207 switch (fncharset)
5208 {
4587b026
GV		 5209 /* ansi is considered iso8859-1, as most modern ansi fonts are. */
5210 case ANSI_CHARSET: return "iso8859-1";
5211 case DEFAULT_CHARSET: return "ascii-*";
5212 case SYMBOL_CHARSET: return "*-symbol";
5213 case SHIFTJIS_CHARSET: return "jisx0212-sjis";
5214 case HANGEUL_CHARSET: return "ksc5601-*";
5215 case GB2312_CHARSET: return "gb2312-*";
5216 case CHINESEBIG5_CHARSET: return "big5-*";
5217 case OEM_CHARSET: return "*-oem";
5218
5219 /* More recent versions of Windows (95 and NT4.0) define more
5220 character sets. */
5221#ifdef EASTEUROPE_CHARSET
5222 case EASTEUROPE_CHARSET: return "iso8859-2";
5223 case TURKISH_CHARSET: return "iso8859-3";
5224 case BALTIC_CHARSET: return "iso8859-4";
5225 case RUSSIAN_CHARSET: return "iso8859-5";
5226 case ARABIC_CHARSET: return "iso8859-6";
5227 case GREEK_CHARSET: return "iso8859-7";
5228 case HEBREW_CHARSET: return "iso8859-8";
5229 case VIETNAMESE_CHARSET: return "viscii1.1-*";
5230 case THAI_CHARSET: return "tis620-*";
5231 case MAC_CHARSET: return "*-mac";
5232 case JOHAB_CHARSET: break; /* What is this? Latin-9? */
5233#endif
5234
5ac45f98 5235#ifdef UNICODE_CHARSET
4587b026 5236 case UNICODE_CHARSET: return "iso10646-unicode";
5ac45f98
GV		 5237#endif
5238 }
1edf84e7 5239 /* Encode numerical value of unknown charset. */
4587b026 5240 sprintf (buf, "*-#%u", fncharset);
1edf84e7 5241 return buf;
ee78dc32
GV		 5242}
5243
5244BOOL
fbd6baed 5245w32_to_x_font (lplogfont, lpxstr, len)
ee78dc32
GV		 5246 LOGFONT * lplogfont;
5247 char * lpxstr;
5248 int len;
5249{
4587b026 5250 char fontname[50];
3cb20f4a
RS		 5251 char height_pixels[8];
5252 char height_dpi[8];
5253 char width_pixels[8];
4587b026 5254 char *fontname_dash;
3cb20f4a
RS		 5255
5256 if (!lpxstr) abort ();
ee78dc32 5257
3cb20f4a
RS		 5258 if (!lplogfont)
5259 return FALSE;
5260
4587b026
GV		 5261 strncpy (fontname, lplogfont->lfFaceName, 50);
5262 fontname[49] = '\0'; /* Just in case */
5263
5264 /* Replace dashes with underscores so the dashes are not
5265 misinterpreted */
5266 fontname_dash = fontname;
5267 while (fontname_dash = strchr (fontname_dash, '-'))
5268 *fontname_dash = '_';
5269
3cb20f4a 5270 if (lplogfont->lfHeight)
ee78dc32 5271 {
3cb20f4a
RS		 5272 sprintf (height_pixels, "%u", abs (lplogfont->lfHeight));
5273 sprintf (height_dpi, "%u",
fbd6baed 5274 (abs (lplogfont->lfHeight) * 720) / one_w32_display_info.height_in);
5ac45f98
GV		 5275 }
5276 else
ee78dc32 5277 {
3cb20f4a
RS		 5278 strcpy (height_pixels, "*");
5279 strcpy (height_dpi, "*");
ee78dc32 5280 }
3cb20f4a
RS		 5281 if (lplogfont->lfWidth)
5282 sprintf (width_pixels, "%u", lplogfont->lfWidth * 10);
5283 else
5284 strcpy (width_pixels, "*");
5285
5286 _snprintf (lpxstr, len - 1,
4587b026
GV		 5287 "-*-%s-%s-%c-*-*-%s-%s-*-*-%c-%s-%s",
5288 /* foundry */
5289 fontname, /* family */
5290 w32_to_x_weight (lplogfont->lfWeight), /* weight */
5291 lplogfont->lfItalic?'i':'r', /* slant */
5292 /* setwidth name */
5293 /* add style name */
5294 height_pixels, /* pixel size */
5295 height_dpi, /* point size */
5296 /* resx */
5297 /* resy */
5298 ((lplogfont->lfPitchAndFamily & 0x3) == VARIABLE_PITCH)
5299 ? 'p' : 'c', /* spacing */
5300 width_pixels, /* avg width */
5301 w32_to_x_charset (lplogfont->lfCharSet) /* charset registry
5302 and encoding*/
3cb20f4a
RS		 5303 );
5304
ee78dc32
GV		 5305 lpxstr[len - 1] = 0; /* just to be sure */
5306 return (TRUE);
5307}
5308
5309BOOL
fbd6baed 5310x_to_w32_font (lpxstr, lplogfont)
ee78dc32
GV		 5311 char * lpxstr;
5312 LOGFONT * lplogfont;
5313{
5314 if (!lplogfont) return (FALSE);
5315
5316 memset (lplogfont, 0, sizeof (*lplogfont));
5ac45f98 5317
1a292d24 5318 /* Set default value for each field. */
771c47d5 5319#if 1
ee78dc32
GV		 5320 lplogfont->lfOutPrecision = OUT_DEFAULT_PRECIS;
5321 lplogfont->lfClipPrecision = CLIP_DEFAULT_PRECIS;
5322 lplogfont->lfQuality = DEFAULT_QUALITY;
5ac45f98
GV		 5323#else
5324 /* go for maximum quality */
5325 lplogfont->lfOutPrecision = OUT_STROKE_PRECIS;
5326 lplogfont->lfClipPrecision = CLIP_STROKE_PRECIS;
5327 lplogfont->lfQuality = PROOF_QUALITY;
5328#endif
5329
1a292d24
AI		 5330 lplogfont->lfCharSet = DEFAULT_CHARSET;
5331 lplogfont->lfWeight = FW_DONTCARE;
5332 lplogfont->lfPitchAndFamily = DEFAULT_PITCH | FF_DONTCARE;
5333
5ac45f98
GV		 5334 if (!lpxstr)
5335 return FALSE;
5336
5337 /* Provide a simple escape mechanism for specifying Windows font names
5338 * directly -- if font spec does not beginning with '-', assume this
5339 * format:
5340 * "<font name>[:height in pixels[:width in pixels[:weight]]]"
5341 */
ee78dc32 5342
5ac45f98
GV		 5343 if (*lpxstr == '-')
5344 {
5345 int fields;
5346 char name[50], weight[20], slant, pitch, pixels[10], height[10], width[10], remainder[20];
5347 char * encoding;
5348
5349 fields = sscanf (lpxstr,
5350 "-%*[^-]-%49[^-]-%19[^-]-%c-%*[^-]-%*[^-]-%9[^-]-%9[^-]-%*[^-]-%*[^-]-%c-%9[^-]-%19s",
5351 name, weight, &slant, pixels, height, &pitch, width, remainder);
5352
5353 if (fields == EOF) return (FALSE);
5354
5355 if (fields > 0 && name[0] != '*')
5356 {
5357 strncpy (lplogfont->lfFaceName,name, LF_FACESIZE);
5358 lplogfont->lfFaceName[LF_FACESIZE-1] = 0;
5359 }
5360 else
5361 {
5362 lplogfont->lfFaceName[0] = 0;
5363 }
5364
5365 fields--;
5366
fbd6baed 5367 lplogfont->lfWeight = x_to_w32_weight ((fields > 0 ? weight : ""));
5ac45f98
GV		 5368
5369 fields--;
5370
fbd6baed 5371 if (!NILP (Vw32_enable_italics))
5ac45f98
GV		 5372 lplogfont->lfItalic = (fields > 0 && slant == 'i');
5373
5374 fields--;
5375
5376 if (fields > 0 && pixels[0] != '*')
5377 lplogfont->lfHeight = atoi (pixels);
5378
5379 fields--;
5380
5381 if (fields > 0 && lplogfont->lfHeight == 0 && height[0] != '*')
5382 lplogfont->lfHeight = (atoi (height)
fbd6baed 5383 * one_w32_display_info.height_in) / 720;
5ac45f98
GV		 5384
5385 fields--;
5386
5387 lplogfont->lfPitchAndFamily =
5388 (fields > 0 && pitch == 'p') ? VARIABLE_PITCH : FIXED_PITCH;
5389
5390 fields--;
5391
5392 if (fields > 0 && width[0] != '*')
5393 lplogfont->lfWidth = atoi (width) / 10;
5394
5395 fields--;
5396
4587b026
GV		 5397 /* Strip the trailing '-' if present. (it shouldn't be, as it
5398 fails the test against xlfn-tight-regexp in fontset.el). */
3c190163 5399 {
5ac45f98
GV		 5400 int len = strlen (remainder);
5401 if (len > 0 && remainder[len-1] == '-')
5402 remainder[len-1] = 0;
ee78dc32 5403 }
5ac45f98
GV		 5404 encoding = remainder;
5405 if (strncmp (encoding, "*-", 2) == 0)
5406 encoding += 2;
fbd6baed 5407 lplogfont->lfCharSet = x_to_w32_charset (fields > 0 ? encoding : "");
5ac45f98
GV		 5408 }
5409 else
5410 {
5411 int fields;
5412 char name[100], height[10], width[10], weight[20];
a1a80b40 5413
5ac45f98
GV		 5414 fields = sscanf (lpxstr,
5415 "%99[^:]:%9[^:]:%9[^:]:%19s",
5416 name, height, width, weight);
5417
5418 if (fields == EOF) return (FALSE);
5419
5420 if (fields > 0)
5421 {
5422 strncpy (lplogfont->lfFaceName,name, LF_FACESIZE);
5423 lplogfont->lfFaceName[LF_FACESIZE-1] = 0;
5424 }
5425 else
5426 {
5427 lplogfont->lfFaceName[0] = 0;
5428 }
5429
5430 fields--;
5431
5432 if (fields > 0)
5433 lplogfont->lfHeight = atoi (height);
5434
5435 fields--;
5436
5437 if (fields > 0)
5438 lplogfont->lfWidth = atoi (width);
5439
5440 fields--;
5441
fbd6baed 5442 lplogfont->lfWeight = x_to_w32_weight ((fields > 0 ? weight : ""));
5ac45f98
GV		 5443 }
5444
5445 /* This makes TrueType fonts work better. */
5446 lplogfont->lfHeight = - abs (lplogfont->lfHeight);
ee78dc32
GV		 5447
5448 return (TRUE);
5449}
5450
5451BOOL
fbd6baed 5452w32_font_match (lpszfont1, lpszfont2)
ee78dc32
GV		 5453 char * lpszfont1;
5454 char * lpszfont2;
5455{
5456 char * s1 = lpszfont1, *e1;
5457 char * s2 = lpszfont2, *e2;
5458
5459 if (s1 == NULL || s2 == NULL) return (FALSE);
5460
5461 if (*s1 == '-') s1++;
5462 if (*s2 == '-') s2++;
5463
5464 while (1)
5465 {
5466 int len1, len2;
5467
5468 e1 = strchr (s1, '-');
5469 e2 = strchr (s2, '-');
5470
5471 if (e1 == NULL || e2 == NULL) return (TRUE);
5472
5473 len1 = e1 - s1;
5474 len2 = e2 - s2;
5475
5476 if (*s1 != '*' && *s2 != '*'
5477 && (len1 != len2 || strnicmp (s1, s2, len1) != 0))
5478 return (FALSE);
5479
5480 s1 = e1 + 1;
5481 s2 = e2 + 1;
5482 }
5483}
5484
5485typedef struct enumfont_t
5486{
5487 HDC hdc;
5488 int numFonts;
3cb20f4a 5489 LOGFONT logfont;
ee78dc32
GV		 5490 XFontStruct *size_ref;
5491 Lisp_Object *pattern;
5492 Lisp_Object *head;
5493 Lisp_Object *tail;
5494} enumfont_t;
5495
5496int CALLBACK
5497enum_font_cb2 (lplf, lptm, FontType, lpef)
5498 ENUMLOGFONT * lplf;
5499 NEWTEXTMETRIC * lptm;
5500 int FontType;
5501 enumfont_t * lpef;
5502{
1edf84e7 5503 if (lplf->elfLogFont.lfStrikeOut || lplf->elfLogFont.lfUnderline)
ee78dc32
GV		 5504 return (1);
5505
4587b026
GV		 5506 /* Check that the character set matches if it was specified */
5507 if (lpef->logfont.lfCharSet != DEFAULT_CHARSET &&
5508 lplf->elfLogFont.lfCharSet != lpef->logfont.lfCharSet)
5509 return (1);
5510
5511 /* We want all fonts cached, so don't compare sizes just yet */
ee78dc32
GV		 5512 /* if (!lpef->size_ref || lptm->tmMaxCharWidth == FONT_WIDTH (lpef->size_ref)) */
5513 {
5514 char buf[100];
4587b026 5515 Lisp_Object width = Qnil;
ee78dc32 5516
779a69a8 5517 if (!NILP (*(lpef->pattern)) && FontType != RASTER_FONTTYPE)
3cb20f4a 5518 {
4587b026 5519 /* Scalable fonts are as big as you want them to be. */
3cb20f4a
RS		 5520 lplf->elfLogFont.lfHeight = lpef->logfont.lfHeight;
5521 lplf->elfLogFont.lfWidth = lpef->logfont.lfWidth;
5522 }
5523
4587b026
GV		 5524 /* The MaxCharWidth is not valid at this stage for scalable fonts. */
5525 if (FontType == RASTER_FONTTYPE)
5526 width = make_number (lptm->tmMaxCharWidth);
5527
fbd6baed 5528 if (!w32_to_x_font (lplf, buf, 100)) return (0);
ee78dc32 5529
fbd6baed 5530 if (NILP (*(lpef->pattern)) || w32_font_match (buf, XSTRING (*(lpef->pattern))->data))
ee78dc32 5531 {
4587b026
GV		 5532 *lpef->tail = Fcons (Fcons (build_string (buf), width), Qnil);
5533 lpef->tail = &(XCONS (*lpef->tail)->cdr);
ee78dc32
GV		 5534 lpef->numFonts++;
5535 }
5536 }
5537
5538 return (1);
5539}
5540
5541int CALLBACK
5542enum_font_cb1 (lplf, lptm, FontType, lpef)
5543 ENUMLOGFONT * lplf;
5544 NEWTEXTMETRIC * lptm;
5545 int FontType;
5546 enumfont_t * lpef;
5547{
5548 return EnumFontFamilies (lpef->hdc,
5549 lplf->elfLogFont.lfFaceName,
5550 (FONTENUMPROC) enum_font_cb2,
5551 (LPARAM) lpef);
5552}
5553
5554
4587b026
GV		 5555/* Interface to fontset handler. (adapted from mw32font.c in Meadow
5556 and xterm.c in Emacs 20.3) */
5557
5558/* Return a list of names of available fonts matching PATTERN on frame
5559 F. If SIZE is not 0, it is the size (maximum bound width) of fonts
5560 to be listed. Frame F NULL means we have not yet created any
5561 frame, which means we can't get proper size info, as we don't have
5562 a device context to use for GetTextMetrics.
5563 MAXNAMES sets a limit on how many fonts to match. */
5564
5565Lisp_Object
5566w32_list_fonts (FRAME_PTR f, Lisp_Object pattern, int size, int maxnames )
5567{
5568 Lisp_Object patterns, key, tem;
5569 Lisp_Object list = Qnil, newlist = Qnil, second_best = Qnil;
5570
396594fe
GV		 5571 /* If we don't have a frame, we can't use the Windows API to list
5572 fonts, as it requires a device context for the Window. This will
5573 only happen during startup if the user specifies a font on the
5574 command line. Print a message on stderr and return nil. */
5575 if (!f)
5576 {
5577 char buffer[256];
5578
5579 sprintf (buffer,
5580 "Emacs cannot get a list of fonts before the initial frame "
5581 "is created.\nThe font specified on the command line may not "
5582 "be found.\n");
5583 MessageBox (NULL, buffer, "Emacs Warning Dialog",
5584 MB_OK | MB_ICONEXCLAMATION | MB_TASKMODAL);
5585 return Qnil;
5586 }
5587
5588
4587b026
GV		 5589 patterns = Fassoc (pattern, Valternate_fontname_alist);
5590 if (NILP (patterns))
5591 patterns = Fcons (pattern, Qnil);
5592
5593 for (; CONSP (patterns); patterns = XCONS (patterns)->cdr)
5594 {
5595 enumfont_t ef;
5596
5597 pattern = XCONS (patterns)->car;
5598
5599 /* See if we cached the result for this particular query.
5600 The cache is an alist of the form:
5601 ((PATTERN (FONTNAME . WIDTH) ...) ...)
5602 */
5603 if ( f &&
5604 (tem = XCONS (FRAME_W32_DISPLAY_INFO (f)->name_list_element)->cdr,
5605 !NILP (list = Fassoc (pattern, tem))))
5606 {
5607 list = Fcdr_safe (list);
5608 /* We have a cached list. Don't have to get the list again. */
5609 goto label_cached;
5610 }
5611
5612 BLOCK_INPUT;
5613 /* At first, put PATTERN in the cache. */
5614 list = Qnil;
5615 ef.pattern = &pattern;
5616 ef.tail = ef.head = &list;
5617 ef.numFonts = 0;
5618 x_to_w32_font (STRINGP (pattern) ? XSTRING (pattern)->data :
5619 NULL, &ef.logfont);
5620 {
5621 ef.hdc = GetDC (FRAME_W32_WINDOW (f));
5622
5623 EnumFontFamilies (ef.hdc, NULL, (FONTENUMPROC) enum_font_cb1,
5624 (LPARAM)&ef);
5625
5626 ReleaseDC (FRAME_W32_WINDOW (f), ef.hdc);
5627 }
5628
5629 UNBLOCK_INPUT;
5630
5631 /* Make a list of the fonts we got back.
5632 Store that in the font cache for the display. */
5633 if (f != NULL)
5634 XCONS (FRAME_W32_DISPLAY_INFO (f)->name_list_element)->cdr
5635 = Fcons (Fcons (pattern, list),
5636 XCONS (FRAME_W32_DISPLAY_INFO (f)->name_list_element)->cdr);
5637
5638 label_cached:
5639 if (NILP (list)) continue; /* Try the remaining alternatives. */
5640
5641 newlist = second_best = Qnil;
5642
5643 /* Make a list of the fonts that have the right width. */
5644 for (; CONSP (list); list = XCONS (list)->cdr)
5645 {
5646 int found_size;
5647 tem = XCONS (list)->car;
5648
5649 if (!CONSP (tem))
5650 continue;
5651 if (NILP (XCONS (tem)->car))
5652 continue;
5653 if (!size)
5654 {
5655 newlist = Fcons (XCONS (tem)->car, newlist);
5656 continue;
5657 }
5658 if (!INTEGERP (XCONS (tem)->cdr))
5659 {
5660 /* Since we don't yet know the size of the font, we must
5661 load it and try GetTextMetrics. */
5662 struct w32_display_info *dpyinfo
5663 = FRAME_W32_DISPLAY_INFO (f);
5664 W32FontStruct thisinfo;
5665 LOGFONT lf;
5666 HDC hdc;
5667 HANDLE oldobj;
5668
5669 if (!x_to_w32_font (XSTRING (XCONS (tem)->car)->data, &lf))
5670 continue;
5671
5672 BLOCK_INPUT;
5673 thisinfo.hfont = CreateFontIndirect (&lf);
5674 if (thisinfo.hfont == NULL)
5675 continue;
5676
5677 hdc = GetDC (dpyinfo->root_window);
5678 oldobj = SelectObject (hdc, thisinfo.hfont);
5679 if (GetTextMetrics (hdc, &thisinfo.tm))
5680 XCONS (tem)->cdr = make_number (FONT_WIDTH (&thisinfo));
5681 else
5682 XCONS (tem)->cdr = make_number (0);
5683 SelectObject (hdc, oldobj);
5684 ReleaseDC (dpyinfo->root_window, hdc);
5685 DeleteObject(thisinfo.hfont);
5686 UNBLOCK_INPUT;
5687 }
5688 found_size = XINT (XCONS (tem)->cdr);
5689 if (found_size == size)
5690 newlist = Fcons (XCONS (tem)->car, newlist);
5691
5692 /* keep track of the closest matching size in case
5693 no exact match is found. */
5694 else if (found_size > 0)
5695 {
5696 if (NILP (second_best))
5697 second_best = tem;
5698 else if (found_size < size)
5699 {
5700 if (XINT (XCONS (second_best)->cdr) > size
5701 || XINT (XCONS (second_best)->cdr) < found_size)
5702 second_best = tem;
5703 }
5704 else
5705 {
5706 if (XINT (XCONS (second_best)->cdr) > size
5707 && XINT (XCONS (second_best)->cdr) >
5708 found_size)
5709 second_best = tem;
5710 }
5711 }
5712 }
5713
5714 if (!NILP (newlist))
5715 break;
5716 else if (!NILP (second_best))
5717 {
5718 newlist = Fcons (XCONS (second_best)->car, Qnil);
5719 break;
5720 }
5721 }
5722
5723 return newlist;
5724}
5725
5726/* Return a pointer to struct font_info of font FONT_IDX of frame F. */
5727struct font_info *
5728w32_get_font_info (f, font_idx)
5729 FRAME_PTR f;
5730 int font_idx;
5731{
5732 return (FRAME_W32_FONT_TABLE (f) + font_idx);
5733}
5734
5735
5736struct font_info*
5737w32_query_font (struct frame *f, char *fontname)
5738{
5739 int i;
5740 struct font_info *pfi;
5741
5742 pfi = FRAME_W32_FONT_TABLE (f);
5743
5744 for (i = 0; i < one_w32_display_info.n_fonts ;i++, pfi++)
5745 {
5746 if (strcmp(pfi->name, fontname) == 0) return pfi;
5747 }
5748
5749 return NULL;
5750}
5751
5752/* Find a CCL program for a font specified by FONTP, and set the member
5753 `encoder' of the structure. */
5754
5755void
5756w32_find_ccl_program (fontp)
5757 struct font_info *fontp;
5758{
5759 extern Lisp_Object Vfont_ccl_encoder_alist, Vccl_program_table;
5760 extern Lisp_Object Qccl_program_idx;
5761 extern Lisp_Object resolve_symbol_ccl_program ();
5762 Lisp_Object list, elt, ccl_prog, ccl_id;
5763
5764 for (list = Vfont_ccl_encoder_alist; CONSP (list); list = XCONS (list)->cdr)
5765 {
5766 elt = XCONS (list)->car;
5767 if (CONSP (elt)
5768 && STRINGP (XCONS (elt)->car)
5769 && (fast_c_string_match_ignore_case (XCONS (elt)->car, fontp->name)
5770 >= 0))
5771 {
5772 if (SYMBOLP (XCONS (elt)->cdr) &&
5773 (!NILP (ccl_id = Fget (XCONS (elt)->cdr, Qccl_program_idx))))
5774 {
5775 ccl_prog = XVECTOR (Vccl_program_table)->contents[XUINT (ccl_id)];
5776 if (!CONSP (ccl_prog)) continue;
5777 ccl_prog = XCONS (ccl_prog)->cdr;
5778 }
5779 else
5780 {
5781 ccl_prog = XCONS (elt)->cdr;
5782 if (!VECTORP (ccl_prog)) continue;
5783 }
5784
5785 fontp->font_encoder
5786 = (struct ccl_program *) xmalloc (sizeof (struct ccl_program));
5787 setup_ccl_program (fontp->font_encoder,
5788 resolve_symbol_ccl_program (ccl_prog));
5789 break;
5790 }
5791 }
5792}
5793
5794\f
5795#if 1
5796#include "x-list-font.c"
5797#else
4b817373 5798DEFUN ("x-list-fonts", Fx_list_fonts, Sx_list_fonts, 1, 4, 0,
ee78dc32
GV		 5799 "Return a list of the names of available fonts matching PATTERN.\n\
5800If optional arguments FACE and FRAME are specified, return only fonts\n\
5801the same size as FACE on FRAME.\n\
5802\n\
5803PATTERN is a string, perhaps with wildcard characters;\n\
5804 the * character matches any substring, and\n\
5805 the ? character matches any single character.\n\
5806 PATTERN is case-insensitive.\n\
5807FACE is a face name--a symbol.\n\
5808\n\
5809The return value is a list of strings, suitable as arguments to\n\
5810set-face-font.\n\
5811\n\
5812Fonts Emacs can't use (i.e. proportional fonts) may or may not be excluded\n\
4b817373
RS		 5813even if they match PATTERN and FACE.\n\
5814\n\
5815The optional fourth argument MAXIMUM sets a limit on how many\n\
5816fonts to match. The first MAXIMUM fonts are reported.")
5817 (pattern, face, frame, maximum)
5818 Lisp_Object pattern, face, frame, maximum;
ee78dc32
GV		 5819{
5820 int num_fonts;
5821 char **names;
5822 XFontStruct *info;
5823 XFontStruct *size_ref;
5824 Lisp_Object namelist;
5825 Lisp_Object list;
5826 FRAME_PTR f;
5827 enumfont_t ef;
5828
5829 CHECK_STRING (pattern, 0);
5830 if (!NILP (face))
5831 CHECK_SYMBOL (face, 1);
5832
5833 f = check_x_frame (frame);
5834
5835 /* Determine the width standard for comparison with the fonts we find. */
5836
5837 if (NILP (face))
5838 size_ref = 0;
5839 else
5840 {
5841 int face_id;
5842
5843 /* Don't die if we get called with a terminal frame. */
fbd6baed
GV		 5844 if (! FRAME_W32_P (f))
5845 error ("non-w32 frame used in `x-list-fonts'");
ee78dc32
GV		 5846
5847 face_id = face_name_id_number (f, face);
5848
5849 if (face_id < 0 || face_id >= FRAME_N_PARAM_FACES (f)
5850 || FRAME_PARAM_FACES (f) [face_id] == 0)
fbd6baed 5851 size_ref = f->output_data.w32->font;
ee78dc32
GV		 5852 else
5853 {
5854 size_ref = FRAME_PARAM_FACES (f) [face_id]->font;
5855 if (size_ref == (XFontStruct *) (~0))
fbd6baed 5856 size_ref = f->output_data.w32->font;
ee78dc32
GV		 5857 }
5858 }
5859
5860 /* See if we cached the result for this particular query. */
5861 list = Fassoc (pattern,
fbd6baed 5862 XCONS (FRAME_W32_DISPLAY_INFO (f)->name_list_element)->cdr);
ee78dc32
GV		 5863
5864 /* We have info in the cache for this PATTERN. */
5865 if (!NILP (list))
5866 {
5867 Lisp_Object tem, newlist;
5868
5869 /* We have info about this pattern. */
5870 list = XCONS (list)->cdr;
5871
5872 if (size_ref == 0)
5873 return list;
5874
5875 BLOCK_INPUT;
5876
5877 /* Filter the cached info and return just the fonts that match FACE. */
5878 newlist = Qnil;
5879 for (tem = list; CONSP (tem); tem = XCONS (tem)->cdr)
5880 {
4587b026
GV		 5881 struct font_info *fontinf;
5882 XFontStruct *thisinfo = NULL;
ee78dc32 5883
4587b026
GV		 5884 fontinf = w32_load_font (f, XSTRING (XCONS (tem)->car)->data, 0);
5885 if (fontinf)
5886 thisinfo = (XFontStruct *)fontinf->font;
ee78dc32
GV		 5887 if (thisinfo && same_size_fonts (thisinfo, size_ref))
5888 newlist = Fcons (XCONS (tem)->car, newlist);
5889
fbd6baed 5890 w32_unload_font (FRAME_W32_DISPLAY_INFO (f), thisinfo);
ee78dc32
GV		 5891 }
5892
5893 UNBLOCK_INPUT;
5894
5895 return newlist;
5896 }
5897
5898 BLOCK_INPUT;
5899
5900 namelist = Qnil;
5901 ef.pattern = &pattern;
5902 ef.tail = ef.head = &namelist;
5903 ef.numFonts = 0;
fbd6baed 5904 x_to_w32_font (STRINGP (pattern) ? XSTRING (pattern)->data : NULL, &ef.logfont);
ee78dc32
GV		 5905
5906 {
fbd6baed 5907 ef.hdc = GetDC (FRAME_W32_WINDOW (f));
ee78dc32
GV		 5908
5909 EnumFontFamilies (ef.hdc, NULL, (FONTENUMPROC) enum_font_cb1, (LPARAM)&ef);
5910
fbd6baed 5911 ReleaseDC (FRAME_W32_WINDOW (f), ef.hdc);
ee78dc32
GV		 5912 }
5913
5914 UNBLOCK_INPUT;
5915
5916 if (ef.numFonts)
5917 {
5918 int i;
5919 Lisp_Object cur;
5920
5921 /* Make a list of all the fonts we got back.
5922 Store that in the font cache for the display. */
fbd6baed 5923 XCONS (FRAME_W32_DISPLAY_INFO (f)->name_list_element)->cdr
ee78dc32 5924 = Fcons (Fcons (pattern, namelist),
fbd6baed 5925 XCONS (FRAME_W32_DISPLAY_INFO (f)->name_list_element)->cdr);
ee78dc32
GV		 5926
5927 /* Make a list of the fonts that have the right width. */
5928 list = Qnil;
5929 cur=namelist;
5930 for (i = 0; i < ef.numFonts; i++)
5931 {
5932 int keeper;
5933
5934 if (!size_ref)
5935 keeper = 1;
5936 else
5937 {
4587b026
GV		 5938 struct font_info *fontinf;
5939 XFontStruct *thisinfo = NULL;
ee78dc32
GV		 5940
5941 BLOCK_INPUT;
4587b026
GV		 5942 fontinf = w32_load_font (f, XSTRING (Fcar (cur))->data, 0);
5943 if (fontinf)
5944 thisinfo = (XFontStruct *)fontinf->font;
ee78dc32
GV		 5945
5946 keeper = thisinfo && same_size_fonts (thisinfo, size_ref);
5947
fbd6baed 5948 w32_unload_font (FRAME_W32_DISPLAY_INFO (f), thisinfo);
ee78dc32
GV		 5949
5950 UNBLOCK_INPUT;
5951 }
5952 if (keeper)
5953 list = Fcons (build_string (XSTRING (Fcar (cur))->data), list);
5954
5955 cur = Fcdr (cur);
5956 }
5957 list = Fnreverse (list);
5958 }
5959
5960 return list;
5961}
4587b026 5962#endif
ee78dc32
GV		 5963\f
5964DEFUN ("x-color-defined-p", Fx_color_defined_p, Sx_color_defined_p, 1, 2, 0,
5965 "Return non-nil if color COLOR is supported on frame FRAME.\n\
5966If FRAME is omitted or nil, use the selected frame.")
5967 (color, frame)
5968 Lisp_Object color, frame;
5969{
5970 COLORREF foo;
5971 FRAME_PTR f = check_x_frame (frame);
5972
5973 CHECK_STRING (color, 1);
5974
5975 if (defined_color (f, XSTRING (color)->data, &foo, 0))
5976 return Qt;
5977 else
5978 return Qnil;
5979}
5980
5981DEFUN ("x-color-values", Fx_color_values, Sx_color_values, 1, 2, 0,
5982 "Return a description of the color named COLOR on frame FRAME.\n\
5983The value is a list of integer RGB values--(RED GREEN BLUE).\n\
5984These values appear to range from 0 to 65280 or 65535, depending\n\
5985on the system; white is (65280 65280 65280) or (65535 65535 65535).\n\
5986If FRAME is omitted or nil, use the selected frame.")
5987 (color, frame)
5988 Lisp_Object color, frame;
5989{
5990 COLORREF foo;
5991 FRAME_PTR f = check_x_frame (frame);
5992
5993 CHECK_STRING (color, 1);
5994
5995 if (defined_color (f, XSTRING (color)->data, &foo, 0))
5996 {
5997 Lisp_Object rgb[3];
5998
1edf84e7
GV		 5999 rgb[0] = make_number ((GetRValue (foo) << 8) | GetRValue (foo));
6000 rgb[1] = make_number ((GetGValue (foo) << 8) | GetGValue (foo));
6001 rgb[2] = make_number ((GetBValue (foo) << 8) | GetBValue (foo));
ee78dc32
GV		 6002 return Flist (3, rgb);
6003 }
6004 else
6005 return Qnil;
6006}
6007
6008DEFUN ("x-display-color-p", Fx_display_color_p, Sx_display_color_p, 0, 1, 0,
6009 "Return t if the X display supports color.\n\
6010The optional argument DISPLAY specifies which display to ask about.\n\
6011DISPLAY should be either a frame or a display name (a string).\n\
6012If omitted or nil, that stands for the selected frame's display.")
6013 (display)
6014 Lisp_Object display;
6015{
fbd6baed 6016 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV		 6017
6018 if ((dpyinfo->n_planes * dpyinfo->n_cbits) <= 2)
6019 return Qnil;
6020
6021 return Qt;
6022}
6023
6024DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p, Sx_display_grayscale_p,
6025 0, 1, 0,
6026 "Return t if the X display supports shades of gray.\n\
6027Note that color displays do support shades of gray.\n\
6028The optional argument DISPLAY specifies which display to ask about.\n\
6029DISPLAY should be either a frame or a display name (a string).\n\
6030If omitted or nil, that stands for the selected frame's display.")
6031 (display)
6032 Lisp_Object display;
6033{
fbd6baed 6034 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV		 6035
6036 if ((dpyinfo->n_planes * dpyinfo->n_cbits) <= 1)
6037 return Qnil;
6038
6039 return Qt;
6040}
6041
6042DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width,
6043 0, 1, 0,
6044 "Returns the width in pixels of the X display DISPLAY.\n\
6045The optional argument DISPLAY specifies which display to ask about.\n\
6046DISPLAY should be either a frame or a display name (a string).\n\
6047If omitted or nil, that stands for the selected frame's display.")
6048 (display)
6049 Lisp_Object display;
6050{
fbd6baed 6051 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV		 6052
6053 return make_number (dpyinfo->width);
6054}
6055
6056DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
6057 Sx_display_pixel_height, 0, 1, 0,
6058 "Returns the height in pixels of the X display DISPLAY.\n\
6059The optional argument DISPLAY specifies which display to ask about.\n\
6060DISPLAY should be either a frame or a display name (a string).\n\
6061If omitted or nil, that stands for the selected frame's display.")
6062 (display)
6063 Lisp_Object display;
6064{
fbd6baed 6065 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV		 6066
6067 return make_number (dpyinfo->height);
6068}
6069
6070DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
6071 0, 1, 0,
6072 "Returns the number of bitplanes of the display DISPLAY.\n\
6073The optional argument DISPLAY specifies which display to ask about.\n\
6074DISPLAY should be either a frame or a display name (a string).\n\
6075If omitted or nil, that stands for the selected frame's display.")
6076 (display)
6077 Lisp_Object display;
6078{
fbd6baed 6079 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV		 6080
6081 return make_number (dpyinfo->n_planes * dpyinfo->n_cbits);
6082}
6083
6084DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
6085 0, 1, 0,
6086 "Returns the number of color cells of the display DISPLAY.\n\
6087The optional argument DISPLAY specifies which display to ask about.\n\
6088DISPLAY should be either a frame or a display name (a string).\n\
6089If omitted or nil, that stands for the selected frame's display.")
6090 (display)
6091 Lisp_Object display;
6092{
fbd6baed 6093 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV		 6094 HDC hdc;
6095 int cap;
6096
5ac45f98
GV		 6097 hdc = GetDC (dpyinfo->root_window);
6098 if (dpyinfo->has_palette)
6099 cap = GetDeviceCaps (hdc,SIZEPALETTE);
6100 else
6101 cap = GetDeviceCaps (hdc,NUMCOLORS);
ee78dc32
GV		 6102
6103 ReleaseDC (dpyinfo->root_window, hdc);
6104
6105 return make_number (cap);
6106}
6107
6108DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
6109 Sx_server_max_request_size,
6110 0, 1, 0,
6111 "Returns the maximum request size of the server of display DISPLAY.\n\
6112The optional argument DISPLAY specifies which display to ask about.\n\
6113DISPLAY should be either a frame or a display name (a string).\n\
6114If omitted or nil, that stands for the selected frame's display.")
6115 (display)
6116 Lisp_Object display;
6117{
fbd6baed 6118 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV		 6119
6120 return make_number (1);
6121}
6122
6123DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
fbd6baed 6124 "Returns the vendor ID string of the W32 system (Microsoft).\n\
ee78dc32
GV		 6125The optional argument DISPLAY specifies which display to ask about.\n\
6126DISPLAY should be either a frame or a display name (a string).\n\
6127If omitted or nil, that stands for the selected frame's display.")
6128 (display)
6129 Lisp_Object display;
6130{
fbd6baed 6131 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV		 6132 char *vendor = "Microsoft Corp.";
6133
6134 if (! vendor) vendor = "";
6135 return build_string (vendor);
6136}
6137
6138DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
6139 "Returns the version numbers of the server of display DISPLAY.\n\
6140The value is a list of three integers: the major and minor\n\
6141version numbers, and the vendor-specific release\n\
6142number. See also the function `x-server-vendor'.\n\n\
6143The optional argument DISPLAY specifies which display to ask about.\n\
6144DISPLAY should be either a frame or a display name (a string).\n\
6145If omitted or nil, that stands for the selected frame's display.")
6146 (display)
6147 Lisp_Object display;
6148{
fbd6baed 6149 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32 6150
fbd6baed
GV		 6151 return Fcons (make_number (w32_major_version),
6152 Fcons (make_number (w32_minor_version), Qnil));
ee78dc32
GV		 6153}
6154
6155DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
6156 "Returns the number of screens on the server of display DISPLAY.\n\
6157The optional argument DISPLAY specifies which display to ask about.\n\
6158DISPLAY should be either a frame or a display name (a string).\n\
6159If omitted or nil, that stands for the selected frame's display.")
6160 (display)
6161 Lisp_Object display;
6162{
fbd6baed 6163 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV		 6164
6165 return make_number (1);
6166}
6167
6168DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, 0,
6169 "Returns the height in millimeters of the X display DISPLAY.\n\
6170The optional argument DISPLAY specifies which display to ask about.\n\
6171DISPLAY should be either a frame or a display name (a string).\n\
6172If omitted or nil, that stands for the selected frame's display.")
6173 (display)
6174 Lisp_Object display;
6175{
fbd6baed 6176 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV		 6177 HDC hdc;
6178 int cap;
6179
5ac45f98 6180 hdc = GetDC (dpyinfo->root_window);
3c190163 6181
ee78dc32 6182 cap = GetDeviceCaps (hdc, VERTSIZE);
3c190163 6183
ee78dc32
GV		 6184 ReleaseDC (dpyinfo->root_window, hdc);
6185
6186 return make_number (cap);
6187}
6188
6189DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
6190 "Returns the width in millimeters of the X display DISPLAY.\n\
6191The optional argument DISPLAY specifies which display to ask about.\n\
6192DISPLAY should be either a frame or a display name (a string).\n\
6193If omitted or nil, that stands for the selected frame's display.")
6194 (display)
6195 Lisp_Object display;
6196{
fbd6baed 6197 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV		 6198
6199 HDC hdc;
6200 int cap;
6201
5ac45f98 6202 hdc = GetDC (dpyinfo->root_window);
3c190163 6203
ee78dc32 6204 cap = GetDeviceCaps (hdc, HORZSIZE);
3c190163 6205
ee78dc32
GV		 6206 ReleaseDC (dpyinfo->root_window, hdc);
6207
6208 return make_number (cap);
6209}
6210
6211DEFUN ("x-display-backing-store", Fx_display_backing_store,
6212 Sx_display_backing_store, 0, 1, 0,
6213 "Returns an indication of whether display DISPLAY does backing store.\n\
6214The value may be `always', `when-mapped', or `not-useful'.\n\
6215The optional argument DISPLAY specifies which display to ask about.\n\
6216DISPLAY should be either a frame or a display name (a string).\n\
6217If omitted or nil, that stands for the selected frame's display.")
6218 (display)
6219 Lisp_Object display;
6220{
6221 return intern ("not-useful");
6222}
6223
6224DEFUN ("x-display-visual-class", Fx_display_visual_class,
6225 Sx_display_visual_class, 0, 1, 0,
6226 "Returns the visual class of the display DISPLAY.\n\
6227The value is one of the symbols `static-gray', `gray-scale',\n\
6228`static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
6229The optional argument DISPLAY specifies which display to ask about.\n\
6230DISPLAY should be either a frame or a display name (a string).\n\
6231If omitted or nil, that stands for the selected frame's display.")
6232 (display)
6233 Lisp_Object display;
6234{
fbd6baed 6235 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV		 6236
6237#if 0
6238 switch (dpyinfo->visual->class)
6239 {
6240 case StaticGray: return (intern ("static-gray"));
6241 case GrayScale: return (intern ("gray-scale"));
6242 case StaticColor: return (intern ("static-color"));
6243 case PseudoColor: return (intern ("pseudo-color"));
6244 case TrueColor: return (intern ("true-color"));
6245 case DirectColor: return (intern ("direct-color"));
6246 default:
6247 error ("Display has an unknown visual class");
6248 }
6249#endif
6250
6251 error ("Display has an unknown visual class");
6252}
6253
6254DEFUN ("x-display-save-under", Fx_display_save_under,
6255 Sx_display_save_under, 0, 1, 0,
6256 "Returns t if the display DISPLAY supports the save-under feature.\n\
6257The optional argument DISPLAY specifies which display to ask about.\n\
6258DISPLAY should be either a frame or a display name (a string).\n\
6259If omitted or nil, that stands for the selected frame's display.")
6260 (display)
6261 Lisp_Object display;
6262{
fbd6baed 6263 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV		 6264
6265 return Qnil;
6266}
6267\f
6268int
6269x_pixel_width (f)
6270 register struct frame *f;
6271{
6272 return PIXEL_WIDTH (f);
6273}
6274
6275int
6276x_pixel_height (f)
6277 register struct frame *f;
6278{
6279 return PIXEL_HEIGHT (f);
6280}
6281
6282int
6283x_char_width (f)
6284 register struct frame *f;
6285{
fbd6baed 6286 return FONT_WIDTH (f->output_data.w32->font);
ee78dc32
GV		 6287}
6288
6289int
6290x_char_height (f)
6291 register struct frame *f;
6292{
fbd6baed 6293 return f->output_data.w32->line_height;
ee78dc32
GV		 6294}
6295
6296int
6297x_screen_planes (frame)
6298 Lisp_Object frame;
6299{
fbd6baed
GV		 6300 return (FRAME_W32_DISPLAY_INFO (XFRAME (frame))->n_planes *
6301 FRAME_W32_DISPLAY_INFO (XFRAME (frame))->n_cbits);
ee78dc32
GV		 6302}
6303\f
6304/* Return the display structure for the display named NAME.
6305 Open a new connection if necessary. */
6306
fbd6baed 6307struct w32_display_info *
ee78dc32
GV		 6308x_display_info_for_name (name)
6309 Lisp_Object name;
6310{
6311 Lisp_Object names;
fbd6baed 6312 struct w32_display_info *dpyinfo;
ee78dc32
GV		 6313
6314 CHECK_STRING (name, 0);
6315
fbd6baed 6316 for (dpyinfo = &one_w32_display_info, names = w32_display_name_list;
ee78dc32
GV		 6317 dpyinfo;
6318 dpyinfo = dpyinfo->next, names = XCONS (names)->cdr)
6319 {
6320 Lisp_Object tem;
6321 tem = Fstring_equal (XCONS (XCONS (names)->car)->car, name);
6322 if (!NILP (tem))
6323 return dpyinfo;
6324 }
6325
6326 /* Use this general default value to start with. */
6327 Vx_resource_name = Vinvocation_name;
6328
6329 validate_x_resource_name ();
6330
fbd6baed 6331 dpyinfo = w32_term_init (name, (unsigned char *)0,
ee78dc32
GV		 6332 (char *) XSTRING (Vx_resource_name)->data);
6333
6334 if (dpyinfo == 0)
6335 error ("Cannot connect to server %s", XSTRING (name)->data);
6336
1edf84e7 6337 w32_in_use = 1;
ee78dc32
GV		 6338 XSETFASTINT (Vwindow_system_version, 3);
6339
6340 return dpyinfo;
6341}
6342
6343DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
6344 1, 3, 0, "Open a connection to a server.\n\
6345DISPLAY is the name of the display to connect to.\n\
6346Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
6347If the optional third arg MUST-SUCCEED is non-nil,\n\
6348terminate Emacs if we can't open the connection.")
6349 (display, xrm_string, must_succeed)
6350 Lisp_Object display, xrm_string, must_succeed;
6351{
6352 unsigned int n_planes;
6353 unsigned char *xrm_option;
fbd6baed 6354 struct w32_display_info *dpyinfo;
ee78dc32
GV		 6355
6356 CHECK_STRING (display, 0);
6357 if (! NILP (xrm_string))
6358 CHECK_STRING (xrm_string, 1);
6359
1edf84e7
GV		 6360 if (! EQ (Vwindow_system, intern ("w32")))
6361 error ("Not using Microsoft Windows");
6362
5ac45f98
GV		 6363 /* Allow color mapping to be defined externally; first look in user's
6364 HOME directory, then in Emacs etc dir for a file called rgb.txt. */
6365 {
6366 Lisp_Object color_file;
6367 struct gcpro gcpro1;
6368
6369 color_file = build_string("~/rgb.txt");
6370
6371 GCPRO1 (color_file);
6372
6373 if (NILP (Ffile_readable_p (color_file)))
6374 color_file =
6375 Fexpand_file_name (build_string ("rgb.txt"),
6376 Fsymbol_value (intern ("data-directory")));
6377
fbd6baed 6378 Vw32_color_map = Fw32_load_color_file (color_file);
5ac45f98
GV		 6379
6380 UNGCPRO;
6381 }
fbd6baed
GV		 6382 if (NILP (Vw32_color_map))
6383 Vw32_color_map = Fw32_default_color_map ();
ee78dc32
GV		 6384
6385 if (! NILP (xrm_string))
6386 xrm_option = (unsigned char *) XSTRING (xrm_string)->data;
6387 else
6388 xrm_option = (unsigned char *) 0;
6389
6390 /* Use this general default value to start with. */
5ac45f98
GV		 6391 /* First remove .exe suffix from invocation-name - it looks ugly. */
6392 {
6393 char basename[ MAX_PATH ], *str;
6394
6395 strcpy (basename, XSTRING (Vinvocation_name)->data);
6396 str = strrchr (basename, '.');
6397 if (str) *str = 0;
6398 Vinvocation_name = build_string (basename);
6399 }
ee78dc32
GV		 6400 Vx_resource_name = Vinvocation_name;
6401
6402 validate_x_resource_name ();
6403
6404 /* This is what opens the connection and sets x_current_display.
6405 This also initializes many symbols, such as those used for input. */
fbd6baed 6406 dpyinfo = w32_term_init (display, xrm_option,
ee78dc32
GV		 6407 (char *) XSTRING (Vx_resource_name)->data);
6408
6409 if (dpyinfo == 0)
6410 {
6411 if (!NILP (must_succeed))
3c190163
GV		 6412 fatal ("Cannot connect to server %s.\n",
6413 XSTRING (display)->data);
ee78dc32
GV		 6414 else
6415 error ("Cannot connect to server %s", XSTRING (display)->data);
6416 }
6417
1edf84e7
GV		 6418 w32_in_use = 1;
6419
ee78dc32
GV		 6420 XSETFASTINT (Vwindow_system_version, 3);
6421 return Qnil;
6422}
6423
6424DEFUN ("x-close-connection", Fx_close_connection,
6425 Sx_close_connection, 1, 1, 0,
6426 "Close the connection to DISPLAY's server.\n\
6427For DISPLAY, specify either a frame or a display name (a string).\n\
6428If DISPLAY is nil, that stands for the selected frame's display.")
6429 (display)
6430 Lisp_Object display;
6431{
fbd6baed
GV		 6432 struct w32_display_info *dpyinfo = check_x_display_info (display);
6433 struct w32_display_info *tail;
ee78dc32
GV		 6434 int i;
6435
6436 if (dpyinfo->reference_count > 0)
6437 error ("Display still has frames on it");
6438
6439 BLOCK_INPUT;
6440 /* Free the fonts in the font table. */
6441 for (i = 0; i < dpyinfo->n_fonts; i++)
6442 {
6443 if (dpyinfo->font_table[i].name)
6444 free (dpyinfo->font_table[i].name);
6445 /* Don't free the full_name string;
6446 it is always shared with something else. */
fbd6baed 6447 w32_unload_font (dpyinfo, dpyinfo->font_table[i].font);
ee78dc32
GV		 6448 }
6449 x_destroy_all_bitmaps (dpyinfo);
6450
6451 x_delete_display (dpyinfo);
6452 UNBLOCK_INPUT;
6453
6454 return Qnil;
6455}
6456
6457DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0,
6458 "Return the list of display names that Emacs has connections to.")
6459 ()
6460{
6461 Lisp_Object tail, result;
6462
6463 result = Qnil;
fbd6baed 6464 for (tail = w32_display_name_list; ! NILP (tail); tail = XCONS (tail)->cdr)
ee78dc32
GV		 6465 result = Fcons (XCONS (XCONS (tail)->car)->car, result);
6466
6467 return result;
6468}
6469
6470DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize, 1, 2, 0,
6471 "If ON is non-nil, report errors as soon as the erring request is made.\n\
6472If ON is nil, allow buffering of requests.\n\
fbd6baed 6473This is a noop on W32 systems.\n\
ee78dc32
GV		 6474The optional second argument DISPLAY specifies which display to act on.\n\
6475DISPLAY should be either a frame or a display name (a string).\n\
6476If DISPLAY is omitted or nil, that stands for the selected frame's display.")
6477 (on, display)
6478 Lisp_Object display, on;
6479{
fbd6baed 6480 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV		 6481
6482 return Qnil;
6483}
6484
6485\f
fbd6baed 6486/* These are the w32 specialized functions */
ee78dc32 6487
fbd6baed
GV		 6488DEFUN ("w32-select-font", Fw32_select_font, Sw32_select_font, 0, 1, 0,
6489 "This will display the W32 font dialog and return an X font string corresponding to the selection.")
ee78dc32
GV		 6490 (frame)
6491 Lisp_Object frame;
6492{
6493 FRAME_PTR f = check_x_frame (frame);
6494 CHOOSEFONT cf;
6495 LOGFONT lf;
6496 char buf[100];
6497
6498 bzero (&cf, sizeof (cf));
6499
6500 cf.lStructSize = sizeof (cf);
fbd6baed 6501 cf.hwndOwner = FRAME_W32_WINDOW (f);
ee78dc32
GV		 6502 cf.Flags = CF_FIXEDPITCHONLY | CF_FORCEFONTEXIST | CF_SCREENFONTS;
6503 cf.lpLogFont = &lf;
6504
fbd6baed 6505 if (!ChooseFont (&cf) || !w32_to_x_font (&lf, buf, 100))
3c190163 6506 return Qnil;
ee78dc32
GV		 6507
6508 return build_string (buf);
6509}
6510
1edf84e7
GV		 6511DEFUN ("w32-send-sys-command", Fw32_send_sys_command, Sw32_send_sys_command, 1, 2, 0,
6512 "Send frame a Windows WM_SYSCOMMAND message of type COMMAND.\n\
6513Some useful values for command are 0xf030 to maximise frame (0xf020\n\
6514to minimize), 0xf120 to restore frame to original size, and 0xf100\n\
6515to activate the menubar for keyboard access. 0xf140 activates the\n\
6516screen saver if defined.\n\
6517\n\
6518If optional parameter FRAME is not specified, use selected frame.")
6519 (command, frame)
6520 Lisp_Object command, frame;
6521{
6522 WPARAM code;
6523 FRAME_PTR f = check_x_frame (frame);
6524
6525 CHECK_NUMBER (command, 0);
6526
6527 PostMessage (FRAME_W32_WINDOW (f), WM_SYSCOMMAND, XINT (command), 0);
6528
6529 return Qnil;
6530}
6531
ccc2d29c
GV		 6532/* Lookup virtual keycode from string representing the name of a
6533 non-ascii keystroke into the corresponding virtual key, using
6534 lispy_function_keys. */
6535static int
6536lookup_vk_code (char *key)
6537{
6538 int i;
6539
6540 for (i = 0; i < 256; i++)
6541 if (lispy_function_keys[i] != 0
6542 && strcmp (lispy_function_keys[i], key) == 0)
6543 return i;
6544
6545 return -1;
6546}
6547
6548/* Convert a one-element vector style key sequence to a hot key
6549 definition. */
6550static int
6551w32_parse_hot_key (key)
6552 Lisp_Object key;
6553{
6554 /* Copied from Fdefine_key and store_in_keymap. */
6555 register Lisp_Object c;
6556 int vk_code;
6557 int lisp_modifiers;
6558 int w32_modifiers;
6559 struct gcpro gcpro1;
6560
6561 CHECK_VECTOR (key, 0);
6562
6563 if (XFASTINT (Flength (key)) != 1)
6564 return Qnil;
6565
6566 GCPRO1 (key);
6567
6568 c = Faref (key, make_number (0));
6569
6570 if (CONSP (c) && lucid_event_type_list_p (c))
6571 c = Fevent_convert_list (c);
6572
6573 UNGCPRO;
6574
6575 if (! INTEGERP (c) && ! SYMBOLP (c))
6576 error ("Key definition is invalid");
6577
6578 /* Work out the base key and the modifiers. */
6579 if (SYMBOLP (c))
6580 {
6581 c = parse_modifiers (c);
6582 lisp_modifiers = Fcar (Fcdr (c));
6583 c = Fcar (c);
6584 if (!SYMBOLP (c))
6585 abort ();
6586 vk_code = lookup_vk_code (XSYMBOL (c)->name->data);
6587 }
6588 else if (INTEGERP (c))
6589 {
6590 lisp_modifiers = XINT (c) & ~CHARACTERBITS;
6591 /* Many ascii characters are their own virtual key code. */
6592 vk_code = XINT (c) & CHARACTERBITS;
6593 }
6594
6595 if (vk_code < 0 || vk_code > 255)
6596 return Qnil;
6597
6598 if ((lisp_modifiers & meta_modifier) != 0
6599 && !NILP (Vw32_alt_is_meta))
6600 lisp_modifiers |= alt_modifier;
6601
6602 /* Convert lisp modifiers to Windows hot-key form. */
6603 w32_modifiers = (lisp_modifiers & hyper_modifier) ? MOD_WIN : 0;
6604 w32_modifiers |= (lisp_modifiers & alt_modifier) ? MOD_ALT : 0;
6605 w32_modifiers |= (lisp_modifiers & ctrl_modifier) ? MOD_CONTROL : 0;
6606 w32_modifiers |= (lisp_modifiers & shift_modifier) ? MOD_SHIFT : 0;
6607
6608 return HOTKEY (vk_code, w32_modifiers);
6609}
6610
6611DEFUN ("w32-register-hot-key", Fw32_register_hot_key, Sw32_register_hot_key, 1, 1, 0,
6612 "Register KEY as a hot-key combination.\n\
6613Certain key combinations like Alt-Tab are reserved for system use on\n\
6614Windows, and therefore are normally intercepted by the system. However,\n\
6615most of these key combinations can be received by registering them as\n\
6616hot-keys, overriding their special meaning.\n\
6617\n\
6618KEY must be a one element key definition in vector form that would be\n\
6619acceptable to `define-key' (e.g. [A-tab] for Alt-Tab). The meta\n\
6620modifier is interpreted as Alt if `w32-alt-is-meta' is t, and hyper\n\
6621is always interpreted as the Windows modifier keys.\n\
6622\n\
6623The return value is the hotkey-id if registered, otherwise nil.")
6624 (key)
6625 Lisp_Object key;
6626{
6627 key = w32_parse_hot_key (key);
6628
6629 if (NILP (Fmemq (key, w32_grabbed_keys)))
6630 {
6631 /* Reuse an empty slot if possible. */
6632 Lisp_Object item = Fmemq (Qnil, w32_grabbed_keys);
6633
6634 /* Safe to add new key to list, even if we have focus. */
6635 if (NILP (item))
6636 w32_grabbed_keys = Fcons (key, w32_grabbed_keys);
6637 else
6638 XCAR (item) = key;
6639
6640 /* Notify input thread about new hot-key definition, so that it
6641 takes effect without needing to switch focus. */
6642 PostThreadMessage (dwWindowsThreadId, WM_EMACS_REGISTER_HOT_KEY,
6643 (WPARAM) key, 0);
6644 }
6645
6646 return key;
6647}
6648
6649DEFUN ("w32-unregister-hot-key", Fw32_unregister_hot_key, Sw32_unregister_hot_key, 1, 1, 0,
6650 "Unregister HOTKEY as a hot-key combination.")
6651 (key)
6652 Lisp_Object key;
6653{
6654 Lisp_Object item;
6655
6656 if (!INTEGERP (key))
6657 key = w32_parse_hot_key (key);
6658
6659 item = Fmemq (key, w32_grabbed_keys);
6660
6661 if (!NILP (item))
6662 {
6663 /* Notify input thread about hot-key definition being removed, so
6664 that it takes effect without needing focus switch. */
6665 if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_UNREGISTER_HOT_KEY,
6666 (WPARAM) XINT (XCAR (item)), (LPARAM) item))
6667 {
6668 MSG msg;
6669 GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
6670 }
6671 return Qt;
6672 }
6673 return Qnil;
6674}
6675
6676DEFUN ("w32-registered-hot-keys", Fw32_registered_hot_keys, Sw32_registered_hot_keys, 0, 0, 0,
6677 "Return list of registered hot-key IDs.")
6678 ()
6679{
6680 return Fcopy_sequence (w32_grabbed_keys);
6681}
6682
6683DEFUN ("w32-reconstruct-hot-key", Fw32_reconstruct_hot_key, Sw32_reconstruct_hot_key, 1, 1, 0,
6684 "Convert hot-key ID to a lisp key combination.")
6685 (hotkeyid)
6686 Lisp_Object hotkeyid;
6687{
6688 int vk_code, w32_modifiers;
6689 Lisp_Object key;
6690
6691 CHECK_NUMBER (hotkeyid, 0);
6692
6693 vk_code = HOTKEY_VK_CODE (hotkeyid);
6694 w32_modifiers = HOTKEY_MODIFIERS (hotkeyid);
6695
6696 if (lispy_function_keys[vk_code])
6697 key = intern (lispy_function_keys[vk_code]);
6698 else
6699 key = make_number (vk_code);
6700
6701 key = Fcons (key, Qnil);
6702 if (w32_modifiers & MOD_SHIFT)
6703 key = Fcons (intern ("shift"), key);
6704 if (w32_modifiers & MOD_CONTROL)
6705 key = Fcons (intern ("control"), key);
6706 if (w32_modifiers & MOD_ALT)
6707 key = Fcons (intern (NILP (Vw32_alt_is_meta) ? "alt" : "meta"), key);
6708 if (w32_modifiers & MOD_WIN)
6709 key = Fcons (intern ("hyper"), key);
6710
6711 return key;
6712}
adcc3809
GV		 6713
6714DEFUN ("w32-toggle-lock-key", Fw32_toggle_lock_key, Sw32_toggle_lock_key, 1, 2, 0,
6715 "Toggle the state of the lock key KEY.\n\
6716KEY can be `capslock', `kp-numlock', or `scroll'.\n\
6717If the optional parameter NEW-STATE is a number, then the state of KEY\n\
6718is set to off if the low bit of NEW-STATE is zero, otherwise on.")
6719 (key, new_state)
6720 Lisp_Object key, new_state;
6721{
6722 int vk_code;
6723 int cur_state;
6724
6725 if (EQ (key, intern ("capslock")))
6726 vk_code = VK_CAPITAL;
6727 else if (EQ (key, intern ("kp-numlock")))
6728 vk_code = VK_NUMLOCK;
6729 else if (EQ (key, intern ("scroll")))
6730 vk_code = VK_SCROLL;
6731 else
6732 return Qnil;
6733
6734 if (!dwWindowsThreadId)
6735 return make_number (w32_console_toggle_lock_key (vk_code, new_state));
6736
6737 if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_TOGGLE_LOCK_KEY,
6738 (WPARAM) vk_code, (LPARAM) new_state))
6739 {
6740 MSG msg;
6741 GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
6742 return make_number (msg.wParam);
6743 }
6744 return Qnil;
6745}
ee78dc32 6746\f
fbd6baed 6747syms_of_w32fns ()
ee78dc32 6748{
1edf84e7
GV		 6749 /* This is zero if not using MS-Windows. */
6750 w32_in_use = 0;
6751
ee78dc32
GV		 6752 /* The section below is built by the lisp expression at the top of the file,
6753 just above where these variables are declared. */
6754 /*&&& init symbols here &&&*/
6755 Qauto_raise = intern ("auto-raise");
6756 staticpro (&Qauto_raise);
6757 Qauto_lower = intern ("auto-lower");
6758 staticpro (&Qauto_lower);
6759 Qbackground_color = intern ("background-color");
6760 staticpro (&Qbackground_color);
6761 Qbar = intern ("bar");
6762 staticpro (&Qbar);
6763 Qborder_color = intern ("border-color");
6764 staticpro (&Qborder_color);
6765 Qborder_width = intern ("border-width");
6766 staticpro (&Qborder_width);
6767 Qbox = intern ("box");
6768 staticpro (&Qbox);
6769 Qcursor_color = intern ("cursor-color");
6770 staticpro (&Qcursor_color);
6771 Qcursor_type = intern ("cursor-type");
6772 staticpro (&Qcursor_type);
ee78dc32
GV		 6773 Qforeground_color = intern ("foreground-color");
6774 staticpro (&Qforeground_color);
6775 Qgeometry = intern ("geometry");
6776 staticpro (&Qgeometry);
6777 Qicon_left = intern ("icon-left");
6778 staticpro (&Qicon_left);
6779 Qicon_top = intern ("icon-top");
6780 staticpro (&Qicon_top);
6781 Qicon_type = intern ("icon-type");
6782 staticpro (&Qicon_type);
6783 Qicon_name = intern ("icon-name");
6784 staticpro (&Qicon_name);
6785 Qinternal_border_width = intern ("internal-border-width");
6786 staticpro (&Qinternal_border_width);
6787 Qleft = intern ("left");
6788 staticpro (&Qleft);
1026b400
RS		 6789 Qright = intern ("right");
6790 staticpro (&Qright);
ee78dc32
GV		 6791 Qmouse_color = intern ("mouse-color");
6792 staticpro (&Qmouse_color);
6793 Qnone = intern ("none");
6794 staticpro (&Qnone);
6795 Qparent_id = intern ("parent-id");
6796 staticpro (&Qparent_id);
6797 Qscroll_bar_width = intern ("scroll-bar-width");
6798 staticpro (&Qscroll_bar_width);
6799 Qsuppress_icon = intern ("suppress-icon");
6800 staticpro (&Qsuppress_icon);
6801 Qtop = intern ("top");
6802 staticpro (&Qtop);
6803 Qundefined_color = intern ("undefined-color");
6804 staticpro (&Qundefined_color);
6805 Qvertical_scroll_bars = intern ("vertical-scroll-bars");
6806 staticpro (&Qvertical_scroll_bars);
6807 Qvisibility = intern ("visibility");
6808 staticpro (&Qvisibility);
6809 Qwindow_id = intern ("window-id");
6810 staticpro (&Qwindow_id);
6811 Qx_frame_parameter = intern ("x-frame-parameter");
6812 staticpro (&Qx_frame_parameter);
6813 Qx_resource_name = intern ("x-resource-name");
6814 staticpro (&Qx_resource_name);
6815 Quser_position = intern ("user-position");
6816 staticpro (&Quser_position);
6817 Quser_size = intern ("user-size");
6818 staticpro (&Quser_size);
6819 Qdisplay = intern ("display");
6820 staticpro (&Qdisplay);
6821 /* This is the end of symbol initialization. */
6822
adcc3809
GV		 6823 Qhyper = intern ("hyper");
6824 staticpro (&Qhyper);
6825 Qsuper = intern ("super");
6826 staticpro (&Qsuper);
6827 Qmeta = intern ("meta");
6828 staticpro (&Qmeta);
6829 Qalt = intern ("alt");
6830 staticpro (&Qalt);
6831 Qctrl = intern ("ctrl");
6832 staticpro (&Qctrl);
6833 Qcontrol = intern ("control");
6834 staticpro (&Qcontrol);
6835 Qshift = intern ("shift");
6836 staticpro (&Qshift);
6837
4b817373
RS		 6838 Qface_set_after_frame_default = intern ("face-set-after-frame-default");
6839 staticpro (&Qface_set_after_frame_default);
6840
ee78dc32
GV		 6841 Fput (Qundefined_color, Qerror_conditions,
6842 Fcons (Qundefined_color, Fcons (Qerror, Qnil)));
6843 Fput (Qundefined_color, Qerror_message,
6844 build_string ("Undefined color"));
6845
ccc2d29c
GV		 6846 staticpro (&w32_grabbed_keys);
6847 w32_grabbed_keys = Qnil;
6848
fbd6baed 6849 DEFVAR_LISP ("w32-color-map", &Vw32_color_map,
ccc2d29c 6850 "An array of color name mappings for windows.");
fbd6baed 6851 Vw32_color_map = Qnil;
ee78dc32 6852
fbd6baed 6853 DEFVAR_LISP ("w32-pass-alt-to-system", &Vw32_pass_alt_to_system,
da36a4d6
GV		 6854 "Non-nil if alt key presses are passed on to Windows.\n\
6855When non-nil, for example, alt pressed and released and then space will\n\
6856open the System menu. When nil, Emacs silently swallows alt key events.");
fbd6baed 6857 Vw32_pass_alt_to_system = Qnil;
da36a4d6 6858
fbd6baed 6859 DEFVAR_LISP ("w32-alt-is-meta", &Vw32_alt_is_meta,
8c205c63
RS		 6860 "Non-nil if the alt key is to be considered the same as the meta key.\n\
6861When nil, Emacs will translate the alt key to the Alt modifier, and not Meta.");
fbd6baed 6862 Vw32_alt_is_meta = Qt;
8c205c63 6863
ccc2d29c
GV		 6864 DEFVAR_LISP ("w32-pass-lwindow-to-system",
6865 &Vw32_pass_lwindow_to_system,
6866 "Non-nil if the left \"Windows\" key is passed on to Windows.\n\
6867When non-nil, the Start menu is opened by tapping the key.");
6868 Vw32_pass_lwindow_to_system = Qt;
6869
6870 DEFVAR_LISP ("w32-pass-rwindow-to-system",
6871 &Vw32_pass_rwindow_to_system,
6872 "Non-nil if the right \"Windows\" key is passed on to Windows.\n\
6873When non-nil, the Start menu is opened by tapping the key.");
6874 Vw32_pass_rwindow_to_system = Qt;
6875
adcc3809
GV		 6876 DEFVAR_INT ("w32-phantom-key-code",
6877 &Vw32_phantom_key_code,
6878 "Virtual key code used to generate \"phantom\" key presses.\n\
6879Value is a number between 0 and 255.\n\
6880\n\
6881Phantom key presses are generated in order to stop the system from\n\
6882acting on \"Windows\" key events when `w32-pass-lwindow-to-system' or\n\
6883`w32-pass-rwindow-to-system' is nil.");
6884 Vw32_phantom_key_code = VK_SPACE;
6885
ccc2d29c
GV		 6886 DEFVAR_LISP ("w32-enable-num-lock",
6887 &Vw32_enable_num_lock,
6888 "Non-nil if Num Lock should act normally.\n\
6889Set to nil to see Num Lock as the key `kp-numlock'.");
6890 Vw32_enable_num_lock = Qt;
6891
6892 DEFVAR_LISP ("w32-enable-caps-lock",
6893 &Vw32_enable_caps_lock,
6894 "Non-nil if Caps Lock should act normally.\n\
6895Set to nil to see Caps Lock as the key `capslock'.");
6896 Vw32_enable_caps_lock = Qt;
6897
6898 DEFVAR_LISP ("w32-scroll-lock-modifier",
6899 &Vw32_scroll_lock_modifier,
6900 "Modifier to use for the Scroll Lock on state.\n\
6901The value can be hyper, super, meta, alt, control or shift for the\n\
6902respective modifier, or nil to see Scroll Lock as the key `scroll'.\n\
6903Any other value will cause the key to be ignored.");
6904 Vw32_scroll_lock_modifier = Qt;
6905
6906 DEFVAR_LISP ("w32-lwindow-modifier",
6907 &Vw32_lwindow_modifier,
6908 "Modifier to use for the left \"Windows\" key.\n\
6909The value can be hyper, super, meta, alt, control or shift for the\n\
6910respective modifier, or nil to appear as the key `lwindow'.\n\
6911Any other value will cause the key to be ignored.");
6912 Vw32_lwindow_modifier = Qnil;
6913
6914 DEFVAR_LISP ("w32-rwindow-modifier",
6915 &Vw32_rwindow_modifier,
6916 "Modifier to use for the right \"Windows\" key.\n\
6917The value can be hyper, super, meta, alt, control or shift for the\n\
6918respective modifier, or nil to appear as the key `rwindow'.\n\
6919Any other value will cause the key to be ignored.");
6920 Vw32_rwindow_modifier = Qnil;
6921
6922 DEFVAR_LISP ("w32-apps-modifier",
6923 &Vw32_apps_modifier,
6924 "Modifier to use for the \"Apps\" key.\n\
6925The value can be hyper, super, meta, alt, control or shift for the\n\
6926respective modifier, or nil to appear as the key `apps'.\n\
6927Any other value will cause the key to be ignored.");
6928 Vw32_apps_modifier = Qnil;
da36a4d6 6929
fbd6baed 6930 DEFVAR_LISP ("w32-enable-italics", &Vw32_enable_italics,
5ac45f98 6931 "Non-nil enables selection of artificially italicized fonts.");
fbd6baed 6932 Vw32_enable_italics = Qnil;
5ac45f98 6933
fbd6baed 6934 DEFVAR_LISP ("w32-enable-palette", &Vw32_enable_palette,
5ac45f98 6935 "Non-nil enables Windows palette management to map colors exactly.");
fbd6baed 6936 Vw32_enable_palette = Qt;
5ac45f98 6937
fbd6baed
GV		 6938 DEFVAR_INT ("w32-mouse-button-tolerance",
6939 &Vw32_mouse_button_tolerance,
5ac45f98
GV		 6940 "Analogue of double click interval for faking middle mouse events.\n\
6941The value is the minimum time in milliseconds that must elapse between\n\
6942left/right button down events before they are considered distinct events.\n\
6943If both mouse buttons are depressed within this interval, a middle mouse\n\
6944button down event is generated instead.");
fbd6baed 6945 XSETINT (Vw32_mouse_button_tolerance, GetDoubleClickTime () / 2);
5ac45f98 6946
fbd6baed
GV		 6947 DEFVAR_INT ("w32-mouse-move-interval",
6948 &Vw32_mouse_move_interval,
84fb1139
KH		 6949 "Minimum interval between mouse move events.\n\
6950The value is the minimum time in milliseconds that must elapse between\n\
6951successive mouse move (or scroll bar drag) events before they are\n\
6952reported as lisp events.");
fbd6baed 6953 XSETINT (Vw32_mouse_move_interval, 50);
84fb1139 6954
ee78dc32
GV		 6955 init_x_parm_symbols ();
6956
6957 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path,
fbd6baed 6958 "List of directories to search for bitmap files for w32.");
ee78dc32
GV		 6959 Vx_bitmap_file_path = decode_env_path ((char *) 0, "PATH");
6960
6961 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape,
6962 "The shape of the pointer when over text.\n\
6963Changing the value does not affect existing frames\n\
6964unless you set the mouse color.");
6965 Vx_pointer_shape = Qnil;
6966
6967 DEFVAR_LISP ("x-resource-name", &Vx_resource_name,
6968 "The name Emacs uses to look up resources; for internal use only.\n\
6969`x-get-resource' uses this as the first component of the instance name\n\
6970when requesting resource values.\n\
6971Emacs initially sets `x-resource-name' to the name under which Emacs\n\
6972was invoked, or to the value specified with the `-name' or `-rn'\n\
6973switches, if present.");
6974 Vx_resource_name = Qnil;
6975
6976 Vx_nontext_pointer_shape = Qnil;
6977
6978 Vx_mode_pointer_shape = Qnil;
6979
6980 DEFVAR_INT ("x-sensitive-text-pointer-shape",
6981 &Vx_sensitive_text_pointer_shape,
6982 "The shape of the pointer when over mouse-sensitive text.\n\
6983This variable takes effect when you create a new frame\n\
6984or when you set the mouse color.");
6985 Vx_sensitive_text_pointer_shape = Qnil;
6986
6987 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel,
6988 "A string indicating the foreground color of the cursor box.");
6989 Vx_cursor_fore_pixel = Qnil;
6990
6991 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager,
6992 "Non-nil if no window manager is in use.\n\
6993Emacs doesn't try to figure this out; this is always nil\n\
6994unless you set it to something else.");
6995 /* We don't have any way to find this out, so set it to nil
6996 and maybe the user would like to set it to t. */
6997 Vx_no_window_manager = Qnil;
6998
4587b026
GV		 6999 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
7000 &Vx_pixel_size_width_font_regexp,
7001 "Regexp matching a font name whose width is the same as `PIXEL_SIZE'.\n\
7002\n\
7003Since Emacs gets width of a font matching with this regexp from\n\
7004PIXEL_SIZE field of the name, font finding mechanism gets faster for\n\
7005such a font. This is especially effective for such large fonts as\n\
7006Chinese, Japanese, and Korean.");
7007 Vx_pixel_size_width_font_regexp = Qnil;
7008
7009 DEFVAR_BOOL ("unibyte-display-via-language-environment",
7010 &unibyte_display_via_language_environment,
7011 "*Non-nil means display unibyte text according to language environment.\n\
7012Specifically this means that unibyte non-ASCII characters\n\
7013are displayed by converting them to the equivalent multibyte characters\n\
7014according to the current language environment. As a result, they are\n\
7015displayed according to the current fontset.");
7016 unibyte_display_via_language_environment = 0;
7017
ee78dc32
GV		 7018 defsubr (&Sx_get_resource);
7019 defsubr (&Sx_list_fonts);
7020 defsubr (&Sx_display_color_p);
7021 defsubr (&Sx_display_grayscale_p);
7022 defsubr (&Sx_color_defined_p);
7023 defsubr (&Sx_color_values);
7024 defsubr (&Sx_server_max_request_size);
7025 defsubr (&Sx_server_vendor);
7026 defsubr (&Sx_server_version);
7027 defsubr (&Sx_display_pixel_width);
7028 defsubr (&Sx_display_pixel_height);
7029 defsubr (&Sx_display_mm_width);
7030 defsubr (&Sx_display_mm_height);
7031 defsubr (&Sx_display_screens);
7032 defsubr (&Sx_display_planes);
7033 defsubr (&Sx_display_color_cells);
7034 defsubr (&Sx_display_visual_class);
7035 defsubr (&Sx_display_backing_store);
7036 defsubr (&Sx_display_save_under);
7037 defsubr (&Sx_parse_geometry);
7038 defsubr (&Sx_create_frame);
ee78dc32
GV		 7039 defsubr (&Sx_open_connection);
7040 defsubr (&Sx_close_connection);
7041 defsubr (&Sx_display_list);
7042 defsubr (&Sx_synchronize);
7043
fbd6baed 7044 /* W32 specific functions */
ee78dc32 7045
1edf84e7 7046 defsubr (&Sw32_focus_frame);
fbd6baed
GV		 7047 defsubr (&Sw32_select_font);
7048 defsubr (&Sw32_define_rgb_color);
7049 defsubr (&Sw32_default_color_map);
7050 defsubr (&Sw32_load_color_file);
1edf84e7 7051 defsubr (&Sw32_send_sys_command);
ccc2d29c
GV		 7052 defsubr (&Sw32_register_hot_key);
7053 defsubr (&Sw32_unregister_hot_key);
7054 defsubr (&Sw32_registered_hot_keys);
7055 defsubr (&Sw32_reconstruct_hot_key);
adcc3809 7056 defsubr (&Sw32_toggle_lock_key);
4587b026
GV		 7057
7058 /* Setting callback functions for fontset handler. */
7059 get_font_info_func = w32_get_font_info;
7060 list_fonts_func = w32_list_fonts;
7061 load_font_func = w32_load_font;
7062 find_ccl_program_func = w32_find_ccl_program;
7063 query_font_func = w32_query_font;
7064 set_frame_fontset_func = x_set_font;
7065 check_window_system_func = check_w32;
ee78dc32
GV		 7066}
7067
7068#undef abort
7069
7070void
fbd6baed 7071w32_abort()
ee78dc32 7072{
5ac45f98
GV		 7073 int button;
7074 button = MessageBox (NULL,
7075 "A fatal error has occurred!\n\n"
7076 "Select Abort to exit, Retry to debug, Ignore to continue",
7077 "Emacs Abort Dialog",
7078 MB_ICONEXCLAMATION | MB_TASKMODAL
7079 | MB_SETFOREGROUND | MB_ABORTRETRYIGNORE);
7080 switch (button)
7081 {
7082 case IDRETRY:
7083 DebugBreak ();
7084 break;
7085 case IDIGNORE:
7086 break;
7087 case IDABORT:
7088 default:
7089 abort ();
7090 break;
7091 }
ee78dc32 7092}
d573caac 7093
83c75055
GV		 7094/* For convenience when debugging. */
7095int
7096w32_last_error()
7097{
7098 return GetLastError ();
7099}
Unnamed repository; edit this file 'description' to name the repository.