HCoop / bpt / emacs.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Doc fix.
[bpt/emacs.git] / src / w32fns.c
CommitLineData
e9e23e23 1/* Graphical user interface functions for the Microsoft W32 API.
a93f4566 2 Copyright (C) 1989, 92, 93, 94, 95, 1996, 1997, 1998, 1999, 2000, 2001
6fc2811b 3 Free Software Foundation, Inc.
ee78dc32
GV		 4
5This file is part of GNU Emacs.
6
7GNU Emacs is free software; you can redistribute it and/or modify
8it under the terms of the GNU General Public License as published by
9the Free Software Foundation; either version 2, or (at your option)
10any later version.
11
12GNU Emacs is distributed in the hope that it will be useful,
13but WITHOUT ANY WARRANTY; without even the implied warranty of
14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15GNU General Public License for more details.
16
17You should have received a copy of the GNU General Public License
18along with GNU Emacs; see the file COPYING. If not, write to
3b7ad313
EN		 19the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20Boston, MA 02111-1307, USA. */
ee78dc32
GV		 21
22/* Added by Kevin Gallo */
23
ee78dc32 24#include <config.h>
1edf84e7
GV		 25
26#include <signal.h>
ee78dc32 27#include <stdio.h>
1edf84e7
GV		 28#include <limits.h>
29#include <errno.h>
ee78dc32
GV		 30
31#include "lisp.h"
4587b026 32#include "charset.h"
71eab8d1 33#include "dispextern.h"
ee78dc32 34#include "w32term.h"
c7501041 35#include "keyboard.h"
ee78dc32
GV		 36#include "frame.h"
37#include "window.h"
38#include "buffer.h"
126f2e35 39#include "fontset.h"
6fc2811b 40#include "intervals.h"
ee78dc32 41#include "blockinput.h"
57bda87a 42#include "epaths.h"
489f9371 43#include "w32heap.h"
ee78dc32 44#include "termhooks.h"
4587b026 45#include "coding.h"
3545439c 46#include "ccl.h"
6fc2811b
JR		 47#include "systime.h"
48
49#include "bitmaps/gray.xbm"
ee78dc32
GV		 50
51#include <commdlg.h>
cb9e33d4 52#include <shellapi.h>
6fc2811b 53#include <ctype.h>
ee78dc32 54
ee78dc32 55extern void free_frame_menubar ();
6fc2811b 56extern double atof ();
adcc3809 57extern int w32_console_toggle_lock_key (int vk_code, Lisp_Object new_state);
5ac45f98 58extern int quit_char;
ee78dc32 59
6fc2811b
JR		 60/* A definition of XColor for non-X frames. */
61#ifndef HAVE_X_WINDOWS
62typedef struct {
63 unsigned long pixel;
64 unsigned short red, green, blue;
65 char flags;
66 char pad;
67} XColor;
68#endif
69
ccc2d29c
GV		 70extern char *lispy_function_keys[];
71
6fc2811b
JR		 72/* The gray bitmap `bitmaps/gray'. This is done because w32term.c uses
73 it, and including `bitmaps/gray' more than once is a problem when
74 config.h defines `static' as an empty replacement string. */
75
76int gray_bitmap_width = gray_width;
77int gray_bitmap_height = gray_height;
78unsigned char *gray_bitmap_bits = gray_bits;
79
ee78dc32 80/* The colormap for converting color names to RGB values */
fbd6baed 81Lisp_Object Vw32_color_map;
ee78dc32 82
da36a4d6 83/* Non nil if alt key presses are passed on to Windows. */
fbd6baed 84Lisp_Object Vw32_pass_alt_to_system;
da36a4d6 85
8c205c63
RS		 86/* Non nil if alt key is translated to meta_modifier, nil if it is translated
87 to alt_modifier. */
fbd6baed 88Lisp_Object Vw32_alt_is_meta;
8c205c63 89
7d081355
AI		 90/* If non-zero, the windows virtual key code for an alternative quit key. */
91Lisp_Object Vw32_quit_key;
92
ccc2d29c
GV		 93/* Non nil if left window key events are passed on to Windows (this only
94 affects whether "tapping" the key opens the Start menu). */
95Lisp_Object Vw32_pass_lwindow_to_system;
96
97/* Non nil if right window key events are passed on to Windows (this
98 only affects whether "tapping" the key opens the Start menu). */
99Lisp_Object Vw32_pass_rwindow_to_system;
100
adcc3809
GV		 101/* Virtual key code used to generate "phantom" key presses in order
102 to stop system from acting on Windows key events. */
103Lisp_Object Vw32_phantom_key_code;
104
ccc2d29c
GV		 105/* Modifier associated with the left "Windows" key, or nil to act as a
106 normal key. */
107Lisp_Object Vw32_lwindow_modifier;
108
109/* Modifier associated with the right "Windows" key, or nil to act as a
110 normal key. */
111Lisp_Object Vw32_rwindow_modifier;
112
113/* Modifier associated with the "Apps" key, or nil to act as a normal
114 key. */
115Lisp_Object Vw32_apps_modifier;
116
117/* Value is nil if Num Lock acts as a function key. */
118Lisp_Object Vw32_enable_num_lock;
119
120/* Value is nil if Caps Lock acts as a function key. */
121Lisp_Object Vw32_enable_caps_lock;
122
123/* Modifier associated with Scroll Lock, or nil to act as a normal key. */
124Lisp_Object Vw32_scroll_lock_modifier;
da36a4d6 125
7ce9aaca 126/* Switch to control whether we inhibit requests for synthesized bold
6fc2811b
JR		 127 and italic versions of fonts. */
128Lisp_Object Vw32_enable_synthesized_fonts;
5ac45f98
GV		 129
130/* Enable palette management. */
fbd6baed 131Lisp_Object Vw32_enable_palette;
5ac45f98
GV		 132
133/* Control how close left/right button down events must be to
134 be converted to a middle button down event. */
fbd6baed 135Lisp_Object Vw32_mouse_button_tolerance;
5ac45f98 136
84fb1139
KH		 137/* Minimum interval between mouse movement (and scroll bar drag)
138 events that are passed on to the event loop. */
fbd6baed 139Lisp_Object Vw32_mouse_move_interval;
84fb1139 140
ee78dc32
GV		 141/* The name we're using in resource queries. */
142Lisp_Object Vx_resource_name;
143
144/* Non nil if no window manager is in use. */
145Lisp_Object Vx_no_window_manager;
146
0af913d7 147/* Non-zero means we're allowed to display a hourglass pointer. */
dfff8a69 148
0af913d7 149int display_hourglass_p;
6fc2811b 150
ee78dc32
GV		 151/* The background and shape of the mouse pointer, and shape when not
152 over text or in the modeline. */
dfff8a69 153
ee78dc32 154Lisp_Object Vx_pointer_shape, Vx_nontext_pointer_shape, Vx_mode_pointer_shape;
0af913d7 155Lisp_Object Vx_hourglass_pointer_shape, Vx_window_horizontal_drag_shape;
6fc2811b 156
ee78dc32 157/* The shape when over mouse-sensitive text. */
dfff8a69 158
ee78dc32
GV		 159Lisp_Object Vx_sensitive_text_pointer_shape;
160
161/* Color of chars displayed in cursor box. */
dfff8a69 162
ee78dc32
GV		 163Lisp_Object Vx_cursor_fore_pixel;
164
1edf84e7 165/* Nonzero if using Windows. */
dfff8a69 166
1edf84e7
GV		 167static int w32_in_use;
168
ee78dc32 169/* Search path for bitmap files. */
dfff8a69 170
ee78dc32
GV		 171Lisp_Object Vx_bitmap_file_path;
172
4587b026 173/* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
dfff8a69 174
4587b026
GV		 175Lisp_Object Vx_pixel_size_width_font_regexp;
176
33d52f9c
GV		 177/* Alist of bdf fonts and the files that define them. */
178Lisp_Object Vw32_bdf_filename_alist;
179
f46e6225
GV		 180Lisp_Object Vw32_system_coding_system;
181
f46e6225 182/* A flag to control whether fonts are matched strictly or not. */
1075afa9
GV		 183int w32_strict_fontnames;
184
c0611964
AI		 185/* A flag to control whether we should only repaint if GetUpdateRect
186 indicates there is an update region. */
187int w32_strict_painting;
188
dfff8a69
JR		 189/* Associative list linking character set strings to Windows codepages. */
190Lisp_Object Vw32_charset_info_alist;
191
192/* VIETNAMESE_CHARSET is not defined in some versions of MSVC. */
193#ifndef VIETNAMESE_CHARSET
194#define VIETNAMESE_CHARSET 163
195#endif
196
ee78dc32
GV		 197Lisp_Object Qauto_raise;
198Lisp_Object Qauto_lower;
ee78dc32
GV		 199Lisp_Object Qbar;
200Lisp_Object Qborder_color;
201Lisp_Object Qborder_width;
202Lisp_Object Qbox;
203Lisp_Object Qcursor_color;
204Lisp_Object Qcursor_type;
ee78dc32
GV		 205Lisp_Object Qgeometry;
206Lisp_Object Qicon_left;
207Lisp_Object Qicon_top;
208Lisp_Object Qicon_type;
209Lisp_Object Qicon_name;
210Lisp_Object Qinternal_border_width;
211Lisp_Object Qleft;
1026b400 212Lisp_Object Qright;
ee78dc32
GV		 213Lisp_Object Qmouse_color;
214Lisp_Object Qnone;
215Lisp_Object Qparent_id;
216Lisp_Object Qscroll_bar_width;
217Lisp_Object Qsuppress_icon;
ee78dc32
GV		 218Lisp_Object Qundefined_color;
219Lisp_Object Qvertical_scroll_bars;
220Lisp_Object Qvisibility;
221Lisp_Object Qwindow_id;
222Lisp_Object Qx_frame_parameter;
223Lisp_Object Qx_resource_name;
224Lisp_Object Quser_position;
225Lisp_Object Quser_size;
6fc2811b 226Lisp_Object Qscreen_gamma;
dfff8a69
JR		 227Lisp_Object Qline_spacing;
228Lisp_Object Qcenter;
dc220243 229Lisp_Object Qcancel_timer;
adcc3809
GV		 230Lisp_Object Qhyper;
231Lisp_Object Qsuper;
232Lisp_Object Qmeta;
233Lisp_Object Qalt;
234Lisp_Object Qctrl;
235Lisp_Object Qcontrol;
236Lisp_Object Qshift;
237
dfff8a69
JR		 238Lisp_Object Qw32_charset_ansi;
239Lisp_Object Qw32_charset_default;
240Lisp_Object Qw32_charset_symbol;
241Lisp_Object Qw32_charset_shiftjis;
767b1ff0 242Lisp_Object Qw32_charset_hangeul;
dfff8a69
JR		 243Lisp_Object Qw32_charset_gb2312;
244Lisp_Object Qw32_charset_chinesebig5;
245Lisp_Object Qw32_charset_oem;
246
71eab8d1
AI		 247#ifndef JOHAB_CHARSET
248#define JOHAB_CHARSET 130
249#endif
dfff8a69
JR		 250#ifdef JOHAB_CHARSET
251Lisp_Object Qw32_charset_easteurope;
252Lisp_Object Qw32_charset_turkish;
253Lisp_Object Qw32_charset_baltic;
254Lisp_Object Qw32_charset_russian;
255Lisp_Object Qw32_charset_arabic;
256Lisp_Object Qw32_charset_greek;
257Lisp_Object Qw32_charset_hebrew;
767b1ff0 258Lisp_Object Qw32_charset_vietnamese;
dfff8a69
JR		 259Lisp_Object Qw32_charset_thai;
260Lisp_Object Qw32_charset_johab;
261Lisp_Object Qw32_charset_mac;
262#endif
263
264#ifdef UNICODE_CHARSET
265Lisp_Object Qw32_charset_unicode;
266#endif
267
6fc2811b
JR		 268extern Lisp_Object Qtop;
269extern Lisp_Object Qdisplay;
270extern Lisp_Object Qtool_bar_lines;
271
5ac45f98
GV		 272/* State variables for emulating a three button mouse. */
273#define LMOUSE 1
274#define MMOUSE 2
275#define RMOUSE 4
276
277static int button_state = 0;
fbd6baed 278static W32Msg saved_mouse_button_msg;
84fb1139 279static unsigned mouse_button_timer; /* non-zero when timer is active */
fbd6baed 280static W32Msg saved_mouse_move_msg;
84fb1139
KH		 281static unsigned mouse_move_timer;
282
93fbe8b7
GV		 283/* W95 mousewheel handler */
284unsigned int msh_mousewheel = 0;
285
84fb1139
KH		 286#define MOUSE_BUTTON_ID 1
287#define MOUSE_MOVE_ID 2
5ac45f98 288
ee78dc32 289/* The below are defined in frame.c. */
dfff8a69 290
ee78dc32 291extern Lisp_Object Qheight, Qminibuffer, Qname, Qonly, Qwidth;
1edf84e7 292extern Lisp_Object Qunsplittable, Qmenu_bar_lines, Qbuffer_predicate, Qtitle;
6fc2811b 293extern Lisp_Object Qtool_bar_lines;
ee78dc32
GV		 294
295extern Lisp_Object Vwindow_system_version;
296
4b817373
RS		 297Lisp_Object Qface_set_after_frame_default;
298
937e601e
AI		 299#ifdef GLYPH_DEBUG
300int image_cache_refcount, dpyinfo_refcount;
301#endif
302
303
fbd6baed
GV		 304/* From w32term.c. */
305extern Lisp_Object Vw32_num_mouse_buttons;
ccc2d29c 306extern Lisp_Object Vw32_recognize_altgr;
5ac45f98 307
65906840
JR		 308extern HWND w32_system_caret_hwnd;
309extern int w32_system_caret_width;
310extern int w32_system_caret_height;
311extern int w32_system_caret_x;
312extern int w32_system_caret_y;
313
ee78dc32 314\f
1edf84e7
GV		 315/* Error if we are not connected to MS-Windows. */
316void
317check_w32 ()
318{
319 if (! w32_in_use)
320 error ("MS-Windows not in use or not initialized");
321}
322
323/* Nonzero if we can use mouse menus.
324 You should not call this unless HAVE_MENUS is defined. */
325
326int
327have_menus_p ()
328{
329 return w32_in_use;
330}
331
ee78dc32 332/* Extract a frame as a FRAME_PTR, defaulting to the selected frame
fbd6baed 333 and checking validity for W32. */
ee78dc32
GV		 334
335FRAME_PTR
336check_x_frame (frame)
337 Lisp_Object frame;
338{
339 FRAME_PTR f;
340
341 if (NILP (frame))
6fc2811b 342 frame = selected_frame;
b7826503 343 CHECK_LIVE_FRAME (frame);
6fc2811b 344 f = XFRAME (frame);
fbd6baed
GV		 345 if (! FRAME_W32_P (f))
346 error ("non-w32 frame used");
ee78dc32
GV		 347 return f;
348}
349
350/* Let the user specify an display with a frame.
fbd6baed 351 nil stands for the selected frame--or, if that is not a w32 frame,
ee78dc32
GV		 352 the first display on the list. */
353
fbd6baed 354static struct w32_display_info *
ee78dc32
GV		 355check_x_display_info (frame)
356 Lisp_Object frame;
357{
358 if (NILP (frame))
359 {
6fc2811b
JR		 360 struct frame *sf = XFRAME (selected_frame);
361
362 if (FRAME_W32_P (sf) && FRAME_LIVE_P (sf))
363 return FRAME_W32_DISPLAY_INFO (sf);
ee78dc32 364 else
fbd6baed 365 return &one_w32_display_info;
ee78dc32
GV		 366 }
367 else if (STRINGP (frame))
368 return x_display_info_for_name (frame);
369 else
370 {
371 FRAME_PTR f;
372
b7826503 373 CHECK_LIVE_FRAME (frame);
ee78dc32 374 f = XFRAME (frame);
fbd6baed
GV		 375 if (! FRAME_W32_P (f))
376 error ("non-w32 frame used");
377 return FRAME_W32_DISPLAY_INFO (f);
ee78dc32
GV		 378 }
379}
380\f
fbd6baed 381/* Return the Emacs frame-object corresponding to an w32 window.
ee78dc32
GV		 382 It could be the frame's main window or an icon window. */
383
384/* This function can be called during GC, so use GC_xxx type test macros. */
385
386struct frame *
387x_window_to_frame (dpyinfo, wdesc)
fbd6baed 388 struct w32_display_info *dpyinfo;
ee78dc32
GV		 389 HWND wdesc;
390{
391 Lisp_Object tail, frame;
392 struct frame *f;
393
8e713be6 394 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
ee78dc32 395 {
8e713be6 396 frame = XCAR (tail);
ee78dc32
GV		 397 if (!GC_FRAMEP (frame))
398 continue;
399 f = XFRAME (frame);
2d764c78 400 if (!FRAME_W32_P (f) || FRAME_W32_DISPLAY_INFO (f) != dpyinfo)
ee78dc32 401 continue;
0af913d7 402 if (f->output_data.w32->hourglass_window == wdesc)
f79e6790
JR		 403 return f;
404
767b1ff0 405 /* TODO: Check tooltips when supported. */
fbd6baed 406 if (FRAME_W32_WINDOW (f) == wdesc)
ee78dc32
GV		 407 return f;
408 }
409 return 0;
410}
411
412\f
413
414/* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
415 id, which is just an int that this section returns. Bitmaps are
416 reference counted so they can be shared among frames.
417
418 Bitmap indices are guaranteed to be > 0, so a negative number can
419 be used to indicate no bitmap.
420
421 If you use x_create_bitmap_from_data, then you must keep track of
422 the bitmaps yourself. That is, creating a bitmap from the same
423 data more than once will not be caught. */
424
425
426/* Functions to access the contents of a bitmap, given an id. */
427
428int
429x_bitmap_height (f, id)
430 FRAME_PTR f;
431 int id;
432{
fbd6baed 433 return FRAME_W32_DISPLAY_INFO (f)->bitmaps[id - 1].height;
ee78dc32
GV		 434}
435
436int
437x_bitmap_width (f, id)
438 FRAME_PTR f;
439 int id;
440{
fbd6baed 441 return FRAME_W32_DISPLAY_INFO (f)->bitmaps[id - 1].width;
ee78dc32
GV		 442}
443
444int
445x_bitmap_pixmap (f, id)
446 FRAME_PTR f;
447 int id;
448{
fbd6baed 449 return (int) FRAME_W32_DISPLAY_INFO (f)->bitmaps[id - 1].pixmap;
ee78dc32
GV		 450}
451
452
453/* Allocate a new bitmap record. Returns index of new record. */
454
455static int
456x_allocate_bitmap_record (f)
457 FRAME_PTR f;
458{
fbd6baed 459 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
ee78dc32
GV		 460 int i;
461
462 if (dpyinfo->bitmaps == NULL)
463 {
464 dpyinfo->bitmaps_size = 10;
465 dpyinfo->bitmaps
fbd6baed 466 = (struct w32_bitmap_record *) xmalloc (dpyinfo->bitmaps_size * sizeof (struct w32_bitmap_record));
ee78dc32
GV		 467 dpyinfo->bitmaps_last = 1;
468 return 1;
469 }
470
471 if (dpyinfo->bitmaps_last < dpyinfo->bitmaps_size)
472 return ++dpyinfo->bitmaps_last;
473
474 for (i = 0; i < dpyinfo->bitmaps_size; ++i)
475 if (dpyinfo->bitmaps[i].refcount == 0)
476 return i + 1;
477
478 dpyinfo->bitmaps_size *= 2;
479 dpyinfo->bitmaps
fbd6baed
GV		 480 = (struct w32_bitmap_record *) xrealloc (dpyinfo->bitmaps,
481 dpyinfo->bitmaps_size * sizeof (struct w32_bitmap_record));
ee78dc32
GV		 482 return ++dpyinfo->bitmaps_last;
483}
484
485/* Add one reference to the reference count of the bitmap with id ID. */
486
487void
488x_reference_bitmap (f, id)
489 FRAME_PTR f;
490 int id;
491{
fbd6baed 492 ++FRAME_W32_DISPLAY_INFO (f)->bitmaps[id - 1].refcount;
ee78dc32
GV		 493}
494
495/* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
496
497int
498x_create_bitmap_from_data (f, bits, width, height)
499 struct frame *f;
500 char *bits;
501 unsigned int width, height;
502{
fbd6baed 503 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
ee78dc32
GV		 504 Pixmap bitmap;
505 int id;
506
507 bitmap = CreateBitmap (width, height,
fbd6baed
GV		 508 FRAME_W32_DISPLAY_INFO (XFRAME (frame))->n_planes,
509 FRAME_W32_DISPLAY_INFO (XFRAME (frame))->n_cbits,
ee78dc32
GV		 510 bits);
511
512 if (! bitmap)
513 return -1;
514
515 id = x_allocate_bitmap_record (f);
516 dpyinfo->bitmaps[id - 1].pixmap = bitmap;
517 dpyinfo->bitmaps[id - 1].file = NULL;
518 dpyinfo->bitmaps[id - 1].hinst = NULL;
519 dpyinfo->bitmaps[id - 1].refcount = 1;
520 dpyinfo->bitmaps[id - 1].depth = 1;
521 dpyinfo->bitmaps[id - 1].height = height;
522 dpyinfo->bitmaps[id - 1].width = width;
523
524 return id;
525}
526
527/* Create bitmap from file FILE for frame F. */
528
529int
530x_create_bitmap_from_file (f, file)
531 struct frame *f;
532 Lisp_Object file;
533{
534 return -1;
767b1ff0 535#if 0 /* TODO : bitmap support */
fbd6baed 536 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
ee78dc32 537 unsigned int width, height;
6fc2811b 538 HBITMAP bitmap;
ee78dc32
GV		 539 int xhot, yhot, result, id;
540 Lisp_Object found;
541 int fd;
542 char *filename;
543 HINSTANCE hinst;
544
545 /* Look for an existing bitmap with the same name. */
546 for (id = 0; id < dpyinfo->bitmaps_last; ++id)
547 {
548 if (dpyinfo->bitmaps[id].refcount
549 && dpyinfo->bitmaps[id].file
550 && !strcmp (dpyinfo->bitmaps[id].file, (char *) XSTRING (file)->data))
551 {
552 ++dpyinfo->bitmaps[id].refcount;
553 return id + 1;
554 }
555 }
556
557 /* Search bitmap-file-path for the file, if appropriate. */
c0ec53ad 558 fd = openp (Vx_bitmap_file_path, file, Qnil, &found, 0);
ee78dc32
GV		 559 if (fd < 0)
560 return -1;
6fc2811b 561 emacs_close (fd);
ee78dc32
GV		 562
563 filename = (char *) XSTRING (found)->data;
564
565 hinst = LoadLibraryEx (filename, NULL, LOAD_LIBRARY_AS_DATAFILE);
566
567 if (hinst == NULL)
568 return -1;
569
570
fbd6baed 571 result = XReadBitmapFile (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
ee78dc32
GV		 572 filename, &width, &height, &bitmap, &xhot, &yhot);
573 if (result != BitmapSuccess)
574 return -1;
575
576 id = x_allocate_bitmap_record (f);
577 dpyinfo->bitmaps[id - 1].pixmap = bitmap;
578 dpyinfo->bitmaps[id - 1].refcount = 1;
579 dpyinfo->bitmaps[id - 1].file = (char *) xmalloc (XSTRING (file)->size + 1);
580 dpyinfo->bitmaps[id - 1].depth = 1;
581 dpyinfo->bitmaps[id - 1].height = height;
582 dpyinfo->bitmaps[id - 1].width = width;
583 strcpy (dpyinfo->bitmaps[id - 1].file, XSTRING (file)->data);
584
585 return id;
767b1ff0 586#endif /* TODO */
ee78dc32
GV		 587}
588
589/* Remove reference to bitmap with id number ID. */
590
33d52f9c 591void
ee78dc32
GV		 592x_destroy_bitmap (f, id)
593 FRAME_PTR f;
594 int id;
595{
fbd6baed 596 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
ee78dc32
GV		 597
598 if (id > 0)
599 {
600 --dpyinfo->bitmaps[id - 1].refcount;
601 if (dpyinfo->bitmaps[id - 1].refcount == 0)
602 {
603 BLOCK_INPUT;
604 DeleteObject (dpyinfo->bitmaps[id - 1].pixmap);
605 if (dpyinfo->bitmaps[id - 1].file)
606 {
6fc2811b 607 xfree (dpyinfo->bitmaps[id - 1].file);
ee78dc32
GV		 608 dpyinfo->bitmaps[id - 1].file = NULL;
609 }
610 UNBLOCK_INPUT;
611 }
612 }
613}
614
615/* Free all the bitmaps for the display specified by DPYINFO. */
616
617static void
618x_destroy_all_bitmaps (dpyinfo)
fbd6baed 619 struct w32_display_info *dpyinfo;
ee78dc32
GV		 620{
621 int i;
622 for (i = 0; i < dpyinfo->bitmaps_last; i++)
623 if (dpyinfo->bitmaps[i].refcount > 0)
624 {
625 DeleteObject (dpyinfo->bitmaps[i].pixmap);
626 if (dpyinfo->bitmaps[i].file)
6fc2811b 627 xfree (dpyinfo->bitmaps[i].file);
ee78dc32
GV		 628 }
629 dpyinfo->bitmaps_last = 0;
630}
631\f
fbd6baed 632/* Connect the frame-parameter names for W32 frames
ee78dc32
GV		 633 to the ways of passing the parameter values to the window system.
634
635 The name of a parameter, as a Lisp symbol,
636 has an `x-frame-parameter' property which is an integer in Lisp
637 but can be interpreted as an `enum x_frame_parm' in C. */
638
639enum x_frame_parm
640{
641 X_PARM_FOREGROUND_COLOR,
642 X_PARM_BACKGROUND_COLOR,
643 X_PARM_MOUSE_COLOR,
644 X_PARM_CURSOR_COLOR,
645 X_PARM_BORDER_COLOR,
646 X_PARM_ICON_TYPE,
647 X_PARM_FONT,
648 X_PARM_BORDER_WIDTH,
649 X_PARM_INTERNAL_BORDER_WIDTH,
650 X_PARM_NAME,
651 X_PARM_AUTORAISE,
652 X_PARM_AUTOLOWER,
653 X_PARM_VERT_SCROLL_BAR,
654 X_PARM_VISIBILITY,
655 X_PARM_MENU_BAR_LINES
656};
657
658
659struct x_frame_parm_table
660{
661 char *name;
6fc2811b 662 void (*setter) P_ ((struct frame *, Lisp_Object, Lisp_Object));
ee78dc32
GV		 663};
664
937e601e
AI		 665static Lisp_Object unwind_create_frame P_ ((Lisp_Object));
666static Lisp_Object unwind_create_tip_frame P_ ((Lisp_Object));
667static void x_change_window_heights P_ ((Lisp_Object, int));
767b1ff0 668/* TODO: Native Input Method support; see x_create_im. */
6fc2811b 669void x_set_foreground_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
dfff8a69 670static void x_set_line_spacing P_ ((struct frame *, Lisp_Object, Lisp_Object));
6fc2811b
JR		 671void x_set_background_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
672void x_set_mouse_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
673void x_set_cursor_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
674void x_set_border_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
675void x_set_cursor_type P_ ((struct frame *, Lisp_Object, Lisp_Object));
676void x_set_icon_type P_ ((struct frame *, Lisp_Object, Lisp_Object));
677void x_set_icon_name P_ ((struct frame *, Lisp_Object, Lisp_Object));
678void x_set_font P_ ((struct frame *, Lisp_Object, Lisp_Object));
679void x_set_border_width P_ ((struct frame *, Lisp_Object, Lisp_Object));
680void x_set_internal_border_width P_ ((struct frame *, Lisp_Object,
681 Lisp_Object));
682void x_explicitly_set_name P_ ((struct frame *, Lisp_Object, Lisp_Object));
683void x_set_autoraise P_ ((struct frame *, Lisp_Object, Lisp_Object));
684void x_set_autolower P_ ((struct frame *, Lisp_Object, Lisp_Object));
685void x_set_vertical_scroll_bars P_ ((struct frame *, Lisp_Object,
686 Lisp_Object));
687void x_set_visibility P_ ((struct frame *, Lisp_Object, Lisp_Object));
688void x_set_menu_bar_lines P_ ((struct frame *, Lisp_Object, Lisp_Object));
689void x_set_scroll_bar_width P_ ((struct frame *, Lisp_Object, Lisp_Object));
690void x_set_title P_ ((struct frame *, Lisp_Object, Lisp_Object));
691void x_set_unsplittable P_ ((struct frame *, Lisp_Object, Lisp_Object));
692void x_set_tool_bar_lines P_ ((struct frame *, Lisp_Object, Lisp_Object));
693static void x_set_screen_gamma P_ ((struct frame *, Lisp_Object, Lisp_Object));
3cf3436e
JR		 694static void x_edge_detection P_ ((struct frame *, struct image *, Lisp_Object,
695 Lisp_Object));
ee78dc32
GV		 696
697static struct x_frame_parm_table x_frame_parms[] =
698{
1edf84e7
GV		 699 "auto-raise", x_set_autoraise,
700 "auto-lower", x_set_autolower,
ee78dc32 701 "background-color", x_set_background_color,
ee78dc32 702 "border-color", x_set_border_color,
1edf84e7
GV		 703 "border-width", x_set_border_width,
704 "cursor-color", x_set_cursor_color,
ee78dc32 705 "cursor-type", x_set_cursor_type,
ee78dc32 706 "font", x_set_font,
1edf84e7
GV		 707 "foreground-color", x_set_foreground_color,
708 "icon-name", x_set_icon_name,
709 "icon-type", x_set_icon_type,
ee78dc32 710 "internal-border-width", x_set_internal_border_width,
ee78dc32 711 "menu-bar-lines", x_set_menu_bar_lines,
1edf84e7
GV		 712 "mouse-color", x_set_mouse_color,
713 "name", x_explicitly_set_name,
ee78dc32 714 "scroll-bar-width", x_set_scroll_bar_width,
1edf84e7 715 "title", x_set_title,
ee78dc32 716 "unsplittable", x_set_unsplittable,
1edf84e7
GV		 717 "vertical-scroll-bars", x_set_vertical_scroll_bars,
718 "visibility", x_set_visibility,
6fc2811b 719 "tool-bar-lines", x_set_tool_bar_lines,
dfff8a69
JR		 720 "screen-gamma", x_set_screen_gamma,
721 "line-spacing", x_set_line_spacing
ee78dc32
GV		 722};
723
724/* Attach the `x-frame-parameter' properties to
fbd6baed 725 the Lisp symbol names of parameters relevant to W32. */
ee78dc32 726
dfff8a69 727void
ee78dc32
GV		 728init_x_parm_symbols ()
729{
730 int i;
731
732 for (i = 0; i < sizeof (x_frame_parms) / sizeof (x_frame_parms[0]); i++)
733 Fput (intern (x_frame_parms[i].name), Qx_frame_parameter,
734 make_number (i));
735}
736\f
dfff8a69 737/* Change the parameters of frame F as specified by ALIST.
ee78dc32
GV		 738 If a parameter is not specially recognized, do nothing;
739 otherwise call the `x_set_...' function for that parameter. */
740
741void
742x_set_frame_parameters (f, alist)
743 FRAME_PTR f;
744 Lisp_Object alist;
745{
746 Lisp_Object tail;
747
748 /* If both of these parameters are present, it's more efficient to
749 set them both at once. So we wait until we've looked at the
750 entire list before we set them. */
b839712d 751 int width, height;
ee78dc32
GV		 752
753 /* Same here. */
754 Lisp_Object left, top;
755
756 /* Same with these. */
757 Lisp_Object icon_left, icon_top;
758
759 /* Record in these vectors all the parms specified. */
760 Lisp_Object *parms;
761 Lisp_Object *values;
a797a73d 762 int i, p;
ee78dc32
GV		 763 int left_no_change = 0, top_no_change = 0;
764 int icon_left_no_change = 0, icon_top_no_change = 0;
765
5878523b
RS		 766 struct gcpro gcpro1, gcpro2;
767
ee78dc32
GV		 768 i = 0;
769 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
770 i++;
771
772 parms = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
773 values = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
774
775 /* Extract parm names and values into those vectors. */
776
777 i = 0;
778 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
779 {
6fc2811b 780 Lisp_Object elt;
ee78dc32
GV		 781
782 elt = Fcar (tail);
783 parms[i] = Fcar (elt);
784 values[i] = Fcdr (elt);
785 i++;
786 }
5878523b
RS		 787 /* TAIL and ALIST are not used again below here. */
788 alist = tail = Qnil;
789
790 GCPRO2 (*parms, *values);
791 gcpro1.nvars = i;
792 gcpro2.nvars = i;
793
794 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
795 because their values appear in VALUES and strings are not valid. */
b839712d 796 top = left = Qunbound;
ee78dc32
GV		 797 icon_left = icon_top = Qunbound;
798
b839712d 799 /* Provide default values for HEIGHT and WIDTH. */
dfff8a69
JR		 800 if (FRAME_NEW_WIDTH (f))
801 width = FRAME_NEW_WIDTH (f);
802 else
803 width = FRAME_WIDTH (f);
804
805 if (FRAME_NEW_HEIGHT (f))
806 height = FRAME_NEW_HEIGHT (f);
807 else
808 height = FRAME_HEIGHT (f);
b839712d 809
a797a73d
GV		 810 /* Process foreground_color and background_color before anything else.
811 They are independent of other properties, but other properties (e.g.,
812 cursor_color) are dependent upon them. */
813 for (p = 0; p < i; p++)
814 {
815 Lisp_Object prop, val;
816
817 prop = parms[p];
818 val = values[p];
819 if (EQ (prop, Qforeground_color) || EQ (prop, Qbackground_color))
820 {
821 register Lisp_Object param_index, old_value;
822
823 param_index = Fget (prop, Qx_frame_parameter);
824 old_value = get_frame_param (f, prop);
825 store_frame_param (f, prop, val);
826 if (NATNUMP (param_index)
827 && (XFASTINT (param_index)
828 < sizeof (x_frame_parms)/sizeof (x_frame_parms[0])))
829 (*x_frame_parms[XINT (param_index)].setter)(f, val, old_value);
830 }
831 }
832
ee78dc32
GV		 833 /* Now process them in reverse of specified order. */
834 for (i--; i >= 0; i--)
835 {
836 Lisp_Object prop, val;
837
838 prop = parms[i];
839 val = values[i];
840
b839712d
RS		 841 if (EQ (prop, Qwidth) && NUMBERP (val))
842 width = XFASTINT (val);
843 else if (EQ (prop, Qheight) && NUMBERP (val))
844 height = XFASTINT (val);
ee78dc32
GV		 845 else if (EQ (prop, Qtop))
846 top = val;
847 else if (EQ (prop, Qleft))
848 left = val;
849 else if (EQ (prop, Qicon_top))
850 icon_top = val;
851 else if (EQ (prop, Qicon_left))
852 icon_left = val;
a797a73d
GV		 853 else if (EQ (prop, Qforeground_color) || EQ (prop, Qbackground_color))
854 /* Processed above. */
855 continue;
ee78dc32
GV		 856 else
857 {
858 register Lisp_Object param_index, old_value;
859
860 param_index = Fget (prop, Qx_frame_parameter);
861 old_value = get_frame_param (f, prop);
862 store_frame_param (f, prop, val);
863 if (NATNUMP (param_index)
864 && (XFASTINT (param_index)
865 < sizeof (x_frame_parms)/sizeof (x_frame_parms[0])))
3c190163 866 (*x_frame_parms[XINT (param_index)].setter)(f, val, old_value);
ee78dc32
GV		 867 }
868 }
869
870 /* Don't die if just one of these was set. */
871 if (EQ (left, Qunbound))
872 {
873 left_no_change = 1;
fbd6baed
GV		 874 if (f->output_data.w32->left_pos < 0)
875 left = Fcons (Qplus, Fcons (make_number (f->output_data.w32->left_pos), Qnil));
ee78dc32 876 else
fbd6baed 877 XSETINT (left, f->output_data.w32->left_pos);
ee78dc32
GV		 878 }
879 if (EQ (top, Qunbound))
880 {
881 top_no_change = 1;
fbd6baed
GV		 882 if (f->output_data.w32->top_pos < 0)
883 top = Fcons (Qplus, Fcons (make_number (f->output_data.w32->top_pos), Qnil));
ee78dc32 884 else
fbd6baed 885 XSETINT (top, f->output_data.w32->top_pos);
ee78dc32
GV		 886 }
887
888 /* If one of the icon positions was not set, preserve or default it. */
889 if (EQ (icon_left, Qunbound) || ! INTEGERP (icon_left))
890 {
891 icon_left_no_change = 1;
892 icon_left = Fcdr (Fassq (Qicon_left, f->param_alist));
893 if (NILP (icon_left))
894 XSETINT (icon_left, 0);
895 }
896 if (EQ (icon_top, Qunbound) || ! INTEGERP (icon_top))
897 {
898 icon_top_no_change = 1;
899 icon_top = Fcdr (Fassq (Qicon_top, f->param_alist));
900 if (NILP (icon_top))
901 XSETINT (icon_top, 0);
902 }
903
ee78dc32
GV		 904 /* Don't set these parameters unless they've been explicitly
905 specified. The window might be mapped or resized while we're in
906 this function, and we don't want to override that unless the lisp
907 code has asked for it.
908
909 Don't set these parameters unless they actually differ from the
910 window's current parameters; the window may not actually exist
911 yet. */
912 {
913 Lisp_Object frame;
914
915 check_frame_size (f, &height, &width);
916
917 XSETFRAME (frame, f);
918
dfff8a69
JR		 919 if (width != FRAME_WIDTH (f)
920 || height != FRAME_HEIGHT (f)
921 || FRAME_NEW_HEIGHT (f) || FRAME_NEW_WIDTH (f))
b839712d 922 Fset_frame_size (frame, make_number (width), make_number (height));
ee78dc32
GV		 923
924 if ((!NILP (left) || !NILP (top))
925 && ! (left_no_change && top_no_change)
fbd6baed
GV		 926 && ! (NUMBERP (left) && XINT (left) == f->output_data.w32->left_pos
927 && NUMBERP (top) && XINT (top) == f->output_data.w32->top_pos))
ee78dc32
GV		 928 {
929 int leftpos = 0;
930 int toppos = 0;
931
932 /* Record the signs. */
fbd6baed 933 f->output_data.w32->size_hint_flags &= ~ (XNegative | YNegative);
ee78dc32 934 if (EQ (left, Qminus))
fbd6baed 935 f->output_data.w32->size_hint_flags |= XNegative;
ee78dc32
GV		 936 else if (INTEGERP (left))
937 {
938 leftpos = XINT (left);
939 if (leftpos < 0)
fbd6baed 940 f->output_data.w32->size_hint_flags |= XNegative;
ee78dc32 941 }
8e713be6
KR		 942 else if (CONSP (left) && EQ (XCAR (left), Qminus)
943 && CONSP (XCDR (left))
944 && INTEGERP (XCAR (XCDR (left))))
ee78dc32 945 {
8e713be6 946 leftpos = - XINT (XCAR (XCDR (left)));
fbd6baed 947 f->output_data.w32->size_hint_flags |= XNegative;
ee78dc32 948 }
8e713be6
KR		 949 else if (CONSP (left) && EQ (XCAR (left), Qplus)
950 && CONSP (XCDR (left))
951 && INTEGERP (XCAR (XCDR (left))))
ee78dc32 952 {
8e713be6 953 leftpos = XINT (XCAR (XCDR (left)));
ee78dc32
GV		 954 }
955
956 if (EQ (top, Qminus))
fbd6baed 957 f->output_data.w32->size_hint_flags |= YNegative;
ee78dc32
GV		 958 else if (INTEGERP (top))
959 {
960 toppos = XINT (top);
961 if (toppos < 0)
fbd6baed 962 f->output_data.w32->size_hint_flags |= YNegative;
ee78dc32 963 }
8e713be6
KR		 964 else if (CONSP (top) && EQ (XCAR (top), Qminus)
965 && CONSP (XCDR (top))
966 && INTEGERP (XCAR (XCDR (top))))
ee78dc32 967 {
8e713be6 968 toppos = - XINT (XCAR (XCDR (top)));
fbd6baed 969 f->output_data.w32->size_hint_flags |= YNegative;
ee78dc32 970 }
8e713be6
KR		 971 else if (CONSP (top) && EQ (XCAR (top), Qplus)
972 && CONSP (XCDR (top))
973 && INTEGERP (XCAR (XCDR (top))))
ee78dc32 974 {
8e713be6 975 toppos = XINT (XCAR (XCDR (top)));
ee78dc32
GV		 976 }
977
978
979 /* Store the numeric value of the position. */
fbd6baed
GV		 980 f->output_data.w32->top_pos = toppos;
981 f->output_data.w32->left_pos = leftpos;
ee78dc32 982
fbd6baed 983 f->output_data.w32->win_gravity = NorthWestGravity;
ee78dc32
GV		 984
985 /* Actually set that position, and convert to absolute. */
986 x_set_offset (f, leftpos, toppos, -1);
987 }
988
989 if ((!NILP (icon_left) || !NILP (icon_top))
990 && ! (icon_left_no_change && icon_top_no_change))
991 x_wm_set_icon_position (f, XINT (icon_left), XINT (icon_top));
992 }
5878523b
RS		 993
994 UNGCPRO;
ee78dc32
GV		 995}
996
997/* Store the screen positions of frame F into XPTR and YPTR.
998 These are the positions of the containing window manager window,
999 not Emacs's own window. */
1000
1001void
1002x_real_positions (f, xptr, yptr)
1003 FRAME_PTR f;
1004 int *xptr, *yptr;
1005{
1006 POINT pt;
3c190163
GV		 1007
1008 {
1009 RECT rect;
ee78dc32 1010
fbd6baed
GV		 1011 GetClientRect(FRAME_W32_WINDOW(f), &rect);
1012 AdjustWindowRect(&rect, f->output_data.w32->dwStyle, FRAME_EXTERNAL_MENU_BAR(f));
ee78dc32 1013
3c190163
GV		 1014 pt.x = rect.left;
1015 pt.y = rect.top;
1016 }
ee78dc32 1017
fbd6baed 1018 ClientToScreen (FRAME_W32_WINDOW(f), &pt);
ee78dc32
GV		 1019
1020 *xptr = pt.x;
1021 *yptr = pt.y;
1022}
1023
1024/* Insert a description of internally-recorded parameters of frame X
1025 into the parameter alist *ALISTPTR that is to be given to the user.
fbd6baed 1026 Only parameters that are specific to W32
ee78dc32
GV		 1027 and whose values are not correctly recorded in the frame's
1028 param_alist need to be considered here. */
1029
dfff8a69 1030void
ee78dc32
GV		 1031x_report_frame_params (f, alistptr)
1032 struct frame *f;
1033 Lisp_Object *alistptr;
1034{
1035 char buf[16];
1036 Lisp_Object tem;
1037
1038 /* Represent negative positions (off the top or left screen edge)
1039 in a way that Fmodify_frame_parameters will understand correctly. */
fbd6baed
GV		 1040 XSETINT (tem, f->output_data.w32->left_pos);
1041 if (f->output_data.w32->left_pos >= 0)
ee78dc32
GV		 1042 store_in_alist (alistptr, Qleft, tem);
1043 else
1044 store_in_alist (alistptr, Qleft, Fcons (Qplus, Fcons (tem, Qnil)));
1045
fbd6baed
GV		 1046 XSETINT (tem, f->output_data.w32->top_pos);
1047 if (f->output_data.w32->top_pos >= 0)
ee78dc32
GV		 1048 store_in_alist (alistptr, Qtop, tem);
1049 else
1050 store_in_alist (alistptr, Qtop, Fcons (Qplus, Fcons (tem, Qnil)));
1051
1052 store_in_alist (alistptr, Qborder_width,
fbd6baed 1053 make_number (f->output_data.w32->border_width));
ee78dc32 1054 store_in_alist (alistptr, Qinternal_border_width,
fbd6baed
GV		 1055 make_number (f->output_data.w32->internal_border_width));
1056 sprintf (buf, "%ld", (long) FRAME_W32_WINDOW (f));
ee78dc32
GV		 1057 store_in_alist (alistptr, Qwindow_id,
1058 build_string (buf));
1059 store_in_alist (alistptr, Qicon_name, f->icon_name);
1060 FRAME_SAMPLE_VISIBILITY (f);
1061 store_in_alist (alistptr, Qvisibility,
1062 (FRAME_VISIBLE_P (f) ? Qt
1063 : FRAME_ICONIFIED_P (f) ? Qicon : Qnil));
1064 store_in_alist (alistptr, Qdisplay,
8e713be6 1065 XCAR (FRAME_W32_DISPLAY_INFO (f)->name_list_element));
ee78dc32
GV		 1066}
1067\f
1068
74e1aeec
JR		 1069DEFUN ("w32-define-rgb-color", Fw32_define_rgb_color,
1070 Sw32_define_rgb_color, 4, 4, 0,
1071 doc: /* Convert RGB numbers to a windows color reference and associate with NAME.
1072This adds or updates a named color to w32-color-map, making it
1073available for use. The original entry's RGB ref is returned, or nil
1074if the entry is new. */)
5ac45f98
GV		 1075 (red, green, blue, name)
1076 Lisp_Object red, green, blue, name;
ee78dc32 1077{
5ac45f98
GV		 1078 Lisp_Object rgb;
1079 Lisp_Object oldrgb = Qnil;
1080 Lisp_Object entry;
1081
b7826503
PJ		 1082 CHECK_NUMBER (red);
1083 CHECK_NUMBER (green);
1084 CHECK_NUMBER (blue);
1085 CHECK_STRING (name);
ee78dc32 1086
5ac45f98 1087 XSET (rgb, Lisp_Int, RGB(XUINT (red), XUINT (green), XUINT (blue)));
ee78dc32 1088
5ac45f98 1089 BLOCK_INPUT;
ee78dc32 1090
fbd6baed
GV		 1091 /* replace existing entry in w32-color-map or add new entry. */
1092 entry = Fassoc (name, Vw32_color_map);
5ac45f98
GV		 1093 if (NILP (entry))
1094 {
1095 entry = Fcons (name, rgb);
fbd6baed 1096 Vw32_color_map = Fcons (entry, Vw32_color_map);
5ac45f98
GV		 1097 }
1098 else
1099 {
1100 oldrgb = Fcdr (entry);
1101 Fsetcdr (entry, rgb);
1102 }
1103
1104 UNBLOCK_INPUT;
1105
1106 return (oldrgb);
ee78dc32
GV		 1107}
1108
74e1aeec
JR		 1109DEFUN ("w32-load-color-file", Fw32_load_color_file,
1110 Sw32_load_color_file, 1, 1, 0,
1111 doc: /* Create an alist of color entries from an external file.
1112Assign this value to w32-color-map to replace the existing color map.
1113
1114The file should define one named RGB color per line like so:
1115 R G B name
1116where R,G,B are numbers between 0 and 255 and name is an arbitrary string. */)
5ac45f98
GV		 1117 (filename)
1118 Lisp_Object filename;
1119{
1120 FILE *fp;
1121 Lisp_Object cmap = Qnil;
1122 Lisp_Object abspath;
1123
b7826503 1124 CHECK_STRING (filename);
5ac45f98
GV		 1125 abspath = Fexpand_file_name (filename, Qnil);
1126
1127 fp = fopen (XSTRING (filename)->data, "rt");
1128 if (fp)
1129 {
1130 char buf[512];
1131 int red, green, blue;
1132 int num;
1133
1134 BLOCK_INPUT;
1135
1136 while (fgets (buf, sizeof (buf), fp) != NULL) {
1137 if (sscanf (buf, "%u %u %u %n", &red, &green, &blue, &num) == 3)
1138 {
1139 char *name = buf + num;
1140 num = strlen (name) - 1;
1141 if (name[num] == '\n')
1142 name[num] = 0;
1143 cmap = Fcons (Fcons (build_string (name),
1144 make_number (RGB (red, green, blue))),
1145 cmap);
1146 }
1147 }
1148 fclose (fp);
1149
1150 UNBLOCK_INPUT;
1151 }
1152
1153 return cmap;
1154}
ee78dc32 1155
fbd6baed 1156/* The default colors for the w32 color map */
ee78dc32
GV		 1157typedef struct colormap_t
1158{
1159 char *name;
1160 COLORREF colorref;
1161} colormap_t;
1162
fbd6baed 1163colormap_t w32_color_map[] =
ee78dc32 1164{
1da8a614
GV		 1165 {"snow" , PALETTERGB (255,250,250)},
1166 {"ghost white" , PALETTERGB (248,248,255)},
1167 {"GhostWhite" , PALETTERGB (248,248,255)},
1168 {"white smoke" , PALETTERGB (245,245,245)},
1169 {"WhiteSmoke" , PALETTERGB (245,245,245)},
1170 {"gainsboro" , PALETTERGB (220,220,220)},
1171 {"floral white" , PALETTERGB (255,250,240)},
1172 {"FloralWhite" , PALETTERGB (255,250,240)},
1173 {"old lace" , PALETTERGB (253,245,230)},
1174 {"OldLace" , PALETTERGB (253,245,230)},
1175 {"linen" , PALETTERGB (250,240,230)},
1176 {"antique white" , PALETTERGB (250,235,215)},
1177 {"AntiqueWhite" , PALETTERGB (250,235,215)},
1178 {"papaya whip" , PALETTERGB (255,239,213)},
1179 {"PapayaWhip" , PALETTERGB (255,239,213)},
1180 {"blanched almond" , PALETTERGB (255,235,205)},
1181 {"BlanchedAlmond" , PALETTERGB (255,235,205)},
1182 {"bisque" , PALETTERGB (255,228,196)},
1183 {"peach puff" , PALETTERGB (255,218,185)},
1184 {"PeachPuff" , PALETTERGB (255,218,185)},
1185 {"navajo white" , PALETTERGB (255,222,173)},
1186 {"NavajoWhite" , PALETTERGB (255,222,173)},
1187 {"moccasin" , PALETTERGB (255,228,181)},
1188 {"cornsilk" , PALETTERGB (255,248,220)},
1189 {"ivory" , PALETTERGB (255,255,240)},
1190 {"lemon chiffon" , PALETTERGB (255,250,205)},
1191 {"LemonChiffon" , PALETTERGB (255,250,205)},
1192 {"seashell" , PALETTERGB (255,245,238)},
1193 {"honeydew" , PALETTERGB (240,255,240)},
1194 {"mint cream" , PALETTERGB (245,255,250)},
1195 {"MintCream" , PALETTERGB (245,255,250)},
1196 {"azure" , PALETTERGB (240,255,255)},
1197 {"alice blue" , PALETTERGB (240,248,255)},
1198 {"AliceBlue" , PALETTERGB (240,248,255)},
1199 {"lavender" , PALETTERGB (230,230,250)},
1200 {"lavender blush" , PALETTERGB (255,240,245)},
1201 {"LavenderBlush" , PALETTERGB (255,240,245)},
1202 {"misty rose" , PALETTERGB (255,228,225)},
1203 {"MistyRose" , PALETTERGB (255,228,225)},
1204 {"white" , PALETTERGB (255,255,255)},
1205 {"black" , PALETTERGB ( 0, 0, 0)},
1206 {"dark slate gray" , PALETTERGB ( 47, 79, 79)},
1207 {"DarkSlateGray" , PALETTERGB ( 47, 79, 79)},
1208 {"dark slate grey" , PALETTERGB ( 47, 79, 79)},
1209 {"DarkSlateGrey" , PALETTERGB ( 47, 79, 79)},
1210 {"dim gray" , PALETTERGB (105,105,105)},
1211 {"DimGray" , PALETTERGB (105,105,105)},
1212 {"dim grey" , PALETTERGB (105,105,105)},
1213 {"DimGrey" , PALETTERGB (105,105,105)},
1214 {"slate gray" , PALETTERGB (112,128,144)},
1215 {"SlateGray" , PALETTERGB (112,128,144)},
1216 {"slate grey" , PALETTERGB (112,128,144)},
1217 {"SlateGrey" , PALETTERGB (112,128,144)},
1218 {"light slate gray" , PALETTERGB (119,136,153)},
1219 {"LightSlateGray" , PALETTERGB (119,136,153)},
1220 {"light slate grey" , PALETTERGB (119,136,153)},
1221 {"LightSlateGrey" , PALETTERGB (119,136,153)},
1222 {"gray" , PALETTERGB (190,190,190)},
1223 {"grey" , PALETTERGB (190,190,190)},
1224 {"light grey" , PALETTERGB (211,211,211)},
1225 {"LightGrey" , PALETTERGB (211,211,211)},
1226 {"light gray" , PALETTERGB (211,211,211)},
1227 {"LightGray" , PALETTERGB (211,211,211)},
1228 {"midnight blue" , PALETTERGB ( 25, 25,112)},
1229 {"MidnightBlue" , PALETTERGB ( 25, 25,112)},
1230 {"navy" , PALETTERGB ( 0, 0,128)},
1231 {"navy blue" , PALETTERGB ( 0, 0,128)},
1232 {"NavyBlue" , PALETTERGB ( 0, 0,128)},
1233 {"cornflower blue" , PALETTERGB (100,149,237)},
1234 {"CornflowerBlue" , PALETTERGB (100,149,237)},
1235 {"dark slate blue" , PALETTERGB ( 72, 61,139)},
1236 {"DarkSlateBlue" , PALETTERGB ( 72, 61,139)},
1237 {"slate blue" , PALETTERGB (106, 90,205)},
1238 {"SlateBlue" , PALETTERGB (106, 90,205)},
1239 {"medium slate blue" , PALETTERGB (123,104,238)},
1240 {"MediumSlateBlue" , PALETTERGB (123,104,238)},
1241 {"light slate blue" , PALETTERGB (132,112,255)},
1242 {"LightSlateBlue" , PALETTERGB (132,112,255)},
1243 {"medium blue" , PALETTERGB ( 0, 0,205)},
1244 {"MediumBlue" , PALETTERGB ( 0, 0,205)},
1245 {"royal blue" , PALETTERGB ( 65,105,225)},
1246 {"RoyalBlue" , PALETTERGB ( 65,105,225)},
1247 {"blue" , PALETTERGB ( 0, 0,255)},
1248 {"dodger blue" , PALETTERGB ( 30,144,255)},
1249 {"DodgerBlue" , PALETTERGB ( 30,144,255)},
1250 {"deep sky blue" , PALETTERGB ( 0,191,255)},
1251 {"DeepSkyBlue" , PALETTERGB ( 0,191,255)},
1252 {"sky blue" , PALETTERGB (135,206,235)},
1253 {"SkyBlue" , PALETTERGB (135,206,235)},
1254 {"light sky blue" , PALETTERGB (135,206,250)},
1255 {"LightSkyBlue" , PALETTERGB (135,206,250)},
1256 {"steel blue" , PALETTERGB ( 70,130,180)},
1257 {"SteelBlue" , PALETTERGB ( 70,130,180)},
1258 {"light steel blue" , PALETTERGB (176,196,222)},
1259 {"LightSteelBlue" , PALETTERGB (176,196,222)},
1260 {"light blue" , PALETTERGB (173,216,230)},
1261 {"LightBlue" , PALETTERGB (173,216,230)},
1262 {"powder blue" , PALETTERGB (176,224,230)},
1263 {"PowderBlue" , PALETTERGB (176,224,230)},
1264 {"pale turquoise" , PALETTERGB (175,238,238)},
1265 {"PaleTurquoise" , PALETTERGB (175,238,238)},
1266 {"dark turquoise" , PALETTERGB ( 0,206,209)},
1267 {"DarkTurquoise" , PALETTERGB ( 0,206,209)},
1268 {"medium turquoise" , PALETTERGB ( 72,209,204)},
1269 {"MediumTurquoise" , PALETTERGB ( 72,209,204)},
1270 {"turquoise" , PALETTERGB ( 64,224,208)},
1271 {"cyan" , PALETTERGB ( 0,255,255)},
1272 {"light cyan" , PALETTERGB (224,255,255)},
1273 {"LightCyan" , PALETTERGB (224,255,255)},
1274 {"cadet blue" , PALETTERGB ( 95,158,160)},
1275 {"CadetBlue" , PALETTERGB ( 95,158,160)},
1276 {"medium aquamarine" , PALETTERGB (102,205,170)},
1277 {"MediumAquamarine" , PALETTERGB (102,205,170)},
1278 {"aquamarine" , PALETTERGB (127,255,212)},
1279 {"dark green" , PALETTERGB ( 0,100, 0)},
1280 {"DarkGreen" , PALETTERGB ( 0,100, 0)},
1281 {"dark olive green" , PALETTERGB ( 85,107, 47)},
1282 {"DarkOliveGreen" , PALETTERGB ( 85,107, 47)},
1283 {"dark sea green" , PALETTERGB (143,188,143)},
1284 {"DarkSeaGreen" , PALETTERGB (143,188,143)},
1285 {"sea green" , PALETTERGB ( 46,139, 87)},
1286 {"SeaGreen" , PALETTERGB ( 46,139, 87)},
1287 {"medium sea green" , PALETTERGB ( 60,179,113)},
1288 {"MediumSeaGreen" , PALETTERGB ( 60,179,113)},
1289 {"light sea green" , PALETTERGB ( 32,178,170)},
1290 {"LightSeaGreen" , PALETTERGB ( 32,178,170)},
1291 {"pale green" , PALETTERGB (152,251,152)},
1292 {"PaleGreen" , PALETTERGB (152,251,152)},
1293 {"spring green" , PALETTERGB ( 0,255,127)},
1294 {"SpringGreen" , PALETTERGB ( 0,255,127)},
1295 {"lawn green" , PALETTERGB (124,252, 0)},
1296 {"LawnGreen" , PALETTERGB (124,252, 0)},
1297 {"green" , PALETTERGB ( 0,255, 0)},
1298 {"chartreuse" , PALETTERGB (127,255, 0)},
1299 {"medium spring green" , PALETTERGB ( 0,250,154)},
1300 {"MediumSpringGreen" , PALETTERGB ( 0,250,154)},
1301 {"green yellow" , PALETTERGB (173,255, 47)},
1302 {"GreenYellow" , PALETTERGB (173,255, 47)},
1303 {"lime green" , PALETTERGB ( 50,205, 50)},
1304 {"LimeGreen" , PALETTERGB ( 50,205, 50)},
1305 {"yellow green" , PALETTERGB (154,205, 50)},
1306 {"YellowGreen" , PALETTERGB (154,205, 50)},
1307 {"forest green" , PALETTERGB ( 34,139, 34)},
1308 {"ForestGreen" , PALETTERGB ( 34,139, 34)},
1309 {"olive drab" , PALETTERGB (107,142, 35)},
1310 {"OliveDrab" , PALETTERGB (107,142, 35)},
1311 {"dark khaki" , PALETTERGB (189,183,107)},
1312 {"DarkKhaki" , PALETTERGB (189,183,107)},
1313 {"khaki" , PALETTERGB (240,230,140)},
1314 {"pale goldenrod" , PALETTERGB (238,232,170)},
1315 {"PaleGoldenrod" , PALETTERGB (238,232,170)},
1316 {"light goldenrod yellow" , PALETTERGB (250,250,210)},
1317 {"LightGoldenrodYellow" , PALETTERGB (250,250,210)},
1318 {"light yellow" , PALETTERGB (255,255,224)},
1319 {"LightYellow" , PALETTERGB (255,255,224)},
1320 {"yellow" , PALETTERGB (255,255, 0)},
1321 {"gold" , PALETTERGB (255,215, 0)},
1322 {"light goldenrod" , PALETTERGB (238,221,130)},
1323 {"LightGoldenrod" , PALETTERGB (238,221,130)},
1324 {"goldenrod" , PALETTERGB (218,165, 32)},
1325 {"dark goldenrod" , PALETTERGB (184,134, 11)},
1326 {"DarkGoldenrod" , PALETTERGB (184,134, 11)},
1327 {"rosy brown" , PALETTERGB (188,143,143)},
1328 {"RosyBrown" , PALETTERGB (188,143,143)},
1329 {"indian red" , PALETTERGB (205, 92, 92)},
1330 {"IndianRed" , PALETTERGB (205, 92, 92)},
1331 {"saddle brown" , PALETTERGB (139, 69, 19)},
1332 {"SaddleBrown" , PALETTERGB (139, 69, 19)},
1333 {"sienna" , PALETTERGB (160, 82, 45)},
1334 {"peru" , PALETTERGB (205,133, 63)},
1335 {"burlywood" , PALETTERGB (222,184,135)},
1336 {"beige" , PALETTERGB (245,245,220)},
1337 {"wheat" , PALETTERGB (245,222,179)},
1338 {"sandy brown" , PALETTERGB (244,164, 96)},
1339 {"SandyBrown" , PALETTERGB (244,164, 96)},
1340 {"tan" , PALETTERGB (210,180,140)},
1341 {"chocolate" , PALETTERGB (210,105, 30)},
1342 {"firebrick" , PALETTERGB (178,34, 34)},
1343 {"brown" , PALETTERGB (165,42, 42)},
1344 {"dark salmon" , PALETTERGB (233,150,122)},
1345 {"DarkSalmon" , PALETTERGB (233,150,122)},
1346 {"salmon" , PALETTERGB (250,128,114)},
1347 {"light salmon" , PALETTERGB (255,160,122)},
1348 {"LightSalmon" , PALETTERGB (255,160,122)},
1349 {"orange" , PALETTERGB (255,165, 0)},
1350 {"dark orange" , PALETTERGB (255,140, 0)},
1351 {"DarkOrange" , PALETTERGB (255,140, 0)},
1352 {"coral" , PALETTERGB (255,127, 80)},
1353 {"light coral" , PALETTERGB (240,128,128)},
1354 {"LightCoral" , PALETTERGB (240,128,128)},
1355 {"tomato" , PALETTERGB (255, 99, 71)},
1356 {"orange red" , PALETTERGB (255, 69, 0)},
1357 {"OrangeRed" , PALETTERGB (255, 69, 0)},
1358 {"red" , PALETTERGB (255, 0, 0)},
1359 {"hot pink" , PALETTERGB (255,105,180)},
1360 {"HotPink" , PALETTERGB (255,105,180)},
1361 {"deep pink" , PALETTERGB (255, 20,147)},
1362 {"DeepPink" , PALETTERGB (255, 20,147)},
1363 {"pink" , PALETTERGB (255,192,203)},
1364 {"light pink" , PALETTERGB (255,182,193)},
1365 {"LightPink" , PALETTERGB (255,182,193)},
1366 {"pale violet red" , PALETTERGB (219,112,147)},
1367 {"PaleVioletRed" , PALETTERGB (219,112,147)},
1368 {"maroon" , PALETTERGB (176, 48, 96)},
1369 {"medium violet red" , PALETTERGB (199, 21,133)},
1370 {"MediumVioletRed" , PALETTERGB (199, 21,133)},
1371 {"violet red" , PALETTERGB (208, 32,144)},
1372 {"VioletRed" , PALETTERGB (208, 32,144)},
1373 {"magenta" , PALETTERGB (255, 0,255)},
1374 {"violet" , PALETTERGB (238,130,238)},
1375 {"plum" , PALETTERGB (221,160,221)},
1376 {"orchid" , PALETTERGB (218,112,214)},
1377 {"medium orchid" , PALETTERGB (186, 85,211)},
1378 {"MediumOrchid" , PALETTERGB (186, 85,211)},
1379 {"dark orchid" , PALETTERGB (153, 50,204)},
1380 {"DarkOrchid" , PALETTERGB (153, 50,204)},
1381 {"dark violet" , PALETTERGB (148, 0,211)},
1382 {"DarkViolet" , PALETTERGB (148, 0,211)},
1383 {"blue violet" , PALETTERGB (138, 43,226)},
1384 {"BlueViolet" , PALETTERGB (138, 43,226)},
1385 {"purple" , PALETTERGB (160, 32,240)},
1386 {"medium purple" , PALETTERGB (147,112,219)},
1387 {"MediumPurple" , PALETTERGB (147,112,219)},
1388 {"thistle" , PALETTERGB (216,191,216)},
1389 {"gray0" , PALETTERGB ( 0, 0, 0)},
1390 {"grey0" , PALETTERGB ( 0, 0, 0)},
1391 {"dark grey" , PALETTERGB (169,169,169)},
1392 {"DarkGrey" , PALETTERGB (169,169,169)},
1393 {"dark gray" , PALETTERGB (169,169,169)},
1394 {"DarkGray" , PALETTERGB (169,169,169)},
1395 {"dark blue" , PALETTERGB ( 0, 0,139)},
1396 {"DarkBlue" , PALETTERGB ( 0, 0,139)},
1397 {"dark cyan" , PALETTERGB ( 0,139,139)},
1398 {"DarkCyan" , PALETTERGB ( 0,139,139)},
1399 {"dark magenta" , PALETTERGB (139, 0,139)},
1400 {"DarkMagenta" , PALETTERGB (139, 0,139)},
1401 {"dark red" , PALETTERGB (139, 0, 0)},
1402 {"DarkRed" , PALETTERGB (139, 0, 0)},
1403 {"light green" , PALETTERGB (144,238,144)},
1404 {"LightGreen" , PALETTERGB (144,238,144)},
ee78dc32
GV		 1405};
1406
fbd6baed 1407DEFUN ("w32-default-color-map", Fw32_default_color_map, Sw32_default_color_map,
74e1aeec 1408 0, 0, 0, doc: /* Return the default color map. */)
ee78dc32
GV		 1409 ()
1410{
1411 int i;
fbd6baed 1412 colormap_t *pc = w32_color_map;
ee78dc32
GV		 1413 Lisp_Object cmap;
1414
1415 BLOCK_INPUT;
1416
1417 cmap = Qnil;
1418
fbd6baed 1419 for (i = 0; i < sizeof (w32_color_map) / sizeof (w32_color_map[0]);
ee78dc32
GV		 1420 pc++, i++)
1421 cmap = Fcons (Fcons (build_string (pc->name),
1422 make_number (pc->colorref)),
1423 cmap);
1424
1425 UNBLOCK_INPUT;
1426
1427 return (cmap);
1428}
ee78dc32
GV		 1429
1430Lisp_Object
fbd6baed 1431w32_to_x_color (rgb)
ee78dc32
GV		 1432 Lisp_Object rgb;
1433{
1434 Lisp_Object color;
1435
b7826503 1436 CHECK_NUMBER (rgb);
ee78dc32
GV		 1437
1438 BLOCK_INPUT;
1439
fbd6baed 1440 color = Frassq (rgb, Vw32_color_map);
ee78dc32
GV		 1441
1442 UNBLOCK_INPUT;
1443
1444 if (!NILP (color))
1445 return (Fcar (color));
1446 else
1447 return Qnil;
1448}
1449
5d7fed93
GV		 1450COLORREF
1451w32_color_map_lookup (colorname)
1452 char *colorname;
1453{
1454 Lisp_Object tail, ret = Qnil;
1455
1456 BLOCK_INPUT;
1457
1458 for (tail = Vw32_color_map; !NILP (tail); tail = Fcdr (tail))
1459 {
1460 register Lisp_Object elt, tem;
1461
1462 elt = Fcar (tail);
1463 if (!CONSP (elt)) continue;
1464
1465 tem = Fcar (elt);
1466
1467 if (lstrcmpi (XSTRING (tem)->data, colorname) == 0)
1468 {
1469 ret = XUINT (Fcdr (elt));
1470 break;
1471 }
1472
1473 QUIT;
1474 }
1475
1476
1477 UNBLOCK_INPUT;
1478
1479 return ret;
1480}
1481
ee78dc32 1482COLORREF
fbd6baed 1483x_to_w32_color (colorname)
ee78dc32
GV		 1484 char * colorname;
1485{
8edb0a6f
JR		 1486 register Lisp_Object ret = Qnil;
1487
ee78dc32 1488 BLOCK_INPUT;
1edf84e7
GV		 1489
1490 if (colorname[0] == '#')
1491 {
1492 /* Could be an old-style RGB Device specification. */
1493 char *color;
1494 int size;
1495 color = colorname + 1;
1496
1497 size = strlen(color);
1498 if (size == 3 || size == 6 || size == 9 || size == 12)
1499 {
1500 UINT colorval;
1501 int i, pos;
1502 pos = 0;
1503 size /= 3;
1504 colorval = 0;
1505
1506 for (i = 0; i < 3; i++)
1507 {
1508 char *end;
1509 char t;
1510 unsigned long value;
1511
1512 /* The check for 'x' in the following conditional takes into
1513 account the fact that strtol allows a "0x" in front of
1514 our numbers, and we don't. */
1515 if (!isxdigit(color[0]) || color[1] == 'x')
1516 break;
1517 t = color[size];
1518 color[size] = '\0';
1519 value = strtoul(color, &end, 16);
1520 color[size] = t;
1521 if (errno == ERANGE || end - color != size)
1522 break;
1523 switch (size)
1524 {
1525 case 1:
1526 value = value * 0x10;
1527 break;
1528 case 2:
1529 break;
1530 case 3:
1531 value /= 0x10;
1532 break;
1533 case 4:
1534 value /= 0x100;
1535 break;
1536 }
1537 colorval |= (value << pos);
1538 pos += 0x8;
1539 if (i == 2)
1540 {
1541 UNBLOCK_INPUT;
1542 return (colorval);
1543 }
1544 color = end;
1545 }
1546 }
1547 }
1548 else if (strnicmp(colorname, "rgb:", 4) == 0)
1549 {
1550 char *color;
1551 UINT colorval;
1552 int i, pos;
1553 pos = 0;
1554
1555 colorval = 0;
1556 color = colorname + 4;
1557 for (i = 0; i < 3; i++)
1558 {
1559 char *end;
1560 unsigned long value;
1561
1562 /* The check for 'x' in the following conditional takes into
1563 account the fact that strtol allows a "0x" in front of
1564 our numbers, and we don't. */
1565 if (!isxdigit(color[0]) || color[1] == 'x')
1566 break;
1567 value = strtoul(color, &end, 16);
1568 if (errno == ERANGE)
1569 break;
1570 switch (end - color)
1571 {
1572 case 1:
1573 value = value * 0x10 + value;
1574 break;
1575 case 2:
1576 break;
1577 case 3:
1578 value /= 0x10;
1579 break;
1580 case 4:
1581 value /= 0x100;
1582 break;
1583 default:
1584 value = ULONG_MAX;
1585 }
1586 if (value == ULONG_MAX)
1587 break;
1588 colorval |= (value << pos);
1589 pos += 0x8;
1590 if (i == 2)
1591 {
1592 if (*end != '\0')
1593 break;
1594 UNBLOCK_INPUT;
1595 return (colorval);
1596 }
1597 if (*end != '/')
1598 break;
1599 color = end + 1;
1600 }
1601 }
1602 else if (strnicmp(colorname, "rgbi:", 5) == 0)
1603 {
1604 /* This is an RGB Intensity specification. */
1605 char *color;
1606 UINT colorval;
1607 int i, pos;
1608 pos = 0;
1609
1610 colorval = 0;
1611 color = colorname + 5;
1612 for (i = 0; i < 3; i++)
1613 {
1614 char *end;
1615 double value;
1616 UINT val;
1617
1618 value = strtod(color, &end);
1619 if (errno == ERANGE)
1620 break;
1621 if (value < 0.0 || value > 1.0)
1622 break;
1623 val = (UINT)(0x100 * value);
1624 /* We used 0x100 instead of 0xFF to give an continuous
1625 range between 0.0 and 1.0 inclusive. The next statement
1626 fixes the 1.0 case. */
1627 if (val == 0x100)
1628 val = 0xFF;
1629 colorval |= (val << pos);
1630 pos += 0x8;
1631 if (i == 2)
1632 {
1633 if (*end != '\0')
1634 break;
1635 UNBLOCK_INPUT;
1636 return (colorval);
1637 }
1638 if (*end != '/')
1639 break;
1640 color = end + 1;
1641 }
1642 }
1643 /* I am not going to attempt to handle any of the CIE color schemes
1644 or TekHVC, since I don't know the algorithms for conversion to
1645 RGB. */
f695b4b1
GV		 1646
1647 /* If we fail to lookup the color name in w32_color_map, then check the
1648 colorname to see if it can be crudely approximated: If the X color
1649 ends in a number (e.g., "darkseagreen2"), strip the number and
1650 return the result of looking up the base color name. */
1651 ret = w32_color_map_lookup (colorname);
1652 if (NILP (ret))
ee78dc32 1653 {
f695b4b1 1654 int len = strlen (colorname);
ee78dc32 1655
f695b4b1
GV		 1656 if (isdigit (colorname[len - 1]))
1657 {
8b77111c 1658 char *ptr, *approx = alloca (len + 1);
ee78dc32 1659
f695b4b1
GV		 1660 strcpy (approx, colorname);
1661 ptr = &approx[len - 1];
1662 while (ptr > approx && isdigit (*ptr))
1663 *ptr-- = '\0';
ee78dc32 1664
f695b4b1 1665 ret = w32_color_map_lookup (approx);
ee78dc32 1666 }
ee78dc32
GV		 1667 }
1668
1669 UNBLOCK_INPUT;
ee78dc32
GV		 1670 return ret;
1671}
1672
5ac45f98
GV		 1673
1674void
fbd6baed 1675w32_regenerate_palette (FRAME_PTR f)
5ac45f98 1676{
fbd6baed 1677 struct w32_palette_entry * list;
5ac45f98
GV		 1678 LOGPALETTE * log_palette;
1679 HPALETTE new_palette;
1680 int i;
1681
1682 /* don't bother trying to create palette if not supported */
fbd6baed 1683 if (! FRAME_W32_DISPLAY_INFO (f)->has_palette)
5ac45f98
GV		 1684 return;
1685
1686 log_palette = (LOGPALETTE *)
1687 alloca (sizeof (LOGPALETTE) +
fbd6baed 1688 FRAME_W32_DISPLAY_INFO (f)->num_colors * sizeof (PALETTEENTRY));
5ac45f98 1689 log_palette->palVersion = 0x300;
fbd6baed 1690 log_palette->palNumEntries = FRAME_W32_DISPLAY_INFO (f)->num_colors;
5ac45f98 1691
fbd6baed 1692 list = FRAME_W32_DISPLAY_INFO (f)->color_list;
5ac45f98 1693 for (i = 0;
fbd6baed 1694 i < FRAME_W32_DISPLAY_INFO (f)->num_colors;
5ac45f98
GV		 1695 i++, list = list->next)
1696 log_palette->palPalEntry[i] = list->entry;
1697
1698 new_palette = CreatePalette (log_palette);
1699
1700 enter_crit ();
1701
fbd6baed
GV		 1702 if (FRAME_W32_DISPLAY_INFO (f)->palette)
1703 DeleteObject (FRAME_W32_DISPLAY_INFO (f)->palette);
1704 FRAME_W32_DISPLAY_INFO (f)->palette = new_palette;
5ac45f98
GV		 1705
1706 /* Realize display palette and garbage all frames. */
1707 release_frame_dc (f, get_frame_dc (f));
1708
1709 leave_crit ();
1710}
1711
fbd6baed
GV		 1712#define W32_COLOR(pe) RGB (pe.peRed, pe.peGreen, pe.peBlue)
1713#define SET_W32_COLOR(pe, color) \
5ac45f98
GV		 1714 do \
1715 { \
1716 pe.peRed = GetRValue (color); \
1717 pe.peGreen = GetGValue (color); \
1718 pe.peBlue = GetBValue (color); \
1719 pe.peFlags = 0; \
1720 } while (0)
1721
1722#if 0
1723/* Keep these around in case we ever want to track color usage. */
1724void
fbd6baed 1725w32_map_color (FRAME_PTR f, COLORREF color)
5ac45f98 1726{
fbd6baed 1727 struct w32_palette_entry * list = FRAME_W32_DISPLAY_INFO (f)->color_list;
5ac45f98 1728
fbd6baed 1729 if (NILP (Vw32_enable_palette))
5ac45f98
GV		 1730 return;
1731
1732 /* check if color is already mapped */
1733 while (list)
1734 {
fbd6baed 1735 if (W32_COLOR (list->entry) == color)
5ac45f98
GV		 1736 {
1737 ++list->refcount;
1738 return;
1739 }
1740 list = list->next;
1741 }
1742
1743 /* not already mapped, so add to list and recreate Windows palette */
fbd6baed
GV		 1744 list = (struct w32_palette_entry *)
1745 xmalloc (sizeof (struct w32_palette_entry));
1746 SET_W32_COLOR (list->entry, color);
5ac45f98 1747 list->refcount = 1;
fbd6baed
GV		 1748 list->next = FRAME_W32_DISPLAY_INFO (f)->color_list;
1749 FRAME_W32_DISPLAY_INFO (f)->color_list = list;
1750 FRAME_W32_DISPLAY_INFO (f)->num_colors++;
5ac45f98
GV		 1751
1752 /* set flag that palette must be regenerated */
fbd6baed 1753 FRAME_W32_DISPLAY_INFO (f)->regen_palette = TRUE;
5ac45f98
GV		 1754}
1755
1756void
fbd6baed 1757w32_unmap_color (FRAME_PTR f, COLORREF color)
5ac45f98 1758{
fbd6baed
GV		 1759 struct w32_palette_entry * list = FRAME_W32_DISPLAY_INFO (f)->color_list;
1760 struct w32_palette_entry **prev = &FRAME_W32_DISPLAY_INFO (f)->color_list;
5ac45f98 1761
fbd6baed 1762 if (NILP (Vw32_enable_palette))
5ac45f98
GV		 1763 return;
1764
1765 /* check if color is already mapped */
1766 while (list)
1767 {
fbd6baed 1768 if (W32_COLOR (list->entry) == color)
5ac45f98
GV		 1769 {
1770 if (--list->refcount == 0)
1771 {
1772 *prev = list->next;
1773 xfree (list);
fbd6baed 1774 FRAME_W32_DISPLAY_INFO (f)->num_colors--;
5ac45f98
GV		 1775 break;
1776 }
1777 else
1778 return;
1779 }
1780 prev = &list->next;
1781 list = list->next;
1782 }
1783
1784 /* set flag that palette must be regenerated */
fbd6baed 1785 FRAME_W32_DISPLAY_INFO (f)->regen_palette = TRUE;
5ac45f98
GV		 1786}
1787#endif
1788
6fc2811b
JR		 1789
1790/* Gamma-correct COLOR on frame F. */
1791
1792void
1793gamma_correct (f, color)
1794 struct frame *f;
1795 COLORREF *color;
1796{
1797 if (f->gamma)
1798 {
1799 *color = PALETTERGB (
1800 pow (GetRValue (*color) / 255.0, f->gamma) * 255.0 + 0.5,
1801 pow (GetGValue (*color) / 255.0, f->gamma) * 255.0 + 0.5,
1802 pow (GetBValue (*color) / 255.0, f->gamma) * 255.0 + 0.5);
1803 }
1804}
1805
1806
ee78dc32
GV		 1807/* Decide if color named COLOR is valid for the display associated with
1808 the selected frame; if so, return the rgb values in COLOR_DEF.
1809 If ALLOC is nonzero, allocate a new colormap cell. */
1810
1811int
6fc2811b 1812w32_defined_color (f, color, color_def, alloc)
ee78dc32
GV		 1813 FRAME_PTR f;
1814 char *color;
6fc2811b 1815 XColor *color_def;
ee78dc32
GV		 1816 int alloc;
1817{
1818 register Lisp_Object tem;
6fc2811b 1819 COLORREF w32_color_ref;
3c190163 1820
fbd6baed 1821 tem = x_to_w32_color (color);
3c190163 1822
ee78dc32
GV		 1823 if (!NILP (tem))
1824 {
d88c567c
JR		 1825 if (f)
1826 {
1827 /* Apply gamma correction. */
1828 w32_color_ref = XUINT (tem);
1829 gamma_correct (f, &w32_color_ref);
1830 XSETINT (tem, w32_color_ref);
1831 }
9badad41
JR		 1832
1833 /* Map this color to the palette if it is enabled. */
fbd6baed 1834 if (!NILP (Vw32_enable_palette))
5ac45f98 1835 {
fbd6baed 1836 struct w32_palette_entry * entry =
d88c567c 1837 one_w32_display_info.color_list;
fbd6baed 1838 struct w32_palette_entry ** prev =
d88c567c 1839 &one_w32_display_info.color_list;
5ac45f98
GV		 1840
1841 /* check if color is already mapped */
1842 while (entry)
1843 {
fbd6baed 1844 if (W32_COLOR (entry->entry) == XUINT (tem))
5ac45f98
GV		 1845 break;
1846 prev = &entry->next;
1847 entry = entry->next;
1848 }
1849
1850 if (entry == NULL && alloc)
1851 {
1852 /* not already mapped, so add to list */
fbd6baed
GV		 1853 entry = (struct w32_palette_entry *)
1854 xmalloc (sizeof (struct w32_palette_entry));
1855 SET_W32_COLOR (entry->entry, XUINT (tem));
5ac45f98
GV		 1856 entry->next = NULL;
1857 *prev = entry;
d88c567c 1858 one_w32_display_info.num_colors++;
5ac45f98
GV		 1859
1860 /* set flag that palette must be regenerated */
d88c567c 1861 one_w32_display_info.regen_palette = TRUE;
5ac45f98
GV		 1862 }
1863 }
1864 /* Ensure COLORREF value is snapped to nearest color in (default)
1865 palette by simulating the PALETTERGB macro. This works whether
1866 or not the display device has a palette. */
6fc2811b
JR		 1867 w32_color_ref = XUINT (tem) | 0x2000000;
1868
6fc2811b
JR		 1869 color_def->pixel = w32_color_ref;
1870 color_def->red = GetRValue (w32_color_ref);
1871 color_def->green = GetGValue (w32_color_ref);
1872 color_def->blue = GetBValue (w32_color_ref);
1873
ee78dc32 1874 return 1;
5ac45f98 1875 }
7fb46567 1876 else
3c190163
GV		 1877 {
1878 return 0;
1879 }
ee78dc32
GV		 1880}
1881
1882/* Given a string ARG naming a color, compute a pixel value from it
1883 suitable for screen F.
1884 If F is not a color screen, return DEF (default) regardless of what
1885 ARG says. */
1886
1887int
1888x_decode_color (f, arg, def)
1889 FRAME_PTR f;
1890 Lisp_Object arg;
1891 int def;
1892{
6fc2811b 1893 XColor cdef;
ee78dc32 1894
b7826503 1895 CHECK_STRING (arg);
ee78dc32
GV		 1896
1897 if (strcmp (XSTRING (arg)->data, "black") == 0)
1898 return BLACK_PIX_DEFAULT (f);
1899 else if (strcmp (XSTRING (arg)->data, "white") == 0)
1900 return WHITE_PIX_DEFAULT (f);
1901
fbd6baed 1902 if ((FRAME_W32_DISPLAY_INFO (f)->n_planes * FRAME_W32_DISPLAY_INFO (f)->n_cbits) == 1)
ee78dc32
GV		 1903 return def;
1904
6fc2811b 1905 /* w32_defined_color is responsible for coping with failures
ee78dc32 1906 by looking for a near-miss. */
6fc2811b
JR		 1907 if (w32_defined_color (f, XSTRING (arg)->data, &cdef, 1))
1908 return cdef.pixel;
ee78dc32
GV		 1909
1910 /* defined_color failed; return an ultimate default. */
1911 return def;
1912}
1913\f
dfff8a69
JR		 1914/* Change the `line-spacing' frame parameter of frame F. OLD_VALUE is
1915 the previous value of that parameter, NEW_VALUE is the new value. */
1916
1917static void
1918x_set_line_spacing (f, new_value, old_value)
1919 struct frame *f;
1920 Lisp_Object new_value, old_value;
1921{
1922 if (NILP (new_value))
1923 f->extra_line_spacing = 0;
1924 else if (NATNUMP (new_value))
1925 f->extra_line_spacing = XFASTINT (new_value);
1926 else
1a948b17 1927 Fsignal (Qerror, Fcons (build_string ("Invalid line-spacing"),
dfff8a69
JR		 1928 Fcons (new_value, Qnil)));
1929 if (FRAME_VISIBLE_P (f))
1930 redraw_frame (f);
1931}
1932
1933
6fc2811b
JR		 1934/* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
1935 the previous value of that parameter, NEW_VALUE is the new value. */
1936
1937static void
1938x_set_screen_gamma (f, new_value, old_value)
1939 struct frame *f;
1940 Lisp_Object new_value, old_value;
1941{
1942 if (NILP (new_value))
1943 f->gamma = 0;
1944 else if (NUMBERP (new_value) && XFLOATINT (new_value) > 0)
1945 /* The value 0.4545 is the normal viewing gamma. */
1946 f->gamma = 1.0 / (0.4545 * XFLOATINT (new_value));
1947 else
1a948b17 1948 Fsignal (Qerror, Fcons (build_string ("Invalid screen-gamma"),
6fc2811b
JR		 1949 Fcons (new_value, Qnil)));
1950
1951 clear_face_cache (0);
1952}
1953
1954
ee78dc32
GV		 1955/* Functions called only from `x_set_frame_param'
1956 to set individual parameters.
1957
fbd6baed 1958 If FRAME_W32_WINDOW (f) is 0,
ee78dc32
GV		 1959 the frame is being created and its window does not exist yet.
1960 In that case, just record the parameter's new value
1961 in the standard place; do not attempt to change the window. */
1962
1963void
1964x_set_foreground_color (f, arg, oldval)
1965 struct frame *f;
1966 Lisp_Object arg, oldval;
1967{
3cf3436e
JR		 1968 struct w32_output *x = f->output_data.w32;
1969 PIX_TYPE fg, old_fg;
1970
1971 fg = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1972 old_fg = FRAME_FOREGROUND_PIXEL (f);
1973 FRAME_FOREGROUND_PIXEL (f) = fg;
5ac45f98 1974
fbd6baed 1975 if (FRAME_W32_WINDOW (f) != 0)
ee78dc32 1976 {
3cf3436e
JR		 1977 if (x->cursor_pixel == old_fg)
1978 x->cursor_pixel = fg;
1979
6fc2811b 1980 update_face_from_frame_parameter (f, Qforeground_color, arg);
ee78dc32
GV		 1981 if (FRAME_VISIBLE_P (f))
1982 redraw_frame (f);
1983 }
1984}
1985
1986void
1987x_set_background_color (f, arg, oldval)
1988 struct frame *f;
1989 Lisp_Object arg, oldval;
1990{
6fc2811b 1991 FRAME_BACKGROUND_PIXEL (f)
ee78dc32
GV		 1992 = x_decode_color (f, arg, WHITE_PIX_DEFAULT (f));
1993
fbd6baed 1994 if (FRAME_W32_WINDOW (f) != 0)
ee78dc32 1995 {
6fc2811b
JR		 1996 SetWindowLong (FRAME_W32_WINDOW (f), WND_BACKGROUND_INDEX,
1997 FRAME_BACKGROUND_PIXEL (f));
ee78dc32 1998
6fc2811b 1999 update_face_from_frame_parameter (f, Qbackground_color, arg);
ee78dc32
GV		 2000
2001 if (FRAME_VISIBLE_P (f))
2002 redraw_frame (f);
2003 }
2004}
2005
2006void
2007x_set_mouse_color (f, arg, oldval)
2008 struct frame *f;
2009 Lisp_Object arg, oldval;
2010{
ee78dc32 2011 Cursor cursor, nontext_cursor, mode_cursor, cross_cursor;
dfc465d3 2012 int count;
ee78dc32
GV		 2013 int mask_color;
2014
2015 if (!EQ (Qnil, arg))
fbd6baed 2016 f->output_data.w32->mouse_pixel
ee78dc32 2017 = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
6fc2811b
JR		 2018 mask_color = FRAME_BACKGROUND_PIXEL (f);
2019
2020 /* Don't let pointers be invisible. */
fbd6baed 2021 if (mask_color == f->output_data.w32->mouse_pixel
6fc2811b
JR		 2022 && mask_color == FRAME_BACKGROUND_PIXEL (f))
2023 f->output_data.w32->mouse_pixel = FRAME_FOREGROUND_PIXEL (f);
ee78dc32 2024
767b1ff0 2025#if 0 /* TODO : cursor changes */
ee78dc32
GV		 2026 BLOCK_INPUT;
2027
2028 /* It's not okay to crash if the user selects a screwy cursor. */
fadca6c6 2029 count = x_catch_errors (FRAME_W32_DISPLAY (f));
ee78dc32
GV		 2030
2031 if (!EQ (Qnil, Vx_pointer_shape))
2032 {
b7826503 2033 CHECK_NUMBER (Vx_pointer_shape);
fbd6baed 2034 cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XINT (Vx_pointer_shape));
ee78dc32
GV		 2035 }
2036 else
fbd6baed
GV		 2037 cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_xterm);
2038 x_check_errors (FRAME_W32_DISPLAY (f), "bad text pointer cursor: %s");
ee78dc32
GV		 2039
2040 if (!EQ (Qnil, Vx_nontext_pointer_shape))
2041 {
b7826503 2042 CHECK_NUMBER (Vx_nontext_pointer_shape);
fbd6baed 2043 nontext_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f),
ee78dc32
GV		 2044 XINT (Vx_nontext_pointer_shape));
2045 }
2046 else
fbd6baed
GV		 2047 nontext_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_left_ptr);
2048 x_check_errors (FRAME_W32_DISPLAY (f), "bad nontext pointer cursor: %s");
ee78dc32 2049
0af913d7 2050 if (!EQ (Qnil, Vx_hourglass_pointer_shape))
6fc2811b 2051 {
b7826503 2052 CHECK_NUMBER (Vx_hourglass_pointer_shape);
0af913d7
GM		 2053 hourglass_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f),
2054 XINT (Vx_hourglass_pointer_shape));
6fc2811b
JR		 2055 }
2056 else
0af913d7 2057 hourglass_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_watch);
6fc2811b
JR		 2058 x_check_errors (FRAME_W32_DISPLAY (f), "bad busy pointer cursor: %s");
2059
2060 x_check_errors (FRAME_W32_DISPLAY (f), "bad nontext pointer cursor: %s");
ee78dc32
GV		 2061 if (!EQ (Qnil, Vx_mode_pointer_shape))
2062 {
b7826503 2063 CHECK_NUMBER (Vx_mode_pointer_shape);
fbd6baed 2064 mode_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f),
ee78dc32
GV		 2065 XINT (Vx_mode_pointer_shape));
2066 }
2067 else
fbd6baed
GV		 2068 mode_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_xterm);
2069 x_check_errors (FRAME_W32_DISPLAY (f), "bad modeline pointer cursor: %s");
ee78dc32
GV		 2070
2071 if (!EQ (Qnil, Vx_sensitive_text_pointer_shape))
2072 {
b7826503 2073 CHECK_NUMBER (Vx_sensitive_text_pointer_shape);
ee78dc32 2074 cross_cursor
fbd6baed 2075 = XCreateFontCursor (FRAME_W32_DISPLAY (f),
ee78dc32
GV		 2076 XINT (Vx_sensitive_text_pointer_shape));
2077 }
2078 else
fbd6baed 2079 cross_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_crosshair);
ee78dc32 2080
4694d762
JR		 2081 if (!NILP (Vx_window_horizontal_drag_shape))
2082 {
b7826503 2083 CHECK_NUMBER (Vx_window_horizontal_drag_shape);
4694d762
JR		 2084 horizontal_drag_cursor
2085 = XCreateFontCursor (FRAME_X_DISPLAY (f),
2086 XINT (Vx_window_horizontal_drag_shape));
2087 }
2088 else
2089 horizontal_drag_cursor
2090 = XCreateFontCursor (FRAME_X_DISPLAY (f), XC_sb_h_double_arrow);
2091
ee78dc32 2092 /* Check and report errors with the above calls. */
fbd6baed 2093 x_check_errors (FRAME_W32_DISPLAY (f), "can't set cursor shape: %s");
fadca6c6 2094 x_uncatch_errors (FRAME_W32_DISPLAY (f), count);
ee78dc32
GV		 2095
2096 {
2097 XColor fore_color, back_color;
2098
fbd6baed 2099 fore_color.pixel = f->output_data.w32->mouse_pixel;
ee78dc32 2100 back_color.pixel = mask_color;
fbd6baed
GV		 2101 XQueryColor (FRAME_W32_DISPLAY (f),
2102 DefaultColormap (FRAME_W32_DISPLAY (f),
2103 DefaultScreen (FRAME_W32_DISPLAY (f))),
ee78dc32 2104 &fore_color);
fbd6baed
GV		 2105 XQueryColor (FRAME_W32_DISPLAY (f),
2106 DefaultColormap (FRAME_W32_DISPLAY (f),
2107 DefaultScreen (FRAME_W32_DISPLAY (f))),
ee78dc32 2108 &back_color);
fbd6baed 2109 XRecolorCursor (FRAME_W32_DISPLAY (f), cursor,
ee78dc32 2110 &fore_color, &back_color);
fbd6baed 2111 XRecolorCursor (FRAME_W32_DISPLAY (f), nontext_cursor,
ee78dc32 2112 &fore_color, &back_color);
fbd6baed 2113 XRecolorCursor (FRAME_W32_DISPLAY (f), mode_cursor,
ee78dc32 2114 &fore_color, &back_color);
fbd6baed 2115 XRecolorCursor (FRAME_W32_DISPLAY (f), cross_cursor,
ee78dc32 2116 &fore_color, &back_color);
0af913d7 2117 XRecolorCursor (FRAME_W32_DISPLAY (f), hourglass_cursor,
6fc2811b 2118 &fore_color, &back_color);
ee78dc32
GV		 2119 }
2120
fbd6baed 2121 if (FRAME_W32_WINDOW (f) != 0)
6fc2811b 2122 XDefineCursor (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f), cursor);
ee78dc32 2123
fbd6baed
GV		 2124 if (cursor != f->output_data.w32->text_cursor && f->output_data.w32->text_cursor != 0)
2125 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->text_cursor);
2126 f->output_data.w32->text_cursor = cursor;
2127
2128 if (nontext_cursor != f->output_data.w32->nontext_cursor
2129 && f->output_data.w32->nontext_cursor != 0)
2130 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->nontext_cursor);
2131 f->output_data.w32->nontext_cursor = nontext_cursor;
2132
0af913d7
GM		 2133 if (hourglass_cursor != f->output_data.w32->hourglass_cursor
2134 && f->output_data.w32->hourglass_cursor != 0)
2135 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->hourglass_cursor);
2136 f->output_data.w32->hourglass_cursor = hourglass_cursor;
6fc2811b 2137
fbd6baed
GV		 2138 if (mode_cursor != f->output_data.w32->modeline_cursor
2139 && f->output_data.w32->modeline_cursor != 0)
2140 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->modeline_cursor);
2141 f->output_data.w32->modeline_cursor = mode_cursor;
6fc2811b 2142
fbd6baed
GV		 2143 if (cross_cursor != f->output_data.w32->cross_cursor
2144 && f->output_data.w32->cross_cursor != 0)
2145 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->cross_cursor);
2146 f->output_data.w32->cross_cursor = cross_cursor;
2147
2148 XFlush (FRAME_W32_DISPLAY (f));
ee78dc32 2149 UNBLOCK_INPUT;
6fc2811b
JR		 2150
2151 update_face_from_frame_parameter (f, Qmouse_color, arg);
767b1ff0 2152#endif /* TODO */
ee78dc32
GV		 2153}
2154
70a0239a
JR		 2155/* Defined in w32term.c. */
2156void x_update_cursor (struct frame *f, int on_p);
2157
ee78dc32
GV		 2158void
2159x_set_cursor_color (f, arg, oldval)
2160 struct frame *f;
2161 Lisp_Object arg, oldval;
2162{
70a0239a 2163 unsigned long fore_pixel, pixel;
ee78dc32 2164
dfff8a69 2165 if (!NILP (Vx_cursor_fore_pixel))
ee78dc32 2166 fore_pixel = x_decode_color (f, Vx_cursor_fore_pixel,
70a0239a 2167 WHITE_PIX_DEFAULT (f));
ee78dc32 2168 else
6fc2811b 2169 fore_pixel = FRAME_BACKGROUND_PIXEL (f);
70a0239a 2170
6759f872 2171 pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
ee78dc32
GV		 2172
2173 /* Make sure that the cursor color differs from the background color. */
70a0239a 2174 if (pixel == FRAME_BACKGROUND_PIXEL (f))
ee78dc32 2175 {
70a0239a
JR		 2176 pixel = f->output_data.w32->mouse_pixel;
2177 if (pixel == fore_pixel)
6fc2811b 2178 fore_pixel = FRAME_BACKGROUND_PIXEL (f);
ee78dc32 2179 }
70a0239a 2180
6fc2811b 2181 FRAME_FOREGROUND_PIXEL (f) = fore_pixel;
70a0239a 2182 f->output_data.w32->cursor_pixel = pixel;
ee78dc32 2183
fbd6baed 2184 if (FRAME_W32_WINDOW (f) != 0)
ee78dc32
GV		 2185 {
2186 if (FRAME_VISIBLE_P (f))
2187 {
70a0239a
JR		 2188 x_update_cursor (f, 0);
2189 x_update_cursor (f, 1);
ee78dc32
GV		 2190 }
2191 }
6fc2811b
JR		 2192
2193 update_face_from_frame_parameter (f, Qcursor_color, arg);
ee78dc32
GV		 2194}
2195
33d52f9c
GV		 2196/* Set the border-color of frame F to pixel value PIX.
2197 Note that this does not fully take effect if done before
2198 F has an window. */
2199void
2200x_set_border_pixel (f, pix)
2201 struct frame *f;
2202 int pix;
2203{
2204 f->output_data.w32->border_pixel = pix;
2205
2206 if (FRAME_W32_WINDOW (f) != 0 && f->output_data.w32->border_width > 0)
2207 {
2208 if (FRAME_VISIBLE_P (f))
2209 redraw_frame (f);
2210 }
2211}
2212
ee78dc32
GV		 2213/* Set the border-color of frame F to value described by ARG.
2214 ARG can be a string naming a color.
2215 The border-color is used for the border that is drawn by the server.
2216 Note that this does not fully take effect if done before
2217 F has a window; it must be redone when the window is created. */
2218
2219void
2220x_set_border_color (f, arg, oldval)
2221 struct frame *f;
2222 Lisp_Object arg, oldval;
2223{
ee78dc32
GV		 2224 int pix;
2225
b7826503 2226 CHECK_STRING (arg);
ee78dc32 2227 pix = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
ee78dc32 2228 x_set_border_pixel (f, pix);
6fc2811b 2229 update_face_from_frame_parameter (f, Qborder_color, arg);
ee78dc32
GV		 2230}
2231
dfff8a69
JR		 2232/* Value is the internal representation of the specified cursor type
2233 ARG. If type is BAR_CURSOR, return in *WIDTH the specified width
2234 of the bar cursor. */
2235
2236enum text_cursor_kinds
2237x_specified_cursor_type (arg, width)
2238 Lisp_Object arg;
2239 int *width;
ee78dc32 2240{
dfff8a69
JR		 2241 enum text_cursor_kinds type;
2242
ee78dc32
GV		 2243 if (EQ (arg, Qbar))
2244 {
dfff8a69
JR		 2245 type = BAR_CURSOR;
2246 *width = 2;
ee78dc32 2247 }
dfff8a69
JR		 2248 else if (CONSP (arg)
2249 && EQ (XCAR (arg), Qbar)
2250 && INTEGERP (XCDR (arg))
2251 && XINT (XCDR (arg)) >= 0)
ee78dc32 2252 {
dfff8a69
JR		 2253 type = BAR_CURSOR;
2254 *width = XINT (XCDR (arg));
ee78dc32 2255 }
dfff8a69
JR		 2256 else if (NILP (arg))
2257 type = NO_CURSOR;
ee78dc32
GV		 2258 else
2259 /* Treat anything unknown as "box cursor".
2260 It was bad to signal an error; people have trouble fixing
2261 .Xdefaults with Emacs, when it has something bad in it. */
dfff8a69
JR		 2262 type = FILLED_BOX_CURSOR;
2263
2264 return type;
2265}
2266
2267void
2268x_set_cursor_type (f, arg, oldval)
2269 FRAME_PTR f;
2270 Lisp_Object arg, oldval;
2271{
2272 int width;
2273
2274 FRAME_DESIRED_CURSOR (f) = x_specified_cursor_type (arg, &width);
2275 f->output_data.w32->cursor_width = width;
ee78dc32
GV		 2276
2277 /* Make sure the cursor gets redrawn. This is overkill, but how
2278 often do people change cursor types? */
2279 update_mode_lines++;
2280}
dfff8a69 2281\f
ee78dc32
GV		 2282void
2283x_set_icon_type (f, arg, oldval)
2284 struct frame *f;
2285 Lisp_Object arg, oldval;
2286{
ee78dc32
GV		 2287 int result;
2288
eb7576ce
GV		 2289 if (NILP (arg) && NILP (oldval))
2290 return;
2291
2292 if (STRINGP (arg) && STRINGP (oldval)
2293 && EQ (Fstring_equal (oldval, arg), Qt))
2294 return;
2295
2296 if (SYMBOLP (arg) && SYMBOLP (oldval) && EQ (arg, oldval))
ee78dc32
GV		 2297 return;
2298
2299 BLOCK_INPUT;
ee78dc32 2300
eb7576ce 2301 result = x_bitmap_icon (f, arg);
ee78dc32
GV		 2302 if (result)
2303 {
2304 UNBLOCK_INPUT;
2305 error ("No icon window available");
2306 }
2307
ee78dc32 2308 UNBLOCK_INPUT;
ee78dc32
GV		 2309}
2310
2311/* Return non-nil if frame F wants a bitmap icon. */
2312
2313Lisp_Object
2314x_icon_type (f)
2315 FRAME_PTR f;
2316{
2317 Lisp_Object tem;
2318
2319 tem = assq_no_quit (Qicon_type, f->param_alist);
2320 if (CONSP (tem))
8e713be6 2321 return XCDR (tem);
ee78dc32
GV		 2322 else
2323 return Qnil;
2324}
2325
2326void
2327x_set_icon_name (f, arg, oldval)
2328 struct frame *f;
2329 Lisp_Object arg, oldval;
2330{
ee78dc32
GV		 2331 if (STRINGP (arg))
2332 {
2333 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
2334 return;
2335 }
2336 else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
2337 return;
2338
2339 f->icon_name = arg;
2340
2341#if 0
fbd6baed 2342 if (f->output_data.w32->icon_bitmap != 0)
ee78dc32
GV		 2343 return;
2344
2345 BLOCK_INPUT;
2346
2347 result = x_text_icon (f,
1edf84e7 2348 (char *) XSTRING ((!NILP (f->icon_name)
ee78dc32 2349 ? f->icon_name
1edf84e7
GV		 2350 : !NILP (f->title)
2351 ? f->title
ee78dc32
GV		 2352 : f->name))->data);
2353
2354 if (result)
2355 {
2356 UNBLOCK_INPUT;
2357 error ("No icon window available");
2358 }
2359
2360 /* If the window was unmapped (and its icon was mapped),
2361 the new icon is not mapped, so map the window in its stead. */
2362 if (FRAME_VISIBLE_P (f))
2363 {
2364#ifdef USE_X_TOOLKIT
fbd6baed 2365 XtPopup (f->output_data.w32->widget, XtGrabNone);
ee78dc32 2366#endif
fbd6baed 2367 XMapWindow (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f));
ee78dc32
GV		 2368 }
2369
fbd6baed 2370 XFlush (FRAME_W32_DISPLAY (f));
ee78dc32
GV		 2371 UNBLOCK_INPUT;
2372#endif
2373}
2374
2375extern Lisp_Object x_new_font ();
4587b026 2376extern Lisp_Object x_new_fontset();
ee78dc32
GV		 2377
2378void
2379x_set_font (f, arg, oldval)
2380 struct frame *f;
2381 Lisp_Object arg, oldval;
2382{
2383 Lisp_Object result;
4587b026 2384 Lisp_Object fontset_name;
4b817373 2385 Lisp_Object frame;
3cf3436e 2386 int old_fontset = FRAME_FONTSET(f);
ee78dc32 2387
b7826503 2388 CHECK_STRING (arg);
ee78dc32 2389
4587b026
GV		 2390 fontset_name = Fquery_fontset (arg, Qnil);
2391
ee78dc32 2392 BLOCK_INPUT;
4587b026
GV		 2393 result = (STRINGP (fontset_name)
2394 ? x_new_fontset (f, XSTRING (fontset_name)->data)
2395 : x_new_font (f, XSTRING (arg)->data));
ee78dc32
GV		 2396 UNBLOCK_INPUT;
2397
2398 if (EQ (result, Qnil))
dfff8a69 2399 error ("Font `%s' is not defined", XSTRING (arg)->data);
ee78dc32 2400 else if (EQ (result, Qt))
dfff8a69 2401 error ("The characters of the given font have varying widths");
ee78dc32
GV		 2402 else if (STRINGP (result))
2403 {
3cf3436e
JR		 2404 if (STRINGP (fontset_name))
2405 {
2406 /* Fontset names are built from ASCII font names, so the
2407 names may be equal despite there was a change. */
2408 if (old_fontset == FRAME_FONTSET (f))
2409 return;
2410 }
2411 else if (!NILP (Fequal (result, oldval)))
dc220243 2412 return;
3cf3436e 2413
ee78dc32 2414 store_frame_param (f, Qfont, result);
6fc2811b 2415 recompute_basic_faces (f);
ee78dc32
GV		 2416 }
2417 else
2418 abort ();
4b817373 2419
6fc2811b
JR		 2420 do_pending_window_change (0);
2421
2422 /* Don't call `face-set-after-frame-default' when faces haven't been
2423 initialized yet. This is the case when called from
2424 Fx_create_frame. In that case, the X widget or window doesn't
2425 exist either, and we can end up in x_report_frame_params with a
2426 null widget which gives a segfault. */
2427 if (FRAME_FACE_CACHE (f))
2428 {
2429 XSETFRAME (frame, f);
2430 call1 (Qface_set_after_frame_default, frame);
2431 }
ee78dc32
GV		 2432}
2433
2434void
2435x_set_border_width (f, arg, oldval)
2436 struct frame *f;
2437 Lisp_Object arg, oldval;
2438{
b7826503 2439 CHECK_NUMBER (arg);
ee78dc32 2440
fbd6baed 2441 if (XINT (arg) == f->output_data.w32->border_width)
ee78dc32
GV		 2442 return;
2443
fbd6baed 2444 if (FRAME_W32_WINDOW (f) != 0)
ee78dc32
GV		 2445 error ("Cannot change the border width of a window");
2446
fbd6baed 2447 f->output_data.w32->border_width = XINT (arg);
ee78dc32
GV		 2448}
2449
2450void
2451x_set_internal_border_width (f, arg, oldval)
2452 struct frame *f;
2453 Lisp_Object arg, oldval;
2454{
fbd6baed 2455 int old = f->output_data.w32->internal_border_width;
ee78dc32 2456
b7826503 2457 CHECK_NUMBER (arg);
fbd6baed
GV		 2458 f->output_data.w32->internal_border_width = XINT (arg);
2459 if (f->output_data.w32->internal_border_width < 0)
2460 f->output_data.w32->internal_border_width = 0;
ee78dc32 2461
fbd6baed 2462 if (f->output_data.w32->internal_border_width == old)
ee78dc32
GV		 2463 return;
2464
fbd6baed 2465 if (FRAME_W32_WINDOW (f) != 0)
ee78dc32 2466 {
ee78dc32 2467 x_set_window_size (f, 0, f->width, f->height);
ee78dc32 2468 SET_FRAME_GARBAGED (f);
6fc2811b 2469 do_pending_window_change (0);
ee78dc32
GV		 2470 }
2471}
2472
2473void
2474x_set_visibility (f, value, oldval)
2475 struct frame *f;
2476 Lisp_Object value, oldval;
2477{
2478 Lisp_Object frame;
2479 XSETFRAME (frame, f);
2480
2481 if (NILP (value))
2482 Fmake_frame_invisible (frame, Qt);
2483 else if (EQ (value, Qicon))
2484 Ficonify_frame (frame);
2485 else
2486 Fmake_frame_visible (frame);
2487}
2488
a1258667
JR		 2489\f
2490/* Change window heights in windows rooted in WINDOW by N lines. */
2491
2492static void
2493x_change_window_heights (window, n)
2494 Lisp_Object window;
2495 int n;
2496{
2497 struct window *w = XWINDOW (window);
2498
2499 XSETFASTINT (w->top, XFASTINT (w->top) + n);
2500 XSETFASTINT (w->height, XFASTINT (w->height) - n);
2501
2502 if (INTEGERP (w->orig_top))
2503 XSETFASTINT (w->orig_top, XFASTINT (w->orig_top) + n);
2504 if (INTEGERP (w->orig_height))
2505 XSETFASTINT (w->orig_height, XFASTINT (w->orig_height) - n);
2506
2507 /* Handle just the top child in a vertical split. */
2508 if (!NILP (w->vchild))
2509 x_change_window_heights (w->vchild, n);
2510
2511 /* Adjust all children in a horizontal split. */
2512 for (window = w->hchild; !NILP (window); window = w->next)
2513 {
2514 w = XWINDOW (window);
2515 x_change_window_heights (window, n);
2516 }
2517}
2518
ee78dc32
GV		 2519void
2520x_set_menu_bar_lines (f, value, oldval)
2521 struct frame *f;
2522 Lisp_Object value, oldval;
2523{
2524 int nlines;
2525 int olines = FRAME_MENU_BAR_LINES (f);
2526
2527 /* Right now, menu bars don't work properly in minibuf-only frames;
2528 most of the commands try to apply themselves to the minibuffer
6fc2811b 2529 frame itself, and get an error because you can't switch buffers
ee78dc32
GV		 2530 in or split the minibuffer window. */
2531 if (FRAME_MINIBUF_ONLY_P (f))
2532 return;
2533
2534 if (INTEGERP (value))
2535 nlines = XINT (value);
2536 else
2537 nlines = 0;
2538
2539 FRAME_MENU_BAR_LINES (f) = 0;
2540 if (nlines)
2541 FRAME_EXTERNAL_MENU_BAR (f) = 1;
2542 else
2543 {
2544 if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
2545 free_frame_menubar (f);
2546 FRAME_EXTERNAL_MENU_BAR (f) = 0;
1edf84e7
GV		 2547
2548 /* Adjust the frame size so that the client (text) dimensions
2549 remain the same. This depends on FRAME_EXTERNAL_MENU_BAR being
2550 set correctly. */
2551 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
6fc2811b 2552 do_pending_window_change (0);
ee78dc32 2553 }
6fc2811b
JR		 2554 adjust_glyphs (f);
2555}
2556
2557
2558/* Set the number of lines used for the tool bar of frame F to VALUE.
2559 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
2560 is the old number of tool bar lines. This function changes the
2561 height of all windows on frame F to match the new tool bar height.
2562 The frame's height doesn't change. */
2563
2564void
2565x_set_tool_bar_lines (f, value, oldval)
2566 struct frame *f;
2567 Lisp_Object value, oldval;
2568{
36f8209a
JR		 2569 int delta, nlines, root_height;
2570 Lisp_Object root_window;
6fc2811b 2571
dc220243
JR		 2572 /* Treat tool bars like menu bars. */
2573 if (FRAME_MINIBUF_ONLY_P (f))
2574 return;
2575
6fc2811b
JR		 2576 /* Use VALUE only if an integer >= 0. */
2577 if (INTEGERP (value) && XINT (value) >= 0)
2578 nlines = XFASTINT (value);
2579 else
2580 nlines = 0;
2581
2582 /* Make sure we redisplay all windows in this frame. */
2583 ++windows_or_buffers_changed;
2584
2585 delta = nlines - FRAME_TOOL_BAR_LINES (f);
36f8209a
JR		 2586
2587 /* Don't resize the tool-bar to more than we have room for. */
2588 root_window = FRAME_ROOT_WINDOW (f);
2589 root_height = XINT (XWINDOW (root_window)->height);
2590 if (root_height - delta < 1)
2591 {
2592 delta = root_height - 1;
2593 nlines = FRAME_TOOL_BAR_LINES (f) + delta;
2594 }
2595
6fc2811b 2596 FRAME_TOOL_BAR_LINES (f) = nlines;
36f8209a 2597 x_change_window_heights (root_window, delta);
6fc2811b 2598 adjust_glyphs (f);
36f8209a
JR		 2599
2600 /* We also have to make sure that the internal border at the top of
2601 the frame, below the menu bar or tool bar, is redrawn when the
2602 tool bar disappears. This is so because the internal border is
2603 below the tool bar if one is displayed, but is below the menu bar
2604 if there isn't a tool bar. The tool bar draws into the area
2605 below the menu bar. */
2606 if (FRAME_W32_WINDOW (f) && FRAME_TOOL_BAR_LINES (f) == 0)
2607 {
2608 updating_frame = f;
2609 clear_frame ();
2610 clear_current_matrices (f);
2611 updating_frame = NULL;
2612 }
2613
2614 /* If the tool bar gets smaller, the internal border below it
2615 has to be cleared. It was formerly part of the display
2616 of the larger tool bar, and updating windows won't clear it. */
2617 if (delta < 0)
2618 {
2619 int height = FRAME_INTERNAL_BORDER_WIDTH (f);
2620 int width = PIXEL_WIDTH (f);
2621 int y = nlines * CANON_Y_UNIT (f);
2622
2623 BLOCK_INPUT;
2624 {
2625 HDC hdc = get_frame_dc (f);
2626 w32_clear_area (f, hdc, 0, y, width, height);
2627 release_frame_dc (f, hdc);
2628 }
2629 UNBLOCK_INPUT;
3cf3436e
JR		 2630
2631 if (WINDOWP (f->tool_bar_window))
2632 clear_glyph_matrix (XWINDOW (f->tool_bar_window)->current_matrix);
36f8209a 2633 }
ee78dc32
GV		 2634}
2635
6fc2811b 2636
ee78dc32 2637/* Change the name of frame F to NAME. If NAME is nil, set F's name to
fbd6baed 2638 w32_id_name.
ee78dc32
GV		 2639
2640 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2641 name; if NAME is a string, set F's name to NAME and set
2642 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2643
2644 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2645 suggesting a new name, which lisp code should override; if
2646 F->explicit_name is set, ignore the new name; otherwise, set it. */
2647
2648void
2649x_set_name (f, name, explicit)
2650 struct frame *f;
2651 Lisp_Object name;
2652 int explicit;
2653{
2654 /* Make sure that requests from lisp code override requests from
2655 Emacs redisplay code. */
2656 if (explicit)
2657 {
2658 /* If we're switching from explicit to implicit, we had better
2659 update the mode lines and thereby update the title. */
2660 if (f->explicit_name && NILP (name))
2661 update_mode_lines = 1;
2662
2663 f->explicit_name = ! NILP (name);
2664 }
2665 else if (f->explicit_name)
2666 return;
2667
fbd6baed 2668 /* If NAME is nil, set the name to the w32_id_name. */
ee78dc32
GV		 2669 if (NILP (name))
2670 {
2671 /* Check for no change needed in this very common case
2672 before we do any consing. */
fbd6baed 2673 if (!strcmp (FRAME_W32_DISPLAY_INFO (f)->w32_id_name,
ee78dc32
GV		 2674 XSTRING (f->name)->data))
2675 return;
fbd6baed 2676 name = build_string (FRAME_W32_DISPLAY_INFO (f)->w32_id_name);
ee78dc32
GV		 2677 }
2678 else
b7826503 2679 CHECK_STRING (name);
ee78dc32
GV		 2680
2681 /* Don't change the name if it's already NAME. */
2682 if (! NILP (Fstring_equal (name, f->name)))
2683 return;
2684
1edf84e7
GV		 2685 f->name = name;
2686
2687 /* For setting the frame title, the title parameter should override
2688 the name parameter. */
2689 if (! NILP (f->title))
2690 name = f->title;
2691
fbd6baed 2692 if (FRAME_W32_WINDOW (f))
ee78dc32 2693 {
6fc2811b 2694 if (STRING_MULTIBYTE (name))
dfff8a69 2695 name = ENCODE_SYSTEM (name);
6fc2811b 2696
ee78dc32 2697 BLOCK_INPUT;
fbd6baed 2698 SetWindowText(FRAME_W32_WINDOW (f), XSTRING (name)->data);
ee78dc32
GV		 2699 UNBLOCK_INPUT;
2700 }
ee78dc32
GV		 2701}
2702
2703/* This function should be called when the user's lisp code has
2704 specified a name for the frame; the name will override any set by the
2705 redisplay code. */
2706void
2707x_explicitly_set_name (f, arg, oldval)
2708 FRAME_PTR f;
2709 Lisp_Object arg, oldval;
2710{
2711 x_set_name (f, arg, 1);
2712}
2713
2714/* This function should be called by Emacs redisplay code to set the
2715 name; names set this way will never override names set by the user's
2716 lisp code. */
2717void
2718x_implicitly_set_name (f, arg, oldval)
2719 FRAME_PTR f;
2720 Lisp_Object arg, oldval;
2721{
2722 x_set_name (f, arg, 0);
2723}
1edf84e7
GV		 2724\f
2725/* Change the title of frame F to NAME.
2726 If NAME is nil, use the frame name as the title.
2727
2728 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2729 name; if NAME is a string, set F's name to NAME and set
2730 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2731
2732 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2733 suggesting a new name, which lisp code should override; if
2734 F->explicit_name is set, ignore the new name; otherwise, set it. */
ee78dc32 2735
1edf84e7 2736void
6fc2811b 2737x_set_title (f, name, old_name)
1edf84e7 2738 struct frame *f;
6fc2811b 2739 Lisp_Object name, old_name;
1edf84e7
GV		 2740{
2741 /* Don't change the title if it's already NAME. */
2742 if (EQ (name, f->title))
2743 return;
2744
2745 update_mode_lines = 1;
2746
2747 f->title = name;
2748
2749 if (NILP (name))
2750 name = f->name;
2751
2752 if (FRAME_W32_WINDOW (f))
2753 {
6fc2811b 2754 if (STRING_MULTIBYTE (name))
dfff8a69 2755 name = ENCODE_SYSTEM (name);
6fc2811b 2756
1edf84e7
GV		 2757 BLOCK_INPUT;
2758 SetWindowText(FRAME_W32_WINDOW (f), XSTRING (name)->data);
2759 UNBLOCK_INPUT;
2760 }
2761}
2762\f
ee78dc32
GV		 2763void
2764x_set_autoraise (f, arg, oldval)
2765 struct frame *f;
2766 Lisp_Object arg, oldval;
2767{
2768 f->auto_raise = !EQ (Qnil, arg);
2769}
2770
2771void
2772x_set_autolower (f, arg, oldval)
2773 struct frame *f;
2774 Lisp_Object arg, oldval;
2775{
2776 f->auto_lower = !EQ (Qnil, arg);
2777}
2778
2779void
2780x_set_unsplittable (f, arg, oldval)
2781 struct frame *f;
2782 Lisp_Object arg, oldval;
2783{
2784 f->no_split = !NILP (arg);
2785}
2786
2787void
2788x_set_vertical_scroll_bars (f, arg, oldval)
2789 struct frame *f;
2790 Lisp_Object arg, oldval;
2791{
1026b400
RS		 2792 if ((EQ (arg, Qleft) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f))
2793 || (EQ (arg, Qright) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f))
2794 || (NILP (arg) && FRAME_HAS_VERTICAL_SCROLL_BARS (f))
2795 || (!NILP (arg) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f)))
ee78dc32 2796 {
1026b400
RS		 2797 FRAME_VERTICAL_SCROLL_BAR_TYPE (f) = NILP (arg) ?
2798 vertical_scroll_bar_none :
87996783
GV		 2799 /* Put scroll bars on the right by default, as is conventional
2800 on MS-Windows. */
2801 EQ (Qleft, arg)
2802 ? vertical_scroll_bar_left
2803 : vertical_scroll_bar_right;
ee78dc32
GV		 2804
2805 /* We set this parameter before creating the window for the
2806 frame, so we can get the geometry right from the start.
2807 However, if the window hasn't been created yet, we shouldn't
2808 call x_set_window_size. */
fbd6baed 2809 if (FRAME_W32_WINDOW (f))
ee78dc32 2810 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
6fc2811b 2811 do_pending_window_change (0);
ee78dc32
GV		 2812 }
2813}
2814
2815void
2816x_set_scroll_bar_width (f, arg, oldval)
2817 struct frame *f;
2818 Lisp_Object arg, oldval;
2819{
6fc2811b
JR		 2820 int wid = FONT_WIDTH (f->output_data.w32->font);
2821
ee78dc32
GV		 2822 if (NILP (arg))
2823 {
6fc2811b
JR		 2824 FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = GetSystemMetrics (SM_CXVSCROLL);
2825 FRAME_SCROLL_BAR_COLS (f) = (FRAME_SCROLL_BAR_PIXEL_WIDTH (f) +
2826 wid - 1) / wid;
2827 if (FRAME_W32_WINDOW (f))
2828 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
2829 do_pending_window_change (0);
ee78dc32
GV		 2830 }
2831 else if (INTEGERP (arg) && XINT (arg) > 0
2832 && XFASTINT (arg) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f))
2833 {
ee78dc32 2834 FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = XFASTINT (arg);
6fc2811b
JR		 2835 FRAME_SCROLL_BAR_COLS (f) = (FRAME_SCROLL_BAR_PIXEL_WIDTH (f)
2836 + wid-1) / wid;
fbd6baed 2837 if (FRAME_W32_WINDOW (f))
ee78dc32 2838 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
6fc2811b 2839 do_pending_window_change (0);
ee78dc32 2840 }
6fc2811b
JR		 2841 change_frame_size (f, 0, FRAME_WIDTH (f), 0, 0, 0);
2842 XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.hpos = 0;
2843 XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.x = 0;
ee78dc32
GV		 2844}
2845\f
2846/* Subroutines of creating an frame. */
2847
2848/* Make sure that Vx_resource_name is set to a reasonable value.
2849 Fix it up, or set it to `emacs' if it is too hopeless. */
2850
2851static void
2852validate_x_resource_name ()
2853{
6fc2811b 2854 int len = 0;
ee78dc32
GV		 2855 /* Number of valid characters in the resource name. */
2856 int good_count = 0;
2857 /* Number of invalid characters in the resource name. */
2858 int bad_count = 0;
2859 Lisp_Object new;
2860 int i;
2861
2862 if (STRINGP (Vx_resource_name))
2863 {
2864 unsigned char *p = XSTRING (Vx_resource_name)->data;
2865 int i;
2866
dfff8a69 2867 len = STRING_BYTES (XSTRING (Vx_resource_name));
ee78dc32
GV		 2868
2869 /* Only letters, digits, - and _ are valid in resource names.
2870 Count the valid characters and count the invalid ones. */
2871 for (i = 0; i < len; i++)
2872 {
2873 int c = p[i];
2874 if (! ((c >= 'a' && c <= 'z')
2875 || (c >= 'A' && c <= 'Z')
2876 || (c >= '0' && c <= '9')
2877 || c == '-' || c == '_'))
2878 bad_count++;
2879 else
2880 good_count++;
2881 }
2882 }
2883 else
2884 /* Not a string => completely invalid. */
2885 bad_count = 5, good_count = 0;
2886
2887 /* If name is valid already, return. */
2888 if (bad_count == 0)
2889 return;
2890
2891 /* If name is entirely invalid, or nearly so, use `emacs'. */
2892 if (good_count == 0
2893 || (good_count == 1 && bad_count > 0))
2894 {
2895 Vx_resource_name = build_string ("emacs");
2896 return;
2897 }
2898
2899 /* Name is partly valid. Copy it and replace the invalid characters
2900 with underscores. */
2901
2902 Vx_resource_name = new = Fcopy_sequence (Vx_resource_name);
2903
2904 for (i = 0; i < len; i++)
2905 {
2906 int c = XSTRING (new)->data[i];
2907 if (! ((c >= 'a' && c <= 'z')
2908 || (c >= 'A' && c <= 'Z')
2909 || (c >= '0' && c <= '9')
2910 || c == '-' || c == '_'))
2911 XSTRING (new)->data[i] = '_';
2912 }
2913}
2914
2915
2916extern char *x_get_string_resource ();
2917
2918DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 2, 4, 0,
74e1aeec
JR		 2919 doc: /* Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.
2920This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the
2921class, where INSTANCE is the name under which Emacs was invoked, or
2922the name specified by the `-name' or `-rn' command-line arguments.
2923
2924The optional arguments COMPONENT and SUBCLASS add to the key and the
2925class, respectively. You must specify both of them or neither.
2926If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'
2927and the class is `Emacs.CLASS.SUBCLASS'. */)
ee78dc32
GV		 2928 (attribute, class, component, subclass)
2929 Lisp_Object attribute, class, component, subclass;
2930{
2931 register char *value;
2932 char *name_key;
2933 char *class_key;
2934
b7826503
PJ		 2935 CHECK_STRING (attribute);
2936 CHECK_STRING (class);
ee78dc32
GV		 2937
2938 if (!NILP (component))
b7826503 2939 CHECK_STRING (component);
ee78dc32 2940 if (!NILP (subclass))
b7826503 2941 CHECK_STRING (subclass);
ee78dc32
GV		 2942 if (NILP (component) != NILP (subclass))
2943 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2944
2945 validate_x_resource_name ();
2946
2947 /* Allocate space for the components, the dots which separate them,
2948 and the final '\0'. Make them big enough for the worst case. */
dfff8a69 2949 name_key = (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name))
ee78dc32 2950 + (STRINGP (component)
dfff8a69
JR		 2951 ? STRING_BYTES (XSTRING (component)) : 0)
2952 + STRING_BYTES (XSTRING (attribute))
ee78dc32
GV		 2953 + 3);
2954
2955 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
dfff8a69 2956 + STRING_BYTES (XSTRING (class))
ee78dc32 2957 + (STRINGP (subclass)
dfff8a69 2958 ? STRING_BYTES (XSTRING (subclass)) : 0)
ee78dc32
GV		 2959 + 3);
2960
2961 /* Start with emacs.FRAMENAME for the name (the specific one)
2962 and with `Emacs' for the class key (the general one). */
2963 strcpy (name_key, XSTRING (Vx_resource_name)->data);
2964 strcpy (class_key, EMACS_CLASS);
2965
2966 strcat (class_key, ".");
2967 strcat (class_key, XSTRING (class)->data);
2968
2969 if (!NILP (component))
2970 {
2971 strcat (class_key, ".");
2972 strcat (class_key, XSTRING (subclass)->data);
2973
2974 strcat (name_key, ".");
2975 strcat (name_key, XSTRING (component)->data);
2976 }
2977
2978 strcat (name_key, ".");
2979 strcat (name_key, XSTRING (attribute)->data);
2980
2981 value = x_get_string_resource (Qnil,
2982 name_key, class_key);
2983
2984 if (value != (char *) 0)
2985 return build_string (value);
2986 else
2987 return Qnil;
2988}
2989
2990/* Used when C code wants a resource value. */
2991
2992char *
2993x_get_resource_string (attribute, class)
2994 char *attribute, *class;
2995{
ee78dc32
GV		 2996 char *name_key;
2997 char *class_key;
6fc2811b 2998 struct frame *sf = SELECTED_FRAME ();
ee78dc32
GV		 2999
3000 /* Allocate space for the components, the dots which separate them,
3001 and the final '\0'. */
dfff8a69 3002 name_key = (char *) alloca (STRING_BYTES (XSTRING (Vinvocation_name))
ee78dc32
GV		 3003 + strlen (attribute) + 2);
3004 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
3005 + strlen (class) + 2);
3006
3007 sprintf (name_key, "%s.%s",
3008 XSTRING (Vinvocation_name)->data,
3009 attribute);
3010 sprintf (class_key, "%s.%s", EMACS_CLASS, class);
3011
6fc2811b 3012 return x_get_string_resource (sf, name_key, class_key);
ee78dc32
GV		 3013}
3014
3015/* Types we might convert a resource string into. */
3016enum resource_types
6fc2811b
JR		 3017{
3018 RES_TYPE_NUMBER,
3019 RES_TYPE_FLOAT,
3020 RES_TYPE_BOOLEAN,
3021 RES_TYPE_STRING,
3022 RES_TYPE_SYMBOL
3023};
ee78dc32
GV		 3024
3025/* Return the value of parameter PARAM.
3026
3027 First search ALIST, then Vdefault_frame_alist, then the X defaults
3028 database, using ATTRIBUTE as the attribute name and CLASS as its class.
3029
3030 Convert the resource to the type specified by desired_type.
3031
3032 If no default is specified, return Qunbound. If you call
6fc2811b 3033 w32_get_arg, make sure you deal with Qunbound in a reasonable way,
ee78dc32
GV		 3034 and don't let it get stored in any Lisp-visible variables! */
3035
3036static Lisp_Object
6fc2811b 3037w32_get_arg (alist, param, attribute, class, type)
ee78dc32
GV		 3038 Lisp_Object alist, param;
3039 char *attribute;
3040 char *class;
3041 enum resource_types type;
3042{
3043 register Lisp_Object tem;
3044
3045 tem = Fassq (param, alist);
3046 if (EQ (tem, Qnil))
3047 tem = Fassq (param, Vdefault_frame_alist);
3048 if (EQ (tem, Qnil))
3049 {
3050
3051 if (attribute)
3052 {
3053 tem = Fx_get_resource (build_string (attribute),
3054 build_string (class),
3055 Qnil, Qnil);
3056
3057 if (NILP (tem))
3058 return Qunbound;
3059
3060 switch (type)
3061 {
6fc2811b 3062 case RES_TYPE_NUMBER:
ee78dc32
GV		 3063 return make_number (atoi (XSTRING (tem)->data));
3064
6fc2811b
JR		 3065 case RES_TYPE_FLOAT:
3066 return make_float (atof (XSTRING (tem)->data));
3067
3068 case RES_TYPE_BOOLEAN:
ee78dc32
GV		 3069 tem = Fdowncase (tem);
3070 if (!strcmp (XSTRING (tem)->data, "on")
3071 || !strcmp (XSTRING (tem)->data, "true"))
3072 return Qt;
3073 else
3074 return Qnil;
3075
6fc2811b 3076 case RES_TYPE_STRING:
ee78dc32
GV		 3077 return tem;
3078
6fc2811b 3079 case RES_TYPE_SYMBOL:
ee78dc32
GV		 3080 /* As a special case, we map the values `true' and `on'
3081 to Qt, and `false' and `off' to Qnil. */
3082 {
3083 Lisp_Object lower;
3084 lower = Fdowncase (tem);
3085 if (!strcmp (XSTRING (lower)->data, "on")
3086 || !strcmp (XSTRING (lower)->data, "true"))
3087 return Qt;
3088 else if (!strcmp (XSTRING (lower)->data, "off")
3089 || !strcmp (XSTRING (lower)->data, "false"))
3090 return Qnil;
3091 else
3092 return Fintern (tem, Qnil);
3093 }
3094
3095 default:
3096 abort ();
3097 }
3098 }
3099 else
3100 return Qunbound;
3101 }
3102 return Fcdr (tem);
3103}
3104
3105/* Record in frame F the specified or default value according to ALIST
dfff8a69
JR		 3106 of the parameter named PROP (a Lisp symbol).
3107 If no value is specified for PROP, look for an X default for XPROP
ee78dc32
GV		 3108 on the frame named NAME.
3109 If that is not found either, use the value DEFLT. */
3110
3111static Lisp_Object
3112x_default_parameter (f, alist, prop, deflt, xprop, xclass, type)
3113 struct frame *f;
3114 Lisp_Object alist;
3115 Lisp_Object prop;
3116 Lisp_Object deflt;
3117 char *xprop;
3118 char *xclass;
3119 enum resource_types type;
3120{
3121 Lisp_Object tem;
3122
6fc2811b 3123 tem = w32_get_arg (alist, prop, xprop, xclass, type);
ee78dc32
GV		 3124 if (EQ (tem, Qunbound))
3125 tem = deflt;
3126 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
3127 return tem;
3128}
3129\f
3130DEFUN ("x-parse-geometry", Fx_parse_geometry, Sx_parse_geometry, 1, 1, 0,
74e1aeec
JR		 3131 doc: /* Parse an X-style geometry string STRING.
3132Returns an alist of the form ((top . TOP), (left . LEFT) ... ).
3133The properties returned may include `top', `left', `height', and `width'.
3134The value of `left' or `top' may be an integer,
3135or a list (+ N) meaning N pixels relative to top/left corner,
3136or a list (- N) meaning -N pixels relative to bottom/right corner. */)
ee78dc32
GV		 3137 (string)
3138 Lisp_Object string;
3139{
3140 int geometry, x, y;
3141 unsigned int width, height;
3142 Lisp_Object result;
3143
b7826503 3144 CHECK_STRING (string);
ee78dc32
GV		 3145
3146 geometry = XParseGeometry ((char *) XSTRING (string)->data,
3147 &x, &y, &width, &height);
3148
3149 result = Qnil;
3150 if (geometry & XValue)
3151 {
3152 Lisp_Object element;
3153
3154 if (x >= 0 && (geometry & XNegative))
3155 element = Fcons (Qleft, Fcons (Qminus, Fcons (make_number (-x), Qnil)));
3156 else if (x < 0 && ! (geometry & XNegative))
3157 element = Fcons (Qleft, Fcons (Qplus, Fcons (make_number (x), Qnil)));
3158 else
3159 element = Fcons (Qleft, make_number (x));
3160 result = Fcons (element, result);
3161 }
3162
3163 if (geometry & YValue)
3164 {
3165 Lisp_Object element;
3166
3167 if (y >= 0 && (geometry & YNegative))
3168 element = Fcons (Qtop, Fcons (Qminus, Fcons (make_number (-y), Qnil)));
3169 else if (y < 0 && ! (geometry & YNegative))
3170 element = Fcons (Qtop, Fcons (Qplus, Fcons (make_number (y), Qnil)));
3171 else
3172 element = Fcons (Qtop, make_number (y));
3173 result = Fcons (element, result);
3174 }
3175
3176 if (geometry & WidthValue)
3177 result = Fcons (Fcons (Qwidth, make_number (width)), result);
3178 if (geometry & HeightValue)
3179 result = Fcons (Fcons (Qheight, make_number (height)), result);
3180
3181 return result;
3182}
3183
3184/* Calculate the desired size and position of this window,
3185 and return the flags saying which aspects were specified.
3186
3187 This function does not make the coordinates positive. */
3188
3189#define DEFAULT_ROWS 40
3190#define DEFAULT_COLS 80
3191
3192static int
3193x_figure_window_size (f, parms)
3194 struct frame *f;
3195 Lisp_Object parms;
3196{
3197 register Lisp_Object tem0, tem1, tem2;
ee78dc32
GV		 3198 long window_prompting = 0;
3199
3200 /* Default values if we fall through.
3201 Actually, if that happens we should get
3202 window manager prompting. */
1026b400 3203 SET_FRAME_WIDTH (f, DEFAULT_COLS);
ee78dc32
GV		 3204 f->height = DEFAULT_ROWS;
3205 /* Window managers expect that if program-specified
3206 positions are not (0,0), they're intentional, not defaults. */
fbd6baed
GV		 3207 f->output_data.w32->top_pos = 0;
3208 f->output_data.w32->left_pos = 0;
ee78dc32 3209
35b41202
JR		 3210 /* Ensure that old new_width and new_height will not override the
3211 values set here. */
3212 FRAME_NEW_WIDTH (f) = 0;
3213 FRAME_NEW_HEIGHT (f) = 0;
3214
6fc2811b
JR		 3215 tem0 = w32_get_arg (parms, Qheight, 0, 0, RES_TYPE_NUMBER);
3216 tem1 = w32_get_arg (parms, Qwidth, 0, 0, RES_TYPE_NUMBER);
3217 tem2 = w32_get_arg (parms, Quser_size, 0, 0, RES_TYPE_NUMBER);
ee78dc32
GV		 3218 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
3219 {
3220 if (!EQ (tem0, Qunbound))
3221 {
b7826503 3222 CHECK_NUMBER (tem0);
ee78dc32
GV		 3223 f->height = XINT (tem0);
3224 }
3225 if (!EQ (tem1, Qunbound))
3226 {
b7826503 3227 CHECK_NUMBER (tem1);
1026b400 3228 SET_FRAME_WIDTH (f, XINT (tem1));
ee78dc32
GV		 3229 }
3230 if (!NILP (tem2) && !EQ (tem2, Qunbound))
3231 window_prompting |= USSize;
3232 else
3233 window_prompting |= PSize;
3234 }
3235
fbd6baed 3236 f->output_data.w32->vertical_scroll_bar_extra
ee78dc32
GV		 3237 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f)
3238 ? 0
3239 : FRAME_SCROLL_BAR_PIXEL_WIDTH (f) > 0
3240 ? FRAME_SCROLL_BAR_PIXEL_WIDTH (f)
fbd6baed 3241 : (FRAME_SCROLL_BAR_COLS (f) * FONT_WIDTH (f->output_data.w32->font)));
6fc2811b
JR		 3242 f->output_data.w32->flags_areas_extra
3243 = FRAME_FLAGS_AREA_WIDTH (f);
fbd6baed
GV		 3244 f->output_data.w32->pixel_width = CHAR_TO_PIXEL_WIDTH (f, f->width);
3245 f->output_data.w32->pixel_height = CHAR_TO_PIXEL_HEIGHT (f, f->height);
ee78dc32 3246
6fc2811b
JR		 3247 tem0 = w32_get_arg (parms, Qtop, 0, 0, RES_TYPE_NUMBER);
3248 tem1 = w32_get_arg (parms, Qleft, 0, 0, RES_TYPE_NUMBER);
3249 tem2 = w32_get_arg (parms, Quser_position, 0, 0, RES_TYPE_NUMBER);
ee78dc32
GV		 3250 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
3251 {
3252 if (EQ (tem0, Qminus))
3253 {
fbd6baed 3254 f->output_data.w32->top_pos = 0;
ee78dc32
GV		 3255 window_prompting |= YNegative;
3256 }
8e713be6
KR		 3257 else if (CONSP (tem0) && EQ (XCAR (tem0), Qminus)
3258 && CONSP (XCDR (tem0))
3259 && INTEGERP (XCAR (XCDR (tem0))))
ee78dc32 3260 {
8e713be6 3261 f->output_data.w32->top_pos = - XINT (XCAR (XCDR (tem0)));
ee78dc32
GV		 3262 window_prompting |= YNegative;
3263 }
8e713be6
KR		 3264 else if (CONSP (tem0) && EQ (XCAR (tem0), Qplus)
3265 && CONSP (XCDR (tem0))
3266 && INTEGERP (XCAR (XCDR (tem0))))
ee78dc32 3267 {
8e713be6 3268 f->output_data.w32->top_pos = XINT (XCAR (XCDR (tem0)));
ee78dc32
GV		 3269 }
3270 else if (EQ (tem0, Qunbound))
fbd6baed 3271 f->output_data.w32->top_pos = 0;
ee78dc32
GV		 3272 else
3273 {
b7826503 3274 CHECK_NUMBER (tem0);
fbd6baed
GV		 3275 f->output_data.w32->top_pos = XINT (tem0);
3276 if (f->output_data.w32->top_pos < 0)
ee78dc32
GV		 3277 window_prompting |= YNegative;
3278 }
3279
3280 if (EQ (tem1, Qminus))
3281 {
fbd6baed 3282 f->output_data.w32->left_pos = 0;
ee78dc32
GV		 3283 window_prompting |= XNegative;
3284 }
8e713be6
KR		 3285 else if (CONSP (tem1) && EQ (XCAR (tem1), Qminus)
3286 && CONSP (XCDR (tem1))
3287 && INTEGERP (XCAR (XCDR (tem1))))
ee78dc32 3288 {
8e713be6 3289 f->output_data.w32->left_pos = - XINT (XCAR (XCDR (tem1)));
ee78dc32
GV		 3290 window_prompting |= XNegative;
3291 }
8e713be6
KR		 3292 else if (CONSP (tem1) && EQ (XCAR (tem1), Qplus)
3293 && CONSP (XCDR (tem1))
3294 && INTEGERP (XCAR (XCDR (tem1))))
ee78dc32 3295 {
8e713be6 3296 f->output_data.w32->left_pos = XINT (XCAR (XCDR (tem1)));
ee78dc32
GV		 3297 }
3298 else if (EQ (tem1, Qunbound))
fbd6baed 3299 f->output_data.w32->left_pos = 0;
ee78dc32
GV		 3300 else
3301 {
b7826503 3302 CHECK_NUMBER (tem1);
fbd6baed
GV		 3303 f->output_data.w32->left_pos = XINT (tem1);
3304 if (f->output_data.w32->left_pos < 0)
ee78dc32
GV		 3305 window_prompting |= XNegative;
3306 }
3307
3308 if (!NILP (tem2) && ! EQ (tem2, Qunbound))
3309 window_prompting |= USPosition;
3310 else
3311 window_prompting |= PPosition;
3312 }
3313
3314 return window_prompting;
3315}
3316
3317\f
3318
fbd6baed 3319extern LRESULT CALLBACK w32_wnd_proc ();
ee78dc32
GV		 3320
3321BOOL
fbd6baed 3322w32_init_class (hinst)
ee78dc32
GV		 3323 HINSTANCE hinst;
3324{
3325 WNDCLASS wc;
3326
5ac45f98 3327 wc.style = CS_HREDRAW | CS_VREDRAW;
fbd6baed 3328 wc.lpfnWndProc = (WNDPROC) w32_wnd_proc;
ee78dc32
GV		 3329 wc.cbClsExtra = 0;
3330 wc.cbWndExtra = WND_EXTRA_BYTES;
3331 wc.hInstance = hinst;
3332 wc.hIcon = LoadIcon (hinst, EMACS_CLASS);
3333 wc.hCursor = LoadCursor (NULL, IDC_ARROW);
4587b026 3334 wc.hbrBackground = NULL; /* GetStockObject (WHITE_BRUSH); */
ee78dc32
GV		 3335 wc.lpszMenuName = NULL;
3336 wc.lpszClassName = EMACS_CLASS;
3337
3338 return (RegisterClass (&wc));
3339}
3340
3341HWND
fbd6baed 3342w32_createscrollbar (f, bar)
ee78dc32
GV		 3343 struct frame *f;
3344 struct scroll_bar * bar;
3345{
3346 return (CreateWindow ("SCROLLBAR", "", SBS_VERT | WS_CHILD | WS_VISIBLE,
3347 /* Position and size of scroll bar. */
6fc2811b
JR		 3348 XINT(bar->left) + VERTICAL_SCROLL_BAR_WIDTH_TRIM,
3349 XINT(bar->top),
3350 XINT(bar->width) - VERTICAL_SCROLL_BAR_WIDTH_TRIM * 2,
3351 XINT(bar->height),
fbd6baed 3352 FRAME_W32_WINDOW (f),
ee78dc32
GV		 3353 NULL,
3354 hinst,
3355 NULL));
3356}
3357
3358void
fbd6baed 3359w32_createwindow (f)
ee78dc32
GV		 3360 struct frame *f;
3361{
3362 HWND hwnd;
1edf84e7
GV		 3363 RECT rect;
3364
3365 rect.left = rect.top = 0;
3366 rect.right = PIXEL_WIDTH (f);
3367 rect.bottom = PIXEL_HEIGHT (f);
3368
3369 AdjustWindowRect (&rect, f->output_data.w32->dwStyle,
3370 FRAME_EXTERNAL_MENU_BAR (f));
ee78dc32
GV		 3371
3372 /* Do first time app init */
3373
3374 if (!hprevinst)
3375 {
fbd6baed 3376 w32_init_class (hinst);
ee78dc32
GV		 3377 }
3378
1edf84e7
GV		 3379 FRAME_W32_WINDOW (f) = hwnd
3380 = CreateWindow (EMACS_CLASS,
3381 f->namebuf,
9ead1b60 3382 f->output_data.w32->dwStyle | WS_CLIPCHILDREN,
1edf84e7
GV		 3383 f->output_data.w32->left_pos,
3384 f->output_data.w32->top_pos,
3385 rect.right - rect.left,
3386 rect.bottom - rect.top,
3387 NULL,
3388 NULL,
3389 hinst,
3390 NULL);
3391
ee78dc32
GV		 3392 if (hwnd)
3393 {
1edf84e7
GV		 3394 SetWindowLong (hwnd, WND_FONTWIDTH_INDEX, FONT_WIDTH (f->output_data.w32->font));
3395 SetWindowLong (hwnd, WND_LINEHEIGHT_INDEX, f->output_data.w32->line_height);
3396 SetWindowLong (hwnd, WND_BORDER_INDEX, f->output_data.w32->internal_border_width);
3397 SetWindowLong (hwnd, WND_SCROLLBAR_INDEX, f->output_data.w32->vertical_scroll_bar_extra);
6fc2811b 3398 SetWindowLong (hwnd, WND_BACKGROUND_INDEX, FRAME_BACKGROUND_PIXEL (f));
ee78dc32 3399
cb9e33d4
RS		 3400 /* Enable drag-n-drop. */
3401 DragAcceptFiles (hwnd, TRUE);
3402
5ac45f98
GV		 3403 /* Do this to discard the default setting specified by our parent. */
3404 ShowWindow (hwnd, SW_HIDE);
3c190163 3405 }
3c190163
GV		 3406}
3407
ee78dc32
GV		 3408void
3409my_post_msg (wmsg, hwnd, msg, wParam, lParam)
fbd6baed 3410 W32Msg * wmsg;
ee78dc32
GV		 3411 HWND hwnd;
3412 UINT msg;
3413 WPARAM wParam;
3414 LPARAM lParam;
3415{
3416 wmsg->msg.hwnd = hwnd;
3417 wmsg->msg.message = msg;
3418 wmsg->msg.wParam = wParam;
3419 wmsg->msg.lParam = lParam;
3420 wmsg->msg.time = GetMessageTime ();
3421
3422 post_msg (wmsg);
3423}
3424
e9e23e23 3425/* GetKeyState and MapVirtualKey on Windows 95 do not actually distinguish
a1a80b40
GV		 3426 between left and right keys as advertised. We test for this
3427 support dynamically, and set a flag when the support is absent. If
3428 absent, we keep track of the left and right control and alt keys
3429 ourselves. This is particularly necessary on keyboards that rely
3430 upon the AltGr key, which is represented as having the left control
3431 and right alt keys pressed. For these keyboards, we need to know
3432 when the left alt key has been pressed in addition to the AltGr key
3433 so that we can properly support M-AltGr-key sequences (such as M-@
3434 on Swedish keyboards). */
3435
3436#define EMACS_LCONTROL 0
3437#define EMACS_RCONTROL 1
3438#define EMACS_LMENU 2
3439#define EMACS_RMENU 3
3440
3441static int modifiers[4];
3442static int modifiers_recorded;
3443static int modifier_key_support_tested;
3444
3445static void
3446test_modifier_support (unsigned int wparam)
3447{
3448 unsigned int l, r;
3449
3450 if (wparam != VK_CONTROL && wparam != VK_MENU)
3451 return;
3452 if (wparam == VK_CONTROL)
3453 {
3454 l = VK_LCONTROL;
3455 r = VK_RCONTROL;
3456 }
3457 else
3458 {
3459 l = VK_LMENU;
3460 r = VK_RMENU;
3461 }
3462 if (!(GetKeyState (l) & 0x8000) && !(GetKeyState (r) & 0x8000))
3463 modifiers_recorded = 1;
3464 else
3465 modifiers_recorded = 0;
3466 modifier_key_support_tested = 1;
3467}
3468
3469static void
3470record_keydown (unsigned int wparam, unsigned int lparam)
3471{
3472 int i;
3473
3474 if (!modifier_key_support_tested)
3475 test_modifier_support (wparam);
3476
3477 if ((wparam != VK_CONTROL && wparam != VK_MENU) || !modifiers_recorded)
3478 return;
3479
3480 if (wparam == VK_CONTROL)
3481 i = (lparam & 0x1000000) ? EMACS_RCONTROL : EMACS_LCONTROL;
3482 else
3483 i = (lparam & 0x1000000) ? EMACS_RMENU : EMACS_LMENU;
3484
3485 modifiers[i] = 1;
3486}
3487
3488static void
3489record_keyup (unsigned int wparam, unsigned int lparam)
3490{
3491 int i;
3492
3493 if ((wparam != VK_CONTROL && wparam != VK_MENU) || !modifiers_recorded)
3494 return;
3495
3496 if (wparam == VK_CONTROL)
3497 i = (lparam & 0x1000000) ? EMACS_RCONTROL : EMACS_LCONTROL;
3498 else
3499 i = (lparam & 0x1000000) ? EMACS_RMENU : EMACS_LMENU;
3500
3501 modifiers[i] = 0;
3502}
3503
da36a4d6
GV		 3504/* Emacs can lose focus while a modifier key has been pressed. When
3505 it regains focus, be conservative and clear all modifiers since
3506 we cannot reconstruct the left and right modifier state. */
3507static void
3508reset_modifiers ()
3509{
8681157a
RS		 3510 SHORT ctrl, alt;
3511
adcc3809
GV		 3512 if (GetFocus () == NULL)
3513 /* Emacs doesn't have keyboard focus. Do nothing. */
da36a4d6 3514 return;
8681157a
RS		 3515
3516 ctrl = GetAsyncKeyState (VK_CONTROL);
3517 alt = GetAsyncKeyState (VK_MENU);
3518
8681157a
RS		 3519 if (!(ctrl & 0x08000))
3520 /* Clear any recorded control modifier state. */
3521 modifiers[EMACS_RCONTROL] = modifiers[EMACS_LCONTROL] = 0;
3522
3523 if (!(alt & 0x08000))
3524 /* Clear any recorded alt modifier state. */
3525 modifiers[EMACS_RMENU] = modifiers[EMACS_LMENU] = 0;
3526
adcc3809
GV		 3527 /* Update the state of all modifier keys, because modifiers used in
3528 hot-key combinations can get stuck on if Emacs loses focus as a
3529 result of a hot-key being pressed. */
3530 {
3531 BYTE keystate[256];
3532
3533#define CURRENT_STATE(key) ((GetAsyncKeyState (key) & 0x8000) >> 8)
3534
3535 GetKeyboardState (keystate);
3536 keystate[VK_SHIFT] = CURRENT_STATE (VK_SHIFT);
3537 keystate[VK_CONTROL] = CURRENT_STATE (VK_CONTROL);
3538 keystate[VK_LCONTROL] = CURRENT_STATE (VK_LCONTROL);
3539 keystate[VK_RCONTROL] = CURRENT_STATE (VK_RCONTROL);
3540 keystate[VK_MENU] = CURRENT_STATE (VK_MENU);
3541 keystate[VK_LMENU] = CURRENT_STATE (VK_LMENU);
3542 keystate[VK_RMENU] = CURRENT_STATE (VK_RMENU);
3543 keystate[VK_LWIN] = CURRENT_STATE (VK_LWIN);
3544 keystate[VK_RWIN] = CURRENT_STATE (VK_RWIN);
3545 keystate[VK_APPS] = CURRENT_STATE (VK_APPS);
3546 SetKeyboardState (keystate);
3547 }
da36a4d6
GV		 3548}
3549
7830e24b
RS		 3550/* Synchronize modifier state with what is reported with the current
3551 keystroke. Even if we cannot distinguish between left and right
3552 modifier keys, we know that, if no modifiers are set, then neither
3553 the left or right modifier should be set. */
3554static void
3555sync_modifiers ()
3556{
3557 if (!modifiers_recorded)
3558 return;
3559
3560 if (!(GetKeyState (VK_CONTROL) & 0x8000))
3561 modifiers[EMACS_RCONTROL] = modifiers[EMACS_LCONTROL] = 0;
3562
3563 if (!(GetKeyState (VK_MENU) & 0x8000))
3564 modifiers[EMACS_RMENU] = modifiers[EMACS_LMENU] = 0;
3565}
3566
a1a80b40
GV		 3567static int
3568modifier_set (int vkey)
3569{
ccc2d29c 3570 if (vkey == VK_CAPITAL || vkey == VK_SCROLL)
891560d6 3571 return (GetKeyState (vkey) & 0x1);
a1a80b40
GV		 3572 if (!modifiers_recorded)
3573 return (GetKeyState (vkey) & 0x8000);
3574
3575 switch (vkey)
3576 {
3577 case VK_LCONTROL:
3578 return modifiers[EMACS_LCONTROL];
3579 case VK_RCONTROL:
3580 return modifiers[EMACS_RCONTROL];
3581 case VK_LMENU:
3582 return modifiers[EMACS_LMENU];
3583 case VK_RMENU:
3584 return modifiers[EMACS_RMENU];
a1a80b40
GV		 3585 }
3586 return (GetKeyState (vkey) & 0x8000);
3587}
3588
ccc2d29c
GV		 3589/* Convert between the modifier bits W32 uses and the modifier bits
3590 Emacs uses. */
3591
3592unsigned int
3593w32_key_to_modifier (int key)
3594{
3595 Lisp_Object key_mapping;
3596
3597 switch (key)
3598 {
3599 case VK_LWIN:
3600 key_mapping = Vw32_lwindow_modifier;
3601 break;
3602 case VK_RWIN:
3603 key_mapping = Vw32_rwindow_modifier;
3604 break;
3605 case VK_APPS:
3606 key_mapping = Vw32_apps_modifier;
3607 break;
3608 case VK_SCROLL:
3609 key_mapping = Vw32_scroll_lock_modifier;
3610 break;
3611 default:
3612 key_mapping = Qnil;
3613 }
3614
adcc3809
GV		 3615 /* NB. This code runs in the input thread, asychronously to the lisp
3616 thread, so we must be careful to ensure access to lisp data is
3617 thread-safe. The following code is safe because the modifier
3618 variable values are updated atomically from lisp and symbols are
3619 not relocated by GC. Also, we don't have to worry about seeing GC
3620 markbits here. */
3621 if (EQ (key_mapping, Qhyper))
ccc2d29c 3622 return hyper_modifier;
adcc3809 3623 if (EQ (key_mapping, Qsuper))
ccc2d29c 3624 return super_modifier;
adcc3809 3625 if (EQ (key_mapping, Qmeta))
ccc2d29c 3626 return meta_modifier;
adcc3809 3627 if (EQ (key_mapping, Qalt))
ccc2d29c 3628 return alt_modifier;
adcc3809 3629 if (EQ (key_mapping, Qctrl))
ccc2d29c 3630 return ctrl_modifier;
adcc3809 3631 if (EQ (key_mapping, Qcontrol)) /* synonym for ctrl */
ccc2d29c 3632 return ctrl_modifier;
adcc3809 3633 if (EQ (key_mapping, Qshift))
ccc2d29c
GV		 3634 return shift_modifier;
3635
3636 /* Don't generate any modifier if not explicitly requested. */
3637 return 0;
3638}
3639
3640unsigned int
3641w32_get_modifiers ()
3642{
3643 return ((modifier_set (VK_SHIFT) ? shift_modifier : 0) |
3644 (modifier_set (VK_CONTROL) ? ctrl_modifier : 0) |
3645 (modifier_set (VK_LWIN) ? w32_key_to_modifier (VK_LWIN) : 0) |
3646 (modifier_set (VK_RWIN) ? w32_key_to_modifier (VK_RWIN) : 0) |
3647 (modifier_set (VK_APPS) ? w32_key_to_modifier (VK_APPS) : 0) |
3648 (modifier_set (VK_SCROLL) ? w32_key_to_modifier (VK_SCROLL) : 0) |
3649 (modifier_set (VK_MENU) ?
3650 ((NILP (Vw32_alt_is_meta)) ? alt_modifier : meta_modifier) : 0));
3651}
3652
a1a80b40
GV		 3653/* We map the VK_* modifiers into console modifier constants
3654 so that we can use the same routines to handle both console
3655 and window input. */
3656
3657static int
ccc2d29c 3658construct_console_modifiers ()
a1a80b40
GV		 3659{
3660 int mods;
3661
a1a80b40
GV		 3662 mods = 0;
3663 mods |= (modifier_set (VK_SHIFT)) ? SHIFT_PRESSED : 0;
3664 mods |= (modifier_set (VK_CAPITAL)) ? CAPSLOCK_ON : 0;
ccc2d29c
GV		 3665 mods |= (modifier_set (VK_SCROLL)) ? SCROLLLOCK_ON : 0;
3666 mods |= (modifier_set (VK_NUMLOCK)) ? NUMLOCK_ON : 0;
a1a80b40
GV		 3667 mods |= (modifier_set (VK_LCONTROL)) ? LEFT_CTRL_PRESSED : 0;
3668 mods |= (modifier_set (VK_RCONTROL)) ? RIGHT_CTRL_PRESSED : 0;
3669 mods |= (modifier_set (VK_LMENU)) ? LEFT_ALT_PRESSED : 0;
3670 mods |= (modifier_set (VK_RMENU)) ? RIGHT_ALT_PRESSED : 0;
ccc2d29c
GV		 3671 mods |= (modifier_set (VK_LWIN)) ? LEFT_WIN_PRESSED : 0;
3672 mods |= (modifier_set (VK_RWIN)) ? RIGHT_WIN_PRESSED : 0;
3673 mods |= (modifier_set (VK_APPS)) ? APPS_PRESSED : 0;
a1a80b40
GV		 3674
3675 return mods;
3676}
3677
ccc2d29c
GV		 3678static int
3679w32_get_key_modifiers (unsigned int wparam, unsigned int lparam)
da36a4d6 3680{
ccc2d29c
GV		 3681 int mods;
3682
3683 /* Convert to emacs modifiers. */
3684 mods = w32_kbd_mods_to_emacs (construct_console_modifiers (), wparam);
3685
3686 return mods;
3687}
da36a4d6 3688
ccc2d29c
GV		 3689unsigned int
3690map_keypad_keys (unsigned int virt_key, unsigned int extended)
3691{
3692 if (virt_key < VK_CLEAR || virt_key > VK_DELETE)
3693 return virt_key;
da36a4d6 3694
ccc2d29c 3695 if (virt_key == VK_RETURN)
da36a4d6
GV		 3696 return (extended ? VK_NUMPAD_ENTER : VK_RETURN);
3697
ccc2d29c
GV		 3698 if (virt_key >= VK_PRIOR && virt_key <= VK_DOWN)
3699 return (!extended ? (VK_NUMPAD_PRIOR + (virt_key - VK_PRIOR)) : virt_key);
3700
3701 if (virt_key == VK_INSERT || virt_key == VK_DELETE)
3702 return (!extended ? (VK_NUMPAD_INSERT + (virt_key - VK_INSERT)) : virt_key);
3703
3704 if (virt_key == VK_CLEAR)
3705 return (!extended ? VK_NUMPAD_CLEAR : virt_key);
3706
3707 return virt_key;
3708}
3709
3710/* List of special key combinations which w32 would normally capture,
3711 but emacs should grab instead. Not directly visible to lisp, to
3712 simplify synchronization. Each item is an integer encoding a virtual
3713 key code and modifier combination to capture. */
3714Lisp_Object w32_grabbed_keys;
3715
3716#define HOTKEY(vk,mods) make_number (((vk) & 255) | ((mods) << 8))
3717#define HOTKEY_ID(k) (XFASTINT (k) & 0xbfff)
3718#define HOTKEY_VK_CODE(k) (XFASTINT (k) & 255)
3719#define HOTKEY_MODIFIERS(k) (XFASTINT (k) >> 8)
3720
3721/* Register hot-keys for reserved key combinations when Emacs has
3722 keyboard focus, since this is the only way Emacs can receive key
3723 combinations like Alt-Tab which are used by the system. */
3724
3725static void
3726register_hot_keys (hwnd)
3727 HWND hwnd;
3728{
3729 Lisp_Object keylist;
3730
3731 /* Use GC_CONSP, since we are called asynchronously. */
3732 for (keylist = w32_grabbed_keys; GC_CONSP (keylist); keylist = XCDR (keylist))
3733 {
3734 Lisp_Object key = XCAR (keylist);
3735
3736 /* Deleted entries get set to nil. */
3737 if (!INTEGERP (key))
3738 continue;
3739
3740 RegisterHotKey (hwnd, HOTKEY_ID (key),
3741 HOTKEY_MODIFIERS (key), HOTKEY_VK_CODE (key));
3742 }
3743}
3744
3745static void
3746unregister_hot_keys (hwnd)
3747 HWND hwnd;
3748{
3749 Lisp_Object keylist;
3750
3751 /* Use GC_CONSP, since we are called asynchronously. */
3752 for (keylist = w32_grabbed_keys; GC_CONSP (keylist); keylist = XCDR (keylist))
3753 {
3754 Lisp_Object key = XCAR (keylist);
3755
3756 if (!INTEGERP (key))
3757 continue;
3758
3759 UnregisterHotKey (hwnd, HOTKEY_ID (key));
3760 }
3761}
3762
5ac45f98
GV		 3763/* Main message dispatch loop. */
3764
1edf84e7
GV		 3765static void
3766w32_msg_pump (deferred_msg * msg_buf)
5ac45f98
GV		 3767{
3768 MSG msg;
ccc2d29c
GV		 3769 int result;
3770 HWND focus_window;
93fbe8b7
GV		 3771
3772 msh_mousewheel = RegisterWindowMessage (MSH_MOUSEWHEEL);
5ac45f98 3773
5ac45f98
GV		 3774 while (GetMessage (&msg, NULL, 0, 0))
3775 {
3776 if (msg.hwnd == NULL)
3777 {
3778 switch (msg.message)
3779 {
3ef68e6b
AI		 3780 case WM_NULL:
3781 /* Produced by complete_deferred_msg; just ignore. */
3782 break;
5ac45f98 3783 case WM_EMACS_CREATEWINDOW:
fbd6baed 3784 w32_createwindow ((struct frame *) msg.wParam);
1edf84e7
GV		 3785 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0))
3786 abort ();
5ac45f98 3787 break;
dfdb4047
GV		 3788 case WM_EMACS_SETLOCALE:
3789 SetThreadLocale (msg.wParam);
3790 /* Reply is not expected. */
3791 break;
ccc2d29c
GV		 3792 case WM_EMACS_SETKEYBOARDLAYOUT:
3793 result = (int) ActivateKeyboardLayout ((HKL) msg.wParam, 0);
3794 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE,
3795 result, 0))
3796 abort ();
3797 break;
3798 case WM_EMACS_REGISTER_HOT_KEY:
3799 focus_window = GetFocus ();
3800 if (focus_window != NULL)
3801 RegisterHotKey (focus_window,
3802 HOTKEY_ID (msg.wParam),
3803 HOTKEY_MODIFIERS (msg.wParam),
3804 HOTKEY_VK_CODE (msg.wParam));
3805 /* Reply is not expected. */
3806 break;
3807 case WM_EMACS_UNREGISTER_HOT_KEY:
3808 focus_window = GetFocus ();
3809 if (focus_window != NULL)
3810 UnregisterHotKey (focus_window, HOTKEY_ID (msg.wParam));
adcc3809
GV		 3811 /* Mark item as erased. NB: this code must be
3812 thread-safe. The next line is okay because the cons
3813 cell is never made into garbage and is not relocated by
3814 GC. */
f3fbd155 3815 XSETCAR ((Lisp_Object) msg.lParam, Qnil);
ccc2d29c
GV		 3816 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0))
3817 abort ();
3818 break;
adcc3809
GV		 3819 case WM_EMACS_TOGGLE_LOCK_KEY:
3820 {
3821 int vk_code = (int) msg.wParam;
3822 int cur_state = (GetKeyState (vk_code) & 1);
3823 Lisp_Object new_state = (Lisp_Object) msg.lParam;
3824
3825 /* NB: This code must be thread-safe. It is safe to
3826 call NILP because symbols are not relocated by GC,
3827 and pointer here is not touched by GC (so the markbit
3828 can't be set). Numbers are safe because they are
3829 immediate values. */
3830 if (NILP (new_state)
3831 || (NUMBERP (new_state)
8edb0a6f 3832 && ((XUINT (new_state)) & 1) != cur_state))
adcc3809
GV		 3833 {
3834 one_w32_display_info.faked_key = vk_code;
3835
3836 keybd_event ((BYTE) vk_code,
3837 (BYTE) MapVirtualKey (vk_code, 0),
3838 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
3839 keybd_event ((BYTE) vk_code,
3840 (BYTE) MapVirtualKey (vk_code, 0),
3841 KEYEVENTF_EXTENDEDKEY | 0, 0);
3842 keybd_event ((BYTE) vk_code,
3843 (BYTE) MapVirtualKey (vk_code, 0),
3844 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
3845 cur_state = !cur_state;
3846 }
3847 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE,
3848 cur_state, 0))
3849 abort ();
3850 }
3851 break;
1edf84e7 3852 default:
1edf84e7 3853 DebPrint (("msg %x not expected by w32_msg_pump\n", msg.message));
5ac45f98
GV		 3854 }
3855 }
3856 else
3857 {
3858 DispatchMessage (&msg);
3859 }
1edf84e7
GV		 3860
3861 /* Exit nested loop when our deferred message has completed. */
3862 if (msg_buf->completed)
3863 break;
5ac45f98 3864 }
1edf84e7
GV		 3865}
3866
3867deferred_msg * deferred_msg_head;
3868
3869static deferred_msg *
3870find_deferred_msg (HWND hwnd, UINT msg)
3871{
3872 deferred_msg * item;
3873
3874 /* Don't actually need synchronization for read access, since
3875 modification of single pointer is always atomic. */
3876 /* enter_crit (); */
3877
3878 for (item = deferred_msg_head; item != NULL; item = item->next)
3879 if (item->w32msg.msg.hwnd == hwnd
3880 && item->w32msg.msg.message == msg)
3881 break;
3882
3883 /* leave_crit (); */
3884
3885 return item;
3886}
3887
3888static LRESULT
3889send_deferred_msg (deferred_msg * msg_buf,
3890 HWND hwnd,
3891 UINT msg,
3892 WPARAM wParam,
3893 LPARAM lParam)
3894{
3895 /* Only input thread can send deferred messages. */
3896 if (GetCurrentThreadId () != dwWindowsThreadId)
3897 abort ();
3898
3899 /* It is an error to send a message that is already deferred. */
3900 if (find_deferred_msg (hwnd, msg) != NULL)
3901 abort ();
3902
3903 /* Enforced synchronization is not needed because this is the only
3904 function that alters deferred_msg_head, and the following critical
3905 section is guaranteed to only be serially reentered (since only the
3906 input thread can call us). */
3907
3908 /* enter_crit (); */
3909
3910 msg_buf->completed = 0;
3911 msg_buf->next = deferred_msg_head;
3912 deferred_msg_head = msg_buf;
3913 my_post_msg (&msg_buf->w32msg, hwnd, msg, wParam, lParam);
3914
3915 /* leave_crit (); */
3916
3917 /* Start a new nested message loop to process other messages until
3918 this one is completed. */
3919 w32_msg_pump (msg_buf);
3920
3921 deferred_msg_head = msg_buf->next;
3922
3923 return msg_buf->result;
3924}
3925
3926void
3927complete_deferred_msg (HWND hwnd, UINT msg, LRESULT result)
3928{
3929 deferred_msg * msg_buf = find_deferred_msg (hwnd, msg);
3930
3931 if (msg_buf == NULL)
3ef68e6b
AI		 3932 /* Message may have been cancelled, so don't abort(). */
3933 return;
1edf84e7
GV		 3934
3935 msg_buf->result = result;
3936 msg_buf->completed = 1;
3937
3938 /* Ensure input thread is woken so it notices the completion. */
3939 PostThreadMessage (dwWindowsThreadId, WM_NULL, 0, 0);
3940}
3941
3ef68e6b
AI		 3942void
3943cancel_all_deferred_msgs ()
3944{
3945 deferred_msg * item;
3946
3947 /* Don't actually need synchronization for read access, since
3948 modification of single pointer is always atomic. */
3949 /* enter_crit (); */
3950
3951 for (item = deferred_msg_head; item != NULL; item = item->next)
3952 {
3953 item->result = 0;
3954 item->completed = 1;
3955 }
3956
3957 /* leave_crit (); */
3958
3959 /* Ensure input thread is woken so it notices the completion. */
3960 PostThreadMessage (dwWindowsThreadId, WM_NULL, 0, 0);
3961}
1edf84e7
GV		 3962
3963DWORD
3964w32_msg_worker (dw)
3965 DWORD dw;
3966{
3967 MSG msg;
3968 deferred_msg dummy_buf;
3969
3970 /* Ensure our message queue is created */
3971
3972 PeekMessage (&msg, NULL, 0, 0, PM_NOREMOVE);
5ac45f98 3973
1edf84e7
GV		 3974 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0))
3975 abort ();
3976
3977 memset (&dummy_buf, 0, sizeof (dummy_buf));
3978 dummy_buf.w32msg.msg.hwnd = NULL;
3979 dummy_buf.w32msg.msg.message = WM_NULL;
3980
3981 /* This is the inital message loop which should only exit when the
3982 application quits. */
3983 w32_msg_pump (&dummy_buf);
3984
3985 return 0;
5ac45f98
GV		 3986}
3987
3ef68e6b
AI		 3988static void
3989post_character_message (hwnd, msg, wParam, lParam, modifiers)
3990 HWND hwnd;
3991 UINT msg;
3992 WPARAM wParam;
3993 LPARAM lParam;
3994 DWORD modifiers;
3995
3996{
3997 W32Msg wmsg;
3998
3999 wmsg.dwModifiers = modifiers;
4000
4001 /* Detect quit_char and set quit-flag directly. Note that we
4002 still need to post a message to ensure the main thread will be
4003 woken up if blocked in sys_select(), but we do NOT want to post
4004 the quit_char message itself (because it will usually be as if
4005 the user had typed quit_char twice). Instead, we post a dummy
4006 message that has no particular effect. */
4007 {
4008 int c = wParam;
4009 if (isalpha (c) && wmsg.dwModifiers == ctrl_modifier)
4010 c = make_ctrl_char (c) & 0377;
7d081355
AI		 4011 if (c == quit_char
4012 || (wmsg.dwModifiers == 0 &&
4013 XFASTINT (Vw32_quit_key) && wParam == XFASTINT (Vw32_quit_key)))
3ef68e6b
AI		 4014 {
4015 Vquit_flag = Qt;
4016
4017 /* The choice of message is somewhat arbitrary, as long as
4018 the main thread handler just ignores it. */
4019 msg = WM_NULL;
4020
4021 /* Interrupt any blocking system calls. */
4022 signal_quit ();
4023
4024 /* As a safety precaution, forcibly complete any deferred
4025 messages. This is a kludge, but I don't see any particularly
4026 clean way to handle the situation where a deferred message is
4027 "dropped" in the lisp thread, and will thus never be
4028 completed, eg. by the user trying to activate the menubar
4029 when the lisp thread is busy, and then typing C-g when the
4030 menubar doesn't open promptly (with the result that the
4031 menubar never responds at all because the deferred
4032 WM_INITMENU message is never completed). Another problem
4033 situation is when the lisp thread calls SendMessage (to send
4034 a window manager command) when a message has been deferred;
4035 the lisp thread gets blocked indefinitely waiting for the
4036 deferred message to be completed, which itself is waiting for
4037 the lisp thread to respond.
4038
4039 Note that we don't want to block the input thread waiting for
4040 a reponse from the lisp thread (although that would at least
4041 solve the deadlock problem above), because we want to be able
4042 to receive C-g to interrupt the lisp thread. */
4043 cancel_all_deferred_msgs ();
4044 }
4045 }
4046
4047 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4048}
4049
ee78dc32
GV		 4050/* Main window procedure */
4051
ee78dc32 4052LRESULT CALLBACK
fbd6baed 4053w32_wnd_proc (hwnd, msg, wParam, lParam)
ee78dc32
GV		 4054 HWND hwnd;
4055 UINT msg;
4056 WPARAM wParam;
4057 LPARAM lParam;
4058{
4059 struct frame *f;
fbd6baed
GV		 4060 struct w32_display_info *dpyinfo = &one_w32_display_info;
4061 W32Msg wmsg;
84fb1139 4062 int windows_translate;
576ba81c 4063 int key;
84fb1139 4064
a6085637
KH		 4065 /* Note that it is okay to call x_window_to_frame, even though we are
4066 not running in the main lisp thread, because frame deletion
4067 requires the lisp thread to synchronize with this thread. Thus, if
4068 a frame struct is returned, it can be used without concern that the
4069 lisp thread might make it disappear while we are using it.
4070
4071 NB. Walking the frame list in this thread is safe (as long as
4072 writes of Lisp_Object slots are atomic, which they are on Windows).
4073 Although delete-frame can destructively modify the frame list while
4074 we are walking it, a garbage collection cannot occur until after
4075 delete-frame has synchronized with this thread.
4076
4077 It is also safe to use functions that make GDI calls, such as
fbd6baed 4078 w32_clear_rect, because these functions must obtain a DC handle
a6085637
KH		 4079 from the frame struct using get_frame_dc which is thread-aware. */
4080
ee78dc32
GV		 4081 switch (msg)
4082 {
4083 case WM_ERASEBKGND:
a6085637
KH		 4084 f = x_window_to_frame (dpyinfo, hwnd);
4085 if (f)
4086 {
9badad41 4087 HDC hdc = get_frame_dc (f);
a6085637 4088 GetUpdateRect (hwnd, &wmsg.rect, FALSE);
9badad41
JR		 4089 w32_clear_rect (f, hdc, &wmsg.rect);
4090 release_frame_dc (f, hdc);
ce6059da
AI		 4091
4092#if defined (W32_DEBUG_DISPLAY)
18f0b342
AI		 4093 DebPrint (("WM_ERASEBKGND (frame %p): erasing %d,%d-%d,%d\n",
4094 f,
4095 wmsg.rect.left, wmsg.rect.top,
4096 wmsg.rect.right, wmsg.rect.bottom));
ce6059da 4097#endif /* W32_DEBUG_DISPLAY */
a6085637 4098 }
5ac45f98
GV		 4099 return 1;
4100 case WM_PALETTECHANGED:
4101 /* ignore our own changes */
4102 if ((HWND)wParam != hwnd)
4103 {
a6085637
KH		 4104 f = x_window_to_frame (dpyinfo, hwnd);
4105 if (f)
4106 /* get_frame_dc will realize our palette and force all
4107 frames to be redrawn if needed. */
4108 release_frame_dc (f, get_frame_dc (f));
5ac45f98
GV		 4109 }
4110 return 0;
ee78dc32 4111 case WM_PAINT:
ce6059da 4112 {
55dcfc15
AI		 4113 PAINTSTRUCT paintStruct;
4114 RECT update_rect;
4115
18f0b342
AI		 4116 f = x_window_to_frame (dpyinfo, hwnd);
4117 if (f == 0)
4118 {
4119 DebPrint (("WM_PAINT received for unknown window %p\n", hwnd));
4120 return 0;
4121 }
4122
55dcfc15
AI		 4123 /* MSDN Docs say not to call BeginPaint if GetUpdateRect
4124 fails. Apparently this can happen under some
4125 circumstances. */
c0611964 4126 if (!w32_strict_painting || GetUpdateRect (hwnd, &update_rect, FALSE))
55dcfc15
AI		 4127 {
4128 enter_crit ();
4129 BeginPaint (hwnd, &paintStruct);
4130
c0611964
AI		 4131 if (w32_strict_painting)
4132 /* The rectangles returned by GetUpdateRect and BeginPaint
4133 do not always match. GetUpdateRect seems to be the
4134 more reliable of the two. */
4135 wmsg.rect = update_rect;
4136 else
4137 wmsg.rect = paintStruct.rcPaint;
55dcfc15
AI		 4138
4139#if defined (W32_DEBUG_DISPLAY)
18f0b342
AI		 4140 DebPrint (("WM_PAINT (frame %p): painting %d,%d-%d,%d\n",
4141 f,
4142 wmsg.rect.left, wmsg.rect.top,
4143 wmsg.rect.right, wmsg.rect.bottom));
4144 DebPrint ((" [update region is %d,%d-%d,%d]\n",
55dcfc15
AI		 4145 update_rect.left, update_rect.top,
4146 update_rect.right, update_rect.bottom));
4147#endif
4148 EndPaint (hwnd, &paintStruct);
4149 leave_crit ();
4150
4151 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4152
4153 return 0;
4154 }
c0611964
AI		 4155
4156 /* If GetUpdateRect returns 0 (meaning there is no update
4157 region), assume the whole window needs to be repainted. */
4158 GetClientRect(hwnd, &wmsg.rect);
4159 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4160 return 0;
ee78dc32 4161 }
a1a80b40 4162
ccc2d29c
GV		 4163 case WM_INPUTLANGCHANGE:
4164 /* Inform lisp thread of keyboard layout changes. */
4165 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4166
4167 /* Clear dead keys in the keyboard state; for simplicity only
4168 preserve modifier key states. */
4169 {
4170 int i;
4171 BYTE keystate[256];
4172
4173 GetKeyboardState (keystate);
4174 for (i = 0; i < 256; i++)
4175 if (1
4176 && i != VK_SHIFT
4177 && i != VK_LSHIFT
4178 && i != VK_RSHIFT
4179 && i != VK_CAPITAL
4180 && i != VK_NUMLOCK
4181 && i != VK_SCROLL
4182 && i != VK_CONTROL
4183 && i != VK_LCONTROL
4184 && i != VK_RCONTROL
4185 && i != VK_MENU
4186 && i != VK_LMENU
4187 && i != VK_RMENU
4188 && i != VK_LWIN
4189 && i != VK_RWIN)
4190 keystate[i] = 0;
4191 SetKeyboardState (keystate);
4192 }
4193 goto dflt;
4194
4195 case WM_HOTKEY:
4196 /* Synchronize hot keys with normal input. */
4197 PostMessage (hwnd, WM_KEYDOWN, HIWORD (lParam), 0);
4198 return (0);
4199
a1a80b40
GV		 4200 case WM_KEYUP:
4201 case WM_SYSKEYUP:
4202 record_keyup (wParam, lParam);
4203 goto dflt;
4204
ee78dc32
GV		 4205 case WM_KEYDOWN:
4206 case WM_SYSKEYDOWN:
ccc2d29c
GV		 4207 /* Ignore keystrokes we fake ourself; see below. */
4208 if (dpyinfo->faked_key == wParam)
4209 {
4210 dpyinfo->faked_key = 0;
576ba81c
AI		 4211 /* Make sure TranslateMessage sees them though (as long as
4212 they don't produce WM_CHAR messages). This ensures that
4213 indicator lights are toggled promptly on Windows 9x, for
4214 example. */
4215 if (lispy_function_keys[wParam] != 0)
4216 {
4217 windows_translate = 1;
4218 goto translate;
4219 }
4220 return 0;
ccc2d29c
GV		 4221 }
4222
7830e24b
RS		 4223 /* Synchronize modifiers with current keystroke. */
4224 sync_modifiers ();
a1a80b40 4225 record_keydown (wParam, lParam);
ccc2d29c 4226 wParam = map_keypad_keys (wParam, (lParam & 0x1000000L) != 0);
84fb1139
KH		 4227
4228 windows_translate = 0;
ccc2d29c
GV		 4229
4230 switch (wParam)
4231 {
4232 case VK_LWIN:
4233 if (NILP (Vw32_pass_lwindow_to_system))
4234 {
4235 /* Prevent system from acting on keyup (which opens the
4236 Start menu if no other key was pressed) by simulating a
4237 press of Space which we will ignore. */
4238 if (GetAsyncKeyState (wParam) & 1)
4239 {
adcc3809 4240 if (NUMBERP (Vw32_phantom_key_code))
576ba81c 4241 key = XUINT (Vw32_phantom_key_code) & 255;
adcc3809 4242 else
576ba81c
AI		 4243 key = VK_SPACE;
4244 dpyinfo->faked_key = key;
4245 keybd_event (key, (BYTE) MapVirtualKey (key, 0), 0, 0);
ccc2d29c
GV		 4246 }
4247 }
4248 if (!NILP (Vw32_lwindow_modifier))
4249 return 0;
4250 break;
4251 case VK_RWIN:
4252 if (NILP (Vw32_pass_rwindow_to_system))
4253 {
4254 if (GetAsyncKeyState (wParam) & 1)
4255 {
adcc3809 4256 if (NUMBERP (Vw32_phantom_key_code))
576ba81c 4257 key = XUINT (Vw32_phantom_key_code) & 255;
adcc3809 4258 else
576ba81c
AI		 4259 key = VK_SPACE;
4260 dpyinfo->faked_key = key;
4261 keybd_event (key, (BYTE) MapVirtualKey (key, 0), 0, 0);
ccc2d29c
GV		 4262 }
4263 }
4264 if (!NILP (Vw32_rwindow_modifier))
4265 return 0;
4266 break;
576ba81c 4267 case VK_APPS:
ccc2d29c
GV		 4268 if (!NILP (Vw32_apps_modifier))
4269 return 0;
4270 break;
4271 case VK_MENU:
4272 if (NILP (Vw32_pass_alt_to_system))
adcc3809
GV		 4273 /* Prevent DefWindowProc from activating the menu bar if an
4274 Alt key is pressed and released by itself. */
ccc2d29c 4275 return 0;
84fb1139 4276 windows_translate = 1;
ccc2d29c
GV		 4277 break;
4278 case VK_CAPITAL:
4279 /* Decide whether to treat as modifier or function key. */
4280 if (NILP (Vw32_enable_caps_lock))
4281 goto disable_lock_key;
adcc3809
GV		 4282 windows_translate = 1;
4283 break;
ccc2d29c
GV		 4284 case VK_NUMLOCK:
4285 /* Decide whether to treat as modifier or function key. */
4286 if (NILP (Vw32_enable_num_lock))
4287 goto disable_lock_key;
adcc3809
GV		 4288 windows_translate = 1;
4289 break;
ccc2d29c
GV		 4290 case VK_SCROLL:
4291 /* Decide whether to treat as modifier or function key. */
4292 if (NILP (Vw32_scroll_lock_modifier))
4293 goto disable_lock_key;
adcc3809
GV		 4294 windows_translate = 1;
4295 break;
ccc2d29c 4296 disable_lock_key:
adcc3809
GV		 4297 /* Ensure the appropriate lock key state (and indicator light)
4298 remains in the same state. We do this by faking another
4299 press of the relevant key. Apparently, this really is the
4300 only way to toggle the state of the indicator lights. */
4301 dpyinfo->faked_key = wParam;
4302 keybd_event ((BYTE) wParam, (BYTE) MapVirtualKey (wParam, 0),
4303 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
4304 keybd_event ((BYTE) wParam, (BYTE) MapVirtualKey (wParam, 0),
4305 KEYEVENTF_EXTENDEDKEY | 0, 0);
4306 keybd_event ((BYTE) wParam, (BYTE) MapVirtualKey (wParam, 0),
4307 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
4308 /* Ensure indicator lights are updated promptly on Windows 9x
4309 (TranslateMessage apparently does this), after forwarding
4310 input event. */
4311 post_character_message (hwnd, msg, wParam, lParam,
4312 w32_get_key_modifiers (wParam, lParam));
4313 windows_translate = 1;
ccc2d29c
GV		 4314 break;
4315 case VK_CONTROL:
4316 case VK_SHIFT:
4317 case VK_PROCESSKEY: /* Generated by IME. */
4318 windows_translate = 1;
4319 break;
adcc3809
GV		 4320 case VK_CANCEL:
4321 /* Windows maps Ctrl-Pause (aka Ctrl-Break) into VK_CANCEL,
4322 which is confusing for purposes of key binding; convert
4323 VK_CANCEL events into VK_PAUSE events. */
4324 wParam = VK_PAUSE;
4325 break;
4326 case VK_PAUSE:
4327 /* Windows maps Ctrl-NumLock into VK_PAUSE, which is confusing
4328 for purposes of key binding; convert these back into
4329 VK_NUMLOCK events, at least when we want to see NumLock key
4330 presses. (Note that there is never any possibility that
4331 VK_PAUSE with Ctrl really is C-Pause as per above.) */
4332 if (NILP (Vw32_enable_num_lock) && modifier_set (VK_CONTROL))
4333 wParam = VK_NUMLOCK;
4334 break;
ccc2d29c
GV		 4335 default:
4336 /* If not defined as a function key, change it to a WM_CHAR message. */
4337 if (lispy_function_keys[wParam] == 0)
4338 {
adcc3809
GV		 4339 DWORD modifiers = construct_console_modifiers ();
4340
ccc2d29c
GV		 4341 if (!NILP (Vw32_recognize_altgr)
4342 && modifier_set (VK_LCONTROL) && modifier_set (VK_RMENU))
4343 {
4344 /* Always let TranslateMessage handle AltGr key chords;
4345 for some reason, ToAscii doesn't always process AltGr
4346 chords correctly. */
4347 windows_translate = 1;
4348 }
adcc3809 4349 else if ((modifiers & (~SHIFT_PRESSED & ~CAPSLOCK_ON)) != 0)
ccc2d29c 4350 {
adcc3809
GV		 4351 /* Handle key chords including any modifiers other
4352 than shift directly, in order to preserve as much
4353 modifier information as possible. */
ccc2d29c
GV		 4354 if ('A' <= wParam && wParam <= 'Z')
4355 {
4356 /* Don't translate modified alphabetic keystrokes,
4357 so the user doesn't need to constantly switch
4358 layout to type control or meta keystrokes when
4359 the normal layout translates alphabetic
4360 characters to non-ascii characters. */
4361 if (!modifier_set (VK_SHIFT))
4362 wParam += ('a' - 'A');
4363 msg = WM_CHAR;
4364 }
4365 else
4366 {
4367 /* Try to handle other keystrokes by determining the
4368 base character (ie. translating the base key plus
4369 shift modifier). */
4370 int add;
4371 int isdead = 0;
4372 KEY_EVENT_RECORD key;
4373
4374 key.bKeyDown = TRUE;
4375 key.wRepeatCount = 1;
4376 key.wVirtualKeyCode = wParam;
4377 key.wVirtualScanCode = (lParam & 0xFF0000) >> 16;
4378 key.uChar.AsciiChar = 0;
adcc3809 4379 key.dwControlKeyState = modifiers;
ccc2d29c
GV		 4380
4381 add = w32_kbd_patch_key (&key);
4382 /* 0 means an unrecognised keycode, negative means
4383 dead key. Ignore both. */
4384 while (--add >= 0)
4385 {
4386 /* Forward asciified character sequence. */
4387 post_character_message
4388 (hwnd, WM_CHAR, key.uChar.AsciiChar, lParam,
4389 w32_get_key_modifiers (wParam, lParam));
4390 w32_kbd_patch_key (&key);
4391 }
4392 return 0;
4393 }
4394 }
4395 else
4396 {
4397 /* Let TranslateMessage handle everything else. */
4398 windows_translate = 1;
4399 }
4400 }
4401 }
a1a80b40 4402
adcc3809 4403 translate:
84fb1139
KH		 4404 if (windows_translate)
4405 {
e9e23e23 4406 MSG windows_msg = { hwnd, msg, wParam, lParam, 0, {0,0} };
84fb1139 4407
e9e23e23
GV		 4408 windows_msg.time = GetMessageTime ();
4409 TranslateMessage (&windows_msg);
84fb1139
KH		 4410 goto dflt;
4411 }
4412
ee78dc32
GV		 4413 /* Fall through */
4414
4415 case WM_SYSCHAR:
4416 case WM_CHAR:
ccc2d29c
GV		 4417 post_character_message (hwnd, msg, wParam, lParam,
4418 w32_get_key_modifiers (wParam, lParam));
ee78dc32 4419 break;
da36a4d6 4420
5ac45f98
GV		 4421 /* Simulate middle mouse button events when left and right buttons
4422 are used together, but only if user has two button mouse. */
ee78dc32 4423 case WM_LBUTTONDOWN:
5ac45f98 4424 case WM_RBUTTONDOWN:
7ce9aaca 4425 if (XINT (Vw32_num_mouse_buttons) > 2)
5ac45f98
GV		 4426 goto handle_plain_button;
4427
4428 {
4429 int this = (msg == WM_LBUTTONDOWN) ? LMOUSE : RMOUSE;
4430 int other = (msg == WM_LBUTTONDOWN) ? RMOUSE : LMOUSE;
4431
3cb20f4a
RS		 4432 if (button_state & this)
4433 return 0;
5ac45f98
GV		 4434
4435 if (button_state == 0)
4436 SetCapture (hwnd);
4437
4438 button_state |= this;
4439
4440 if (button_state & other)
4441 {
84fb1139 4442 if (mouse_button_timer)
5ac45f98 4443 {
84fb1139
KH		 4444 KillTimer (hwnd, mouse_button_timer);
4445 mouse_button_timer = 0;
5ac45f98
GV		 4446
4447 /* Generate middle mouse event instead. */
4448 msg = WM_MBUTTONDOWN;
4449 button_state |= MMOUSE;
4450 }
4451 else if (button_state & MMOUSE)
4452 {
4453 /* Ignore button event if we've already generated a
4454 middle mouse down event. This happens if the
4455 user releases and press one of the two buttons
4456 after we've faked a middle mouse event. */
4457 return 0;
4458 }
4459 else
4460 {
4461 /* Flush out saved message. */
84fb1139 4462 post_msg (&saved_mouse_button_msg);
5ac45f98 4463 }
fbd6baed 4464 wmsg.dwModifiers = w32_get_modifiers ();
5ac45f98
GV		 4465 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4466
4467 /* Clear message buffer. */
84fb1139 4468 saved_mouse_button_msg.msg.hwnd = 0;
5ac45f98
GV		 4469 }
4470 else
4471 {
4472 /* Hold onto message for now. */
84fb1139 4473 mouse_button_timer =
adcc3809
GV		 4474 SetTimer (hwnd, MOUSE_BUTTON_ID,
4475 XINT (Vw32_mouse_button_tolerance), NULL);
84fb1139
KH		 4476 saved_mouse_button_msg.msg.hwnd = hwnd;
4477 saved_mouse_button_msg.msg.message = msg;
4478 saved_mouse_button_msg.msg.wParam = wParam;
4479 saved_mouse_button_msg.msg.lParam = lParam;
4480 saved_mouse_button_msg.msg.time = GetMessageTime ();
fbd6baed 4481 saved_mouse_button_msg.dwModifiers = w32_get_modifiers ();
5ac45f98
GV		 4482 }
4483 }
4484 return 0;
4485
ee78dc32 4486 case WM_LBUTTONUP:
5ac45f98 4487 case WM_RBUTTONUP:
7ce9aaca 4488 if (XINT (Vw32_num_mouse_buttons) > 2)
5ac45f98
GV		 4489 goto handle_plain_button;
4490
4491 {
4492 int this = (msg == WM_LBUTTONUP) ? LMOUSE : RMOUSE;
4493 int other = (msg == WM_LBUTTONUP) ? RMOUSE : LMOUSE;
4494
3cb20f4a
RS		 4495 if ((button_state & this) == 0)
4496 return 0;
5ac45f98
GV		 4497
4498 button_state &= ~this;
4499
4500 if (button_state & MMOUSE)
4501 {
4502 /* Only generate event when second button is released. */
4503 if ((button_state & other) == 0)
4504 {
4505 msg = WM_MBUTTONUP;
4506 button_state &= ~MMOUSE;
4507
4508 if (button_state) abort ();
4509 }
4510 else
4511 return 0;
4512 }
4513 else
4514 {
4515 /* Flush out saved message if necessary. */
84fb1139 4516 if (saved_mouse_button_msg.msg.hwnd)
5ac45f98 4517 {
84fb1139 4518 post_msg (&saved_mouse_button_msg);
5ac45f98
GV		 4519 }
4520 }
fbd6baed 4521 wmsg.dwModifiers = w32_get_modifiers ();
5ac45f98
GV		 4522 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4523
4524 /* Always clear message buffer and cancel timer. */
84fb1139
KH		 4525 saved_mouse_button_msg.msg.hwnd = 0;
4526 KillTimer (hwnd, mouse_button_timer);
4527 mouse_button_timer = 0;
5ac45f98
GV		 4528
4529 if (button_state == 0)
4530 ReleaseCapture ();
4531 }
4532 return 0;
4533
ee78dc32
GV		 4534 case WM_MBUTTONDOWN:
4535 case WM_MBUTTONUP:
5ac45f98 4536 handle_plain_button:
ee78dc32
GV		 4537 {
4538 BOOL up;
1edf84e7 4539 int button;
ee78dc32 4540
1edf84e7 4541 if (parse_button (msg, &button, &up))
ee78dc32
GV		 4542 {
4543 if (up) ReleaseCapture ();
4544 else SetCapture (hwnd);
1edf84e7
GV		 4545 button = (button == 0) ? LMOUSE :
4546 ((button == 1) ? MMOUSE : RMOUSE);
4547 if (up)
4548 button_state &= ~button;
4549 else
4550 button_state |= button;
ee78dc32
GV		 4551 }
4552 }
4553
fbd6baed 4554 wmsg.dwModifiers = w32_get_modifiers ();
ee78dc32 4555 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
5ac45f98
GV		 4556 return 0;
4557
84fb1139 4558 case WM_VSCROLL:
5ac45f98 4559 case WM_MOUSEMOVE:
fbd6baed 4560 if (XINT (Vw32_mouse_move_interval) <= 0
84fb1139
KH		 4561 || (msg == WM_MOUSEMOVE && button_state == 0))
4562 {
fbd6baed 4563 wmsg.dwModifiers = w32_get_modifiers ();
84fb1139
KH		 4564 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4565 return 0;
4566 }
4567
4568 /* Hang onto mouse move and scroll messages for a bit, to avoid
4569 sending such events to Emacs faster than it can process them.
4570 If we get more events before the timer from the first message
4571 expires, we just replace the first message. */
4572
4573 if (saved_mouse_move_msg.msg.hwnd == 0)
4574 mouse_move_timer =
adcc3809
GV		 4575 SetTimer (hwnd, MOUSE_MOVE_ID,
4576 XINT (Vw32_mouse_move_interval), NULL);
84fb1139
KH		 4577
4578 /* Hold onto message for now. */
4579 saved_mouse_move_msg.msg.hwnd = hwnd;
4580 saved_mouse_move_msg.msg.message = msg;
4581 saved_mouse_move_msg.msg.wParam = wParam;
4582 saved_mouse_move_msg.msg.lParam = lParam;
4583 saved_mouse_move_msg.msg.time = GetMessageTime ();
fbd6baed 4584 saved_mouse_move_msg.dwModifiers = w32_get_modifiers ();
84fb1139
KH		 4585
4586 return 0;
4587
1edf84e7
GV		 4588 case WM_MOUSEWHEEL:
4589 wmsg.dwModifiers = w32_get_modifiers ();
4590 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4591 return 0;
4592
cb9e33d4
RS		 4593 case WM_DROPFILES:
4594 wmsg.dwModifiers = w32_get_modifiers ();
4595 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4596 return 0;
4597
84fb1139
KH		 4598 case WM_TIMER:
4599 /* Flush out saved messages if necessary. */
4600 if (wParam == mouse_button_timer)
5ac45f98 4601 {
84fb1139
KH		 4602 if (saved_mouse_button_msg.msg.hwnd)
4603 {
4604 post_msg (&saved_mouse_button_msg);
4605 saved_mouse_button_msg.msg.hwnd = 0;
4606 }
4607 KillTimer (hwnd, mouse_button_timer);
4608 mouse_button_timer = 0;
4609 }
4610 else if (wParam == mouse_move_timer)
4611 {
4612 if (saved_mouse_move_msg.msg.hwnd)
4613 {
4614 post_msg (&saved_mouse_move_msg);
4615 saved_mouse_move_msg.msg.hwnd = 0;
4616 }
4617 KillTimer (hwnd, mouse_move_timer);
4618 mouse_move_timer = 0;
5ac45f98 4619 }
5ac45f98 4620 return 0;
84fb1139
KH		 4621
4622 case WM_NCACTIVATE:
4623 /* Windows doesn't send us focus messages when putting up and
e9e23e23 4624 taking down a system popup dialog as for Ctrl-Alt-Del on Windows 95.
84fb1139
KH		 4625 The only indication we get that something happened is receiving
4626 this message afterwards. So this is a good time to reset our
4627 keyboard modifiers' state. */
4628 reset_modifiers ();
4629 goto dflt;
da36a4d6 4630
1edf84e7 4631 case WM_INITMENU:
487163ac
AI		 4632 button_state = 0;
4633 ReleaseCapture ();
1edf84e7
GV		 4634 /* We must ensure menu bar is fully constructed and up to date
4635 before allowing user interaction with it. To achieve this
4636 we send this message to the lisp thread and wait for a
4637 reply (whose value is not actually needed) to indicate that
4638 the menu bar is now ready for use, so we can now return.
4639
4640 To remain responsive in the meantime, we enter a nested message
4641 loop that can process all other messages.
4642
4643 However, we skip all this if the message results from calling
4644 TrackPopupMenu - in fact, we must NOT attempt to send the lisp
4645 thread a message because it is blocked on us at this point. We
4646 set menubar_active before calling TrackPopupMenu to indicate
4647 this (there is no possibility of confusion with real menubar
4648 being active). */
4649
4650 f = x_window_to_frame (dpyinfo, hwnd);
4651 if (f
4652 && (f->output_data.w32->menubar_active
4653 /* We can receive this message even in the absence of a
4654 menubar (ie. when the system menu is activated) - in this
4655 case we do NOT want to forward the message, otherwise it
4656 will cause the menubar to suddenly appear when the user
4657 had requested it to be turned off! */
4658 || f->output_data.w32->menubar_widget == NULL))
4659 return 0;
4660
4661 {
4662 deferred_msg msg_buf;
4663
4664 /* Detect if message has already been deferred; in this case
4665 we cannot return any sensible value to ignore this. */
4666 if (find_deferred_msg (hwnd, msg) != NULL)
4667 abort ();
4668
4669 return send_deferred_msg (&msg_buf, hwnd, msg, wParam, lParam);
4670 }
4671
4672 case WM_EXITMENULOOP:
4673 f = x_window_to_frame (dpyinfo, hwnd);
4674
4675 /* Indicate that menubar can be modified again. */
4676 if (f)
4677 f->output_data.w32->menubar_active = 0;
4678 goto dflt;
4679
126f2e35
JR		 4680 case WM_MENUSELECT:
4681 wmsg.dwModifiers = w32_get_modifiers ();
4682 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4683 return 0;
4684
87996783
GV		 4685 case WM_MEASUREITEM:
4686 f = x_window_to_frame (dpyinfo, hwnd);
4687 if (f)
4688 {
4689 MEASUREITEMSTRUCT * pMis = (MEASUREITEMSTRUCT *) lParam;
4690
4691 if (pMis->CtlType == ODT_MENU)
4692 {
4693 /* Work out dimensions for popup menu titles. */
4694 char * title = (char *) pMis->itemData;
4695 HDC hdc = GetDC (hwnd);
4696 HFONT menu_font = GetCurrentObject (hdc, OBJ_FONT);
4697 LOGFONT menu_logfont;
4698 HFONT old_font;
4699 SIZE size;
4700
4701 GetObject (menu_font, sizeof (menu_logfont), &menu_logfont);
4702 menu_logfont.lfWeight = FW_BOLD;
4703 menu_font = CreateFontIndirect (&menu_logfont);
4704 old_font = SelectObject (hdc, menu_font);
4705
dfff8a69
JR		 4706 pMis->itemHeight = GetSystemMetrics (SM_CYMENUSIZE);
4707 if (title)
4708 {
4709 GetTextExtentPoint32 (hdc, title, strlen (title), &size);
4710 pMis->itemWidth = size.cx;
4711 if (pMis->itemHeight < size.cy)
4712 pMis->itemHeight = size.cy;
4713 }
4714 else
4715 pMis->itemWidth = 0;
87996783
GV		 4716
4717 SelectObject (hdc, old_font);
4718 DeleteObject (menu_font);
4719 ReleaseDC (hwnd, hdc);
4720 return TRUE;
4721 }
4722 }
4723 return 0;
4724
4725 case WM_DRAWITEM:
4726 f = x_window_to_frame (dpyinfo, hwnd);
4727 if (f)
4728 {
4729 DRAWITEMSTRUCT * pDis = (DRAWITEMSTRUCT *) lParam;
4730
4731 if (pDis->CtlType == ODT_MENU)
4732 {
4733 /* Draw popup menu title. */
4734 char * title = (char *) pDis->itemData;
212da13b
JR		 4735 if (title)
4736 {
4737 HDC hdc = pDis->hDC;
4738 HFONT menu_font = GetCurrentObject (hdc, OBJ_FONT);
4739 LOGFONT menu_logfont;
4740 HFONT old_font;
4741
4742 GetObject (menu_font, sizeof (menu_logfont), &menu_logfont);
4743 menu_logfont.lfWeight = FW_BOLD;
4744 menu_font = CreateFontIndirect (&menu_logfont);
4745 old_font = SelectObject (hdc, menu_font);
4746
4747 /* Always draw title as if not selected. */
4748 ExtTextOut (hdc,
4749 pDis->rcItem.left
4750 + GetSystemMetrics (SM_CXMENUCHECK),
4751 pDis->rcItem.top,
4752 ETO_OPAQUE, &pDis->rcItem,
4753 title, strlen (title), NULL);
4754
4755 SelectObject (hdc, old_font);
4756 DeleteObject (menu_font);
4757 }
87996783
GV		 4758 return TRUE;
4759 }
4760 }
4761 return 0;
4762
1edf84e7
GV		 4763#if 0
4764 /* Still not right - can't distinguish between clicks in the
4765 client area of the frame from clicks forwarded from the scroll
4766 bars - may have to hook WM_NCHITTEST to remember the mouse
4767 position and then check if it is in the client area ourselves. */
4768 case WM_MOUSEACTIVATE:
4769 /* Discard the mouse click that activates a frame, allowing the
4770 user to click anywhere without changing point (or worse!).
4771 Don't eat mouse clicks on scrollbars though!! */
4772 if (LOWORD (lParam) == HTCLIENT )
4773 return MA_ACTIVATEANDEAT;
4774 goto dflt;
4775#endif
4776
1edf84e7 4777 case WM_ACTIVATEAPP:
ccc2d29c 4778 case WM_ACTIVATE:
1edf84e7
GV		 4779 case WM_WINDOWPOSCHANGED:
4780 case WM_SHOWWINDOW:
4781 /* Inform lisp thread that a frame might have just been obscured
4782 or exposed, so should recheck visibility of all frames. */
4783 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4784 goto dflt;
4785
da36a4d6 4786 case WM_SETFOCUS:
adcc3809
GV		 4787 dpyinfo->faked_key = 0;
4788 reset_modifiers ();
ccc2d29c
GV		 4789 register_hot_keys (hwnd);
4790 goto command;
8681157a 4791 case WM_KILLFOCUS:
ccc2d29c 4792 unregister_hot_keys (hwnd);
487163ac
AI		 4793 button_state = 0;
4794 ReleaseCapture ();
65906840
JR		 4795 /* Relinquish the system caret. */
4796 if (w32_system_caret_hwnd)
4797 {
4798 DestroyCaret ();
4799 w32_system_caret_hwnd = NULL;
4800 }
ee78dc32
GV		 4801 case WM_MOVE:
4802 case WM_SIZE:
ee78dc32 4803 case WM_COMMAND:
ccc2d29c 4804 command:
fbd6baed 4805 wmsg.dwModifiers = w32_get_modifiers ();
ee78dc32
GV		 4806 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4807 goto dflt;
8847d890
RS		 4808
4809 case WM_CLOSE:
fbd6baed 4810 wmsg.dwModifiers = w32_get_modifiers ();
8847d890
RS		 4811 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4812 return 0;
4813
ee78dc32
GV		 4814 case WM_WINDOWPOSCHANGING:
4815 {
4816 WINDOWPLACEMENT wp;
4817 LPWINDOWPOS lppos = (WINDOWPOS *) lParam;
1edf84e7
GV		 4818
4819 wp.length = sizeof (WINDOWPLACEMENT);
ee78dc32
GV		 4820 GetWindowPlacement (hwnd, &wp);
4821
1edf84e7 4822 if (wp.showCmd != SW_SHOWMINIMIZED && (lppos->flags & SWP_NOSIZE) == 0)
ee78dc32
GV		 4823 {
4824 RECT rect;
4825 int wdiff;
4826 int hdiff;
1edf84e7
GV		 4827 DWORD font_width;
4828 DWORD line_height;
4829 DWORD internal_border;
4830 DWORD scrollbar_extra;
ee78dc32
GV		 4831 RECT wr;
4832
5ac45f98 4833 wp.length = sizeof(wp);
ee78dc32
GV		 4834 GetWindowRect (hwnd, &wr);
4835
3c190163 4836 enter_crit ();
ee78dc32 4837
1edf84e7
GV		 4838 font_width = GetWindowLong (hwnd, WND_FONTWIDTH_INDEX);
4839 line_height = GetWindowLong (hwnd, WND_LINEHEIGHT_INDEX);
4840 internal_border = GetWindowLong (hwnd, WND_BORDER_INDEX);
4841 scrollbar_extra = GetWindowLong (hwnd, WND_SCROLLBAR_INDEX);
ee78dc32 4842
3c190163 4843 leave_crit ();
ee78dc32
GV		 4844
4845 memset (&rect, 0, sizeof (rect));
4846 AdjustWindowRect (&rect, GetWindowLong (hwnd, GWL_STYLE),
4847 GetMenu (hwnd) != NULL);
4848
1edf84e7
GV		 4849 /* Force width and height of client area to be exact
4850 multiples of the character cell dimensions. */
4851 wdiff = (lppos->cx - (rect.right - rect.left)
4852 - 2 * internal_border - scrollbar_extra)
4853 % font_width;
4854 hdiff = (lppos->cy - (rect.bottom - rect.top)
4855 - 2 * internal_border)
4856 % line_height;
ee78dc32
GV		 4857
4858 if (wdiff || hdiff)
4859 {
4860 /* For right/bottom sizing we can just fix the sizes.
4861 However for top/left sizing we will need to fix the X
4862 and Y positions as well. */
4863
4864 lppos->cx -= wdiff;
4865 lppos->cy -= hdiff;
4866
4867 if (wp.showCmd != SW_SHOWMAXIMIZED
1edf84e7 4868 && (lppos->flags & SWP_NOMOVE) == 0)
ee78dc32
GV		 4869 {
4870 if (lppos->x != wr.left || lppos->y != wr.top)
4871 {
4872 lppos->x += wdiff;
4873 lppos->y += hdiff;
4874 }
4875 else
4876 {
4877 lppos->flags |= SWP_NOMOVE;
4878 }
4879 }
4880
1edf84e7 4881 return 0;
ee78dc32
GV		 4882 }
4883 }
4884 }
ee78dc32
GV		 4885
4886 goto dflt;
1edf84e7 4887
b1f918f8
GV		 4888 case WM_GETMINMAXINFO:
4889 /* Hack to correct bug that allows Emacs frames to be resized
4890 below the Minimum Tracking Size. */
4891 ((LPMINMAXINFO) lParam)->ptMinTrackSize.y++;
bf853fee
AI		 4892 /* Hack to allow resizing the Emacs frame above the screen size.
4893 Note that Windows 9x limits coordinates to 16-bits. */
4894 ((LPMINMAXINFO) lParam)->ptMaxTrackSize.x = 32767;
4895 ((LPMINMAXINFO) lParam)->ptMaxTrackSize.y = 32767;
b1f918f8
GV		 4896 return 0;
4897
1edf84e7
GV		 4898 case WM_EMACS_CREATESCROLLBAR:
4899 return (LRESULT) w32_createscrollbar ((struct frame *) wParam,
4900 (struct scroll_bar *) lParam);
4901
5ac45f98 4902 case WM_EMACS_SHOWWINDOW:
1edf84e7
GV		 4903 return ShowWindow ((HWND) wParam, (WPARAM) lParam);
4904
dfdb4047 4905 case WM_EMACS_SETFOREGROUND:
ce6059da
AI		 4906 {
4907 HWND foreground_window;
4908 DWORD foreground_thread, retval;
4909
4910 /* On NT 5.0, and apparently Windows 98, it is necessary to
4911 attach to the thread that currently has focus in order to
4912 pull the focus away from it. */
4913 foreground_window = GetForegroundWindow ();
4914 foreground_thread = GetWindowThreadProcessId (foreground_window, NULL);
4915 if (!foreground_window
4916 || foreground_thread == GetCurrentThreadId ()
4917 || !AttachThreadInput (GetCurrentThreadId (),
4918 foreground_thread, TRUE))
4919 foreground_thread = 0;
4920
4921 retval = SetForegroundWindow ((HWND) wParam);
4922
4923 /* Detach from the previous foreground thread. */
4924 if (foreground_thread)
4925 AttachThreadInput (GetCurrentThreadId (),
4926 foreground_thread, FALSE);
4927
4928 return retval;
4929 }
dfdb4047 4930
5ac45f98
GV		 4931 case WM_EMACS_SETWINDOWPOS:
4932 {
1edf84e7
GV		 4933 WINDOWPOS * pos = (WINDOWPOS *) wParam;
4934 return SetWindowPos (hwnd, pos->hwndInsertAfter,
5ac45f98
GV		 4935 pos->x, pos->y, pos->cx, pos->cy, pos->flags);
4936 }
1edf84e7 4937
ee78dc32 4938 case WM_EMACS_DESTROYWINDOW:
cb9e33d4 4939 DragAcceptFiles ((HWND) wParam, FALSE);
1edf84e7
GV		 4940 return DestroyWindow ((HWND) wParam);
4941
65906840
JR		 4942 case WM_EMACS_DESTROY_CARET:
4943 w32_system_caret_hwnd = NULL;
4944 return DestroyCaret ();
4945
4946 case WM_EMACS_TRACK_CARET:
4947 /* If there is currently no system caret, create one. */
4948 if (w32_system_caret_hwnd == NULL)
4949 {
4950 w32_system_caret_hwnd = hwnd;
4951 CreateCaret (hwnd, NULL, w32_system_caret_width,
4952 w32_system_caret_height);
4953 }
4954 return SetCaretPos (w32_system_caret_x, w32_system_caret_y);
4955
1edf84e7
GV		 4956 case WM_EMACS_TRACKPOPUPMENU:
4957 {
4958 UINT flags;
4959 POINT *pos;
4960 int retval;
4961 pos = (POINT *)lParam;
4962 flags = TPM_CENTERALIGN;
4963 if (button_state & LMOUSE)
4964 flags |= TPM_LEFTBUTTON;
4965 else if (button_state & RMOUSE)
4966 flags |= TPM_RIGHTBUTTON;
4967
87996783
GV		 4968 /* Remember we did a SetCapture on the initial mouse down event,
4969 so for safety, we make sure the capture is cancelled now. */
4970 ReleaseCapture ();
490822ff 4971 button_state = 0;
87996783 4972
1edf84e7
GV		 4973 /* Use menubar_active to indicate that WM_INITMENU is from
4974 TrackPopupMenu below, and should be ignored. */
4975 f = x_window_to_frame (dpyinfo, hwnd);
4976 if (f)
4977 f->output_data.w32->menubar_active = 1;
4978
4979 if (TrackPopupMenu ((HMENU)wParam, flags, pos->x, pos->y,
4980 0, hwnd, NULL))
4981 {
4982 MSG amsg;
4983 /* Eat any mouse messages during popupmenu */
4984 while (PeekMessage (&amsg, hwnd, WM_MOUSEFIRST, WM_MOUSELAST,
4985 PM_REMOVE));
4986 /* Get the menu selection, if any */
4987 if (PeekMessage (&amsg, hwnd, WM_COMMAND, WM_COMMAND, PM_REMOVE))
4988 {
4989 retval = LOWORD (amsg.wParam);
4990 }
4991 else
4992 {
4993 retval = 0;
4994 }
1edf84e7
GV		 4995 }
4996 else
4997 {
4998 retval = -1;
4999 }
5000
5001 return retval;
5002 }
5003
ee78dc32 5004 default:
93fbe8b7
GV		 5005 /* Check for messages registered at runtime. */
5006 if (msg == msh_mousewheel)
5007 {
5008 wmsg.dwModifiers = w32_get_modifiers ();
5009 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
5010 return 0;
5011 }
5012
ee78dc32
GV		 5013 dflt:
5014 return DefWindowProc (hwnd, msg, wParam, lParam);
5015 }
5016
1edf84e7
GV		 5017
5018 /* The most common default return code for handled messages is 0. */
5019 return 0;
ee78dc32
GV		 5020}
5021
5022void
5023my_create_window (f)
5024 struct frame * f;
5025{
5026 MSG msg;
5027
1edf84e7
GV		 5028 if (!PostThreadMessage (dwWindowsThreadId, WM_EMACS_CREATEWINDOW, (WPARAM)f, 0))
5029 abort ();
ee78dc32
GV		 5030 GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
5031}
5032
fbd6baed 5033/* Create and set up the w32 window for frame F. */
ee78dc32
GV		 5034
5035static void
fbd6baed 5036w32_window (f, window_prompting, minibuffer_only)
ee78dc32
GV		 5037 struct frame *f;
5038 long window_prompting;
5039 int minibuffer_only;
5040{
5041 BLOCK_INPUT;
5042
5043 /* Use the resource name as the top-level window name
5044 for looking up resources. Make a non-Lisp copy
5045 for the window manager, so GC relocation won't bother it.
5046
5047 Elsewhere we specify the window name for the window manager. */
5048
5049 {
5050 char *str = (char *) XSTRING (Vx_resource_name)->data;
5051 f->namebuf = (char *) xmalloc (strlen (str) + 1);
5052 strcpy (f->namebuf, str);
5053 }
5054
5055 my_create_window (f);
5056
5057 validate_x_resource_name ();
5058
5059 /* x_set_name normally ignores requests to set the name if the
5060 requested name is the same as the current name. This is the one
5061 place where that assumption isn't correct; f->name is set, but
5062 the server hasn't been told. */
5063 {
5064 Lisp_Object name;
5065 int explicit = f->explicit_name;
5066
5067 f->explicit_name = 0;
5068 name = f->name;
5069 f->name = Qnil;
5070 x_set_name (f, name, explicit);
5071 }
5072
5073 UNBLOCK_INPUT;
5074
5075 if (!minibuffer_only && FRAME_EXTERNAL_MENU_BAR (f))
5076 initialize_frame_menubar (f);
5077
fbd6baed 5078 if (FRAME_W32_WINDOW (f) == 0)
ee78dc32
GV		 5079 error ("Unable to create window");
5080}
5081
5082/* Handle the icon stuff for this window. Perhaps later we might
5083 want an x_set_icon_position which can be called interactively as
5084 well. */
5085
5086static void
5087x_icon (f, parms)
5088 struct frame *f;
5089 Lisp_Object parms;
5090{
5091 Lisp_Object icon_x, icon_y;
5092
e9e23e23 5093 /* Set the position of the icon. Note that Windows 95 groups all
ee78dc32 5094 icons in the tray. */
6fc2811b
JR		 5095 icon_x = w32_get_arg (parms, Qicon_left, 0, 0, RES_TYPE_NUMBER);
5096 icon_y = w32_get_arg (parms, Qicon_top, 0, 0, RES_TYPE_NUMBER);
ee78dc32
GV		 5097 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
5098 {
b7826503
PJ		 5099 CHECK_NUMBER (icon_x);
5100 CHECK_NUMBER (icon_y);
ee78dc32
GV		 5101 }
5102 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
5103 error ("Both left and top icon corners of icon must be specified");
5104
5105 BLOCK_INPUT;
5106
5107 if (! EQ (icon_x, Qunbound))
5108 x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y));
5109
1edf84e7
GV		 5110#if 0 /* TODO */
5111 /* Start up iconic or window? */
5112 x_wm_set_window_state
6fc2811b 5113 (f, (EQ (w32_get_arg (parms, Qvisibility, 0, 0, RES_TYPE_SYMBOL), Qicon)
1edf84e7
GV		 5114 ? IconicState
5115 : NormalState));
5116
5117 x_text_icon (f, (char *) XSTRING ((!NILP (f->icon_name)
5118 ? f->icon_name
5119 : f->name))->data);
5120#endif
5121
ee78dc32
GV		 5122 UNBLOCK_INPUT;
5123}
5124
6fc2811b
JR		 5125
5126static void
5127x_make_gc (f)
5128 struct frame *f;
5129{
5130 XGCValues gc_values;
5131
5132 BLOCK_INPUT;
5133
5134 /* Create the GC's of this frame.
5135 Note that many default values are used. */
5136
5137 /* Normal video */
5138 gc_values.font = f->output_data.w32->font;
5139
5140 /* Cursor has cursor-color background, background-color foreground. */
5141 gc_values.foreground = FRAME_BACKGROUND_PIXEL (f);
5142 gc_values.background = f->output_data.w32->cursor_pixel;
5143 f->output_data.w32->cursor_gc
5144 = XCreateGC (NULL, FRAME_W32_WINDOW (f),
5145 (GCFont | GCForeground | GCBackground),
5146 &gc_values);
5147
5148 /* Reliefs. */
5149 f->output_data.w32->white_relief.gc = 0;
5150 f->output_data.w32->black_relief.gc = 0;
5151
5152 UNBLOCK_INPUT;
5153}
5154
5155
937e601e
AI		 5156/* Handler for signals raised during x_create_frame and
5157 x_create_top_frame. FRAME is the frame which is partially
5158 constructed. */
5159
5160static Lisp_Object
5161unwind_create_frame (frame)
5162 Lisp_Object frame;
5163{
5164 struct frame *f = XFRAME (frame);
5165
5166 /* If frame is ``official'', nothing to do. */
5167 if (!CONSP (Vframe_list) || !EQ (XCAR (Vframe_list), frame))
5168 {
5169#ifdef GLYPH_DEBUG
5170 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
5171#endif
5172
5173 x_free_frame_resources (f);
5174
5175 /* Check that reference counts are indeed correct. */
5176 xassert (dpyinfo->reference_count == dpyinfo_refcount);
5177 xassert (dpyinfo->image_cache->refcount == image_cache_refcount);
c844a81a
GM		 5178
5179 return Qt;
937e601e
AI		 5180 }
5181
5182 return Qnil;
5183}
5184
5185
ee78dc32
GV		 5186DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
5187 1, 1, 0,
74e1aeec
JR		 5188 doc: /* Make a new window, which is called a \"frame\" in Emacs terms.
5189Returns an Emacs frame object.
5190ALIST is an alist of frame parameters.
5191If the parameters specify that the frame should not have a minibuffer,
5192and do not specify a specific minibuffer window to use,
5193then `default-minibuffer-frame' must be a frame whose minibuffer can
5194be shared by the new frame.
5195
5196This function is an internal primitive--use `make-frame' instead. */)
ee78dc32
GV		 5197 (parms)
5198 Lisp_Object parms;
5199{
5200 struct frame *f;
5201 Lisp_Object frame, tem;
5202 Lisp_Object name;
5203 int minibuffer_only = 0;
5204 long window_prompting = 0;
5205 int width, height;
dc220243 5206 int count = BINDING_STACK_SIZE ();
1edf84e7 5207 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
ee78dc32 5208 Lisp_Object display;
6fc2811b 5209 struct w32_display_info *dpyinfo = NULL;
ee78dc32
GV		 5210 Lisp_Object parent;
5211 struct kboard *kb;
5212
4587b026
GV		 5213 check_w32 ();
5214
ee78dc32
GV		 5215 /* Use this general default value to start with
5216 until we know if this frame has a specified name. */
5217 Vx_resource_name = Vinvocation_name;
5218
6fc2811b 5219 display = w32_get_arg (parms, Qdisplay, 0, 0, RES_TYPE_STRING);
ee78dc32
GV		 5220 if (EQ (display, Qunbound))
5221 display = Qnil;
5222 dpyinfo = check_x_display_info (display);
5223#ifdef MULTI_KBOARD
5224 kb = dpyinfo->kboard;
5225#else
5226 kb = &the_only_kboard;
5227#endif
5228
6fc2811b 5229 name = w32_get_arg (parms, Qname, "name", "Name", RES_TYPE_STRING);
ee78dc32
GV		 5230 if (!STRINGP (name)
5231 && ! EQ (name, Qunbound)
5232 && ! NILP (name))
5233 error ("Invalid frame name--not a string or nil");
5234
5235 if (STRINGP (name))
5236 Vx_resource_name = name;
5237
5238 /* See if parent window is specified. */
6fc2811b 5239 parent = w32_get_arg (parms, Qparent_id, NULL, NULL, RES_TYPE_NUMBER);
ee78dc32
GV		 5240 if (EQ (parent, Qunbound))
5241 parent = Qnil;
5242 if (! NILP (parent))
b7826503 5243 CHECK_NUMBER (parent);
ee78dc32 5244
1edf84e7
GV		 5245 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
5246 /* No need to protect DISPLAY because that's not used after passing
5247 it to make_frame_without_minibuffer. */
5248 frame = Qnil;
5249 GCPRO4 (parms, parent, name, frame);
1660f34a
JR		 5250 tem = w32_get_arg (parms, Qminibuffer, "minibuffer", "Minibuffer",
5251 RES_TYPE_SYMBOL);
ee78dc32
GV		 5252 if (EQ (tem, Qnone) || NILP (tem))
5253 f = make_frame_without_minibuffer (Qnil, kb, display);
5254 else if (EQ (tem, Qonly))
5255 {
5256 f = make_minibuffer_frame ();
5257 minibuffer_only = 1;
5258 }
5259 else if (WINDOWP (tem))
5260 f = make_frame_without_minibuffer (tem, kb, display);
5261 else
5262 f = make_frame (1);
5263
1edf84e7
GV		 5264 XSETFRAME (frame, f);
5265
ee78dc32
GV		 5266 /* Note that Windows does support scroll bars. */
5267 FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
5ac45f98
GV		 5268 /* By default, make scrollbars the system standard width. */
5269 f->scroll_bar_pixel_width = GetSystemMetrics (SM_CXVSCROLL);
ee78dc32 5270
fbd6baed 5271 f->output_method = output_w32;
6fc2811b
JR		 5272 f->output_data.w32 =
5273 (struct w32_output *) xmalloc (sizeof (struct w32_output));
fbd6baed 5274 bzero (f->output_data.w32, sizeof (struct w32_output));
4587b026 5275 FRAME_FONTSET (f) = -1;
937e601e 5276 record_unwind_protect (unwind_create_frame, frame);
4587b026 5277
1edf84e7 5278 f->icon_name
6fc2811b 5279 = w32_get_arg (parms, Qicon_name, "iconName", "Title", RES_TYPE_STRING);
1edf84e7
GV		 5280 if (! STRINGP (f->icon_name))
5281 f->icon_name = Qnil;
5282
fbd6baed 5283/* FRAME_W32_DISPLAY_INFO (f) = dpyinfo; */
ee78dc32
GV		 5284#ifdef MULTI_KBOARD
5285 FRAME_KBOARD (f) = kb;
5286#endif
5287
5288 /* Specify the parent under which to make this window. */
5289
5290 if (!NILP (parent))
5291 {
1660f34a 5292 f->output_data.w32->parent_desc = (Window) XFASTINT (parent);
fbd6baed 5293 f->output_data.w32->explicit_parent = 1;
ee78dc32
GV		 5294 }
5295 else
5296 {
fbd6baed
GV		 5297 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
5298 f->output_data.w32->explicit_parent = 0;
ee78dc32
GV		 5299 }
5300
ee78dc32
GV		 5301 /* Set the name; the functions to which we pass f expect the name to
5302 be set. */
5303 if (EQ (name, Qunbound) || NILP (name))
5304 {
fbd6baed 5305 f->name = build_string (dpyinfo->w32_id_name);
ee78dc32
GV		 5306 f->explicit_name = 0;
5307 }
5308 else
5309 {
5310 f->name = name;
5311 f->explicit_name = 1;
5312 /* use the frame's title when getting resources for this frame. */
5313 specbind (Qx_resource_name, name);
5314 }
5315
5316 /* Extract the window parameters from the supplied values
5317 that are needed to determine window geometry. */
5318 {
5319 Lisp_Object font;
5320
6fc2811b
JR		 5321 font = w32_get_arg (parms, Qfont, "font", "Font", RES_TYPE_STRING);
5322
ee78dc32
GV		 5323 BLOCK_INPUT;
5324 /* First, try whatever font the caller has specified. */
5325 if (STRINGP (font))
4587b026
GV		 5326 {
5327 tem = Fquery_fontset (font, Qnil);
5328 if (STRINGP (tem))
5329 font = x_new_fontset (f, XSTRING (tem)->data);
5330 else
1075afa9 5331 font = x_new_font (f, XSTRING (font)->data);
4587b026 5332 }
ee78dc32
GV		 5333 /* Try out a font which we hope has bold and italic variations. */
5334 if (!STRINGP (font))
e39649be 5335 font = x_new_font (f, "-*-Courier New-normal-r-*-*-*-100-*-*-c-*-iso8859-1");
ee78dc32 5336 if (! STRINGP (font))
6fc2811b 5337 font = x_new_font (f, "-*-Courier-normal-r-*-*-13-*-*-*-c-*-iso8859-1");
ee78dc32
GV		 5338 /* If those didn't work, look for something which will at least work. */
5339 if (! STRINGP (font))
6fc2811b 5340 font = x_new_font (f, "-*-Fixedsys-normal-r-*-*-12-*-*-*-c-*-iso8859-1");
ee78dc32
GV		 5341 UNBLOCK_INPUT;
5342 if (! STRINGP (font))
1edf84e7 5343 font = build_string ("Fixedsys");
ee78dc32
GV		 5344
5345 x_default_parameter (f, parms, Qfont, font,
6fc2811b 5346 "font", "Font", RES_TYPE_STRING);
ee78dc32
GV		 5347 }
5348
5349 x_default_parameter (f, parms, Qborder_width, make_number (2),
1660f34a 5350 "borderWidth", "BorderWidth", RES_TYPE_NUMBER);
ee78dc32
GV		 5351 /* This defaults to 2 in order to match xterm. We recognize either
5352 internalBorderWidth or internalBorder (which is what xterm calls
5353 it). */
5354 if (NILP (Fassq (Qinternal_border_width, parms)))
5355 {
5356 Lisp_Object value;
5357
6fc2811b 5358 value = w32_get_arg (parms, Qinternal_border_width,
1660f34a 5359 "internalBorder", "InternalBorder", RES_TYPE_NUMBER);
ee78dc32
GV		 5360 if (! EQ (value, Qunbound))
5361 parms = Fcons (Fcons (Qinternal_border_width, value),
5362 parms);
5363 }
1edf84e7 5364 /* Default internalBorderWidth to 0 on Windows to match other programs. */
ee78dc32 5365 x_default_parameter (f, parms, Qinternal_border_width, make_number (0),
1660f34a
JR		 5366 "internalBorderWidth", "InternalBorder", RES_TYPE_NUMBER);
5367 x_default_parameter (f, parms, Qvertical_scroll_bars, Qright,
5368 "verticalScrollBars", "ScrollBars", RES_TYPE_SYMBOL);
ee78dc32
GV		 5369
5370 /* Also do the stuff which must be set before the window exists. */
5371 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
6fc2811b 5372 "foreground", "Foreground", RES_TYPE_STRING);
ee78dc32 5373 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
6fc2811b 5374 "background", "Background", RES_TYPE_STRING);
ee78dc32 5375 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
6fc2811b 5376 "pointerColor", "Foreground", RES_TYPE_STRING);
ee78dc32 5377 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
6fc2811b 5378 "cursorColor", "Foreground", RES_TYPE_STRING);
ee78dc32 5379 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
6fc2811b
JR		 5380 "borderColor", "BorderColor", RES_TYPE_STRING);
5381 x_default_parameter (f, parms, Qscreen_gamma, Qnil,
5382 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT);
dfff8a69
JR		 5383 x_default_parameter (f, parms, Qline_spacing, Qnil,
5384 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER);
6fc2811b 5385
ee78dc32 5386
6fc2811b
JR		 5387 /* Init faces before x_default_parameter is called for scroll-bar
5388 parameters because that function calls x_set_scroll_bar_width,
5389 which calls change_frame_size, which calls Fset_window_buffer,
5390 which runs hooks, which call Fvertical_motion. At the end, we
5391 end up in init_iterator with a null face cache, which should not
5392 happen. */
5393 init_frame_faces (f);
5394
ee78dc32 5395 x_default_parameter (f, parms, Qmenu_bar_lines, make_number (1),
6fc2811b
JR		 5396 "menuBar", "MenuBar", RES_TYPE_NUMBER);
5397 x_default_parameter (f, parms, Qtool_bar_lines, make_number (0),
5398 "toolBar", "ToolBar", RES_TYPE_NUMBER);
1edf84e7 5399 x_default_parameter (f, parms, Qbuffer_predicate, Qnil,
6fc2811b 5400 "bufferPredicate", "BufferPredicate", RES_TYPE_SYMBOL);
1edf84e7 5401 x_default_parameter (f, parms, Qtitle, Qnil,
6fc2811b 5402 "title", "Title", RES_TYPE_STRING);
ee78dc32 5403
fbd6baed
GV		 5404 f->output_data.w32->dwStyle = WS_OVERLAPPEDWINDOW;
5405 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
3cf3436e
JR		 5406
5407 /* Add the tool-bar height to the initial frame height so that the
5408 user gets a text display area of the size he specified with -g or
5409 via .Xdefaults. Later changes of the tool-bar height don't
5410 change the frame size. This is done so that users can create
5411 tall Emacs frames without having to guess how tall the tool-bar
5412 will get. */
5413 if (FRAME_TOOL_BAR_LINES (f))
5414 {
5415 int margin, relief, bar_height;
5416
5417 relief = (tool_bar_button_relief > 0
5418 ? tool_bar_button_relief
5419 : DEFAULT_TOOL_BAR_BUTTON_RELIEF);
5420
5421 if (INTEGERP (Vtool_bar_button_margin)
5422 && XINT (Vtool_bar_button_margin) > 0)
5423 margin = XFASTINT (Vtool_bar_button_margin);
5424 else if (CONSP (Vtool_bar_button_margin)
5425 && INTEGERP (XCDR (Vtool_bar_button_margin))
5426 && XINT (XCDR (Vtool_bar_button_margin)) > 0)
5427 margin = XFASTINT (XCDR (Vtool_bar_button_margin));
5428 else
5429 margin = 0;
5430
5431 bar_height = DEFAULT_TOOL_BAR_IMAGE_HEIGHT + 2 * margin + 2 * relief;
5432 f->height += (bar_height + CANON_Y_UNIT (f) - 1) / CANON_Y_UNIT (f);
5433 }
5434
ee78dc32
GV		 5435 window_prompting = x_figure_window_size (f, parms);
5436
5437 if (window_prompting & XNegative)
5438 {
5439 if (window_prompting & YNegative)
fbd6baed 5440 f->output_data.w32->win_gravity = SouthEastGravity;
ee78dc32 5441 else
fbd6baed 5442 f->output_data.w32->win_gravity = NorthEastGravity;
ee78dc32
GV		 5443 }
5444 else
5445 {
5446 if (window_prompting & YNegative)
fbd6baed 5447 f->output_data.w32->win_gravity = SouthWestGravity;
ee78dc32 5448 else
fbd6baed 5449 f->output_data.w32->win_gravity = NorthWestGravity;
ee78dc32
GV		 5450 }
5451
fbd6baed 5452 f->output_data.w32->size_hint_flags = window_prompting;
ee78dc32 5453
6fc2811b
JR		 5454 tem = w32_get_arg (parms, Qunsplittable, 0, 0, RES_TYPE_BOOLEAN);
5455 f->no_split = minibuffer_only || EQ (tem, Qt);
5456
fbd6baed 5457 w32_window (f, window_prompting, minibuffer_only);
ee78dc32 5458 x_icon (f, parms);
6fc2811b
JR		 5459
5460 x_make_gc (f);
5461
5462 /* Now consider the frame official. */
5463 FRAME_W32_DISPLAY_INFO (f)->reference_count++;
5464 Vframe_list = Fcons (frame, Vframe_list);
ee78dc32
GV		 5465
5466 /* We need to do this after creating the window, so that the
5467 icon-creation functions can say whose icon they're describing. */
5468 x_default_parameter (f, parms, Qicon_type, Qnil,
6fc2811b 5469 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL);
ee78dc32
GV		 5470
5471 x_default_parameter (f, parms, Qauto_raise, Qnil,
6fc2811b 5472 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
ee78dc32 5473 x_default_parameter (f, parms, Qauto_lower, Qnil,
6fc2811b 5474 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
ee78dc32 5475 x_default_parameter (f, parms, Qcursor_type, Qbox,
6fc2811b
JR		 5476 "cursorType", "CursorType", RES_TYPE_SYMBOL);
5477 x_default_parameter (f, parms, Qscroll_bar_width, Qnil,
5478 "scrollBarWidth", "ScrollBarWidth", RES_TYPE_NUMBER);
ee78dc32
GV		 5479
5480 /* Dimensions, especially f->height, must be done via change_frame_size.
5481 Change will not be effected unless different from the current
5482 f->height. */
5483 width = f->width;
5484 height = f->height;
dc220243 5485
1026b400
RS		 5486 f->height = 0;
5487 SET_FRAME_WIDTH (f, 0);
6fc2811b
JR		 5488 change_frame_size (f, height, width, 1, 0, 0);
5489
6fc2811b
JR		 5490 /* Tell the server what size and position, etc, we want, and how
5491 badly we want them. This should be done after we have the menu
5492 bar so that its size can be taken into account. */
ee78dc32
GV		 5493 BLOCK_INPUT;
5494 x_wm_set_size_hint (f, window_prompting, 0);
5495 UNBLOCK_INPUT;
5496
4694d762
JR		 5497 /* Set up faces after all frame parameters are known. This call
5498 also merges in face attributes specified for new frames. If we
5499 don't do this, the `menu' face for instance won't have the right
5500 colors, and the menu bar won't appear in the specified colors for
5501 new frames. */
5502 call1 (Qface_set_after_frame_default, frame);
5503
6fc2811b
JR		 5504 /* Make the window appear on the frame and enable display, unless
5505 the caller says not to. However, with explicit parent, Emacs
5506 cannot control visibility, so don't try. */
fbd6baed 5507 if (! f->output_data.w32->explicit_parent)
ee78dc32
GV		 5508 {
5509 Lisp_Object visibility;
5510
6fc2811b 5511 visibility = w32_get_arg (parms, Qvisibility, 0, 0, RES_TYPE_SYMBOL);
ee78dc32
GV		 5512 if (EQ (visibility, Qunbound))
5513 visibility = Qt;
5514
5515 if (EQ (visibility, Qicon))
5516 x_iconify_frame (f);
5517 else if (! NILP (visibility))
5518 x_make_frame_visible (f);
5519 else
5520 /* Must have been Qnil. */
5521 ;
5522 }
6fc2811b 5523 UNGCPRO;
9e57df62
GM		 5524
5525 /* Make sure windows on this frame appear in calls to next-window
5526 and similar functions. */
5527 Vwindow_list = Qnil;
5528
ee78dc32
GV		 5529 return unbind_to (count, frame);
5530}
5531
5532/* FRAME is used only to get a handle on the X display. We don't pass the
5533 display info directly because we're called from frame.c, which doesn't
5534 know about that structure. */
5535Lisp_Object
5536x_get_focus_frame (frame)
5537 struct frame *frame;
5538{
fbd6baed 5539 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (frame);
ee78dc32 5540 Lisp_Object xfocus;
fbd6baed 5541 if (! dpyinfo->w32_focus_frame)
ee78dc32
GV		 5542 return Qnil;
5543
fbd6baed 5544 XSETFRAME (xfocus, dpyinfo->w32_focus_frame);
ee78dc32
GV		 5545 return xfocus;
5546}
1edf84e7
GV		 5547
5548DEFUN ("w32-focus-frame", Fw32_focus_frame, Sw32_focus_frame, 1, 1, 0,
74e1aeec 5549 doc: /* Give FRAME input focus, raising to foreground if necessary. */)
1edf84e7
GV		 5550 (frame)
5551 Lisp_Object frame;
5552{
5553 x_focus_on_frame (check_x_frame (frame));
5554 return Qnil;
5555}
5556
ee78dc32 5557\f
767b1ff0
JR		 5558/* Return the charset portion of a font name. */
5559char * xlfd_charset_of_font (char * fontname)
5560{
5561 char *charset, *encoding;
5562
5563 encoding = strrchr(fontname, '-');
ceb12877 5564 if (!encoding || encoding == fontname)
767b1ff0
JR		 5565 return NULL;
5566
478ea067
AI		 5567 for (charset = encoding - 1; charset >= fontname; charset--)
5568 if (*charset == '-')
5569 break;
767b1ff0 5570
478ea067 5571 if (charset == fontname || strcmp(charset, "-*-*") == 0)
767b1ff0
JR		 5572 return NULL;
5573
5574 return charset + 1;
5575}
5576
33d52f9c
GV		 5577struct font_info *w32_load_bdf_font (struct frame *f, char *fontname,
5578 int size, char* filename);
8edb0a6f 5579static Lisp_Object w32_list_bdf_fonts (Lisp_Object pattern, int max_names);
c7501041
EZ		 5580static BOOL w32_to_x_font (LOGFONT * lplf, char * lpxstr, int len,
5581 char * charset);
5582static BOOL x_to_w32_font (char *lpxstr, LOGFONT *lplogfont);
33d52f9c 5583
8edb0a6f 5584static struct font_info *
33d52f9c 5585w32_load_system_font (f,fontname,size)
55dcfc15
AI		 5586 struct frame *f;
5587 char * fontname;
5588 int size;
ee78dc32 5589{
4587b026
GV		 5590 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
5591 Lisp_Object font_names;
5592
4587b026
GV		 5593 /* Get a list of all the fonts that match this name. Once we
5594 have a list of matching fonts, we compare them against the fonts
5595 we already have loaded by comparing names. */
5596 font_names = w32_list_fonts (f, build_string (fontname), size, 100);
5597
5598 if (!NILP (font_names))
3c190163 5599 {
4587b026
GV		 5600 Lisp_Object tail;
5601 int i;
4587b026
GV		 5602
5603 /* First check if any are already loaded, as that is cheaper
5604 than loading another one. */
5605 for (i = 0; i < dpyinfo->n_fonts; i++)
8e713be6 5606 for (tail = font_names; CONSP (tail); tail = XCDR (tail))
6fc2811b
JR		 5607 if (dpyinfo->font_table[i].name
5608 && (!strcmp (dpyinfo->font_table[i].name,
5609 XSTRING (XCAR (tail))->data)
5610 || !strcmp (dpyinfo->font_table[i].full_name,
5611 XSTRING (XCAR (tail))->data)))
4587b026 5612 return (dpyinfo->font_table + i);
6fc2811b 5613
8e713be6 5614 fontname = (char *) XSTRING (XCAR (font_names))->data;
4587b026 5615 }
1075afa9 5616 else if (w32_strict_fontnames)
5ca0cd71
GV		 5617 {
5618 /* If EnumFontFamiliesEx was available, we got a full list of
5619 fonts back so stop now to avoid the possibility of loading a
5620 random font. If we had to fall back to EnumFontFamilies, the
5621 list is incomplete, so continue whether the font we want was
5622 listed or not. */
5623 HMODULE gdi32 = GetModuleHandle ("gdi32.dll");
5624 FARPROC enum_font_families_ex
1075afa9 5625 = GetProcAddress (gdi32, "EnumFontFamiliesExA");
5ca0cd71
GV		 5626 if (enum_font_families_ex)
5627 return NULL;
5628 }
4587b026
GV		 5629
5630 /* Load the font and add it to the table. */
5631 {
767b1ff0 5632 char *full_name, *encoding, *charset;
4587b026
GV		 5633 XFontStruct *font;
5634 struct font_info *fontp;
3c190163 5635 LOGFONT lf;
4587b026 5636 BOOL ok;
19c291d3 5637 int codepage;
6fc2811b 5638 int i;
5ac45f98 5639
4587b026 5640 if (!fontname || !x_to_w32_font (fontname, &lf))
3c190163 5641 return (NULL);
5ac45f98 5642
4587b026
GV		 5643 if (!*lf.lfFaceName)
5644 /* If no name was specified for the font, we get a random font
5645 from CreateFontIndirect - this is not particularly
5646 desirable, especially since CreateFontIndirect does not
5647 fill out the missing name in lf, so we never know what we
5648 ended up with. */
5649 return NULL;
5650
3c190163 5651 font = (XFontStruct *) xmalloc (sizeof (XFontStruct));
c6be3860 5652 bzero (font, sizeof (*font));
5ac45f98 5653
33d52f9c
GV		 5654 /* Set bdf to NULL to indicate that this is a Windows font. */
5655 font->bdf = NULL;
5ac45f98 5656
3c190163 5657 BLOCK_INPUT;
5ac45f98
GV		 5658
5659 font->hfont = CreateFontIndirect (&lf);
ee78dc32 5660
1a292d24
AI		 5661 if (font->hfont == NULL)
5662 {
5663 ok = FALSE;
5664 }
5665 else
5666 {
5667 HDC hdc;
5668 HANDLE oldobj;
19c291d3
AI		 5669
5670 codepage = w32_codepage_for_font (fontname);
1a292d24
AI		 5671
5672 hdc = GetDC (dpyinfo->root_window);
5673 oldobj = SelectObject (hdc, font->hfont);
5c6682be 5674
1a292d24 5675 ok = GetTextMetrics (hdc, &font->tm);
5c6682be
JR		 5676 if (codepage == CP_UNICODE)
5677 font->double_byte_p = 1;
5678 else
8b77111c
AI		 5679 {
5680 /* Unfortunately, some fonts (eg. MingLiU, a big5 ttf font)
5681 don't report themselves as double byte fonts, when
5682 patently they are. So instead of trusting
5683 GetFontLanguageInfo, we check the properties of the
5684 codepage directly, since that is ultimately what we are
5685 working from anyway. */
5686 /* font->double_byte_p = GetFontLanguageInfo(hdc) & GCP_DBCS; */
5687 CPINFO cpi = {0};
5688 GetCPInfo (codepage, &cpi);
5689 font->double_byte_p = cpi.MaxCharSize > 1;
5690 }
5c6682be 5691
1a292d24
AI		 5692 SelectObject (hdc, oldobj);
5693 ReleaseDC (dpyinfo->root_window, hdc);
6fc2811b
JR		 5694 /* Fill out details in lf according to the font that was
5695 actually loaded. */
5696 lf.lfHeight = font->tm.tmInternalLeading - font->tm.tmHeight;
5697 lf.lfWidth = font->tm.tmAveCharWidth;
5698 lf.lfWeight = font->tm.tmWeight;
5699 lf.lfItalic = font->tm.tmItalic;
5700 lf.lfCharSet = font->tm.tmCharSet;
5701 lf.lfPitchAndFamily = ((font->tm.tmPitchAndFamily & TMPF_FIXED_PITCH)
d88c567c 5702 ? VARIABLE_PITCH : FIXED_PITCH);
6fc2811b
JR		 5703 lf.lfOutPrecision = ((font->tm.tmPitchAndFamily & TMPF_VECTOR)
5704 ? OUT_STROKE_PRECIS : OUT_STRING_PRECIS);
c6be3860
AI		 5705
5706 w32_cache_char_metrics (font);
1a292d24 5707 }
5ac45f98 5708
1a292d24 5709 UNBLOCK_INPUT;
5ac45f98 5710
4587b026
GV		 5711 if (!ok)
5712 {
1a292d24
AI		 5713 w32_unload_font (dpyinfo, font);
5714 return (NULL);
5715 }
ee78dc32 5716
6fc2811b
JR		 5717 /* Find a free slot in the font table. */
5718 for (i = 0; i < dpyinfo->n_fonts; ++i)
5719 if (dpyinfo->font_table[i].name == NULL)
5720 break;
5721
5722 /* If no free slot found, maybe enlarge the font table. */
5723 if (i == dpyinfo->n_fonts
5724 && dpyinfo->n_fonts == dpyinfo->font_table_size)
4587b026 5725 {
6fc2811b
JR		 5726 int sz;
5727 dpyinfo->font_table_size = max (16, 2 * dpyinfo->font_table_size);
5728 sz = dpyinfo->font_table_size * sizeof *dpyinfo->font_table;
4587b026 5729 dpyinfo->font_table
6fc2811b 5730 = (struct font_info *) xrealloc (dpyinfo->font_table, sz);
4587b026
GV		 5731 }
5732
6fc2811b
JR		 5733 fontp = dpyinfo->font_table + i;
5734 if (i == dpyinfo->n_fonts)
5735 ++dpyinfo->n_fonts;
4587b026
GV		 5736
5737 /* Now fill in the slots of *FONTP. */
5738 BLOCK_INPUT;
5739 fontp->font = font;
6fc2811b 5740 fontp->font_idx = i;
4587b026
GV		 5741 fontp->name = (char *) xmalloc (strlen (fontname) + 1);
5742 bcopy (fontname, fontp->name, strlen (fontname) + 1);
5743
767b1ff0
JR		 5744 charset = xlfd_charset_of_font (fontname);
5745
19c291d3
AI		 5746 /* Cache the W32 codepage for a font. This makes w32_encode_char
5747 (called for every glyph during redisplay) much faster. */
5748 fontp->codepage = codepage;
5749
4587b026
GV		 5750 /* Work out the font's full name. */
5751 full_name = (char *)xmalloc (100);
767b1ff0 5752 if (full_name && w32_to_x_font (&lf, full_name, 100, charset))
4587b026
GV		 5753 fontp->full_name = full_name;
5754 else
5755 {
5756 /* If all else fails - just use the name we used to load it. */
5757 xfree (full_name);
5758 fontp->full_name = fontp->name;
5759 }
5760
5761 fontp->size = FONT_WIDTH (font);
5762 fontp->height = FONT_HEIGHT (font);
5763
5764 /* The slot `encoding' specifies how to map a character
5765 code-points (0x20..0x7F or 0x2020..0x7F7F) of each charset to
126f2e35
JR		 5766 the font code-points (0:0x20..0x7F, 1:0xA0..0xFF), or
5767 (0:0x20..0x7F, 1:0xA0..0xFF,
5768 (0:0x2020..0x7F7F, 1:0xA0A0..0xFFFF, 3:0x20A0..0x7FFF,
4587b026 5769 2:0xA020..0xFF7F). For the moment, we don't know which charset
6fc2811b 5770 uses this font. So, we set information in fontp->encoding[1]
4587b026
GV		 5771 which is never used by any charset. If mapping can't be
5772 decided, set FONT_ENCODING_NOT_DECIDED. */
33d52f9c
GV		 5773
5774 /* SJIS fonts need to be set to type 4, all others seem to work as
5775 type FONT_ENCODING_NOT_DECIDED. */
5776 encoding = strrchr (fontp->name, '-');
5777 if (encoding && stricmp (encoding+1, "sjis") == 0)
1c885fe1 5778 fontp->encoding[1] = 4;
33d52f9c 5779 else
1c885fe1 5780 fontp->encoding[1] = FONT_ENCODING_NOT_DECIDED;
4587b026
GV		 5781
5782 /* The following three values are set to 0 under W32, which is
5783 what they get set to if XGetFontProperty fails under X. */
5784 fontp->baseline_offset = 0;
5785 fontp->relative_compose = 0;
33d52f9c 5786 fontp->default_ascent = 0;
4587b026 5787
6fc2811b
JR		 5788 /* Set global flag fonts_changed_p to non-zero if the font loaded
5789 has a character with a smaller width than any other character
5790 before, or if the font loaded has a smalle>r height than any
5791 other font loaded before. If this happens, it will make a
5792 glyph matrix reallocation necessary. */
5793 fonts_changed_p = x_compute_min_glyph_bounds (f);
4587b026 5794 UNBLOCK_INPUT;
4587b026
GV		 5795 return fontp;
5796 }
5797}
5798
33d52f9c
GV		 5799/* Load font named FONTNAME of size SIZE for frame F, and return a
5800 pointer to the structure font_info while allocating it dynamically.
5801 If loading fails, return NULL. */
5802struct font_info *
5803w32_load_font (f,fontname,size)
5804struct frame *f;
5805char * fontname;
5806int size;
5807{
5808 Lisp_Object bdf_fonts;
5809 struct font_info *retval = NULL;
5810
8edb0a6f 5811 bdf_fonts = w32_list_bdf_fonts (build_string (fontname), 1);
33d52f9c
GV		 5812
5813 while (!retval && CONSP (bdf_fonts))
5814 {
5815 char *bdf_name, *bdf_file;
5816 Lisp_Object bdf_pair;
5817
8e713be6
KR		 5818 bdf_name = XSTRING (XCAR (bdf_fonts))->data;
5819 bdf_pair = Fassoc (XCAR (bdf_fonts), Vw32_bdf_filename_alist);
5820 bdf_file = XSTRING (XCDR (bdf_pair))->data;
33d52f9c
GV		 5821
5822 retval = w32_load_bdf_font (f, bdf_name, size, bdf_file);
5823
8e713be6 5824 bdf_fonts = XCDR (bdf_fonts);
33d52f9c
GV		 5825 }
5826
5827 if (retval)
5828 return retval;
5829
5830 return w32_load_system_font(f, fontname, size);
5831}
5832
5833
ee78dc32 5834void
fbd6baed
GV		 5835w32_unload_font (dpyinfo, font)
5836 struct w32_display_info *dpyinfo;
ee78dc32
GV		 5837 XFontStruct * font;
5838{
5839 if (font)
5840 {
c6be3860 5841 if (font->per_char) xfree (font->per_char);
33d52f9c
GV		 5842 if (font->bdf) w32_free_bdf_font (font->bdf);
5843
3c190163 5844 if (font->hfont) DeleteObject(font->hfont);
ee78dc32
GV		 5845 xfree (font);
5846 }
5847}
5848
fbd6baed 5849/* The font conversion stuff between x and w32 */
ee78dc32
GV		 5850
5851/* X font string is as follows (from faces.el)
5852 * (let ((- "[-?]")
5853 * (foundry "[^-]+")
5854 * (family "[^-]+")
5855 * (weight "\\(bold\\|demibold\\|medium\\)") ; 1
5856 * (weight\? "\\([^-]*\\)") ; 1
5857 * (slant "\\([ior]\\)") ; 2
5858 * (slant\? "\\([^-]?\\)") ; 2
5859 * (swidth "\\([^-]*\\)") ; 3
5860 * (adstyle "[^-]*") ; 4
5861 * (pixelsize "[0-9]+")
5862 * (pointsize "[0-9][0-9]+")
5863 * (resx "[0-9][0-9]+")
5864 * (resy "[0-9][0-9]+")
5865 * (spacing "[cmp?*]")
5866 * (avgwidth "[0-9]+")
5867 * (registry "[^-]+")
5868 * (encoding "[^-]+")
5869 * )
ee78dc32 5870 */
ee78dc32 5871
8edb0a6f 5872static LONG
fbd6baed 5873x_to_w32_weight (lpw)
ee78dc32
GV		 5874 char * lpw;
5875{
5876 if (!lpw) return (FW_DONTCARE);
5ac45f98
GV		 5877
5878 if (stricmp (lpw,"heavy") == 0) return FW_HEAVY;
5879 else if (stricmp (lpw,"extrabold") == 0) return FW_EXTRABOLD;
5880 else if (stricmp (lpw,"bold") == 0) return FW_BOLD;
5881 else if (stricmp (lpw,"demibold") == 0) return FW_SEMIBOLD;
1edf84e7 5882 else if (stricmp (lpw,"semibold") == 0) return FW_SEMIBOLD;
5ac45f98
GV		 5883 else if (stricmp (lpw,"medium") == 0) return FW_MEDIUM;
5884 else if (stricmp (lpw,"normal") == 0) return FW_NORMAL;
5885 else if (stricmp (lpw,"light") == 0) return FW_LIGHT;
5886 else if (stricmp (lpw,"extralight") == 0) return FW_EXTRALIGHT;
5887 else if (stricmp (lpw,"thin") == 0) return FW_THIN;
ee78dc32 5888 else
5ac45f98 5889 return FW_DONTCARE;
ee78dc32
GV		 5890}
5891
5ac45f98 5892
8edb0a6f 5893static char *
fbd6baed 5894w32_to_x_weight (fnweight)
ee78dc32
GV		 5895 int fnweight;
5896{
5ac45f98
GV		 5897 if (fnweight >= FW_HEAVY) return "heavy";
5898 if (fnweight >= FW_EXTRABOLD) return "extrabold";
5899 if (fnweight >= FW_BOLD) return "bold";
03f8fb34 5900 if (fnweight >= FW_SEMIBOLD) return "demibold";
5ac45f98
GV		 5901 if (fnweight >= FW_MEDIUM) return "medium";
5902 if (fnweight >= FW_NORMAL) return "normal";
5903 if (fnweight >= FW_LIGHT) return "light";
5904 if (fnweight >= FW_EXTRALIGHT) return "extralight";
5905 if (fnweight >= FW_THIN) return "thin";
5906 else
5907 return "*";
5908}
5909
8edb0a6f 5910static LONG
fbd6baed 5911x_to_w32_charset (lpcs)
5ac45f98
GV		 5912 char * lpcs;
5913{
767b1ff0 5914 Lisp_Object this_entry, w32_charset;
8b77111c
AI		 5915 char *charset;
5916 int len = strlen (lpcs);
5917
5918 /* Support "*-#nnn" format for unknown charsets. */
5919 if (strncmp (lpcs, "*-#", 3) == 0)
5920 return atoi (lpcs + 3);
5921
5922 /* Handle wildcards by ignoring them; eg. treat "big5*-*" as "big5". */
5923 charset = alloca (len + 1);
5924 strcpy (charset, lpcs);
5925 lpcs = strchr (charset, '*');
5926 if (lpcs)
5927 *lpcs = 0;
4587b026 5928
dfff8a69
JR		 5929 /* Look through w32-charset-info-alist for the character set.
5930 Format of each entry is
5931 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
5932 */
8b77111c 5933 this_entry = Fassoc (build_string(charset), Vw32_charset_info_alist);
4587b026 5934
767b1ff0
JR		 5935 if (NILP(this_entry))
5936 {
5937 /* At startup, we want iso8859-1 fonts to come up properly. */
8b77111c 5938 if (stricmp(charset, "iso8859-1") == 0)
767b1ff0
JR		 5939 return ANSI_CHARSET;
5940 else
5941 return DEFAULT_CHARSET;
5942 }
5943
5944 w32_charset = Fcar (Fcdr (this_entry));
5945
5946 // Translate Lisp symbol to number.
5947 if (w32_charset == Qw32_charset_ansi)
5948 return ANSI_CHARSET;
5949 if (w32_charset == Qw32_charset_symbol)
5950 return SYMBOL_CHARSET;
5951 if (w32_charset == Qw32_charset_shiftjis)
5952 return SHIFTJIS_CHARSET;
5953 if (w32_charset == Qw32_charset_hangeul)
5954 return HANGEUL_CHARSET;
5955 if (w32_charset == Qw32_charset_chinesebig5)
5956 return CHINESEBIG5_CHARSET;
5957 if (w32_charset == Qw32_charset_gb2312)
5958 return GB2312_CHARSET;
5959 if (w32_charset == Qw32_charset_oem)
5960 return OEM_CHARSET;
dfff8a69 5961#ifdef JOHAB_CHARSET
767b1ff0
JR		 5962 if (w32_charset == Qw32_charset_johab)
5963 return JOHAB_CHARSET;
5964 if (w32_charset == Qw32_charset_easteurope)
5965 return EASTEUROPE_CHARSET;
5966 if (w32_charset == Qw32_charset_turkish)
5967 return TURKISH_CHARSET;
5968 if (w32_charset == Qw32_charset_baltic)
5969 return BALTIC_CHARSET;
5970 if (w32_charset == Qw32_charset_russian)
5971 return RUSSIAN_CHARSET;
5972 if (w32_charset == Qw32_charset_arabic)
5973 return ARABIC_CHARSET;
5974 if (w32_charset == Qw32_charset_greek)
5975 return GREEK_CHARSET;
5976 if (w32_charset == Qw32_charset_hebrew)
5977 return HEBREW_CHARSET;
5978 if (w32_charset == Qw32_charset_vietnamese)
5979 return VIETNAMESE_CHARSET;
5980 if (w32_charset == Qw32_charset_thai)
5981 return THAI_CHARSET;
5982 if (w32_charset == Qw32_charset_mac)
5983 return MAC_CHARSET;
dfff8a69 5984#endif /* JOHAB_CHARSET */
5ac45f98 5985#ifdef UNICODE_CHARSET
767b1ff0
JR		 5986 if (w32_charset == Qw32_charset_unicode)
5987 return UNICODE_CHARSET;
5ac45f98 5988#endif
dfff8a69
JR		 5989
5990 return DEFAULT_CHARSET;
5ac45f98
GV		 5991}
5992
dfff8a69 5993
8edb0a6f 5994static char *
fbd6baed 5995w32_to_x_charset (fncharset)
5ac45f98
GV		 5996 int fncharset;
5997{
5e905a57 5998 static char buf[32];
767b1ff0 5999 Lisp_Object charset_type;
1edf84e7 6000
5ac45f98
GV		 6001 switch (fncharset)
6002 {
767b1ff0
JR		 6003 case ANSI_CHARSET:
6004 /* Handle startup case of w32-charset-info-alist not
6005 being set up yet. */
6006 if (NILP(Vw32_charset_info_alist))
6007 return "iso8859-1";
6008 charset_type = Qw32_charset_ansi;
6009 break;
6010 case DEFAULT_CHARSET:
6011 charset_type = Qw32_charset_default;
6012 break;
6013 case SYMBOL_CHARSET:
6014 charset_type = Qw32_charset_symbol;
6015 break;
6016 case SHIFTJIS_CHARSET:
6017 charset_type = Qw32_charset_shiftjis;
6018 break;
6019 case HANGEUL_CHARSET:
6020 charset_type = Qw32_charset_hangeul;
6021 break;
6022 case GB2312_CHARSET:
6023 charset_type = Qw32_charset_gb2312;
6024 break;
6025 case CHINESEBIG5_CHARSET:
6026 charset_type = Qw32_charset_chinesebig5;
6027 break;
6028 case OEM_CHARSET:
6029 charset_type = Qw32_charset_oem;
6030 break;
4587b026
GV		 6031
6032 /* More recent versions of Windows (95 and NT4.0) define more
6033 character sets. */
6034#ifdef EASTEUROPE_CHARSET
767b1ff0
JR		 6035 case EASTEUROPE_CHARSET:
6036 charset_type = Qw32_charset_easteurope;
6037 break;
6038 case TURKISH_CHARSET:
6039 charset_type = Qw32_charset_turkish;
6040 break;
6041 case BALTIC_CHARSET:
6042 charset_type = Qw32_charset_baltic;
6043 break;
33d52f9c 6044 case RUSSIAN_CHARSET:
767b1ff0
JR		 6045 charset_type = Qw32_charset_russian;
6046 break;
6047 case ARABIC_CHARSET:
6048 charset_type = Qw32_charset_arabic;
6049 break;
6050 case GREEK_CHARSET:
6051 charset_type = Qw32_charset_greek;
6052 break;
6053 case HEBREW_CHARSET:
6054 charset_type = Qw32_charset_hebrew;
6055 break;
6056 case VIETNAMESE_CHARSET:
6057 charset_type = Qw32_charset_vietnamese;
6058 break;
6059 case THAI_CHARSET:
6060 charset_type = Qw32_charset_thai;
6061 break;
6062 case MAC_CHARSET:
6063 charset_type = Qw32_charset_mac;
6064 break;
6065 case JOHAB_CHARSET:
6066 charset_type = Qw32_charset_johab;
6067 break;
4587b026
GV		 6068#endif
6069
5ac45f98 6070#ifdef UNICODE_CHARSET
767b1ff0
JR		 6071 case UNICODE_CHARSET:
6072 charset_type = Qw32_charset_unicode;
6073 break;
5ac45f98 6074#endif
767b1ff0
JR		 6075 default:
6076 /* Encode numerical value of unknown charset. */
6077 sprintf (buf, "*-#%u", fncharset);
6078 return buf;
5ac45f98 6079 }
767b1ff0
JR		 6080
6081 {
6082 Lisp_Object rest;
6083 char * best_match = NULL;
6084
6085 /* Look through w32-charset-info-alist for the character set.
6086 Prefer ISO codepages, and prefer lower numbers in the ISO
6087 range. Only return charsets for codepages which are installed.
6088
6089 Format of each entry is
6090 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
6091 */
6092 for (rest = Vw32_charset_info_alist; CONSP (rest); rest = XCDR (rest))
6093 {
6094 char * x_charset;
6095 Lisp_Object w32_charset;
6096 Lisp_Object codepage;
6097
6098 Lisp_Object this_entry = XCAR (rest);
6099
6100 /* Skip invalid entries in alist. */
6101 if (!CONSP (this_entry) || !STRINGP (XCAR (this_entry))
6102 || !CONSP (XCDR (this_entry))
6103 || !SYMBOLP (XCAR (XCDR (this_entry))))
6104 continue;
6105
6106 x_charset = XSTRING (XCAR (this_entry))->data;
6107 w32_charset = XCAR (XCDR (this_entry));
6108 codepage = XCDR (XCDR (this_entry));
6109
6110 /* Look for Same charset and a valid codepage (or non-int
6111 which means ignore). */
6112 if (w32_charset == charset_type
6113 && (!INTEGERP (codepage) || codepage == CP_DEFAULT
6114 || IsValidCodePage (XINT (codepage))))
6115 {
6116 /* If we don't have a match already, then this is the
6117 best. */
6118 if (!best_match)
6119 best_match = x_charset;
6120 /* If this is an ISO codepage, and the best so far isn't,
6121 then this is better. */
6122 else if (stricmp (best_match, "iso") != 0
6123 && stricmp (x_charset, "iso") == 0)
6124 best_match = x_charset;
6125 /* If both are ISO8859 codepages, choose the one with the
6126 lowest number in the encoding field. */
6127 else if (stricmp (best_match, "iso8859-") == 0
6128 && stricmp (x_charset, "iso8859-") == 0)
6129 {
6130 int best_enc = atoi (best_match + 8);
6131 int this_enc = atoi (x_charset + 8);
6132 if (this_enc > 0 && this_enc < best_enc)
6133 best_match = x_charset;
6134 }
6135 }
6136 }
6137
6138 /* If no match, encode the numeric value. */
6139 if (!best_match)
6140 {
6141 sprintf (buf, "*-#%u", fncharset);
6142 return buf;
6143 }
6144
5e905a57
JR		 6145 strncpy(buf, best_match, 31);
6146 buf[31] = '\0';
767b1ff0
JR		 6147 return buf;
6148 }
ee78dc32
GV		 6149}
6150
dfff8a69
JR		 6151
6152/* Get the Windows codepage corresponding to the specified font. The
6153 charset info in the font name is used to look up
6154 w32-charset-to-codepage-alist. */
6155int
6156w32_codepage_for_font (char *fontname)
6157{
767b1ff0
JR		 6158 Lisp_Object codepage, entry;
6159 char *charset_str, *charset, *end;
dfff8a69 6160
767b1ff0 6161 if (NILP (Vw32_charset_info_alist))
dfff8a69
JR		 6162 return CP_DEFAULT;
6163
767b1ff0
JR		 6164 /* Extract charset part of font string. */
6165 charset = xlfd_charset_of_font (fontname);
6166
6167 if (!charset)
ceb12877 6168 return CP_UNKNOWN;
767b1ff0 6169
8b77111c 6170 charset_str = (char *) alloca (strlen (charset) + 1);
767b1ff0
JR		 6171 strcpy (charset_str, charset);
6172
8b77111c 6173#if 0
dfff8a69
JR		 6174 /* Remove leading "*-". */
6175 if (strncmp ("*-", charset_str, 2) == 0)
6176 charset = charset_str + 2;
6177 else
8b77111c 6178#endif
dfff8a69
JR		 6179 charset = charset_str;
6180
6181 /* Stop match at wildcard (including preceding '-'). */
6182 if (end = strchr (charset, '*'))
6183 {
6184 if (end > charset && *(end-1) == '-')
6185 end--;
6186 *end = '\0';
6187 }
6188
767b1ff0
JR		 6189 entry = Fassoc (build_string(charset), Vw32_charset_info_alist);
6190 if (NILP (entry))
ceb12877 6191 return CP_UNKNOWN;
767b1ff0
JR		 6192
6193 codepage = Fcdr (Fcdr (entry));
6194
6195 if (NILP (codepage))
6196 return CP_8BIT;
6197 else if (XFASTINT (codepage) == XFASTINT (Qt))
6198 return CP_UNICODE;
6199 else if (INTEGERP (codepage))
dfff8a69
JR		 6200 return XINT (codepage);
6201 else
ceb12877 6202 return CP_UNKNOWN;
dfff8a69
JR		 6203}
6204
6205
8edb0a6f 6206static BOOL
767b1ff0 6207w32_to_x_font (lplogfont, lpxstr, len, specific_charset)
ee78dc32
GV		 6208 LOGFONT * lplogfont;
6209 char * lpxstr;
6210 int len;
767b1ff0 6211 char * specific_charset;
ee78dc32 6212{
6fc2811b 6213 char* fonttype;
f46e6225 6214 char *fontname;
3cb20f4a
RS		 6215 char height_pixels[8];
6216 char height_dpi[8];
6217 char width_pixels[8];
4587b026 6218 char *fontname_dash;
d88c567c
JR		 6219 int display_resy = one_w32_display_info.resy;
6220 int display_resx = one_w32_display_info.resx;
f46e6225
GV		 6221 int bufsz;
6222 struct coding_system coding;
3cb20f4a
RS		 6223
6224 if (!lpxstr) abort ();
ee78dc32 6225
3cb20f4a
RS		 6226 if (!lplogfont)
6227 return FALSE;
6228
6fc2811b
JR		 6229 if (lplogfont->lfOutPrecision == OUT_STRING_PRECIS)
6230 fonttype = "raster";
6231 else if (lplogfont->lfOutPrecision == OUT_STROKE_PRECIS)
6232 fonttype = "outline";
6233 else
6234 fonttype = "unknown";
6235
f46e6225
GV		 6236 setup_coding_system (Fcheck_coding_system (Vw32_system_coding_system),
6237 &coding);
aab5ac44
KH		 6238 coding.src_multibyte = 0;
6239 coding.dst_multibyte = 1;
f46e6225
GV		 6240 coding.mode |= CODING_MODE_LAST_BLOCK;
6241 bufsz = decoding_buffer_size (&coding, LF_FACESIZE);
6242
6243 fontname = alloca(sizeof(*fontname) * bufsz);
6244 decode_coding (&coding, lplogfont->lfFaceName, fontname,
6245 strlen(lplogfont->lfFaceName), bufsz - 1);
6246 *(fontname + coding.produced) = '\0';
4587b026
GV		 6247
6248 /* Replace dashes with underscores so the dashes are not
f46e6225 6249 misinterpreted. */
4587b026
GV		 6250 fontname_dash = fontname;
6251 while (fontname_dash = strchr (fontname_dash, '-'))
6252 *fontname_dash = '_';
6253
3cb20f4a 6254 if (lplogfont->lfHeight)
ee78dc32 6255 {
3cb20f4a
RS		 6256 sprintf (height_pixels, "%u", abs (lplogfont->lfHeight));
6257 sprintf (height_dpi, "%u",
33d52f9c 6258 abs (lplogfont->lfHeight) * 720 / display_resy);
5ac45f98
GV		 6259 }
6260 else
ee78dc32 6261 {
3cb20f4a
RS		 6262 strcpy (height_pixels, "*");
6263 strcpy (height_dpi, "*");
ee78dc32 6264 }
3cb20f4a
RS		 6265 if (lplogfont->lfWidth)
6266 sprintf (width_pixels, "%u", lplogfont->lfWidth * 10);
6267 else
6268 strcpy (width_pixels, "*");
6269
6270 _snprintf (lpxstr, len - 1,
6fc2811b
JR		 6271 "-%s-%s-%s-%c-normal-normal-%s-%s-%d-%d-%c-%s-%s",
6272 fonttype, /* foundry */
4587b026
GV		 6273 fontname, /* family */
6274 w32_to_x_weight (lplogfont->lfWeight), /* weight */
6275 lplogfont->lfItalic?'i':'r', /* slant */
6276 /* setwidth name */
6277 /* add style name */
6278 height_pixels, /* pixel size */
6279 height_dpi, /* point size */
33d52f9c
GV		 6280 display_resx, /* resx */
6281 display_resy, /* resy */
4587b026
GV		 6282 ((lplogfont->lfPitchAndFamily & 0x3) == VARIABLE_PITCH)
6283 ? 'p' : 'c', /* spacing */
6284 width_pixels, /* avg width */
767b1ff0
JR		 6285 specific_charset ? specific_charset
6286 : w32_to_x_charset (lplogfont->lfCharSet)
6287 /* charset registry and encoding */
3cb20f4a
RS		 6288 );
6289
ee78dc32
GV		 6290 lpxstr[len - 1] = 0; /* just to be sure */
6291 return (TRUE);
6292}
6293
8edb0a6f 6294static BOOL
fbd6baed 6295x_to_w32_font (lpxstr, lplogfont)
ee78dc32
GV		 6296 char * lpxstr;
6297 LOGFONT * lplogfont;
6298{
f46e6225
GV		 6299 struct coding_system coding;
6300
ee78dc32 6301 if (!lplogfont) return (FALSE);
f46e6225 6302
ee78dc32 6303 memset (lplogfont, 0, sizeof (*lplogfont));
5ac45f98 6304
1a292d24 6305 /* Set default value for each field. */
771c47d5 6306#if 1
ee78dc32
GV		 6307 lplogfont->lfOutPrecision = OUT_DEFAULT_PRECIS;
6308 lplogfont->lfClipPrecision = CLIP_DEFAULT_PRECIS;
6309 lplogfont->lfQuality = DEFAULT_QUALITY;
5ac45f98
GV		 6310#else
6311 /* go for maximum quality */
6312 lplogfont->lfOutPrecision = OUT_STROKE_PRECIS;
6313 lplogfont->lfClipPrecision = CLIP_STROKE_PRECIS;
6314 lplogfont->lfQuality = PROOF_QUALITY;
6315#endif
6316
1a292d24
AI		 6317 lplogfont->lfCharSet = DEFAULT_CHARSET;
6318 lplogfont->lfWeight = FW_DONTCARE;
6319 lplogfont->lfPitchAndFamily = DEFAULT_PITCH | FF_DONTCARE;
6320
5ac45f98
GV		 6321 if (!lpxstr)
6322 return FALSE;
6323
6324 /* Provide a simple escape mechanism for specifying Windows font names
6325 * directly -- if font spec does not beginning with '-', assume this
6326 * format:
6327 * "<font name>[:height in pixels[:width in pixels[:weight]]]"
6328 */
ee78dc32 6329
5ac45f98
GV		 6330 if (*lpxstr == '-')
6331 {
33d52f9c
GV		 6332 int fields, tem;
6333 char name[50], weight[20], slant, pitch, pixels[10], height[10],
8b77111c 6334 width[10], resy[10], remainder[50];
5ac45f98 6335 char * encoding;
d98c0337 6336 int dpi = one_w32_display_info.resy;
5ac45f98
GV		 6337
6338 fields = sscanf (lpxstr,
8b77111c 6339 "-%*[^-]-%49[^-]-%19[^-]-%c-%*[^-]-%*[^-]-%9[^-]-%9[^-]-%*[^-]-%9[^-]-%c-%9[^-]-%49s",
33d52f9c 6340 name, weight, &slant, pixels, height, resy, &pitch, width, remainder);
8b77111c
AI		 6341 if (fields == EOF)
6342 return (FALSE);
6343
6344 /* In the general case when wildcards cover more than one field,
6345 we don't know which field is which, so don't fill any in.
6346 However, we need to cope with this particular form, which is
6347 generated by font_list_1 (invoked by try_font_list):
6348 "-raster-6x10-*-gb2312*-*"
6349 and make sure to correctly parse the charset field. */
6350 if (fields == 3)
6351 {
6352 fields = sscanf (lpxstr,
6353 "-%*[^-]-%49[^-]-*-%49s",
6354 name, remainder);
6355 }
6356 else if (fields < 9)
6357 {
6358 fields = 0;
6359 remainder[0] = 0;
6360 }
6fc2811b 6361
5ac45f98
GV		 6362 if (fields > 0 && name[0] != '*')
6363 {
8ea3e054
RS		 6364 int bufsize;
6365 unsigned char *buf;
6366
f46e6225
GV		 6367 setup_coding_system
6368 (Fcheck_coding_system (Vw32_system_coding_system), &coding);
aab5ac44
KH		 6369 coding.src_multibyte = 1;
6370 coding.dst_multibyte = 1;
8ea3e054
RS		 6371 bufsize = encoding_buffer_size (&coding, strlen (name));
6372 buf = (unsigned char *) alloca (bufsize);
f46e6225 6373 coding.mode |= CODING_MODE_LAST_BLOCK;
8ea3e054
RS		 6374 encode_coding (&coding, name, buf, strlen (name), bufsize);
6375 if (coding.produced >= LF_FACESIZE)
6376 coding.produced = LF_FACESIZE - 1;
6377 buf[coding.produced] = 0;
6378 strcpy (lplogfont->lfFaceName, buf);
5ac45f98
GV		 6379 }
6380 else
6381 {
6fc2811b 6382 lplogfont->lfFaceName[0] = '\0';
5ac45f98
GV		 6383 }
6384
6385 fields--;
6386
fbd6baed 6387 lplogfont->lfWeight = x_to_w32_weight ((fields > 0 ? weight : ""));
5ac45f98
GV		 6388
6389 fields--;
6390
c8874f14 6391 lplogfont->lfItalic = (fields > 0 && slant == 'i');
5ac45f98
GV		 6392
6393 fields--;
6394
6395 if (fields > 0 && pixels[0] != '*')
6396 lplogfont->lfHeight = atoi (pixels);
6397
6398 fields--;
5ac45f98 6399 fields--;
33d52f9c
GV		 6400 if (fields > 0 && resy[0] != '*')
6401 {
6fc2811b 6402 tem = atoi (resy);
33d52f9c
GV		 6403 if (tem > 0) dpi = tem;
6404 }
5ac45f98 6405
33d52f9c
GV		 6406 if (fields > -1 && lplogfont->lfHeight == 0 && height[0] != '*')
6407 lplogfont->lfHeight = atoi (height) * dpi / 720;
6408
6409 if (fields > 0)
5ac45f98
GV		 6410 lplogfont->lfPitchAndFamily =
6411 (fields > 0 && pitch == 'p') ? VARIABLE_PITCH : FIXED_PITCH;
6412
6413 fields--;
6414
6415 if (fields > 0 && width[0] != '*')
6416 lplogfont->lfWidth = atoi (width) / 10;
6417
6418 fields--;
6419
4587b026 6420 /* Strip the trailing '-' if present. (it shouldn't be, as it
d88c567c 6421 fails the test against xlfd-tight-regexp in fontset.el). */
3c190163 6422 {
5ac45f98
GV		 6423 int len = strlen (remainder);
6424 if (len > 0 && remainder[len-1] == '-')
6425 remainder[len-1] = 0;
ee78dc32 6426 }
5ac45f98 6427 encoding = remainder;
8b77111c 6428#if 0
5ac45f98
GV		 6429 if (strncmp (encoding, "*-", 2) == 0)
6430 encoding += 2;
8b77111c
AI		 6431#endif
6432 lplogfont->lfCharSet = x_to_w32_charset (encoding);
5ac45f98
GV		 6433 }
6434 else
6435 {
6436 int fields;
6437 char name[100], height[10], width[10], weight[20];
a1a80b40 6438
5ac45f98
GV		 6439 fields = sscanf (lpxstr,
6440 "%99[^:]:%9[^:]:%9[^:]:%19s",
6441 name, height, width, weight);
6442
6443 if (fields == EOF) return (FALSE);
6444
6445 if (fields > 0)
6446 {
6447 strncpy (lplogfont->lfFaceName,name, LF_FACESIZE);
6448 lplogfont->lfFaceName[LF_FACESIZE-1] = 0;
6449 }
6450 else
6451 {
6452 lplogfont->lfFaceName[0] = 0;
6453 }
6454
6455 fields--;
6456
6457 if (fields > 0)
6458 lplogfont->lfHeight = atoi (height);
6459
6460 fields--;
6461
6462 if (fields > 0)
6463 lplogfont->lfWidth = atoi (width);
6464
6465 fields--;
6466
fbd6baed 6467 lplogfont->lfWeight = x_to_w32_weight ((fields > 0 ? weight : ""));
5ac45f98
GV		 6468 }
6469
6470 /* This makes TrueType fonts work better. */
6471 lplogfont->lfHeight = - abs (lplogfont->lfHeight);
6fc2811b 6472
ee78dc32
GV		 6473 return (TRUE);
6474}
6475
d88c567c
JR		 6476/* Strip the pixel height and point height from the given xlfd, and
6477 return the pixel height. If no pixel height is specified, calculate
6478 one from the point height, or if that isn't defined either, return
6479 0 (which usually signifies a scalable font).
6480*/
8edb0a6f
JR		 6481static int
6482xlfd_strip_height (char *fontname)
d88c567c 6483{
8edb0a6f 6484 int pixel_height, field_number;
d88c567c
JR		 6485 char *read_from, *write_to;
6486
6487 xassert (fontname);
6488
6489 pixel_height = field_number = 0;
6490 write_to = NULL;
6491
6492 /* Look for height fields. */
6493 for (read_from = fontname; *read_from; read_from++)
6494 {
6495 if (*read_from == '-')
6496 {
6497 field_number++;
6498 if (field_number == 7) /* Pixel height. */
6499 {
6500 read_from++;
6501 write_to = read_from;
6502
6503 /* Find end of field. */
6504 for (;*read_from && *read_from != '-'; read_from++)
6505 ;
6506
6507 /* Split the fontname at end of field. */
6508 if (*read_from)
6509 {
6510 *read_from = '\0';
6511 read_from++;
6512 }
6513 pixel_height = atoi (write_to);
6514 /* Blank out field. */
6515 if (read_from > write_to)
6516 {
6517 *write_to = '-';
6518 write_to++;
6519 }
767b1ff0 6520 /* If the pixel height field is at the end (partial xlfd),
d88c567c
JR		 6521 return now. */
6522 else
6523 return pixel_height;
6524
6525 /* If we got a pixel height, the point height can be
6526 ignored. Just blank it out and break now. */
6527 if (pixel_height)
6528 {
6529 /* Find end of point size field. */
6530 for (; *read_from && *read_from != '-'; read_from++)
6531 ;
6532
6533 if (*read_from)
6534 read_from++;
6535
6536 /* Blank out the point size field. */
6537 if (read_from > write_to)
6538 {
6539 *write_to = '-';
6540 write_to++;
6541 }
6542 else
6543 return pixel_height;
6544
6545 break;
6546 }
6547 /* If the point height is already blank, break now. */
6548 if (*read_from == '-')
6549 {
6550 read_from++;
6551 break;
6552 }
6553 }
6554 else if (field_number == 8)
6555 {
6556 /* If we didn't get a pixel height, try to get the point
6557 height and convert that. */
6558 int point_size;
6559 char *point_size_start = read_from++;
6560
6561 /* Find end of field. */
6562 for (; *read_from && *read_from != '-'; read_from++)
6563 ;
6564
6565 if (*read_from)
6566 {
6567 *read_from = '\0';
6568 read_from++;
6569 }
6570
6571 point_size = atoi (point_size_start);
6572
6573 /* Convert to pixel height. */
6574 pixel_height = point_size
6575 * one_w32_display_info.height_in / 720;
6576
6577 /* Blank out this field and break. */
6578 *write_to = '-';
6579 write_to++;
6580 break;
6581 }
6582 }
6583 }
6584
6585 /* Shift the rest of the font spec into place. */
6586 if (write_to && read_from > write_to)
6587 {
6588 for (; *read_from; read_from++, write_to++)
6589 *write_to = *read_from;
6590 *write_to = '\0';
6591 }
6592
6593 return pixel_height;
6594}
6595
6fc2811b 6596/* Assume parameter 1 is fully qualified, no wildcards. */
8edb0a6f 6597static BOOL
6fc2811b
JR		 6598w32_font_match (fontname, pattern)
6599 char * fontname;
6600 char * pattern;
ee78dc32 6601{
e7c72122 6602 char *regex = alloca (strlen (pattern) * 2 + 3);
d88c567c 6603 char *font_name_copy = alloca (strlen (fontname) + 1);
6fc2811b 6604 char *ptr;
ee78dc32 6605
d88c567c
JR		 6606 /* Copy fontname so we can modify it during comparison. */
6607 strcpy (font_name_copy, fontname);
6608
6fc2811b
JR		 6609 ptr = regex;
6610 *ptr++ = '^';
ee78dc32 6611
6fc2811b
JR		 6612 /* Turn pattern into a regexp and do a regexp match. */
6613 for (; *pattern; pattern++)
6614 {
6615 if (*pattern == '?')
6616 *ptr++ = '.';
6617 else if (*pattern == '*')
6618 {
6619 *ptr++ = '.';
6620 *ptr++ = '*';
6621 }
33d52f9c 6622 else
6fc2811b 6623 *ptr++ = *pattern;
ee78dc32 6624 }
6fc2811b
JR		 6625 *ptr = '$';
6626 *(ptr + 1) = '\0';
6627
d88c567c
JR		 6628 /* Strip out font heights and compare them seperately, since
6629 rounding error can cause mismatches. This also allows a
6630 comparison between a font that declares only a pixel height and a
6631 pattern that declares the point height.
6632 */
6633 {
6634 int font_height, pattern_height;
6635
6636 font_height = xlfd_strip_height (font_name_copy);
6637 pattern_height = xlfd_strip_height (regex);
6638
6639 /* Compare now, and don't bother doing expensive regexp matching
6640 if the heights differ. */
6641 if (font_height && pattern_height && (font_height != pattern_height))
6642 return FALSE;
6643 }
6644
6fc2811b 6645 return (fast_c_string_match_ignore_case (build_string (regex),
d88c567c 6646 font_name_copy) >= 0);
ee78dc32
GV		 6647}
6648
5ca0cd71
GV		 6649/* Callback functions, and a structure holding info they need, for
6650 listing system fonts on W32. We need one set of functions to do the
6651 job properly, but these don't work on NT 3.51 and earlier, so we
6652 have a second set which don't handle character sets properly to
6653 fall back on.
6654
6655 In both cases, there are two passes made. The first pass gets one
6656 font from each family, the second pass lists all the fonts from
6657 each family. */
6658
ee78dc32
GV		 6659typedef struct enumfont_t
6660{
6661 HDC hdc;
6662 int numFonts;
3cb20f4a 6663 LOGFONT logfont;
ee78dc32
GV		 6664 XFontStruct *size_ref;
6665 Lisp_Object *pattern;
ee78dc32
GV		 6666 Lisp_Object *tail;
6667} enumfont_t;
6668
8edb0a6f 6669static int CALLBACK
ee78dc32
GV		 6670enum_font_cb2 (lplf, lptm, FontType, lpef)
6671 ENUMLOGFONT * lplf;
6672 NEWTEXTMETRIC * lptm;
6673 int FontType;
6674 enumfont_t * lpef;
6675{
66895301
JR		 6676 /* Ignore struck out and underlined versions of fonts. */
6677 if (lplf->elfLogFont.lfStrikeOut || lplf->elfLogFont.lfUnderline)
6678 return 1;
6679
6680 /* Only return fonts with names starting with @ if they were
6681 explicitly specified, since Microsoft uses an initial @ to
6682 denote fonts for vertical writing, without providing a more
6683 convenient way of identifying them. */
6684 if (lplf->elfLogFont.lfFaceName[0] == '@'
6685 && lpef->logfont.lfFaceName[0] != '@')
5e905a57
JR		 6686 return 1;
6687
4587b026
GV		 6688 /* Check that the character set matches if it was specified */
6689 if (lpef->logfont.lfCharSet != DEFAULT_CHARSET &&
6690 lplf->elfLogFont.lfCharSet != lpef->logfont.lfCharSet)
5e905a57 6691 return 1;
4587b026 6692
ee78dc32
GV		 6693 {
6694 char buf[100];
4587b026 6695 Lisp_Object width = Qnil;
767b1ff0 6696 char *charset = NULL;
ee78dc32 6697
6fc2811b
JR		 6698 /* Truetype fonts do not report their true metrics until loaded */
6699 if (FontType != RASTER_FONTTYPE)
3cb20f4a 6700 {
6fc2811b
JR		 6701 if (!NILP (*(lpef->pattern)))
6702 {
6703 /* Scalable fonts are as big as you want them to be. */
6704 lplf->elfLogFont.lfHeight = lpef->logfont.lfHeight;
6705 lplf->elfLogFont.lfWidth = lpef->logfont.lfWidth;
6706 width = make_number (lpef->logfont.lfWidth);
6707 }
6708 else
6709 {
6710 lplf->elfLogFont.lfHeight = 0;
6711 lplf->elfLogFont.lfWidth = 0;
6712 }
3cb20f4a 6713 }
6fc2811b 6714
f46e6225
GV		 6715 /* Make sure the height used here is the same as everywhere
6716 else (ie character height, not cell height). */
6fc2811b
JR		 6717 if (lplf->elfLogFont.lfHeight > 0)
6718 {
6719 /* lptm can be trusted for RASTER fonts, but not scalable ones. */
6720 if (FontType == RASTER_FONTTYPE)
6721 lplf->elfLogFont.lfHeight = lptm->tmInternalLeading - lptm->tmHeight;
6722 else
6723 lplf->elfLogFont.lfHeight = -lplf->elfLogFont.lfHeight;
6724 }
4587b026 6725
767b1ff0
JR		 6726 if (!NILP (*(lpef->pattern)))
6727 {
6728 charset = xlfd_charset_of_font (XSTRING(*(lpef->pattern))->data);
6729
6730 /* Ensure that charset is valid for this font. */
6731 if (charset
6732 && (x_to_w32_charset (charset) != lplf->elfLogFont.lfCharSet))
6733 charset = NULL;
6734 }
6735
6736 /* TODO: List all relevant charsets if charset not specified. */
6737 if (!w32_to_x_font (&(lplf->elfLogFont), buf, 100, charset))
66895301 6738 return 1;
ee78dc32 6739
5ca0cd71
GV		 6740 if (NILP (*(lpef->pattern))
6741 || w32_font_match (buf, XSTRING (*(lpef->pattern))->data))
ee78dc32 6742 {
4587b026 6743 *lpef->tail = Fcons (Fcons (build_string (buf), width), Qnil);
8e713be6 6744 lpef->tail = &(XCDR (*lpef->tail));
ee78dc32
GV		 6745 lpef->numFonts++;
6746 }
6747 }
6fc2811b 6748
5e905a57 6749 return 1;
ee78dc32
GV		 6750}
6751
8edb0a6f 6752static int CALLBACK
ee78dc32
GV		 6753enum_font_cb1 (lplf, lptm, FontType, lpef)
6754 ENUMLOGFONT * lplf;
6755 NEWTEXTMETRIC * lptm;
6756 int FontType;
6757 enumfont_t * lpef;
6758{
6759 return EnumFontFamilies (lpef->hdc,
6760 lplf->elfLogFont.lfFaceName,
6761 (FONTENUMPROC) enum_font_cb2,
6762 (LPARAM) lpef);
6763}
6764
6765
8edb0a6f 6766static int CALLBACK
5ca0cd71
GV		 6767enum_fontex_cb2 (lplf, lptm, font_type, lpef)
6768 ENUMLOGFONTEX * lplf;
6769 NEWTEXTMETRICEX * lptm;
6770 int font_type;
6771 enumfont_t * lpef;
6772{
6773 /* We are not interested in the extra info we get back from the 'Ex
6774 version - only the fact that we get character set variations
6775 enumerated seperately. */
6776 return enum_font_cb2 ((ENUMLOGFONT *) lplf, (NEWTEXTMETRIC *) lptm,
6777 font_type, lpef);
6778}
6779
8edb0a6f 6780static int CALLBACK
5ca0cd71
GV		 6781enum_fontex_cb1 (lplf, lptm, font_type, lpef)
6782 ENUMLOGFONTEX * lplf;
6783 NEWTEXTMETRICEX * lptm;
6784 int font_type;
6785 enumfont_t * lpef;
6786{
6787 HMODULE gdi32 = GetModuleHandle ("gdi32.dll");
6788 FARPROC enum_font_families_ex
6789 = GetProcAddress ( gdi32, "EnumFontFamiliesExA");
6790 /* We don't really expect EnumFontFamiliesEx to disappear once we
6791 get here, so don't bother handling it gracefully. */
6792 if (enum_font_families_ex == NULL)
6793 error ("gdi32.dll has disappeared!");
6794 return enum_font_families_ex (lpef->hdc,
6795 &lplf->elfLogFont,
6796 (FONTENUMPROC) enum_fontex_cb2,
6797 (LPARAM) lpef, 0);
6798}
6799
4587b026
GV		 6800/* Interface to fontset handler. (adapted from mw32font.c in Meadow
6801 and xterm.c in Emacs 20.3) */
6802
8edb0a6f 6803static Lisp_Object w32_list_bdf_fonts (Lisp_Object pattern, int max_names)
33d52f9c
GV		 6804{
6805 char *fontname, *ptnstr;
6806 Lisp_Object list, tem, newlist = Qnil;
55dcfc15 6807 int n_fonts = 0;
33d52f9c
GV		 6808
6809 list = Vw32_bdf_filename_alist;
6810 ptnstr = XSTRING (pattern)->data;
6811
8e713be6 6812 for ( ; CONSP (list); list = XCDR (list))
33d52f9c 6813 {
8e713be6 6814 tem = XCAR (list);
33d52f9c 6815 if (CONSP (tem))
8e713be6 6816 fontname = XSTRING (XCAR (tem))->data;
33d52f9c
GV		 6817 else if (STRINGP (tem))
6818 fontname = XSTRING (tem)->data;
6819 else
6820 continue;
6821
6822 if (w32_font_match (fontname, ptnstr))
5ca0cd71 6823 {
8e713be6 6824 newlist = Fcons (XCAR (tem), newlist);
5ca0cd71
GV		 6825 n_fonts++;
6826 if (n_fonts >= max_names)
6827 break;
6828 }
33d52f9c
GV		 6829 }
6830
6831 return newlist;
6832}
6833
8edb0a6f
JR		 6834static Lisp_Object w32_list_synthesized_fonts (FRAME_PTR f,
6835 Lisp_Object pattern,
6836 int size, int max_names);
5ca0cd71 6837
4587b026
GV		 6838/* Return a list of names of available fonts matching PATTERN on frame
6839 F. If SIZE is not 0, it is the size (maximum bound width) of fonts
6840 to be listed. Frame F NULL means we have not yet created any
6841 frame, which means we can't get proper size info, as we don't have
6842 a device context to use for GetTextMetrics.
6843 MAXNAMES sets a limit on how many fonts to match. */
6844
6845Lisp_Object
dc220243
JR		 6846w32_list_fonts (f, pattern, size, maxnames)
6847 struct frame *f;
6848 Lisp_Object pattern;
6849 int size;
6850 int maxnames;
4587b026 6851{
6fc2811b 6852 Lisp_Object patterns, key = Qnil, tem, tpat;
4587b026 6853 Lisp_Object list = Qnil, newlist = Qnil, second_best = Qnil;
33d52f9c 6854 struct w32_display_info *dpyinfo = &one_w32_display_info;
5ca0cd71 6855 int n_fonts = 0;
396594fe 6856
4587b026
GV		 6857 patterns = Fassoc (pattern, Valternate_fontname_alist);
6858 if (NILP (patterns))
6859 patterns = Fcons (pattern, Qnil);
6860
8e713be6 6861 for (; CONSP (patterns); patterns = XCDR (patterns))
4587b026
GV		 6862 {
6863 enumfont_t ef;
767b1ff0 6864 int codepage;
4587b026 6865
8e713be6 6866 tpat = XCAR (patterns);
4587b026 6867
767b1ff0
JR		 6868 if (!STRINGP (tpat))
6869 continue;
6870
6871 /* Avoid expensive EnumFontFamilies functions if we are not
6872 going to be able to output one of these anyway. */
6873 codepage = w32_codepage_for_font (XSTRING (tpat)->data);
6874 if (codepage != CP_8BIT && codepage != CP_UNICODE
ceb12877
AI		 6875 && codepage != CP_DEFAULT && codepage != CP_UNKNOWN
6876 && !IsValidCodePage(codepage))
767b1ff0
JR		 6877 continue;
6878
4587b026
GV		 6879 /* See if we cached the result for this particular query.
6880 The cache is an alist of the form:
6881 ((PATTERN (FONTNAME . WIDTH) ...) ...)
6882 */
8e713be6 6883 if (tem = XCDR (dpyinfo->name_list_element),
33d52f9c 6884 !NILP (list = Fassoc (tpat, tem)))
4587b026
GV		 6885 {
6886 list = Fcdr_safe (list);
6887 /* We have a cached list. Don't have to get the list again. */
6888 goto label_cached;
6889 }
6890
6891 BLOCK_INPUT;
6892 /* At first, put PATTERN in the cache. */
6893 list = Qnil;
33d52f9c
GV		 6894 ef.pattern = &tpat;
6895 ef.tail = &list;
4587b026 6896 ef.numFonts = 0;
33d52f9c 6897
5ca0cd71
GV		 6898 /* Use EnumFontFamiliesEx where it is available, as it knows
6899 about character sets. Fall back to EnumFontFamilies for
6900 older versions of NT that don't support the 'Ex function. */
767b1ff0 6901 x_to_w32_font (XSTRING (tpat)->data, &ef.logfont);
4587b026 6902 {
5ca0cd71
GV		 6903 LOGFONT font_match_pattern;
6904 HMODULE gdi32 = GetModuleHandle ("gdi32.dll");
6905 FARPROC enum_font_families_ex
6906 = GetProcAddress ( gdi32, "EnumFontFamiliesExA");
6907
6908 /* We do our own pattern matching so we can handle wildcards. */
6909 font_match_pattern.lfFaceName[0] = 0;
6910 font_match_pattern.lfPitchAndFamily = 0;
6911 /* We can use the charset, because if it is a wildcard it will
6912 be DEFAULT_CHARSET anyway. */
6913 font_match_pattern.lfCharSet = ef.logfont.lfCharSet;
6914
33d52f9c 6915 ef.hdc = GetDC (dpyinfo->root_window);
4587b026 6916
5ca0cd71
GV		 6917 if (enum_font_families_ex)
6918 enum_font_families_ex (ef.hdc,
6919 &font_match_pattern,
6920 (FONTENUMPROC) enum_fontex_cb1,
6921 (LPARAM) &ef, 0);
6922 else
6923 EnumFontFamilies (ef.hdc, NULL, (FONTENUMPROC) enum_font_cb1,
6924 (LPARAM)&ef);
4587b026 6925
33d52f9c 6926 ReleaseDC (dpyinfo->root_window, ef.hdc);
4587b026
GV		 6927 }
6928
6929 UNBLOCK_INPUT;
6930
6931 /* Make a list of the fonts we got back.
6932 Store that in the font cache for the display. */
f3fbd155
KR		 6933 XSETCDR (dpyinfo->name_list_element,
6934 Fcons (Fcons (tpat, list),
6935 XCDR (dpyinfo->name_list_element)));
4587b026
GV		 6936
6937 label_cached:
6938 if (NILP (list)) continue; /* Try the remaining alternatives. */
6939
6940 newlist = second_best = Qnil;
6941
6942 /* Make a list of the fonts that have the right width. */
8e713be6 6943 for (; CONSP (list); list = XCDR (list))
4587b026
GV		 6944 {
6945 int found_size;
8e713be6 6946 tem = XCAR (list);
4587b026
GV		 6947
6948 if (!CONSP (tem))
6949 continue;
8e713be6 6950 if (NILP (XCAR (tem)))
4587b026
GV		 6951 continue;
6952 if (!size)
6953 {
8e713be6 6954 newlist = Fcons (XCAR (tem), newlist);
5ca0cd71
GV		 6955 n_fonts++;
6956 if (n_fonts >= maxnames)
6957 break;
6958 else
6959 continue;
4587b026 6960 }
8e713be6 6961 if (!INTEGERP (XCDR (tem)))
4587b026
GV		 6962 {
6963 /* Since we don't yet know the size of the font, we must
6964 load it and try GetTextMetrics. */
4587b026
GV		 6965 W32FontStruct thisinfo;
6966 LOGFONT lf;
6967 HDC hdc;
6968 HANDLE oldobj;
6969
8e713be6 6970 if (!x_to_w32_font (XSTRING (XCAR (tem))->data, &lf))
4587b026
GV		 6971 continue;
6972
6973 BLOCK_INPUT;
33d52f9c 6974 thisinfo.bdf = NULL;
4587b026
GV		 6975 thisinfo.hfont = CreateFontIndirect (&lf);
6976 if (thisinfo.hfont == NULL)
6977 continue;
6978
6979 hdc = GetDC (dpyinfo->root_window);
6980 oldobj = SelectObject (hdc, thisinfo.hfont);
6981 if (GetTextMetrics (hdc, &thisinfo.tm))
f3fbd155 6982 XSETCDR (tem, make_number (FONT_WIDTH (&thisinfo)));
4587b026 6983 else
f3fbd155 6984 XSETCDR (tem, make_number (0));
4587b026
GV		 6985 SelectObject (hdc, oldobj);
6986 ReleaseDC (dpyinfo->root_window, hdc);
6987 DeleteObject(thisinfo.hfont);
6988 UNBLOCK_INPUT;
6989 }
8e713be6 6990 found_size = XINT (XCDR (tem));
4587b026 6991 if (found_size == size)
5ca0cd71 6992 {
8e713be6 6993 newlist = Fcons (XCAR (tem), newlist);
5ca0cd71
GV		 6994 n_fonts++;
6995 if (n_fonts >= maxnames)
6996 break;
6997 }
4587b026
GV		 6998 /* keep track of the closest matching size in case
6999 no exact match is found. */
7000 else if (found_size > 0)
7001 {
7002 if (NILP (second_best))
7003 second_best = tem;
5ca0cd71 7004
4587b026
GV		 7005 else if (found_size < size)
7006 {
8e713be6
KR		 7007 if (XINT (XCDR (second_best)) > size
7008 || XINT (XCDR (second_best)) < found_size)
4587b026
GV		 7009 second_best = tem;
7010 }
7011 else
7012 {
8e713be6
KR		 7013 if (XINT (XCDR (second_best)) > size
7014 && XINT (XCDR (second_best)) >
4587b026
GV		 7015 found_size)
7016 second_best = tem;
7017 }
7018 }
7019 }
7020
7021 if (!NILP (newlist))
7022 break;
7023 else if (!NILP (second_best))
7024 {
8e713be6 7025 newlist = Fcons (XCAR (second_best), Qnil);
4587b026
GV		 7026 break;
7027 }
7028 }
7029
33d52f9c 7030 /* Include any bdf fonts. */
5ca0cd71 7031 if (n_fonts < maxnames)
33d52f9c
GV		 7032 {
7033 Lisp_Object combined[2];
5ca0cd71 7034 combined[0] = w32_list_bdf_fonts (pattern, maxnames - n_fonts);
33d52f9c
GV		 7035 combined[1] = newlist;
7036 newlist = Fnconc(2, combined);
7037 }
7038
5ca0cd71
GV		 7039 /* If we can't find a font that matches, check if Windows would be
7040 able to synthesize it from a different style. */
6fc2811b 7041 if (NILP (newlist) && !NILP (Vw32_enable_synthesized_fonts))
5ca0cd71
GV		 7042 newlist = w32_list_synthesized_fonts (f, pattern, size, maxnames);
7043
4587b026
GV		 7044 return newlist;
7045}
7046
8edb0a6f 7047static Lisp_Object
5ca0cd71
GV		 7048w32_list_synthesized_fonts (f, pattern, size, max_names)
7049 FRAME_PTR f;
7050 Lisp_Object pattern;
7051 int size;
7052 int max_names;
7053{
7054 int fields;
7055 char *full_pattn, *new_pattn, foundary[50], family[50], *pattn_part2;
7056 char style[20], slant;
8edb0a6f 7057 Lisp_Object matches, tem, synthed_matches = Qnil;
5ca0cd71
GV		 7058
7059 full_pattn = XSTRING (pattern)->data;
7060
8b77111c 7061 pattn_part2 = alloca (XSTRING (pattern)->size + 1);
5ca0cd71
GV		 7062 /* Allow some space for wildcard expansion. */
7063 new_pattn = alloca (XSTRING (pattern)->size + 100);
7064
7065 fields = sscanf (full_pattn, "-%49[^-]-%49[^-]-%19[^-]-%c-%s",
7066 foundary, family, style, &slant, pattn_part2);
7067 if (fields == EOF || fields < 5)
7068 return Qnil;
7069
7070 /* If the style and slant are wildcards already there is no point
7071 checking again (and we don't want to keep recursing). */
7072 if (*style == '*' && slant == '*')
7073 return Qnil;
7074
7075 sprintf (new_pattn, "-%s-%s-*-*-%s", foundary, family, pattn_part2);
7076
7077 matches = w32_list_fonts (f, build_string (new_pattn), size, max_names);
7078
8e713be6 7079 for ( ; CONSP (matches); matches = XCDR (matches))
5ca0cd71 7080 {
8e713be6 7081 tem = XCAR (matches);
5ca0cd71
GV		 7082 if (!STRINGP (tem))
7083 continue;
7084
7085 full_pattn = XSTRING (tem)->data;
7086 fields = sscanf (full_pattn, "-%49[^-]-%49[^-]-%*[^-]-%*c-%s",
7087 foundary, family, pattn_part2);
7088 if (fields == EOF || fields < 3)
7089 continue;
7090
7091 sprintf (new_pattn, "-%s-%s-%s-%c-%s", foundary, family, style,
7092 slant, pattn_part2);
7093
7094 synthed_matches = Fcons (build_string (new_pattn),
7095 synthed_matches);
7096 }
7097
7098 return synthed_matches;
7099}
7100
7101
4587b026
GV		 7102/* Return a pointer to struct font_info of font FONT_IDX of frame F. */
7103struct font_info *
7104w32_get_font_info (f, font_idx)
7105 FRAME_PTR f;
7106 int font_idx;
7107{
7108 return (FRAME_W32_FONT_TABLE (f) + font_idx);
7109}
7110
7111
7112struct font_info*
7113w32_query_font (struct frame *f, char *fontname)
7114{
7115 int i;
7116 struct font_info *pfi;
7117
7118 pfi = FRAME_W32_FONT_TABLE (f);
7119
7120 for (i = 0; i < one_w32_display_info.n_fonts ;i++, pfi++)
7121 {
7122 if (strcmp(pfi->name, fontname) == 0) return pfi;
7123 }
7124
7125 return NULL;
7126}
7127
7128/* Find a CCL program for a font specified by FONTP, and set the member
7129 `encoder' of the structure. */
7130
7131void
7132w32_find_ccl_program (fontp)
7133 struct font_info *fontp;
7134{
3545439c 7135 Lisp_Object list, elt;
4587b026 7136
8e713be6 7137 for (list = Vfont_ccl_encoder_alist; CONSP (list); list = XCDR (list))
4587b026 7138 {
8e713be6 7139 elt = XCAR (list);
4587b026 7140 if (CONSP (elt)
8e713be6
KR		 7141 && STRINGP (XCAR (elt))
7142 && (fast_c_string_match_ignore_case (XCAR (elt), fontp->name)
4587b026 7143 >= 0))
3545439c
KH		 7144 break;
7145 }
7146 if (! NILP (list))
7147 {
17eedd00
KH		 7148 struct ccl_program *ccl
7149 = (struct ccl_program *) xmalloc (sizeof (struct ccl_program));
3545439c 7150
8e713be6 7151 if (setup_ccl_program (ccl, XCDR (elt)) < 0)
3545439c
KH		 7152 xfree (ccl);
7153 else
7154 fontp->font_encoder = ccl;
4587b026
GV		 7155 }
7156}
7157
7158\f
8edb0a6f
JR		 7159/* Find BDF files in a specified directory. (use GCPRO when calling,
7160 as this calls lisp to get a directory listing). */
7161static Lisp_Object
7162w32_find_bdf_fonts_in_dir (Lisp_Object directory)
7163{
7164 Lisp_Object filelist, list = Qnil;
7165 char fontname[100];
7166
7167 if (!STRINGP(directory))
7168 return Qnil;
7169
7170 filelist = Fdirectory_files (directory, Qt,
7171 build_string (".*\\.[bB][dD][fF]"), Qt);
7172
7173 for ( ; CONSP(filelist); filelist = XCDR (filelist))
7174 {
7175 Lisp_Object filename = XCAR (filelist);
7176 if (w32_BDF_to_x_font (XSTRING (filename)->data, fontname, 100))
7177 store_in_alist (&list, build_string (fontname), filename);
7178 }
7179 return list;
7180}
7181
6fc2811b
JR		 7182DEFUN ("w32-find-bdf-fonts", Fw32_find_bdf_fonts, Sw32_find_bdf_fonts,
7183 1, 1, 0,
74e1aeec
JR		 7184 doc: /* Return a list of BDF fonts in DIR, suitable for appending to
7185w32-bdf-filename-alist. Fonts which do not contain an xlfd description
7186will not be included in the list. DIR may be a list of directories. */)
6fc2811b
JR		 7187 (directory)
7188 Lisp_Object directory;
7189{
7190 Lisp_Object list = Qnil;
7191 struct gcpro gcpro1, gcpro2;
ee78dc32 7192
6fc2811b
JR		 7193 if (!CONSP (directory))
7194 return w32_find_bdf_fonts_in_dir (directory);
ee78dc32 7195
6fc2811b 7196 for ( ; CONSP (directory); directory = XCDR (directory))
ee78dc32 7197 {
6fc2811b
JR		 7198 Lisp_Object pair[2];
7199 pair[0] = list;
7200 pair[1] = Qnil;
7201 GCPRO2 (directory, list);
7202 pair[1] = w32_find_bdf_fonts_in_dir( XCAR (directory) );
7203 list = Fnconc( 2, pair );
7204 UNGCPRO;
7205 }
7206 return list;
7207}
ee78dc32 7208
6fc2811b
JR		 7209\f
7210DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0,
74e1aeec 7211 doc: /* Internal function called by `color-defined-p', which see. */)
6fc2811b
JR		 7212 (color, frame)
7213 Lisp_Object color, frame;
7214{
7215 XColor foo;
7216 FRAME_PTR f = check_x_frame (frame);
ee78dc32 7217
b7826503 7218 CHECK_STRING (color);
ee78dc32 7219
6fc2811b
JR		 7220 if (w32_defined_color (f, XSTRING (color)->data, &foo, 0))
7221 return Qt;
7222 else
7223 return Qnil;
7224}
ee78dc32 7225
2d764c78 7226DEFUN ("xw-color-values", Fxw_color_values, Sxw_color_values, 1, 2, 0,
74e1aeec 7227 doc: /* Internal function called by `color-values', which see. */)
ee78dc32
GV		 7228 (color, frame)
7229 Lisp_Object color, frame;
7230{
6fc2811b 7231 XColor foo;
ee78dc32
GV		 7232 FRAME_PTR f = check_x_frame (frame);
7233
b7826503 7234 CHECK_STRING (color);
ee78dc32 7235
6fc2811b 7236 if (w32_defined_color (f, XSTRING (color)->data, &foo, 0))
ee78dc32
GV		 7237 {
7238 Lisp_Object rgb[3];
7239
6fc2811b
JR		 7240 rgb[0] = make_number ((GetRValue (foo.pixel) << 8)
7241 | GetRValue (foo.pixel));
7242 rgb[1] = make_number ((GetGValue (foo.pixel) << 8)
7243 | GetGValue (foo.pixel));
7244 rgb[2] = make_number ((GetBValue (foo.pixel) << 8)
7245 | GetBValue (foo.pixel));
ee78dc32
GV		 7246 return Flist (3, rgb);
7247 }
7248 else
7249 return Qnil;
7250}
7251
2d764c78 7252DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0,
74e1aeec 7253 doc: /* Internal function called by `display-color-p', which see. */)
ee78dc32
GV		 7254 (display)
7255 Lisp_Object display;
7256{
fbd6baed 7257 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV		 7258
7259 if ((dpyinfo->n_planes * dpyinfo->n_cbits) <= 2)
7260 return Qnil;
7261
7262 return Qt;
7263}
7264
74e1aeec
JR		 7265DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p,
7266 Sx_display_grayscale_p, 0, 1, 0,
7267 doc: /* Return t if the X display supports shades of gray.
7268Note that color displays do support shades of gray.
7269The optional argument DISPLAY specifies which display to ask about.
7270DISPLAY should be either a frame or a display name (a string).
7271If omitted or nil, that stands for the selected frame's display. */)
ee78dc32
GV		 7272 (display)
7273 Lisp_Object display;
7274{
fbd6baed 7275 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV		 7276
7277 if ((dpyinfo->n_planes * dpyinfo->n_cbits) <= 1)
7278 return Qnil;
7279
7280 return Qt;
7281}
7282
74e1aeec
JR		 7283DEFUN ("x-display-pixel-width", Fx_display_pixel_width,
7284 Sx_display_pixel_width, 0, 1, 0,
7285 doc: /* Returns the width in pixels of DISPLAY.
7286The optional argument DISPLAY specifies which display to ask about.
7287DISPLAY should be either a frame or a display name (a string).
7288If omitted or nil, that stands for the selected frame's display. */)
ee78dc32
GV		 7289 (display)
7290 Lisp_Object display;
7291{
fbd6baed 7292 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV		 7293
7294 return make_number (dpyinfo->width);
7295}
7296
7297DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
74e1aeec
JR		 7298 Sx_display_pixel_height, 0, 1, 0,
7299 doc: /* Returns the height in pixels of DISPLAY.
7300The optional argument DISPLAY specifies which display to ask about.
7301DISPLAY should be either a frame or a display name (a string).
7302If omitted or nil, that stands for the selected frame's display. */)
ee78dc32
GV		 7303 (display)
7304 Lisp_Object display;
7305{
fbd6baed 7306 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV		 7307
7308 return make_number (dpyinfo->height);
7309}
7310
7311DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
74e1aeec
JR		 7312 0, 1, 0,
7313 doc: /* Returns the number of bitplanes of DISPLAY.
7314The optional argument DISPLAY specifies which display to ask about.
7315DISPLAY should be either a frame or a display name (a string).
7316If omitted or nil, that stands for the selected frame's display. */)
ee78dc32
GV		 7317 (display)
7318 Lisp_Object display;
7319{
fbd6baed 7320 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV		 7321
7322 return make_number (dpyinfo->n_planes * dpyinfo->n_cbits);
7323}
7324
7325DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
74e1aeec
JR		 7326 0, 1, 0,
7327 doc: /* Returns the number of color cells of DISPLAY.
7328The optional argument DISPLAY specifies which display to ask about.
7329DISPLAY should be either a frame or a display name (a string).
7330If omitted or nil, that stands for the selected frame's display. */)
ee78dc32
GV		 7331 (display)
7332 Lisp_Object display;
7333{
fbd6baed 7334 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV		 7335 HDC hdc;
7336 int cap;
7337
5ac45f98
GV		 7338 hdc = GetDC (dpyinfo->root_window);
7339 if (dpyinfo->has_palette)
7340 cap = GetDeviceCaps (hdc,SIZEPALETTE);
7341 else
7342 cap = GetDeviceCaps (hdc,NUMCOLORS);
abf8c61b
AI		 7343
7344 if (cap < 0)
7345 cap = 1 << (dpyinfo->n_planes * dpyinfo->n_cbits);
ee78dc32
GV		 7346
7347 ReleaseDC (dpyinfo->root_window, hdc);
7348
7349 return make_number (cap);
7350}
7351
7352DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
7353 Sx_server_max_request_size,
74e1aeec
JR		 7354 0, 1, 0,
7355 doc: /* Returns the maximum request size of the server of DISPLAY.
7356The optional argument DISPLAY specifies which display to ask about.
7357DISPLAY should be either a frame or a display name (a string).
7358If omitted or nil, that stands for the selected frame's display. */)
ee78dc32
GV		 7359 (display)
7360 Lisp_Object display;
7361{
fbd6baed 7362 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV		 7363
7364 return make_number (1);
7365}
7366
7367DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
74e1aeec
JR		 7368 doc: /* Returns the vendor ID string of the W32 system (Microsoft).
7369The optional argument DISPLAY specifies which display to ask about.
7370DISPLAY should be either a frame or a display name (a string).
7371If omitted or nil, that stands for the selected frame's display. */)
ee78dc32
GV		 7372 (display)
7373 Lisp_Object display;
7374{
dfff8a69 7375 return build_string ("Microsoft Corp.");
ee78dc32
GV		 7376}
7377
7378DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
74e1aeec
JR		 7379 doc: /* Returns the version numbers of the server of DISPLAY.
7380The value is a list of three integers: the major and minor
7381version numbers, and the vendor-specific release
7382number. See also the function `x-server-vendor'.
7383
7384The optional argument DISPLAY specifies which display to ask about.
7385DISPLAY should be either a frame or a display name (a string).
7386If omitted or nil, that stands for the selected frame's display. */)
ee78dc32
GV		 7387 (display)
7388 Lisp_Object display;
7389{
fbd6baed 7390 return Fcons (make_number (w32_major_version),
58e0f0e4
AI		 7391 Fcons (make_number (w32_minor_version),
7392 Fcons (make_number (w32_build_number), Qnil)));
ee78dc32
GV		 7393}
7394
7395DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
74e1aeec
JR		 7396 doc: /* Returns the number of screens on the server of DISPLAY.
7397The optional argument DISPLAY specifies which display to ask about.
7398DISPLAY should be either a frame or a display name (a string).
7399If omitted or nil, that stands for the selected frame's display. */)
ee78dc32
GV		 7400 (display)
7401 Lisp_Object display;
7402{
ee78dc32
GV		 7403 return make_number (1);
7404}
7405
74e1aeec
JR		 7406DEFUN ("x-display-mm-height", Fx_display_mm_height,
7407 Sx_display_mm_height, 0, 1, 0,
7408 doc: /* Returns the height in millimeters of DISPLAY.
7409The optional argument DISPLAY specifies which display to ask about.
7410DISPLAY should be either a frame or a display name (a string).
7411If omitted or nil, that stands for the selected frame's display. */)
ee78dc32
GV		 7412 (display)
7413 Lisp_Object display;
7414{
fbd6baed 7415 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV		 7416 HDC hdc;
7417 int cap;
7418
5ac45f98 7419 hdc = GetDC (dpyinfo->root_window);
3c190163 7420
ee78dc32 7421 cap = GetDeviceCaps (hdc, VERTSIZE);
3c190163 7422
ee78dc32
GV		 7423 ReleaseDC (dpyinfo->root_window, hdc);
7424
7425 return make_number (cap);
7426}
7427
7428DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
74e1aeec
JR		 7429 doc: /* Returns the width in millimeters of DISPLAY.
7430The optional argument DISPLAY specifies which display to ask about.
7431DISPLAY should be either a frame or a display name (a string).
7432If omitted or nil, that stands for the selected frame's display. */)
ee78dc32
GV		 7433 (display)
7434 Lisp_Object display;
7435{
fbd6baed 7436 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV		 7437
7438 HDC hdc;
7439 int cap;
7440
5ac45f98 7441 hdc = GetDC (dpyinfo->root_window);
3c190163 7442
ee78dc32 7443 cap = GetDeviceCaps (hdc, HORZSIZE);
3c190163 7444
ee78dc32
GV		 7445 ReleaseDC (dpyinfo->root_window, hdc);
7446
7447 return make_number (cap);
7448}
7449
7450DEFUN ("x-display-backing-store", Fx_display_backing_store,
74e1aeec
JR		 7451 Sx_display_backing_store, 0, 1, 0,
7452 doc: /* Returns an indication of whether DISPLAY does backing store.
7453The value may be `always', `when-mapped', or `not-useful'.
7454The optional argument DISPLAY specifies which display to ask about.
7455DISPLAY should be either a frame or a display name (a string).
7456If omitted or nil, that stands for the selected frame's display. */)
ee78dc32
GV		 7457 (display)
7458 Lisp_Object display;
7459{
7460 return intern ("not-useful");
7461}
7462
7463DEFUN ("x-display-visual-class", Fx_display_visual_class,
74e1aeec
JR		 7464 Sx_display_visual_class, 0, 1, 0,
7465 doc: /* Returns the visual class of DISPLAY.
7466The value is one of the symbols `static-gray', `gray-scale',
7467`static-color', `pseudo-color', `true-color', or `direct-color'.
7468
7469The optional argument DISPLAY specifies which display to ask about.
7470DISPLAY should be either a frame or a display name (a string).
7471If omitted or nil, that stands for the selected frame's display. */)
ee78dc32
GV		 7472 (display)
7473 Lisp_Object display;
7474{
fbd6baed 7475 struct w32_display_info *dpyinfo = check_x_display_info (display);
abf8c61b 7476 Lisp_Object result = Qnil;
ee78dc32 7477
abf8c61b
AI		 7478 if (dpyinfo->has_palette)
7479 result = intern ("pseudo-color");
7480 else if (dpyinfo->n_planes * dpyinfo->n_cbits == 1)
7481 result = intern ("static-grey");
7482 else if (dpyinfo->n_planes * dpyinfo->n_cbits == 4)
7483 result = intern ("static-color");
7484 else if (dpyinfo->n_planes * dpyinfo->n_cbits > 8)
7485 result = intern ("true-color");
ee78dc32 7486
abf8c61b 7487 return result;
ee78dc32
GV		 7488}
7489
7490DEFUN ("x-display-save-under", Fx_display_save_under,
74e1aeec
JR		 7491 Sx_display_save_under, 0, 1, 0,
7492 doc: /* Returns t if DISPLAY supports the save-under feature.
7493The optional argument DISPLAY specifies which display to ask about.
7494DISPLAY should be either a frame or a display name (a string).
7495If omitted or nil, that stands for the selected frame's display. */)
ee78dc32
GV		 7496 (display)
7497 Lisp_Object display;
7498{
6fc2811b
JR		 7499 return Qnil;
7500}
7501\f
7502int
7503x_pixel_width (f)
7504 register struct frame *f;
7505{
7506 return PIXEL_WIDTH (f);
7507}
7508
7509int
7510x_pixel_height (f)
7511 register struct frame *f;
7512{
7513 return PIXEL_HEIGHT (f);
7514}
7515
7516int
7517x_char_width (f)
7518 register struct frame *f;
7519{
7520 return FONT_WIDTH (f->output_data.w32->font);
7521}
7522
7523int
7524x_char_height (f)
7525 register struct frame *f;
7526{
7527 return f->output_data.w32->line_height;
7528}
7529
7530int
7531x_screen_planes (f)
7532 register struct frame *f;
7533{
7534 return FRAME_W32_DISPLAY_INFO (f)->n_planes;
7535}
7536\f
7537/* Return the display structure for the display named NAME.
7538 Open a new connection if necessary. */
7539
7540struct w32_display_info *
7541x_display_info_for_name (name)
7542 Lisp_Object name;
7543{
7544 Lisp_Object names;
7545 struct w32_display_info *dpyinfo;
7546
b7826503 7547 CHECK_STRING (name);
6fc2811b
JR		 7548
7549 for (dpyinfo = &one_w32_display_info, names = w32_display_name_list;
7550 dpyinfo;
7551 dpyinfo = dpyinfo->next, names = XCDR (names))
7552 {
7553 Lisp_Object tem;
7554 tem = Fstring_equal (XCAR (XCAR (names)), name);
7555 if (!NILP (tem))
7556 return dpyinfo;
7557 }
7558
7559 /* Use this general default value to start with. */
7560 Vx_resource_name = Vinvocation_name;
7561
7562 validate_x_resource_name ();
7563
7564 dpyinfo = w32_term_init (name, (unsigned char *)0,
7565 (char *) XSTRING (Vx_resource_name)->data);
7566
7567 if (dpyinfo == 0)
7568 error ("Cannot connect to server %s", XSTRING (name)->data);
7569
7570 w32_in_use = 1;
7571 XSETFASTINT (Vwindow_system_version, 3);
7572
7573 return dpyinfo;
7574}
7575
7576DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
74e1aeec
JR		 7577 1, 3, 0, doc: /* Open a connection to a server.
7578DISPLAY is the name of the display to connect to.
7579Optional second arg XRM-STRING is a string of resources in xrdb format.
7580If the optional third arg MUST-SUCCEED is non-nil,
7581terminate Emacs if we can't open the connection. */)
6fc2811b
JR		 7582 (display, xrm_string, must_succeed)
7583 Lisp_Object display, xrm_string, must_succeed;
7584{
7585 unsigned char *xrm_option;
7586 struct w32_display_info *dpyinfo;
7587
74e1aeec
JR		 7588 /* If initialization has already been done, return now to avoid
7589 overwriting critical parts of one_w32_display_info. */
7590 if (w32_in_use)
7591 return Qnil;
7592
b7826503 7593 CHECK_STRING (display);
6fc2811b 7594 if (! NILP (xrm_string))
b7826503 7595 CHECK_STRING (xrm_string);
6fc2811b
JR		 7596
7597 if (! EQ (Vwindow_system, intern ("w32")))
7598 error ("Not using Microsoft Windows");
7599
7600 /* Allow color mapping to be defined externally; first look in user's
7601 HOME directory, then in Emacs etc dir for a file called rgb.txt. */
7602 {
7603 Lisp_Object color_file;
7604 struct gcpro gcpro1;
7605
7606 color_file = build_string("~/rgb.txt");
7607
7608 GCPRO1 (color_file);
7609
7610 if (NILP (Ffile_readable_p (color_file)))
7611 color_file =
7612 Fexpand_file_name (build_string ("rgb.txt"),
7613 Fsymbol_value (intern ("data-directory")));
7614
7615 Vw32_color_map = Fw32_load_color_file (color_file);
7616
7617 UNGCPRO;
7618 }
7619 if (NILP (Vw32_color_map))
7620 Vw32_color_map = Fw32_default_color_map ();
7621
7622 if (! NILP (xrm_string))
7623 xrm_option = (unsigned char *) XSTRING (xrm_string)->data;
7624 else
7625 xrm_option = (unsigned char *) 0;
7626
7627 /* Use this general default value to start with. */
7628 /* First remove .exe suffix from invocation-name - it looks ugly. */
7629 {
7630 char basename[ MAX_PATH ], *str;
7631
7632 strcpy (basename, XSTRING (Vinvocation_name)->data);
7633 str = strrchr (basename, '.');
7634 if (str) *str = 0;
7635 Vinvocation_name = build_string (basename);
7636 }
7637 Vx_resource_name = Vinvocation_name;
7638
7639 validate_x_resource_name ();
7640
7641 /* This is what opens the connection and sets x_current_display.
7642 This also initializes many symbols, such as those used for input. */
7643 dpyinfo = w32_term_init (display, xrm_option,
7644 (char *) XSTRING (Vx_resource_name)->data);
7645
7646 if (dpyinfo == 0)
7647 {
7648 if (!NILP (must_succeed))
7649 fatal ("Cannot connect to server %s.\n",
7650 XSTRING (display)->data);
7651 else
7652 error ("Cannot connect to server %s", XSTRING (display)->data);
7653 }
7654
7655 w32_in_use = 1;
7656
7657 XSETFASTINT (Vwindow_system_version, 3);
7658 return Qnil;
7659}
7660
7661DEFUN ("x-close-connection", Fx_close_connection,
7662 Sx_close_connection, 1, 1, 0,
74e1aeec
JR		 7663 doc: /* Close the connection to DISPLAY's server.
7664For DISPLAY, specify either a frame or a display name (a string).
7665If DISPLAY is nil, that stands for the selected frame's display. */)
6fc2811b
JR		 7666 (display)
7667 Lisp_Object display;
7668{
7669 struct w32_display_info *dpyinfo = check_x_display_info (display);
7670 int i;
7671
7672 if (dpyinfo->reference_count > 0)
7673 error ("Display still has frames on it");
7674
7675 BLOCK_INPUT;
7676 /* Free the fonts in the font table. */
7677 for (i = 0; i < dpyinfo->n_fonts; i++)
7678 if (dpyinfo->font_table[i].name)
7679 {
126f2e35
JR		 7680 if (dpyinfo->font_table[i].name != dpyinfo->font_table[i].full_name)
7681 xfree (dpyinfo->font_table[i].full_name);
6fc2811b 7682 xfree (dpyinfo->font_table[i].name);
6fc2811b
JR		 7683 w32_unload_font (dpyinfo, dpyinfo->font_table[i].font);
7684 }
7685 x_destroy_all_bitmaps (dpyinfo);
7686
7687 x_delete_display (dpyinfo);
7688 UNBLOCK_INPUT;
7689
7690 return Qnil;
7691}
7692
7693DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0,
74e1aeec 7694 doc: /* Return the list of display names that Emacs has connections to. */)
6fc2811b
JR		 7695 ()
7696{
7697 Lisp_Object tail, result;
7698
7699 result = Qnil;
7700 for (tail = w32_display_name_list; ! NILP (tail); tail = XCDR (tail))
7701 result = Fcons (XCAR (XCAR (tail)), result);
7702
7703 return result;
7704}
7705
7706DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize, 1, 2, 0,
74e1aeec 7707 doc: /* This is a noop on W32 systems. */)
6fc2811b
JR		 7708 (on, display)
7709 Lisp_Object display, on;
7710{
6fc2811b
JR		 7711 return Qnil;
7712}
7713
7714\f
7715\f
7716/***********************************************************************
7717 Image types
7718 ***********************************************************************/
7719
7720/* Value is the number of elements of vector VECTOR. */
7721
7722#define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
7723
7724/* List of supported image types. Use define_image_type to add new
7725 types. Use lookup_image_type to find a type for a given symbol. */
7726
7727static struct image_type *image_types;
7728
6fc2811b
JR		 7729/* The symbol `image' which is the car of the lists used to represent
7730 images in Lisp. */
7731
7732extern Lisp_Object Qimage;
7733
7734/* The symbol `xbm' which is used as the type symbol for XBM images. */
7735
7736Lisp_Object Qxbm;
7737
7738/* Keywords. */
7739
6fc2811b 7740extern Lisp_Object QCwidth, QCheight, QCforeground, QCbackground, QCfile;
dfff8a69
JR		 7741extern Lisp_Object QCdata;
7742Lisp_Object QCtype, QCascent, QCmargin, QCrelief;
a93f4566 7743Lisp_Object QCconversion, QCcolor_symbols, QCheuristic_mask;
3cf3436e 7744Lisp_Object QCindex, QCmatrix, QCcolor_adjustment, QCmask;
6fc2811b
JR		 7745
7746/* Other symbols. */
7747
3cf3436e 7748Lisp_Object Qlaplace, Qemboss, Qedge_detection, Qheuristic;
6fc2811b
JR		 7749
7750/* Time in seconds after which images should be removed from the cache
7751 if not displayed. */
7752
7753Lisp_Object Vimage_cache_eviction_delay;
7754
7755/* Function prototypes. */
7756
7757static void define_image_type P_ ((struct image_type *type));
7758static struct image_type *lookup_image_type P_ ((Lisp_Object symbol));
7759static void image_error P_ ((char *format, Lisp_Object, Lisp_Object));
7760static void x_laplace P_ ((struct frame *, struct image *));
3cf3436e 7761static void x_emboss P_ ((struct frame *, struct image *));
6fc2811b
JR		 7762static int x_build_heuristic_mask P_ ((struct frame *, struct image *,
7763 Lisp_Object));
7764
dfff8a69 7765
6fc2811b
JR		 7766/* Define a new image type from TYPE. This adds a copy of TYPE to
7767 image_types and adds the symbol *TYPE->type to Vimage_types. */
7768
7769static void
7770define_image_type (type)
7771 struct image_type *type;
7772{
7773 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
7774 The initialized data segment is read-only. */
7775 struct image_type *p = (struct image_type *) xmalloc (sizeof *p);
7776 bcopy (type, p, sizeof *p);
7777 p->next = image_types;
7778 image_types = p;
7779 Vimage_types = Fcons (*p->type, Vimage_types);
7780}
7781
7782
7783/* Look up image type SYMBOL, and return a pointer to its image_type
7784 structure. Value is null if SYMBOL is not a known image type. */
7785
7786static INLINE struct image_type *
7787lookup_image_type (symbol)
7788 Lisp_Object symbol;
7789{
7790 struct image_type *type;
7791
7792 for (type = image_types; type; type = type->next)
7793 if (EQ (symbol, *type->type))
7794 break;
7795
7796 return type;
7797}
7798
7799
7800/* Value is non-zero if OBJECT is a valid Lisp image specification. A
7801 valid image specification is a list whose car is the symbol
7802 `image', and whose rest is a property list. The property list must
7803 contain a value for key `:type'. That value must be the name of a
7804 supported image type. The rest of the property list depends on the
7805 image type. */
7806
7807int
7808valid_image_p (object)
7809 Lisp_Object object;
7810{
7811 int valid_p = 0;
7812
7813 if (CONSP (object) && EQ (XCAR (object), Qimage))
7814 {
3cf3436e
JR		 7815 Lisp_Object tem;
7816
7817 for (tem = XCDR (object); CONSP (tem); tem = XCDR (tem))
7818 if (EQ (XCAR (tem), QCtype))
7819 {
7820 tem = XCDR (tem);
7821 if (CONSP (tem) && SYMBOLP (XCAR (tem)))
7822 {
7823 struct image_type *type;
7824 type = lookup_image_type (XCAR (tem));
7825 if (type)
7826 valid_p = type->valid_p (object);
7827 }
7828
7829 break;
7830 }
6fc2811b
JR		 7831 }
7832
7833 return valid_p;
7834}
7835
7836
7837/* Log error message with format string FORMAT and argument ARG.
7838 Signaling an error, e.g. when an image cannot be loaded, is not a
7839 good idea because this would interrupt redisplay, and the error
7840 message display would lead to another redisplay. This function
7841 therefore simply displays a message. */
7842
7843static void
7844image_error (format, arg1, arg2)
7845 char *format;
7846 Lisp_Object arg1, arg2;
7847{
7848 add_to_log (format, arg1, arg2);
7849}
7850
7851
7852\f
7853/***********************************************************************
7854 Image specifications
7855 ***********************************************************************/
7856
7857enum image_value_type
7858{
7859 IMAGE_DONT_CHECK_VALUE_TYPE,
7860 IMAGE_STRING_VALUE,
3cf3436e 7861 IMAGE_STRING_OR_NIL_VALUE,
6fc2811b
JR		 7862 IMAGE_SYMBOL_VALUE,
7863 IMAGE_POSITIVE_INTEGER_VALUE,
8edb0a6f 7864 IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR,
6fc2811b 7865 IMAGE_NON_NEGATIVE_INTEGER_VALUE,
dfff8a69 7866 IMAGE_ASCENT_VALUE,
6fc2811b
JR		 7867 IMAGE_INTEGER_VALUE,
7868 IMAGE_FUNCTION_VALUE,
7869 IMAGE_NUMBER_VALUE,
7870 IMAGE_BOOL_VALUE
7871};
7872
7873/* Structure used when parsing image specifications. */
7874
7875struct image_keyword
7876{
7877 /* Name of keyword. */
7878 char *name;
7879
7880 /* The type of value allowed. */
7881 enum image_value_type type;
7882
7883 /* Non-zero means key must be present. */
7884 int mandatory_p;
7885
7886 /* Used to recognize duplicate keywords in a property list. */
7887 int count;
7888
7889 /* The value that was found. */
7890 Lisp_Object value;
7891};
7892
7893
7894static int parse_image_spec P_ ((Lisp_Object, struct image_keyword *,
7895 int, Lisp_Object));
7896static Lisp_Object image_spec_value P_ ((Lisp_Object, Lisp_Object, int *));
7897
7898
7899/* Parse image spec SPEC according to KEYWORDS. A valid image spec
7900 has the format (image KEYWORD VALUE ...). One of the keyword/
7901 value pairs must be `:type TYPE'. KEYWORDS is a vector of
7902 image_keywords structures of size NKEYWORDS describing other
7903 allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
7904
7905static int
7906parse_image_spec (spec, keywords, nkeywords, type)
7907 Lisp_Object spec;
7908 struct image_keyword *keywords;
7909 int nkeywords;
7910 Lisp_Object type;
7911{
7912 int i;
7913 Lisp_Object plist;
7914
7915 if (!CONSP (spec) || !EQ (XCAR (spec), Qimage))
7916 return 0;
7917
7918 plist = XCDR (spec);
7919 while (CONSP (plist))
7920 {
7921 Lisp_Object key, value;
7922
7923 /* First element of a pair must be a symbol. */
7924 key = XCAR (plist);
7925 plist = XCDR (plist);
7926 if (!SYMBOLP (key))
7927 return 0;
7928
7929 /* There must follow a value. */
7930 if (!CONSP (plist))
7931 return 0;
7932 value = XCAR (plist);
7933 plist = XCDR (plist);
7934
7935 /* Find key in KEYWORDS. Error if not found. */
7936 for (i = 0; i < nkeywords; ++i)
7937 if (strcmp (keywords[i].name, XSYMBOL (key)->name->data) == 0)
7938 break;
7939
7940 if (i == nkeywords)
7941 continue;
7942
7943 /* Record that we recognized the keyword. If a keywords
7944 was found more than once, it's an error. */
7945 keywords[i].value = value;
7946 ++keywords[i].count;
7947
7948 if (keywords[i].count > 1)
7949 return 0;
7950
7951 /* Check type of value against allowed type. */
7952 switch (keywords[i].type)
7953 {
7954 case IMAGE_STRING_VALUE:
7955 if (!STRINGP (value))
7956 return 0;
7957 break;
7958
3cf3436e
JR		 7959 case IMAGE_STRING_OR_NIL_VALUE:
7960 if (!STRINGP (value) && !NILP (value))
7961 return 0;
7962 break;
7963
6fc2811b
JR		 7964 case IMAGE_SYMBOL_VALUE:
7965 if (!SYMBOLP (value))
7966 return 0;
7967 break;
7968
7969 case IMAGE_POSITIVE_INTEGER_VALUE:
7970 if (!INTEGERP (value) || XINT (value) <= 0)
7971 return 0;
7972 break;
7973
8edb0a6f
JR		 7974 case IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR:
7975 if (INTEGERP (value) && XINT (value) >= 0)
7976 break;
7977 if (CONSP (value)
7978 && INTEGERP (XCAR (value)) && INTEGERP (XCDR (value))
7979 && XINT (XCAR (value)) >= 0 && XINT (XCDR (value)) >= 0)
7980 break;
7981 return 0;
7982
dfff8a69
JR		 7983 case IMAGE_ASCENT_VALUE:
7984 if (SYMBOLP (value) && EQ (value, Qcenter))
7985 break;
7986 else if (INTEGERP (value)
7987 && XINT (value) >= 0
7988 && XINT (value) <= 100)
7989 break;
7990 return 0;
7991
6fc2811b
JR		 7992 case IMAGE_NON_NEGATIVE_INTEGER_VALUE:
7993 if (!INTEGERP (value) || XINT (value) < 0)
7994 return 0;
7995 break;
7996
7997 case IMAGE_DONT_CHECK_VALUE_TYPE:
7998 break;
7999
8000 case IMAGE_FUNCTION_VALUE:
8001 value = indirect_function (value);
8002 if (SUBRP (value)
8003 || COMPILEDP (value)
8004 || (CONSP (value) && EQ (XCAR (value), Qlambda)))
8005 break;
8006 return 0;
8007
8008 case IMAGE_NUMBER_VALUE:
8009 if (!INTEGERP (value) && !FLOATP (value))
8010 return 0;
8011 break;
8012
8013 case IMAGE_INTEGER_VALUE:
8014 if (!INTEGERP (value))
8015 return 0;
8016 break;
8017
8018 case IMAGE_BOOL_VALUE:
8019 if (!NILP (value) && !EQ (value, Qt))
8020 return 0;
8021 break;
8022
8023 default:
8024 abort ();
8025 break;
8026 }
8027
8028 if (EQ (key, QCtype) && !EQ (type, value))
8029 return 0;
8030 }
8031
8032 /* Check that all mandatory fields are present. */
8033 for (i = 0; i < nkeywords; ++i)
8034 if (keywords[i].mandatory_p && keywords[i].count == 0)
8035 return 0;
8036
8037 return NILP (plist);
8038}
8039
8040
8041/* Return the value of KEY in image specification SPEC. Value is nil
8042 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
8043 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
8044
8045static Lisp_Object
8046image_spec_value (spec, key, found)
8047 Lisp_Object spec, key;
8048 int *found;
8049{
8050 Lisp_Object tail;
8051
8052 xassert (valid_image_p (spec));
8053
8054 for (tail = XCDR (spec);
8055 CONSP (tail) && CONSP (XCDR (tail));
8056 tail = XCDR (XCDR (tail)))
8057 {
8058 if (EQ (XCAR (tail), key))
8059 {
8060 if (found)
8061 *found = 1;
8062 return XCAR (XCDR (tail));
8063 }
8064 }
8065
8066 if (found)
8067 *found = 0;
8068 return Qnil;
8069}
8070
8071
8072
8073\f
8074/***********************************************************************
8075 Image type independent image structures
8076 ***********************************************************************/
8077
8078static struct image *make_image P_ ((Lisp_Object spec, unsigned hash));
8079static void free_image P_ ((struct frame *f, struct image *img));
8080
8081
8082/* Allocate and return a new image structure for image specification
8083 SPEC. SPEC has a hash value of HASH. */
8084
8085static struct image *
8086make_image (spec, hash)
8087 Lisp_Object spec;
8088 unsigned hash;
8089{
8090 struct image *img = (struct image *) xmalloc (sizeof *img);
8091
8092 xassert (valid_image_p (spec));
8093 bzero (img, sizeof *img);
8094 img->type = lookup_image_type (image_spec_value (spec, QCtype, NULL));
8095 xassert (img->type != NULL);
8096 img->spec = spec;
8097 img->data.lisp_val = Qnil;
8098 img->ascent = DEFAULT_IMAGE_ASCENT;
8099 img->hash = hash;
8100 return img;
8101}
8102
8103
8104/* Free image IMG which was used on frame F, including its resources. */
8105
8106static void
8107free_image (f, img)
8108 struct frame *f;
8109 struct image *img;
8110{
8111 if (img)
8112 {
8113 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
8114
8115 /* Remove IMG from the hash table of its cache. */
8116 if (img->prev)
8117 img->prev->next = img->next;
8118 else
8119 c->buckets[img->hash % IMAGE_CACHE_BUCKETS_SIZE] = img->next;
8120
8121 if (img->next)
8122 img->next->prev = img->prev;
8123
8124 c->images[img->id] = NULL;
8125
8126 /* Free resources, then free IMG. */
8127 img->type->free (f, img);
8128 xfree (img);
8129 }
8130}
8131
8132
8133/* Prepare image IMG for display on frame F. Must be called before
8134 drawing an image. */
8135
8136void
8137prepare_image_for_display (f, img)
8138 struct frame *f;
8139 struct image *img;
8140{
8141 EMACS_TIME t;
8142
8143 /* We're about to display IMG, so set its timestamp to `now'. */
8144 EMACS_GET_TIME (t);
8145 img->timestamp = EMACS_SECS (t);
8146
8147 /* If IMG doesn't have a pixmap yet, load it now, using the image
8148 type dependent loader function. */
8149 if (img->pixmap == 0 && !img->load_failed_p)
8150 img->load_failed_p = img->type->load (f, img) == 0;
8151}
8152
8153
dfff8a69
JR		 8154/* Value is the number of pixels for the ascent of image IMG when
8155 drawn in face FACE. */
8156
8157int
8158image_ascent (img, face)
8159 struct image *img;
8160 struct face *face;
8161{
8edb0a6f 8162 int height = img->height + img->vmargin;
dfff8a69
JR		 8163 int ascent;
8164
8165 if (img->ascent == CENTERED_IMAGE_ASCENT)
8166 {
8167 if (face->font)
8168 ascent = height / 2 - (FONT_DESCENT(face->font)
8169 - FONT_BASE(face->font)) / 2;
8170 else
8171 ascent = height / 2;
8172 }
8173 else
8174 ascent = height * img->ascent / 100.0;
8175
8176 return ascent;
8177}
8178
8179
6fc2811b
JR		 8180\f
8181/***********************************************************************
8182 Helper functions for X image types
8183 ***********************************************************************/
8184
8185static void x_clear_image P_ ((struct frame *f, struct image *img));
8186static unsigned long x_alloc_image_color P_ ((struct frame *f,
8187 struct image *img,
8188 Lisp_Object color_name,
8189 unsigned long dflt));
8190
8191/* Free X resources of image IMG which is used on frame F. */
8192
8193static void
8194x_clear_image (f, img)
8195 struct frame *f;
8196 struct image *img;
8197{
767b1ff0 8198#if 0 /* TODO: W32 image support */
6fc2811b
JR		 8199
8200 if (img->pixmap)
8201 {
8202 BLOCK_INPUT;
8203 XFreePixmap (NULL, img->pixmap);
8204 img->pixmap = 0;
8205 UNBLOCK_INPUT;
8206 }
8207
8208 if (img->ncolors)
8209 {
8210 int class = FRAME_W32_DISPLAY_INFO (f)->visual->class;
8211
8212 /* If display has an immutable color map, freeing colors is not
8213 necessary and some servers don't allow it. So don't do it. */
8214 if (class != StaticColor
8215 && class != StaticGray
8216 && class != TrueColor)
8217 {
8218 Colormap cmap;
8219 BLOCK_INPUT;
8220 cmap = DefaultColormapOfScreen (FRAME_W32_DISPLAY_INFO (f)->screen);
8221 XFreeColors (FRAME_W32_DISPLAY (f), cmap, img->colors,
8222 img->ncolors, 0);
8223 UNBLOCK_INPUT;
8224 }
8225
8226 xfree (img->colors);
8227 img->colors = NULL;
8228 img->ncolors = 0;
8229 }
8230#endif
8231}
8232
8233
8234/* Allocate color COLOR_NAME for image IMG on frame F. If color
8235 cannot be allocated, use DFLT. Add a newly allocated color to
8236 IMG->colors, so that it can be freed again. Value is the pixel
8237 color. */
8238
8239static unsigned long
8240x_alloc_image_color (f, img, color_name, dflt)
8241 struct frame *f;
8242 struct image *img;
8243 Lisp_Object color_name;
8244 unsigned long dflt;
8245{
767b1ff0 8246#if 0 /* TODO: allocing colors. */
6fc2811b
JR		 8247 XColor color;
8248 unsigned long result;
8249
8250 xassert (STRINGP (color_name));
8251
8252 if (w32_defined_color (f, XSTRING (color_name)->data, &color, 1))
8253 {
8254 /* This isn't called frequently so we get away with simply
8255 reallocating the color vector to the needed size, here. */
8256 ++img->ncolors;
8257 img->colors =
8258 (unsigned long *) xrealloc (img->colors,
8259 img->ncolors * sizeof *img->colors);
8260 img->colors[img->ncolors - 1] = color.pixel;
8261 result = color.pixel;
8262 }
8263 else
8264 result = dflt;
8265 return result;
8266#endif
8267 return 0;
8268}
8269
8270
8271\f
8272/***********************************************************************
8273 Image Cache
8274 ***********************************************************************/
8275
8276static void cache_image P_ ((struct frame *f, struct image *img));
3cf3436e 8277static void postprocess_image P_ ((struct frame *, struct image *));
6fc2811b
JR		 8278
8279
8280/* Return a new, initialized image cache that is allocated from the
8281 heap. Call free_image_cache to free an image cache. */
8282
8283struct image_cache *
8284make_image_cache ()
8285{
8286 struct image_cache *c = (struct image_cache *) xmalloc (sizeof *c);
8287 int size;
8288
8289 bzero (c, sizeof *c);
8290 c->size = 50;
8291 c->images = (struct image **) xmalloc (c->size * sizeof *c->images);
8292 size = IMAGE_CACHE_BUCKETS_SIZE * sizeof *c->buckets;
8293 c->buckets = (struct image **) xmalloc (size);
8294 bzero (c->buckets, size);
8295 return c;
8296}
8297
8298
8299/* Free image cache of frame F. Be aware that X frames share images
8300 caches. */
8301
8302void
8303free_image_cache (f)
8304 struct frame *f;
8305{
8306 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
8307 if (c)
8308 {
8309 int i;
8310
8311 /* Cache should not be referenced by any frame when freed. */
8312 xassert (c->refcount == 0);
8313
8314 for (i = 0; i < c->used; ++i)
8315 free_image (f, c->images[i]);
8316 xfree (c->images);
8317 xfree (c);
8318 xfree (c->buckets);
8319 FRAME_X_IMAGE_CACHE (f) = NULL;
8320 }
8321}
8322
8323
8324/* Clear image cache of frame F. FORCE_P non-zero means free all
8325 images. FORCE_P zero means clear only images that haven't been
8326 displayed for some time. Should be called from time to time to
dfff8a69
JR		 8327 reduce the number of loaded images. If image-eviction-seconds is
8328 non-nil, this frees images in the cache which weren't displayed for
6fc2811b
JR		 8329 at least that many seconds. */
8330
8331void
8332clear_image_cache (f, force_p)
8333 struct frame *f;
8334 int force_p;
8335{
8336 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
8337
8338 if (c && INTEGERP (Vimage_cache_eviction_delay))
8339 {
8340 EMACS_TIME t;
8341 unsigned long old;
8342 int i, any_freed_p = 0;
8343
8344 EMACS_GET_TIME (t);
8345 old = EMACS_SECS (t) - XFASTINT (Vimage_cache_eviction_delay);
8346
8347 for (i = 0; i < c->used; ++i)
8348 {
8349 struct image *img = c->images[i];
8350 if (img != NULL
8351 && (force_p
8352 || (img->timestamp > old)))
8353 {
8354 free_image (f, img);
8355 any_freed_p = 1;
8356 }
8357 }
8358
8359 /* We may be clearing the image cache because, for example,
8360 Emacs was iconified for a longer period of time. In that
8361 case, current matrices may still contain references to
8362 images freed above. So, clear these matrices. */
8363 if (any_freed_p)
8364 {
8365 clear_current_matrices (f);
8366 ++windows_or_buffers_changed;
8367 }
8368 }
8369}
8370
8371
8372DEFUN ("clear-image-cache", Fclear_image_cache, Sclear_image_cache,
8373 0, 1, 0,
74e1aeec
JR		 8374 doc: /* Clear the image cache of FRAME.
8375FRAME nil or omitted means use the selected frame.
8376FRAME t means clear the image caches of all frames. */)
6fc2811b
JR		 8377 (frame)
8378 Lisp_Object frame;
8379{
8380 if (EQ (frame, Qt))
8381 {
8382 Lisp_Object tail;
8383
8384 FOR_EACH_FRAME (tail, frame)
8385 if (FRAME_W32_P (XFRAME (frame)))
8386 clear_image_cache (XFRAME (frame), 1);
8387 }
8388 else
8389 clear_image_cache (check_x_frame (frame), 1);
8390
8391 return Qnil;
8392}
8393
8394
3cf3436e
JR		 8395/* Compute masks and transform image IMG on frame F, as specified
8396 by the image's specification, */
8397
8398static void
8399postprocess_image (f, img)
8400 struct frame *f;
8401 struct image *img;
8402{
8403#if 0 /* TODO: image support. */
8404 /* Manipulation of the image's mask. */
8405 if (img->pixmap)
8406 {
8407 Lisp_Object conversion, spec;
8408 Lisp_Object mask;
8409
8410 spec = img->spec;
8411
8412 /* `:heuristic-mask t'
8413 `:mask heuristic'
8414 means build a mask heuristically.
8415 `:heuristic-mask (R G B)'
8416 `:mask (heuristic (R G B))'
8417 means build a mask from color (R G B) in the
8418 image.
8419 `:mask nil'
8420 means remove a mask, if any. */
8421
8422 mask = image_spec_value (spec, QCheuristic_mask, NULL);
8423 if (!NILP (mask))
8424 x_build_heuristic_mask (f, img, mask);
8425 else
8426 {
8427 int found_p;
8428
8429 mask = image_spec_value (spec, QCmask, &found_p);
8430
8431 if (EQ (mask, Qheuristic))
8432 x_build_heuristic_mask (f, img, Qt);
8433 else if (CONSP (mask)
8434 && EQ (XCAR (mask), Qheuristic))
8435 {
8436 if (CONSP (XCDR (mask)))
8437 x_build_heuristic_mask (f, img, XCAR (XCDR (mask)));
8438 else
8439 x_build_heuristic_mask (f, img, XCDR (mask));
8440 }
8441 else if (NILP (mask) && found_p && img->mask)
8442 {
8443 XFreePixmap (FRAME_X_DISPLAY (f), img->mask);
8444 img->mask = NULL;
8445 }
8446 }
8447
8448
8449 /* Should we apply an image transformation algorithm? */
8450 conversion = image_spec_value (spec, QCconversion, NULL);
8451 if (EQ (conversion, Qdisabled))
8452 x_disable_image (f, img);
8453 else if (EQ (conversion, Qlaplace))
8454 x_laplace (f, img);
8455 else if (EQ (conversion, Qemboss))
8456 x_emboss (f, img);
8457 else if (CONSP (conversion)
8458 && EQ (XCAR (conversion), Qedge_detection))
8459 {
8460 Lisp_Object tem;
8461 tem = XCDR (conversion);
8462 if (CONSP (tem))
8463 x_edge_detection (f, img,
8464 Fplist_get (tem, QCmatrix),
8465 Fplist_get (tem, QCcolor_adjustment));
8466 }
8467 }
8468#endif
8469}
8470
8471
6fc2811b
JR		 8472/* Return the id of image with Lisp specification SPEC on frame F.
8473 SPEC must be a valid Lisp image specification (see valid_image_p). */
8474
8475int
8476lookup_image (f, spec)
8477 struct frame *f;
8478 Lisp_Object spec;
8479{
8480 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
8481 struct image *img;
8482 int i;
8483 unsigned hash;
8484 struct gcpro gcpro1;
8485 EMACS_TIME now;
8486
8487 /* F must be a window-system frame, and SPEC must be a valid image
8488 specification. */
8489 xassert (FRAME_WINDOW_P (f));
8490 xassert (valid_image_p (spec));
8491
8492 GCPRO1 (spec);
8493
8494 /* Look up SPEC in the hash table of the image cache. */
8495 hash = sxhash (spec, 0);
8496 i = hash % IMAGE_CACHE_BUCKETS_SIZE;
8497
8498 for (img = c->buckets[i]; img; img = img->next)
8499 if (img->hash == hash && !NILP (Fequal (img->spec, spec)))
8500 break;
8501
8502 /* If not found, create a new image and cache it. */
8503 if (img == NULL)
8504 {
3cf3436e
JR		 8505 extern Lisp_Object Qpostscript;
8506
8edb0a6f 8507 BLOCK_INPUT;
6fc2811b
JR		 8508 img = make_image (spec, hash);
8509 cache_image (f, img);
8510 img->load_failed_p = img->type->load (f, img) == 0;
6fc2811b
JR		 8511
8512 /* If we can't load the image, and we don't have a width and
8513 height, use some arbitrary width and height so that we can
8514 draw a rectangle for it. */
8515 if (img->load_failed_p)
8516 {
8517 Lisp_Object value;
8518
8519 value = image_spec_value (spec, QCwidth, NULL);
8520 img->width = (INTEGERP (value)
8521 ? XFASTINT (value) : DEFAULT_IMAGE_WIDTH);
8522 value = image_spec_value (spec, QCheight, NULL);
8523 img->height = (INTEGERP (value)
8524 ? XFASTINT (value) : DEFAULT_IMAGE_HEIGHT);
8525 }
8526 else
8527 {
8528 /* Handle image type independent image attributes
8529 `:ascent PERCENT', `:margin MARGIN', `:relief RELIEF'. */
8edb0a6f 8530 Lisp_Object ascent, margin, relief;
6fc2811b
JR		 8531
8532 ascent = image_spec_value (spec, QCascent, NULL);
8533 if (INTEGERP (ascent))
8534 img->ascent = XFASTINT (ascent);
dfff8a69
JR		 8535 else if (EQ (ascent, Qcenter))
8536 img->ascent = CENTERED_IMAGE_ASCENT;
8537
6fc2811b
JR		 8538 margin = image_spec_value (spec, QCmargin, NULL);
8539 if (INTEGERP (margin) && XINT (margin) >= 0)
8edb0a6f
JR		 8540 img->vmargin = img->hmargin = XFASTINT (margin);
8541 else if (CONSP (margin) && INTEGERP (XCAR (margin))
8542 && INTEGERP (XCDR (margin)))
8543 {
8544 if (XINT (XCAR (margin)) > 0)
8545 img->hmargin = XFASTINT (XCAR (margin));
8546 if (XINT (XCDR (margin)) > 0)
8547 img->vmargin = XFASTINT (XCDR (margin));
8548 }
6fc2811b
JR		 8549
8550 relief = image_spec_value (spec, QCrelief, NULL);
8551 if (INTEGERP (relief))
8552 {
8553 img->relief = XINT (relief);
8edb0a6f
JR		 8554 img->hmargin += abs (img->relief);
8555 img->vmargin += abs (img->relief);
6fc2811b
JR		 8556 }
8557
3cf3436e
JR		 8558 /* Do image transformations and compute masks, unless we
8559 don't have the image yet. */
8560 if (!EQ (*img->type->type, Qpostscript))
8561 postprocess_image (f, img);
6fc2811b 8562 }
3cf3436e 8563
8edb0a6f
JR		 8564 UNBLOCK_INPUT;
8565 xassert (!interrupt_input_blocked);
6fc2811b
JR		 8566 }
8567
8568 /* We're using IMG, so set its timestamp to `now'. */
8569 EMACS_GET_TIME (now);
8570 img->timestamp = EMACS_SECS (now);
8571
8572 UNGCPRO;
8573
8574 /* Value is the image id. */
8575 return img->id;
8576}
8577
8578
8579/* Cache image IMG in the image cache of frame F. */
8580
8581static void
8582cache_image (f, img)
8583 struct frame *f;
8584 struct image *img;
8585{
8586 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
8587 int i;
8588
8589 /* Find a free slot in c->images. */
8590 for (i = 0; i < c->used; ++i)
8591 if (c->images[i] == NULL)
8592 break;
8593
8594 /* If no free slot found, maybe enlarge c->images. */
8595 if (i == c->used && c->used == c->size)
8596 {
8597 c->size *= 2;
8598 c->images = (struct image **) xrealloc (c->images,
8599 c->size * sizeof *c->images);
8600 }
8601
8602 /* Add IMG to c->images, and assign IMG an id. */
8603 c->images[i] = img;
8604 img->id = i;
8605 if (i == c->used)
8606 ++c->used;
8607
8608 /* Add IMG to the cache's hash table. */
8609 i = img->hash % IMAGE_CACHE_BUCKETS_SIZE;
8610 img->next = c->buckets[i];
8611 if (img->next)
8612 img->next->prev = img;
8613 img->prev = NULL;
8614 c->buckets[i] = img;
8615}
8616
8617
8618/* Call FN on every image in the image cache of frame F. Used to mark
8619 Lisp Objects in the image cache. */
8620
8621void
8622forall_images_in_image_cache (f, fn)
8623 struct frame *f;
8624 void (*fn) P_ ((struct image *img));
8625{
8626 if (FRAME_LIVE_P (f) && FRAME_W32_P (f))
8627 {
8628 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
8629 if (c)
8630 {
8631 int i;
8632 for (i = 0; i < c->used; ++i)
8633 if (c->images[i])
8634 fn (c->images[i]);
8635 }
8636 }
8637}
8638
8639
8640\f
8641/***********************************************************************
8642 W32 support code
8643 ***********************************************************************/
8644
767b1ff0 8645#if 0 /* TODO: W32 specific image code. */
6fc2811b
JR		 8646
8647static int x_create_x_image_and_pixmap P_ ((struct frame *, int, int, int,
8648 XImage **, Pixmap *));
8649static void x_destroy_x_image P_ ((XImage *));
8650static void x_put_x_image P_ ((struct frame *, XImage *, Pixmap, int, int));
8651
8652
8653/* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
8654 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
8655 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
8656 via xmalloc. Print error messages via image_error if an error
8657 occurs. Value is non-zero if successful. */
8658
8659static int
8660x_create_x_image_and_pixmap (f, width, height, depth, ximg, pixmap)
8661 struct frame *f;
8662 int width, height, depth;
8663 XImage **ximg;
8664 Pixmap *pixmap;
8665{
767b1ff0 8666#if 0 /* TODO: Image support for W32 */
6fc2811b
JR		 8667 Display *display = FRAME_W32_DISPLAY (f);
8668 Screen *screen = FRAME_X_SCREEN (f);
8669 Window window = FRAME_W32_WINDOW (f);
8670
8671 xassert (interrupt_input_blocked);
8672
8673 if (depth <= 0)
8674 depth = DefaultDepthOfScreen (screen);
8675 *ximg = XCreateImage (display, DefaultVisualOfScreen (screen),
8676 depth, ZPixmap, 0, NULL, width, height,
8677 depth > 16 ? 32 : depth > 8 ? 16 : 8, 0);
8678 if (*ximg == NULL)
8679 {
8680 image_error ("Unable to allocate X image", Qnil, Qnil);
8681 return 0;
8682 }
8683
8684 /* Allocate image raster. */
8685 (*ximg)->data = (char *) xmalloc ((*ximg)->bytes_per_line * height);
8686
8687 /* Allocate a pixmap of the same size. */
8688 *pixmap = XCreatePixmap (display, window, width, height, depth);
8689 if (*pixmap == 0)
8690 {
8691 x_destroy_x_image (*ximg);
8692 *ximg = NULL;
8693 image_error ("Unable to create X pixmap", Qnil, Qnil);
8694 return 0;
8695 }
8696#endif
8697 return 1;
8698}
8699
8700
8701/* Destroy XImage XIMG. Free XIMG->data. */
8702
8703static void
8704x_destroy_x_image (ximg)
8705 XImage *ximg;
8706{
8707 xassert (interrupt_input_blocked);
8708 if (ximg)
8709 {
8710 xfree (ximg->data);
8711 ximg->data = NULL;
8712 XDestroyImage (ximg);
8713 }
8714}
8715
8716
8717/* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
8718 are width and height of both the image and pixmap. */
8719
8720static void
8721x_put_x_image (f, ximg, pixmap, width, height)
8722 struct frame *f;
8723 XImage *ximg;
8724 Pixmap pixmap;
8725{
8726 GC gc;
8727
8728 xassert (interrupt_input_blocked);
8729 gc = XCreateGC (NULL, pixmap, 0, NULL);
8730 XPutImage (NULL, pixmap, gc, ximg, 0, 0, 0, 0, width, height);
8731 XFreeGC (NULL, gc);
8732}
8733
8734#endif
8735
8736\f
8737/***********************************************************************
3cf3436e 8738 File Handling
6fc2811b
JR		 8739 ***********************************************************************/
8740
8741static Lisp_Object x_find_image_file P_ ((Lisp_Object));
3cf3436e
JR		 8742static char *slurp_file P_ ((char *, int *));
8743
6fc2811b
JR		 8744
8745/* Find image file FILE. Look in data-directory, then
8746 x-bitmap-file-path. Value is the full name of the file found, or
8747 nil if not found. */
8748
8749static Lisp_Object
8750x_find_image_file (file)
8751 Lisp_Object file;
8752{
8753 Lisp_Object file_found, search_path;
8754 struct gcpro gcpro1, gcpro2;
8755 int fd;
8756
8757 file_found = Qnil;
8758 search_path = Fcons (Vdata_directory, Vx_bitmap_file_path);
8759 GCPRO2 (file_found, search_path);
8760
8761 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
c0ec53ad 8762 fd = openp (search_path, file, Qnil, &file_found, 0);
6fc2811b 8763
939d6465 8764 if (fd == -1)
6fc2811b
JR		 8765 file_found = Qnil;
8766 else
8767 close (fd);
8768
8769 UNGCPRO;
8770 return file_found;
8771}
8772
8773
3cf3436e
JR		 8774/* Read FILE into memory. Value is a pointer to a buffer allocated
8775 with xmalloc holding FILE's contents. Value is null if an error
8776 occurred. *SIZE is set to the size of the file. */
8777
8778static char *
8779slurp_file (file, size)
8780 char *file;
8781 int *size;
8782{
8783 FILE *fp = NULL;
8784 char *buf = NULL;
8785 struct stat st;
8786
8787 if (stat (file, &st) == 0
8788 && (fp = fopen (file, "r")) != NULL
8789 && (buf = (char *) xmalloc (st.st_size),
8790 fread (buf, 1, st.st_size, fp) == st.st_size))
8791 {
8792 *size = st.st_size;
8793 fclose (fp);
8794 }
8795 else
8796 {
8797 if (fp)
8798 fclose (fp);
8799 if (buf)
8800 {
8801 xfree (buf);
8802 buf = NULL;
8803 }
8804 }
8805
8806 return buf;
8807}
8808
8809
6fc2811b
JR		 8810\f
8811/***********************************************************************
8812 XBM images
8813 ***********************************************************************/
8814
8815static int xbm_load P_ ((struct frame *f, struct image *img));
8816static int xbm_load_image_from_file P_ ((struct frame *f, struct image *img,
8817 Lisp_Object file));
8818static int xbm_image_p P_ ((Lisp_Object object));
8819static int xbm_read_bitmap_file_data P_ ((char *, int *, int *,
8820 unsigned char **));
8821
8822
8823/* Indices of image specification fields in xbm_format, below. */
8824
8825enum xbm_keyword_index
8826{
8827 XBM_TYPE,
8828 XBM_FILE,
8829 XBM_WIDTH,
8830 XBM_HEIGHT,
8831 XBM_DATA,
8832 XBM_FOREGROUND,
8833 XBM_BACKGROUND,
8834 XBM_ASCENT,
8835 XBM_MARGIN,
8836 XBM_RELIEF,
8837 XBM_ALGORITHM,
8838 XBM_HEURISTIC_MASK,
8839 XBM_LAST
8840};
8841
8842/* Vector of image_keyword structures describing the format
8843 of valid XBM image specifications. */
8844
8845static struct image_keyword xbm_format[XBM_LAST] =
8846{
8847 {":type", IMAGE_SYMBOL_VALUE, 1},
8848 {":file", IMAGE_STRING_VALUE, 0},
8849 {":width", IMAGE_POSITIVE_INTEGER_VALUE, 0},
8850 {":height", IMAGE_POSITIVE_INTEGER_VALUE, 0},
8851 {":data", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
3cf3436e
JR		 8852 {":foreground", IMAGE_STRING_OR_NIL_VALUE, 0},
8853 {":background", IMAGE_STRING_OR_NIL_VALUE, 0},
6fc2811b 8854 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
8edb0a6f 8855 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
6fc2811b 8856 {":relief", IMAGE_INTEGER_VALUE, 0},
a93f4566 8857 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6fc2811b
JR		 8858 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
8859};
8860
8861/* Structure describing the image type XBM. */
8862
8863static struct image_type xbm_type =
8864{
8865 &Qxbm,
8866 xbm_image_p,
8867 xbm_load,
8868 x_clear_image,
8869 NULL
8870};
8871
8872/* Tokens returned from xbm_scan. */
8873
8874enum xbm_token
8875{
8876 XBM_TK_IDENT = 256,
8877 XBM_TK_NUMBER
8878};
8879
8880
8881/* Return non-zero if OBJECT is a valid XBM-type image specification.
8882 A valid specification is a list starting with the symbol `image'
8883 The rest of the list is a property list which must contain an
8884 entry `:type xbm..
8885
8886 If the specification specifies a file to load, it must contain
8887 an entry `:file FILENAME' where FILENAME is a string.
8888
8889 If the specification is for a bitmap loaded from memory it must
8890 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
8891 WIDTH and HEIGHT are integers > 0. DATA may be:
8892
8893 1. a string large enough to hold the bitmap data, i.e. it must
8894 have a size >= (WIDTH + 7) / 8 * HEIGHT
8895
8896 2. a bool-vector of size >= WIDTH * HEIGHT
8897
8898 3. a vector of strings or bool-vectors, one for each line of the
8899 bitmap.
8900
8901 Both the file and data forms may contain the additional entries
8902 `:background COLOR' and `:foreground COLOR'. If not present,
8903 foreground and background of the frame on which the image is
8904 displayed, is used. */
8905
8906static int
8907xbm_image_p (object)
8908 Lisp_Object object;
8909{
8910 struct image_keyword kw[XBM_LAST];
8911
8912 bcopy (xbm_format, kw, sizeof kw);
8913 if (!parse_image_spec (object, kw, XBM_LAST, Qxbm))
8914 return 0;
8915
8916 xassert (EQ (kw[XBM_TYPE].value, Qxbm));
8917
8918 if (kw[XBM_FILE].count)
8919 {
8920 if (kw[XBM_WIDTH].count || kw[XBM_HEIGHT].count || kw[XBM_DATA].count)
8921 return 0;
8922 }
8923 else
8924 {
8925 Lisp_Object data;
8926 int width, height;
8927
8928 /* Entries for `:width', `:height' and `:data' must be present. */
8929 if (!kw[XBM_WIDTH].count
8930 || !kw[XBM_HEIGHT].count
8931 || !kw[XBM_DATA].count)
8932 return 0;
8933
8934 data = kw[XBM_DATA].value;
8935 width = XFASTINT (kw[XBM_WIDTH].value);
8936 height = XFASTINT (kw[XBM_HEIGHT].value);
8937
8938 /* Check type of data, and width and height against contents of
8939 data. */
8940 if (VECTORP (data))
8941 {
8942 int i;
8943
8944 /* Number of elements of the vector must be >= height. */
8945 if (XVECTOR (data)->size < height)
8946 return 0;
8947
8948 /* Each string or bool-vector in data must be large enough
8949 for one line of the image. */
8950 for (i = 0; i < height; ++i)
8951 {
8952 Lisp_Object elt = XVECTOR (data)->contents[i];
8953
8954 if (STRINGP (elt))
8955 {
8956 if (XSTRING (elt)->size
8957 < (width + BITS_PER_CHAR - 1) / BITS_PER_CHAR)
8958 return 0;
8959 }
8960 else if (BOOL_VECTOR_P (elt))
8961 {
8962 if (XBOOL_VECTOR (elt)->size < width)
8963 return 0;
8964 }
8965 else
8966 return 0;
8967 }
8968 }
8969 else if (STRINGP (data))
8970 {
8971 if (XSTRING (data)->size
8972 < (width + BITS_PER_CHAR - 1) / BITS_PER_CHAR * height)
8973 return 0;
8974 }
8975 else if (BOOL_VECTOR_P (data))
8976 {
8977 if (XBOOL_VECTOR (data)->size < width * height)
8978 return 0;
8979 }
8980 else
8981 return 0;
8982 }
8983
8984 /* Baseline must be a value between 0 and 100 (a percentage). */
8985 if (kw[XBM_ASCENT].count
8986 && XFASTINT (kw[XBM_ASCENT].value) > 100)
8987 return 0;
8988
8989 return 1;
8990}
8991
8992
8993/* Scan a bitmap file. FP is the stream to read from. Value is
8994 either an enumerator from enum xbm_token, or a character for a
8995 single-character token, or 0 at end of file. If scanning an
8996 identifier, store the lexeme of the identifier in SVAL. If
8997 scanning a number, store its value in *IVAL. */
8998
8999static int
3cf3436e
JR		 9000xbm_scan (s, end, sval, ival)
9001 char **s, *end;
6fc2811b
JR		 9002 char *sval;
9003 int *ival;
9004{
9005 int c;
3cf3436e
JR		 9006
9007 loop:
9008
6fc2811b 9009 /* Skip white space. */
3cf3436e 9010 while (*s < end &&(c = *(*s)++, isspace (c)))
6fc2811b
JR		 9011 ;
9012
3cf3436e 9013 if (*s >= end)
6fc2811b
JR		 9014 c = 0;
9015 else if (isdigit (c))
9016 {
9017 int value = 0, digit;
9018
3cf3436e 9019 if (c == '0' && *s < end)
6fc2811b 9020 {
3cf3436e 9021 c = *(*s)++;
6fc2811b
JR		 9022 if (c == 'x' || c == 'X')
9023 {
3cf3436e 9024 while (*s < end)
6fc2811b 9025 {
3cf3436e 9026 c = *(*s)++;
6fc2811b
JR		 9027 if (isdigit (c))
9028 digit = c - '0';
9029 else if (c >= 'a' && c <= 'f')
9030 digit = c - 'a' + 10;
9031 else if (c >= 'A' && c <= 'F')
9032 digit = c - 'A' + 10;
9033 else
9034 break;
9035 value = 16 * value + digit;
9036 }
9037 }
9038 else if (isdigit (c))
9039 {
9040 value = c - '0';
3cf3436e
JR		 9041 while (*s < end
9042 && (c = *(*s)++, isdigit (c)))
6fc2811b
JR		 9043 value = 8 * value + c - '0';
9044 }
9045 }
9046 else
9047 {
9048 value = c - '0';
3cf3436e
JR		 9049 while (*s < end
9050 && (c = *(*s)++, isdigit (c)))
6fc2811b
JR		 9051 value = 10 * value + c - '0';
9052 }
9053
3cf3436e
JR		 9054 if (*s < end)
9055 *s = *s - 1;
6fc2811b
JR		 9056 *ival = value;
9057 c = XBM_TK_NUMBER;
9058 }
9059 else if (isalpha (c) || c == '_')
9060 {
9061 *sval++ = c;
3cf3436e
JR		 9062 while (*s < end
9063 && (c = *(*s)++, (isalnum (c) || c == '_')))
6fc2811b
JR		 9064 *sval++ = c;
9065 *sval = 0;
3cf3436e
JR		 9066 if (*s < end)
9067 *s = *s - 1;
6fc2811b
JR		 9068 c = XBM_TK_IDENT;
9069 }
3cf3436e
JR		 9070 else if (c == '/' && **s == '*')
9071 {
9072 /* C-style comment. */
9073 ++*s;
9074 while (**s && (**s != '*' || *(*s + 1) != '/'))
9075 ++*s;
9076 if (**s)
9077 {
9078 *s += 2;
9079 goto loop;
9080 }
9081 }
6fc2811b
JR		 9082
9083 return c;
9084}
9085
9086
9087/* Replacement for XReadBitmapFileData which isn't available under old
3cf3436e
JR		 9088 X versions. CONTENTS is a pointer to a buffer to parse; END is the
9089 buffer's end. Set *WIDTH and *HEIGHT to the width and height of
9090 the image. Return in *DATA the bitmap data allocated with xmalloc.
9091 Value is non-zero if successful. DATA null means just test if
9092 CONTENTS looks like an in-memory XBM file. */
6fc2811b
JR		 9093
9094static int
3cf3436e
JR		 9095xbm_read_bitmap_data (contents, end, width, height, data)
9096 char *contents, *end;
6fc2811b
JR		 9097 int *width, *height;
9098 unsigned char **data;
9099{
3cf3436e 9100 char *s = contents;
6fc2811b
JR		 9101 char buffer[BUFSIZ];
9102 int padding_p = 0;
9103 int v10 = 0;
9104 int bytes_per_line, i, nbytes;
9105 unsigned char *p;
9106 int value;
9107 int LA1;
9108
9109#define match() \
3cf3436e 9110 LA1 = xbm_scan (contents, end, buffer, &value)
6fc2811b
JR		 9111
9112#define expect(TOKEN) \
9113 if (LA1 != (TOKEN)) \
9114 goto failure; \
9115 else \
9116 match ()
9117
9118#define expect_ident(IDENT) \
9119 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
9120 match (); \
9121 else \
9122 goto failure
9123
6fc2811b 9124 *width = *height = -1;
3cf3436e
JR		 9125 if (data)
9126 *data = NULL;
9127 LA1 = xbm_scan (&s, end, buffer, &value);
6fc2811b
JR		 9128
9129 /* Parse defines for width, height and hot-spots. */
9130 while (LA1 == '#')
9131 {
9132 match ();
9133 expect_ident ("define");
9134 expect (XBM_TK_IDENT);
9135
9136 if (LA1 == XBM_TK_NUMBER);
9137 {
9138 char *p = strrchr (buffer, '_');
9139 p = p ? p + 1 : buffer;
9140 if (strcmp (p, "width") == 0)
9141 *width = value;
9142 else if (strcmp (p, "height") == 0)
9143 *height = value;
9144 }
9145 expect (XBM_TK_NUMBER);
9146 }
9147
9148 if (*width < 0 || *height < 0)
9149 goto failure;
3cf3436e
JR		 9150 else if (data == NULL)
9151 goto success;
6fc2811b
JR		 9152
9153 /* Parse bits. Must start with `static'. */
9154 expect_ident ("static");
9155 if (LA1 == XBM_TK_IDENT)
9156 {
9157 if (strcmp (buffer, "unsigned") == 0)
9158 {
9159 match ();
9160 expect_ident ("char");
9161 }
9162 else if (strcmp (buffer, "short") == 0)
9163 {
9164 match ();
9165 v10 = 1;
9166 if (*width % 16 && *width % 16 < 9)
9167 padding_p = 1;
9168 }
9169 else if (strcmp (buffer, "char") == 0)
9170 match ();
9171 else
9172 goto failure;
9173 }
9174 else
9175 goto failure;
9176
9177 expect (XBM_TK_IDENT);
9178 expect ('[');
9179 expect (']');
9180 expect ('=');
9181 expect ('{');
9182
9183 bytes_per_line = (*width + 7) / 8 + padding_p;
9184 nbytes = bytes_per_line * *height;
9185 p = *data = (char *) xmalloc (nbytes);
9186
9187 if (v10)
9188 {
9189
9190 for (i = 0; i < nbytes; i += 2)
9191 {
9192 int val = value;
9193 expect (XBM_TK_NUMBER);
9194
9195 *p++ = val;
9196 if (!padding_p || ((i + 2) % bytes_per_line))
9197 *p++ = value >> 8;
9198
9199 if (LA1 == ',' || LA1 == '}')
9200 match ();
9201 else
9202 goto failure;
9203 }
9204 }
9205 else
9206 {
9207 for (i = 0; i < nbytes; ++i)
9208 {
9209 int val = value;
9210 expect (XBM_TK_NUMBER);
9211
9212 *p++ = val;
9213
9214 if (LA1 == ',' || LA1 == '}')
9215 match ();
9216 else
9217 goto failure;
9218 }
9219 }
9220
3cf3436e 9221 success:
6fc2811b
JR		 9222 return 1;
9223
9224 failure:
3cf3436e
JR		 9225
9226 if (data && *data)
6fc2811b
JR		 9227 {
9228 xfree (*data);
9229 *data = NULL;
9230 }
9231 return 0;
9232
9233#undef match
9234#undef expect
9235#undef expect_ident
9236}
9237
9238
3cf3436e
JR		 9239/* Load XBM image IMG which will be displayed on frame F from buffer
9240 CONTENTS. END is the end of the buffer. Value is non-zero if
9241 successful. */
6fc2811b
JR		 9242
9243static int
3cf3436e 9244xbm_load_image (f, img, contents, end)
6fc2811b
JR		 9245 struct frame *f;
9246 struct image *img;
3cf3436e 9247 char *contents, *end;
6fc2811b
JR		 9248{
9249 int rc;
9250 unsigned char *data;
9251 int success_p = 0;
6fc2811b 9252
3cf3436e 9253 rc = xbm_read_bitmap_data (contents, end, &img->width, &img->height, &data);
6fc2811b
JR		 9254 if (rc)
9255 {
9256 int depth = one_w32_display_info.n_cbits;
9257 unsigned long foreground = FRAME_FOREGROUND_PIXEL (f);
9258 unsigned long background = FRAME_BACKGROUND_PIXEL (f);
9259 Lisp_Object value;
9260
9261 xassert (img->width > 0 && img->height > 0);
9262
9263 /* Get foreground and background colors, maybe allocate colors. */
9264 value = image_spec_value (img->spec, QCforeground, NULL);
9265 if (!NILP (value))
9266 foreground = x_alloc_image_color (f, img, value, foreground);
9267
9268 value = image_spec_value (img->spec, QCbackground, NULL);
9269 if (!NILP (value))
9270 background = x_alloc_image_color (f, img, value, background);
9271
767b1ff0 9272#if 0 /* TODO : Port image display to W32 */
6fc2811b
JR		 9273 img->pixmap
9274 = XCreatePixmapFromBitmapData (FRAME_W32_DISPLAY (f),
9275 FRAME_W32_WINDOW (f),
9276 data,
9277 img->width, img->height,
9278 foreground, background,
9279 depth);
9280 xfree (data);
9281
9282 if (img->pixmap == 0)
9283 {
9284 x_clear_image (f, img);
3cf3436e 9285 image_error ("Unable to create X pixmap for `%s'", img->spec, Qnil);
6fc2811b
JR		 9286 }
9287 else
9288 success_p = 1;
6fc2811b
JR		 9289#endif
9290 }
9291 else
9292 image_error ("Error loading XBM image `%s'", img->spec, Qnil);
9293
6fc2811b
JR		 9294 return success_p;
9295}
9296
9297
3cf3436e
JR		 9298/* Value is non-zero if DATA looks like an in-memory XBM file. */
9299
9300static int
9301xbm_file_p (data)
9302 Lisp_Object data;
9303{
9304 int w, h;
9305 return (STRINGP (data)
9306 && xbm_read_bitmap_data (XSTRING (data)->data,
9307 (XSTRING (data)->data
9308 + STRING_BYTES (XSTRING (data))),
9309 &w, &h, NULL));
9310}
9311
9312
6fc2811b
JR		 9313/* Fill image IMG which is used on frame F with pixmap data. Value is
9314 non-zero if successful. */
9315
9316static int
9317xbm_load (f, img)
9318 struct frame *f;
9319 struct image *img;
9320{
9321 int success_p = 0;
9322 Lisp_Object file_name;
9323
9324 xassert (xbm_image_p (img->spec));
9325
9326 /* If IMG->spec specifies a file name, create a non-file spec from it. */
9327 file_name = image_spec_value (img->spec, QCfile, NULL);
9328 if (STRINGP (file_name))
3cf3436e
JR		 9329 {
9330 Lisp_Object file;
9331 char *contents;
9332 int size;
9333 struct gcpro gcpro1;
9334
9335 file = x_find_image_file (file_name);
9336 GCPRO1 (file);
9337 if (!STRINGP (file))
9338 {
9339 image_error ("Cannot find image file `%s'", file_name, Qnil);
9340 UNGCPRO;
9341 return 0;
9342 }
9343
9344 contents = slurp_file (XSTRING (file)->data, &size);
9345 if (contents == NULL)
9346 {
9347 image_error ("Error loading XBM image `%s'", img->spec, Qnil);
9348 UNGCPRO;
9349 return 0;
9350 }
9351
9352 success_p = xbm_load_image (f, img, contents, contents + size);
9353 UNGCPRO;
9354 }
6fc2811b
JR		 9355 else
9356 {
9357 struct image_keyword fmt[XBM_LAST];
9358 Lisp_Object data;
9359 int depth;
9360 unsigned long foreground = FRAME_FOREGROUND_PIXEL (f);
9361 unsigned long background = FRAME_BACKGROUND_PIXEL (f);
9362 char *bits;
9363 int parsed_p;
3cf3436e
JR		 9364 int in_memory_file_p = 0;
9365
9366 /* See if data looks like an in-memory XBM file. */
9367 data = image_spec_value (img->spec, QCdata, NULL);
9368 in_memory_file_p = xbm_file_p (data);
6fc2811b
JR		 9369
9370 /* Parse the list specification. */
9371 bcopy (xbm_format, fmt, sizeof fmt);
9372 parsed_p = parse_image_spec (img->spec, fmt, XBM_LAST, Qxbm);
9373 xassert (parsed_p);
9374
9375 /* Get specified width, and height. */
3cf3436e
JR		 9376 if (!in_memory_file_p)
9377 {
9378 img->width = XFASTINT (fmt[XBM_WIDTH].value);
9379 img->height = XFASTINT (fmt[XBM_HEIGHT].value);
9380 xassert (img->width > 0 && img->height > 0);
9381 }
6fc2811b 9382 /* Get foreground and background colors, maybe allocate colors. */
3cf3436e
JR		 9383 if (fmt[XBM_FOREGROUND].count
9384 && STRINGP (fmt[XBM_FOREGROUND].value))
6fc2811b
JR		 9385 foreground = x_alloc_image_color (f, img, fmt[XBM_FOREGROUND].value,
9386 foreground);
3cf3436e
JR		 9387 if (fmt[XBM_BACKGROUND].count
9388 && STRINGP (fmt[XBM_BACKGROUND].value))
6fc2811b
JR		 9389 background = x_alloc_image_color (f, img, fmt[XBM_BACKGROUND].value,
9390 background);
9391
3cf3436e
JR		 9392 if (in_memory_file_p)
9393 success_p = xbm_load_image (f, img, XSTRING (data)->data,
9394 (XSTRING (data)->data
9395 + STRING_BYTES (XSTRING (data))));
9396 else
6fc2811b 9397 {
3cf3436e
JR		 9398 if (VECTORP (data))
9399 {
9400 int i;
9401 char *p;
9402 int nbytes = (img->width + BITS_PER_CHAR - 1) / BITS_PER_CHAR;
6fc2811b 9403
3cf3436e
JR		 9404 p = bits = (char *) alloca (nbytes * img->height);
9405 for (i = 0; i < img->height; ++i, p += nbytes)
9406 {
9407 Lisp_Object line = XVECTOR (data)->contents[i];
9408 if (STRINGP (line))
9409 bcopy (XSTRING (line)->data, p, nbytes);
9410 else
9411 bcopy (XBOOL_VECTOR (line)->data, p, nbytes);
9412 }
9413 }
9414 else if (STRINGP (data))
9415 bits = XSTRING (data)->data;
9416 else
9417 bits = XBOOL_VECTOR (data)->data;
9418#ifdef TODO /* image support. */
9419 /* Create the pixmap. */
9420 depth = DefaultDepthOfScreen (FRAME_X_SCREEN (f));
9421 img->pixmap
9422 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f),
9423 FRAME_X_WINDOW (f),
9424 bits,
9425 img->width, img->height,
9426 foreground, background,
9427 depth);
9428#endif
9429 if (img->pixmap)
9430 success_p = 1;
9431 else
6fc2811b 9432 {
3cf3436e
JR		 9433 image_error ("Unable to create pixmap for XBM image `%s'",
9434 img->spec, Qnil);
9435 x_clear_image (f, img);
6fc2811b
JR		 9436 }
9437 }
6fc2811b
JR		 9438 }
9439
9440 return success_p;
9441}
9442
9443
9444\f
9445/***********************************************************************
9446 XPM images
9447 ***********************************************************************/
9448
9449#if HAVE_XPM
9450
9451static int xpm_image_p P_ ((Lisp_Object object));
9452static int xpm_load P_ ((struct frame *f, struct image *img));
9453static int xpm_valid_color_symbols_p P_ ((Lisp_Object));
9454
9455#include "X11/xpm.h"
9456
9457/* The symbol `xpm' identifying XPM-format images. */
9458
9459Lisp_Object Qxpm;
9460
9461/* Indices of image specification fields in xpm_format, below. */
9462
9463enum xpm_keyword_index
9464{
9465 XPM_TYPE,
9466 XPM_FILE,
9467 XPM_DATA,
9468 XPM_ASCENT,
9469 XPM_MARGIN,
9470 XPM_RELIEF,
9471 XPM_ALGORITHM,
9472 XPM_HEURISTIC_MASK,
9473 XPM_COLOR_SYMBOLS,
9474 XPM_LAST
9475};
9476
9477/* Vector of image_keyword structures describing the format
9478 of valid XPM image specifications. */
9479
9480static struct image_keyword xpm_format[XPM_LAST] =
9481{
9482 {":type", IMAGE_SYMBOL_VALUE, 1},
9483 {":file", IMAGE_STRING_VALUE, 0},
9484 {":data", IMAGE_STRING_VALUE, 0},
9485 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
8edb0a6f 9486 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
6fc2811b 9487 {":relief", IMAGE_INTEGER_VALUE, 0},
a93f4566 9488 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6fc2811b
JR		 9489 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
9490 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
9491};
9492
9493/* Structure describing the image type XBM. */
9494
9495static struct image_type xpm_type =
9496{
9497 &Qxpm,
9498 xpm_image_p,
9499 xpm_load,
9500 x_clear_image,
9501 NULL
9502};
9503
9504
9505/* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
9506 for XPM images. Such a list must consist of conses whose car and
9507 cdr are strings. */
9508
9509static int
9510xpm_valid_color_symbols_p (color_symbols)
9511 Lisp_Object color_symbols;
9512{
9513 while (CONSP (color_symbols))
9514 {
9515 Lisp_Object sym = XCAR (color_symbols);
9516 if (!CONSP (sym)
9517 || !STRINGP (XCAR (sym))
9518 || !STRINGP (XCDR (sym)))
9519 break;
9520 color_symbols = XCDR (color_symbols);
9521 }
9522
9523 return NILP (color_symbols);
9524}
9525
9526
9527/* Value is non-zero if OBJECT is a valid XPM image specification. */
9528
9529static int
9530xpm_image_p (object)
9531 Lisp_Object object;
9532{
9533 struct image_keyword fmt[XPM_LAST];
9534 bcopy (xpm_format, fmt, sizeof fmt);
9535 return (parse_image_spec (object, fmt, XPM_LAST, Qxpm)
9536 /* Either `:file' or `:data' must be present. */
9537 && fmt[XPM_FILE].count + fmt[XPM_DATA].count == 1
9538 /* Either no `:color-symbols' or it's a list of conses
9539 whose car and cdr are strings. */
9540 && (fmt[XPM_COLOR_SYMBOLS].count == 0
9541 || xpm_valid_color_symbols_p (fmt[XPM_COLOR_SYMBOLS].value))
9542 && (fmt[XPM_ASCENT].count == 0
9543 || XFASTINT (fmt[XPM_ASCENT].value) < 100));
9544}
9545
9546
9547/* Load image IMG which will be displayed on frame F. Value is
9548 non-zero if successful. */
9549
9550static int
9551xpm_load (f, img)
9552 struct frame *f;
9553 struct image *img;
9554{
9555 int rc, i;
9556 XpmAttributes attrs;
9557 Lisp_Object specified_file, color_symbols;
9558
9559 /* Configure the XPM lib. Use the visual of frame F. Allocate
9560 close colors. Return colors allocated. */
9561 bzero (&attrs, sizeof attrs);
dfff8a69
JR		 9562 attrs.visual = FRAME_X_VISUAL (f);
9563 attrs.colormap = FRAME_X_COLORMAP (f);
6fc2811b 9564 attrs.valuemask |= XpmVisual;
dfff8a69 9565 attrs.valuemask |= XpmColormap;
6fc2811b 9566 attrs.valuemask |= XpmReturnAllocPixels;
dfff8a69 9567#ifdef XpmAllocCloseColors
6fc2811b
JR		 9568 attrs.alloc_close_colors = 1;
9569 attrs.valuemask |= XpmAllocCloseColors;
dfff8a69
JR		 9570#else
9571 attrs.closeness = 600;
9572 attrs.valuemask |= XpmCloseness;
9573#endif
6fc2811b
JR		 9574
9575 /* If image specification contains symbolic color definitions, add
9576 these to `attrs'. */
9577 color_symbols = image_spec_value (img->spec, QCcolor_symbols, NULL);
9578 if (CONSP (color_symbols))
9579 {
9580 Lisp_Object tail;
9581 XpmColorSymbol *xpm_syms;
9582 int i, size;
9583
9584 attrs.valuemask |= XpmColorSymbols;
9585
9586 /* Count number of symbols. */
9587 attrs.numsymbols = 0;
9588 for (tail = color_symbols; CONSP (tail); tail = XCDR (tail))
9589 ++attrs.numsymbols;
9590
9591 /* Allocate an XpmColorSymbol array. */
9592 size = attrs.numsymbols * sizeof *xpm_syms;
9593 xpm_syms = (XpmColorSymbol *) alloca (size);
9594 bzero (xpm_syms, size);
9595 attrs.colorsymbols = xpm_syms;
9596
9597 /* Fill the color symbol array. */
9598 for (tail = color_symbols, i = 0;
9599 CONSP (tail);
9600 ++i, tail = XCDR (tail))
9601 {
9602 Lisp_Object name = XCAR (XCAR (tail));
9603 Lisp_Object color = XCDR (XCAR (tail));
9604 xpm_syms[i].name = (char *) alloca (XSTRING (name)->size + 1);
9605 strcpy (xpm_syms[i].name, XSTRING (name)->data);
9606 xpm_syms[i].value = (char *) alloca (XSTRING (color)->size + 1);
9607 strcpy (xpm_syms[i].value, XSTRING (color)->data);
9608 }
9609 }
9610
9611 /* Create a pixmap for the image, either from a file, or from a
9612 string buffer containing data in the same format as an XPM file. */
9613 BLOCK_INPUT;
9614 specified_file = image_spec_value (img->spec, QCfile, NULL);
9615 if (STRINGP (specified_file))
9616 {
9617 Lisp_Object file = x_find_image_file (specified_file);
9618 if (!STRINGP (file))
9619 {
9620 image_error ("Cannot find image file `%s'", specified_file, Qnil);
9621 UNBLOCK_INPUT;
9622 return 0;
9623 }
9624
9625 rc = XpmReadFileToPixmap (NULL, FRAME_W32_WINDOW (f),
9626 XSTRING (file)->data, &img->pixmap, &img->mask,
9627 &attrs);
9628 }
9629 else
9630 {
9631 Lisp_Object buffer = image_spec_value (img->spec, QCdata, NULL);
9632 rc = XpmCreatePixmapFromBuffer (NULL, FRAME_W32_WINDOW (f),
9633 XSTRING (buffer)->data,
9634 &img->pixmap, &img->mask,
9635 &attrs);
9636 }
9637 UNBLOCK_INPUT;
9638
9639 if (rc == XpmSuccess)
9640 {
9641 /* Remember allocated colors. */
9642 img->ncolors = attrs.nalloc_pixels;
9643 img->colors = (unsigned long *) xmalloc (img->ncolors
9644 * sizeof *img->colors);
9645 for (i = 0; i < attrs.nalloc_pixels; ++i)
9646 img->colors[i] = attrs.alloc_pixels[i];
9647
9648 img->width = attrs.width;
9649 img->height = attrs.height;
9650 xassert (img->width > 0 && img->height > 0);
9651
9652 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
9653 BLOCK_INPUT;
9654 XpmFreeAttributes (&attrs);
9655 UNBLOCK_INPUT;
9656 }
9657 else
9658 {
9659 switch (rc)
9660 {
9661 case XpmOpenFailed:
9662 image_error ("Error opening XPM file (%s)", img->spec, Qnil);
9663 break;
9664
9665 case XpmFileInvalid:
9666 image_error ("Invalid XPM file (%s)", img->spec, Qnil);
9667 break;
9668
9669 case XpmNoMemory:
9670 image_error ("Out of memory (%s)", img->spec, Qnil);
9671 break;
9672
9673 case XpmColorFailed:
9674 image_error ("Color allocation error (%s)", img->spec, Qnil);
9675 break;
9676
9677 default:
9678 image_error ("Unknown error (%s)", img->spec, Qnil);
9679 break;
9680 }
9681 }
9682
9683 return rc == XpmSuccess;
9684}
9685
9686#endif /* HAVE_XPM != 0 */
9687
9688\f
767b1ff0 9689#if 0 /* TODO : Color tables on W32. */
6fc2811b
JR		 9690/***********************************************************************
9691 Color table
9692 ***********************************************************************/
9693
9694/* An entry in the color table mapping an RGB color to a pixel color. */
9695
9696struct ct_color
9697{
9698 int r, g, b;
9699 unsigned long pixel;
9700
9701 /* Next in color table collision list. */
9702 struct ct_color *next;
9703};
9704
9705/* The bucket vector size to use. Must be prime. */
9706
9707#define CT_SIZE 101
9708
9709/* Value is a hash of the RGB color given by R, G, and B. */
9710
9711#define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
9712
9713/* The color hash table. */
9714
9715struct ct_color **ct_table;
9716
9717/* Number of entries in the color table. */
9718
9719int ct_colors_allocated;
9720
9721/* Function prototypes. */
9722
9723static void init_color_table P_ ((void));
9724static void free_color_table P_ ((void));
9725static unsigned long *colors_in_color_table P_ ((int *n));
9726static unsigned long lookup_rgb_color P_ ((struct frame *f, int r, int g, int b));
9727static unsigned long lookup_pixel_color P_ ((struct frame *f, unsigned long p));
9728
9729
9730/* Initialize the color table. */
9731
9732static void
9733init_color_table ()
9734{
9735 int size = CT_SIZE * sizeof (*ct_table);
9736 ct_table = (struct ct_color **) xmalloc (size);
9737 bzero (ct_table, size);
9738 ct_colors_allocated = 0;
9739}
9740
9741
9742/* Free memory associated with the color table. */
9743
9744static void
9745free_color_table ()
9746{
9747 int i;
9748 struct ct_color *p, *next;
9749
9750 for (i = 0; i < CT_SIZE; ++i)
9751 for (p = ct_table[i]; p; p = next)
9752 {
9753 next = p->next;
9754 xfree (p);
9755 }
9756
9757 xfree (ct_table);
9758 ct_table = NULL;
9759}
9760
9761
9762/* Value is a pixel color for RGB color R, G, B on frame F. If an
9763 entry for that color already is in the color table, return the
9764 pixel color of that entry. Otherwise, allocate a new color for R,
9765 G, B, and make an entry in the color table. */
9766
9767static unsigned long
9768lookup_rgb_color (f, r, g, b)
9769 struct frame *f;
9770 int r, g, b;
9771{
9772 unsigned hash = CT_HASH_RGB (r, g, b);
9773 int i = hash % CT_SIZE;
9774 struct ct_color *p;
9775
9776 for (p = ct_table[i]; p; p = p->next)
9777 if (p->r == r && p->g == g && p->b == b)
9778 break;
9779
9780 if (p == NULL)
9781 {
9782 COLORREF color;
9783 Colormap cmap;
9784 int rc;
9785
9786 color = PALETTERGB (r, g, b);
9787
9788 ++ct_colors_allocated;
9789
9790 p = (struct ct_color *) xmalloc (sizeof *p);
9791 p->r = r;
9792 p->g = g;
9793 p->b = b;
9794 p->pixel = color;
9795 p->next = ct_table[i];
9796 ct_table[i] = p;
9797 }
9798
9799 return p->pixel;
9800}
9801
9802
9803/* Look up pixel color PIXEL which is used on frame F in the color
9804 table. If not already present, allocate it. Value is PIXEL. */
9805
9806static unsigned long
9807lookup_pixel_color (f, pixel)
9808 struct frame *f;
9809 unsigned long pixel;
9810{
9811 int i = pixel % CT_SIZE;
9812 struct ct_color *p;
9813
9814 for (p = ct_table[i]; p; p = p->next)
9815 if (p->pixel == pixel)
9816 break;
9817
9818 if (p == NULL)
9819 {
9820 XColor color;
9821 Colormap cmap;
9822 int rc;
9823
9824 BLOCK_INPUT;
9825
9826 cmap = DefaultColormapOfScreen (FRAME_X_SCREEN (f));
9827 color.pixel = pixel;
9828 XQueryColor (NULL, cmap, &color);
9829 rc = x_alloc_nearest_color (f, cmap, &color);
9830 UNBLOCK_INPUT;
9831
9832 if (rc)
9833 {
9834 ++ct_colors_allocated;
9835
9836 p = (struct ct_color *) xmalloc (sizeof *p);
9837 p->r = color.red;
9838 p->g = color.green;
9839 p->b = color.blue;
9840 p->pixel = pixel;
9841 p->next = ct_table[i];
9842 ct_table[i] = p;
9843 }
9844 else
9845 return FRAME_FOREGROUND_PIXEL (f);
9846 }
9847 return p->pixel;
9848}
9849
9850
9851/* Value is a vector of all pixel colors contained in the color table,
9852 allocated via xmalloc. Set *N to the number of colors. */
9853
9854static unsigned long *
9855colors_in_color_table (n)
9856 int *n;
9857{
9858 int i, j;
9859 struct ct_color *p;
9860 unsigned long *colors;
9861
9862 if (ct_colors_allocated == 0)
9863 {
9864 *n = 0;
9865 colors = NULL;
9866 }
9867 else
9868 {
9869 colors = (unsigned long *) xmalloc (ct_colors_allocated
9870 * sizeof *colors);
9871 *n = ct_colors_allocated;
9872
9873 for (i = j = 0; i < CT_SIZE; ++i)
9874 for (p = ct_table[i]; p; p = p->next)
9875 colors[j++] = p->pixel;
9876 }
9877
9878 return colors;
9879}
9880
767b1ff0 9881#endif /* TODO */
6fc2811b
JR		 9882
9883\f
9884/***********************************************************************
9885 Algorithms
9886 ***********************************************************************/
3cf3436e
JR		 9887#if 0 /* TODO: image support. */
9888static XColor *x_to_xcolors P_ ((struct frame *, struct image *, int));
9889static void x_from_xcolors P_ ((struct frame *, struct image *, XColor *));
9890static void x_detect_edges P_ ((struct frame *, struct image *, int[9], int));
9891
9892/* Non-zero means draw a cross on images having `:conversion
9893 disabled'. */
6fc2811b 9894
3cf3436e 9895int cross_disabled_images;
6fc2811b 9896
3cf3436e
JR		 9897/* Edge detection matrices for different edge-detection
9898 strategies. */
6fc2811b 9899
3cf3436e
JR		 9900static int emboss_matrix[9] = {
9901 /* x - 1 x x + 1 */
9902 2, -1, 0, /* y - 1 */
9903 -1, 0, 1, /* y */
9904 0, 1, -2 /* y + 1 */
9905};
9906
9907static int laplace_matrix[9] = {
9908 /* x - 1 x x + 1 */
9909 1, 0, 0, /* y - 1 */
9910 0, 0, 0, /* y */
9911 0, 0, -1 /* y + 1 */
9912};
9913
9914/* Value is the intensity of the color whose red/green/blue values
9915 are R, G, and B. */
9916
9917#define COLOR_INTENSITY(R, G, B) ((2 * (R) + 3 * (G) + (B)) / 6)
9918
9919
9920/* On frame F, return an array of XColor structures describing image
9921 IMG->pixmap. Each XColor structure has its pixel color set. RGB_P
9922 non-zero means also fill the red/green/blue members of the XColor
9923 structures. Value is a pointer to the array of XColors structures,
9924 allocated with xmalloc; it must be freed by the caller. */
9925
9926static XColor *
9927x_to_xcolors (f, img, rgb_p)
9928 struct frame *f;
9929 struct image *img;
9930 int rgb_p;
9931{
9932 int x, y;
9933 XColor *colors, *p;
9934 XImage *ximg;
9935
9936 colors = (XColor *) xmalloc (img->width * img->height * sizeof *colors);
9937
9938 /* Get the X image IMG->pixmap. */
9939 ximg = XGetImage (FRAME_X_DISPLAY (f), img->pixmap,
9940 0, 0, img->width, img->height, ~0, ZPixmap);
9941
9942 /* Fill the `pixel' members of the XColor array. I wished there
9943 were an easy and portable way to circumvent XGetPixel. */
9944 p = colors;
9945 for (y = 0; y < img->height; ++y)
9946 {
9947 XColor *row = p;
9948
9949 for (x = 0; x < img->width; ++x, ++p)
9950 p->pixel = XGetPixel (ximg, x, y);
9951
9952 if (rgb_p)
9953 x_query_colors (f, row, img->width);
9954 }
9955
9956 XDestroyImage (ximg);
9957 return colors;
9958}
9959
9960
9961/* Create IMG->pixmap from an array COLORS of XColor structures, whose
9962 RGB members are set. F is the frame on which this all happens.
9963 COLORS will be freed; an existing IMG->pixmap will be freed, too. */
6fc2811b
JR		 9964
9965static void
3cf3436e 9966x_from_xcolors (f, img, colors)
6fc2811b 9967 struct frame *f;
3cf3436e 9968 struct image *img;
6fc2811b 9969 XColor *colors;
6fc2811b 9970{
3cf3436e
JR		 9971 int x, y;
9972 XImage *oimg;
9973 Pixmap pixmap;
9974 XColor *p;
9975
9976 init_color_table ();
9977
9978 x_create_x_image_and_pixmap (f, img->width, img->height, 0,
9979 &oimg, &pixmap);
9980 p = colors;
9981 for (y = 0; y < img->height; ++y)
9982 for (x = 0; x < img->width; ++x, ++p)
9983 {
9984 unsigned long pixel;
9985 pixel = lookup_rgb_color (f, p->red, p->green, p->blue);
9986 XPutPixel (oimg, x, y, pixel);
9987 }
6fc2811b 9988
3cf3436e
JR		 9989 xfree (colors);
9990 x_clear_image_1 (f, img, 1, 0, 1);
6fc2811b 9991
3cf3436e
JR		 9992 x_put_x_image (f, oimg, pixmap, img->width, img->height);
9993 x_destroy_x_image (oimg);
9994 img->pixmap = pixmap;
9995 img->colors = colors_in_color_table (&img->ncolors);
9996 free_color_table ();
6fc2811b
JR		 9997}
9998
9999
3cf3436e
JR		 10000/* On frame F, perform edge-detection on image IMG.
10001
10002 MATRIX is a nine-element array specifying the transformation
10003 matrix. See emboss_matrix for an example.
10004
10005 COLOR_ADJUST is a color adjustment added to each pixel of the
10006 outgoing image. */
6fc2811b
JR		 10007
10008static void
3cf3436e 10009x_detect_edges (f, img, matrix, color_adjust)
6fc2811b 10010 struct frame *f;
3cf3436e
JR		 10011 struct image *img;
10012 int matrix[9], color_adjust;
6fc2811b 10013{
3cf3436e
JR		 10014 XColor *colors = x_to_xcolors (f, img, 1);
10015 XColor *new, *p;
10016 int x, y, i, sum;
10017
10018 for (i = sum = 0; i < 9; ++i)
10019 sum += abs (matrix[i]);
10020
10021#define COLOR(A, X, Y) ((A) + (Y) * img->width + (X))
10022
10023 new = (XColor *) xmalloc (img->width * img->height * sizeof *new);
10024
10025 for (y = 0; y < img->height; ++y)
10026 {
10027 p = COLOR (new, 0, y);
10028 p->red = p->green = p->blue = 0xffff/2;
10029 p = COLOR (new, img->width - 1, y);
10030 p->red = p->green = p->blue = 0xffff/2;
10031 }
6fc2811b 10032
3cf3436e
JR		 10033 for (x = 1; x < img->width - 1; ++x)
10034 {
10035 p = COLOR (new, x, 0);
10036 p->red = p->green = p->blue = 0xffff/2;
10037 p = COLOR (new, x, img->height - 1);
10038 p->red = p->green = p->blue = 0xffff/2;
10039 }
10040
10041 for (y = 1; y < img->height - 1; ++y)
10042 {
10043 p = COLOR (new, 1, y);
10044
10045 for (x = 1; x < img->width - 1; ++x, ++p)
10046 {
10047 int r, g, b, y1, x1;
10048
10049 r = g = b = i = 0;
10050 for (y1 = y - 1; y1 < y + 2; ++y1)
10051 for (x1 = x - 1; x1 < x + 2; ++x1, ++i)
10052 if (matrix[i])
10053 {
10054 XColor *t = COLOR (colors, x1, y1);
10055 r += matrix[i] * t->red;
10056 g += matrix[i] * t->green;
10057 b += matrix[i] * t->blue;
10058 }
10059
10060 r = (r / sum + color_adjust) & 0xffff;
10061 g = (g / sum + color_adjust) & 0xffff;
10062 b = (b / sum + color_adjust) & 0xffff;
10063 p->red = p->green = p->blue = COLOR_INTENSITY (r, g, b);
10064 }
10065 }
10066
10067 xfree (colors);
10068 x_from_xcolors (f, img, new);
10069
10070#undef COLOR
10071}
10072
10073
10074/* Perform the pre-defined `emboss' edge-detection on image IMG
10075 on frame F. */
10076
10077static void
10078x_emboss (f, img)
10079 struct frame *f;
10080 struct image *img;
10081{
10082 x_detect_edges (f, img, emboss_matrix, 0xffff / 2);
6fc2811b 10083}
3cf3436e 10084
6fc2811b
JR		 10085
10086/* Transform image IMG which is used on frame F with a Laplace
10087 edge-detection algorithm. The result is an image that can be used
10088 to draw disabled buttons, for example. */
10089
10090static void
10091x_laplace (f, img)
10092 struct frame *f;
10093 struct image *img;
10094{
3cf3436e
JR		 10095 x_detect_edges (f, img, laplace_matrix, 45000);
10096}
6fc2811b 10097
6fc2811b 10098
3cf3436e
JR		 10099/* Perform edge-detection on image IMG on frame F, with specified
10100 transformation matrix MATRIX and color-adjustment COLOR_ADJUST.
6fc2811b 10101
3cf3436e 10102 MATRIX must be either
6fc2811b 10103
3cf3436e
JR		 10104 - a list of at least 9 numbers in row-major form
10105 - a vector of at least 9 numbers
6fc2811b 10106
3cf3436e
JR		 10107 COLOR_ADJUST nil means use a default; otherwise it must be a
10108 number. */
6fc2811b 10109
3cf3436e
JR		 10110static void
10111x_edge_detection (f, img, matrix, color_adjust)
10112 struct frame *f;
10113 struct image *img;
10114 Lisp_Object matrix, color_adjust;
10115{
10116 int i = 0;
10117 int trans[9];
10118
10119 if (CONSP (matrix))
6fc2811b 10120 {
3cf3436e
JR		 10121 for (i = 0;
10122 i < 9 && CONSP (matrix) && NUMBERP (XCAR (matrix));
10123 ++i, matrix = XCDR (matrix))
10124 trans[i] = XFLOATINT (XCAR (matrix));
10125 }
10126 else if (VECTORP (matrix) && ASIZE (matrix) >= 9)
10127 {
10128 for (i = 0; i < 9 && NUMBERP (AREF (matrix, i)); ++i)
10129 trans[i] = XFLOATINT (AREF (matrix, i));
10130 }
10131
10132 if (NILP (color_adjust))
10133 color_adjust = make_number (0xffff / 2);
10134
10135 if (i == 9 && NUMBERP (color_adjust))
10136 x_detect_edges (f, img, trans, (int) XFLOATINT (color_adjust));
10137}
10138
6fc2811b 10139
3cf3436e 10140/* Transform image IMG on frame F so that it looks disabled. */
6fc2811b 10141
3cf3436e
JR		 10142static void
10143x_disable_image (f, img)
10144 struct frame *f;
10145 struct image *img;
10146{
10147 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
10148
10149 if (dpyinfo->n_planes >= 2)
10150 {
10151 /* Color (or grayscale). Convert to gray, and equalize. Just
10152 drawing such images with a stipple can look very odd, so
10153 we're using this method instead. */
10154 XColor *colors = x_to_xcolors (f, img, 1);
10155 XColor *p, *end;
10156 const int h = 15000;
10157 const int l = 30000;
10158
10159 for (p = colors, end = colors + img->width * img->height;
10160 p < end;
10161 ++p)
6fc2811b 10162 {
3cf3436e
JR		 10163 int i = COLOR_INTENSITY (p->red, p->green, p->blue);
10164 int i2 = (0xffff - h - l) * i / 0xffff + l;
10165 p->red = p->green = p->blue = i2;
6fc2811b
JR		 10166 }
10167
3cf3436e 10168 x_from_xcolors (f, img, colors);
6fc2811b
JR		 10169 }
10170
3cf3436e
JR		 10171 /* Draw a cross over the disabled image, if we must or if we
10172 should. */
10173 if (dpyinfo->n_planes < 2 || cross_disabled_images)
10174 {
10175 Display *dpy = FRAME_X_DISPLAY (f);
10176 GC gc;
6fc2811b 10177
3cf3436e
JR		 10178 gc = XCreateGC (dpy, img->pixmap, 0, NULL);
10179 XSetForeground (dpy, gc, BLACK_PIX_DEFAULT (f));
10180 XDrawLine (dpy, img->pixmap, gc, 0, 0,
10181 img->width - 1, img->height - 1);
10182 XDrawLine (dpy, img->pixmap, gc, 0, img->height - 1,
10183 img->width - 1, 0);
10184 XFreeGC (dpy, gc);
6fc2811b 10185
3cf3436e
JR		 10186 if (img->mask)
10187 {
10188 gc = XCreateGC (dpy, img->mask, 0, NULL);
10189 XSetForeground (dpy, gc, WHITE_PIX_DEFAULT (f));
10190 XDrawLine (dpy, img->mask, gc, 0, 0,
10191 img->width - 1, img->height - 1);
10192 XDrawLine (dpy, img->mask, gc, 0, img->height - 1,
10193 img->width - 1, 0);
10194 XFreeGC (dpy, gc);
10195 }
10196 }
6fc2811b
JR		 10197}
10198
10199
10200/* Build a mask for image IMG which is used on frame F. FILE is the
10201 name of an image file, for error messages. HOW determines how to
10202 determine the background color of IMG. If it is a list '(R G B)',
10203 with R, G, and B being integers >= 0, take that as the color of the
10204 background. Otherwise, determine the background color of IMG
10205 heuristically. Value is non-zero if successful. */
10206
10207static int
10208x_build_heuristic_mask (f, img, how)
10209 struct frame *f;
10210 struct image *img;
10211 Lisp_Object how;
10212{
6fc2811b
JR		 10213 Display *dpy = FRAME_W32_DISPLAY (f);
10214 XImage *ximg, *mask_img;
10215 int x, y, rc, look_at_corners_p;
10216 unsigned long bg;
10217
10218 BLOCK_INPUT;
10219
10220 /* Create an image and pixmap serving as mask. */
10221 rc = x_create_x_image_and_pixmap (f, img->width, img->height, 1,
10222 &mask_img, &img->mask);
10223 if (!rc)
10224 {
10225 UNBLOCK_INPUT;
10226 return 0;
10227 }
10228
10229 /* Get the X image of IMG->pixmap. */
10230 ximg = XGetImage (dpy, img->pixmap, 0, 0, img->width, img->height,
10231 ~0, ZPixmap);
10232
10233 /* Determine the background color of ximg. If HOW is `(R G B)'
10234 take that as color. Otherwise, try to determine the color
10235 heuristically. */
10236 look_at_corners_p = 1;
10237
10238 if (CONSP (how))
10239 {
10240 int rgb[3], i = 0;
10241
10242 while (i < 3
10243 && CONSP (how)
10244 && NATNUMP (XCAR (how)))
10245 {
10246 rgb[i] = XFASTINT (XCAR (how)) & 0xffff;
10247 how = XCDR (how);
10248 }
10249
10250 if (i == 3 && NILP (how))
10251 {
10252 char color_name[30];
10253 XColor exact, color;
10254 Colormap cmap;
10255
10256 sprintf (color_name, "#%04x%04x%04x", rgb[0], rgb[1], rgb[2]);
10257
10258 cmap = DefaultColormapOfScreen (FRAME_X_SCREEN (f));
10259 if (XLookupColor (dpy, cmap, color_name, &exact, &color))
10260 {
10261 bg = color.pixel;
10262 look_at_corners_p = 0;
10263 }
10264 }
10265 }
10266
10267 if (look_at_corners_p)
10268 {
10269 unsigned long corners[4];
10270 int i, best_count;
10271
10272 /* Get the colors at the corners of ximg. */
10273 corners[0] = XGetPixel (ximg, 0, 0);
10274 corners[1] = XGetPixel (ximg, img->width - 1, 0);
10275 corners[2] = XGetPixel (ximg, img->width - 1, img->height - 1);
10276 corners[3] = XGetPixel (ximg, 0, img->height - 1);
10277
10278 /* Choose the most frequently found color as background. */
10279 for (i = best_count = 0; i < 4; ++i)
10280 {
10281 int j, n;
10282
10283 for (j = n = 0; j < 4; ++j)
10284 if (corners[i] == corners[j])
10285 ++n;
10286
10287 if (n > best_count)
10288 bg = corners[i], best_count = n;
10289 }
10290 }
10291
10292 /* Set all bits in mask_img to 1 whose color in ximg is different
10293 from the background color bg. */
10294 for (y = 0; y < img->height; ++y)
10295 for (x = 0; x < img->width; ++x)
10296 XPutPixel (mask_img, x, y, XGetPixel (ximg, x, y) != bg);
10297
10298 /* Put mask_img into img->mask. */
10299 x_put_x_image (f, mask_img, img->mask, img->width, img->height);
10300 x_destroy_x_image (mask_img);
10301 XDestroyImage (ximg);
10302
10303 UNBLOCK_INPUT;
6fc2811b
JR		 10304
10305 return 1;
10306}
3cf3436e 10307#endif /* TODO */
6fc2811b
JR		 10308
10309\f
10310/***********************************************************************
10311 PBM (mono, gray, color)
10312 ***********************************************************************/
10313#ifdef HAVE_PBM
10314
10315static int pbm_image_p P_ ((Lisp_Object object));
10316static int pbm_load P_ ((struct frame *f, struct image *img));
10317static int pbm_scan_number P_ ((unsigned char **, unsigned char *));
10318
10319/* The symbol `pbm' identifying images of this type. */
10320
10321Lisp_Object Qpbm;
10322
10323/* Indices of image specification fields in gs_format, below. */
10324
10325enum pbm_keyword_index
10326{
10327 PBM_TYPE,
10328 PBM_FILE,
10329 PBM_DATA,
10330 PBM_ASCENT,
10331 PBM_MARGIN,
10332 PBM_RELIEF,
10333 PBM_ALGORITHM,
10334 PBM_HEURISTIC_MASK,
10335 PBM_LAST
10336};
10337
10338/* Vector of image_keyword structures describing the format
10339 of valid user-defined image specifications. */
10340
10341static struct image_keyword pbm_format[PBM_LAST] =
10342{
10343 {":type", IMAGE_SYMBOL_VALUE, 1},
10344 {":file", IMAGE_STRING_VALUE, 0},
10345 {":data", IMAGE_STRING_VALUE, 0},
10346 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
8edb0a6f 10347 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
6fc2811b 10348 {":relief", IMAGE_INTEGER_VALUE, 0},
a93f4566 10349 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
3cf3436e
JR		 10350 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
10351 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
10352 {":foreground", IMAGE_STRING_OR_NIL_VALUE, 0},
10353 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
6fc2811b
JR		 10354};
10355
10356/* Structure describing the image type `pbm'. */
10357
10358static struct image_type pbm_type =
10359{
10360 &Qpbm,
10361 pbm_image_p,
10362 pbm_load,
10363 x_clear_image,
10364 NULL
10365};
10366
10367
10368/* Return non-zero if OBJECT is a valid PBM image specification. */
10369
10370static int
10371pbm_image_p (object)
10372 Lisp_Object object;
10373{
10374 struct image_keyword fmt[PBM_LAST];
10375
10376 bcopy (pbm_format, fmt, sizeof fmt);
10377
10378 if (!parse_image_spec (object, fmt, PBM_LAST, Qpbm)
10379 || (fmt[PBM_ASCENT].count
10380 && XFASTINT (fmt[PBM_ASCENT].value) > 100))
10381 return 0;
10382
10383 /* Must specify either :data or :file. */
10384 return fmt[PBM_DATA].count + fmt[PBM_FILE].count == 1;
10385}
10386
10387
10388/* Scan a decimal number from *S and return it. Advance *S while
10389 reading the number. END is the end of the string. Value is -1 at
10390 end of input. */
10391
10392static int
10393pbm_scan_number (s, end)
10394 unsigned char **s, *end;
10395{
10396 int c, val = -1;
10397
10398 while (*s < end)
10399 {
10400 /* Skip white-space. */
10401 while (*s < end && (c = *(*s)++, isspace (c)))
10402 ;
10403
10404 if (c == '#')
10405 {
10406 /* Skip comment to end of line. */
10407 while (*s < end && (c = *(*s)++, c != '\n'))
10408 ;
10409 }
10410 else if (isdigit (c))
10411 {
10412 /* Read decimal number. */
10413 val = c - '0';
10414 while (*s < end && (c = *(*s)++, isdigit (c)))
10415 val = 10 * val + c - '0';
10416 break;
10417 }
10418 else
10419 break;
10420 }
10421
10422 return val;
10423}
10424
10425
10426/* Read FILE into memory. Value is a pointer to a buffer allocated
10427 with xmalloc holding FILE's contents. Value is null if an error
10428 occured. *SIZE is set to the size of the file. */
10429
10430static char *
10431pbm_read_file (file, size)
10432 Lisp_Object file;
10433 int *size;
10434{
10435 FILE *fp = NULL;
10436 char *buf = NULL;
10437 struct stat st;
10438
10439 if (stat (XSTRING (file)->data, &st) == 0
10440 && (fp = fopen (XSTRING (file)->data, "r")) != NULL
10441 && (buf = (char *) xmalloc (st.st_size),
10442 fread (buf, 1, st.st_size, fp) == st.st_size))
10443 {
10444 *size = st.st_size;
10445 fclose (fp);
10446 }
10447 else
10448 {
10449 if (fp)
10450 fclose (fp);
10451 if (buf)
10452 {
10453 xfree (buf);
10454 buf = NULL;
10455 }
10456 }
10457
10458 return buf;
10459}
10460
10461
10462/* Load PBM image IMG for use on frame F. */
10463
10464static int
10465pbm_load (f, img)
10466 struct frame *f;
10467 struct image *img;
10468{
10469 int raw_p, x, y;
10470 int width, height, max_color_idx = 0;
10471 XImage *ximg;
10472 Lisp_Object file, specified_file;
10473 enum {PBM_MONO, PBM_GRAY, PBM_COLOR} type;
10474 struct gcpro gcpro1;
10475 unsigned char *contents = NULL;
10476 unsigned char *end, *p;
10477 int size;
10478
10479 specified_file = image_spec_value (img->spec, QCfile, NULL);
10480 file = Qnil;
10481 GCPRO1 (file);
10482
10483 if (STRINGP (specified_file))
10484 {
10485 file = x_find_image_file (specified_file);
10486 if (!STRINGP (file))
10487 {
10488 image_error ("Cannot find image file `%s'", specified_file, Qnil);
10489 UNGCPRO;
10490 return 0;
10491 }
10492
3cf3436e 10493 contents = slurp_file (XSTRING (file)->data, &size);
6fc2811b
JR		 10494 if (contents == NULL)
10495 {
10496 image_error ("Error reading `%s'", file, Qnil);
10497 UNGCPRO;
10498 return 0;
10499 }
10500
10501 p = contents;
10502 end = contents + size;
10503 }
10504 else
10505 {
10506 Lisp_Object data;
10507 data = image_spec_value (img->spec, QCdata, NULL);
10508 p = XSTRING (data)->data;
10509 end = p + STRING_BYTES (XSTRING (data));
10510 }
10511
10512 /* Check magic number. */
10513 if (end - p < 2 || *p++ != 'P')
10514 {
10515 image_error ("Not a PBM image: `%s'", img->spec, Qnil);
10516 error:
10517 xfree (contents);
10518 UNGCPRO;
10519 return 0;
10520 }
10521
6fc2811b
JR		 10522 switch (*p++)
10523 {
10524 case '1':
10525 raw_p = 0, type = PBM_MONO;
10526 break;
10527
10528 case '2':
10529 raw_p = 0, type = PBM_GRAY;
10530 break;
10531
10532 case '3':
10533 raw_p = 0, type = PBM_COLOR;
10534 break;
10535
10536 case '4':
10537 raw_p = 1, type = PBM_MONO;
10538 break;
10539
10540 case '5':
10541 raw_p = 1, type = PBM_GRAY;
10542 break;
10543
10544 case '6':
10545 raw_p = 1, type = PBM_COLOR;
10546 break;
10547
10548 default:
10549 image_error ("Not a PBM image: `%s'", img->spec, Qnil);
10550 goto error;
10551 }
10552
10553 /* Read width, height, maximum color-component. Characters
10554 starting with `#' up to the end of a line are ignored. */
10555 width = pbm_scan_number (&p, end);
10556 height = pbm_scan_number (&p, end);
10557
10558 if (type != PBM_MONO)
10559 {
10560 max_color_idx = pbm_scan_number (&p, end);
10561 if (raw_p && max_color_idx > 255)
10562 max_color_idx = 255;
10563 }
10564
10565 if (width < 0
10566 || height < 0
10567 || (type != PBM_MONO && max_color_idx < 0))
10568 goto error;
10569
6fc2811b
JR		 10570 if (!x_create_x_image_and_pixmap (f, width, height, 0,
10571 &ximg, &img->pixmap))
3cf3436e
JR		 10572 goto error;
10573
6fc2811b
JR		 10574 /* Initialize the color hash table. */
10575 init_color_table ();
10576
10577 if (type == PBM_MONO)
10578 {
10579 int c = 0, g;
3cf3436e
JR		 10580 struct image_keyword fmt[PBM_LAST];
10581 unsigned long fg = FRAME_FOREGROUND_PIXEL (f);
10582 unsigned long bg = FRAME_BACKGROUND_PIXEL (f);
10583
10584 /* Parse the image specification. */
10585 bcopy (pbm_format, fmt, sizeof fmt);
10586 parse_image_spec (img->spec, fmt, PBM_LAST, Qpbm);
10587
10588 /* Get foreground and background colors, maybe allocate colors. */
10589 if (fmt[PBM_FOREGROUND].count
10590 && STRINGP (fmt[PBM_FOREGROUND].value))
10591 fg = x_alloc_image_color (f, img, fmt[PBM_FOREGROUND].value, fg);
10592 if (fmt[PBM_BACKGROUND].count
10593 && STRINGP (fmt[PBM_BACKGROUND].value))
10594 bg = x_alloc_image_color (f, img, fmt[PBM_BACKGROUND].value, bg);
6fc2811b
JR		 10595
10596 for (y = 0; y < height; ++y)
10597 for (x = 0; x < width; ++x)
10598 {
10599 if (raw_p)
10600 {
10601 if ((x & 7) == 0)
10602 c = *p++;
10603 g = c & 0x80;
10604 c <<= 1;
10605 }
10606 else
10607 g = pbm_scan_number (&p, end);
10608
3cf3436e 10609 XPutPixel (ximg, x, y, g ? fg : bg);
6fc2811b
JR		 10610 }
10611 }
10612 else
10613 {
10614 for (y = 0; y < height; ++y)
10615 for (x = 0; x < width; ++x)
10616 {
10617 int r, g, b;
10618
10619 if (type == PBM_GRAY)
10620 r = g = b = raw_p ? *p++ : pbm_scan_number (&p, end);
10621 else if (raw_p)
10622 {
10623 r = *p++;
10624 g = *p++;
10625 b = *p++;
10626 }
10627 else
10628 {
10629 r = pbm_scan_number (&p, end);
10630 g = pbm_scan_number (&p, end);
10631 b = pbm_scan_number (&p, end);
10632 }
10633
10634 if (r < 0 || g < 0 || b < 0)
10635 {
dfff8a69 10636 xfree (ximg->data);
6fc2811b
JR		 10637 ximg->data = NULL;
10638 XDestroyImage (ximg);
6fc2811b
JR		 10639 image_error ("Invalid pixel value in image `%s'",
10640 img->spec, Qnil);
10641 goto error;
10642 }
10643
10644 /* RGB values are now in the range 0..max_color_idx.
10645 Scale this to the range 0..0xffff supported by X. */
10646 r = (double) r * 65535 / max_color_idx;
10647 g = (double) g * 65535 / max_color_idx;
10648 b = (double) b * 65535 / max_color_idx;
10649 XPutPixel (ximg, x, y, lookup_rgb_color (f, r, g, b));
10650 }
10651 }
10652
10653 /* Store in IMG->colors the colors allocated for the image, and
10654 free the color table. */
10655 img->colors = colors_in_color_table (&img->ncolors);
10656 free_color_table ();
10657
10658 /* Put the image into a pixmap. */
10659 x_put_x_image (f, ximg, img->pixmap, width, height);
10660 x_destroy_x_image (ximg);
6fc2811b
JR		 10661
10662 img->width = width;
10663 img->height = height;
10664
10665 UNGCPRO;
10666 xfree (contents);
10667 return 1;
10668}
10669#endif /* HAVE_PBM */
10670
10671\f
10672/***********************************************************************
10673 PNG
10674 ***********************************************************************/
10675
10676#if HAVE_PNG
10677
10678#include <png.h>
10679
10680/* Function prototypes. */
10681
10682static int png_image_p P_ ((Lisp_Object object));
10683static int png_load P_ ((struct frame *f, struct image *img));
10684
10685/* The symbol `png' identifying images of this type. */
10686
10687Lisp_Object Qpng;
10688
10689/* Indices of image specification fields in png_format, below. */
10690
10691enum png_keyword_index
10692{
10693 PNG_TYPE,
10694 PNG_DATA,
10695 PNG_FILE,
10696 PNG_ASCENT,
10697 PNG_MARGIN,
10698 PNG_RELIEF,
10699 PNG_ALGORITHM,
10700 PNG_HEURISTIC_MASK,
10701 PNG_LAST
10702};
10703
10704/* Vector of image_keyword structures describing the format
10705 of valid user-defined image specifications. */
10706
10707static struct image_keyword png_format[PNG_LAST] =
10708{
10709 {":type", IMAGE_SYMBOL_VALUE, 1},
10710 {":data", IMAGE_STRING_VALUE, 0},
10711 {":file", IMAGE_STRING_VALUE, 0},
10712 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
8edb0a6f 10713 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
6fc2811b 10714 {":relief", IMAGE_INTEGER_VALUE, 0},
a93f4566 10715 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6fc2811b
JR		 10716 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
10717};
10718
10719/* Structure describing the image type `png'. */
10720
10721static struct image_type png_type =
10722{
10723 &Qpng,
10724 png_image_p,
10725 png_load,
10726 x_clear_image,
10727 NULL
10728};
10729
10730
10731/* Return non-zero if OBJECT is a valid PNG image specification. */
10732
10733static int
10734png_image_p (object)
10735 Lisp_Object object;
10736{
10737 struct image_keyword fmt[PNG_LAST];
10738 bcopy (png_format, fmt, sizeof fmt);
10739
10740 if (!parse_image_spec (object, fmt, PNG_LAST, Qpng)
10741 || (fmt[PNG_ASCENT].count
10742 && XFASTINT (fmt[PNG_ASCENT].value) > 100))
10743 return 0;
10744
10745 /* Must specify either the :data or :file keyword. */
10746 return fmt[PNG_FILE].count + fmt[PNG_DATA].count == 1;
10747}
10748
10749
10750/* Error and warning handlers installed when the PNG library
10751 is initialized. */
10752
10753static void
10754my_png_error (png_ptr, msg)
10755 png_struct *png_ptr;
10756 char *msg;
10757{
10758 xassert (png_ptr != NULL);
10759 image_error ("PNG error: %s", build_string (msg), Qnil);
10760 longjmp (png_ptr->jmpbuf, 1);
10761}
10762
10763
10764static void
10765my_png_warning (png_ptr, msg)
10766 png_struct *png_ptr;
10767 char *msg;
10768{
10769 xassert (png_ptr != NULL);
10770 image_error ("PNG warning: %s", build_string (msg), Qnil);
10771}
10772
6fc2811b
JR		 10773/* Memory source for PNG decoding. */
10774
10775struct png_memory_storage
10776{
10777 unsigned char *bytes; /* The data */
10778 size_t len; /* How big is it? */
10779 int index; /* Where are we? */
10780};
10781
10782
10783/* Function set as reader function when reading PNG image from memory.
10784 PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
10785 bytes from the input to DATA. */
10786
10787static void
10788png_read_from_memory (png_ptr, data, length)
10789 png_structp png_ptr;
10790 png_bytep data;
10791 png_size_t length;
10792{
10793 struct png_memory_storage *tbr
10794 = (struct png_memory_storage *) png_get_io_ptr (png_ptr);
10795
10796 if (length > tbr->len - tbr->index)
10797 png_error (png_ptr, "Read error");
10798
10799 bcopy (tbr->bytes + tbr->index, data, length);
10800 tbr->index = tbr->index + length;
10801}
10802
6fc2811b
JR		 10803/* Load PNG image IMG for use on frame F. Value is non-zero if
10804 successful. */
10805
10806static int
10807png_load (f, img)
10808 struct frame *f;
10809 struct image *img;
10810{
10811 Lisp_Object file, specified_file;
10812 Lisp_Object specified_data;
10813 int x, y, i;
10814 XImage *ximg, *mask_img = NULL;
10815 struct gcpro gcpro1;
10816 png_struct *png_ptr = NULL;
10817 png_info *info_ptr = NULL, *end_info = NULL;
10818 FILE *fp = NULL;
10819 png_byte sig[8];
10820 png_byte *pixels = NULL;
10821 png_byte **rows = NULL;
10822 png_uint_32 width, height;
10823 int bit_depth, color_type, interlace_type;
10824 png_byte channels;
10825 png_uint_32 row_bytes;
10826 int transparent_p;
10827 char *gamma_str;
10828 double screen_gamma, image_gamma;
10829 int intent;
10830 struct png_memory_storage tbr; /* Data to be read */
10831
10832 /* Find out what file to load. */
10833 specified_file = image_spec_value (img->spec, QCfile, NULL);
10834 specified_data = image_spec_value (img->spec, QCdata, NULL);
10835 file = Qnil;
10836 GCPRO1 (file);
10837
10838 if (NILP (specified_data))
10839 {
10840 file = x_find_image_file (specified_file);
10841 if (!STRINGP (file))
10842 {
10843 image_error ("Cannot find image file `%s'", specified_file, Qnil);
10844 UNGCPRO;
10845 return 0;
10846 }
10847
10848 /* Open the image file. */
10849 fp = fopen (XSTRING (file)->data, "rb");
10850 if (!fp)
10851 {
10852 image_error ("Cannot open image file `%s'", file, Qnil);
10853 UNGCPRO;
10854 fclose (fp);
10855 return 0;
10856 }
10857
10858 /* Check PNG signature. */
10859 if (fread (sig, 1, sizeof sig, fp) != sizeof sig
10860 || !png_check_sig (sig, sizeof sig))
10861 {
10862 image_error ("Not a PNG file:` %s'", file, Qnil);
10863 UNGCPRO;
10864 fclose (fp);
10865 return 0;
10866 }
10867 }
10868 else
10869 {
10870 /* Read from memory. */
10871 tbr.bytes = XSTRING (specified_data)->data;
10872 tbr.len = STRING_BYTES (XSTRING (specified_data));
10873 tbr.index = 0;
10874
10875 /* Check PNG signature. */
10876 if (tbr.len < sizeof sig
10877 || !png_check_sig (tbr.bytes, sizeof sig))
10878 {
10879 image_error ("Not a PNG image: `%s'", img->spec, Qnil);
10880 UNGCPRO;
10881 return 0;
10882 }
10883
10884 /* Need to skip past the signature. */
10885 tbr.bytes += sizeof (sig);
10886 }
10887
6fc2811b
JR		 10888 /* Initialize read and info structs for PNG lib. */
10889 png_ptr = png_create_read_struct (PNG_LIBPNG_VER_STRING, NULL,
10890 my_png_error, my_png_warning);
10891 if (!png_ptr)
10892 {
10893 if (fp) fclose (fp);
10894 UNGCPRO;
10895 return 0;
10896 }
10897
10898 info_ptr = png_create_info_struct (png_ptr);
10899 if (!info_ptr)
10900 {
10901 png_destroy_read_struct (&png_ptr, NULL, NULL);
10902 if (fp) fclose (fp);
10903 UNGCPRO;
10904 return 0;
10905 }
10906
10907 end_info = png_create_info_struct (png_ptr);
10908 if (!end_info)
10909 {
10910 png_destroy_read_struct (&png_ptr, &info_ptr, NULL);
10911 if (fp) fclose (fp);
10912 UNGCPRO;
10913 return 0;
10914 }
10915
10916 /* Set error jump-back. We come back here when the PNG library
10917 detects an error. */
10918 if (setjmp (png_ptr->jmpbuf))
10919 {
10920 error:
10921 if (png_ptr)
10922 png_destroy_read_struct (&png_ptr, &info_ptr, &end_info);
10923 xfree (pixels);
10924 xfree (rows);
10925 if (fp) fclose (fp);
10926 UNGCPRO;
10927 return 0;
10928 }
10929
10930 /* Read image info. */
10931 if (!NILP (specified_data))
10932 png_set_read_fn (png_ptr, (void *) &tbr, png_read_from_memory);
10933 else
10934 png_init_io (png_ptr, fp);
10935
10936 png_set_sig_bytes (png_ptr, sizeof sig);
10937 png_read_info (png_ptr, info_ptr);
10938 png_get_IHDR (png_ptr, info_ptr, &width, &height, &bit_depth, &color_type,
10939 &interlace_type, NULL, NULL);
10940
10941 /* If image contains simply transparency data, we prefer to
10942 construct a clipping mask. */
10943 if (png_get_valid (png_ptr, info_ptr, PNG_INFO_tRNS))
10944 transparent_p = 1;
10945 else
10946 transparent_p = 0;
10947
10948 /* This function is easier to write if we only have to handle
10949 one data format: RGB or RGBA with 8 bits per channel. Let's
10950 transform other formats into that format. */
10951
10952 /* Strip more than 8 bits per channel. */
10953 if (bit_depth == 16)
10954 png_set_strip_16 (png_ptr);
10955
10956 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
10957 if available. */
10958 png_set_expand (png_ptr);
10959
10960 /* Convert grayscale images to RGB. */
10961 if (color_type == PNG_COLOR_TYPE_GRAY
10962 || color_type == PNG_COLOR_TYPE_GRAY_ALPHA)
10963 png_set_gray_to_rgb (png_ptr);
10964
10965 /* The value 2.2 is a guess for PC monitors from PNG example.c. */
10966 gamma_str = getenv ("SCREEN_GAMMA");
10967 screen_gamma = gamma_str ? atof (gamma_str) : 2.2;
10968
10969 /* Tell the PNG lib to handle gamma correction for us. */
10970
10971#if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
10972 if (png_get_sRGB (png_ptr, info_ptr, &intent))
10973 /* There is a special chunk in the image specifying the gamma. */
10974 png_set_sRGB (png_ptr, info_ptr, intent);
10975 else
10976#endif
10977 if (png_get_gAMA (png_ptr, info_ptr, &image_gamma))
10978 /* Image contains gamma information. */
10979 png_set_gamma (png_ptr, screen_gamma, image_gamma);
10980 else
10981 /* Use a default of 0.5 for the image gamma. */
10982 png_set_gamma (png_ptr, screen_gamma, 0.5);
10983
10984 /* Handle alpha channel by combining the image with a background
10985 color. Do this only if a real alpha channel is supplied. For
10986 simple transparency, we prefer a clipping mask. */
10987 if (!transparent_p)
10988 {
10989 png_color_16 *image_background;
10990
10991 if (png_get_bKGD (png_ptr, info_ptr, &image_background))
10992 /* Image contains a background color with which to
10993 combine the image. */
10994 png_set_background (png_ptr, image_background,
10995 PNG_BACKGROUND_GAMMA_FILE, 1, 1.0);
10996 else
10997 {
10998 /* Image does not contain a background color with which
10999 to combine the image data via an alpha channel. Use
11000 the frame's background instead. */
11001 XColor color;
11002 Colormap cmap;
11003 png_color_16 frame_background;
11004
11005 BLOCK_INPUT;
11006 cmap = DefaultColormapOfScreen (FRAME_X_SCREEN (f));
11007 color.pixel = FRAME_BACKGROUND_PIXEL (f);
11008 XQueryColor (FRAME_W32_DISPLAY (f), cmap, &color);
11009 UNBLOCK_INPUT;
11010
11011 bzero (&frame_background, sizeof frame_background);
11012 frame_background.red = color.red;
11013 frame_background.green = color.green;
11014 frame_background.blue = color.blue;
11015
11016 png_set_background (png_ptr, &frame_background,
11017 PNG_BACKGROUND_GAMMA_SCREEN, 0, 1.0);
11018 }
11019 }
11020
11021 /* Update info structure. */
11022 png_read_update_info (png_ptr, info_ptr);
11023
11024 /* Get number of channels. Valid values are 1 for grayscale images
11025 and images with a palette, 2 for grayscale images with transparency
11026 information (alpha channel), 3 for RGB images, and 4 for RGB
11027 images with alpha channel, i.e. RGBA. If conversions above were
11028 sufficient we should only have 3 or 4 channels here. */
11029 channels = png_get_channels (png_ptr, info_ptr);
11030 xassert (channels == 3 || channels == 4);
11031
11032 /* Number of bytes needed for one row of the image. */
11033 row_bytes = png_get_rowbytes (png_ptr, info_ptr);
11034
11035 /* Allocate memory for the image. */
11036 pixels = (png_byte *) xmalloc (row_bytes * height * sizeof *pixels);
11037 rows = (png_byte **) xmalloc (height * sizeof *rows);
11038 for (i = 0; i < height; ++i)
11039 rows[i] = pixels + i * row_bytes;
11040
11041 /* Read the entire image. */
11042 png_read_image (png_ptr, rows);
11043 png_read_end (png_ptr, info_ptr);
11044 if (fp)
11045 {
11046 fclose (fp);
11047 fp = NULL;
11048 }
11049
11050 BLOCK_INPUT;
11051
11052 /* Create the X image and pixmap. */
11053 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg,
11054 &img->pixmap))
11055 {
11056 UNBLOCK_INPUT;
11057 goto error;
11058 }
11059
11060 /* Create an image and pixmap serving as mask if the PNG image
11061 contains an alpha channel. */
11062 if (channels == 4
11063 && !transparent_p
11064 && !x_create_x_image_and_pixmap (f, width, height, 1,
11065 &mask_img, &img->mask))
11066 {
11067 x_destroy_x_image (ximg);
11068 XFreePixmap (FRAME_W32_DISPLAY (f), img->pixmap);
11069 img->pixmap = 0;
11070 UNBLOCK_INPUT;
11071 goto error;
11072 }
11073
11074 /* Fill the X image and mask from PNG data. */
11075 init_color_table ();
11076
11077 for (y = 0; y < height; ++y)
11078 {
11079 png_byte *p = rows[y];
11080
11081 for (x = 0; x < width; ++x)
11082 {
11083 unsigned r, g, b;
11084
11085 r = *p++ << 8;
11086 g = *p++ << 8;
11087 b = *p++ << 8;
11088 XPutPixel (ximg, x, y, lookup_rgb_color (f, r, g, b));
11089
11090 /* An alpha channel, aka mask channel, associates variable
11091 transparency with an image. Where other image formats
11092 support binary transparency---fully transparent or fully
11093 opaque---PNG allows up to 254 levels of partial transparency.
11094 The PNG library implements partial transparency by combining
11095 the image with a specified background color.
11096
11097 I'm not sure how to handle this here nicely: because the
11098 background on which the image is displayed may change, for
11099 real alpha channel support, it would be necessary to create
11100 a new image for each possible background.
11101
11102 What I'm doing now is that a mask is created if we have
11103 boolean transparency information. Otherwise I'm using
11104 the frame's background color to combine the image with. */
11105
11106 if (channels == 4)
11107 {
11108 if (mask_img)
11109 XPutPixel (mask_img, x, y, *p > 0);
11110 ++p;
11111 }
11112 }
11113 }
11114
11115 /* Remember colors allocated for this image. */
11116 img->colors = colors_in_color_table (&img->ncolors);
11117 free_color_table ();
11118
11119 /* Clean up. */
11120 png_destroy_read_struct (&png_ptr, &info_ptr, &end_info);
11121 xfree (rows);
11122 xfree (pixels);
11123
11124 img->width = width;
11125 img->height = height;
11126
11127 /* Put the image into the pixmap, then free the X image and its buffer. */
11128 x_put_x_image (f, ximg, img->pixmap, width, height);
11129 x_destroy_x_image (ximg);
11130
11131 /* Same for the mask. */
11132 if (mask_img)
11133 {
11134 x_put_x_image (f, mask_img, img->mask, img->width, img->height);
11135 x_destroy_x_image (mask_img);
11136 }
11137
11138 UNBLOCK_INPUT;
11139 UNGCPRO;
11140 return 1;
11141}
11142
11143#endif /* HAVE_PNG != 0 */
11144
11145
11146\f
11147/***********************************************************************
11148 JPEG
11149 ***********************************************************************/
11150
11151#if HAVE_JPEG
11152
11153/* Work around a warning about HAVE_STDLIB_H being redefined in
11154 jconfig.h. */
11155#ifdef HAVE_STDLIB_H
11156#define HAVE_STDLIB_H_1
11157#undef HAVE_STDLIB_H
11158#endif /* HAVE_STLIB_H */
11159
11160#include <jpeglib.h>
11161#include <jerror.h>
11162#include <setjmp.h>
11163
11164#ifdef HAVE_STLIB_H_1
11165#define HAVE_STDLIB_H 1
11166#endif
11167
11168static int jpeg_image_p P_ ((Lisp_Object object));
11169static int jpeg_load P_ ((struct frame *f, struct image *img));
11170
11171/* The symbol `jpeg' identifying images of this type. */
11172
11173Lisp_Object Qjpeg;
11174
11175/* Indices of image specification fields in gs_format, below. */
11176
11177enum jpeg_keyword_index
11178{
11179 JPEG_TYPE,
11180 JPEG_DATA,
11181 JPEG_FILE,
11182 JPEG_ASCENT,
11183 JPEG_MARGIN,
11184 JPEG_RELIEF,
11185 JPEG_ALGORITHM,
11186 JPEG_HEURISTIC_MASK,
11187 JPEG_LAST
11188};
11189
11190/* Vector of image_keyword structures describing the format
11191 of valid user-defined image specifications. */
11192
11193static struct image_keyword jpeg_format[JPEG_LAST] =
11194{
11195 {":type", IMAGE_SYMBOL_VALUE, 1},
11196 {":data", IMAGE_STRING_VALUE, 0},
11197 {":file", IMAGE_STRING_VALUE, 0},
11198 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
8edb0a6f 11199 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
6fc2811b 11200 {":relief", IMAGE_INTEGER_VALUE, 0},
a93f4566 11201 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6fc2811b
JR		 11202 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
11203};
11204
11205/* Structure describing the image type `jpeg'. */
11206
11207static struct image_type jpeg_type =
11208{
11209 &Qjpeg,
11210 jpeg_image_p,
11211 jpeg_load,
11212 x_clear_image,
11213 NULL
11214};
11215
11216
11217/* Return non-zero if OBJECT is a valid JPEG image specification. */
11218
11219static int
11220jpeg_image_p (object)
11221 Lisp_Object object;
11222{
11223 struct image_keyword fmt[JPEG_LAST];
11224
11225 bcopy (jpeg_format, fmt, sizeof fmt);
11226
11227 if (!parse_image_spec (object, fmt, JPEG_LAST, Qjpeg)
11228 || (fmt[JPEG_ASCENT].count
11229 && XFASTINT (fmt[JPEG_ASCENT].value) > 100))
11230 return 0;
11231
11232 /* Must specify either the :data or :file keyword. */
11233 return fmt[JPEG_FILE].count + fmt[JPEG_DATA].count == 1;
11234}
11235
11236
11237struct my_jpeg_error_mgr
11238{
11239 struct jpeg_error_mgr pub;
11240 jmp_buf setjmp_buffer;
11241};
11242
11243static void
11244my_error_exit (cinfo)
11245 j_common_ptr cinfo;
11246{
11247 struct my_jpeg_error_mgr *mgr = (struct my_jpeg_error_mgr *) cinfo->err;
11248 longjmp (mgr->setjmp_buffer, 1);
11249}
11250
6fc2811b
JR		 11251/* Init source method for JPEG data source manager. Called by
11252 jpeg_read_header() before any data is actually read. See
11253 libjpeg.doc from the JPEG lib distribution. */
11254
11255static void
11256our_init_source (cinfo)
11257 j_decompress_ptr cinfo;
11258{
11259}
11260
11261
11262/* Fill input buffer method for JPEG data source manager. Called
11263 whenever more data is needed. We read the whole image in one step,
11264 so this only adds a fake end of input marker at the end. */
11265
11266static boolean
11267our_fill_input_buffer (cinfo)
11268 j_decompress_ptr cinfo;
11269{
11270 /* Insert a fake EOI marker. */
11271 struct jpeg_source_mgr *src = cinfo->src;
11272 static JOCTET buffer[2];
11273
11274 buffer[0] = (JOCTET) 0xFF;
11275 buffer[1] = (JOCTET) JPEG_EOI;
11276
11277 src->next_input_byte = buffer;
11278 src->bytes_in_buffer = 2;
11279 return TRUE;
11280}
11281
11282
11283/* Method to skip over NUM_BYTES bytes in the image data. CINFO->src
11284 is the JPEG data source manager. */
11285
11286static void
11287our_skip_input_data (cinfo, num_bytes)
11288 j_decompress_ptr cinfo;
11289 long num_bytes;
11290{
11291 struct jpeg_source_mgr *src = (struct jpeg_source_mgr *) cinfo->src;
11292
11293 if (src)
11294 {
11295 if (num_bytes > src->bytes_in_buffer)
11296 ERREXIT (cinfo, JERR_INPUT_EOF);
11297
11298 src->bytes_in_buffer -= num_bytes;
11299 src->next_input_byte += num_bytes;
11300 }
11301}
11302
11303
11304/* Method to terminate data source. Called by
11305 jpeg_finish_decompress() after all data has been processed. */
11306
11307static void
11308our_term_source (cinfo)
11309 j_decompress_ptr cinfo;
11310{
11311}
11312
11313
11314/* Set up the JPEG lib for reading an image from DATA which contains
11315 LEN bytes. CINFO is the decompression info structure created for
11316 reading the image. */
11317
11318static void
11319jpeg_memory_src (cinfo, data, len)
11320 j_decompress_ptr cinfo;
11321 JOCTET *data;
11322 unsigned int len;
11323{
11324 struct jpeg_source_mgr *src;
11325
11326 if (cinfo->src == NULL)
11327 {
11328 /* First time for this JPEG object? */
11329 cinfo->src = (struct jpeg_source_mgr *)
11330 (*cinfo->mem->alloc_small) ((j_common_ptr) cinfo, JPOOL_PERMANENT,
11331 sizeof (struct jpeg_source_mgr));
11332 src = (struct jpeg_source_mgr *) cinfo->src;
11333 src->next_input_byte = data;
11334 }
11335
11336 src = (struct jpeg_source_mgr *) cinfo->src;
11337 src->init_source = our_init_source;
11338 src->fill_input_buffer = our_fill_input_buffer;
11339 src->skip_input_data = our_skip_input_data;
11340 src->resync_to_restart = jpeg_resync_to_restart; /* Use default method. */
11341 src->term_source = our_term_source;
11342 src->bytes_in_buffer = len;
11343 src->next_input_byte = data;
11344}
11345
11346
11347/* Load image IMG for use on frame F. Patterned after example.c
11348 from the JPEG lib. */
11349
11350static int
11351jpeg_load (f, img)
11352 struct frame *f;
11353 struct image *img;
11354{
11355 struct jpeg_decompress_struct cinfo;
11356 struct my_jpeg_error_mgr mgr;
11357 Lisp_Object file, specified_file;
11358 Lisp_Object specified_data;
11359 FILE *fp = NULL;
11360 JSAMPARRAY buffer;
11361 int row_stride, x, y;
11362 XImage *ximg = NULL;
11363 int rc;
11364 unsigned long *colors;
11365 int width, height;
11366 struct gcpro gcpro1;
11367
11368 /* Open the JPEG file. */
11369 specified_file = image_spec_value (img->spec, QCfile, NULL);
11370 specified_data = image_spec_value (img->spec, QCdata, NULL);
11371 file = Qnil;
11372 GCPRO1 (file);
11373
6fc2811b
JR		 11374 if (NILP (specified_data))
11375 {
11376 file = x_find_image_file (specified_file);
11377 if (!STRINGP (file))
11378 {
11379 image_error ("Cannot find image file `%s'", specified_file, Qnil);
11380 UNGCPRO;
11381 return 0;
11382 }
11383
11384 fp = fopen (XSTRING (file)->data, "r");
11385 if (fp == NULL)
11386 {
11387 image_error ("Cannot open `%s'", file, Qnil);
11388 UNGCPRO;
11389 return 0;
11390 }
11391 }
11392
11393 /* Customize libjpeg's error handling to call my_error_exit when an
11394 error is detected. This function will perform a longjmp. */
11395 mgr.pub.error_exit = my_error_exit;
11396 cinfo.err = jpeg_std_error (&mgr.pub);
11397
11398 if ((rc = setjmp (mgr.setjmp_buffer)) != 0)
11399 {
11400 if (rc == 1)
11401 {
11402 /* Called from my_error_exit. Display a JPEG error. */
11403 char buffer[JMSG_LENGTH_MAX];
11404 cinfo.err->format_message ((j_common_ptr) &cinfo, buffer);
11405 image_error ("Error reading JPEG image `%s': %s", img->spec,
11406 build_string (buffer));
11407 }
11408
11409 /* Close the input file and destroy the JPEG object. */
11410 if (fp)
11411 fclose (fp);
11412 jpeg_destroy_decompress (&cinfo);
11413
11414 BLOCK_INPUT;
11415
11416 /* If we already have an XImage, free that. */
11417 x_destroy_x_image (ximg);
11418
11419 /* Free pixmap and colors. */
11420 x_clear_image (f, img);
11421
11422 UNBLOCK_INPUT;
11423 UNGCPRO;
11424 return 0;
11425 }
11426
11427 /* Create the JPEG decompression object. Let it read from fp.
11428 Read the JPEG image header. */
11429 jpeg_create_decompress (&cinfo);
11430
11431 if (NILP (specified_data))
11432 jpeg_stdio_src (&cinfo, fp);
11433 else
11434 jpeg_memory_src (&cinfo, XSTRING (specified_data)->data,
11435 STRING_BYTES (XSTRING (specified_data)));
11436
11437 jpeg_read_header (&cinfo, TRUE);
11438
11439 /* Customize decompression so that color quantization will be used.
11440 Start decompression. */
11441 cinfo.quantize_colors = TRUE;
11442 jpeg_start_decompress (&cinfo);
11443 width = img->width = cinfo.output_width;
11444 height = img->height = cinfo.output_height;
11445
11446 BLOCK_INPUT;
11447
11448 /* Create X image and pixmap. */
11449 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg,
11450 &img->pixmap))
11451 {
11452 UNBLOCK_INPUT;
11453 longjmp (mgr.setjmp_buffer, 2);
11454 }
11455
11456 /* Allocate colors. When color quantization is used,
11457 cinfo.actual_number_of_colors has been set with the number of
11458 colors generated, and cinfo.colormap is a two-dimensional array
11459 of color indices in the range 0..cinfo.actual_number_of_colors.
11460 No more than 255 colors will be generated. */
11461 {
11462 int i, ir, ig, ib;
11463
11464 if (cinfo.out_color_components > 2)
11465 ir = 0, ig = 1, ib = 2;
11466 else if (cinfo.out_color_components > 1)
11467 ir = 0, ig = 1, ib = 0;
11468 else
11469 ir = 0, ig = 0, ib = 0;
11470
11471 /* Use the color table mechanism because it handles colors that
11472 cannot be allocated nicely. Such colors will be replaced with
11473 a default color, and we don't have to care about which colors
11474 can be freed safely, and which can't. */
11475 init_color_table ();
11476 colors = (unsigned long *) alloca (cinfo.actual_number_of_colors
11477 * sizeof *colors);
11478
11479 for (i = 0; i < cinfo.actual_number_of_colors; ++i)
11480 {
11481 /* Multiply RGB values with 255 because X expects RGB values
11482 in the range 0..0xffff. */
11483 int r = cinfo.colormap[ir][i] << 8;
11484 int g = cinfo.colormap[ig][i] << 8;
11485 int b = cinfo.colormap[ib][i] << 8;
11486 colors[i] = lookup_rgb_color (f, r, g, b);
11487 }
11488
11489 /* Remember those colors actually allocated. */
11490 img->colors = colors_in_color_table (&img->ncolors);
11491 free_color_table ();
11492 }
11493
11494 /* Read pixels. */
11495 row_stride = width * cinfo.output_components;
11496 buffer = cinfo.mem->alloc_sarray ((j_common_ptr) &cinfo, JPOOL_IMAGE,
11497 row_stride, 1);
11498 for (y = 0; y < height; ++y)
11499 {
11500 jpeg_read_scanlines (&cinfo, buffer, 1);
11501 for (x = 0; x < cinfo.output_width; ++x)
11502 XPutPixel (ximg, x, y, colors[buffer[0][x]]);
11503 }
11504
11505 /* Clean up. */
11506 jpeg_finish_decompress (&cinfo);
11507 jpeg_destroy_decompress (&cinfo);
11508 if (fp)
11509 fclose (fp);
11510
11511 /* Put the image into the pixmap. */
11512 x_put_x_image (f, ximg, img->pixmap, width, height);
11513 x_destroy_x_image (ximg);
11514 UNBLOCK_INPUT;
11515 UNGCPRO;
11516 return 1;
11517}
11518
11519#endif /* HAVE_JPEG */
11520
11521
11522\f
11523/***********************************************************************
11524 TIFF
11525 ***********************************************************************/
11526
11527#if HAVE_TIFF
11528
11529#include <tiffio.h>
11530
11531static int tiff_image_p P_ ((Lisp_Object object));
11532static int tiff_load P_ ((struct frame *f, struct image *img));
11533
11534/* The symbol `tiff' identifying images of this type. */
11535
11536Lisp_Object Qtiff;
11537
11538/* Indices of image specification fields in tiff_format, below. */
11539
11540enum tiff_keyword_index
11541{
11542 TIFF_TYPE,
11543 TIFF_DATA,
11544 TIFF_FILE,
11545 TIFF_ASCENT,
11546 TIFF_MARGIN,
11547 TIFF_RELIEF,
11548 TIFF_ALGORITHM,
11549 TIFF_HEURISTIC_MASK,
11550 TIFF_LAST
11551};
11552
11553/* Vector of image_keyword structures describing the format
11554 of valid user-defined image specifications. */
11555
11556static struct image_keyword tiff_format[TIFF_LAST] =
11557{
11558 {":type", IMAGE_SYMBOL_VALUE, 1},
11559 {":data", IMAGE_STRING_VALUE, 0},
11560 {":file", IMAGE_STRING_VALUE, 0},
11561 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
8edb0a6f 11562 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
6fc2811b 11563 {":relief", IMAGE_INTEGER_VALUE, 0},
a93f4566 11564 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6fc2811b
JR		 11565 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
11566};
11567
11568/* Structure describing the image type `tiff'. */
11569
11570static struct image_type tiff_type =
11571{
11572 &Qtiff,
11573 tiff_image_p,
11574 tiff_load,
11575 x_clear_image,
11576 NULL
11577};
11578
11579
11580/* Return non-zero if OBJECT is a valid TIFF image specification. */
11581
11582static int
11583tiff_image_p (object)
11584 Lisp_Object object;
11585{
11586 struct image_keyword fmt[TIFF_LAST];
11587 bcopy (tiff_format, fmt, sizeof fmt);
11588
11589 if (!parse_image_spec (object, fmt, TIFF_LAST, Qtiff)
11590 || (fmt[TIFF_ASCENT].count
11591 && XFASTINT (fmt[TIFF_ASCENT].value) > 100))
11592 return 0;
11593
11594 /* Must specify either the :data or :file keyword. */
11595 return fmt[TIFF_FILE].count + fmt[TIFF_DATA].count == 1;
11596}
11597
11598
11599/* Reading from a memory buffer for TIFF images Based on the PNG
11600 memory source, but we have to provide a lot of extra functions.
11601 Blah.
11602
11603 We really only need to implement read and seek, but I am not
11604 convinced that the TIFF library is smart enough not to destroy
11605 itself if we only hand it the function pointers we need to
11606 override. */
11607
11608typedef struct
11609{
11610 unsigned char *bytes;
11611 size_t len;
11612 int index;
11613}
11614tiff_memory_source;
11615
11616static size_t
11617tiff_read_from_memory (data, buf, size)
11618 thandle_t data;
11619 tdata_t buf;
11620 tsize_t size;
11621{
11622 tiff_memory_source *src = (tiff_memory_source *) data;
11623
11624 if (size > src->len - src->index)
11625 return (size_t) -1;
11626 bcopy (src->bytes + src->index, buf, size);
11627 src->index += size;
11628 return size;
11629}
11630
11631static size_t
11632tiff_write_from_memory (data, buf, size)
11633 thandle_t data;
11634 tdata_t buf;
11635 tsize_t size;
11636{
11637 return (size_t) -1;
11638}
11639
11640static toff_t
11641tiff_seek_in_memory (data, off, whence)
11642 thandle_t data;
11643 toff_t off;
11644 int whence;
11645{
11646 tiff_memory_source *src = (tiff_memory_source *) data;
11647 int idx;
11648
11649 switch (whence)
11650 {
11651 case SEEK_SET: /* Go from beginning of source. */
11652 idx = off;
11653 break;
11654
11655 case SEEK_END: /* Go from end of source. */
11656 idx = src->len + off;
11657 break;
11658
11659 case SEEK_CUR: /* Go from current position. */
11660 idx = src->index + off;
11661 break;
11662
11663 default: /* Invalid `whence'. */
11664 return -1;
11665 }
11666
11667 if (idx > src->len || idx < 0)
11668 return -1;
11669
11670 src->index = idx;
11671 return src->index;
11672}
11673
11674static int
11675tiff_close_memory (data)
11676 thandle_t data;
11677{
11678 /* NOOP */
11679 return 0;
11680}
11681
11682static int
11683tiff_mmap_memory (data, pbase, psize)
11684 thandle_t data;
11685 tdata_t *pbase;
11686 toff_t *psize;
11687{
11688 /* It is already _IN_ memory. */
11689 return 0;
11690}
11691
11692static void
11693tiff_unmap_memory (data, base, size)
11694 thandle_t data;
11695 tdata_t base;
11696 toff_t size;
11697{
11698 /* We don't need to do this. */
11699}
11700
11701static toff_t
11702tiff_size_of_memory (data)
11703 thandle_t data;
11704{
11705 return ((tiff_memory_source *) data)->len;
11706}
11707
3cf3436e
JR		 11708
11709static void
11710tiff_error_handler (title, format, ap)
11711 const char *title, *format;
11712 va_list ap;
11713{
11714 char buf[512];
11715 int len;
11716
11717 len = sprintf (buf, "TIFF error: %s ", title);
11718 vsprintf (buf + len, format, ap);
11719 add_to_log (buf, Qnil, Qnil);
11720}
11721
11722
11723static void
11724tiff_warning_handler (title, format, ap)
11725 const char *title, *format;
11726 va_list ap;
11727{
11728 char buf[512];
11729 int len;
11730
11731 len = sprintf (buf, "TIFF warning: %s ", title);
11732 vsprintf (buf + len, format, ap);
11733 add_to_log (buf, Qnil, Qnil);
11734}
11735
11736
6fc2811b
JR		 11737/* Load TIFF image IMG for use on frame F. Value is non-zero if
11738 successful. */
11739
11740static int
11741tiff_load (f, img)
11742 struct frame *f;
11743 struct image *img;
11744{
11745 Lisp_Object file, specified_file;
11746 Lisp_Object specified_data;
11747 TIFF *tiff;
11748 int width, height, x, y;
11749 uint32 *buf;
11750 int rc;
11751 XImage *ximg;
11752 struct gcpro gcpro1;
11753 tiff_memory_source memsrc;
11754
11755 specified_file = image_spec_value (img->spec, QCfile, NULL);
11756 specified_data = image_spec_value (img->spec, QCdata, NULL);
11757 file = Qnil;
11758 GCPRO1 (file);
11759
3cf3436e
JR		 11760 TIFFSetErrorHandler (tiff_error_handler);
11761 TIFFSetWarningHandler (tiff_warning_handler);
11762
6fc2811b
JR		 11763 if (NILP (specified_data))
11764 {
11765 /* Read from a file */
11766 file = x_find_image_file (specified_file);
11767 if (!STRINGP (file))
3cf3436e
JR		 11768 {
11769 image_error ("Cannot find image file `%s'", file, Qnil);
11770 UNGCPRO;
11771 return 0;
11772 }
11773
6fc2811b
JR		 11774 /* Try to open the image file. */
11775 tiff = TIFFOpen (XSTRING (file)->data, "r");
11776 if (tiff == NULL)
3cf3436e
JR		 11777 {
11778 image_error ("Cannot open `%s'", file, Qnil);
11779 UNGCPRO;
11780 return 0;
11781 }
6fc2811b
JR		 11782 }
11783 else
11784 {
11785 /* Memory source! */
11786 memsrc.bytes = XSTRING (specified_data)->data;
11787 memsrc.len = STRING_BYTES (XSTRING (specified_data));
11788 memsrc.index = 0;
11789
11790 tiff = TIFFClientOpen ("memory_source", "r", &memsrc,
11791 (TIFFReadWriteProc) tiff_read_from_memory,
11792 (TIFFReadWriteProc) tiff_write_from_memory,
11793 tiff_seek_in_memory,
11794 tiff_close_memory,
11795 tiff_size_of_memory,
11796 tiff_mmap_memory,
11797 tiff_unmap_memory);
11798
11799 if (!tiff)
11800 {
11801 image_error ("Cannot open memory source for `%s'", img->spec, Qnil);
11802 UNGCPRO;
11803 return 0;
11804 }
11805 }
11806
11807 /* Get width and height of the image, and allocate a raster buffer
11808 of width x height 32-bit values. */
11809 TIFFGetField (tiff, TIFFTAG_IMAGEWIDTH, &width);
11810 TIFFGetField (tiff, TIFFTAG_IMAGELENGTH, &height);
11811 buf = (uint32 *) xmalloc (width * height * sizeof *buf);
11812
11813 rc = TIFFReadRGBAImage (tiff, width, height, buf, 0);
11814 TIFFClose (tiff);
11815 if (!rc)
11816 {
11817 image_error ("Error reading TIFF image `%s'", img->spec, Qnil);
11818 xfree (buf);
11819 UNGCPRO;
11820 return 0;
11821 }
11822
6fc2811b
JR		 11823 /* Create the X image and pixmap. */
11824 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg, &img->pixmap))
11825 {
6fc2811b
JR		 11826 xfree (buf);
11827 UNGCPRO;
11828 return 0;
11829 }
11830
11831 /* Initialize the color table. */
11832 init_color_table ();
11833
11834 /* Process the pixel raster. Origin is in the lower-left corner. */
11835 for (y = 0; y < height; ++y)
11836 {
11837 uint32 *row = buf + y * width;
11838
11839 for (x = 0; x < width; ++x)
11840 {
11841 uint32 abgr = row[x];
11842 int r = TIFFGetR (abgr) << 8;
11843 int g = TIFFGetG (abgr) << 8;
11844 int b = TIFFGetB (abgr) << 8;
11845 XPutPixel (ximg, x, height - 1 - y, lookup_rgb_color (f, r, g, b));
11846 }
11847 }
11848
11849 /* Remember the colors allocated for the image. Free the color table. */
11850 img->colors = colors_in_color_table (&img->ncolors);
11851 free_color_table ();
11852
11853 /* Put the image into the pixmap, then free the X image and its buffer. */
11854 x_put_x_image (f, ximg, img->pixmap, width, height);
11855 x_destroy_x_image (ximg);
11856 xfree (buf);
6fc2811b
JR		 11857
11858 img->width = width;
11859 img->height = height;
11860
11861 UNGCPRO;
11862 return 1;
11863}
11864
11865#endif /* HAVE_TIFF != 0 */
11866
11867
11868\f
11869/***********************************************************************
11870 GIF
11871 ***********************************************************************/
11872
11873#if HAVE_GIF
11874
11875#include <gif_lib.h>
11876
11877static int gif_image_p P_ ((Lisp_Object object));
11878static int gif_load P_ ((struct frame *f, struct image *img));
11879
11880/* The symbol `gif' identifying images of this type. */
11881
11882Lisp_Object Qgif;
11883
11884/* Indices of image specification fields in gif_format, below. */
11885
11886enum gif_keyword_index
11887{
11888 GIF_TYPE,
11889 GIF_DATA,
11890 GIF_FILE,
11891 GIF_ASCENT,
11892 GIF_MARGIN,
11893 GIF_RELIEF,
11894 GIF_ALGORITHM,
11895 GIF_HEURISTIC_MASK,
11896 GIF_IMAGE,
11897 GIF_LAST
11898};
11899
11900/* Vector of image_keyword structures describing the format
11901 of valid user-defined image specifications. */
11902
11903static struct image_keyword gif_format[GIF_LAST] =
11904{
11905 {":type", IMAGE_SYMBOL_VALUE, 1},
11906 {":data", IMAGE_STRING_VALUE, 0},
11907 {":file", IMAGE_STRING_VALUE, 0},
11908 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
8edb0a6f 11909 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
6fc2811b 11910 {":relief", IMAGE_INTEGER_VALUE, 0},
a93f4566 11911 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6fc2811b
JR		 11912 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
11913 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0}
11914};
11915
11916/* Structure describing the image type `gif'. */
11917
11918static struct image_type gif_type =
11919{
11920 &Qgif,
11921 gif_image_p,
11922 gif_load,
11923 x_clear_image,
11924 NULL
11925};
11926
11927/* Return non-zero if OBJECT is a valid GIF image specification. */
11928
11929static int
11930gif_image_p (object)
11931 Lisp_Object object;
11932{
11933 struct image_keyword fmt[GIF_LAST];
11934 bcopy (gif_format, fmt, sizeof fmt);
11935
11936 if (!parse_image_spec (object, fmt, GIF_LAST, Qgif)
11937 || (fmt[GIF_ASCENT].count
11938 && XFASTINT (fmt[GIF_ASCENT].value) > 100))
11939 return 0;
11940
11941 /* Must specify either the :data or :file keyword. */
11942 return fmt[GIF_FILE].count + fmt[GIF_DATA].count == 1;
11943}
11944
11945/* Reading a GIF image from memory
11946 Based on the PNG memory stuff to a certain extent. */
11947
11948typedef struct
11949{
11950 unsigned char *bytes;
11951 size_t len;
11952 int index;
11953}
11954gif_memory_source;
11955
11956/* Make the current memory source available to gif_read_from_memory.
11957 It's done this way because not all versions of libungif support
11958 a UserData field in the GifFileType structure. */
11959static gif_memory_source *current_gif_memory_src;
11960
11961static int
11962gif_read_from_memory (file, buf, len)
11963 GifFileType *file;
11964 GifByteType *buf;
11965 int len;
11966{
11967 gif_memory_source *src = current_gif_memory_src;
11968
11969 if (len > src->len - src->index)
11970 return -1;
11971
11972 bcopy (src->bytes + src->index, buf, len);
11973 src->index += len;
11974 return len;
11975}
11976
11977
11978/* Load GIF image IMG for use on frame F. Value is non-zero if
11979 successful. */
11980
11981static int
11982gif_load (f, img)
11983 struct frame *f;
11984 struct image *img;
11985{
11986 Lisp_Object file, specified_file;
11987 Lisp_Object specified_data;
11988 int rc, width, height, x, y, i;
11989 XImage *ximg;
11990 ColorMapObject *gif_color_map;
11991 unsigned long pixel_colors[256];
11992 GifFileType *gif;
11993 struct gcpro gcpro1;
11994 Lisp_Object image;
11995 int ino, image_left, image_top, image_width, image_height;
11996 gif_memory_source memsrc;
11997 unsigned char *raster;
11998
11999 specified_file = image_spec_value (img->spec, QCfile, NULL);
12000 specified_data = image_spec_value (img->spec, QCdata, NULL);
12001 file = Qnil;
dfff8a69 12002 GCPRO1 (file);
6fc2811b
JR		 12003
12004 if (NILP (specified_data))
12005 {
12006 file = x_find_image_file (specified_file);
6fc2811b
JR		 12007 if (!STRINGP (file))
12008 {
12009 image_error ("Cannot find image file `%s'", specified_file, Qnil);
12010 UNGCPRO;
12011 return 0;
12012 }
12013
12014 /* Open the GIF file. */
12015 gif = DGifOpenFileName (XSTRING (file)->data);
12016 if (gif == NULL)
12017 {
12018 image_error ("Cannot open `%s'", file, Qnil);
12019 UNGCPRO;
12020 return 0;
12021 }
12022 }
12023 else
12024 {
12025 /* Read from memory! */
12026 current_gif_memory_src = &memsrc;
12027 memsrc.bytes = XSTRING (specified_data)->data;
12028 memsrc.len = STRING_BYTES (XSTRING (specified_data));
12029 memsrc.index = 0;
12030
12031 gif = DGifOpen(&memsrc, gif_read_from_memory);
12032 if (!gif)
12033 {
12034 image_error ("Cannot open memory source `%s'", img->spec, Qnil);
12035 UNGCPRO;
12036 return 0;
12037 }
12038 }
12039
12040 /* Read entire contents. */
12041 rc = DGifSlurp (gif);
12042 if (rc == GIF_ERROR)
12043 {
12044 image_error ("Error reading `%s'", img->spec, Qnil);
12045 DGifCloseFile (gif);
12046 UNGCPRO;
12047 return 0;
12048 }
12049
12050 image = image_spec_value (img->spec, QCindex, NULL);
12051 ino = INTEGERP (image) ? XFASTINT (image) : 0;
12052 if (ino >= gif->ImageCount)
12053 {
12054 image_error ("Invalid image number `%s' in image `%s'",
12055 image, img->spec);
12056 DGifCloseFile (gif);
12057 UNGCPRO;
12058 return 0;
12059 }
12060
12061 width = img->width = gif->SWidth;
12062 height = img->height = gif->SHeight;
12063
12064 BLOCK_INPUT;
12065
12066 /* Create the X image and pixmap. */
12067 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg, &img->pixmap))
12068 {
12069 UNBLOCK_INPUT;
12070 DGifCloseFile (gif);
12071 UNGCPRO;
12072 return 0;
12073 }
12074
12075 /* Allocate colors. */
12076 gif_color_map = gif->SavedImages[ino].ImageDesc.ColorMap;
12077 if (!gif_color_map)
12078 gif_color_map = gif->SColorMap;
12079 init_color_table ();
12080 bzero (pixel_colors, sizeof pixel_colors);
12081
12082 for (i = 0; i < gif_color_map->ColorCount; ++i)
12083 {
12084 int r = gif_color_map->Colors[i].Red << 8;
12085 int g = gif_color_map->Colors[i].Green << 8;
12086 int b = gif_color_map->Colors[i].Blue << 8;
12087 pixel_colors[i] = lookup_rgb_color (f, r, g, b);
12088 }
12089
12090 img->colors = colors_in_color_table (&img->ncolors);
12091 free_color_table ();
12092
12093 /* Clear the part of the screen image that are not covered by
12094 the image from the GIF file. Full animated GIF support
12095 requires more than can be done here (see the gif89 spec,
12096 disposal methods). Let's simply assume that the part
12097 not covered by a sub-image is in the frame's background color. */
12098 image_top = gif->SavedImages[ino].ImageDesc.Top;
12099 image_left = gif->SavedImages[ino].ImageDesc.Left;
12100 image_width = gif->SavedImages[ino].ImageDesc.Width;
12101 image_height = gif->SavedImages[ino].ImageDesc.Height;
12102
12103 for (y = 0; y < image_top; ++y)
12104 for (x = 0; x < width; ++x)
12105 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
12106
12107 for (y = image_top + image_height; y < height; ++y)
12108 for (x = 0; x < width; ++x)
12109 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
12110
12111 for (y = image_top; y < image_top + image_height; ++y)
12112 {
12113 for (x = 0; x < image_left; ++x)
12114 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
12115 for (x = image_left + image_width; x < width; ++x)
12116 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
12117 }
12118
12119 /* Read the GIF image into the X image. We use a local variable
12120 `raster' here because RasterBits below is a char *, and invites
12121 problems with bytes >= 0x80. */
12122 raster = (unsigned char *) gif->SavedImages[ino].RasterBits;
12123
12124 if (gif->SavedImages[ino].ImageDesc.Interlace)
12125 {
12126 static int interlace_start[] = {0, 4, 2, 1};
12127 static int interlace_increment[] = {8, 8, 4, 2};
12128 int pass, inc;
12129 int row = interlace_start[0];
12130
12131 pass = 0;
12132
12133 for (y = 0; y < image_height; y++)
12134 {
12135 if (row >= image_height)
12136 {
12137 row = interlace_start[++pass];
12138 while (row >= image_height)
12139 row = interlace_start[++pass];
12140 }
12141
12142 for (x = 0; x < image_width; x++)
12143 {
12144 int i = raster[(y * image_width) + x];
12145 XPutPixel (ximg, x + image_left, row + image_top,
12146 pixel_colors[i]);
12147 }
12148
12149 row += interlace_increment[pass];
12150 }
12151 }
12152 else
12153 {
12154 for (y = 0; y < image_height; ++y)
12155 for (x = 0; x < image_width; ++x)
12156 {
12157 int i = raster[y* image_width + x];
12158 XPutPixel (ximg, x + image_left, y + image_top, pixel_colors[i]);
12159 }
12160 }
12161
12162 DGifCloseFile (gif);
12163
12164 /* Put the image into the pixmap, then free the X image and its buffer. */
12165 x_put_x_image (f, ximg, img->pixmap, width, height);
12166 x_destroy_x_image (ximg);
12167 UNBLOCK_INPUT;
12168
12169 UNGCPRO;
12170 return 1;
12171}
12172
12173#endif /* HAVE_GIF != 0 */
12174
12175
12176\f
12177/***********************************************************************
12178 Ghostscript
12179 ***********************************************************************/
12180
3cf3436e
JR		 12181Lisp_Object Qpostscript;
12182
6fc2811b
JR		 12183#ifdef HAVE_GHOSTSCRIPT
12184static int gs_image_p P_ ((Lisp_Object object));
12185static int gs_load P_ ((struct frame *f, struct image *img));
12186static void gs_clear_image P_ ((struct frame *f, struct image *img));
12187
12188/* The symbol `postscript' identifying images of this type. */
12189
6fc2811b
JR		 12190/* Keyword symbols. */
12191
12192Lisp_Object QCloader, QCbounding_box, QCpt_width, QCpt_height;
12193
12194/* Indices of image specification fields in gs_format, below. */
12195
12196enum gs_keyword_index
12197{
12198 GS_TYPE,
12199 GS_PT_WIDTH,
12200 GS_PT_HEIGHT,
12201 GS_FILE,
12202 GS_LOADER,
12203 GS_BOUNDING_BOX,
12204 GS_ASCENT,
12205 GS_MARGIN,
12206 GS_RELIEF,
12207 GS_ALGORITHM,
12208 GS_HEURISTIC_MASK,
12209 GS_LAST
12210};
12211
12212/* Vector of image_keyword structures describing the format
12213 of valid user-defined image specifications. */
12214
12215static struct image_keyword gs_format[GS_LAST] =
12216{
12217 {":type", IMAGE_SYMBOL_VALUE, 1},
12218 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE, 1},
12219 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE, 1},
12220 {":file", IMAGE_STRING_VALUE, 1},
12221 {":loader", IMAGE_FUNCTION_VALUE, 0},
12222 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE, 1},
12223 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
8edb0a6f 12224 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
6fc2811b 12225 {":relief", IMAGE_INTEGER_VALUE, 0},
a93f4566 12226 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6fc2811b
JR		 12227 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
12228};
12229
12230/* Structure describing the image type `ghostscript'. */
12231
12232static struct image_type gs_type =
12233{
12234 &Qpostscript,
12235 gs_image_p,
12236 gs_load,
12237 gs_clear_image,
12238 NULL
12239};
12240
12241
12242/* Free X resources of Ghostscript image IMG which is used on frame F. */
12243
12244static void
12245gs_clear_image (f, img)
12246 struct frame *f;
12247 struct image *img;
12248{
12249 /* IMG->data.ptr_val may contain a recorded colormap. */
12250 xfree (img->data.ptr_val);
12251 x_clear_image (f, img);
12252}
12253
12254
12255/* Return non-zero if OBJECT is a valid Ghostscript image
12256 specification. */
12257
12258static int
12259gs_image_p (object)
12260 Lisp_Object object;
12261{
12262 struct image_keyword fmt[GS_LAST];
12263 Lisp_Object tem;
12264 int i;
12265
12266 bcopy (gs_format, fmt, sizeof fmt);
12267
12268 if (!parse_image_spec (object, fmt, GS_LAST, Qpostscript)
12269 || (fmt[GS_ASCENT].count
12270 && XFASTINT (fmt[GS_ASCENT].value) > 100))
12271 return 0;
12272
12273 /* Bounding box must be a list or vector containing 4 integers. */
12274 tem = fmt[GS_BOUNDING_BOX].value;
12275 if (CONSP (tem))
12276 {
12277 for (i = 0; i < 4; ++i, tem = XCDR (tem))
12278 if (!CONSP (tem) || !INTEGERP (XCAR (tem)))
12279 return 0;
12280 if (!NILP (tem))
12281 return 0;
12282 }
12283 else if (VECTORP (tem))
12284 {
12285 if (XVECTOR (tem)->size != 4)
12286 return 0;
12287 for (i = 0; i < 4; ++i)
12288 if (!INTEGERP (XVECTOR (tem)->contents[i]))
12289 return 0;
12290 }
12291 else
12292 return 0;
12293
12294 return 1;
12295}
12296
12297
12298/* Load Ghostscript image IMG for use on frame F. Value is non-zero
12299 if successful. */
12300
12301static int
12302gs_load (f, img)
12303 struct frame *f;
12304 struct image *img;
12305{
12306 char buffer[100];
12307 Lisp_Object window_and_pixmap_id = Qnil, loader, pt_height, pt_width;
12308 struct gcpro gcpro1, gcpro2;
12309 Lisp_Object frame;
12310 double in_width, in_height;
12311 Lisp_Object pixel_colors = Qnil;
12312
12313 /* Compute pixel size of pixmap needed from the given size in the
12314 image specification. Sizes in the specification are in pt. 1 pt
12315 = 1/72 in, xdpi and ydpi are stored in the frame's X display
12316 info. */
12317 pt_width = image_spec_value (img->spec, QCpt_width, NULL);
12318 in_width = XFASTINT (pt_width) / 72.0;
12319 img->width = in_width * FRAME_W32_DISPLAY_INFO (f)->resx;
12320 pt_height = image_spec_value (img->spec, QCpt_height, NULL);
12321 in_height = XFASTINT (pt_height) / 72.0;
12322 img->height = in_height * FRAME_W32_DISPLAY_INFO (f)->resy;
12323
12324 /* Create the pixmap. */
12325 BLOCK_INPUT;
12326 xassert (img->pixmap == 0);
12327 img->pixmap = XCreatePixmap (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
12328 img->width, img->height,
12329 DefaultDepthOfScreen (FRAME_X_SCREEN (f)));
12330 UNBLOCK_INPUT;
12331
12332 if (!img->pixmap)
12333 {
12334 image_error ("Unable to create pixmap for `%s'", img->spec, Qnil);
12335 return 0;
12336 }
12337
12338 /* Call the loader to fill the pixmap. It returns a process object
12339 if successful. We do not record_unwind_protect here because
12340 other places in redisplay like calling window scroll functions
12341 don't either. Let the Lisp loader use `unwind-protect' instead. */
12342 GCPRO2 (window_and_pixmap_id, pixel_colors);
12343
12344 sprintf (buffer, "%lu %lu",
12345 (unsigned long) FRAME_W32_WINDOW (f),
12346 (unsigned long) img->pixmap);
12347 window_and_pixmap_id = build_string (buffer);
12348
12349 sprintf (buffer, "%lu %lu",
12350 FRAME_FOREGROUND_PIXEL (f),
12351 FRAME_BACKGROUND_PIXEL (f));
12352 pixel_colors = build_string (buffer);
12353
12354 XSETFRAME (frame, f);
12355 loader = image_spec_value (img->spec, QCloader, NULL);
12356 if (NILP (loader))
12357 loader = intern ("gs-load-image");
12358
12359 img->data.lisp_val = call6 (loader, frame, img->spec,
12360 make_number (img->width),
12361 make_number (img->height),
12362 window_and_pixmap_id,
12363 pixel_colors);
12364 UNGCPRO;
12365 return PROCESSP (img->data.lisp_val);
12366}
12367
12368
12369/* Kill the Ghostscript process that was started to fill PIXMAP on
12370 frame F. Called from XTread_socket when receiving an event
12371 telling Emacs that Ghostscript has finished drawing. */
12372
12373void
12374x_kill_gs_process (pixmap, f)
12375 Pixmap pixmap;
12376 struct frame *f;
12377{
12378 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
12379 int class, i;
12380 struct image *img;
12381
12382 /* Find the image containing PIXMAP. */
12383 for (i = 0; i < c->used; ++i)
12384 if (c->images[i]->pixmap == pixmap)
12385 break;
12386
3cf3436e
JR		 12387 /* Should someone in between have cleared the image cache, for
12388 instance, give up. */
12389 if (i == c->used)
12390 return;
12391
6fc2811b
JR		 12392 /* Kill the GS process. We should have found PIXMAP in the image
12393 cache and its image should contain a process object. */
6fc2811b
JR		 12394 img = c->images[i];
12395 xassert (PROCESSP (img->data.lisp_val));
12396 Fkill_process (img->data.lisp_val, Qnil);
12397 img->data.lisp_val = Qnil;
12398
12399 /* On displays with a mutable colormap, figure out the colors
12400 allocated for the image by looking at the pixels of an XImage for
12401 img->pixmap. */
12402 class = FRAME_W32_DISPLAY_INFO (f)->visual->class;
12403 if (class != StaticColor && class != StaticGray && class != TrueColor)
12404 {
12405 XImage *ximg;
12406
12407 BLOCK_INPUT;
12408
12409 /* Try to get an XImage for img->pixmep. */
12410 ximg = XGetImage (FRAME_W32_DISPLAY (f), img->pixmap,
12411 0, 0, img->width, img->height, ~0, ZPixmap);
12412 if (ximg)
12413 {
12414 int x, y;
12415
12416 /* Initialize the color table. */
12417 init_color_table ();
12418
12419 /* For each pixel of the image, look its color up in the
12420 color table. After having done so, the color table will
12421 contain an entry for each color used by the image. */
12422 for (y = 0; y < img->height; ++y)
12423 for (x = 0; x < img->width; ++x)
12424 {
12425 unsigned long pixel = XGetPixel (ximg, x, y);
12426 lookup_pixel_color (f, pixel);
12427 }
12428
12429 /* Record colors in the image. Free color table and XImage. */
12430 img->colors = colors_in_color_table (&img->ncolors);
12431 free_color_table ();
12432 XDestroyImage (ximg);
12433
12434#if 0 /* This doesn't seem to be the case. If we free the colors
12435 here, we get a BadAccess later in x_clear_image when
12436 freeing the colors. */
12437 /* We have allocated colors once, but Ghostscript has also
12438 allocated colors on behalf of us. So, to get the
12439 reference counts right, free them once. */
12440 if (img->ncolors)
3cf3436e 12441 x_free_colors (FRAME_W32_DISPLAY (f), cmap,
6fc2811b 12442 img->colors, img->ncolors, 0);
6fc2811b
JR		 12443#endif
12444 }
12445 else
12446 image_error ("Cannot get X image of `%s'; colors will not be freed",
12447 img->spec, Qnil);
12448
12449 UNBLOCK_INPUT;
12450 }
3cf3436e
JR		 12451
12452 /* Now that we have the pixmap, compute mask and transform the
12453 image if requested. */
12454 BLOCK_INPUT;
12455 postprocess_image (f, img);
12456 UNBLOCK_INPUT;
6fc2811b
JR		 12457}
12458
12459#endif /* HAVE_GHOSTSCRIPT */
12460
12461\f
12462/***********************************************************************
12463 Window properties
12464 ***********************************************************************/
12465
12466DEFUN ("x-change-window-property", Fx_change_window_property,
12467 Sx_change_window_property, 2, 3, 0,
74e1aeec
JR		 12468 doc: /* Change window property PROP to VALUE on the X window of FRAME.
12469PROP and VALUE must be strings. FRAME nil or omitted means use the
12470selected frame. Value is VALUE. */)
6fc2811b
JR		 12471 (prop, value, frame)
12472 Lisp_Object frame, prop, value;
12473{
767b1ff0 12474#if 0 /* TODO : port window properties to W32 */
6fc2811b
JR		 12475 struct frame *f = check_x_frame (frame);
12476 Atom prop_atom;
12477
b7826503
PJ		 12478 CHECK_STRING (prop);
12479 CHECK_STRING (value);
6fc2811b
JR		 12480
12481 BLOCK_INPUT;
12482 prop_atom = XInternAtom (FRAME_W32_DISPLAY (f), XSTRING (prop)->data, False);
12483 XChangeProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
12484 prop_atom, XA_STRING, 8, PropModeReplace,
12485 XSTRING (value)->data, XSTRING (value)->size);
12486
12487 /* Make sure the property is set when we return. */
12488 XFlush (FRAME_W32_DISPLAY (f));
12489 UNBLOCK_INPUT;
12490
767b1ff0 12491#endif /* TODO */
6fc2811b
JR		 12492
12493 return value;
12494}
12495
12496
12497DEFUN ("x-delete-window-property", Fx_delete_window_property,
12498 Sx_delete_window_property, 1, 2, 0,
74e1aeec
JR		 12499 doc: /* Remove window property PROP from X window of FRAME.
12500FRAME nil or omitted means use the selected frame. Value is PROP. */)
6fc2811b
JR		 12501 (prop, frame)
12502 Lisp_Object prop, frame;
12503{
767b1ff0 12504#if 0 /* TODO : port window properties to W32 */
6fc2811b
JR		 12505
12506 struct frame *f = check_x_frame (frame);
12507 Atom prop_atom;
12508
b7826503 12509 CHECK_STRING (prop);
6fc2811b
JR		 12510 BLOCK_INPUT;
12511 prop_atom = XInternAtom (FRAME_W32_DISPLAY (f), XSTRING (prop)->data, False);
12512 XDeleteProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f), prop_atom);
12513
12514 /* Make sure the property is removed when we return. */
12515 XFlush (FRAME_W32_DISPLAY (f));
12516 UNBLOCK_INPUT;
767b1ff0 12517#endif /* TODO */
6fc2811b
JR		 12518
12519 return prop;
12520}
12521
12522
12523DEFUN ("x-window-property", Fx_window_property, Sx_window_property,
12524 1, 2, 0,
74e1aeec
JR		 12525 doc: /* Value is the value of window property PROP on FRAME.
12526If FRAME is nil or omitted, use the selected frame. Value is nil
12527if FRAME hasn't a property with name PROP or if PROP has no string
12528value. */)
6fc2811b
JR		 12529 (prop, frame)
12530 Lisp_Object prop, frame;
12531{
767b1ff0 12532#if 0 /* TODO : port window properties to W32 */
6fc2811b
JR		 12533
12534 struct frame *f = check_x_frame (frame);
12535 Atom prop_atom;
12536 int rc;
12537 Lisp_Object prop_value = Qnil;
12538 char *tmp_data = NULL;
12539 Atom actual_type;
12540 int actual_format;
12541 unsigned long actual_size, bytes_remaining;
12542
b7826503 12543 CHECK_STRING (prop);
6fc2811b
JR		 12544 BLOCK_INPUT;
12545 prop_atom = XInternAtom (FRAME_W32_DISPLAY (f), XSTRING (prop)->data, False);
12546 rc = XGetWindowProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
12547 prop_atom, 0, 0, False, XA_STRING,
12548 &actual_type, &actual_format, &actual_size,
12549 &bytes_remaining, (unsigned char **) &tmp_data);
12550 if (rc == Success)
12551 {
12552 int size = bytes_remaining;
12553
12554 XFree (tmp_data);
12555 tmp_data = NULL;
12556
12557 rc = XGetWindowProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
12558 prop_atom, 0, bytes_remaining,
12559 False, XA_STRING,
12560 &actual_type, &actual_format,
12561 &actual_size, &bytes_remaining,
12562 (unsigned char **) &tmp_data);
12563 if (rc == Success)
12564 prop_value = make_string (tmp_data, size);
12565
12566 XFree (tmp_data);
12567 }
12568
12569 UNBLOCK_INPUT;
12570
12571 return prop_value;
12572
767b1ff0 12573#endif /* TODO */
6fc2811b
JR		 12574 return Qnil;
12575}
12576
12577
12578\f
12579/***********************************************************************
12580 Busy cursor
12581 ***********************************************************************/
12582
f79e6790 12583/* If non-null, an asynchronous timer that, when it expires, displays
0af913d7 12584 an hourglass cursor on all frames. */
6fc2811b 12585
0af913d7 12586static struct atimer *hourglass_atimer;
6fc2811b 12587
0af913d7 12588/* Non-zero means an hourglass cursor is currently shown. */
6fc2811b 12589
0af913d7 12590static int hourglass_shown_p;
6fc2811b 12591
0af913d7 12592/* Number of seconds to wait before displaying an hourglass cursor. */
6fc2811b 12593
0af913d7 12594static Lisp_Object Vhourglass_delay;
6fc2811b 12595
0af913d7 12596/* Default number of seconds to wait before displaying an hourglass
f79e6790
JR		 12597 cursor. */
12598
0af913d7 12599#define DEFAULT_HOURGLASS_DELAY 1
f79e6790
JR		 12600
12601/* Function prototypes. */
12602
0af913d7
GM		 12603static void show_hourglass P_ ((struct atimer *));
12604static void hide_hourglass P_ ((void));
f79e6790
JR		 12605
12606
0af913d7 12607/* Cancel a currently active hourglass timer, and start a new one. */
f79e6790
JR		 12608
12609void
0af913d7 12610start_hourglass ()
f79e6790 12611{
767b1ff0 12612#if 0 /* TODO: cursor shape changes. */
f79e6790 12613 EMACS_TIME delay;
dfff8a69 12614 int secs, usecs = 0;
f79e6790 12615
0af913d7 12616 cancel_hourglass ();
f79e6790 12617
0af913d7
GM		 12618 if (INTEGERP (Vhourglass_delay)
12619 && XINT (Vhourglass_delay) > 0)
12620 secs = XFASTINT (Vhourglass_delay);
12621 else if (FLOATP (Vhourglass_delay)
12622 && XFLOAT_DATA (Vhourglass_delay) > 0)
dfff8a69
JR		 12623 {
12624 Lisp_Object tem;
0af913d7 12625 tem = Ftruncate (Vhourglass_delay, Qnil);
dfff8a69 12626 secs = XFASTINT (tem);
0af913d7 12627 usecs = (XFLOAT_DATA (Vhourglass_delay) - secs) * 1000000;
dfff8a69 12628 }
f79e6790 12629 else
0af913d7 12630 secs = DEFAULT_HOURGLASS_DELAY;
f79e6790 12631
dfff8a69 12632 EMACS_SET_SECS_USECS (delay, secs, usecs);
0af913d7
GM		 12633 hourglass_atimer = start_atimer (ATIMER_RELATIVE, delay,
12634 show_hourglass, NULL);
f79e6790
JR		 12635#endif
12636}
12637
12638
0af913d7
GM		 12639/* Cancel the hourglass cursor timer if active, hide an hourglass
12640 cursor if shown. */
f79e6790
JR		 12641
12642void
0af913d7 12643cancel_hourglass ()
f79e6790 12644{
0af913d7 12645 if (hourglass_atimer)
dfff8a69 12646 {
0af913d7
GM		 12647 cancel_atimer (hourglass_atimer);
12648 hourglass_atimer = NULL;
dfff8a69
JR		 12649 }
12650
0af913d7
GM		 12651 if (hourglass_shown_p)
12652 hide_hourglass ();
f79e6790
JR		 12653}
12654
12655
0af913d7
GM		 12656/* Timer function of hourglass_atimer. TIMER is equal to
12657 hourglass_atimer.
f79e6790 12658
0af913d7
GM		 12659 Display an hourglass cursor on all frames by mapping the frames'
12660 hourglass_window. Set the hourglass_p flag in the frames'
12661 output_data.x structure to indicate that an hourglass cursor is
12662 shown on the frames. */
f79e6790
JR		 12663
12664static void
0af913d7 12665show_hourglass (timer)
f79e6790 12666 struct atimer *timer;
6fc2811b 12667{
767b1ff0 12668#if 0 /* TODO: cursor shape changes. */
f79e6790 12669 /* The timer implementation will cancel this timer automatically
0af913d7 12670 after this function has run. Set hourglass_atimer to null
f79e6790 12671 so that we know the timer doesn't have to be canceled. */
0af913d7 12672 hourglass_atimer = NULL;
f79e6790 12673
0af913d7 12674 if (!hourglass_shown_p)
6fc2811b
JR		 12675 {
12676 Lisp_Object rest, frame;
f79e6790
JR		 12677
12678 BLOCK_INPUT;
12679
6fc2811b 12680 FOR_EACH_FRAME (rest, frame)
dc220243 12681 if (FRAME_W32_P (XFRAME (frame)))
6fc2811b
JR		 12682 {
12683 struct frame *f = XFRAME (frame);
f79e6790 12684
0af913d7 12685 f->output_data.w32->hourglass_p = 1;
f79e6790 12686
0af913d7 12687 if (!f->output_data.w32->hourglass_window)
6fc2811b
JR		 12688 {
12689 unsigned long mask = CWCursor;
12690 XSetWindowAttributes attrs;
f79e6790 12691
0af913d7 12692 attrs.cursor = f->output_data.w32->hourglass_cursor;
f79e6790 12693
0af913d7 12694 f->output_data.w32->hourglass_window
f79e6790 12695 = XCreateWindow (FRAME_X_DISPLAY (f),
6fc2811b
JR		 12696 FRAME_OUTER_WINDOW (f),
12697 0, 0, 32000, 32000, 0, 0,
f79e6790
JR		 12698 InputOnly,
12699 CopyFromParent,
6fc2811b
JR		 12700 mask, &attrs);
12701 }
f79e6790 12702
0af913d7
GM		 12703 XMapRaised (FRAME_X_DISPLAY (f),
12704 f->output_data.w32->hourglass_window);
f79e6790 12705 XFlush (FRAME_X_DISPLAY (f));
6fc2811b 12706 }
6fc2811b 12707
0af913d7 12708 hourglass_shown_p = 1;
f79e6790
JR		 12709 UNBLOCK_INPUT;
12710 }
12711#endif
6fc2811b
JR		 12712}
12713
12714
0af913d7 12715/* Hide the hourglass cursor on all frames, if it is currently shown. */
6fc2811b 12716
f79e6790 12717static void
0af913d7 12718hide_hourglass ()
f79e6790 12719{
767b1ff0 12720#if 0 /* TODO: cursor shape changes. */
0af913d7 12721 if (hourglass_shown_p)
6fc2811b 12722 {
f79e6790
JR		 12723 Lisp_Object rest, frame;
12724
12725 BLOCK_INPUT;
12726 FOR_EACH_FRAME (rest, frame)
6fc2811b 12727 {
f79e6790
JR		 12728 struct frame *f = XFRAME (frame);
12729
dc220243 12730 if (FRAME_W32_P (f)
f79e6790 12731 /* Watch out for newly created frames. */
0af913d7 12732 && f->output_data.x->hourglass_window)
f79e6790 12733 {
0af913d7
GM		 12734 XUnmapWindow (FRAME_X_DISPLAY (f),
12735 f->output_data.x->hourglass_window);
12736 /* Sync here because XTread_socket looks at the
12737 hourglass_p flag that is reset to zero below. */
f79e6790 12738 XSync (FRAME_X_DISPLAY (f), False);
0af913d7 12739 f->output_data.x->hourglass_p = 0;
f79e6790 12740 }
6fc2811b 12741 }
6fc2811b 12742
0af913d7 12743 hourglass_shown_p = 0;
f79e6790
JR		 12744 UNBLOCK_INPUT;
12745 }
12746#endif
6fc2811b
JR		 12747}
12748
12749
12750\f
12751/***********************************************************************
12752 Tool tips
12753 ***********************************************************************/
12754
12755static Lisp_Object x_create_tip_frame P_ ((struct w32_display_info *,
3cf3436e
JR		 12756 Lisp_Object, Lisp_Object));
12757static void compute_tip_xy P_ ((struct frame *, Lisp_Object, Lisp_Object,
12758 Lisp_Object, int, int, int *, int *));
6fc2811b 12759
3cf3436e 12760/* The frame of a currently visible tooltip. */
6fc2811b 12761
937e601e 12762Lisp_Object tip_frame;
6fc2811b
JR		 12763
12764/* If non-nil, a timer started that hides the last tooltip when it
12765 fires. */
12766
12767Lisp_Object tip_timer;
12768Window tip_window;
12769
3cf3436e
JR		 12770/* If non-nil, a vector of 3 elements containing the last args
12771 with which x-show-tip was called. See there. */
12772
12773Lisp_Object last_show_tip_args;
12774
12775/* Maximum size for tooltips; a cons (COLUMNS . ROWS). */
12776
12777Lisp_Object Vx_max_tooltip_size;
12778
12779
937e601e
AI		 12780static Lisp_Object
12781unwind_create_tip_frame (frame)
12782 Lisp_Object frame;
12783{
c844a81a
GM		 12784 Lisp_Object deleted;
12785
12786 deleted = unwind_create_frame (frame);
12787 if (EQ (deleted, Qt))
12788 {
12789 tip_window = NULL;
12790 tip_frame = Qnil;
12791 }
12792
12793 return deleted;
937e601e
AI		 12794}
12795
12796
6fc2811b 12797/* Create a frame for a tooltip on the display described by DPYINFO.
3cf3436e
JR		 12798 PARMS is a list of frame parameters. TEXT is the string to
12799 display in the tip frame. Value is the frame.
937e601e
AI		 12800
12801 Note that functions called here, esp. x_default_parameter can
12802 signal errors, for instance when a specified color name is
12803 undefined. We have to make sure that we're in a consistent state
12804 when this happens. */
6fc2811b
JR		 12805
12806static Lisp_Object
3cf3436e 12807x_create_tip_frame (dpyinfo, parms, text)
6fc2811b 12808 struct w32_display_info *dpyinfo;
3cf3436e 12809 Lisp_Object parms, text;
6fc2811b 12810{
767b1ff0 12811#if 0 /* TODO : w32 version */
6fc2811b
JR		 12812 struct frame *f;
12813 Lisp_Object frame, tem;
12814 Lisp_Object name;
12815 long window_prompting = 0;
12816 int width, height;
dc220243 12817 int count = BINDING_STACK_SIZE ();
6fc2811b
JR		 12818 struct gcpro gcpro1, gcpro2, gcpro3;
12819 struct kboard *kb;
3cf3436e
JR		 12820 int face_change_count_before = face_change_count;
12821 Lisp_Object buffer;
12822 struct buffer *old_buffer;
6fc2811b
JR		 12823
12824 check_x ();
12825
12826 /* Use this general default value to start with until we know if
12827 this frame has a specified name. */
12828 Vx_resource_name = Vinvocation_name;
12829
12830#ifdef MULTI_KBOARD
12831 kb = dpyinfo->kboard;
12832#else
12833 kb = &the_only_kboard;
12834#endif
12835
12836 /* Get the name of the frame to use for resource lookup. */
12837 name = w32_get_arg (parms, Qname, "name", "Name", RES_TYPE_STRING);
12838 if (!STRINGP (name)
12839 && !EQ (name, Qunbound)
12840 && !NILP (name))
12841 error ("Invalid frame name--not a string or nil");
12842 Vx_resource_name = name;
12843
12844 frame = Qnil;
12845 GCPRO3 (parms, name, frame);
937e601e 12846 f = make_frame (1);
6fc2811b 12847 XSETFRAME (frame, f);
3cf3436e
JR		 12848
12849 buffer = Fget_buffer_create (build_string (" *tip*"));
12850 Fset_window_buffer (FRAME_ROOT_WINDOW (f), buffer);
12851 old_buffer = current_buffer;
12852 set_buffer_internal_1 (XBUFFER (buffer));
12853 current_buffer->truncate_lines = Qnil;
12854 Ferase_buffer ();
12855 Finsert (1, &text);
12856 set_buffer_internal_1 (old_buffer);
12857
6fc2811b 12858 FRAME_CAN_HAVE_SCROLL_BARS (f) = 0;
937e601e 12859 record_unwind_protect (unwind_create_tip_frame, frame);
6fc2811b 12860
3cf3436e
JR		 12861 /* By setting the output method, we're essentially saying that
12862 the frame is live, as per FRAME_LIVE_P. If we get a signal
12863 from this point on, x_destroy_window might screw up reference
12864 counts etc. */
d88c567c 12865 f->output_method = output_w32;
6fc2811b
JR		 12866 f->output_data.w32 =
12867 (struct w32_output *) xmalloc (sizeof (struct w32_output));
12868 bzero (f->output_data.w32, sizeof (struct w32_output));
12869#if 0
12870 f->output_data.w32->icon_bitmap = -1;
12871#endif
12872 f->output_data.w32->fontset = -1;
12873 f->icon_name = Qnil;
12874
937e601e
AI		 12875#ifdef GLYPH_DEBUG
12876 image_cache_refcount = FRAME_X_IMAGE_CACHE (f)->refcount;
12877 dpyinfo_refcount = dpyinfo->reference_count;
12878#endif /* GLYPH_DEBUG */
6fc2811b
JR		 12879#ifdef MULTI_KBOARD
12880 FRAME_KBOARD (f) = kb;
12881#endif
12882 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
12883 f->output_data.w32->explicit_parent = 0;
12884
12885 /* Set the name; the functions to which we pass f expect the name to
12886 be set. */
12887 if (EQ (name, Qunbound) || NILP (name))
12888 {
12889 f->name = build_string (dpyinfo->x_id_name);
12890 f->explicit_name = 0;
12891 }
12892 else
12893 {
12894 f->name = name;
12895 f->explicit_name = 1;
12896 /* use the frame's title when getting resources for this frame. */
12897 specbind (Qx_resource_name, name);
12898 }
12899
6fc2811b
JR		 12900 /* Extract the window parameters from the supplied values
12901 that are needed to determine window geometry. */
12902 {
12903 Lisp_Object font;
12904
12905 font = w32_get_arg (parms, Qfont, "font", "Font", RES_TYPE_STRING);
12906
12907 BLOCK_INPUT;
12908 /* First, try whatever font the caller has specified. */
12909 if (STRINGP (font))
12910 {
12911 tem = Fquery_fontset (font, Qnil);
12912 if (STRINGP (tem))
12913 font = x_new_fontset (f, XSTRING (tem)->data);
12914 else
12915 font = x_new_font (f, XSTRING (font)->data);
12916 }
12917
12918 /* Try out a font which we hope has bold and italic variations. */
12919 if (!STRINGP (font))
e39649be 12920 font = x_new_font (f, "-*-courier new-normal-r-*-*-*-100-*-*-*-*-iso8859-1");
6fc2811b
JR		 12921 if (!STRINGP (font))
12922 font = x_new_font (f, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
12923 if (! STRINGP (font))
12924 font = x_new_font (f, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
12925 if (! STRINGP (font))
12926 /* This was formerly the first thing tried, but it finds too many fonts
12927 and takes too long. */
12928 font = x_new_font (f, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
12929 /* If those didn't work, look for something which will at least work. */
12930 if (! STRINGP (font))
12931 font = x_new_font (f, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
12932 UNBLOCK_INPUT;
12933 if (! STRINGP (font))
12934 font = build_string ("fixed");
12935
12936 x_default_parameter (f, parms, Qfont, font,
12937 "font", "Font", RES_TYPE_STRING);
12938 }
12939
12940 x_default_parameter (f, parms, Qborder_width, make_number (2),
12941 "borderWidth", "BorderWidth", RES_TYPE_NUMBER);
12942
12943 /* This defaults to 2 in order to match xterm. We recognize either
12944 internalBorderWidth or internalBorder (which is what xterm calls
12945 it). */
12946 if (NILP (Fassq (Qinternal_border_width, parms)))
12947 {
12948 Lisp_Object value;
12949
12950 value = w32_get_arg (parms, Qinternal_border_width,
12951 "internalBorder", "internalBorder", RES_TYPE_NUMBER);
12952 if (! EQ (value, Qunbound))
12953 parms = Fcons (Fcons (Qinternal_border_width, value),
12954 parms);
12955 }
12956
12957 x_default_parameter (f, parms, Qinternal_border_width, make_number (1),
12958 "internalBorderWidth", "internalBorderWidth",
12959 RES_TYPE_NUMBER);
12960
12961 /* Also do the stuff which must be set before the window exists. */
12962 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
12963 "foreground", "Foreground", RES_TYPE_STRING);
12964 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
12965 "background", "Background", RES_TYPE_STRING);
12966 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
12967 "pointerColor", "Foreground", RES_TYPE_STRING);
12968 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
12969 "cursorColor", "Foreground", RES_TYPE_STRING);
12970 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
12971 "borderColor", "BorderColor", RES_TYPE_STRING);
12972
12973 /* Init faces before x_default_parameter is called for scroll-bar
12974 parameters because that function calls x_set_scroll_bar_width,
12975 which calls change_frame_size, which calls Fset_window_buffer,
12976 which runs hooks, which call Fvertical_motion. At the end, we
12977 end up in init_iterator with a null face cache, which should not
12978 happen. */
12979 init_frame_faces (f);
12980
12981 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
12982 window_prompting = x_figure_window_size (f, parms);
12983
12984 if (window_prompting & XNegative)
12985 {
12986 if (window_prompting & YNegative)
12987 f->output_data.w32->win_gravity = SouthEastGravity;
12988 else
12989 f->output_data.w32->win_gravity = NorthEastGravity;
12990 }
12991 else
12992 {
12993 if (window_prompting & YNegative)
12994 f->output_data.w32->win_gravity = SouthWestGravity;
12995 else
12996 f->output_data.w32->win_gravity = NorthWestGravity;
12997 }
12998
12999 f->output_data.w32->size_hint_flags = window_prompting;
13000 {
13001 XSetWindowAttributes attrs;
13002 unsigned long mask;
13003
13004 BLOCK_INPUT;
3cf3436e
JR		 13005 mask = CWBackPixel | CWOverrideRedirect | CWEventMask;
13006 if (DoesSaveUnders (dpyinfo->screen))
13007 mask |= CWSaveUnder;
13008
6fc2811b
JR		 13009 /* Window managers looks at the override-redirect flag to
13010 determine whether or net to give windows a decoration (Xlib
13011 3.2.8). */
13012 attrs.override_redirect = True;
13013 attrs.save_under = True;
13014 attrs.background_pixel = FRAME_BACKGROUND_PIXEL (f);
13015 /* Arrange for getting MapNotify and UnmapNotify events. */
13016 attrs.event_mask = StructureNotifyMask;
13017 tip_window
13018 = FRAME_W32_WINDOW (f)
13019 = XCreateWindow (FRAME_W32_DISPLAY (f),
13020 FRAME_W32_DISPLAY_INFO (f)->root_window,
13021 /* x, y, width, height */
13022 0, 0, 1, 1,
13023 /* Border. */
13024 1,
13025 CopyFromParent, InputOutput, CopyFromParent,
13026 mask, &attrs);
13027 UNBLOCK_INPUT;
13028 }
13029
13030 x_make_gc (f);
13031
13032 x_default_parameter (f, parms, Qauto_raise, Qnil,
13033 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
13034 x_default_parameter (f, parms, Qauto_lower, Qnil,
13035 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
13036 x_default_parameter (f, parms, Qcursor_type, Qbox,
13037 "cursorType", "CursorType", RES_TYPE_SYMBOL);
13038
13039 /* Dimensions, especially f->height, must be done via change_frame_size.
13040 Change will not be effected unless different from the current
13041 f->height. */
13042 width = f->width;
13043 height = f->height;
13044 f->height = 0;
13045 SET_FRAME_WIDTH (f, 0);
13046 change_frame_size (f, height, width, 1, 0, 0);
13047
3cf3436e
JR		 13048 /* Set up faces after all frame parameters are known. This call
13049 also merges in face attributes specified for new frames.
13050
13051 Frame parameters may be changed if .Xdefaults contains
13052 specifications for the default font. For example, if there is an
13053 `Emacs.default.attributeBackground: pink', the `background-color'
13054 attribute of the frame get's set, which let's the internal border
13055 of the tooltip frame appear in pink. Prevent this. */
13056 {
13057 Lisp_Object bg = Fframe_parameter (frame, Qbackground_color);
13058
13059 /* Set tip_frame here, so that */
13060 tip_frame = frame;
13061 call1 (Qface_set_after_frame_default, frame);
13062
13063 if (!EQ (bg, Fframe_parameter (frame, Qbackground_color)))
13064 Fmodify_frame_parameters (frame, Fcons (Fcons (Qbackground_color, bg),
13065 Qnil));
13066 }
13067
6fc2811b
JR		 13068 f->no_split = 1;
13069
13070 UNGCPRO;
13071
13072 /* It is now ok to make the frame official even if we get an error
13073 below. And the frame needs to be on Vframe_list or making it
13074 visible won't work. */
13075 Vframe_list = Fcons (frame, Vframe_list);
13076
13077 /* Now that the frame is official, it counts as a reference to
13078 its display. */
13079 FRAME_W32_DISPLAY_INFO (f)->reference_count++;
ee78dc32 13080
3cf3436e
JR		 13081 /* Setting attributes of faces of the tooltip frame from resources
13082 and similar will increment face_change_count, which leads to the
13083 clearing of all current matrices. Since this isn't necessary
13084 here, avoid it by resetting face_change_count to the value it
13085 had before we created the tip frame. */
13086 face_change_count = face_change_count_before;
13087
13088 /* Discard the unwind_protect. */
6fc2811b 13089 return unbind_to (count, frame);
767b1ff0 13090#endif /* TODO */
6fc2811b 13091 return Qnil;
ee78dc32
GV		 13092}
13093
3cf3436e
JR		 13094
13095/* Compute where to display tip frame F. PARMS is the list of frame
13096 parameters for F. DX and DY are specified offsets from the current
13097 location of the mouse. WIDTH and HEIGHT are the width and height
13098 of the tooltip. Return coordinates relative to the root window of
13099 the display in *ROOT_X, and *ROOT_Y. */
13100
13101static void
13102compute_tip_xy (f, parms, dx, dy, width, height, root_x, root_y)
13103 struct frame *f;
13104 Lisp_Object parms, dx, dy;
13105 int width, height;
13106 int *root_x, *root_y;
13107{
13108#ifdef TODO /* Tool tips not supported. */
13109 Lisp_Object left, top;
13110 int win_x, win_y;
13111 Window root, child;
13112 unsigned pmask;
13113
13114 /* User-specified position? */
13115 left = Fcdr (Fassq (Qleft, parms));
13116 top = Fcdr (Fassq (Qtop, parms));
13117
13118 /* Move the tooltip window where the mouse pointer is. Resize and
13119 show it. */
13120 if (!INTEGERP (left) && !INTEGERP (top))
13121 {
13122 BLOCK_INPUT;
13123 XQueryPointer (FRAME_X_DISPLAY (f), FRAME_X_DISPLAY_INFO (f)->root_window,
13124 &root, &child, root_x, root_y, &win_x, &win_y, &pmask);
13125 UNBLOCK_INPUT;
13126 }
13127
13128 if (INTEGERP (top))
13129 *root_y = XINT (top);
13130 else if (*root_y + XINT (dy) - height < 0)
13131 *root_y -= XINT (dy);
13132 else
13133 {
13134 *root_y -= height;
13135 *root_y += XINT (dy);
13136 }
13137
13138 if (INTEGERP (left))
13139 *root_x = XINT (left);
13140 else if (*root_x + XINT (dx) + width > FRAME_X_DISPLAY_INFO (f)->width)
13141 *root_x -= width + XINT (dx);
13142 else
13143 *root_x += XINT (dx);
13144
13145#endif /* Tooltip support. */
13146}
13147
13148
767b1ff0 13149#ifdef TODO /* Tooltip support not complete. */
71eab8d1 13150DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
74e1aeec
JR		 13151 doc: /* Show STRING in a \"tooltip\" window on frame FRAME.
13152A tooltip window is a small window displaying a string.
13153
13154FRAME nil or omitted means use the selected frame.
13155
13156PARMS is an optional list of frame parameters which can be
13157used to change the tooltip's appearance.
13158
13159Automatically hide the tooltip after TIMEOUT seconds.
13160TIMEOUT nil means use the default timeout of 5 seconds.
13161
13162If the list of frame parameters PARAMS contains a `left' parameters,
13163the tooltip is displayed at that x-position. Otherwise it is
13164displayed at the mouse position, with offset DX added (default is 5 if
13165DX isn't specified). Likewise for the y-position; if a `top' frame
13166parameter is specified, it determines the y-position of the tooltip
13167window, otherwise it is displayed at the mouse position, with offset
13168DY added (default is -10).
13169
13170A tooltip's maximum size is specified by `x-max-tooltip-size'.
13171Text larger than the specified size is clipped. */)
71eab8d1
AI		 13172 (string, frame, parms, timeout, dx, dy)
13173 Lisp_Object string, frame, parms, timeout, dx, dy;
ee78dc32 13174{
6fc2811b
JR		 13175 struct frame *f;
13176 struct window *w;
3cf3436e
JR		 13177 Lisp_Object buffer, top, left, max_width, max_height;
13178 int root_x, root_y;
6fc2811b
JR		 13179 struct buffer *old_buffer;
13180 struct text_pos pos;
13181 int i, width, height;
6fc2811b
JR		 13182 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
13183 int old_windows_or_buffers_changed = windows_or_buffers_changed;
13184 int count = specpdl_ptr - specpdl;
13185
13186 specbind (Qinhibit_redisplay, Qt);
ee78dc32 13187
dfff8a69 13188 GCPRO4 (string, parms, frame, timeout);
ee78dc32 13189
b7826503 13190 CHECK_STRING (string);
6fc2811b
JR		 13191 f = check_x_frame (frame);
13192 if (NILP (timeout))
13193 timeout = make_number (5);
13194 else
b7826503 13195 CHECK_NATNUM (timeout);
ee78dc32 13196
71eab8d1
AI		 13197 if (NILP (dx))
13198 dx = make_number (5);
13199 else
b7826503 13200 CHECK_NUMBER (dx);
71eab8d1
AI		 13201
13202 if (NILP (dy))
dc220243 13203 dy = make_number (-10);
71eab8d1 13204 else
b7826503 13205 CHECK_NUMBER (dy);
71eab8d1 13206
dc220243
JR		 13207 if (NILP (last_show_tip_args))
13208 last_show_tip_args = Fmake_vector (make_number (3), Qnil);
13209
13210 if (!NILP (tip_frame))
13211 {
13212 Lisp_Object last_string = AREF (last_show_tip_args, 0);
13213 Lisp_Object last_frame = AREF (last_show_tip_args, 1);
13214 Lisp_Object last_parms = AREF (last_show_tip_args, 2);
13215
13216 if (EQ (frame, last_frame)
13217 && !NILP (Fequal (last_string, string))
13218 && !NILP (Fequal (last_parms, parms)))
13219 {
13220 struct frame *f = XFRAME (tip_frame);
13221
13222 /* Only DX and DY have changed. */
13223 if (!NILP (tip_timer))
13224 {
13225 Lisp_Object timer = tip_timer;
13226 tip_timer = Qnil;
13227 call1 (Qcancel_timer, timer);
13228 }
13229
13230 BLOCK_INPUT;
13231 compute_tip_xy (f, parms, dx, dy, &root_x, &root_y);
13232 XMoveWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
13233 root_x, root_y - PIXEL_HEIGHT (f));
13234 UNBLOCK_INPUT;
13235 goto start_timer;
13236 }
13237 }
13238
6fc2811b
JR		 13239 /* Hide a previous tip, if any. */
13240 Fx_hide_tip ();
ee78dc32 13241
dc220243
JR		 13242 ASET (last_show_tip_args, 0, string);
13243 ASET (last_show_tip_args, 1, frame);
13244 ASET (last_show_tip_args, 2, parms);
13245
6fc2811b
JR		 13246 /* Add default values to frame parameters. */
13247 if (NILP (Fassq (Qname, parms)))
13248 parms = Fcons (Fcons (Qname, build_string ("tooltip")), parms);
13249 if (NILP (Fassq (Qinternal_border_width, parms)))
13250 parms = Fcons (Fcons (Qinternal_border_width, make_number (3)), parms);
13251 if (NILP (Fassq (Qborder_width, parms)))
13252 parms = Fcons (Fcons (Qborder_width, make_number (1)), parms);
13253 if (NILP (Fassq (Qborder_color, parms)))
13254 parms = Fcons (Fcons (Qborder_color, build_string ("lightyellow")), parms);
13255 if (NILP (Fassq (Qbackground_color, parms)))
13256 parms = Fcons (Fcons (Qbackground_color, build_string ("lightyellow")),
13257 parms);
13258
13259 /* Create a frame for the tooltip, and record it in the global
13260 variable tip_frame. */
13261 frame = x_create_tip_frame (FRAME_W32_DISPLAY_INFO (f), parms);
937e601e 13262 f = XFRAME (frame);
6fc2811b 13263
3cf3436e 13264 /* Set up the frame's root window. */
6fc2811b
JR		 13265 w = XWINDOW (FRAME_ROOT_WINDOW (f));
13266 w->left = w->top = make_number (0);
3cf3436e
JR		 13267
13268 if (CONSP (Vx_max_tooltip_size)
13269 && INTEGERP (XCAR (Vx_max_tooltip_size))
13270 && XINT (XCAR (Vx_max_tooltip_size)) > 0
13271 && INTEGERP (XCDR (Vx_max_tooltip_size))
13272 && XINT (XCDR (Vx_max_tooltip_size)) > 0)
13273 {
13274 w->width = XCAR (Vx_max_tooltip_size);
13275 w->height = XCDR (Vx_max_tooltip_size);
13276 }
13277 else
13278 {
13279 w->width = make_number (80);
13280 w->height = make_number (40);
13281 }
13282
13283 f->window_width = XINT (w->width);
6fc2811b
JR		 13284 adjust_glyphs (f);
13285 w->pseudo_window_p = 1;
13286
13287 /* Display the tooltip text in a temporary buffer. */
6fc2811b 13288 old_buffer = current_buffer;
3cf3436e
JR		 13289 set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f))->buffer));
13290 current_buffer->truncate_lines = Qnil;
6fc2811b
JR		 13291 clear_glyph_matrix (w->desired_matrix);
13292 clear_glyph_matrix (w->current_matrix);
13293 SET_TEXT_POS (pos, BEGV, BEGV_BYTE);
13294 try_window (FRAME_ROOT_WINDOW (f), pos);
13295
13296 /* Compute width and height of the tooltip. */
13297 width = height = 0;
13298 for (i = 0; i < w->desired_matrix->nrows; ++i)
ee78dc32 13299 {
6fc2811b
JR		 13300 struct glyph_row *row = &w->desired_matrix->rows[i];
13301 struct glyph *last;
13302 int row_width;
13303
13304 /* Stop at the first empty row at the end. */
13305 if (!row->enabled_p || !row->displays_text_p)
13306 break;
13307
13308 /* Let the row go over the full width of the frame. */
13309 row->full_width_p = 1;
13310
13311 /* There's a glyph at the end of rows that is use to place
13312 the cursor there. Don't include the width of this glyph. */
13313 if (row->used[TEXT_AREA])
13314 {
13315 last = &row->glyphs[TEXT_AREA][row->used[TEXT_AREA] - 1];
13316 row_width = row->pixel_width - last->pixel_width;
13317 }
13318 else
13319 row_width = row->pixel_width;
13320
13321 height += row->height;
13322 width = max (width, row_width);
ee78dc32
GV		 13323 }
13324
6fc2811b
JR		 13325 /* Add the frame's internal border to the width and height the X
13326 window should have. */
13327 height += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
13328 width += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
ee78dc32 13329
6fc2811b
JR		 13330 /* Move the tooltip window where the mouse pointer is. Resize and
13331 show it. */
3cf3436e 13332 compute_tip_xy (f, parms, dx, dy, width, height, &root_x, &root_y);
71eab8d1 13333
71eab8d1
AI		 13334 BLOCK_INPUT;
13335 XMoveResizeWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
13336 root_x, root_y - height, width, height);
13337 XMapRaised (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f));
6fc2811b 13338 UNBLOCK_INPUT;
ee78dc32 13339
6fc2811b
JR		 13340 /* Draw into the window. */
13341 w->must_be_updated_p = 1;
13342 update_single_window (w, 1);
ee78dc32 13343
6fc2811b
JR		 13344 /* Restore original current buffer. */
13345 set_buffer_internal_1 (old_buffer);
13346 windows_or_buffers_changed = old_windows_or_buffers_changed;
ee78dc32 13347
dc220243 13348 start_timer:
6fc2811b
JR		 13349 /* Let the tip disappear after timeout seconds. */
13350 tip_timer = call3 (intern ("run-at-time"), timeout, Qnil,
13351 intern ("x-hide-tip"));
ee78dc32 13352
dfff8a69 13353 UNGCPRO;
6fc2811b 13354 return unbind_to (count, Qnil);
ee78dc32
GV		 13355}
13356
ee78dc32 13357
6fc2811b 13358DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0,
74e1aeec
JR		 13359 doc: /* Hide the current tooltip window, if there is any.
13360Value is t if tooltip was open, nil otherwise. */)
6fc2811b
JR		 13361 ()
13362{
937e601e
AI		 13363 int count;
13364 Lisp_Object deleted, frame, timer;
13365 struct gcpro gcpro1, gcpro2;
13366
13367 /* Return quickly if nothing to do. */
13368 if (NILP (tip_timer) && NILP (tip_frame))
13369 return Qnil;
13370
13371 frame = tip_frame;
13372 timer = tip_timer;
13373 GCPRO2 (frame, timer);
13374 tip_frame = tip_timer = deleted = Qnil;
6fc2811b 13375
937e601e 13376 count = BINDING_STACK_SIZE ();
6fc2811b 13377 specbind (Qinhibit_redisplay, Qt);
937e601e 13378 specbind (Qinhibit_quit, Qt);
6fc2811b 13379
937e601e 13380 if (!NILP (timer))
dc220243 13381 call1 (Qcancel_timer, timer);
ee78dc32 13382
937e601e 13383 if (FRAMEP (frame))
6fc2811b 13384 {
937e601e
AI		 13385 Fdelete_frame (frame, Qnil);
13386 deleted = Qt;
6fc2811b 13387 }
1edf84e7 13388
937e601e
AI		 13389 UNGCPRO;
13390 return unbind_to (count, deleted);
6fc2811b 13391}
767b1ff0 13392#endif
5ac45f98 13393
5ac45f98 13394
6fc2811b
JR		 13395\f
13396/***********************************************************************
13397 File selection dialog
13398 ***********************************************************************/
13399
13400extern Lisp_Object Qfile_name_history;
13401
13402DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 4, 0,
74e1aeec
JR		 13403 doc: /* Read file name, prompting with PROMPT in directory DIR.
13404Use a file selection dialog.
13405Select DEFAULT-FILENAME in the dialog's file selection box, if
13406specified. Ensure that file exists if MUSTMATCH is non-nil. */)
6fc2811b
JR		 13407 (prompt, dir, default_filename, mustmatch)
13408 Lisp_Object prompt, dir, default_filename, mustmatch;
13409{
13410 struct frame *f = SELECTED_FRAME ();
13411 Lisp_Object file = Qnil;
13412 int count = specpdl_ptr - specpdl;
13413 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
13414 char filename[MAX_PATH + 1];
13415 char init_dir[MAX_PATH + 1];
13416 int use_dialog_p = 1;
13417
13418 GCPRO5 (prompt, dir, default_filename, mustmatch, file);
b7826503
PJ		 13419 CHECK_STRING (prompt);
13420 CHECK_STRING (dir);
6fc2811b
JR		 13421
13422 /* Create the dialog with PROMPT as title, using DIR as initial
13423 directory and using "*" as pattern. */
13424 dir = Fexpand_file_name (dir, Qnil);
13425 strncpy (init_dir, XSTRING (dir)->data, MAX_PATH);
13426 init_dir[MAX_PATH] = '\0';
13427 unixtodos_filename (init_dir);
13428
13429 if (STRINGP (default_filename))
13430 {
13431 char *file_name_only;
13432 char *full_path_name = XSTRING (default_filename)->data;
5ac45f98 13433
6fc2811b 13434 unixtodos_filename (full_path_name);
5ac45f98 13435
6fc2811b
JR		 13436 file_name_only = strrchr (full_path_name, '\\');
13437 if (!file_name_only)
13438 file_name_only = full_path_name;
13439 else
13440 {
13441 file_name_only++;
5ac45f98 13442
6fc2811b
JR		 13443 /* If default_file_name is a directory, don't use the open
13444 file dialog, as it does not support selecting
13445 directories. */
13446 if (!(*file_name_only))
13447 use_dialog_p = 0;
13448 }
ee78dc32 13449
6fc2811b
JR		 13450 strncpy (filename, file_name_only, MAX_PATH);
13451 filename[MAX_PATH] = '\0';
13452 }
ee78dc32 13453 else
6fc2811b 13454 filename[0] = '\0';
ee78dc32 13455
6fc2811b
JR		 13456 if (use_dialog_p)
13457 {
13458 OPENFILENAME file_details;
5ac45f98 13459
6fc2811b
JR		 13460 /* Prevent redisplay. */
13461 specbind (Qinhibit_redisplay, Qt);
13462 BLOCK_INPUT;
ee78dc32 13463
6fc2811b
JR		 13464 bzero (&file_details, sizeof (file_details));
13465 file_details.lStructSize = sizeof (file_details);
13466 file_details.hwndOwner = FRAME_W32_WINDOW (f);
3cf3436e
JR		 13467 /* Undocumented Bug in Common File Dialog:
13468 If a filter is not specified, shell links are not resolved. */
13469 file_details.lpstrFilter = "ALL Files (*.*)\0*.*\0\0";
6fc2811b
JR		 13470 file_details.lpstrFile = filename;
13471 file_details.nMaxFile = sizeof (filename);
13472 file_details.lpstrInitialDir = init_dir;
13473 file_details.lpstrTitle = XSTRING (prompt)->data;
13474 file_details.Flags = OFN_HIDEREADONLY | OFN_NOCHANGEDIR;
ee78dc32 13475
6fc2811b
JR		 13476 if (!NILP (mustmatch))
13477 file_details.Flags |= OFN_FILEMUSTEXIST | OFN_PATHMUSTEXIST;
ee78dc32 13478
6fc2811b
JR		 13479 if (GetOpenFileName (&file_details))
13480 {
13481 dostounix_filename (filename);
13482 file = build_string (filename);
13483 }
ee78dc32 13484 else
6fc2811b
JR		 13485 file = Qnil;
13486
13487 UNBLOCK_INPUT;
13488 file = unbind_to (count, file);
ee78dc32 13489 }
6fc2811b
JR		 13490 /* Open File dialog will not allow folders to be selected, so resort
13491 to minibuffer completing reads for directories. */
13492 else
13493 file = Fcompleting_read (prompt, intern ("read-file-name-internal"),
13494 dir, mustmatch, dir, Qfile_name_history,
13495 default_filename, Qnil);
ee78dc32 13496
6fc2811b 13497 UNGCPRO;
1edf84e7 13498
6fc2811b
JR		 13499 /* Make "Cancel" equivalent to C-g. */
13500 if (NILP (file))
13501 Fsignal (Qquit, Qnil);
ee78dc32 13502
dfff8a69 13503 return unbind_to (count, file);
6fc2811b 13504}
ee78dc32 13505
ee78dc32 13506
6fc2811b 13507\f
6fc2811b
JR		 13508/***********************************************************************
13509 w32 specialized functions
13510 ***********************************************************************/
ee78dc32 13511
fbd6baed 13512DEFUN ("w32-select-font", Fw32_select_font, Sw32_select_font, 0, 1, 0,
74e1aeec
JR		 13513 doc: /* Select a font using the W32 font dialog.
13514Returns an X font string corresponding to the selection. */)
ee78dc32
GV		 13515 (frame)
13516 Lisp_Object frame;
13517{
13518 FRAME_PTR f = check_x_frame (frame);
13519 CHOOSEFONT cf;
13520 LOGFONT lf;
f46e6225
GV		 13521 TEXTMETRIC tm;
13522 HDC hdc;
13523 HANDLE oldobj;
ee78dc32
GV		 13524 char buf[100];
13525
13526 bzero (&cf, sizeof (cf));
f46e6225 13527 bzero (&lf, sizeof (lf));
ee78dc32
GV		 13528
13529 cf.lStructSize = sizeof (cf);
fbd6baed 13530 cf.hwndOwner = FRAME_W32_WINDOW (f);
6fc2811b 13531 cf.Flags = CF_FORCEFONTEXIST | CF_SCREENFONTS;
ee78dc32
GV		 13532 cf.lpLogFont = &lf;
13533
f46e6225
GV		 13534 /* Initialize as much of the font details as we can from the current
13535 default font. */
13536 hdc = GetDC (FRAME_W32_WINDOW (f));
13537 oldobj = SelectObject (hdc, FRAME_FONT (f)->hfont);
13538 GetTextFace (hdc, LF_FACESIZE, lf.lfFaceName);
13539 if (GetTextMetrics (hdc, &tm))
13540 {
13541 lf.lfHeight = tm.tmInternalLeading - tm.tmHeight;
13542 lf.lfWeight = tm.tmWeight;
13543 lf.lfItalic = tm.tmItalic;
13544 lf.lfUnderline = tm.tmUnderlined;
13545 lf.lfStrikeOut = tm.tmStruckOut;
f46e6225
GV		 13546 lf.lfCharSet = tm.tmCharSet;
13547 cf.Flags |= CF_INITTOLOGFONTSTRUCT;
13548 }
13549 SelectObject (hdc, oldobj);
6fc2811b 13550 ReleaseDC (FRAME_W32_WINDOW (f), hdc);
f46e6225 13551
767b1ff0 13552 if (!ChooseFont (&cf) || !w32_to_x_font (&lf, buf, 100, NULL))
3c190163 13553 return Qnil;
ee78dc32
GV		 13554
13555 return build_string (buf);
13556}
13557
74e1aeec
JR		 13558DEFUN ("w32-send-sys-command", Fw32_send_sys_command,
13559 Sw32_send_sys_command, 1, 2, 0,
13560 doc: /* Send frame a Windows WM_SYSCOMMAND message of type COMMAND.
13561Some useful values for command are 0xf030 to maximise frame (0xf020
13562to minimize), 0xf120 to restore frame to original size, and 0xf100
13563to activate the menubar for keyboard access. 0xf140 activates the
13564screen saver if defined.
13565
13566If optional parameter FRAME is not specified, use selected frame. */)
1edf84e7
GV		 13567 (command, frame)
13568 Lisp_Object command, frame;
13569{
1edf84e7
GV		 13570 FRAME_PTR f = check_x_frame (frame);
13571
b7826503 13572 CHECK_NUMBER (command);
1edf84e7 13573
ce6059da 13574 PostMessage (FRAME_W32_WINDOW (f), WM_SYSCOMMAND, XINT (command), 0);
1edf84e7
GV		 13575
13576 return Qnil;
13577}
13578
55dcfc15 13579DEFUN ("w32-shell-execute", Fw32_shell_execute, Sw32_shell_execute, 2, 4, 0,
74e1aeec
JR		 13580 doc: /* Get Windows to perform OPERATION on DOCUMENT.
13581This is a wrapper around the ShellExecute system function, which
13582invokes the application registered to handle OPERATION for DOCUMENT.
13583OPERATION is typically \"open\", \"print\" or \"explore\" (but can be
13584nil for the default action), and DOCUMENT is typically the name of a
13585document file or URL, but can also be a program executable to run or
13586a directory to open in the Windows Explorer.
13587
13588If DOCUMENT is a program executable, PARAMETERS can be a string
13589containing command line parameters, but otherwise should be nil.
13590
13591SHOW-FLAG can be used to control whether the invoked application is hidden
13592or minimized. If SHOW-FLAG is nil, the application is displayed normally,
13593otherwise it is an integer representing a ShowWindow flag:
13594
13595 0 - start hidden
13596 1 - start normally
13597 3 - start maximized
13598 6 - start minimized */)
55dcfc15
AI		 13599 (operation, document, parameters, show_flag)
13600 Lisp_Object operation, document, parameters, show_flag;
13601{
13602 Lisp_Object current_dir;
13603
b7826503 13604 CHECK_STRING (document);
55dcfc15
AI		 13605
13606 /* Encode filename and current directory. */
13607 current_dir = ENCODE_FILE (current_buffer->directory);
13608 document = ENCODE_FILE (document);
13609 if ((int) ShellExecute (NULL,
6fc2811b
JR		 13610 (STRINGP (operation) ?
13611 XSTRING (operation)->data : NULL),
55dcfc15
AI		 13612 XSTRING (document)->data,
13613 (STRINGP (parameters) ?
13614 XSTRING (parameters)->data : NULL),
13615 XSTRING (current_dir)->data,
13616 (INTEGERP (show_flag) ?
13617 XINT (show_flag) : SW_SHOWDEFAULT))
13618 > 32)
13619 return Qt;
90d97e64 13620 error ("ShellExecute failed: %s", w32_strerror (0));
55dcfc15
AI		 13621}
13622
ccc2d29c
GV		 13623/* Lookup virtual keycode from string representing the name of a
13624 non-ascii keystroke into the corresponding virtual key, using
13625 lispy_function_keys. */
13626static int
13627lookup_vk_code (char *key)
13628{
13629 int i;
13630
13631 for (i = 0; i < 256; i++)
13632 if (lispy_function_keys[i] != 0
13633 && strcmp (lispy_function_keys[i], key) == 0)
13634 return i;
13635
13636 return -1;
13637}
13638
13639/* Convert a one-element vector style key sequence to a hot key
13640 definition. */
13641static int
13642w32_parse_hot_key (key)
13643 Lisp_Object key;
13644{
13645 /* Copied from Fdefine_key and store_in_keymap. */
13646 register Lisp_Object c;
13647 int vk_code;
13648 int lisp_modifiers;
13649 int w32_modifiers;
13650 struct gcpro gcpro1;
13651
b7826503 13652 CHECK_VECTOR (key);
ccc2d29c
GV		 13653
13654 if (XFASTINT (Flength (key)) != 1)
13655 return Qnil;
13656
13657 GCPRO1 (key);
13658
13659 c = Faref (key, make_number (0));
13660
13661 if (CONSP (c) && lucid_event_type_list_p (c))
13662 c = Fevent_convert_list (c);
13663
13664 UNGCPRO;
13665
13666 if (! INTEGERP (c) && ! SYMBOLP (c))
13667 error ("Key definition is invalid");
13668
13669 /* Work out the base key and the modifiers. */
13670 if (SYMBOLP (c))
13671 {
13672 c = parse_modifiers (c);
13673 lisp_modifiers = Fcar (Fcdr (c));
13674 c = Fcar (c);
13675 if (!SYMBOLP (c))
13676 abort ();
13677 vk_code = lookup_vk_code (XSYMBOL (c)->name->data);
13678 }
13679 else if (INTEGERP (c))
13680 {
13681 lisp_modifiers = XINT (c) & ~CHARACTERBITS;
13682 /* Many ascii characters are their own virtual key code. */
13683 vk_code = XINT (c) & CHARACTERBITS;
13684 }
13685
13686 if (vk_code < 0 || vk_code > 255)
13687 return Qnil;
13688
13689 if ((lisp_modifiers & meta_modifier) != 0
13690 && !NILP (Vw32_alt_is_meta))
13691 lisp_modifiers |= alt_modifier;
13692
71eab8d1
AI		 13693 /* Supply defs missing from mingw32. */
13694#ifndef MOD_ALT
13695#define MOD_ALT 0x0001
13696#define MOD_CONTROL 0x0002
13697#define MOD_SHIFT 0x0004
13698#define MOD_WIN 0x0008
13699#endif
13700
ccc2d29c
GV		 13701 /* Convert lisp modifiers to Windows hot-key form. */
13702 w32_modifiers = (lisp_modifiers & hyper_modifier) ? MOD_WIN : 0;
13703 w32_modifiers |= (lisp_modifiers & alt_modifier) ? MOD_ALT : 0;
13704 w32_modifiers |= (lisp_modifiers & ctrl_modifier) ? MOD_CONTROL : 0;
13705 w32_modifiers |= (lisp_modifiers & shift_modifier) ? MOD_SHIFT : 0;
13706
13707 return HOTKEY (vk_code, w32_modifiers);
13708}
13709
74e1aeec
JR		 13710DEFUN ("w32-register-hot-key", Fw32_register_hot_key,
13711 Sw32_register_hot_key, 1, 1, 0,
13712 doc: /* Register KEY as a hot-key combination.
13713Certain key combinations like Alt-Tab are reserved for system use on
13714Windows, and therefore are normally intercepted by the system. However,
13715most of these key combinations can be received by registering them as
13716hot-keys, overriding their special meaning.
13717
13718KEY must be a one element key definition in vector form that would be
13719acceptable to `define-key' (e.g. [A-tab] for Alt-Tab). The meta
13720modifier is interpreted as Alt if `w32-alt-is-meta' is t, and hyper
13721is always interpreted as the Windows modifier keys.
13722
13723The return value is the hotkey-id if registered, otherwise nil. */)
ccc2d29c
GV		 13724 (key)
13725 Lisp_Object key;
13726{
13727 key = w32_parse_hot_key (key);
13728
13729 if (NILP (Fmemq (key, w32_grabbed_keys)))
13730 {
13731 /* Reuse an empty slot if possible. */
13732 Lisp_Object item = Fmemq (Qnil, w32_grabbed_keys);
13733
13734 /* Safe to add new key to list, even if we have focus. */
13735 if (NILP (item))
13736 w32_grabbed_keys = Fcons (key, w32_grabbed_keys);
13737 else
f3fbd155 13738 XSETCAR (item, key);
ccc2d29c
GV		 13739
13740 /* Notify input thread about new hot-key definition, so that it
13741 takes effect without needing to switch focus. */
13742 PostThreadMessage (dwWindowsThreadId, WM_EMACS_REGISTER_HOT_KEY,
13743 (WPARAM) key, 0);
13744 }
13745
13746 return key;
13747}
13748
74e1aeec
JR		 13749DEFUN ("w32-unregister-hot-key", Fw32_unregister_hot_key,
13750 Sw32_unregister_hot_key, 1, 1, 0,
13751 doc: /* Unregister HOTKEY as a hot-key combination. */)
ccc2d29c
GV		 13752 (key)
13753 Lisp_Object key;
13754{
13755 Lisp_Object item;
13756
13757 if (!INTEGERP (key))
13758 key = w32_parse_hot_key (key);
13759
13760 item = Fmemq (key, w32_grabbed_keys);
13761
13762 if (!NILP (item))
13763 {
13764 /* Notify input thread about hot-key definition being removed, so
13765 that it takes effect without needing focus switch. */
13766 if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_UNREGISTER_HOT_KEY,
13767 (WPARAM) XINT (XCAR (item)), (LPARAM) item))
13768 {
13769 MSG msg;
13770 GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
13771 }
13772 return Qt;
13773 }
13774 return Qnil;
13775}
13776
74e1aeec
JR		 13777DEFUN ("w32-registered-hot-keys", Fw32_registered_hot_keys,
13778 Sw32_registered_hot_keys, 0, 0, 0,
13779 doc: /* Return list of registered hot-key IDs. */)
ccc2d29c
GV		 13780 ()
13781{
13782 return Fcopy_sequence (w32_grabbed_keys);
13783}
13784
74e1aeec
JR		 13785DEFUN ("w32-reconstruct-hot-key", Fw32_reconstruct_hot_key,
13786 Sw32_reconstruct_hot_key, 1, 1, 0,
13787 doc: /* Convert hot-key ID to a lisp key combination. */)
ccc2d29c
GV		 13788 (hotkeyid)
13789 Lisp_Object hotkeyid;
13790{
13791 int vk_code, w32_modifiers;
13792 Lisp_Object key;
13793
b7826503 13794 CHECK_NUMBER (hotkeyid);
ccc2d29c
GV		 13795
13796 vk_code = HOTKEY_VK_CODE (hotkeyid);
13797 w32_modifiers = HOTKEY_MODIFIERS (hotkeyid);
13798
13799 if (lispy_function_keys[vk_code])
13800 key = intern (lispy_function_keys[vk_code]);
13801 else
13802 key = make_number (vk_code);
13803
13804 key = Fcons (key, Qnil);
13805 if (w32_modifiers & MOD_SHIFT)
3ef68e6b 13806 key = Fcons (Qshift, key);
ccc2d29c 13807 if (w32_modifiers & MOD_CONTROL)
3ef68e6b 13808 key = Fcons (Qctrl, key);
ccc2d29c 13809 if (w32_modifiers & MOD_ALT)
3ef68e6b 13810 key = Fcons (NILP (Vw32_alt_is_meta) ? Qalt : Qmeta, key);
ccc2d29c 13811 if (w32_modifiers & MOD_WIN)
3ef68e6b 13812 key = Fcons (Qhyper, key);
ccc2d29c
GV		 13813
13814 return key;
13815}
adcc3809 13816
74e1aeec
JR		 13817DEFUN ("w32-toggle-lock-key", Fw32_toggle_lock_key,
13818 Sw32_toggle_lock_key, 1, 2, 0,
13819 doc: /* Toggle the state of the lock key KEY.
13820KEY can be `capslock', `kp-numlock', or `scroll'.
13821If the optional parameter NEW-STATE is a number, then the state of KEY
13822is set to off if the low bit of NEW-STATE is zero, otherwise on. */)
adcc3809
GV		 13823 (key, new_state)
13824 Lisp_Object key, new_state;
13825{
13826 int vk_code;
adcc3809
GV		 13827
13828 if (EQ (key, intern ("capslock")))
13829 vk_code = VK_CAPITAL;
13830 else if (EQ (key, intern ("kp-numlock")))
13831 vk_code = VK_NUMLOCK;
13832 else if (EQ (key, intern ("scroll")))
13833 vk_code = VK_SCROLL;
13834 else
13835 return Qnil;
13836
13837 if (!dwWindowsThreadId)
13838 return make_number (w32_console_toggle_lock_key (vk_code, new_state));
13839
13840 if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_TOGGLE_LOCK_KEY,
13841 (WPARAM) vk_code, (LPARAM) new_state))
13842 {
13843 MSG msg;
13844 GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
13845 return make_number (msg.wParam);
13846 }
13847 return Qnil;
13848}
ee78dc32 13849\f
2254bcde 13850DEFUN ("file-system-info", Ffile_system_info, Sfile_system_info, 1, 1, 0,
74e1aeec
JR		 13851 doc: /* Return storage information about the file system FILENAME is on.
13852Value is a list of floats (TOTAL FREE AVAIL), where TOTAL is the total
13853storage of the file system, FREE is the free storage, and AVAIL is the
13854storage available to a non-superuser. All 3 numbers are in bytes.
13855If the underlying system call fails, value is nil. */)
2254bcde
AI		 13856 (filename)
13857 Lisp_Object filename;
13858{
13859 Lisp_Object encoded, value;
13860
b7826503 13861 CHECK_STRING (filename);
2254bcde
AI		 13862 filename = Fexpand_file_name (filename, Qnil);
13863 encoded = ENCODE_FILE (filename);
13864
13865 value = Qnil;
13866
13867 /* Determining the required information on Windows turns out, sadly,
13868 to be more involved than one would hope. The original Win32 api
13869 call for this will return bogus information on some systems, but we
13870 must dynamically probe for the replacement api, since that was
13871 added rather late on. */
13872 {
13873 HMODULE hKernel = GetModuleHandle ("kernel32");
13874 BOOL (*pfn_GetDiskFreeSpaceEx)
13875 (char *, PULARGE_INTEGER, PULARGE_INTEGER, PULARGE_INTEGER)
13876 = (void *) GetProcAddress (hKernel, "GetDiskFreeSpaceEx");
13877
13878 /* On Windows, we may need to specify the root directory of the
13879 volume holding FILENAME. */
13880 char rootname[MAX_PATH];
13881 char *name = XSTRING (encoded)->data;
13882
13883 /* find the root name of the volume if given */
13884 if (isalpha (name[0]) && name[1] == ':')
13885 {
13886 rootname[0] = name[0];
13887 rootname[1] = name[1];
13888 rootname[2] = '\\';
13889 rootname[3] = 0;
13890 }
13891 else if (IS_DIRECTORY_SEP (name[0]) && IS_DIRECTORY_SEP (name[1]))
13892 {
13893 char *str = rootname;
13894 int slashes = 4;
13895 do
13896 {
13897 if (IS_DIRECTORY_SEP (*name) && --slashes == 0)
13898 break;
13899 *str++ = *name++;
13900 }
13901 while ( *name );
13902
13903 *str++ = '\\';
13904 *str = 0;
13905 }
13906
13907 if (pfn_GetDiskFreeSpaceEx)
13908 {
13909 LARGE_INTEGER availbytes;
13910 LARGE_INTEGER freebytes;
13911 LARGE_INTEGER totalbytes;
13912
13913 if (pfn_GetDiskFreeSpaceEx(rootname,
13914 &availbytes,
13915 &totalbytes,
13916 &freebytes))
13917 value = list3 (make_float ((double) totalbytes.QuadPart),
13918 make_float ((double) freebytes.QuadPart),
13919 make_float ((double) availbytes.QuadPart));
13920 }
13921 else
13922 {
13923 DWORD sectors_per_cluster;
13924 DWORD bytes_per_sector;
13925 DWORD free_clusters;
13926 DWORD total_clusters;
13927
13928 if (GetDiskFreeSpace(rootname,
13929 &sectors_per_cluster,
13930 &bytes_per_sector,
13931 &free_clusters,
13932 &total_clusters))
13933 value = list3 (make_float ((double) total_clusters
13934 * sectors_per_cluster * bytes_per_sector),
13935 make_float ((double) free_clusters
13936 * sectors_per_cluster * bytes_per_sector),
13937 make_float ((double) free_clusters
13938 * sectors_per_cluster * bytes_per_sector));
13939 }
13940 }
13941
13942 return value;
13943}
13944\f
fbd6baed 13945syms_of_w32fns ()
ee78dc32 13946{
1edf84e7
GV		 13947 /* This is zero if not using MS-Windows. */
13948 w32_in_use = 0;
13949
ee78dc32
GV		 13950 /* The section below is built by the lisp expression at the top of the file,
13951 just above where these variables are declared. */
13952 /*&&& init symbols here &&&*/
13953 Qauto_raise = intern ("auto-raise");
13954 staticpro (&Qauto_raise);
13955 Qauto_lower = intern ("auto-lower");
13956 staticpro (&Qauto_lower);
ee78dc32
GV		 13957 Qbar = intern ("bar");
13958 staticpro (&Qbar);
13959 Qborder_color = intern ("border-color");
13960 staticpro (&Qborder_color);
13961 Qborder_width = intern ("border-width");
13962 staticpro (&Qborder_width);
13963 Qbox = intern ("box");
13964 staticpro (&Qbox);
13965 Qcursor_color = intern ("cursor-color");
13966 staticpro (&Qcursor_color);
13967 Qcursor_type = intern ("cursor-type");
13968 staticpro (&Qcursor_type);
ee78dc32
GV		 13969 Qgeometry = intern ("geometry");
13970 staticpro (&Qgeometry);
13971 Qicon_left = intern ("icon-left");
13972 staticpro (&Qicon_left);
13973 Qicon_top = intern ("icon-top");
13974 staticpro (&Qicon_top);
13975 Qicon_type = intern ("icon-type");
13976 staticpro (&Qicon_type);
13977 Qicon_name = intern ("icon-name");
13978 staticpro (&Qicon_name);
13979 Qinternal_border_width = intern ("internal-border-width");
13980 staticpro (&Qinternal_border_width);
13981 Qleft = intern ("left");
13982 staticpro (&Qleft);
1026b400
RS		 13983 Qright = intern ("right");
13984 staticpro (&Qright);
ee78dc32
GV		 13985 Qmouse_color = intern ("mouse-color");
13986 staticpro (&Qmouse_color);
13987 Qnone = intern ("none");
13988 staticpro (&Qnone);
13989 Qparent_id = intern ("parent-id");
13990 staticpro (&Qparent_id);
13991 Qscroll_bar_width = intern ("scroll-bar-width");
13992 staticpro (&Qscroll_bar_width);
13993 Qsuppress_icon = intern ("suppress-icon");
13994 staticpro (&Qsuppress_icon);
ee78dc32
GV		 13995 Qundefined_color = intern ("undefined-color");
13996 staticpro (&Qundefined_color);
13997 Qvertical_scroll_bars = intern ("vertical-scroll-bars");
13998 staticpro (&Qvertical_scroll_bars);
13999 Qvisibility = intern ("visibility");
14000 staticpro (&Qvisibility);
14001 Qwindow_id = intern ("window-id");
14002 staticpro (&Qwindow_id);
14003 Qx_frame_parameter = intern ("x-frame-parameter");
14004 staticpro (&Qx_frame_parameter);
14005 Qx_resource_name = intern ("x-resource-name");
14006 staticpro (&Qx_resource_name);
14007 Quser_position = intern ("user-position");
14008 staticpro (&Quser_position);
14009 Quser_size = intern ("user-size");
14010 staticpro (&Quser_size);
6fc2811b
JR		 14011 Qscreen_gamma = intern ("screen-gamma");
14012 staticpro (&Qscreen_gamma);
dfff8a69
JR		 14013 Qline_spacing = intern ("line-spacing");
14014 staticpro (&Qline_spacing);
14015 Qcenter = intern ("center");
14016 staticpro (&Qcenter);
dc220243
JR		 14017 Qcancel_timer = intern ("cancel-timer");
14018 staticpro (&Qcancel_timer);
ee78dc32
GV		 14019 /* This is the end of symbol initialization. */
14020
adcc3809
GV		 14021 Qhyper = intern ("hyper");
14022 staticpro (&Qhyper);
14023 Qsuper = intern ("super");
14024 staticpro (&Qsuper);
14025 Qmeta = intern ("meta");
14026 staticpro (&Qmeta);
14027 Qalt = intern ("alt");
14028 staticpro (&Qalt);
14029 Qctrl = intern ("ctrl");
14030 staticpro (&Qctrl);
14031 Qcontrol = intern ("control");
14032 staticpro (&Qcontrol);
14033 Qshift = intern ("shift");
14034 staticpro (&Qshift);
14035
6fc2811b
JR		 14036 /* Text property `display' should be nonsticky by default. */
14037 Vtext_property_default_nonsticky
14038 = Fcons (Fcons (Qdisplay, Qt), Vtext_property_default_nonsticky);
14039
14040
14041 Qlaplace = intern ("laplace");
14042 staticpro (&Qlaplace);
3cf3436e
JR		 14043 Qemboss = intern ("emboss");
14044 staticpro (&Qemboss);
14045 Qedge_detection = intern ("edge-detection");
14046 staticpro (&Qedge_detection);
14047 Qheuristic = intern ("heuristic");
14048 staticpro (&Qheuristic);
14049 QCmatrix = intern (":matrix");
14050 staticpro (&QCmatrix);
14051 QCcolor_adjustment = intern (":color-adjustment");
14052 staticpro (&QCcolor_adjustment);
14053 QCmask = intern (":mask");
14054 staticpro (&QCmask);
6fc2811b 14055
4b817373
RS		 14056 Qface_set_after_frame_default = intern ("face-set-after-frame-default");
14057 staticpro (&Qface_set_after_frame_default);
14058
ee78dc32
GV		 14059 Fput (Qundefined_color, Qerror_conditions,
14060 Fcons (Qundefined_color, Fcons (Qerror, Qnil)));
14061 Fput (Qundefined_color, Qerror_message,
14062 build_string ("Undefined color"));
14063
ccc2d29c
GV		 14064 staticpro (&w32_grabbed_keys);
14065 w32_grabbed_keys = Qnil;
14066
fbd6baed 14067 DEFVAR_LISP ("w32-color-map", &Vw32_color_map,
74e1aeec 14068 doc: /* An array of color name mappings for windows. */);
fbd6baed 14069 Vw32_color_map = Qnil;
ee78dc32 14070
fbd6baed 14071 DEFVAR_LISP ("w32-pass-alt-to-system", &Vw32_pass_alt_to_system,
74e1aeec
JR		 14072 doc: /* Non-nil if alt key presses are passed on to Windows.
14073When non-nil, for example, alt pressed and released and then space will
14074open the System menu. When nil, Emacs silently swallows alt key events. */);
fbd6baed 14075 Vw32_pass_alt_to_system = Qnil;
da36a4d6 14076
fbd6baed 14077 DEFVAR_LISP ("w32-alt-is-meta", &Vw32_alt_is_meta,
74e1aeec
JR		 14078 doc: /* Non-nil if the alt key is to be considered the same as the meta key.
14079When nil, Emacs will translate the alt key to the Alt modifier, and not Meta. */);
fbd6baed 14080 Vw32_alt_is_meta = Qt;
8c205c63 14081
7d081355 14082 DEFVAR_INT ("w32-quit-key", &Vw32_quit_key,
74e1aeec 14083 doc: /* If non-zero, the virtual key code for an alternative quit key. */);
7d081355
AI		 14084 XSETINT (Vw32_quit_key, 0);
14085
ccc2d29c
GV		 14086 DEFVAR_LISP ("w32-pass-lwindow-to-system",
14087 &Vw32_pass_lwindow_to_system,
74e1aeec
JR		 14088 doc: /* Non-nil if the left \"Windows\" key is passed on to Windows.
14089When non-nil, the Start menu is opened by tapping the key. */);
ccc2d29c
GV		 14090 Vw32_pass_lwindow_to_system = Qt;
14091
14092 DEFVAR_LISP ("w32-pass-rwindow-to-system",
14093 &Vw32_pass_rwindow_to_system,
74e1aeec
JR		 14094 doc: /* Non-nil if the right \"Windows\" key is passed on to Windows.
14095When non-nil, the Start menu is opened by tapping the key. */);
ccc2d29c
GV		 14096 Vw32_pass_rwindow_to_system = Qt;
14097
adcc3809
GV		 14098 DEFVAR_INT ("w32-phantom-key-code",
14099 &Vw32_phantom_key_code,
74e1aeec
JR		 14100 doc: /* Virtual key code used to generate \"phantom\" key presses.
14101Value is a number between 0 and 255.
14102
14103Phantom key presses are generated in order to stop the system from
14104acting on \"Windows\" key events when `w32-pass-lwindow-to-system' or
14105`w32-pass-rwindow-to-system' is nil. */);
ce6059da
AI		 14106 /* Although 255 is technically not a valid key code, it works and
14107 means that this hack won't interfere with any real key code. */
14108 Vw32_phantom_key_code = 255;
adcc3809 14109
ccc2d29c
GV		 14110 DEFVAR_LISP ("w32-enable-num-lock",
14111 &Vw32_enable_num_lock,
74e1aeec
JR		 14112 doc: /* Non-nil if Num Lock should act normally.
14113Set to nil to see Num Lock as the key `kp-numlock'. */);
ccc2d29c
GV		 14114 Vw32_enable_num_lock = Qt;
14115
14116 DEFVAR_LISP ("w32-enable-caps-lock",
14117 &Vw32_enable_caps_lock,
74e1aeec
JR		 14118 doc: /* Non-nil if Caps Lock should act normally.
14119Set to nil to see Caps Lock as the key `capslock'. */);
ccc2d29c
GV		 14120 Vw32_enable_caps_lock = Qt;
14121
14122 DEFVAR_LISP ("w32-scroll-lock-modifier",
14123 &Vw32_scroll_lock_modifier,
74e1aeec
JR		 14124 doc: /* Modifier to use for the Scroll Lock on state.
14125The value can be hyper, super, meta, alt, control or shift for the
14126respective modifier, or nil to see Scroll Lock as the key `scroll'.
14127Any other value will cause the key to be ignored. */);
ccc2d29c
GV		 14128 Vw32_scroll_lock_modifier = Qt;
14129
14130 DEFVAR_LISP ("w32-lwindow-modifier",
14131 &Vw32_lwindow_modifier,
74e1aeec
JR		 14132 doc: /* Modifier to use for the left \"Windows\" key.
14133The value can be hyper, super, meta, alt, control or shift for the
14134respective modifier, or nil to appear as the key `lwindow'.
14135Any other value will cause the key to be ignored. */);
ccc2d29c
GV		 14136 Vw32_lwindow_modifier = Qnil;
14137
14138 DEFVAR_LISP ("w32-rwindow-modifier",
14139 &Vw32_rwindow_modifier,
74e1aeec
JR		 14140 doc: /* Modifier to use for the right \"Windows\" key.
14141The value can be hyper, super, meta, alt, control or shift for the
14142respective modifier, or nil to appear as the key `rwindow'.
14143Any other value will cause the key to be ignored. */);
ccc2d29c
GV		 14144 Vw32_rwindow_modifier = Qnil;
14145
14146 DEFVAR_LISP ("w32-apps-modifier",
14147 &Vw32_apps_modifier,
74e1aeec
JR		 14148 doc: /* Modifier to use for the \"Apps\" key.
14149The value can be hyper, super, meta, alt, control or shift for the
14150respective modifier, or nil to appear as the key `apps'.
14151Any other value will cause the key to be ignored. */);
ccc2d29c 14152 Vw32_apps_modifier = Qnil;
da36a4d6 14153
212da13b 14154 DEFVAR_LISP ("w32-enable-synthesized-fonts", &Vw32_enable_synthesized_fonts,
74e1aeec 14155 doc: /* Non-nil enables selection of artificially italicized and bold fonts. */);
6fc2811b 14156 Vw32_enable_synthesized_fonts = Qnil;
5ac45f98 14157
fbd6baed 14158 DEFVAR_LISP ("w32-enable-palette", &Vw32_enable_palette,
74e1aeec 14159 doc: /* Non-nil enables Windows palette management to map colors exactly. */);
fbd6baed 14160 Vw32_enable_palette = Qt;
5ac45f98 14161
fbd6baed
GV		 14162 DEFVAR_INT ("w32-mouse-button-tolerance",
14163 &Vw32_mouse_button_tolerance,
74e1aeec
JR		 14164 doc: /* Analogue of double click interval for faking middle mouse events.
14165The value is the minimum time in milliseconds that must elapse between
14166left/right button down events before they are considered distinct events.
14167If both mouse buttons are depressed within this interval, a middle mouse
14168button down event is generated instead. */);
fbd6baed 14169 XSETINT (Vw32_mouse_button_tolerance, GetDoubleClickTime () / 2);
5ac45f98 14170
fbd6baed
GV		 14171 DEFVAR_INT ("w32-mouse-move-interval",
14172 &Vw32_mouse_move_interval,
74e1aeec
JR		 14173 doc: /* Minimum interval between mouse move events.
14174The value is the minimum time in milliseconds that must elapse between
14175successive mouse move (or scroll bar drag) events before they are
14176reported as lisp events. */);
247be837 14177 XSETINT (Vw32_mouse_move_interval, 0);
84fb1139 14178
ee78dc32
GV		 14179 init_x_parm_symbols ();
14180
14181 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path,
74e1aeec 14182 doc: /* List of directories to search for bitmap files for w32. */);
ee78dc32
GV		 14183 Vx_bitmap_file_path = decode_env_path ((char *) 0, "PATH");
14184
14185 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape,
74e1aeec
JR		 14186 doc: /* The shape of the pointer when over text.
14187Changing the value does not affect existing frames
14188unless you set the mouse color. */);
ee78dc32
GV		 14189 Vx_pointer_shape = Qnil;
14190
14191 DEFVAR_LISP ("x-resource-name", &Vx_resource_name,
74e1aeec
JR		 14192 doc: /* The name Emacs uses to look up resources; for internal use only.
14193`x-get-resource' uses this as the first component of the instance name
14194when requesting resource values.
14195Emacs initially sets `x-resource-name' to the name under which Emacs
14196was invoked, or to the value specified with the `-name' or `-rn'
14197switches, if present. */);
ee78dc32
GV		 14198 Vx_resource_name = Qnil;
14199
14200 Vx_nontext_pointer_shape = Qnil;
14201
14202 Vx_mode_pointer_shape = Qnil;
14203
0af913d7 14204 DEFVAR_LISP ("x-hourglass-pointer-shape", &Vx_hourglass_pointer_shape,
74e1aeec
JR		 14205 doc: /* The shape of the pointer when Emacs is busy.
14206This variable takes effect when you create a new frame
14207or when you set the mouse color. */);
0af913d7 14208 Vx_hourglass_pointer_shape = Qnil;
6fc2811b 14209
0af913d7 14210 DEFVAR_BOOL ("display-hourglass", &display_hourglass_p,
74e1aeec 14211 doc: /* Non-zero means Emacs displays an hourglass pointer on window systems. */);
0af913d7 14212 display_hourglass_p = 1;
6fc2811b 14213
0af913d7 14214 DEFVAR_LISP ("hourglass-delay", &Vhourglass_delay,
74e1aeec
JR		 14215 doc: /* *Seconds to wait before displaying an hourglass pointer.
14216Value must be an integer or float. */);
0af913d7 14217 Vhourglass_delay = make_number (DEFAULT_HOURGLASS_DELAY);
f79e6790 14218
6fc2811b 14219 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
ee78dc32 14220 &Vx_sensitive_text_pointer_shape,
74e1aeec
JR		 14221 doc: /* The shape of the pointer when over mouse-sensitive text.
14222This variable takes effect when you create a new frame
14223or when you set the mouse color. */);
ee78dc32
GV		 14224 Vx_sensitive_text_pointer_shape = Qnil;
14225
4694d762
JR		 14226 DEFVAR_LISP ("x-window-horizontal-drag-cursor",
14227 &Vx_window_horizontal_drag_shape,
74e1aeec
JR		 14228 doc: /* Pointer shape to use for indicating a window can be dragged horizontally.
14229This variable takes effect when you create a new frame
14230or when you set the mouse color. */);
4694d762
JR		 14231 Vx_window_horizontal_drag_shape = Qnil;
14232
ee78dc32 14233 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel,
74e1aeec 14234 doc: /* A string indicating the foreground color of the cursor box. */);
ee78dc32
GV		 14235 Vx_cursor_fore_pixel = Qnil;
14236
3cf3436e 14237 DEFVAR_LISP ("x-max-tooltip-size", &Vx_max_tooltip_size,
74e1aeec
JR		 14238 doc: /* Maximum size for tooltips. Value is a pair (COLUMNS . ROWS).
14239Text larger than this is clipped. */);
3cf3436e
JR		 14240 Vx_max_tooltip_size = Fcons (make_number (80), make_number (40));
14241
ee78dc32 14242 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager,
74e1aeec
JR		 14243 doc: /* Non-nil if no window manager is in use.
14244Emacs doesn't try to figure this out; this is always nil
14245unless you set it to something else. */);
ee78dc32
GV		 14246 /* We don't have any way to find this out, so set it to nil
14247 and maybe the user would like to set it to t. */
14248 Vx_no_window_manager = Qnil;
14249
4587b026
GV		 14250 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
14251 &Vx_pixel_size_width_font_regexp,
74e1aeec
JR		 14252 doc: /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'.
14253
14254Since Emacs gets width of a font matching with this regexp from
14255PIXEL_SIZE field of the name, font finding mechanism gets faster for
14256such a font. This is especially effective for such large fonts as
14257Chinese, Japanese, and Korean. */);
4587b026
GV		 14258 Vx_pixel_size_width_font_regexp = Qnil;
14259
6fc2811b 14260 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay,
74e1aeec
JR		 14261 doc: /* Time after which cached images are removed from the cache.
14262When an image has not been displayed this many seconds, remove it
14263from the image cache. Value must be an integer or nil with nil
14264meaning don't clear the cache. */);
6fc2811b
JR		 14265 Vimage_cache_eviction_delay = make_number (30 * 60);
14266
33d52f9c
GV		 14267 DEFVAR_LISP ("w32-bdf-filename-alist",
14268 &Vw32_bdf_filename_alist,
74e1aeec 14269 doc: /* List of bdf fonts and their corresponding filenames. */);
33d52f9c
GV		 14270 Vw32_bdf_filename_alist = Qnil;
14271
1075afa9
GV		 14272 DEFVAR_BOOL ("w32-strict-fontnames",
14273 &w32_strict_fontnames,
74e1aeec
JR		 14274 doc: /* Non-nil means only use fonts that are exact matches for those requested.
14275Default is nil, which allows old fontnames that are not XLFD compliant,
14276and allows third-party CJK display to work by specifying false charset
14277fields to trick Emacs into translating to Big5, SJIS etc.
14278Setting this to t will prevent wrong fonts being selected when
14279fontsets are automatically created. */);
1075afa9
GV		 14280 w32_strict_fontnames = 0;
14281
c0611964
AI		 14282 DEFVAR_BOOL ("w32-strict-painting",
14283 &w32_strict_painting,
74e1aeec
JR		 14284 doc: /* Non-nil means use strict rules for repainting frames.
14285Set this to nil to get the old behaviour for repainting; this should
14286only be necessary if the default setting causes problems. */);
c0611964
AI		 14287 w32_strict_painting = 1;
14288
f46e6225
GV		 14289 DEFVAR_LISP ("w32-system-coding-system",
14290 &Vw32_system_coding_system,
74e1aeec 14291 doc: /* Coding system used by Windows system functions, such as for font names. */);
f46e6225
GV		 14292 Vw32_system_coding_system = Qnil;
14293
dfff8a69
JR		 14294 DEFVAR_LISP ("w32-charset-info-alist",
14295 &Vw32_charset_info_alist,
74e1aeec
JR		 14296 doc: /* Alist linking Emacs character sets to Windows fonts
14297and codepages. Each entry should be of the form:
14298
14299 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE))
14300
14301where CHARSET_NAME is a string used in font names to identify the charset,
14302WINDOWS_CHARSET is a symbol that can be one of:
14303w32-charset-ansi, w32-charset-default, w32-charset-symbol,
14304w32-charset-shiftjis, w32-charset-hangeul, w32-charset-gb2312,
14305w32-charset-chinesebig5,
dfff8a69 14306#ifdef JOHAB_CHARSET
74e1aeec
JR		 14307w32-charset-johab, w32-charset-hebrew,
14308w32-charset-arabic, w32-charset-greek, w32-charset-turkish,
14309w32-charset-vietnamese, w32-charset-thai, w32-charset-easteurope,
14310w32-charset-russian, w32-charset-mac, w32-charset-baltic,
dfff8a69
JR		 14311#endif
14312#ifdef UNICODE_CHARSET
74e1aeec 14313w32-charset-unicode,
dfff8a69 14314#endif
74e1aeec
JR		 14315or w32-charset-oem.
14316CODEPAGE should be an integer specifying the codepage that should be used
14317to display the character set, t to do no translation and output as Unicode,
14318or nil to do no translation and output as 8 bit (or multibyte on far-east
14319versions of Windows) characters. */);
dfff8a69
JR		 14320 Vw32_charset_info_alist = Qnil;
14321
14322 staticpro (&Qw32_charset_ansi);
14323 Qw32_charset_ansi = intern ("w32-charset-ansi");
14324 staticpro (&Qw32_charset_symbol);
14325 Qw32_charset_symbol = intern ("w32-charset-symbol");
14326 staticpro (&Qw32_charset_shiftjis);
14327 Qw32_charset_shiftjis = intern ("w32-charset-shiftjis");
767b1ff0
JR		 14328 staticpro (&Qw32_charset_hangeul);
14329 Qw32_charset_hangeul = intern ("w32-charset-hangeul");
dfff8a69
JR		 14330 staticpro (&Qw32_charset_chinesebig5);
14331 Qw32_charset_chinesebig5 = intern ("w32-charset-chinesebig5");
14332 staticpro (&Qw32_charset_gb2312);
14333 Qw32_charset_gb2312 = intern ("w32-charset-gb2312");
14334 staticpro (&Qw32_charset_oem);
14335 Qw32_charset_oem = intern ("w32-charset-oem");
14336
14337#ifdef JOHAB_CHARSET
14338 {
14339 static int w32_extra_charsets_defined = 1;
74e1aeec
JR		 14340 DEFVAR_BOOL ("w32-extra-charsets-defined", &w32_extra_charsets_defined,
14341 doc: /* Internal variable. */);
dfff8a69
JR		 14342
14343 staticpro (&Qw32_charset_johab);
14344 Qw32_charset_johab = intern ("w32-charset-johab");
14345 staticpro (&Qw32_charset_easteurope);
14346 Qw32_charset_easteurope = intern ("w32-charset-easteurope");
14347 staticpro (&Qw32_charset_turkish);
14348 Qw32_charset_turkish = intern ("w32-charset-turkish");
14349 staticpro (&Qw32_charset_baltic);
14350 Qw32_charset_baltic = intern ("w32-charset-baltic");
14351 staticpro (&Qw32_charset_russian);
14352 Qw32_charset_russian = intern ("w32-charset-russian");
14353 staticpro (&Qw32_charset_arabic);
14354 Qw32_charset_arabic = intern ("w32-charset-arabic");
14355 staticpro (&Qw32_charset_greek);
14356 Qw32_charset_greek = intern ("w32-charset-greek");
14357 staticpro (&Qw32_charset_hebrew);
14358 Qw32_charset_hebrew = intern ("w32-charset-hebrew");
767b1ff0
JR		 14359 staticpro (&Qw32_charset_vietnamese);
14360 Qw32_charset_vietnamese = intern ("w32-charset-vietnamese");
dfff8a69
JR		 14361 staticpro (&Qw32_charset_thai);
14362 Qw32_charset_thai = intern ("w32-charset-thai");
14363 staticpro (&Qw32_charset_mac);
14364 Qw32_charset_mac = intern ("w32-charset-mac");
14365 }
14366#endif
14367
14368#ifdef UNICODE_CHARSET
14369 {
14370 static int w32_unicode_charset_defined = 1;
14371 DEFVAR_BOOL ("w32-unicode-charset-defined",
74e1aeec
JR		 14372 &w32_unicode_charset_defined,
14373 doc: /* Internal variable. */);
dfff8a69
JR		 14374
14375 staticpro (&Qw32_charset_unicode);
14376 Qw32_charset_unicode = intern ("w32-charset-unicode");
14377#endif
14378
ee78dc32 14379 defsubr (&Sx_get_resource);
767b1ff0 14380#if 0 /* TODO: Port to W32 */
6fc2811b
JR		 14381 defsubr (&Sx_change_window_property);
14382 defsubr (&Sx_delete_window_property);
14383 defsubr (&Sx_window_property);
14384#endif
2d764c78 14385 defsubr (&Sxw_display_color_p);
ee78dc32 14386 defsubr (&Sx_display_grayscale_p);
2d764c78
EZ		 14387 defsubr (&Sxw_color_defined_p);
14388 defsubr (&Sxw_color_values);
ee78dc32
GV		 14389 defsubr (&Sx_server_max_request_size);
14390 defsubr (&Sx_server_vendor);
14391 defsubr (&Sx_server_version);
14392 defsubr (&Sx_display_pixel_width);
14393 defsubr (&Sx_display_pixel_height);
14394 defsubr (&Sx_display_mm_width);
14395 defsubr (&Sx_display_mm_height);
14396 defsubr (&Sx_display_screens);
14397 defsubr (&Sx_display_planes);
14398 defsubr (&Sx_display_color_cells);
14399 defsubr (&Sx_display_visual_class);
14400 defsubr (&Sx_display_backing_store);
14401 defsubr (&Sx_display_save_under);
14402 defsubr (&Sx_parse_geometry);
14403 defsubr (&Sx_create_frame);
ee78dc32
GV		 14404 defsubr (&Sx_open_connection);
14405 defsubr (&Sx_close_connection);
14406 defsubr (&Sx_display_list);
14407 defsubr (&Sx_synchronize);
14408
fbd6baed 14409 /* W32 specific functions */
ee78dc32 14410
1edf84e7 14411 defsubr (&Sw32_focus_frame);
fbd6baed
GV		 14412 defsubr (&Sw32_select_font);
14413 defsubr (&Sw32_define_rgb_color);
14414 defsubr (&Sw32_default_color_map);
14415 defsubr (&Sw32_load_color_file);
1edf84e7 14416 defsubr (&Sw32_send_sys_command);
55dcfc15 14417 defsubr (&Sw32_shell_execute);
ccc2d29c
GV		 14418 defsubr (&Sw32_register_hot_key);
14419 defsubr (&Sw32_unregister_hot_key);
14420 defsubr (&Sw32_registered_hot_keys);
14421 defsubr (&Sw32_reconstruct_hot_key);
adcc3809 14422 defsubr (&Sw32_toggle_lock_key);
33d52f9c 14423 defsubr (&Sw32_find_bdf_fonts);
4587b026 14424
2254bcde
AI		 14425 defsubr (&Sfile_system_info);
14426
4587b026
GV		 14427 /* Setting callback functions for fontset handler. */
14428 get_font_info_func = w32_get_font_info;
6fc2811b
JR		 14429
14430#if 0 /* This function pointer doesn't seem to be used anywhere.
14431 And the pointer assigned has the wrong type, anyway. */
4587b026 14432 list_fonts_func = w32_list_fonts;
6fc2811b
JR		 14433#endif
14434
4587b026
GV		 14435 load_font_func = w32_load_font;
14436 find_ccl_program_func = w32_find_ccl_program;
14437 query_font_func = w32_query_font;
14438 set_frame_fontset_func = x_set_font;
14439 check_window_system_func = check_w32;
6fc2811b 14440
767b1ff0 14441#if 0 /* TODO Image support for W32 */
6fc2811b
JR		 14442 /* Images. */
14443 Qxbm = intern ("xbm");
14444 staticpro (&Qxbm);
14445 QCtype = intern (":type");
14446 staticpro (&QCtype);
a93f4566
GM		 14447 QCconversion = intern (":conversion");
14448 staticpro (&QCconversion);
6fc2811b
JR		 14449 QCheuristic_mask = intern (":heuristic-mask");
14450 staticpro (&QCheuristic_mask);
14451 QCcolor_symbols = intern (":color-symbols");
14452 staticpro (&QCcolor_symbols);
6fc2811b
JR		 14453 QCascent = intern (":ascent");
14454 staticpro (&QCascent);
14455 QCmargin = intern (":margin");
14456 staticpro (&QCmargin);
14457 QCrelief = intern (":relief");
14458 staticpro (&QCrelief);
14459 Qpostscript = intern ("postscript");
14460 staticpro (&Qpostscript);
14461 QCloader = intern (":loader");
14462 staticpro (&QCloader);
14463 QCbounding_box = intern (":bounding-box");
14464 staticpro (&QCbounding_box);
14465 QCpt_width = intern (":pt-width");
14466 staticpro (&QCpt_width);
14467 QCpt_height = intern (":pt-height");
14468 staticpro (&QCpt_height);
14469 QCindex = intern (":index");
14470 staticpro (&QCindex);
14471 Qpbm = intern ("pbm");
14472 staticpro (&Qpbm);
14473
14474#if HAVE_XPM
14475 Qxpm = intern ("xpm");
14476 staticpro (&Qxpm);
14477#endif
14478
14479#if HAVE_JPEG
14480 Qjpeg = intern ("jpeg");
14481 staticpro (&Qjpeg);
14482#endif
14483
14484#if HAVE_TIFF
14485 Qtiff = intern ("tiff");
14486 staticpro (&Qtiff);
14487#endif
14488
14489#if HAVE_GIF
14490 Qgif = intern ("gif");
14491 staticpro (&Qgif);
14492#endif
14493
14494#if HAVE_PNG
14495 Qpng = intern ("png");
14496 staticpro (&Qpng);
14497#endif
14498
14499 defsubr (&Sclear_image_cache);
14500
14501#if GLYPH_DEBUG
14502 defsubr (&Simagep);
14503 defsubr (&Slookup_image);
14504#endif
767b1ff0 14505#endif /* TODO */
6fc2811b 14506
0af913d7
GM		 14507 hourglass_atimer = NULL;
14508 hourglass_shown_p = 0;
767b1ff0 14509#ifdef TODO /* Tooltip support not complete. */
6fc2811b
JR		 14510 defsubr (&Sx_show_tip);
14511 defsubr (&Sx_hide_tip);
767b1ff0 14512#endif
6fc2811b 14513 tip_timer = Qnil;
57fa2774
JR		 14514 staticpro (&tip_timer);
14515 tip_frame = Qnil;
14516 staticpro (&tip_frame);
6fc2811b
JR		 14517
14518 defsubr (&Sx_file_dialog);
14519}
14520
14521
14522void
14523init_xfns ()
14524{
14525 image_types = NULL;
14526 Vimage_types = Qnil;
14527
767b1ff0 14528#if 0 /* TODO : Image support for W32 */
6fc2811b
JR		 14529 define_image_type (&xbm_type);
14530 define_image_type (&gs_type);
14531 define_image_type (&pbm_type);
14532
14533#if HAVE_XPM
14534 define_image_type (&xpm_type);
14535#endif
14536
14537#if HAVE_JPEG
14538 define_image_type (&jpeg_type);
14539#endif
14540
14541#if HAVE_TIFF
14542 define_image_type (&tiff_type);
14543#endif
14544
14545#if HAVE_GIF
14546 define_image_type (&gif_type);
14547#endif
14548
14549#if HAVE_PNG
14550 define_image_type (&png_type);
14551#endif
767b1ff0 14552#endif /* TODO */
ee78dc32
GV		 14553}
14554
14555#undef abort
14556
14557void
fbd6baed 14558w32_abort()
ee78dc32 14559{
5ac45f98
GV		 14560 int button;
14561 button = MessageBox (NULL,
14562 "A fatal error has occurred!\n\n"
14563 "Select Abort to exit, Retry to debug, Ignore to continue",
14564 "Emacs Abort Dialog",
14565 MB_ICONEXCLAMATION | MB_TASKMODAL
14566 | MB_SETFOREGROUND | MB_ABORTRETRYIGNORE);
14567 switch (button)
14568 {
14569 case IDRETRY:
14570 DebugBreak ();
14571 break;
14572 case IDIGNORE:
14573 break;
14574 case IDABORT:
14575 default:
14576 abort ();
14577 break;
14578 }
ee78dc32 14579}
d573caac 14580
83c75055
GV		 14581/* For convenience when debugging. */
14582int
14583w32_last_error()
14584{
14585 return GetLastError ();
14586}
Unnamed repository; edit this file 'description' to name the repository.