HCoop / bpt / emacs.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Add xrefs to X Resources.
[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
71eab8d1
AI		 55#define max(a, b) ((a) > (b) ? (a) : (b))
56
ee78dc32 57extern void free_frame_menubar ();
6fc2811b 58extern double atof ();
adcc3809 59extern int w32_console_toggle_lock_key (int vk_code, Lisp_Object new_state);
5ac45f98 60extern int quit_char;
ee78dc32 61
6fc2811b
JR		 62/* A definition of XColor for non-X frames. */
63#ifndef HAVE_X_WINDOWS
64typedef struct {
65 unsigned long pixel;
66 unsigned short red, green, blue;
67 char flags;
68 char pad;
69} XColor;
70#endif
71
ccc2d29c
GV		 72extern char *lispy_function_keys[];
73
6fc2811b
JR		 74/* The gray bitmap `bitmaps/gray'. This is done because w32term.c uses
75 it, and including `bitmaps/gray' more than once is a problem when
76 config.h defines `static' as an empty replacement string. */
77
78int gray_bitmap_width = gray_width;
79int gray_bitmap_height = gray_height;
80unsigned char *gray_bitmap_bits = gray_bits;
81
ee78dc32 82/* The colormap for converting color names to RGB values */
fbd6baed 83Lisp_Object Vw32_color_map;
ee78dc32 84
da36a4d6 85/* Non nil if alt key presses are passed on to Windows. */
fbd6baed 86Lisp_Object Vw32_pass_alt_to_system;
da36a4d6 87
8c205c63
RS		 88/* Non nil if alt key is translated to meta_modifier, nil if it is translated
89 to alt_modifier. */
fbd6baed 90Lisp_Object Vw32_alt_is_meta;
8c205c63 91
7d081355
AI		 92/* If non-zero, the windows virtual key code for an alternative quit key. */
93Lisp_Object Vw32_quit_key;
94
ccc2d29c
GV		 95/* Non nil if left window key events are passed on to Windows (this only
96 affects whether "tapping" the key opens the Start menu). */
97Lisp_Object Vw32_pass_lwindow_to_system;
98
99/* Non nil if right window key events are passed on to Windows (this
100 only affects whether "tapping" the key opens the Start menu). */
101Lisp_Object Vw32_pass_rwindow_to_system;
102
adcc3809
GV		 103/* Virtual key code used to generate "phantom" key presses in order
104 to stop system from acting on Windows key events. */
105Lisp_Object Vw32_phantom_key_code;
106
ccc2d29c
GV		 107/* Modifier associated with the left "Windows" key, or nil to act as a
108 normal key. */
109Lisp_Object Vw32_lwindow_modifier;
110
111/* Modifier associated with the right "Windows" key, or nil to act as a
112 normal key. */
113Lisp_Object Vw32_rwindow_modifier;
114
115/* Modifier associated with the "Apps" key, or nil to act as a normal
116 key. */
117Lisp_Object Vw32_apps_modifier;
118
119/* Value is nil if Num Lock acts as a function key. */
120Lisp_Object Vw32_enable_num_lock;
121
122/* Value is nil if Caps Lock acts as a function key. */
123Lisp_Object Vw32_enable_caps_lock;
124
125/* Modifier associated with Scroll Lock, or nil to act as a normal key. */
126Lisp_Object Vw32_scroll_lock_modifier;
da36a4d6 127
7ce9aaca 128/* Switch to control whether we inhibit requests for synthesized bold
6fc2811b
JR		 129 and italic versions of fonts. */
130Lisp_Object Vw32_enable_synthesized_fonts;
5ac45f98
GV		 131
132/* Enable palette management. */
fbd6baed 133Lisp_Object Vw32_enable_palette;
5ac45f98
GV		 134
135/* Control how close left/right button down events must be to
136 be converted to a middle button down event. */
fbd6baed 137Lisp_Object Vw32_mouse_button_tolerance;
5ac45f98 138
84fb1139
KH		 139/* Minimum interval between mouse movement (and scroll bar drag)
140 events that are passed on to the event loop. */
fbd6baed 141Lisp_Object Vw32_mouse_move_interval;
84fb1139 142
ee78dc32
GV		 143/* The name we're using in resource queries. */
144Lisp_Object Vx_resource_name;
145
146/* Non nil if no window manager is in use. */
147Lisp_Object Vx_no_window_manager;
148
0af913d7 149/* Non-zero means we're allowed to display a hourglass pointer. */
dfff8a69 150
0af913d7 151int display_hourglass_p;
6fc2811b 152
ee78dc32
GV		 153/* The background and shape of the mouse pointer, and shape when not
154 over text or in the modeline. */
dfff8a69 155
ee78dc32 156Lisp_Object Vx_pointer_shape, Vx_nontext_pointer_shape, Vx_mode_pointer_shape;
0af913d7 157Lisp_Object Vx_hourglass_pointer_shape, Vx_window_horizontal_drag_shape;
6fc2811b 158
ee78dc32 159/* The shape when over mouse-sensitive text. */
dfff8a69 160
ee78dc32
GV		 161Lisp_Object Vx_sensitive_text_pointer_shape;
162
163/* Color of chars displayed in cursor box. */
dfff8a69 164
ee78dc32
GV		 165Lisp_Object Vx_cursor_fore_pixel;
166
1edf84e7 167/* Nonzero if using Windows. */
dfff8a69 168
1edf84e7
GV		 169static int w32_in_use;
170
ee78dc32 171/* Search path for bitmap files. */
dfff8a69 172
ee78dc32
GV		 173Lisp_Object Vx_bitmap_file_path;
174
4587b026 175/* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
dfff8a69 176
4587b026
GV		 177Lisp_Object Vx_pixel_size_width_font_regexp;
178
33d52f9c
GV		 179/* Alist of bdf fonts and the files that define them. */
180Lisp_Object Vw32_bdf_filename_alist;
181
f46e6225
GV		 182Lisp_Object Vw32_system_coding_system;
183
f46e6225 184/* A flag to control whether fonts are matched strictly or not. */
1075afa9
GV		 185int w32_strict_fontnames;
186
c0611964
AI		 187/* A flag to control whether we should only repaint if GetUpdateRect
188 indicates there is an update region. */
189int w32_strict_painting;
190
dfff8a69
JR		 191/* Associative list linking character set strings to Windows codepages. */
192Lisp_Object Vw32_charset_info_alist;
193
194/* VIETNAMESE_CHARSET is not defined in some versions of MSVC. */
195#ifndef VIETNAMESE_CHARSET
196#define VIETNAMESE_CHARSET 163
197#endif
198
ee78dc32
GV		 199Lisp_Object Qauto_raise;
200Lisp_Object Qauto_lower;
ee78dc32
GV		 201Lisp_Object Qbar;
202Lisp_Object Qborder_color;
203Lisp_Object Qborder_width;
204Lisp_Object Qbox;
205Lisp_Object Qcursor_color;
206Lisp_Object Qcursor_type;
ee78dc32
GV		 207Lisp_Object Qgeometry;
208Lisp_Object Qicon_left;
209Lisp_Object Qicon_top;
210Lisp_Object Qicon_type;
211Lisp_Object Qicon_name;
212Lisp_Object Qinternal_border_width;
213Lisp_Object Qleft;
1026b400 214Lisp_Object Qright;
ee78dc32
GV		 215Lisp_Object Qmouse_color;
216Lisp_Object Qnone;
217Lisp_Object Qparent_id;
218Lisp_Object Qscroll_bar_width;
219Lisp_Object Qsuppress_icon;
ee78dc32
GV		 220Lisp_Object Qundefined_color;
221Lisp_Object Qvertical_scroll_bars;
222Lisp_Object Qvisibility;
223Lisp_Object Qwindow_id;
224Lisp_Object Qx_frame_parameter;
225Lisp_Object Qx_resource_name;
226Lisp_Object Quser_position;
227Lisp_Object Quser_size;
6fc2811b 228Lisp_Object Qscreen_gamma;
dfff8a69
JR		 229Lisp_Object Qline_spacing;
230Lisp_Object Qcenter;
dc220243 231Lisp_Object Qcancel_timer;
adcc3809
GV		 232Lisp_Object Qhyper;
233Lisp_Object Qsuper;
234Lisp_Object Qmeta;
235Lisp_Object Qalt;
236Lisp_Object Qctrl;
237Lisp_Object Qcontrol;
238Lisp_Object Qshift;
239
dfff8a69
JR		 240Lisp_Object Qw32_charset_ansi;
241Lisp_Object Qw32_charset_default;
242Lisp_Object Qw32_charset_symbol;
243Lisp_Object Qw32_charset_shiftjis;
767b1ff0 244Lisp_Object Qw32_charset_hangeul;
dfff8a69
JR		 245Lisp_Object Qw32_charset_gb2312;
246Lisp_Object Qw32_charset_chinesebig5;
247Lisp_Object Qw32_charset_oem;
248
71eab8d1
AI		 249#ifndef JOHAB_CHARSET
250#define JOHAB_CHARSET 130
251#endif
dfff8a69
JR		 252#ifdef JOHAB_CHARSET
253Lisp_Object Qw32_charset_easteurope;
254Lisp_Object Qw32_charset_turkish;
255Lisp_Object Qw32_charset_baltic;
256Lisp_Object Qw32_charset_russian;
257Lisp_Object Qw32_charset_arabic;
258Lisp_Object Qw32_charset_greek;
259Lisp_Object Qw32_charset_hebrew;
767b1ff0 260Lisp_Object Qw32_charset_vietnamese;
dfff8a69
JR		 261Lisp_Object Qw32_charset_thai;
262Lisp_Object Qw32_charset_johab;
263Lisp_Object Qw32_charset_mac;
264#endif
265
266#ifdef UNICODE_CHARSET
267Lisp_Object Qw32_charset_unicode;
268#endif
269
6fc2811b
JR		 270extern Lisp_Object Qtop;
271extern Lisp_Object Qdisplay;
272extern Lisp_Object Qtool_bar_lines;
273
5ac45f98
GV		 274/* State variables for emulating a three button mouse. */
275#define LMOUSE 1
276#define MMOUSE 2
277#define RMOUSE 4
278
279static int button_state = 0;
fbd6baed 280static W32Msg saved_mouse_button_msg;
84fb1139 281static unsigned mouse_button_timer; /* non-zero when timer is active */
fbd6baed 282static W32Msg saved_mouse_move_msg;
84fb1139
KH		 283static unsigned mouse_move_timer;
284
93fbe8b7
GV		 285/* W95 mousewheel handler */
286unsigned int msh_mousewheel = 0;
287
84fb1139
KH		 288#define MOUSE_BUTTON_ID 1
289#define MOUSE_MOVE_ID 2
5ac45f98 290
ee78dc32 291/* The below are defined in frame.c. */
dfff8a69 292
ee78dc32 293extern Lisp_Object Qheight, Qminibuffer, Qname, Qonly, Qwidth;
1edf84e7 294extern Lisp_Object Qunsplittable, Qmenu_bar_lines, Qbuffer_predicate, Qtitle;
6fc2811b 295extern Lisp_Object Qtool_bar_lines;
ee78dc32
GV		 296
297extern Lisp_Object Vwindow_system_version;
298
4b817373
RS		 299Lisp_Object Qface_set_after_frame_default;
300
937e601e
AI		 301#ifdef GLYPH_DEBUG
302int image_cache_refcount, dpyinfo_refcount;
303#endif
304
305
fbd6baed
GV		 306/* From w32term.c. */
307extern Lisp_Object Vw32_num_mouse_buttons;
ccc2d29c 308extern Lisp_Object Vw32_recognize_altgr;
5ac45f98 309
65906840
JR		 310extern HWND w32_system_caret_hwnd;
311extern int w32_system_caret_width;
312extern int w32_system_caret_height;
313extern int w32_system_caret_x;
314extern int w32_system_caret_y;
315
ee78dc32 316\f
1edf84e7
GV		 317/* Error if we are not connected to MS-Windows. */
318void
319check_w32 ()
320{
321 if (! w32_in_use)
322 error ("MS-Windows not in use or not initialized");
323}
324
325/* Nonzero if we can use mouse menus.
326 You should not call this unless HAVE_MENUS is defined. */
327
328int
329have_menus_p ()
330{
331 return w32_in_use;
332}
333
ee78dc32 334/* Extract a frame as a FRAME_PTR, defaulting to the selected frame
fbd6baed 335 and checking validity for W32. */
ee78dc32
GV		 336
337FRAME_PTR
338check_x_frame (frame)
339 Lisp_Object frame;
340{
341 FRAME_PTR f;
342
343 if (NILP (frame))
6fc2811b
JR		 344 frame = selected_frame;
345 CHECK_LIVE_FRAME (frame, 0);
346 f = XFRAME (frame);
fbd6baed
GV		 347 if (! FRAME_W32_P (f))
348 error ("non-w32 frame used");
ee78dc32
GV		 349 return f;
350}
351
352/* Let the user specify an display with a frame.
fbd6baed 353 nil stands for the selected frame--or, if that is not a w32 frame,
ee78dc32
GV		 354 the first display on the list. */
355
fbd6baed 356static struct w32_display_info *
ee78dc32
GV		 357check_x_display_info (frame)
358 Lisp_Object frame;
359{
360 if (NILP (frame))
361 {
6fc2811b
JR		 362 struct frame *sf = XFRAME (selected_frame);
363
364 if (FRAME_W32_P (sf) && FRAME_LIVE_P (sf))
365 return FRAME_W32_DISPLAY_INFO (sf);
ee78dc32 366 else
fbd6baed 367 return &one_w32_display_info;
ee78dc32
GV		 368 }
369 else if (STRINGP (frame))
370 return x_display_info_for_name (frame);
371 else
372 {
373 FRAME_PTR f;
374
375 CHECK_LIVE_FRAME (frame, 0);
376 f = XFRAME (frame);
fbd6baed
GV		 377 if (! FRAME_W32_P (f))
378 error ("non-w32 frame used");
379 return FRAME_W32_DISPLAY_INFO (f);
ee78dc32
GV		 380 }
381}
382\f
fbd6baed 383/* Return the Emacs frame-object corresponding to an w32 window.
ee78dc32
GV		 384 It could be the frame's main window or an icon window. */
385
386/* This function can be called during GC, so use GC_xxx type test macros. */
387
388struct frame *
389x_window_to_frame (dpyinfo, wdesc)
fbd6baed 390 struct w32_display_info *dpyinfo;
ee78dc32
GV		 391 HWND wdesc;
392{
393 Lisp_Object tail, frame;
394 struct frame *f;
395
8e713be6 396 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
ee78dc32 397 {
8e713be6 398 frame = XCAR (tail);
ee78dc32
GV		 399 if (!GC_FRAMEP (frame))
400 continue;
401 f = XFRAME (frame);
2d764c78 402 if (!FRAME_W32_P (f) || FRAME_W32_DISPLAY_INFO (f) != dpyinfo)
ee78dc32 403 continue;
0af913d7 404 if (f->output_data.w32->hourglass_window == wdesc)
f79e6790
JR		 405 return f;
406
767b1ff0 407 /* TODO: Check tooltips when supported. */
fbd6baed 408 if (FRAME_W32_WINDOW (f) == wdesc)
ee78dc32
GV		 409 return f;
410 }
411 return 0;
412}
413
414\f
415
416/* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
417 id, which is just an int that this section returns. Bitmaps are
418 reference counted so they can be shared among frames.
419
420 Bitmap indices are guaranteed to be > 0, so a negative number can
421 be used to indicate no bitmap.
422
423 If you use x_create_bitmap_from_data, then you must keep track of
424 the bitmaps yourself. That is, creating a bitmap from the same
425 data more than once will not be caught. */
426
427
428/* Functions to access the contents of a bitmap, given an id. */
429
430int
431x_bitmap_height (f, id)
432 FRAME_PTR f;
433 int id;
434{
fbd6baed 435 return FRAME_W32_DISPLAY_INFO (f)->bitmaps[id - 1].height;
ee78dc32
GV		 436}
437
438int
439x_bitmap_width (f, id)
440 FRAME_PTR f;
441 int id;
442{
fbd6baed 443 return FRAME_W32_DISPLAY_INFO (f)->bitmaps[id - 1].width;
ee78dc32
GV		 444}
445
446int
447x_bitmap_pixmap (f, id)
448 FRAME_PTR f;
449 int id;
450{
fbd6baed 451 return (int) FRAME_W32_DISPLAY_INFO (f)->bitmaps[id - 1].pixmap;
ee78dc32
GV		 452}
453
454
455/* Allocate a new bitmap record. Returns index of new record. */
456
457static int
458x_allocate_bitmap_record (f)
459 FRAME_PTR f;
460{
fbd6baed 461 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
ee78dc32
GV		 462 int i;
463
464 if (dpyinfo->bitmaps == NULL)
465 {
466 dpyinfo->bitmaps_size = 10;
467 dpyinfo->bitmaps
fbd6baed 468 = (struct w32_bitmap_record *) xmalloc (dpyinfo->bitmaps_size * sizeof (struct w32_bitmap_record));
ee78dc32
GV		 469 dpyinfo->bitmaps_last = 1;
470 return 1;
471 }
472
473 if (dpyinfo->bitmaps_last < dpyinfo->bitmaps_size)
474 return ++dpyinfo->bitmaps_last;
475
476 for (i = 0; i < dpyinfo->bitmaps_size; ++i)
477 if (dpyinfo->bitmaps[i].refcount == 0)
478 return i + 1;
479
480 dpyinfo->bitmaps_size *= 2;
481 dpyinfo->bitmaps
fbd6baed
GV		 482 = (struct w32_bitmap_record *) xrealloc (dpyinfo->bitmaps,
483 dpyinfo->bitmaps_size * sizeof (struct w32_bitmap_record));
ee78dc32
GV		 484 return ++dpyinfo->bitmaps_last;
485}
486
487/* Add one reference to the reference count of the bitmap with id ID. */
488
489void
490x_reference_bitmap (f, id)
491 FRAME_PTR f;
492 int id;
493{
fbd6baed 494 ++FRAME_W32_DISPLAY_INFO (f)->bitmaps[id - 1].refcount;
ee78dc32
GV		 495}
496
497/* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
498
499int
500x_create_bitmap_from_data (f, bits, width, height)
501 struct frame *f;
502 char *bits;
503 unsigned int width, height;
504{
fbd6baed 505 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
ee78dc32
GV		 506 Pixmap bitmap;
507 int id;
508
509 bitmap = CreateBitmap (width, height,
fbd6baed
GV		 510 FRAME_W32_DISPLAY_INFO (XFRAME (frame))->n_planes,
511 FRAME_W32_DISPLAY_INFO (XFRAME (frame))->n_cbits,
ee78dc32
GV		 512 bits);
513
514 if (! bitmap)
515 return -1;
516
517 id = x_allocate_bitmap_record (f);
518 dpyinfo->bitmaps[id - 1].pixmap = bitmap;
519 dpyinfo->bitmaps[id - 1].file = NULL;
520 dpyinfo->bitmaps[id - 1].hinst = NULL;
521 dpyinfo->bitmaps[id - 1].refcount = 1;
522 dpyinfo->bitmaps[id - 1].depth = 1;
523 dpyinfo->bitmaps[id - 1].height = height;
524 dpyinfo->bitmaps[id - 1].width = width;
525
526 return id;
527}
528
529/* Create bitmap from file FILE for frame F. */
530
531int
532x_create_bitmap_from_file (f, file)
533 struct frame *f;
534 Lisp_Object file;
535{
536 return -1;
767b1ff0 537#if 0 /* TODO : bitmap support */
fbd6baed 538 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
ee78dc32 539 unsigned int width, height;
6fc2811b 540 HBITMAP bitmap;
ee78dc32
GV		 541 int xhot, yhot, result, id;
542 Lisp_Object found;
543 int fd;
544 char *filename;
545 HINSTANCE hinst;
546
547 /* Look for an existing bitmap with the same name. */
548 for (id = 0; id < dpyinfo->bitmaps_last; ++id)
549 {
550 if (dpyinfo->bitmaps[id].refcount
551 && dpyinfo->bitmaps[id].file
552 && !strcmp (dpyinfo->bitmaps[id].file, (char *) XSTRING (file)->data))
553 {
554 ++dpyinfo->bitmaps[id].refcount;
555 return id + 1;
556 }
557 }
558
559 /* Search bitmap-file-path for the file, if appropriate. */
c0ec53ad 560 fd = openp (Vx_bitmap_file_path, file, Qnil, &found, 0);
ee78dc32
GV		 561 if (fd < 0)
562 return -1;
6fc2811b 563 emacs_close (fd);
ee78dc32
GV		 564
565 filename = (char *) XSTRING (found)->data;
566
567 hinst = LoadLibraryEx (filename, NULL, LOAD_LIBRARY_AS_DATAFILE);
568
569 if (hinst == NULL)
570 return -1;
571
572
fbd6baed 573 result = XReadBitmapFile (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
ee78dc32
GV		 574 filename, &width, &height, &bitmap, &xhot, &yhot);
575 if (result != BitmapSuccess)
576 return -1;
577
578 id = x_allocate_bitmap_record (f);
579 dpyinfo->bitmaps[id - 1].pixmap = bitmap;
580 dpyinfo->bitmaps[id - 1].refcount = 1;
581 dpyinfo->bitmaps[id - 1].file = (char *) xmalloc (XSTRING (file)->size + 1);
582 dpyinfo->bitmaps[id - 1].depth = 1;
583 dpyinfo->bitmaps[id - 1].height = height;
584 dpyinfo->bitmaps[id - 1].width = width;
585 strcpy (dpyinfo->bitmaps[id - 1].file, XSTRING (file)->data);
586
587 return id;
767b1ff0 588#endif /* TODO */
ee78dc32
GV		 589}
590
591/* Remove reference to bitmap with id number ID. */
592
33d52f9c 593void
ee78dc32
GV		 594x_destroy_bitmap (f, id)
595 FRAME_PTR f;
596 int id;
597{
fbd6baed 598 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
ee78dc32
GV		 599
600 if (id > 0)
601 {
602 --dpyinfo->bitmaps[id - 1].refcount;
603 if (dpyinfo->bitmaps[id - 1].refcount == 0)
604 {
605 BLOCK_INPUT;
606 DeleteObject (dpyinfo->bitmaps[id - 1].pixmap);
607 if (dpyinfo->bitmaps[id - 1].file)
608 {
6fc2811b 609 xfree (dpyinfo->bitmaps[id - 1].file);
ee78dc32
GV		 610 dpyinfo->bitmaps[id - 1].file = NULL;
611 }
612 UNBLOCK_INPUT;
613 }
614 }
615}
616
617/* Free all the bitmaps for the display specified by DPYINFO. */
618
619static void
620x_destroy_all_bitmaps (dpyinfo)
fbd6baed 621 struct w32_display_info *dpyinfo;
ee78dc32
GV		 622{
623 int i;
624 for (i = 0; i < dpyinfo->bitmaps_last; i++)
625 if (dpyinfo->bitmaps[i].refcount > 0)
626 {
627 DeleteObject (dpyinfo->bitmaps[i].pixmap);
628 if (dpyinfo->bitmaps[i].file)
6fc2811b 629 xfree (dpyinfo->bitmaps[i].file);
ee78dc32
GV		 630 }
631 dpyinfo->bitmaps_last = 0;
632}
633\f
fbd6baed 634/* Connect the frame-parameter names for W32 frames
ee78dc32
GV		 635 to the ways of passing the parameter values to the window system.
636
637 The name of a parameter, as a Lisp symbol,
638 has an `x-frame-parameter' property which is an integer in Lisp
639 but can be interpreted as an `enum x_frame_parm' in C. */
640
641enum x_frame_parm
642{
643 X_PARM_FOREGROUND_COLOR,
644 X_PARM_BACKGROUND_COLOR,
645 X_PARM_MOUSE_COLOR,
646 X_PARM_CURSOR_COLOR,
647 X_PARM_BORDER_COLOR,
648 X_PARM_ICON_TYPE,
649 X_PARM_FONT,
650 X_PARM_BORDER_WIDTH,
651 X_PARM_INTERNAL_BORDER_WIDTH,
652 X_PARM_NAME,
653 X_PARM_AUTORAISE,
654 X_PARM_AUTOLOWER,
655 X_PARM_VERT_SCROLL_BAR,
656 X_PARM_VISIBILITY,
657 X_PARM_MENU_BAR_LINES
658};
659
660
661struct x_frame_parm_table
662{
663 char *name;
6fc2811b 664 void (*setter) P_ ((struct frame *, Lisp_Object, Lisp_Object));
ee78dc32
GV		 665};
666
937e601e
AI		 667static Lisp_Object unwind_create_frame P_ ((Lisp_Object));
668static Lisp_Object unwind_create_tip_frame P_ ((Lisp_Object));
669static void x_change_window_heights P_ ((Lisp_Object, int));
767b1ff0 670/* TODO: Native Input Method support; see x_create_im. */
6fc2811b 671void x_set_foreground_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
dfff8a69 672static void x_set_line_spacing P_ ((struct frame *, Lisp_Object, Lisp_Object));
6fc2811b
JR		 673void x_set_background_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
674void x_set_mouse_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
675void x_set_cursor_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
676void x_set_border_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
677void x_set_cursor_type P_ ((struct frame *, Lisp_Object, Lisp_Object));
678void x_set_icon_type P_ ((struct frame *, Lisp_Object, Lisp_Object));
679void x_set_icon_name P_ ((struct frame *, Lisp_Object, Lisp_Object));
680void x_set_font P_ ((struct frame *, Lisp_Object, Lisp_Object));
681void x_set_border_width P_ ((struct frame *, Lisp_Object, Lisp_Object));
682void x_set_internal_border_width P_ ((struct frame *, Lisp_Object,
683 Lisp_Object));
684void x_explicitly_set_name P_ ((struct frame *, Lisp_Object, Lisp_Object));
685void x_set_autoraise P_ ((struct frame *, Lisp_Object, Lisp_Object));
686void x_set_autolower P_ ((struct frame *, Lisp_Object, Lisp_Object));
687void x_set_vertical_scroll_bars P_ ((struct frame *, Lisp_Object,
688 Lisp_Object));
689void x_set_visibility P_ ((struct frame *, Lisp_Object, Lisp_Object));
690void x_set_menu_bar_lines P_ ((struct frame *, Lisp_Object, Lisp_Object));
691void x_set_scroll_bar_width P_ ((struct frame *, Lisp_Object, Lisp_Object));
692void x_set_title P_ ((struct frame *, Lisp_Object, Lisp_Object));
693void x_set_unsplittable P_ ((struct frame *, Lisp_Object, Lisp_Object));
694void x_set_tool_bar_lines P_ ((struct frame *, Lisp_Object, Lisp_Object));
695static void x_set_screen_gamma P_ ((struct frame *, Lisp_Object, Lisp_Object));
3cf3436e
JR		 696static void x_edge_detection P_ ((struct frame *, struct image *, Lisp_Object,
697 Lisp_Object));
ee78dc32
GV		 698
699static struct x_frame_parm_table x_frame_parms[] =
700{
1edf84e7
GV		 701 "auto-raise", x_set_autoraise,
702 "auto-lower", x_set_autolower,
ee78dc32 703 "background-color", x_set_background_color,
ee78dc32 704 "border-color", x_set_border_color,
1edf84e7
GV		 705 "border-width", x_set_border_width,
706 "cursor-color", x_set_cursor_color,
ee78dc32 707 "cursor-type", x_set_cursor_type,
ee78dc32 708 "font", x_set_font,
1edf84e7
GV		 709 "foreground-color", x_set_foreground_color,
710 "icon-name", x_set_icon_name,
711 "icon-type", x_set_icon_type,
ee78dc32 712 "internal-border-width", x_set_internal_border_width,
ee78dc32 713 "menu-bar-lines", x_set_menu_bar_lines,
1edf84e7
GV		 714 "mouse-color", x_set_mouse_color,
715 "name", x_explicitly_set_name,
ee78dc32 716 "scroll-bar-width", x_set_scroll_bar_width,
1edf84e7 717 "title", x_set_title,
ee78dc32 718 "unsplittable", x_set_unsplittable,
1edf84e7
GV		 719 "vertical-scroll-bars", x_set_vertical_scroll_bars,
720 "visibility", x_set_visibility,
6fc2811b 721 "tool-bar-lines", x_set_tool_bar_lines,
dfff8a69
JR		 722 "screen-gamma", x_set_screen_gamma,
723 "line-spacing", x_set_line_spacing
ee78dc32
GV		 724};
725
726/* Attach the `x-frame-parameter' properties to
fbd6baed 727 the Lisp symbol names of parameters relevant to W32. */
ee78dc32 728
dfff8a69 729void
ee78dc32
GV		 730init_x_parm_symbols ()
731{
732 int i;
733
734 for (i = 0; i < sizeof (x_frame_parms) / sizeof (x_frame_parms[0]); i++)
735 Fput (intern (x_frame_parms[i].name), Qx_frame_parameter,
736 make_number (i));
737}
738\f
dfff8a69 739/* Change the parameters of frame F as specified by ALIST.
ee78dc32
GV		 740 If a parameter is not specially recognized, do nothing;
741 otherwise call the `x_set_...' function for that parameter. */
742
743void
744x_set_frame_parameters (f, alist)
745 FRAME_PTR f;
746 Lisp_Object alist;
747{
748 Lisp_Object tail;
749
750 /* If both of these parameters are present, it's more efficient to
751 set them both at once. So we wait until we've looked at the
752 entire list before we set them. */
b839712d 753 int width, height;
ee78dc32
GV		 754
755 /* Same here. */
756 Lisp_Object left, top;
757
758 /* Same with these. */
759 Lisp_Object icon_left, icon_top;
760
761 /* Record in these vectors all the parms specified. */
762 Lisp_Object *parms;
763 Lisp_Object *values;
a797a73d 764 int i, p;
ee78dc32
GV		 765 int left_no_change = 0, top_no_change = 0;
766 int icon_left_no_change = 0, icon_top_no_change = 0;
767
5878523b
RS		 768 struct gcpro gcpro1, gcpro2;
769
ee78dc32
GV		 770 i = 0;
771 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
772 i++;
773
774 parms = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
775 values = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
776
777 /* Extract parm names and values into those vectors. */
778
779 i = 0;
780 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
781 {
6fc2811b 782 Lisp_Object elt;
ee78dc32
GV		 783
784 elt = Fcar (tail);
785 parms[i] = Fcar (elt);
786 values[i] = Fcdr (elt);
787 i++;
788 }
5878523b
RS		 789 /* TAIL and ALIST are not used again below here. */
790 alist = tail = Qnil;
791
792 GCPRO2 (*parms, *values);
793 gcpro1.nvars = i;
794 gcpro2.nvars = i;
795
796 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
797 because their values appear in VALUES and strings are not valid. */
b839712d 798 top = left = Qunbound;
ee78dc32
GV		 799 icon_left = icon_top = Qunbound;
800
b839712d 801 /* Provide default values for HEIGHT and WIDTH. */
dfff8a69
JR		 802 if (FRAME_NEW_WIDTH (f))
803 width = FRAME_NEW_WIDTH (f);
804 else
805 width = FRAME_WIDTH (f);
806
807 if (FRAME_NEW_HEIGHT (f))
808 height = FRAME_NEW_HEIGHT (f);
809 else
810 height = FRAME_HEIGHT (f);
b839712d 811
a797a73d
GV		 812 /* Process foreground_color and background_color before anything else.
813 They are independent of other properties, but other properties (e.g.,
814 cursor_color) are dependent upon them. */
815 for (p = 0; p < i; p++)
816 {
817 Lisp_Object prop, val;
818
819 prop = parms[p];
820 val = values[p];
821 if (EQ (prop, Qforeground_color) || EQ (prop, Qbackground_color))
822 {
823 register Lisp_Object param_index, old_value;
824
825 param_index = Fget (prop, Qx_frame_parameter);
826 old_value = get_frame_param (f, prop);
827 store_frame_param (f, prop, val);
828 if (NATNUMP (param_index)
829 && (XFASTINT (param_index)
830 < sizeof (x_frame_parms)/sizeof (x_frame_parms[0])))
831 (*x_frame_parms[XINT (param_index)].setter)(f, val, old_value);
832 }
833 }
834
ee78dc32
GV		 835 /* Now process them in reverse of specified order. */
836 for (i--; i >= 0; i--)
837 {
838 Lisp_Object prop, val;
839
840 prop = parms[i];
841 val = values[i];
842
b839712d
RS		 843 if (EQ (prop, Qwidth) && NUMBERP (val))
844 width = XFASTINT (val);
845 else if (EQ (prop, Qheight) && NUMBERP (val))
846 height = XFASTINT (val);
ee78dc32
GV		 847 else if (EQ (prop, Qtop))
848 top = val;
849 else if (EQ (prop, Qleft))
850 left = val;
851 else if (EQ (prop, Qicon_top))
852 icon_top = val;
853 else if (EQ (prop, Qicon_left))
854 icon_left = val;
a797a73d
GV		 855 else if (EQ (prop, Qforeground_color) || EQ (prop, Qbackground_color))
856 /* Processed above. */
857 continue;
ee78dc32
GV		 858 else
859 {
860 register Lisp_Object param_index, old_value;
861
862 param_index = Fget (prop, Qx_frame_parameter);
863 old_value = get_frame_param (f, prop);
864 store_frame_param (f, prop, val);
865 if (NATNUMP (param_index)
866 && (XFASTINT (param_index)
867 < sizeof (x_frame_parms)/sizeof (x_frame_parms[0])))
3c190163 868 (*x_frame_parms[XINT (param_index)].setter)(f, val, old_value);
ee78dc32
GV		 869 }
870 }
871
872 /* Don't die if just one of these was set. */
873 if (EQ (left, Qunbound))
874 {
875 left_no_change = 1;
fbd6baed
GV		 876 if (f->output_data.w32->left_pos < 0)
877 left = Fcons (Qplus, Fcons (make_number (f->output_data.w32->left_pos), Qnil));
ee78dc32 878 else
fbd6baed 879 XSETINT (left, f->output_data.w32->left_pos);
ee78dc32
GV		 880 }
881 if (EQ (top, Qunbound))
882 {
883 top_no_change = 1;
fbd6baed
GV		 884 if (f->output_data.w32->top_pos < 0)
885 top = Fcons (Qplus, Fcons (make_number (f->output_data.w32->top_pos), Qnil));
ee78dc32 886 else
fbd6baed 887 XSETINT (top, f->output_data.w32->top_pos);
ee78dc32
GV		 888 }
889
890 /* If one of the icon positions was not set, preserve or default it. */
891 if (EQ (icon_left, Qunbound) || ! INTEGERP (icon_left))
892 {
893 icon_left_no_change = 1;
894 icon_left = Fcdr (Fassq (Qicon_left, f->param_alist));
895 if (NILP (icon_left))
896 XSETINT (icon_left, 0);
897 }
898 if (EQ (icon_top, Qunbound) || ! INTEGERP (icon_top))
899 {
900 icon_top_no_change = 1;
901 icon_top = Fcdr (Fassq (Qicon_top, f->param_alist));
902 if (NILP (icon_top))
903 XSETINT (icon_top, 0);
904 }
905
ee78dc32
GV		 906 /* Don't set these parameters unless they've been explicitly
907 specified. The window might be mapped or resized while we're in
908 this function, and we don't want to override that unless the lisp
909 code has asked for it.
910
911 Don't set these parameters unless they actually differ from the
912 window's current parameters; the window may not actually exist
913 yet. */
914 {
915 Lisp_Object frame;
916
917 check_frame_size (f, &height, &width);
918
919 XSETFRAME (frame, f);
920
dfff8a69
JR		 921 if (width != FRAME_WIDTH (f)
922 || height != FRAME_HEIGHT (f)
923 || FRAME_NEW_HEIGHT (f) || FRAME_NEW_WIDTH (f))
b839712d 924 Fset_frame_size (frame, make_number (width), make_number (height));
ee78dc32
GV		 925
926 if ((!NILP (left) || !NILP (top))
927 && ! (left_no_change && top_no_change)
fbd6baed
GV		 928 && ! (NUMBERP (left) && XINT (left) == f->output_data.w32->left_pos
929 && NUMBERP (top) && XINT (top) == f->output_data.w32->top_pos))
ee78dc32
GV		 930 {
931 int leftpos = 0;
932 int toppos = 0;
933
934 /* Record the signs. */
fbd6baed 935 f->output_data.w32->size_hint_flags &= ~ (XNegative | YNegative);
ee78dc32 936 if (EQ (left, Qminus))
fbd6baed 937 f->output_data.w32->size_hint_flags |= XNegative;
ee78dc32
GV		 938 else if (INTEGERP (left))
939 {
940 leftpos = XINT (left);
941 if (leftpos < 0)
fbd6baed 942 f->output_data.w32->size_hint_flags |= XNegative;
ee78dc32 943 }
8e713be6
KR		 944 else if (CONSP (left) && EQ (XCAR (left), Qminus)
945 && CONSP (XCDR (left))
946 && INTEGERP (XCAR (XCDR (left))))
ee78dc32 947 {
8e713be6 948 leftpos = - XINT (XCAR (XCDR (left)));
fbd6baed 949 f->output_data.w32->size_hint_flags |= XNegative;
ee78dc32 950 }
8e713be6
KR		 951 else if (CONSP (left) && EQ (XCAR (left), Qplus)
952 && CONSP (XCDR (left))
953 && INTEGERP (XCAR (XCDR (left))))
ee78dc32 954 {
8e713be6 955 leftpos = XINT (XCAR (XCDR (left)));
ee78dc32
GV		 956 }
957
958 if (EQ (top, Qminus))
fbd6baed 959 f->output_data.w32->size_hint_flags |= YNegative;
ee78dc32
GV		 960 else if (INTEGERP (top))
961 {
962 toppos = XINT (top);
963 if (toppos < 0)
fbd6baed 964 f->output_data.w32->size_hint_flags |= YNegative;
ee78dc32 965 }
8e713be6
KR		 966 else if (CONSP (top) && EQ (XCAR (top), Qminus)
967 && CONSP (XCDR (top))
968 && INTEGERP (XCAR (XCDR (top))))
ee78dc32 969 {
8e713be6 970 toppos = - XINT (XCAR (XCDR (top)));
fbd6baed 971 f->output_data.w32->size_hint_flags |= YNegative;
ee78dc32 972 }
8e713be6
KR		 973 else if (CONSP (top) && EQ (XCAR (top), Qplus)
974 && CONSP (XCDR (top))
975 && INTEGERP (XCAR (XCDR (top))))
ee78dc32 976 {
8e713be6 977 toppos = XINT (XCAR (XCDR (top)));
ee78dc32
GV		 978 }
979
980
981 /* Store the numeric value of the position. */
fbd6baed
GV		 982 f->output_data.w32->top_pos = toppos;
983 f->output_data.w32->left_pos = leftpos;
ee78dc32 984
fbd6baed 985 f->output_data.w32->win_gravity = NorthWestGravity;
ee78dc32
GV		 986
987 /* Actually set that position, and convert to absolute. */
988 x_set_offset (f, leftpos, toppos, -1);
989 }
990
991 if ((!NILP (icon_left) || !NILP (icon_top))
992 && ! (icon_left_no_change && icon_top_no_change))
993 x_wm_set_icon_position (f, XINT (icon_left), XINT (icon_top));
994 }
5878523b
RS		 995
996 UNGCPRO;
ee78dc32
GV		 997}
998
999/* Store the screen positions of frame F into XPTR and YPTR.
1000 These are the positions of the containing window manager window,
1001 not Emacs's own window. */
1002
1003void
1004x_real_positions (f, xptr, yptr)
1005 FRAME_PTR f;
1006 int *xptr, *yptr;
1007{
1008 POINT pt;
3c190163
GV		 1009
1010 {
1011 RECT rect;
ee78dc32 1012
fbd6baed
GV		 1013 GetClientRect(FRAME_W32_WINDOW(f), &rect);
1014 AdjustWindowRect(&rect, f->output_data.w32->dwStyle, FRAME_EXTERNAL_MENU_BAR(f));
ee78dc32 1015
3c190163
GV		 1016 pt.x = rect.left;
1017 pt.y = rect.top;
1018 }
ee78dc32 1019
fbd6baed 1020 ClientToScreen (FRAME_W32_WINDOW(f), &pt);
ee78dc32
GV		 1021
1022 *xptr = pt.x;
1023 *yptr = pt.y;
1024}
1025
1026/* Insert a description of internally-recorded parameters of frame X
1027 into the parameter alist *ALISTPTR that is to be given to the user.
fbd6baed 1028 Only parameters that are specific to W32
ee78dc32
GV		 1029 and whose values are not correctly recorded in the frame's
1030 param_alist need to be considered here. */
1031
dfff8a69 1032void
ee78dc32
GV		 1033x_report_frame_params (f, alistptr)
1034 struct frame *f;
1035 Lisp_Object *alistptr;
1036{
1037 char buf[16];
1038 Lisp_Object tem;
1039
1040 /* Represent negative positions (off the top or left screen edge)
1041 in a way that Fmodify_frame_parameters will understand correctly. */
fbd6baed
GV		 1042 XSETINT (tem, f->output_data.w32->left_pos);
1043 if (f->output_data.w32->left_pos >= 0)
ee78dc32
GV		 1044 store_in_alist (alistptr, Qleft, tem);
1045 else
1046 store_in_alist (alistptr, Qleft, Fcons (Qplus, Fcons (tem, Qnil)));
1047
fbd6baed
GV		 1048 XSETINT (tem, f->output_data.w32->top_pos);
1049 if (f->output_data.w32->top_pos >= 0)
ee78dc32
GV		 1050 store_in_alist (alistptr, Qtop, tem);
1051 else
1052 store_in_alist (alistptr, Qtop, Fcons (Qplus, Fcons (tem, Qnil)));
1053
1054 store_in_alist (alistptr, Qborder_width,
fbd6baed 1055 make_number (f->output_data.w32->border_width));
ee78dc32 1056 store_in_alist (alistptr, Qinternal_border_width,
fbd6baed
GV		 1057 make_number (f->output_data.w32->internal_border_width));
1058 sprintf (buf, "%ld", (long) FRAME_W32_WINDOW (f));
ee78dc32
GV		 1059 store_in_alist (alistptr, Qwindow_id,
1060 build_string (buf));
1061 store_in_alist (alistptr, Qicon_name, f->icon_name);
1062 FRAME_SAMPLE_VISIBILITY (f);
1063 store_in_alist (alistptr, Qvisibility,
1064 (FRAME_VISIBLE_P (f) ? Qt
1065 : FRAME_ICONIFIED_P (f) ? Qicon : Qnil));
1066 store_in_alist (alistptr, Qdisplay,
8e713be6 1067 XCAR (FRAME_W32_DISPLAY_INFO (f)->name_list_element));
ee78dc32
GV		 1068}
1069\f
1070
fbd6baed 1071DEFUN ("w32-define-rgb-color", Fw32_define_rgb_color, Sw32_define_rgb_color, 4, 4, 0,
5ac45f98 1072 "Convert RGB numbers to a windows color reference and associate with NAME (a string).\n\
fbd6baed 1073This adds or updates a named color to w32-color-map, making it available for use.\n\
5ac45f98
GV		 1074The original entry's RGB ref is returned, or nil if the entry is new.")
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
1082 CHECK_NUMBER (red, 0);
1083 CHECK_NUMBER (green, 0);
1084 CHECK_NUMBER (blue, 0);
1085 CHECK_STRING (name, 0);
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
fbd6baed 1109DEFUN ("w32-load-color-file", Fw32_load_color_file, Sw32_load_color_file, 1, 1, 0,
5ac45f98 1110 "Create an alist of color entries from an external file (ie. rgb.txt).\n\
fbd6baed 1111Assign this value to w32-color-map to replace the existing color map.\n\
5ac45f98
GV		 1112\
1113The file should define one named RGB color per line like so:\
1114 R G B name\n\
1115where R,G,B are numbers between 0 and 255 and name is an arbitrary string.")
1116 (filename)
1117 Lisp_Object filename;
1118{
1119 FILE *fp;
1120 Lisp_Object cmap = Qnil;
1121 Lisp_Object abspath;
1122
1123 CHECK_STRING (filename, 0);
1124 abspath = Fexpand_file_name (filename, Qnil);
1125
1126 fp = fopen (XSTRING (filename)->data, "rt");
1127 if (fp)
1128 {
1129 char buf[512];
1130 int red, green, blue;
1131 int num;
1132
1133 BLOCK_INPUT;
1134
1135 while (fgets (buf, sizeof (buf), fp) != NULL) {
1136 if (sscanf (buf, "%u %u %u %n", &red, &green, &blue, &num) == 3)
1137 {
1138 char *name = buf + num;
1139 num = strlen (name) - 1;
1140 if (name[num] == '\n')
1141 name[num] = 0;
1142 cmap = Fcons (Fcons (build_string (name),
1143 make_number (RGB (red, green, blue))),
1144 cmap);
1145 }
1146 }
1147 fclose (fp);
1148
1149 UNBLOCK_INPUT;
1150 }
1151
1152 return cmap;
1153}
ee78dc32 1154
fbd6baed 1155/* The default colors for the w32 color map */
ee78dc32
GV		 1156typedef struct colormap_t
1157{
1158 char *name;
1159 COLORREF colorref;
1160} colormap_t;
1161
fbd6baed 1162colormap_t w32_color_map[] =
ee78dc32 1163{
1da8a614
GV		 1164 {"snow" , PALETTERGB (255,250,250)},
1165 {"ghost white" , PALETTERGB (248,248,255)},
1166 {"GhostWhite" , PALETTERGB (248,248,255)},
1167 {"white smoke" , PALETTERGB (245,245,245)},
1168 {"WhiteSmoke" , PALETTERGB (245,245,245)},
1169 {"gainsboro" , PALETTERGB (220,220,220)},
1170 {"floral white" , PALETTERGB (255,250,240)},
1171 {"FloralWhite" , PALETTERGB (255,250,240)},
1172 {"old lace" , PALETTERGB (253,245,230)},
1173 {"OldLace" , PALETTERGB (253,245,230)},
1174 {"linen" , PALETTERGB (250,240,230)},
1175 {"antique white" , PALETTERGB (250,235,215)},
1176 {"AntiqueWhite" , PALETTERGB (250,235,215)},
1177 {"papaya whip" , PALETTERGB (255,239,213)},
1178 {"PapayaWhip" , PALETTERGB (255,239,213)},
1179 {"blanched almond" , PALETTERGB (255,235,205)},
1180 {"BlanchedAlmond" , PALETTERGB (255,235,205)},
1181 {"bisque" , PALETTERGB (255,228,196)},
1182 {"peach puff" , PALETTERGB (255,218,185)},
1183 {"PeachPuff" , PALETTERGB (255,218,185)},
1184 {"navajo white" , PALETTERGB (255,222,173)},
1185 {"NavajoWhite" , PALETTERGB (255,222,173)},
1186 {"moccasin" , PALETTERGB (255,228,181)},
1187 {"cornsilk" , PALETTERGB (255,248,220)},
1188 {"ivory" , PALETTERGB (255,255,240)},
1189 {"lemon chiffon" , PALETTERGB (255,250,205)},
1190 {"LemonChiffon" , PALETTERGB (255,250,205)},
1191 {"seashell" , PALETTERGB (255,245,238)},
1192 {"honeydew" , PALETTERGB (240,255,240)},
1193 {"mint cream" , PALETTERGB (245,255,250)},
1194 {"MintCream" , PALETTERGB (245,255,250)},
1195 {"azure" , PALETTERGB (240,255,255)},
1196 {"alice blue" , PALETTERGB (240,248,255)},
1197 {"AliceBlue" , PALETTERGB (240,248,255)},
1198 {"lavender" , PALETTERGB (230,230,250)},
1199 {"lavender blush" , PALETTERGB (255,240,245)},
1200 {"LavenderBlush" , PALETTERGB (255,240,245)},
1201 {"misty rose" , PALETTERGB (255,228,225)},
1202 {"MistyRose" , PALETTERGB (255,228,225)},
1203 {"white" , PALETTERGB (255,255,255)},
1204 {"black" , PALETTERGB ( 0, 0, 0)},
1205 {"dark slate gray" , PALETTERGB ( 47, 79, 79)},
1206 {"DarkSlateGray" , PALETTERGB ( 47, 79, 79)},
1207 {"dark slate grey" , PALETTERGB ( 47, 79, 79)},
1208 {"DarkSlateGrey" , PALETTERGB ( 47, 79, 79)},
1209 {"dim gray" , PALETTERGB (105,105,105)},
1210 {"DimGray" , PALETTERGB (105,105,105)},
1211 {"dim grey" , PALETTERGB (105,105,105)},
1212 {"DimGrey" , PALETTERGB (105,105,105)},
1213 {"slate gray" , PALETTERGB (112,128,144)},
1214 {"SlateGray" , PALETTERGB (112,128,144)},
1215 {"slate grey" , PALETTERGB (112,128,144)},
1216 {"SlateGrey" , PALETTERGB (112,128,144)},
1217 {"light slate gray" , PALETTERGB (119,136,153)},
1218 {"LightSlateGray" , PALETTERGB (119,136,153)},
1219 {"light slate grey" , PALETTERGB (119,136,153)},
1220 {"LightSlateGrey" , PALETTERGB (119,136,153)},
1221 {"gray" , PALETTERGB (190,190,190)},
1222 {"grey" , PALETTERGB (190,190,190)},
1223 {"light grey" , PALETTERGB (211,211,211)},
1224 {"LightGrey" , PALETTERGB (211,211,211)},
1225 {"light gray" , PALETTERGB (211,211,211)},
1226 {"LightGray" , PALETTERGB (211,211,211)},
1227 {"midnight blue" , PALETTERGB ( 25, 25,112)},
1228 {"MidnightBlue" , PALETTERGB ( 25, 25,112)},
1229 {"navy" , PALETTERGB ( 0, 0,128)},
1230 {"navy blue" , PALETTERGB ( 0, 0,128)},
1231 {"NavyBlue" , PALETTERGB ( 0, 0,128)},
1232 {"cornflower blue" , PALETTERGB (100,149,237)},
1233 {"CornflowerBlue" , PALETTERGB (100,149,237)},
1234 {"dark slate blue" , PALETTERGB ( 72, 61,139)},
1235 {"DarkSlateBlue" , PALETTERGB ( 72, 61,139)},
1236 {"slate blue" , PALETTERGB (106, 90,205)},
1237 {"SlateBlue" , PALETTERGB (106, 90,205)},
1238 {"medium slate blue" , PALETTERGB (123,104,238)},
1239 {"MediumSlateBlue" , PALETTERGB (123,104,238)},
1240 {"light slate blue" , PALETTERGB (132,112,255)},
1241 {"LightSlateBlue" , PALETTERGB (132,112,255)},
1242 {"medium blue" , PALETTERGB ( 0, 0,205)},
1243 {"MediumBlue" , PALETTERGB ( 0, 0,205)},
1244 {"royal blue" , PALETTERGB ( 65,105,225)},
1245 {"RoyalBlue" , PALETTERGB ( 65,105,225)},
1246 {"blue" , PALETTERGB ( 0, 0,255)},
1247 {"dodger blue" , PALETTERGB ( 30,144,255)},
1248 {"DodgerBlue" , PALETTERGB ( 30,144,255)},
1249 {"deep sky blue" , PALETTERGB ( 0,191,255)},
1250 {"DeepSkyBlue" , PALETTERGB ( 0,191,255)},
1251 {"sky blue" , PALETTERGB (135,206,235)},
1252 {"SkyBlue" , PALETTERGB (135,206,235)},
1253 {"light sky blue" , PALETTERGB (135,206,250)},
1254 {"LightSkyBlue" , PALETTERGB (135,206,250)},
1255 {"steel blue" , PALETTERGB ( 70,130,180)},
1256 {"SteelBlue" , PALETTERGB ( 70,130,180)},
1257 {"light steel blue" , PALETTERGB (176,196,222)},
1258 {"LightSteelBlue" , PALETTERGB (176,196,222)},
1259 {"light blue" , PALETTERGB (173,216,230)},
1260 {"LightBlue" , PALETTERGB (173,216,230)},
1261 {"powder blue" , PALETTERGB (176,224,230)},
1262 {"PowderBlue" , PALETTERGB (176,224,230)},
1263 {"pale turquoise" , PALETTERGB (175,238,238)},
1264 {"PaleTurquoise" , PALETTERGB (175,238,238)},
1265 {"dark turquoise" , PALETTERGB ( 0,206,209)},
1266 {"DarkTurquoise" , PALETTERGB ( 0,206,209)},
1267 {"medium turquoise" , PALETTERGB ( 72,209,204)},
1268 {"MediumTurquoise" , PALETTERGB ( 72,209,204)},
1269 {"turquoise" , PALETTERGB ( 64,224,208)},
1270 {"cyan" , PALETTERGB ( 0,255,255)},
1271 {"light cyan" , PALETTERGB (224,255,255)},
1272 {"LightCyan" , PALETTERGB (224,255,255)},
1273 {"cadet blue" , PALETTERGB ( 95,158,160)},
1274 {"CadetBlue" , PALETTERGB ( 95,158,160)},
1275 {"medium aquamarine" , PALETTERGB (102,205,170)},
1276 {"MediumAquamarine" , PALETTERGB (102,205,170)},
1277 {"aquamarine" , PALETTERGB (127,255,212)},
1278 {"dark green" , PALETTERGB ( 0,100, 0)},
1279 {"DarkGreen" , PALETTERGB ( 0,100, 0)},
1280 {"dark olive green" , PALETTERGB ( 85,107, 47)},
1281 {"DarkOliveGreen" , PALETTERGB ( 85,107, 47)},
1282 {"dark sea green" , PALETTERGB (143,188,143)},
1283 {"DarkSeaGreen" , PALETTERGB (143,188,143)},
1284 {"sea green" , PALETTERGB ( 46,139, 87)},
1285 {"SeaGreen" , PALETTERGB ( 46,139, 87)},
1286 {"medium sea green" , PALETTERGB ( 60,179,113)},
1287 {"MediumSeaGreen" , PALETTERGB ( 60,179,113)},
1288 {"light sea green" , PALETTERGB ( 32,178,170)},
1289 {"LightSeaGreen" , PALETTERGB ( 32,178,170)},
1290 {"pale green" , PALETTERGB (152,251,152)},
1291 {"PaleGreen" , PALETTERGB (152,251,152)},
1292 {"spring green" , PALETTERGB ( 0,255,127)},
1293 {"SpringGreen" , PALETTERGB ( 0,255,127)},
1294 {"lawn green" , PALETTERGB (124,252, 0)},
1295 {"LawnGreen" , PALETTERGB (124,252, 0)},
1296 {"green" , PALETTERGB ( 0,255, 0)},
1297 {"chartreuse" , PALETTERGB (127,255, 0)},
1298 {"medium spring green" , PALETTERGB ( 0,250,154)},
1299 {"MediumSpringGreen" , PALETTERGB ( 0,250,154)},
1300 {"green yellow" , PALETTERGB (173,255, 47)},
1301 {"GreenYellow" , PALETTERGB (173,255, 47)},
1302 {"lime green" , PALETTERGB ( 50,205, 50)},
1303 {"LimeGreen" , PALETTERGB ( 50,205, 50)},
1304 {"yellow green" , PALETTERGB (154,205, 50)},
1305 {"YellowGreen" , PALETTERGB (154,205, 50)},
1306 {"forest green" , PALETTERGB ( 34,139, 34)},
1307 {"ForestGreen" , PALETTERGB ( 34,139, 34)},
1308 {"olive drab" , PALETTERGB (107,142, 35)},
1309 {"OliveDrab" , PALETTERGB (107,142, 35)},
1310 {"dark khaki" , PALETTERGB (189,183,107)},
1311 {"DarkKhaki" , PALETTERGB (189,183,107)},
1312 {"khaki" , PALETTERGB (240,230,140)},
1313 {"pale goldenrod" , PALETTERGB (238,232,170)},
1314 {"PaleGoldenrod" , PALETTERGB (238,232,170)},
1315 {"light goldenrod yellow" , PALETTERGB (250,250,210)},
1316 {"LightGoldenrodYellow" , PALETTERGB (250,250,210)},
1317 {"light yellow" , PALETTERGB (255,255,224)},
1318 {"LightYellow" , PALETTERGB (255,255,224)},
1319 {"yellow" , PALETTERGB (255,255, 0)},
1320 {"gold" , PALETTERGB (255,215, 0)},
1321 {"light goldenrod" , PALETTERGB (238,221,130)},
1322 {"LightGoldenrod" , PALETTERGB (238,221,130)},
1323 {"goldenrod" , PALETTERGB (218,165, 32)},
1324 {"dark goldenrod" , PALETTERGB (184,134, 11)},
1325 {"DarkGoldenrod" , PALETTERGB (184,134, 11)},
1326 {"rosy brown" , PALETTERGB (188,143,143)},
1327 {"RosyBrown" , PALETTERGB (188,143,143)},
1328 {"indian red" , PALETTERGB (205, 92, 92)},
1329 {"IndianRed" , PALETTERGB (205, 92, 92)},
1330 {"saddle brown" , PALETTERGB (139, 69, 19)},
1331 {"SaddleBrown" , PALETTERGB (139, 69, 19)},
1332 {"sienna" , PALETTERGB (160, 82, 45)},
1333 {"peru" , PALETTERGB (205,133, 63)},
1334 {"burlywood" , PALETTERGB (222,184,135)},
1335 {"beige" , PALETTERGB (245,245,220)},
1336 {"wheat" , PALETTERGB (245,222,179)},
1337 {"sandy brown" , PALETTERGB (244,164, 96)},
1338 {"SandyBrown" , PALETTERGB (244,164, 96)},
1339 {"tan" , PALETTERGB (210,180,140)},
1340 {"chocolate" , PALETTERGB (210,105, 30)},
1341 {"firebrick" , PALETTERGB (178,34, 34)},
1342 {"brown" , PALETTERGB (165,42, 42)},
1343 {"dark salmon" , PALETTERGB (233,150,122)},
1344 {"DarkSalmon" , PALETTERGB (233,150,122)},
1345 {"salmon" , PALETTERGB (250,128,114)},
1346 {"light salmon" , PALETTERGB (255,160,122)},
1347 {"LightSalmon" , PALETTERGB (255,160,122)},
1348 {"orange" , PALETTERGB (255,165, 0)},
1349 {"dark orange" , PALETTERGB (255,140, 0)},
1350 {"DarkOrange" , PALETTERGB (255,140, 0)},
1351 {"coral" , PALETTERGB (255,127, 80)},
1352 {"light coral" , PALETTERGB (240,128,128)},
1353 {"LightCoral" , PALETTERGB (240,128,128)},
1354 {"tomato" , PALETTERGB (255, 99, 71)},
1355 {"orange red" , PALETTERGB (255, 69, 0)},
1356 {"OrangeRed" , PALETTERGB (255, 69, 0)},
1357 {"red" , PALETTERGB (255, 0, 0)},
1358 {"hot pink" , PALETTERGB (255,105,180)},
1359 {"HotPink" , PALETTERGB (255,105,180)},
1360 {"deep pink" , PALETTERGB (255, 20,147)},
1361 {"DeepPink" , PALETTERGB (255, 20,147)},
1362 {"pink" , PALETTERGB (255,192,203)},
1363 {"light pink" , PALETTERGB (255,182,193)},
1364 {"LightPink" , PALETTERGB (255,182,193)},
1365 {"pale violet red" , PALETTERGB (219,112,147)},
1366 {"PaleVioletRed" , PALETTERGB (219,112,147)},
1367 {"maroon" , PALETTERGB (176, 48, 96)},
1368 {"medium violet red" , PALETTERGB (199, 21,133)},
1369 {"MediumVioletRed" , PALETTERGB (199, 21,133)},
1370 {"violet red" , PALETTERGB (208, 32,144)},
1371 {"VioletRed" , PALETTERGB (208, 32,144)},
1372 {"magenta" , PALETTERGB (255, 0,255)},
1373 {"violet" , PALETTERGB (238,130,238)},
1374 {"plum" , PALETTERGB (221,160,221)},
1375 {"orchid" , PALETTERGB (218,112,214)},
1376 {"medium orchid" , PALETTERGB (186, 85,211)},
1377 {"MediumOrchid" , PALETTERGB (186, 85,211)},
1378 {"dark orchid" , PALETTERGB (153, 50,204)},
1379 {"DarkOrchid" , PALETTERGB (153, 50,204)},
1380 {"dark violet" , PALETTERGB (148, 0,211)},
1381 {"DarkViolet" , PALETTERGB (148, 0,211)},
1382 {"blue violet" , PALETTERGB (138, 43,226)},
1383 {"BlueViolet" , PALETTERGB (138, 43,226)},
1384 {"purple" , PALETTERGB (160, 32,240)},
1385 {"medium purple" , PALETTERGB (147,112,219)},
1386 {"MediumPurple" , PALETTERGB (147,112,219)},
1387 {"thistle" , PALETTERGB (216,191,216)},
1388 {"gray0" , PALETTERGB ( 0, 0, 0)},
1389 {"grey0" , PALETTERGB ( 0, 0, 0)},
1390 {"dark grey" , PALETTERGB (169,169,169)},
1391 {"DarkGrey" , PALETTERGB (169,169,169)},
1392 {"dark gray" , PALETTERGB (169,169,169)},
1393 {"DarkGray" , PALETTERGB (169,169,169)},
1394 {"dark blue" , PALETTERGB ( 0, 0,139)},
1395 {"DarkBlue" , PALETTERGB ( 0, 0,139)},
1396 {"dark cyan" , PALETTERGB ( 0,139,139)},
1397 {"DarkCyan" , PALETTERGB ( 0,139,139)},
1398 {"dark magenta" , PALETTERGB (139, 0,139)},
1399 {"DarkMagenta" , PALETTERGB (139, 0,139)},
1400 {"dark red" , PALETTERGB (139, 0, 0)},
1401 {"DarkRed" , PALETTERGB (139, 0, 0)},
1402 {"light green" , PALETTERGB (144,238,144)},
1403 {"LightGreen" , PALETTERGB (144,238,144)},
ee78dc32
GV		 1404};
1405
fbd6baed 1406DEFUN ("w32-default-color-map", Fw32_default_color_map, Sw32_default_color_map,
ee78dc32
GV		 1407 0, 0, 0, "Return the default color map.")
1408 ()
1409{
1410 int i;
fbd6baed 1411 colormap_t *pc = w32_color_map;
ee78dc32
GV		 1412 Lisp_Object cmap;
1413
1414 BLOCK_INPUT;
1415
1416 cmap = Qnil;
1417
fbd6baed 1418 for (i = 0; i < sizeof (w32_color_map) / sizeof (w32_color_map[0]);
ee78dc32
GV		 1419 pc++, i++)
1420 cmap = Fcons (Fcons (build_string (pc->name),
1421 make_number (pc->colorref)),
1422 cmap);
1423
1424 UNBLOCK_INPUT;
1425
1426 return (cmap);
1427}
ee78dc32
GV		 1428
1429Lisp_Object
fbd6baed 1430w32_to_x_color (rgb)
ee78dc32
GV		 1431 Lisp_Object rgb;
1432{
1433 Lisp_Object color;
1434
1435 CHECK_NUMBER (rgb, 0);
1436
1437 BLOCK_INPUT;
1438
fbd6baed 1439 color = Frassq (rgb, Vw32_color_map);
ee78dc32
GV		 1440
1441 UNBLOCK_INPUT;
1442
1443 if (!NILP (color))
1444 return (Fcar (color));
1445 else
1446 return Qnil;
1447}
1448
5d7fed93
GV		 1449COLORREF
1450w32_color_map_lookup (colorname)
1451 char *colorname;
1452{
1453 Lisp_Object tail, ret = Qnil;
1454
1455 BLOCK_INPUT;
1456
1457 for (tail = Vw32_color_map; !NILP (tail); tail = Fcdr (tail))
1458 {
1459 register Lisp_Object elt, tem;
1460
1461 elt = Fcar (tail);
1462 if (!CONSP (elt)) continue;
1463
1464 tem = Fcar (elt);
1465
1466 if (lstrcmpi (XSTRING (tem)->data, colorname) == 0)
1467 {
1468 ret = XUINT (Fcdr (elt));
1469 break;
1470 }
1471
1472 QUIT;
1473 }
1474
1475
1476 UNBLOCK_INPUT;
1477
1478 return ret;
1479}
1480
ee78dc32 1481COLORREF
fbd6baed 1482x_to_w32_color (colorname)
ee78dc32
GV		 1483 char * colorname;
1484{
8edb0a6f
JR		 1485 register Lisp_Object ret = Qnil;
1486
ee78dc32 1487 BLOCK_INPUT;
1edf84e7
GV		 1488
1489 if (colorname[0] == '#')
1490 {
1491 /* Could be an old-style RGB Device specification. */
1492 char *color;
1493 int size;
1494 color = colorname + 1;
1495
1496 size = strlen(color);
1497 if (size == 3 || size == 6 || size == 9 || size == 12)
1498 {
1499 UINT colorval;
1500 int i, pos;
1501 pos = 0;
1502 size /= 3;
1503 colorval = 0;
1504
1505 for (i = 0; i < 3; i++)
1506 {
1507 char *end;
1508 char t;
1509 unsigned long value;
1510
1511 /* The check for 'x' in the following conditional takes into
1512 account the fact that strtol allows a "0x" in front of
1513 our numbers, and we don't. */
1514 if (!isxdigit(color[0]) || color[1] == 'x')
1515 break;
1516 t = color[size];
1517 color[size] = '\0';
1518 value = strtoul(color, &end, 16);
1519 color[size] = t;
1520 if (errno == ERANGE || end - color != size)
1521 break;
1522 switch (size)
1523 {
1524 case 1:
1525 value = value * 0x10;
1526 break;
1527 case 2:
1528 break;
1529 case 3:
1530 value /= 0x10;
1531 break;
1532 case 4:
1533 value /= 0x100;
1534 break;
1535 }
1536 colorval |= (value << pos);
1537 pos += 0x8;
1538 if (i == 2)
1539 {
1540 UNBLOCK_INPUT;
1541 return (colorval);
1542 }
1543 color = end;
1544 }
1545 }
1546 }
1547 else if (strnicmp(colorname, "rgb:", 4) == 0)
1548 {
1549 char *color;
1550 UINT colorval;
1551 int i, pos;
1552 pos = 0;
1553
1554 colorval = 0;
1555 color = colorname + 4;
1556 for (i = 0; i < 3; i++)
1557 {
1558 char *end;
1559 unsigned long value;
1560
1561 /* The check for 'x' in the following conditional takes into
1562 account the fact that strtol allows a "0x" in front of
1563 our numbers, and we don't. */
1564 if (!isxdigit(color[0]) || color[1] == 'x')
1565 break;
1566 value = strtoul(color, &end, 16);
1567 if (errno == ERANGE)
1568 break;
1569 switch (end - color)
1570 {
1571 case 1:
1572 value = value * 0x10 + value;
1573 break;
1574 case 2:
1575 break;
1576 case 3:
1577 value /= 0x10;
1578 break;
1579 case 4:
1580 value /= 0x100;
1581 break;
1582 default:
1583 value = ULONG_MAX;
1584 }
1585 if (value == ULONG_MAX)
1586 break;
1587 colorval |= (value << pos);
1588 pos += 0x8;
1589 if (i == 2)
1590 {
1591 if (*end != '\0')
1592 break;
1593 UNBLOCK_INPUT;
1594 return (colorval);
1595 }
1596 if (*end != '/')
1597 break;
1598 color = end + 1;
1599 }
1600 }
1601 else if (strnicmp(colorname, "rgbi:", 5) == 0)
1602 {
1603 /* This is an RGB Intensity specification. */
1604 char *color;
1605 UINT colorval;
1606 int i, pos;
1607 pos = 0;
1608
1609 colorval = 0;
1610 color = colorname + 5;
1611 for (i = 0; i < 3; i++)
1612 {
1613 char *end;
1614 double value;
1615 UINT val;
1616
1617 value = strtod(color, &end);
1618 if (errno == ERANGE)
1619 break;
1620 if (value < 0.0 || value > 1.0)
1621 break;
1622 val = (UINT)(0x100 * value);
1623 /* We used 0x100 instead of 0xFF to give an continuous
1624 range between 0.0 and 1.0 inclusive. The next statement
1625 fixes the 1.0 case. */
1626 if (val == 0x100)
1627 val = 0xFF;
1628 colorval |= (val << pos);
1629 pos += 0x8;
1630 if (i == 2)
1631 {
1632 if (*end != '\0')
1633 break;
1634 UNBLOCK_INPUT;
1635 return (colorval);
1636 }
1637 if (*end != '/')
1638 break;
1639 color = end + 1;
1640 }
1641 }
1642 /* I am not going to attempt to handle any of the CIE color schemes
1643 or TekHVC, since I don't know the algorithms for conversion to
1644 RGB. */
f695b4b1
GV		 1645
1646 /* If we fail to lookup the color name in w32_color_map, then check the
1647 colorname to see if it can be crudely approximated: If the X color
1648 ends in a number (e.g., "darkseagreen2"), strip the number and
1649 return the result of looking up the base color name. */
1650 ret = w32_color_map_lookup (colorname);
1651 if (NILP (ret))
ee78dc32 1652 {
f695b4b1 1653 int len = strlen (colorname);
ee78dc32 1654
f695b4b1
GV		 1655 if (isdigit (colorname[len - 1]))
1656 {
8b77111c 1657 char *ptr, *approx = alloca (len + 1);
ee78dc32 1658
f695b4b1
GV		 1659 strcpy (approx, colorname);
1660 ptr = &approx[len - 1];
1661 while (ptr > approx && isdigit (*ptr))
1662 *ptr-- = '\0';
ee78dc32 1663
f695b4b1 1664 ret = w32_color_map_lookup (approx);
ee78dc32 1665 }
ee78dc32
GV		 1666 }
1667
1668 UNBLOCK_INPUT;
ee78dc32
GV		 1669 return ret;
1670}
1671
5ac45f98
GV		 1672
1673void
fbd6baed 1674w32_regenerate_palette (FRAME_PTR f)
5ac45f98 1675{
fbd6baed 1676 struct w32_palette_entry * list;
5ac45f98
GV		 1677 LOGPALETTE * log_palette;
1678 HPALETTE new_palette;
1679 int i;
1680
1681 /* don't bother trying to create palette if not supported */
fbd6baed 1682 if (! FRAME_W32_DISPLAY_INFO (f)->has_palette)
5ac45f98
GV		 1683 return;
1684
1685 log_palette = (LOGPALETTE *)
1686 alloca (sizeof (LOGPALETTE) +
fbd6baed 1687 FRAME_W32_DISPLAY_INFO (f)->num_colors * sizeof (PALETTEENTRY));
5ac45f98 1688 log_palette->palVersion = 0x300;
fbd6baed 1689 log_palette->palNumEntries = FRAME_W32_DISPLAY_INFO (f)->num_colors;
5ac45f98 1690
fbd6baed 1691 list = FRAME_W32_DISPLAY_INFO (f)->color_list;
5ac45f98 1692 for (i = 0;
fbd6baed 1693 i < FRAME_W32_DISPLAY_INFO (f)->num_colors;
5ac45f98
GV		 1694 i++, list = list->next)
1695 log_palette->palPalEntry[i] = list->entry;
1696
1697 new_palette = CreatePalette (log_palette);
1698
1699 enter_crit ();
1700
fbd6baed
GV		 1701 if (FRAME_W32_DISPLAY_INFO (f)->palette)
1702 DeleteObject (FRAME_W32_DISPLAY_INFO (f)->palette);
1703 FRAME_W32_DISPLAY_INFO (f)->palette = new_palette;
5ac45f98
GV		 1704
1705 /* Realize display palette and garbage all frames. */
1706 release_frame_dc (f, get_frame_dc (f));
1707
1708 leave_crit ();
1709}
1710
fbd6baed
GV		 1711#define W32_COLOR(pe) RGB (pe.peRed, pe.peGreen, pe.peBlue)
1712#define SET_W32_COLOR(pe, color) \
5ac45f98
GV		 1713 do \
1714 { \
1715 pe.peRed = GetRValue (color); \
1716 pe.peGreen = GetGValue (color); \
1717 pe.peBlue = GetBValue (color); \
1718 pe.peFlags = 0; \
1719 } while (0)
1720
1721#if 0
1722/* Keep these around in case we ever want to track color usage. */
1723void
fbd6baed 1724w32_map_color (FRAME_PTR f, COLORREF color)
5ac45f98 1725{
fbd6baed 1726 struct w32_palette_entry * list = FRAME_W32_DISPLAY_INFO (f)->color_list;
5ac45f98 1727
fbd6baed 1728 if (NILP (Vw32_enable_palette))
5ac45f98
GV		 1729 return;
1730
1731 /* check if color is already mapped */
1732 while (list)
1733 {
fbd6baed 1734 if (W32_COLOR (list->entry) == color)
5ac45f98
GV		 1735 {
1736 ++list->refcount;
1737 return;
1738 }
1739 list = list->next;
1740 }
1741
1742 /* not already mapped, so add to list and recreate Windows palette */
fbd6baed
GV		 1743 list = (struct w32_palette_entry *)
1744 xmalloc (sizeof (struct w32_palette_entry));
1745 SET_W32_COLOR (list->entry, color);
5ac45f98 1746 list->refcount = 1;
fbd6baed
GV		 1747 list->next = FRAME_W32_DISPLAY_INFO (f)->color_list;
1748 FRAME_W32_DISPLAY_INFO (f)->color_list = list;
1749 FRAME_W32_DISPLAY_INFO (f)->num_colors++;
5ac45f98
GV		 1750
1751 /* set flag that palette must be regenerated */
fbd6baed 1752 FRAME_W32_DISPLAY_INFO (f)->regen_palette = TRUE;
5ac45f98
GV		 1753}
1754
1755void
fbd6baed 1756w32_unmap_color (FRAME_PTR f, COLORREF color)
5ac45f98 1757{
fbd6baed
GV		 1758 struct w32_palette_entry * list = FRAME_W32_DISPLAY_INFO (f)->color_list;
1759 struct w32_palette_entry **prev = &FRAME_W32_DISPLAY_INFO (f)->color_list;
5ac45f98 1760
fbd6baed 1761 if (NILP (Vw32_enable_palette))
5ac45f98
GV		 1762 return;
1763
1764 /* check if color is already mapped */
1765 while (list)
1766 {
fbd6baed 1767 if (W32_COLOR (list->entry) == color)
5ac45f98
GV		 1768 {
1769 if (--list->refcount == 0)
1770 {
1771 *prev = list->next;
1772 xfree (list);
fbd6baed 1773 FRAME_W32_DISPLAY_INFO (f)->num_colors--;
5ac45f98
GV		 1774 break;
1775 }
1776 else
1777 return;
1778 }
1779 prev = &list->next;
1780 list = list->next;
1781 }
1782
1783 /* set flag that palette must be regenerated */
fbd6baed 1784 FRAME_W32_DISPLAY_INFO (f)->regen_palette = TRUE;
5ac45f98
GV		 1785}
1786#endif
1787
6fc2811b
JR		 1788
1789/* Gamma-correct COLOR on frame F. */
1790
1791void
1792gamma_correct (f, color)
1793 struct frame *f;
1794 COLORREF *color;
1795{
1796 if (f->gamma)
1797 {
1798 *color = PALETTERGB (
1799 pow (GetRValue (*color) / 255.0, f->gamma) * 255.0 + 0.5,
1800 pow (GetGValue (*color) / 255.0, f->gamma) * 255.0 + 0.5,
1801 pow (GetBValue (*color) / 255.0, f->gamma) * 255.0 + 0.5);
1802 }
1803}
1804
1805
ee78dc32
GV		 1806/* Decide if color named COLOR is valid for the display associated with
1807 the selected frame; if so, return the rgb values in COLOR_DEF.
1808 If ALLOC is nonzero, allocate a new colormap cell. */
1809
1810int
6fc2811b 1811w32_defined_color (f, color, color_def, alloc)
ee78dc32
GV		 1812 FRAME_PTR f;
1813 char *color;
6fc2811b 1814 XColor *color_def;
ee78dc32
GV		 1815 int alloc;
1816{
1817 register Lisp_Object tem;
6fc2811b 1818 COLORREF w32_color_ref;
3c190163 1819
fbd6baed 1820 tem = x_to_w32_color (color);
3c190163 1821
ee78dc32
GV		 1822 if (!NILP (tem))
1823 {
d88c567c
JR		 1824 if (f)
1825 {
1826 /* Apply gamma correction. */
1827 w32_color_ref = XUINT (tem);
1828 gamma_correct (f, &w32_color_ref);
1829 XSETINT (tem, w32_color_ref);
1830 }
9badad41
JR		 1831
1832 /* Map this color to the palette if it is enabled. */
fbd6baed 1833 if (!NILP (Vw32_enable_palette))
5ac45f98 1834 {
fbd6baed 1835 struct w32_palette_entry * entry =
d88c567c 1836 one_w32_display_info.color_list;
fbd6baed 1837 struct w32_palette_entry ** prev =
d88c567c 1838 &one_w32_display_info.color_list;
5ac45f98
GV		 1839
1840 /* check if color is already mapped */
1841 while (entry)
1842 {
fbd6baed 1843 if (W32_COLOR (entry->entry) == XUINT (tem))
5ac45f98
GV		 1844 break;
1845 prev = &entry->next;
1846 entry = entry->next;
1847 }
1848
1849 if (entry == NULL && alloc)
1850 {
1851 /* not already mapped, so add to list */
fbd6baed
GV		 1852 entry = (struct w32_palette_entry *)
1853 xmalloc (sizeof (struct w32_palette_entry));
1854 SET_W32_COLOR (entry->entry, XUINT (tem));
5ac45f98
GV		 1855 entry->next = NULL;
1856 *prev = entry;
d88c567c 1857 one_w32_display_info.num_colors++;
5ac45f98
GV		 1858
1859 /* set flag that palette must be regenerated */
d88c567c 1860 one_w32_display_info.regen_palette = TRUE;
5ac45f98
GV		 1861 }
1862 }
1863 /* Ensure COLORREF value is snapped to nearest color in (default)
1864 palette by simulating the PALETTERGB macro. This works whether
1865 or not the display device has a palette. */
6fc2811b
JR		 1866 w32_color_ref = XUINT (tem) | 0x2000000;
1867
6fc2811b
JR		 1868 color_def->pixel = w32_color_ref;
1869 color_def->red = GetRValue (w32_color_ref);
1870 color_def->green = GetGValue (w32_color_ref);
1871 color_def->blue = GetBValue (w32_color_ref);
1872
ee78dc32 1873 return 1;
5ac45f98 1874 }
7fb46567 1875 else
3c190163
GV		 1876 {
1877 return 0;
1878 }
ee78dc32
GV		 1879}
1880
1881/* Given a string ARG naming a color, compute a pixel value from it
1882 suitable for screen F.
1883 If F is not a color screen, return DEF (default) regardless of what
1884 ARG says. */
1885
1886int
1887x_decode_color (f, arg, def)
1888 FRAME_PTR f;
1889 Lisp_Object arg;
1890 int def;
1891{
6fc2811b 1892 XColor cdef;
ee78dc32
GV		 1893
1894 CHECK_STRING (arg, 0);
1895
1896 if (strcmp (XSTRING (arg)->data, "black") == 0)
1897 return BLACK_PIX_DEFAULT (f);
1898 else if (strcmp (XSTRING (arg)->data, "white") == 0)
1899 return WHITE_PIX_DEFAULT (f);
1900
fbd6baed 1901 if ((FRAME_W32_DISPLAY_INFO (f)->n_planes * FRAME_W32_DISPLAY_INFO (f)->n_cbits) == 1)
ee78dc32
GV		 1902 return def;
1903
6fc2811b 1904 /* w32_defined_color is responsible for coping with failures
ee78dc32 1905 by looking for a near-miss. */
6fc2811b
JR		 1906 if (w32_defined_color (f, XSTRING (arg)->data, &cdef, 1))
1907 return cdef.pixel;
ee78dc32
GV		 1908
1909 /* defined_color failed; return an ultimate default. */
1910 return def;
1911}
1912\f
dfff8a69
JR		 1913/* Change the `line-spacing' frame parameter of frame F. OLD_VALUE is
1914 the previous value of that parameter, NEW_VALUE is the new value. */
1915
1916static void
1917x_set_line_spacing (f, new_value, old_value)
1918 struct frame *f;
1919 Lisp_Object new_value, old_value;
1920{
1921 if (NILP (new_value))
1922 f->extra_line_spacing = 0;
1923 else if (NATNUMP (new_value))
1924 f->extra_line_spacing = XFASTINT (new_value);
1925 else
1a948b17 1926 Fsignal (Qerror, Fcons (build_string ("Invalid line-spacing"),
dfff8a69
JR		 1927 Fcons (new_value, Qnil)));
1928 if (FRAME_VISIBLE_P (f))
1929 redraw_frame (f);
1930}
1931
1932
6fc2811b
JR		 1933/* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
1934 the previous value of that parameter, NEW_VALUE is the new value. */
1935
1936static void
1937x_set_screen_gamma (f, new_value, old_value)
1938 struct frame *f;
1939 Lisp_Object new_value, old_value;
1940{
1941 if (NILP (new_value))
1942 f->gamma = 0;
1943 else if (NUMBERP (new_value) && XFLOATINT (new_value) > 0)
1944 /* The value 0.4545 is the normal viewing gamma. */
1945 f->gamma = 1.0 / (0.4545 * XFLOATINT (new_value));
1946 else
1a948b17 1947 Fsignal (Qerror, Fcons (build_string ("Invalid screen-gamma"),
6fc2811b
JR		 1948 Fcons (new_value, Qnil)));
1949
1950 clear_face_cache (0);
1951}
1952
1953
ee78dc32
GV		 1954/* Functions called only from `x_set_frame_param'
1955 to set individual parameters.
1956
fbd6baed 1957 If FRAME_W32_WINDOW (f) is 0,
ee78dc32
GV		 1958 the frame is being created and its window does not exist yet.
1959 In that case, just record the parameter's new value
1960 in the standard place; do not attempt to change the window. */
1961
1962void
1963x_set_foreground_color (f, arg, oldval)
1964 struct frame *f;
1965 Lisp_Object arg, oldval;
1966{
3cf3436e
JR		 1967 struct w32_output *x = f->output_data.w32;
1968 PIX_TYPE fg, old_fg;
1969
1970 fg = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1971 old_fg = FRAME_FOREGROUND_PIXEL (f);
1972 FRAME_FOREGROUND_PIXEL (f) = fg;
5ac45f98 1973
fbd6baed 1974 if (FRAME_W32_WINDOW (f) != 0)
ee78dc32 1975 {
3cf3436e
JR		 1976 if (x->cursor_pixel == old_fg)
1977 x->cursor_pixel = fg;
1978
6fc2811b 1979 update_face_from_frame_parameter (f, Qforeground_color, arg);
ee78dc32
GV		 1980 if (FRAME_VISIBLE_P (f))
1981 redraw_frame (f);
1982 }
1983}
1984
1985void
1986x_set_background_color (f, arg, oldval)
1987 struct frame *f;
1988 Lisp_Object arg, oldval;
1989{
6fc2811b 1990 FRAME_BACKGROUND_PIXEL (f)
ee78dc32
GV		 1991 = x_decode_color (f, arg, WHITE_PIX_DEFAULT (f));
1992
fbd6baed 1993 if (FRAME_W32_WINDOW (f) != 0)
ee78dc32 1994 {
6fc2811b
JR		 1995 SetWindowLong (FRAME_W32_WINDOW (f), WND_BACKGROUND_INDEX,
1996 FRAME_BACKGROUND_PIXEL (f));
ee78dc32 1997
6fc2811b 1998 update_face_from_frame_parameter (f, Qbackground_color, arg);
ee78dc32
GV		 1999
2000 if (FRAME_VISIBLE_P (f))
2001 redraw_frame (f);
2002 }
2003}
2004
2005void
2006x_set_mouse_color (f, arg, oldval)
2007 struct frame *f;
2008 Lisp_Object arg, oldval;
2009{
ee78dc32 2010 Cursor cursor, nontext_cursor, mode_cursor, cross_cursor;
dfc465d3 2011 int count;
ee78dc32
GV		 2012 int mask_color;
2013
2014 if (!EQ (Qnil, arg))
fbd6baed 2015 f->output_data.w32->mouse_pixel
ee78dc32 2016 = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
6fc2811b
JR		 2017 mask_color = FRAME_BACKGROUND_PIXEL (f);
2018
2019 /* Don't let pointers be invisible. */
fbd6baed 2020 if (mask_color == f->output_data.w32->mouse_pixel
6fc2811b
JR		 2021 && mask_color == FRAME_BACKGROUND_PIXEL (f))
2022 f->output_data.w32->mouse_pixel = FRAME_FOREGROUND_PIXEL (f);
ee78dc32 2023
767b1ff0 2024#if 0 /* TODO : cursor changes */
ee78dc32
GV		 2025 BLOCK_INPUT;
2026
2027 /* It's not okay to crash if the user selects a screwy cursor. */
fadca6c6 2028 count = x_catch_errors (FRAME_W32_DISPLAY (f));
ee78dc32
GV		 2029
2030 if (!EQ (Qnil, Vx_pointer_shape))
2031 {
2032 CHECK_NUMBER (Vx_pointer_shape, 0);
fbd6baed 2033 cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XINT (Vx_pointer_shape));
ee78dc32
GV		 2034 }
2035 else
fbd6baed
GV		 2036 cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_xterm);
2037 x_check_errors (FRAME_W32_DISPLAY (f), "bad text pointer cursor: %s");
ee78dc32
GV		 2038
2039 if (!EQ (Qnil, Vx_nontext_pointer_shape))
2040 {
2041 CHECK_NUMBER (Vx_nontext_pointer_shape, 0);
fbd6baed 2042 nontext_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f),
ee78dc32
GV		 2043 XINT (Vx_nontext_pointer_shape));
2044 }
2045 else
fbd6baed
GV		 2046 nontext_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_left_ptr);
2047 x_check_errors (FRAME_W32_DISPLAY (f), "bad nontext pointer cursor: %s");
ee78dc32 2048
0af913d7 2049 if (!EQ (Qnil, Vx_hourglass_pointer_shape))
6fc2811b 2050 {
0af913d7
GM		 2051 CHECK_NUMBER (Vx_hourglass_pointer_shape, 0);
2052 hourglass_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f),
2053 XINT (Vx_hourglass_pointer_shape));
6fc2811b
JR		 2054 }
2055 else
0af913d7 2056 hourglass_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_watch);
6fc2811b
JR		 2057 x_check_errors (FRAME_W32_DISPLAY (f), "bad busy pointer cursor: %s");
2058
2059 x_check_errors (FRAME_W32_DISPLAY (f), "bad nontext pointer cursor: %s");
ee78dc32
GV		 2060 if (!EQ (Qnil, Vx_mode_pointer_shape))
2061 {
2062 CHECK_NUMBER (Vx_mode_pointer_shape, 0);
fbd6baed 2063 mode_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f),
ee78dc32
GV		 2064 XINT (Vx_mode_pointer_shape));
2065 }
2066 else
fbd6baed
GV		 2067 mode_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_xterm);
2068 x_check_errors (FRAME_W32_DISPLAY (f), "bad modeline pointer cursor: %s");
ee78dc32
GV		 2069
2070 if (!EQ (Qnil, Vx_sensitive_text_pointer_shape))
2071 {
2072 CHECK_NUMBER (Vx_sensitive_text_pointer_shape, 0);
2073 cross_cursor
fbd6baed 2074 = XCreateFontCursor (FRAME_W32_DISPLAY (f),
ee78dc32
GV		 2075 XINT (Vx_sensitive_text_pointer_shape));
2076 }
2077 else
fbd6baed 2078 cross_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_crosshair);
ee78dc32 2079
4694d762
JR		 2080 if (!NILP (Vx_window_horizontal_drag_shape))
2081 {
2082 CHECK_NUMBER (Vx_window_horizontal_drag_shape, 0);
2083 horizontal_drag_cursor
2084 = XCreateFontCursor (FRAME_X_DISPLAY (f),
2085 XINT (Vx_window_horizontal_drag_shape));
2086 }
2087 else
2088 horizontal_drag_cursor
2089 = XCreateFontCursor (FRAME_X_DISPLAY (f), XC_sb_h_double_arrow);
2090
ee78dc32 2091 /* Check and report errors with the above calls. */
fbd6baed 2092 x_check_errors (FRAME_W32_DISPLAY (f), "can't set cursor shape: %s");
fadca6c6 2093 x_uncatch_errors (FRAME_W32_DISPLAY (f), count);
ee78dc32
GV		 2094
2095 {
2096 XColor fore_color, back_color;
2097
fbd6baed 2098 fore_color.pixel = f->output_data.w32->mouse_pixel;
ee78dc32 2099 back_color.pixel = mask_color;
fbd6baed
GV		 2100 XQueryColor (FRAME_W32_DISPLAY (f),
2101 DefaultColormap (FRAME_W32_DISPLAY (f),
2102 DefaultScreen (FRAME_W32_DISPLAY (f))),
ee78dc32 2103 &fore_color);
fbd6baed
GV		 2104 XQueryColor (FRAME_W32_DISPLAY (f),
2105 DefaultColormap (FRAME_W32_DISPLAY (f),
2106 DefaultScreen (FRAME_W32_DISPLAY (f))),
ee78dc32 2107 &back_color);
fbd6baed 2108 XRecolorCursor (FRAME_W32_DISPLAY (f), cursor,
ee78dc32 2109 &fore_color, &back_color);
fbd6baed 2110 XRecolorCursor (FRAME_W32_DISPLAY (f), nontext_cursor,
ee78dc32 2111 &fore_color, &back_color);
fbd6baed 2112 XRecolorCursor (FRAME_W32_DISPLAY (f), mode_cursor,
ee78dc32 2113 &fore_color, &back_color);
fbd6baed 2114 XRecolorCursor (FRAME_W32_DISPLAY (f), cross_cursor,
ee78dc32 2115 &fore_color, &back_color);
0af913d7 2116 XRecolorCursor (FRAME_W32_DISPLAY (f), hourglass_cursor,
6fc2811b 2117 &fore_color, &back_color);
ee78dc32
GV		 2118 }
2119
fbd6baed 2120 if (FRAME_W32_WINDOW (f) != 0)
6fc2811b 2121 XDefineCursor (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f), cursor);
ee78dc32 2122
fbd6baed
GV		 2123 if (cursor != f->output_data.w32->text_cursor && f->output_data.w32->text_cursor != 0)
2124 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->text_cursor);
2125 f->output_data.w32->text_cursor = cursor;
2126
2127 if (nontext_cursor != f->output_data.w32->nontext_cursor
2128 && f->output_data.w32->nontext_cursor != 0)
2129 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->nontext_cursor);
2130 f->output_data.w32->nontext_cursor = nontext_cursor;
2131
0af913d7
GM		 2132 if (hourglass_cursor != f->output_data.w32->hourglass_cursor
2133 && f->output_data.w32->hourglass_cursor != 0)
2134 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->hourglass_cursor);
2135 f->output_data.w32->hourglass_cursor = hourglass_cursor;
6fc2811b 2136
fbd6baed
GV		 2137 if (mode_cursor != f->output_data.w32->modeline_cursor
2138 && f->output_data.w32->modeline_cursor != 0)
2139 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->modeline_cursor);
2140 f->output_data.w32->modeline_cursor = mode_cursor;
6fc2811b 2141
fbd6baed
GV		 2142 if (cross_cursor != f->output_data.w32->cross_cursor
2143 && f->output_data.w32->cross_cursor != 0)
2144 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->cross_cursor);
2145 f->output_data.w32->cross_cursor = cross_cursor;
2146
2147 XFlush (FRAME_W32_DISPLAY (f));
ee78dc32 2148 UNBLOCK_INPUT;
6fc2811b
JR		 2149
2150 update_face_from_frame_parameter (f, Qmouse_color, arg);
767b1ff0 2151#endif /* TODO */
ee78dc32
GV		 2152}
2153
70a0239a
JR		 2154/* Defined in w32term.c. */
2155void x_update_cursor (struct frame *f, int on_p);
2156
ee78dc32
GV		 2157void
2158x_set_cursor_color (f, arg, oldval)
2159 struct frame *f;
2160 Lisp_Object arg, oldval;
2161{
70a0239a 2162 unsigned long fore_pixel, pixel;
ee78dc32 2163
dfff8a69 2164 if (!NILP (Vx_cursor_fore_pixel))
ee78dc32 2165 fore_pixel = x_decode_color (f, Vx_cursor_fore_pixel,
70a0239a 2166 WHITE_PIX_DEFAULT (f));
ee78dc32 2167 else
6fc2811b 2168 fore_pixel = FRAME_BACKGROUND_PIXEL (f);
70a0239a 2169
6759f872 2170 pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
ee78dc32
GV		 2171
2172 /* Make sure that the cursor color differs from the background color. */
70a0239a 2173 if (pixel == FRAME_BACKGROUND_PIXEL (f))
ee78dc32 2174 {
70a0239a
JR		 2175 pixel = f->output_data.w32->mouse_pixel;
2176 if (pixel == fore_pixel)
6fc2811b 2177 fore_pixel = FRAME_BACKGROUND_PIXEL (f);
ee78dc32 2178 }
70a0239a 2179
6fc2811b 2180 FRAME_FOREGROUND_PIXEL (f) = fore_pixel;
70a0239a 2181 f->output_data.w32->cursor_pixel = pixel;
ee78dc32 2182
fbd6baed 2183 if (FRAME_W32_WINDOW (f) != 0)
ee78dc32
GV		 2184 {
2185 if (FRAME_VISIBLE_P (f))
2186 {
70a0239a
JR		 2187 x_update_cursor (f, 0);
2188 x_update_cursor (f, 1);
ee78dc32
GV		 2189 }
2190 }
6fc2811b
JR		 2191
2192 update_face_from_frame_parameter (f, Qcursor_color, arg);
ee78dc32
GV		 2193}
2194
33d52f9c
GV		 2195/* Set the border-color of frame F to pixel value PIX.
2196 Note that this does not fully take effect if done before
2197 F has an window. */
2198void
2199x_set_border_pixel (f, pix)
2200 struct frame *f;
2201 int pix;
2202{
2203 f->output_data.w32->border_pixel = pix;
2204
2205 if (FRAME_W32_WINDOW (f) != 0 && f->output_data.w32->border_width > 0)
2206 {
2207 if (FRAME_VISIBLE_P (f))
2208 redraw_frame (f);
2209 }
2210}
2211
ee78dc32
GV		 2212/* Set the border-color of frame F to value described by ARG.
2213 ARG can be a string naming a color.
2214 The border-color is used for the border that is drawn by the server.
2215 Note that this does not fully take effect if done before
2216 F has a window; it must be redone when the window is created. */
2217
2218void
2219x_set_border_color (f, arg, oldval)
2220 struct frame *f;
2221 Lisp_Object arg, oldval;
2222{
ee78dc32
GV		 2223 int pix;
2224
2225 CHECK_STRING (arg, 0);
ee78dc32 2226 pix = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
ee78dc32 2227 x_set_border_pixel (f, pix);
6fc2811b 2228 update_face_from_frame_parameter (f, Qborder_color, arg);
ee78dc32
GV		 2229}
2230
dfff8a69
JR		 2231/* Value is the internal representation of the specified cursor type
2232 ARG. If type is BAR_CURSOR, return in *WIDTH the specified width
2233 of the bar cursor. */
2234
2235enum text_cursor_kinds
2236x_specified_cursor_type (arg, width)
2237 Lisp_Object arg;
2238 int *width;
ee78dc32 2239{
dfff8a69
JR		 2240 enum text_cursor_kinds type;
2241
ee78dc32
GV		 2242 if (EQ (arg, Qbar))
2243 {
dfff8a69
JR		 2244 type = BAR_CURSOR;
2245 *width = 2;
ee78dc32 2246 }
dfff8a69
JR		 2247 else if (CONSP (arg)
2248 && EQ (XCAR (arg), Qbar)
2249 && INTEGERP (XCDR (arg))
2250 && XINT (XCDR (arg)) >= 0)
ee78dc32 2251 {
dfff8a69
JR		 2252 type = BAR_CURSOR;
2253 *width = XINT (XCDR (arg));
ee78dc32 2254 }
dfff8a69
JR		 2255 else if (NILP (arg))
2256 type = NO_CURSOR;
ee78dc32
GV		 2257 else
2258 /* Treat anything unknown as "box cursor".
2259 It was bad to signal an error; people have trouble fixing
2260 .Xdefaults with Emacs, when it has something bad in it. */
dfff8a69
JR		 2261 type = FILLED_BOX_CURSOR;
2262
2263 return type;
2264}
2265
2266void
2267x_set_cursor_type (f, arg, oldval)
2268 FRAME_PTR f;
2269 Lisp_Object arg, oldval;
2270{
2271 int width;
2272
2273 FRAME_DESIRED_CURSOR (f) = x_specified_cursor_type (arg, &width);
2274 f->output_data.w32->cursor_width = width;
ee78dc32
GV		 2275
2276 /* Make sure the cursor gets redrawn. This is overkill, but how
2277 often do people change cursor types? */
2278 update_mode_lines++;
2279}
dfff8a69 2280\f
ee78dc32
GV		 2281void
2282x_set_icon_type (f, arg, oldval)
2283 struct frame *f;
2284 Lisp_Object arg, oldval;
2285{
ee78dc32
GV		 2286 int result;
2287
eb7576ce
GV		 2288 if (NILP (arg) && NILP (oldval))
2289 return;
2290
2291 if (STRINGP (arg) && STRINGP (oldval)
2292 && EQ (Fstring_equal (oldval, arg), Qt))
2293 return;
2294
2295 if (SYMBOLP (arg) && SYMBOLP (oldval) && EQ (arg, oldval))
ee78dc32
GV		 2296 return;
2297
2298 BLOCK_INPUT;
ee78dc32 2299
eb7576ce 2300 result = x_bitmap_icon (f, arg);
ee78dc32
GV		 2301 if (result)
2302 {
2303 UNBLOCK_INPUT;
2304 error ("No icon window available");
2305 }
2306
ee78dc32 2307 UNBLOCK_INPUT;
ee78dc32
GV		 2308}
2309
2310/* Return non-nil if frame F wants a bitmap icon. */
2311
2312Lisp_Object
2313x_icon_type (f)
2314 FRAME_PTR f;
2315{
2316 Lisp_Object tem;
2317
2318 tem = assq_no_quit (Qicon_type, f->param_alist);
2319 if (CONSP (tem))
8e713be6 2320 return XCDR (tem);
ee78dc32
GV		 2321 else
2322 return Qnil;
2323}
2324
2325void
2326x_set_icon_name (f, arg, oldval)
2327 struct frame *f;
2328 Lisp_Object arg, oldval;
2329{
ee78dc32
GV		 2330 if (STRINGP (arg))
2331 {
2332 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
2333 return;
2334 }
2335 else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
2336 return;
2337
2338 f->icon_name = arg;
2339
2340#if 0
fbd6baed 2341 if (f->output_data.w32->icon_bitmap != 0)
ee78dc32
GV		 2342 return;
2343
2344 BLOCK_INPUT;
2345
2346 result = x_text_icon (f,
1edf84e7 2347 (char *) XSTRING ((!NILP (f->icon_name)
ee78dc32 2348 ? f->icon_name
1edf84e7
GV		 2349 : !NILP (f->title)
2350 ? f->title
ee78dc32
GV		 2351 : f->name))->data);
2352
2353 if (result)
2354 {
2355 UNBLOCK_INPUT;
2356 error ("No icon window available");
2357 }
2358
2359 /* If the window was unmapped (and its icon was mapped),
2360 the new icon is not mapped, so map the window in its stead. */
2361 if (FRAME_VISIBLE_P (f))
2362 {
2363#ifdef USE_X_TOOLKIT
fbd6baed 2364 XtPopup (f->output_data.w32->widget, XtGrabNone);
ee78dc32 2365#endif
fbd6baed 2366 XMapWindow (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f));
ee78dc32
GV		 2367 }
2368
fbd6baed 2369 XFlush (FRAME_W32_DISPLAY (f));
ee78dc32
GV		 2370 UNBLOCK_INPUT;
2371#endif
2372}
2373
2374extern Lisp_Object x_new_font ();
4587b026 2375extern Lisp_Object x_new_fontset();
ee78dc32
GV		 2376
2377void
2378x_set_font (f, arg, oldval)
2379 struct frame *f;
2380 Lisp_Object arg, oldval;
2381{
2382 Lisp_Object result;
4587b026 2383 Lisp_Object fontset_name;
4b817373 2384 Lisp_Object frame;
3cf3436e 2385 int old_fontset = FRAME_FONTSET(f);
ee78dc32
GV		 2386
2387 CHECK_STRING (arg, 1);
2388
4587b026
GV		 2389 fontset_name = Fquery_fontset (arg, Qnil);
2390
ee78dc32 2391 BLOCK_INPUT;
4587b026
GV		 2392 result = (STRINGP (fontset_name)
2393 ? x_new_fontset (f, XSTRING (fontset_name)->data)
2394 : x_new_font (f, XSTRING (arg)->data));
ee78dc32
GV		 2395 UNBLOCK_INPUT;
2396
2397 if (EQ (result, Qnil))
dfff8a69 2398 error ("Font `%s' is not defined", XSTRING (arg)->data);
ee78dc32 2399 else if (EQ (result, Qt))
dfff8a69 2400 error ("The characters of the given font have varying widths");
ee78dc32
GV		 2401 else if (STRINGP (result))
2402 {
3cf3436e
JR		 2403 if (STRINGP (fontset_name))
2404 {
2405 /* Fontset names are built from ASCII font names, so the
2406 names may be equal despite there was a change. */
2407 if (old_fontset == FRAME_FONTSET (f))
2408 return;
2409 }
2410 else if (!NILP (Fequal (result, oldval)))
dc220243 2411 return;
3cf3436e 2412
ee78dc32 2413 store_frame_param (f, Qfont, result);
6fc2811b 2414 recompute_basic_faces (f);
ee78dc32
GV		 2415 }
2416 else
2417 abort ();
4b817373 2418
6fc2811b
JR		 2419 do_pending_window_change (0);
2420
2421 /* Don't call `face-set-after-frame-default' when faces haven't been
2422 initialized yet. This is the case when called from
2423 Fx_create_frame. In that case, the X widget or window doesn't
2424 exist either, and we can end up in x_report_frame_params with a
2425 null widget which gives a segfault. */
2426 if (FRAME_FACE_CACHE (f))
2427 {
2428 XSETFRAME (frame, f);
2429 call1 (Qface_set_after_frame_default, frame);
2430 }
ee78dc32
GV		 2431}
2432
2433void
2434x_set_border_width (f, arg, oldval)
2435 struct frame *f;
2436 Lisp_Object arg, oldval;
2437{
2438 CHECK_NUMBER (arg, 0);
2439
fbd6baed 2440 if (XINT (arg) == f->output_data.w32->border_width)
ee78dc32
GV		 2441 return;
2442
fbd6baed 2443 if (FRAME_W32_WINDOW (f) != 0)
ee78dc32
GV		 2444 error ("Cannot change the border width of a window");
2445
fbd6baed 2446 f->output_data.w32->border_width = XINT (arg);
ee78dc32
GV		 2447}
2448
2449void
2450x_set_internal_border_width (f, arg, oldval)
2451 struct frame *f;
2452 Lisp_Object arg, oldval;
2453{
fbd6baed 2454 int old = f->output_data.w32->internal_border_width;
ee78dc32
GV		 2455
2456 CHECK_NUMBER (arg, 0);
fbd6baed
GV		 2457 f->output_data.w32->internal_border_width = XINT (arg);
2458 if (f->output_data.w32->internal_border_width < 0)
2459 f->output_data.w32->internal_border_width = 0;
ee78dc32 2460
fbd6baed 2461 if (f->output_data.w32->internal_border_width == old)
ee78dc32
GV		 2462 return;
2463
fbd6baed 2464 if (FRAME_W32_WINDOW (f) != 0)
ee78dc32 2465 {
ee78dc32 2466 x_set_window_size (f, 0, f->width, f->height);
ee78dc32 2467 SET_FRAME_GARBAGED (f);
6fc2811b 2468 do_pending_window_change (0);
ee78dc32
GV		 2469 }
2470}
2471
2472void
2473x_set_visibility (f, value, oldval)
2474 struct frame *f;
2475 Lisp_Object value, oldval;
2476{
2477 Lisp_Object frame;
2478 XSETFRAME (frame, f);
2479
2480 if (NILP (value))
2481 Fmake_frame_invisible (frame, Qt);
2482 else if (EQ (value, Qicon))
2483 Ficonify_frame (frame);
2484 else
2485 Fmake_frame_visible (frame);
2486}
2487
a1258667
JR		 2488\f
2489/* Change window heights in windows rooted in WINDOW by N lines. */
2490
2491static void
2492x_change_window_heights (window, n)
2493 Lisp_Object window;
2494 int n;
2495{
2496 struct window *w = XWINDOW (window);
2497
2498 XSETFASTINT (w->top, XFASTINT (w->top) + n);
2499 XSETFASTINT (w->height, XFASTINT (w->height) - n);
2500
2501 if (INTEGERP (w->orig_top))
2502 XSETFASTINT (w->orig_top, XFASTINT (w->orig_top) + n);
2503 if (INTEGERP (w->orig_height))
2504 XSETFASTINT (w->orig_height, XFASTINT (w->orig_height) - n);
2505
2506 /* Handle just the top child in a vertical split. */
2507 if (!NILP (w->vchild))
2508 x_change_window_heights (w->vchild, n);
2509
2510 /* Adjust all children in a horizontal split. */
2511 for (window = w->hchild; !NILP (window); window = w->next)
2512 {
2513 w = XWINDOW (window);
2514 x_change_window_heights (window, n);
2515 }
2516}
2517
ee78dc32
GV		 2518void
2519x_set_menu_bar_lines (f, value, oldval)
2520 struct frame *f;
2521 Lisp_Object value, oldval;
2522{
2523 int nlines;
2524 int olines = FRAME_MENU_BAR_LINES (f);
2525
2526 /* Right now, menu bars don't work properly in minibuf-only frames;
2527 most of the commands try to apply themselves to the minibuffer
6fc2811b 2528 frame itself, and get an error because you can't switch buffers
ee78dc32
GV		 2529 in or split the minibuffer window. */
2530 if (FRAME_MINIBUF_ONLY_P (f))
2531 return;
2532
2533 if (INTEGERP (value))
2534 nlines = XINT (value);
2535 else
2536 nlines = 0;
2537
2538 FRAME_MENU_BAR_LINES (f) = 0;
2539 if (nlines)
2540 FRAME_EXTERNAL_MENU_BAR (f) = 1;
2541 else
2542 {
2543 if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
2544 free_frame_menubar (f);
2545 FRAME_EXTERNAL_MENU_BAR (f) = 0;
1edf84e7
GV		 2546
2547 /* Adjust the frame size so that the client (text) dimensions
2548 remain the same. This depends on FRAME_EXTERNAL_MENU_BAR being
2549 set correctly. */
2550 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
6fc2811b 2551 do_pending_window_change (0);
ee78dc32 2552 }
6fc2811b
JR		 2553 adjust_glyphs (f);
2554}
2555
2556
2557/* Set the number of lines used for the tool bar of frame F to VALUE.
2558 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
2559 is the old number of tool bar lines. This function changes the
2560 height of all windows on frame F to match the new tool bar height.
2561 The frame's height doesn't change. */
2562
2563void
2564x_set_tool_bar_lines (f, value, oldval)
2565 struct frame *f;
2566 Lisp_Object value, oldval;
2567{
36f8209a
JR		 2568 int delta, nlines, root_height;
2569 Lisp_Object root_window;
6fc2811b 2570
dc220243
JR		 2571 /* Treat tool bars like menu bars. */
2572 if (FRAME_MINIBUF_ONLY_P (f))
2573 return;
2574
6fc2811b
JR		 2575 /* Use VALUE only if an integer >= 0. */
2576 if (INTEGERP (value) && XINT (value) >= 0)
2577 nlines = XFASTINT (value);
2578 else
2579 nlines = 0;
2580
2581 /* Make sure we redisplay all windows in this frame. */
2582 ++windows_or_buffers_changed;
2583
2584 delta = nlines - FRAME_TOOL_BAR_LINES (f);
36f8209a
JR		 2585
2586 /* Don't resize the tool-bar to more than we have room for. */
2587 root_window = FRAME_ROOT_WINDOW (f);
2588 root_height = XINT (XWINDOW (root_window)->height);
2589 if (root_height - delta < 1)
2590 {
2591 delta = root_height - 1;
2592 nlines = FRAME_TOOL_BAR_LINES (f) + delta;
2593 }
2594
6fc2811b 2595 FRAME_TOOL_BAR_LINES (f) = nlines;
36f8209a 2596 x_change_window_heights (root_window, delta);
6fc2811b 2597 adjust_glyphs (f);
36f8209a
JR		 2598
2599 /* We also have to make sure that the internal border at the top of
2600 the frame, below the menu bar or tool bar, is redrawn when the
2601 tool bar disappears. This is so because the internal border is
2602 below the tool bar if one is displayed, but is below the menu bar
2603 if there isn't a tool bar. The tool bar draws into the area
2604 below the menu bar. */
2605 if (FRAME_W32_WINDOW (f) && FRAME_TOOL_BAR_LINES (f) == 0)
2606 {
2607 updating_frame = f;
2608 clear_frame ();
2609 clear_current_matrices (f);
2610 updating_frame = NULL;
2611 }
2612
2613 /* If the tool bar gets smaller, the internal border below it
2614 has to be cleared. It was formerly part of the display
2615 of the larger tool bar, and updating windows won't clear it. */
2616 if (delta < 0)
2617 {
2618 int height = FRAME_INTERNAL_BORDER_WIDTH (f);
2619 int width = PIXEL_WIDTH (f);
2620 int y = nlines * CANON_Y_UNIT (f);
2621
2622 BLOCK_INPUT;
2623 {
2624 HDC hdc = get_frame_dc (f);
2625 w32_clear_area (f, hdc, 0, y, width, height);
2626 release_frame_dc (f, hdc);
2627 }
2628 UNBLOCK_INPUT;
3cf3436e
JR		 2629
2630 if (WINDOWP (f->tool_bar_window))
2631 clear_glyph_matrix (XWINDOW (f->tool_bar_window)->current_matrix);
36f8209a 2632 }
ee78dc32
GV		 2633}
2634
6fc2811b 2635
ee78dc32 2636/* Change the name of frame F to NAME. If NAME is nil, set F's name to
fbd6baed 2637 w32_id_name.
ee78dc32
GV		 2638
2639 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2640 name; if NAME is a string, set F's name to NAME and set
2641 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2642
2643 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2644 suggesting a new name, which lisp code should override; if
2645 F->explicit_name is set, ignore the new name; otherwise, set it. */
2646
2647void
2648x_set_name (f, name, explicit)
2649 struct frame *f;
2650 Lisp_Object name;
2651 int explicit;
2652{
2653 /* Make sure that requests from lisp code override requests from
2654 Emacs redisplay code. */
2655 if (explicit)
2656 {
2657 /* If we're switching from explicit to implicit, we had better
2658 update the mode lines and thereby update the title. */
2659 if (f->explicit_name && NILP (name))
2660 update_mode_lines = 1;
2661
2662 f->explicit_name = ! NILP (name);
2663 }
2664 else if (f->explicit_name)
2665 return;
2666
fbd6baed 2667 /* If NAME is nil, set the name to the w32_id_name. */
ee78dc32
GV		 2668 if (NILP (name))
2669 {
2670 /* Check for no change needed in this very common case
2671 before we do any consing. */
fbd6baed 2672 if (!strcmp (FRAME_W32_DISPLAY_INFO (f)->w32_id_name,
ee78dc32
GV		 2673 XSTRING (f->name)->data))
2674 return;
fbd6baed 2675 name = build_string (FRAME_W32_DISPLAY_INFO (f)->w32_id_name);
ee78dc32
GV		 2676 }
2677 else
2678 CHECK_STRING (name, 0);
2679
2680 /* Don't change the name if it's already NAME. */
2681 if (! NILP (Fstring_equal (name, f->name)))
2682 return;
2683
1edf84e7
GV		 2684 f->name = name;
2685
2686 /* For setting the frame title, the title parameter should override
2687 the name parameter. */
2688 if (! NILP (f->title))
2689 name = f->title;
2690
fbd6baed 2691 if (FRAME_W32_WINDOW (f))
ee78dc32 2692 {
6fc2811b 2693 if (STRING_MULTIBYTE (name))
dfff8a69 2694 name = ENCODE_SYSTEM (name);
6fc2811b 2695
ee78dc32 2696 BLOCK_INPUT;
fbd6baed 2697 SetWindowText(FRAME_W32_WINDOW (f), XSTRING (name)->data);
ee78dc32
GV		 2698 UNBLOCK_INPUT;
2699 }
ee78dc32
GV		 2700}
2701
2702/* This function should be called when the user's lisp code has
2703 specified a name for the frame; the name will override any set by the
2704 redisplay code. */
2705void
2706x_explicitly_set_name (f, arg, oldval)
2707 FRAME_PTR f;
2708 Lisp_Object arg, oldval;
2709{
2710 x_set_name (f, arg, 1);
2711}
2712
2713/* This function should be called by Emacs redisplay code to set the
2714 name; names set this way will never override names set by the user's
2715 lisp code. */
2716void
2717x_implicitly_set_name (f, arg, oldval)
2718 FRAME_PTR f;
2719 Lisp_Object arg, oldval;
2720{
2721 x_set_name (f, arg, 0);
2722}
1edf84e7
GV		 2723\f
2724/* Change the title of frame F to NAME.
2725 If NAME is nil, use the frame name as the title.
2726
2727 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2728 name; if NAME is a string, set F's name to NAME and set
2729 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2730
2731 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2732 suggesting a new name, which lisp code should override; if
2733 F->explicit_name is set, ignore the new name; otherwise, set it. */
ee78dc32 2734
1edf84e7 2735void
6fc2811b 2736x_set_title (f, name, old_name)
1edf84e7 2737 struct frame *f;
6fc2811b 2738 Lisp_Object name, old_name;
1edf84e7
GV		 2739{
2740 /* Don't change the title if it's already NAME. */
2741 if (EQ (name, f->title))
2742 return;
2743
2744 update_mode_lines = 1;
2745
2746 f->title = name;
2747
2748 if (NILP (name))
2749 name = f->name;
2750
2751 if (FRAME_W32_WINDOW (f))
2752 {
6fc2811b 2753 if (STRING_MULTIBYTE (name))
dfff8a69 2754 name = ENCODE_SYSTEM (name);
6fc2811b 2755
1edf84e7
GV		 2756 BLOCK_INPUT;
2757 SetWindowText(FRAME_W32_WINDOW (f), XSTRING (name)->data);
2758 UNBLOCK_INPUT;
2759 }
2760}
2761\f
ee78dc32
GV		 2762void
2763x_set_autoraise (f, arg, oldval)
2764 struct frame *f;
2765 Lisp_Object arg, oldval;
2766{
2767 f->auto_raise = !EQ (Qnil, arg);
2768}
2769
2770void
2771x_set_autolower (f, arg, oldval)
2772 struct frame *f;
2773 Lisp_Object arg, oldval;
2774{
2775 f->auto_lower = !EQ (Qnil, arg);
2776}
2777
2778void
2779x_set_unsplittable (f, arg, oldval)
2780 struct frame *f;
2781 Lisp_Object arg, oldval;
2782{
2783 f->no_split = !NILP (arg);
2784}
2785
2786void
2787x_set_vertical_scroll_bars (f, arg, oldval)
2788 struct frame *f;
2789 Lisp_Object arg, oldval;
2790{
1026b400
RS		 2791 if ((EQ (arg, Qleft) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f))
2792 || (EQ (arg, Qright) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f))
2793 || (NILP (arg) && FRAME_HAS_VERTICAL_SCROLL_BARS (f))
2794 || (!NILP (arg) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f)))
ee78dc32 2795 {
1026b400
RS		 2796 FRAME_VERTICAL_SCROLL_BAR_TYPE (f) = NILP (arg) ?
2797 vertical_scroll_bar_none :
87996783
GV		 2798 /* Put scroll bars on the right by default, as is conventional
2799 on MS-Windows. */
2800 EQ (Qleft, arg)
2801 ? vertical_scroll_bar_left
2802 : vertical_scroll_bar_right;
ee78dc32
GV		 2803
2804 /* We set this parameter before creating the window for the
2805 frame, so we can get the geometry right from the start.
2806 However, if the window hasn't been created yet, we shouldn't
2807 call x_set_window_size. */
fbd6baed 2808 if (FRAME_W32_WINDOW (f))
ee78dc32 2809 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
6fc2811b 2810 do_pending_window_change (0);
ee78dc32
GV		 2811 }
2812}
2813
2814void
2815x_set_scroll_bar_width (f, arg, oldval)
2816 struct frame *f;
2817 Lisp_Object arg, oldval;
2818{
6fc2811b
JR		 2819 int wid = FONT_WIDTH (f->output_data.w32->font);
2820
ee78dc32
GV		 2821 if (NILP (arg))
2822 {
6fc2811b
JR		 2823 FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = GetSystemMetrics (SM_CXVSCROLL);
2824 FRAME_SCROLL_BAR_COLS (f) = (FRAME_SCROLL_BAR_PIXEL_WIDTH (f) +
2825 wid - 1) / wid;
2826 if (FRAME_W32_WINDOW (f))
2827 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
2828 do_pending_window_change (0);
ee78dc32
GV		 2829 }
2830 else if (INTEGERP (arg) && XINT (arg) > 0
2831 && XFASTINT (arg) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f))
2832 {
ee78dc32 2833 FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = XFASTINT (arg);
6fc2811b
JR		 2834 FRAME_SCROLL_BAR_COLS (f) = (FRAME_SCROLL_BAR_PIXEL_WIDTH (f)
2835 + wid-1) / wid;
fbd6baed 2836 if (FRAME_W32_WINDOW (f))
ee78dc32 2837 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
6fc2811b 2838 do_pending_window_change (0);
ee78dc32 2839 }
6fc2811b
JR		 2840 change_frame_size (f, 0, FRAME_WIDTH (f), 0, 0, 0);
2841 XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.hpos = 0;
2842 XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.x = 0;
ee78dc32
GV		 2843}
2844\f
2845/* Subroutines of creating an frame. */
2846
2847/* Make sure that Vx_resource_name is set to a reasonable value.
2848 Fix it up, or set it to `emacs' if it is too hopeless. */
2849
2850static void
2851validate_x_resource_name ()
2852{
6fc2811b 2853 int len = 0;
ee78dc32
GV		 2854 /* Number of valid characters in the resource name. */
2855 int good_count = 0;
2856 /* Number of invalid characters in the resource name. */
2857 int bad_count = 0;
2858 Lisp_Object new;
2859 int i;
2860
2861 if (STRINGP (Vx_resource_name))
2862 {
2863 unsigned char *p = XSTRING (Vx_resource_name)->data;
2864 int i;
2865
dfff8a69 2866 len = STRING_BYTES (XSTRING (Vx_resource_name));
ee78dc32
GV		 2867
2868 /* Only letters, digits, - and _ are valid in resource names.
2869 Count the valid characters and count the invalid ones. */
2870 for (i = 0; i < len; i++)
2871 {
2872 int c = p[i];
2873 if (! ((c >= 'a' && c <= 'z')
2874 || (c >= 'A' && c <= 'Z')
2875 || (c >= '0' && c <= '9')
2876 || c == '-' || c == '_'))
2877 bad_count++;
2878 else
2879 good_count++;
2880 }
2881 }
2882 else
2883 /* Not a string => completely invalid. */
2884 bad_count = 5, good_count = 0;
2885
2886 /* If name is valid already, return. */
2887 if (bad_count == 0)
2888 return;
2889
2890 /* If name is entirely invalid, or nearly so, use `emacs'. */
2891 if (good_count == 0
2892 || (good_count == 1 && bad_count > 0))
2893 {
2894 Vx_resource_name = build_string ("emacs");
2895 return;
2896 }
2897
2898 /* Name is partly valid. Copy it and replace the invalid characters
2899 with underscores. */
2900
2901 Vx_resource_name = new = Fcopy_sequence (Vx_resource_name);
2902
2903 for (i = 0; i < len; i++)
2904 {
2905 int c = XSTRING (new)->data[i];
2906 if (! ((c >= 'a' && c <= 'z')
2907 || (c >= 'A' && c <= 'Z')
2908 || (c >= '0' && c <= '9')
2909 || c == '-' || c == '_'))
2910 XSTRING (new)->data[i] = '_';
2911 }
2912}
2913
2914
2915extern char *x_get_string_resource ();
2916
2917DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 2, 4, 0,
2918 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
2919This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
2920class, where INSTANCE is the name under which Emacs was invoked, or\n\
2921the name specified by the `-name' or `-rn' command-line arguments.\n\
2922\n\
2923The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
2924class, respectively. You must specify both of them or neither.\n\
2925If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
2926and the class is `Emacs.CLASS.SUBCLASS'.")
2927 (attribute, class, component, subclass)
2928 Lisp_Object attribute, class, component, subclass;
2929{
2930 register char *value;
2931 char *name_key;
2932 char *class_key;
2933
2934 CHECK_STRING (attribute, 0);
2935 CHECK_STRING (class, 0);
2936
2937 if (!NILP (component))
2938 CHECK_STRING (component, 1);
2939 if (!NILP (subclass))
2940 CHECK_STRING (subclass, 2);
2941 if (NILP (component) != NILP (subclass))
2942 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2943
2944 validate_x_resource_name ();
2945
2946 /* Allocate space for the components, the dots which separate them,
2947 and the final '\0'. Make them big enough for the worst case. */
dfff8a69 2948 name_key = (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name))
ee78dc32 2949 + (STRINGP (component)
dfff8a69
JR		 2950 ? STRING_BYTES (XSTRING (component)) : 0)
2951 + STRING_BYTES (XSTRING (attribute))
ee78dc32
GV		 2952 + 3);
2953
2954 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
dfff8a69 2955 + STRING_BYTES (XSTRING (class))
ee78dc32 2956 + (STRINGP (subclass)
dfff8a69 2957 ? STRING_BYTES (XSTRING (subclass)) : 0)
ee78dc32
GV		 2958 + 3);
2959
2960 /* Start with emacs.FRAMENAME for the name (the specific one)
2961 and with `Emacs' for the class key (the general one). */
2962 strcpy (name_key, XSTRING (Vx_resource_name)->data);
2963 strcpy (class_key, EMACS_CLASS);
2964
2965 strcat (class_key, ".");
2966 strcat (class_key, XSTRING (class)->data);
2967
2968 if (!NILP (component))
2969 {
2970 strcat (class_key, ".");
2971 strcat (class_key, XSTRING (subclass)->data);
2972
2973 strcat (name_key, ".");
2974 strcat (name_key, XSTRING (component)->data);
2975 }
2976
2977 strcat (name_key, ".");
2978 strcat (name_key, XSTRING (attribute)->data);
2979
2980 value = x_get_string_resource (Qnil,
2981 name_key, class_key);
2982
2983 if (value != (char *) 0)
2984 return build_string (value);
2985 else
2986 return Qnil;
2987}
2988
2989/* Used when C code wants a resource value. */
2990
2991char *
2992x_get_resource_string (attribute, class)
2993 char *attribute, *class;
2994{
ee78dc32
GV		 2995 char *name_key;
2996 char *class_key;
6fc2811b 2997 struct frame *sf = SELECTED_FRAME ();
ee78dc32
GV		 2998
2999 /* Allocate space for the components, the dots which separate them,
3000 and the final '\0'. */
dfff8a69 3001 name_key = (char *) alloca (STRING_BYTES (XSTRING (Vinvocation_name))
ee78dc32
GV		 3002 + strlen (attribute) + 2);
3003 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
3004 + strlen (class) + 2);
3005
3006 sprintf (name_key, "%s.%s",
3007 XSTRING (Vinvocation_name)->data,
3008 attribute);
3009 sprintf (class_key, "%s.%s", EMACS_CLASS, class);
3010
6fc2811b 3011 return x_get_string_resource (sf, name_key, class_key);
ee78dc32
GV		 3012}
3013
3014/* Types we might convert a resource string into. */
3015enum resource_types
6fc2811b
JR		 3016{
3017 RES_TYPE_NUMBER,
3018 RES_TYPE_FLOAT,
3019 RES_TYPE_BOOLEAN,
3020 RES_TYPE_STRING,
3021 RES_TYPE_SYMBOL
3022};
ee78dc32
GV		 3023
3024/* Return the value of parameter PARAM.
3025
3026 First search ALIST, then Vdefault_frame_alist, then the X defaults
3027 database, using ATTRIBUTE as the attribute name and CLASS as its class.
3028
3029 Convert the resource to the type specified by desired_type.
3030
3031 If no default is specified, return Qunbound. If you call
6fc2811b 3032 w32_get_arg, make sure you deal with Qunbound in a reasonable way,
ee78dc32
GV		 3033 and don't let it get stored in any Lisp-visible variables! */
3034
3035static Lisp_Object
6fc2811b 3036w32_get_arg (alist, param, attribute, class, type)
ee78dc32
GV		 3037 Lisp_Object alist, param;
3038 char *attribute;
3039 char *class;
3040 enum resource_types type;
3041{
3042 register Lisp_Object tem;
3043
3044 tem = Fassq (param, alist);
3045 if (EQ (tem, Qnil))
3046 tem = Fassq (param, Vdefault_frame_alist);
3047 if (EQ (tem, Qnil))
3048 {
3049
3050 if (attribute)
3051 {
3052 tem = Fx_get_resource (build_string (attribute),
3053 build_string (class),
3054 Qnil, Qnil);
3055
3056 if (NILP (tem))
3057 return Qunbound;
3058
3059 switch (type)
3060 {
6fc2811b 3061 case RES_TYPE_NUMBER:
ee78dc32
GV		 3062 return make_number (atoi (XSTRING (tem)->data));
3063
6fc2811b
JR		 3064 case RES_TYPE_FLOAT:
3065 return make_float (atof (XSTRING (tem)->data));
3066
3067 case RES_TYPE_BOOLEAN:
ee78dc32
GV		 3068 tem = Fdowncase (tem);
3069 if (!strcmp (XSTRING (tem)->data, "on")
3070 || !strcmp (XSTRING (tem)->data, "true"))
3071 return Qt;
3072 else
3073 return Qnil;
3074
6fc2811b 3075 case RES_TYPE_STRING:
ee78dc32
GV		 3076 return tem;
3077
6fc2811b 3078 case RES_TYPE_SYMBOL:
ee78dc32
GV		 3079 /* As a special case, we map the values `true' and `on'
3080 to Qt, and `false' and `off' to Qnil. */
3081 {
3082 Lisp_Object lower;
3083 lower = Fdowncase (tem);
3084 if (!strcmp (XSTRING (lower)->data, "on")
3085 || !strcmp (XSTRING (lower)->data, "true"))
3086 return Qt;
3087 else if (!strcmp (XSTRING (lower)->data, "off")
3088 || !strcmp (XSTRING (lower)->data, "false"))
3089 return Qnil;
3090 else
3091 return Fintern (tem, Qnil);
3092 }
3093
3094 default:
3095 abort ();
3096 }
3097 }
3098 else
3099 return Qunbound;
3100 }
3101 return Fcdr (tem);
3102}
3103
3104/* Record in frame F the specified or default value according to ALIST
dfff8a69
JR		 3105 of the parameter named PROP (a Lisp symbol).
3106 If no value is specified for PROP, look for an X default for XPROP
ee78dc32
GV		 3107 on the frame named NAME.
3108 If that is not found either, use the value DEFLT. */
3109
3110static Lisp_Object
3111x_default_parameter (f, alist, prop, deflt, xprop, xclass, type)
3112 struct frame *f;
3113 Lisp_Object alist;
3114 Lisp_Object prop;
3115 Lisp_Object deflt;
3116 char *xprop;
3117 char *xclass;
3118 enum resource_types type;
3119{
3120 Lisp_Object tem;
3121
6fc2811b 3122 tem = w32_get_arg (alist, prop, xprop, xclass, type);
ee78dc32
GV		 3123 if (EQ (tem, Qunbound))
3124 tem = deflt;
3125 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
3126 return tem;
3127}
3128\f
3129DEFUN ("x-parse-geometry", Fx_parse_geometry, Sx_parse_geometry, 1, 1, 0,
3130 "Parse an X-style geometry string STRING.\n\
3131Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
3132The properties returned may include `top', `left', `height', and `width'.\n\
3133The value of `left' or `top' may be an integer,\n\
3134or a list (+ N) meaning N pixels relative to top/left corner,\n\
3135or a list (- N) meaning -N pixels relative to bottom/right corner.")
3136 (string)
3137 Lisp_Object string;
3138{
3139 int geometry, x, y;
3140 unsigned int width, height;
3141 Lisp_Object result;
3142
3143 CHECK_STRING (string, 0);
3144
3145 geometry = XParseGeometry ((char *) XSTRING (string)->data,
3146 &x, &y, &width, &height);
3147
3148 result = Qnil;
3149 if (geometry & XValue)
3150 {
3151 Lisp_Object element;
3152
3153 if (x >= 0 && (geometry & XNegative))
3154 element = Fcons (Qleft, Fcons (Qminus, Fcons (make_number (-x), Qnil)));
3155 else if (x < 0 && ! (geometry & XNegative))
3156 element = Fcons (Qleft, Fcons (Qplus, Fcons (make_number (x), Qnil)));
3157 else
3158 element = Fcons (Qleft, make_number (x));
3159 result = Fcons (element, result);
3160 }
3161
3162 if (geometry & YValue)
3163 {
3164 Lisp_Object element;
3165
3166 if (y >= 0 && (geometry & YNegative))
3167 element = Fcons (Qtop, Fcons (Qminus, Fcons (make_number (-y), Qnil)));
3168 else if (y < 0 && ! (geometry & YNegative))
3169 element = Fcons (Qtop, Fcons (Qplus, Fcons (make_number (y), Qnil)));
3170 else
3171 element = Fcons (Qtop, make_number (y));
3172 result = Fcons (element, result);
3173 }
3174
3175 if (geometry & WidthValue)
3176 result = Fcons (Fcons (Qwidth, make_number (width)), result);
3177 if (geometry & HeightValue)
3178 result = Fcons (Fcons (Qheight, make_number (height)), result);
3179
3180 return result;
3181}
3182
3183/* Calculate the desired size and position of this window,
3184 and return the flags saying which aspects were specified.
3185
3186 This function does not make the coordinates positive. */
3187
3188#define DEFAULT_ROWS 40
3189#define DEFAULT_COLS 80
3190
3191static int
3192x_figure_window_size (f, parms)
3193 struct frame *f;
3194 Lisp_Object parms;
3195{
3196 register Lisp_Object tem0, tem1, tem2;
ee78dc32
GV		 3197 long window_prompting = 0;
3198
3199 /* Default values if we fall through.
3200 Actually, if that happens we should get
3201 window manager prompting. */
1026b400 3202 SET_FRAME_WIDTH (f, DEFAULT_COLS);
ee78dc32
GV		 3203 f->height = DEFAULT_ROWS;
3204 /* Window managers expect that if program-specified
3205 positions are not (0,0), they're intentional, not defaults. */
fbd6baed
GV		 3206 f->output_data.w32->top_pos = 0;
3207 f->output_data.w32->left_pos = 0;
ee78dc32 3208
35b41202
JR		 3209 /* Ensure that old new_width and new_height will not override the
3210 values set here. */
3211 FRAME_NEW_WIDTH (f) = 0;
3212 FRAME_NEW_HEIGHT (f) = 0;
3213
6fc2811b
JR		 3214 tem0 = w32_get_arg (parms, Qheight, 0, 0, RES_TYPE_NUMBER);
3215 tem1 = w32_get_arg (parms, Qwidth, 0, 0, RES_TYPE_NUMBER);
3216 tem2 = w32_get_arg (parms, Quser_size, 0, 0, RES_TYPE_NUMBER);
ee78dc32
GV		 3217 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
3218 {
3219 if (!EQ (tem0, Qunbound))
3220 {
3221 CHECK_NUMBER (tem0, 0);
3222 f->height = XINT (tem0);
3223 }
3224 if (!EQ (tem1, Qunbound))
3225 {
3226 CHECK_NUMBER (tem1, 0);
1026b400 3227 SET_FRAME_WIDTH (f, XINT (tem1));
ee78dc32
GV		 3228 }
3229 if (!NILP (tem2) && !EQ (tem2, Qunbound))
3230 window_prompting |= USSize;
3231 else
3232 window_prompting |= PSize;
3233 }
3234
fbd6baed 3235 f->output_data.w32->vertical_scroll_bar_extra
ee78dc32
GV		 3236 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f)
3237 ? 0
3238 : FRAME_SCROLL_BAR_PIXEL_WIDTH (f) > 0
3239 ? FRAME_SCROLL_BAR_PIXEL_WIDTH (f)
fbd6baed 3240 : (FRAME_SCROLL_BAR_COLS (f) * FONT_WIDTH (f->output_data.w32->font)));
6fc2811b
JR		 3241 f->output_data.w32->flags_areas_extra
3242 = FRAME_FLAGS_AREA_WIDTH (f);
fbd6baed
GV		 3243 f->output_data.w32->pixel_width = CHAR_TO_PIXEL_WIDTH (f, f->width);
3244 f->output_data.w32->pixel_height = CHAR_TO_PIXEL_HEIGHT (f, f->height);
ee78dc32 3245
6fc2811b
JR		 3246 tem0 = w32_get_arg (parms, Qtop, 0, 0, RES_TYPE_NUMBER);
3247 tem1 = w32_get_arg (parms, Qleft, 0, 0, RES_TYPE_NUMBER);
3248 tem2 = w32_get_arg (parms, Quser_position, 0, 0, RES_TYPE_NUMBER);
ee78dc32
GV		 3249 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
3250 {
3251 if (EQ (tem0, Qminus))
3252 {
fbd6baed 3253 f->output_data.w32->top_pos = 0;
ee78dc32
GV		 3254 window_prompting |= YNegative;
3255 }
8e713be6
KR		 3256 else if (CONSP (tem0) && EQ (XCAR (tem0), Qminus)
3257 && CONSP (XCDR (tem0))
3258 && INTEGERP (XCAR (XCDR (tem0))))
ee78dc32 3259 {
8e713be6 3260 f->output_data.w32->top_pos = - XINT (XCAR (XCDR (tem0)));
ee78dc32
GV		 3261 window_prompting |= YNegative;
3262 }
8e713be6
KR		 3263 else if (CONSP (tem0) && EQ (XCAR (tem0), Qplus)
3264 && CONSP (XCDR (tem0))
3265 && INTEGERP (XCAR (XCDR (tem0))))
ee78dc32 3266 {
8e713be6 3267 f->output_data.w32->top_pos = XINT (XCAR (XCDR (tem0)));
ee78dc32
GV		 3268 }
3269 else if (EQ (tem0, Qunbound))
fbd6baed 3270 f->output_data.w32->top_pos = 0;
ee78dc32
GV		 3271 else
3272 {
3273 CHECK_NUMBER (tem0, 0);
fbd6baed
GV		 3274 f->output_data.w32->top_pos = XINT (tem0);
3275 if (f->output_data.w32->top_pos < 0)
ee78dc32
GV		 3276 window_prompting |= YNegative;
3277 }
3278
3279 if (EQ (tem1, Qminus))
3280 {
fbd6baed 3281 f->output_data.w32->left_pos = 0;
ee78dc32
GV		 3282 window_prompting |= XNegative;
3283 }
8e713be6
KR		 3284 else if (CONSP (tem1) && EQ (XCAR (tem1), Qminus)
3285 && CONSP (XCDR (tem1))
3286 && INTEGERP (XCAR (XCDR (tem1))))
ee78dc32 3287 {
8e713be6 3288 f->output_data.w32->left_pos = - XINT (XCAR (XCDR (tem1)));
ee78dc32
GV		 3289 window_prompting |= XNegative;
3290 }
8e713be6
KR		 3291 else if (CONSP (tem1) && EQ (XCAR (tem1), Qplus)
3292 && CONSP (XCDR (tem1))
3293 && INTEGERP (XCAR (XCDR (tem1))))
ee78dc32 3294 {
8e713be6 3295 f->output_data.w32->left_pos = XINT (XCAR (XCDR (tem1)));
ee78dc32
GV		 3296 }
3297 else if (EQ (tem1, Qunbound))
fbd6baed 3298 f->output_data.w32->left_pos = 0;
ee78dc32
GV		 3299 else
3300 {
3301 CHECK_NUMBER (tem1, 0);
fbd6baed
GV		 3302 f->output_data.w32->left_pos = XINT (tem1);
3303 if (f->output_data.w32->left_pos < 0)
ee78dc32
GV		 3304 window_prompting |= XNegative;
3305 }
3306
3307 if (!NILP (tem2) && ! EQ (tem2, Qunbound))
3308 window_prompting |= USPosition;
3309 else
3310 window_prompting |= PPosition;
3311 }
3312
3313 return window_prompting;
3314}
3315
3316\f
3317
fbd6baed 3318extern LRESULT CALLBACK w32_wnd_proc ();
ee78dc32
GV		 3319
3320BOOL
fbd6baed 3321w32_init_class (hinst)
ee78dc32
GV		 3322 HINSTANCE hinst;
3323{
3324 WNDCLASS wc;
3325
5ac45f98 3326 wc.style = CS_HREDRAW | CS_VREDRAW;
fbd6baed 3327 wc.lpfnWndProc = (WNDPROC) w32_wnd_proc;
ee78dc32
GV		 3328 wc.cbClsExtra = 0;
3329 wc.cbWndExtra = WND_EXTRA_BYTES;
3330 wc.hInstance = hinst;
3331 wc.hIcon = LoadIcon (hinst, EMACS_CLASS);
3332 wc.hCursor = LoadCursor (NULL, IDC_ARROW);
4587b026 3333 wc.hbrBackground = NULL; /* GetStockObject (WHITE_BRUSH); */
ee78dc32
GV		 3334 wc.lpszMenuName = NULL;
3335 wc.lpszClassName = EMACS_CLASS;
3336
3337 return (RegisterClass (&wc));
3338}
3339
3340HWND
fbd6baed 3341w32_createscrollbar (f, bar)
ee78dc32
GV		 3342 struct frame *f;
3343 struct scroll_bar * bar;
3344{
3345 return (CreateWindow ("SCROLLBAR", "", SBS_VERT | WS_CHILD | WS_VISIBLE,
3346 /* Position and size of scroll bar. */
6fc2811b
JR		 3347 XINT(bar->left) + VERTICAL_SCROLL_BAR_WIDTH_TRIM,
3348 XINT(bar->top),
3349 XINT(bar->width) - VERTICAL_SCROLL_BAR_WIDTH_TRIM * 2,
3350 XINT(bar->height),
fbd6baed 3351 FRAME_W32_WINDOW (f),
ee78dc32
GV		 3352 NULL,
3353 hinst,
3354 NULL));
3355}
3356
3357void
fbd6baed 3358w32_createwindow (f)
ee78dc32
GV		 3359 struct frame *f;
3360{
3361 HWND hwnd;
1edf84e7
GV		 3362 RECT rect;
3363
3364 rect.left = rect.top = 0;
3365 rect.right = PIXEL_WIDTH (f);
3366 rect.bottom = PIXEL_HEIGHT (f);
3367
3368 AdjustWindowRect (&rect, f->output_data.w32->dwStyle,
3369 FRAME_EXTERNAL_MENU_BAR (f));
ee78dc32
GV		 3370
3371 /* Do first time app init */
3372
3373 if (!hprevinst)
3374 {
fbd6baed 3375 w32_init_class (hinst);
ee78dc32
GV		 3376 }
3377
1edf84e7
GV		 3378 FRAME_W32_WINDOW (f) = hwnd
3379 = CreateWindow (EMACS_CLASS,
3380 f->namebuf,
9ead1b60 3381 f->output_data.w32->dwStyle | WS_CLIPCHILDREN,
1edf84e7
GV		 3382 f->output_data.w32->left_pos,
3383 f->output_data.w32->top_pos,
3384 rect.right - rect.left,
3385 rect.bottom - rect.top,
3386 NULL,
3387 NULL,
3388 hinst,
3389 NULL);
3390
ee78dc32
GV		 3391 if (hwnd)
3392 {
1edf84e7
GV		 3393 SetWindowLong (hwnd, WND_FONTWIDTH_INDEX, FONT_WIDTH (f->output_data.w32->font));
3394 SetWindowLong (hwnd, WND_LINEHEIGHT_INDEX, f->output_data.w32->line_height);
3395 SetWindowLong (hwnd, WND_BORDER_INDEX, f->output_data.w32->internal_border_width);
3396 SetWindowLong (hwnd, WND_SCROLLBAR_INDEX, f->output_data.w32->vertical_scroll_bar_extra);
6fc2811b 3397 SetWindowLong (hwnd, WND_BACKGROUND_INDEX, FRAME_BACKGROUND_PIXEL (f));
ee78dc32 3398
cb9e33d4
RS		 3399 /* Enable drag-n-drop. */
3400 DragAcceptFiles (hwnd, TRUE);
3401
5ac45f98
GV		 3402 /* Do this to discard the default setting specified by our parent. */
3403 ShowWindow (hwnd, SW_HIDE);
3c190163 3404 }
3c190163
GV		 3405}
3406
ee78dc32
GV		 3407void
3408my_post_msg (wmsg, hwnd, msg, wParam, lParam)
fbd6baed 3409 W32Msg * wmsg;
ee78dc32
GV		 3410 HWND hwnd;
3411 UINT msg;
3412 WPARAM wParam;
3413 LPARAM lParam;
3414{
3415 wmsg->msg.hwnd = hwnd;
3416 wmsg->msg.message = msg;
3417 wmsg->msg.wParam = wParam;
3418 wmsg->msg.lParam = lParam;
3419 wmsg->msg.time = GetMessageTime ();
3420
3421 post_msg (wmsg);
3422}
3423
e9e23e23 3424/* GetKeyState and MapVirtualKey on Windows 95 do not actually distinguish
a1a80b40
GV		 3425 between left and right keys as advertised. We test for this
3426 support dynamically, and set a flag when the support is absent. If
3427 absent, we keep track of the left and right control and alt keys
3428 ourselves. This is particularly necessary on keyboards that rely
3429 upon the AltGr key, which is represented as having the left control
3430 and right alt keys pressed. For these keyboards, we need to know
3431 when the left alt key has been pressed in addition to the AltGr key
3432 so that we can properly support M-AltGr-key sequences (such as M-@
3433 on Swedish keyboards). */
3434
3435#define EMACS_LCONTROL 0
3436#define EMACS_RCONTROL 1
3437#define EMACS_LMENU 2
3438#define EMACS_RMENU 3
3439
3440static int modifiers[4];
3441static int modifiers_recorded;
3442static int modifier_key_support_tested;
3443
3444static void
3445test_modifier_support (unsigned int wparam)
3446{
3447 unsigned int l, r;
3448
3449 if (wparam != VK_CONTROL && wparam != VK_MENU)
3450 return;
3451 if (wparam == VK_CONTROL)
3452 {
3453 l = VK_LCONTROL;
3454 r = VK_RCONTROL;
3455 }
3456 else
3457 {
3458 l = VK_LMENU;
3459 r = VK_RMENU;
3460 }
3461 if (!(GetKeyState (l) & 0x8000) && !(GetKeyState (r) & 0x8000))
3462 modifiers_recorded = 1;
3463 else
3464 modifiers_recorded = 0;
3465 modifier_key_support_tested = 1;
3466}
3467
3468static void
3469record_keydown (unsigned int wparam, unsigned int lparam)
3470{
3471 int i;
3472
3473 if (!modifier_key_support_tested)
3474 test_modifier_support (wparam);
3475
3476 if ((wparam != VK_CONTROL && wparam != VK_MENU) || !modifiers_recorded)
3477 return;
3478
3479 if (wparam == VK_CONTROL)
3480 i = (lparam & 0x1000000) ? EMACS_RCONTROL : EMACS_LCONTROL;
3481 else
3482 i = (lparam & 0x1000000) ? EMACS_RMENU : EMACS_LMENU;
3483
3484 modifiers[i] = 1;
3485}
3486
3487static void
3488record_keyup (unsigned int wparam, unsigned int lparam)
3489{
3490 int i;
3491
3492 if ((wparam != VK_CONTROL && wparam != VK_MENU) || !modifiers_recorded)
3493 return;
3494
3495 if (wparam == VK_CONTROL)
3496 i = (lparam & 0x1000000) ? EMACS_RCONTROL : EMACS_LCONTROL;
3497 else
3498 i = (lparam & 0x1000000) ? EMACS_RMENU : EMACS_LMENU;
3499
3500 modifiers[i] = 0;
3501}
3502
da36a4d6
GV		 3503/* Emacs can lose focus while a modifier key has been pressed. When
3504 it regains focus, be conservative and clear all modifiers since
3505 we cannot reconstruct the left and right modifier state. */
3506static void
3507reset_modifiers ()
3508{
8681157a
RS		 3509 SHORT ctrl, alt;
3510
adcc3809
GV		 3511 if (GetFocus () == NULL)
3512 /* Emacs doesn't have keyboard focus. Do nothing. */
da36a4d6 3513 return;
8681157a
RS		 3514
3515 ctrl = GetAsyncKeyState (VK_CONTROL);
3516 alt = GetAsyncKeyState (VK_MENU);
3517
8681157a
RS		 3518 if (!(ctrl & 0x08000))
3519 /* Clear any recorded control modifier state. */
3520 modifiers[EMACS_RCONTROL] = modifiers[EMACS_LCONTROL] = 0;
3521
3522 if (!(alt & 0x08000))
3523 /* Clear any recorded alt modifier state. */
3524 modifiers[EMACS_RMENU] = modifiers[EMACS_LMENU] = 0;
3525
adcc3809
GV		 3526 /* Update the state of all modifier keys, because modifiers used in
3527 hot-key combinations can get stuck on if Emacs loses focus as a
3528 result of a hot-key being pressed. */
3529 {
3530 BYTE keystate[256];
3531
3532#define CURRENT_STATE(key) ((GetAsyncKeyState (key) & 0x8000) >> 8)
3533
3534 GetKeyboardState (keystate);
3535 keystate[VK_SHIFT] = CURRENT_STATE (VK_SHIFT);
3536 keystate[VK_CONTROL] = CURRENT_STATE (VK_CONTROL);
3537 keystate[VK_LCONTROL] = CURRENT_STATE (VK_LCONTROL);
3538 keystate[VK_RCONTROL] = CURRENT_STATE (VK_RCONTROL);
3539 keystate[VK_MENU] = CURRENT_STATE (VK_MENU);
3540 keystate[VK_LMENU] = CURRENT_STATE (VK_LMENU);
3541 keystate[VK_RMENU] = CURRENT_STATE (VK_RMENU);
3542 keystate[VK_LWIN] = CURRENT_STATE (VK_LWIN);
3543 keystate[VK_RWIN] = CURRENT_STATE (VK_RWIN);
3544 keystate[VK_APPS] = CURRENT_STATE (VK_APPS);
3545 SetKeyboardState (keystate);
3546 }
da36a4d6
GV		 3547}
3548
7830e24b
RS		 3549/* Synchronize modifier state with what is reported with the current
3550 keystroke. Even if we cannot distinguish between left and right
3551 modifier keys, we know that, if no modifiers are set, then neither
3552 the left or right modifier should be set. */
3553static void
3554sync_modifiers ()
3555{
3556 if (!modifiers_recorded)
3557 return;
3558
3559 if (!(GetKeyState (VK_CONTROL) & 0x8000))
3560 modifiers[EMACS_RCONTROL] = modifiers[EMACS_LCONTROL] = 0;
3561
3562 if (!(GetKeyState (VK_MENU) & 0x8000))
3563 modifiers[EMACS_RMENU] = modifiers[EMACS_LMENU] = 0;
3564}
3565
a1a80b40
GV		 3566static int
3567modifier_set (int vkey)
3568{
ccc2d29c 3569 if (vkey == VK_CAPITAL || vkey == VK_SCROLL)
891560d6 3570 return (GetKeyState (vkey) & 0x1);
a1a80b40
GV		 3571 if (!modifiers_recorded)
3572 return (GetKeyState (vkey) & 0x8000);
3573
3574 switch (vkey)
3575 {
3576 case VK_LCONTROL:
3577 return modifiers[EMACS_LCONTROL];
3578 case VK_RCONTROL:
3579 return modifiers[EMACS_RCONTROL];
3580 case VK_LMENU:
3581 return modifiers[EMACS_LMENU];
3582 case VK_RMENU:
3583 return modifiers[EMACS_RMENU];
a1a80b40
GV		 3584 }
3585 return (GetKeyState (vkey) & 0x8000);
3586}
3587
ccc2d29c
GV		 3588/* Convert between the modifier bits W32 uses and the modifier bits
3589 Emacs uses. */
3590
3591unsigned int
3592w32_key_to_modifier (int key)
3593{
3594 Lisp_Object key_mapping;
3595
3596 switch (key)
3597 {
3598 case VK_LWIN:
3599 key_mapping = Vw32_lwindow_modifier;
3600 break;
3601 case VK_RWIN:
3602 key_mapping = Vw32_rwindow_modifier;
3603 break;
3604 case VK_APPS:
3605 key_mapping = Vw32_apps_modifier;
3606 break;
3607 case VK_SCROLL:
3608 key_mapping = Vw32_scroll_lock_modifier;
3609 break;
3610 default:
3611 key_mapping = Qnil;
3612 }
3613
adcc3809
GV		 3614 /* NB. This code runs in the input thread, asychronously to the lisp
3615 thread, so we must be careful to ensure access to lisp data is
3616 thread-safe. The following code is safe because the modifier
3617 variable values are updated atomically from lisp and symbols are
3618 not relocated by GC. Also, we don't have to worry about seeing GC
3619 markbits here. */
3620 if (EQ (key_mapping, Qhyper))
ccc2d29c 3621 return hyper_modifier;
adcc3809 3622 if (EQ (key_mapping, Qsuper))
ccc2d29c 3623 return super_modifier;
adcc3809 3624 if (EQ (key_mapping, Qmeta))
ccc2d29c 3625 return meta_modifier;
adcc3809 3626 if (EQ (key_mapping, Qalt))
ccc2d29c 3627 return alt_modifier;
adcc3809 3628 if (EQ (key_mapping, Qctrl))
ccc2d29c 3629 return ctrl_modifier;
adcc3809 3630 if (EQ (key_mapping, Qcontrol)) /* synonym for ctrl */
ccc2d29c 3631 return ctrl_modifier;
adcc3809 3632 if (EQ (key_mapping, Qshift))
ccc2d29c
GV		 3633 return shift_modifier;
3634
3635 /* Don't generate any modifier if not explicitly requested. */
3636 return 0;
3637}
3638
3639unsigned int
3640w32_get_modifiers ()
3641{
3642 return ((modifier_set (VK_SHIFT) ? shift_modifier : 0) |
3643 (modifier_set (VK_CONTROL) ? ctrl_modifier : 0) |
3644 (modifier_set (VK_LWIN) ? w32_key_to_modifier (VK_LWIN) : 0) |
3645 (modifier_set (VK_RWIN) ? w32_key_to_modifier (VK_RWIN) : 0) |
3646 (modifier_set (VK_APPS) ? w32_key_to_modifier (VK_APPS) : 0) |
3647 (modifier_set (VK_SCROLL) ? w32_key_to_modifier (VK_SCROLL) : 0) |
3648 (modifier_set (VK_MENU) ?
3649 ((NILP (Vw32_alt_is_meta)) ? alt_modifier : meta_modifier) : 0));
3650}
3651
a1a80b40
GV		 3652/* We map the VK_* modifiers into console modifier constants
3653 so that we can use the same routines to handle both console
3654 and window input. */
3655
3656static int
ccc2d29c 3657construct_console_modifiers ()
a1a80b40
GV		 3658{
3659 int mods;
3660
a1a80b40
GV		 3661 mods = 0;
3662 mods |= (modifier_set (VK_SHIFT)) ? SHIFT_PRESSED : 0;
3663 mods |= (modifier_set (VK_CAPITAL)) ? CAPSLOCK_ON : 0;
ccc2d29c
GV		 3664 mods |= (modifier_set (VK_SCROLL)) ? SCROLLLOCK_ON : 0;
3665 mods |= (modifier_set (VK_NUMLOCK)) ? NUMLOCK_ON : 0;
a1a80b40
GV		 3666 mods |= (modifier_set (VK_LCONTROL)) ? LEFT_CTRL_PRESSED : 0;
3667 mods |= (modifier_set (VK_RCONTROL)) ? RIGHT_CTRL_PRESSED : 0;
3668 mods |= (modifier_set (VK_LMENU)) ? LEFT_ALT_PRESSED : 0;
3669 mods |= (modifier_set (VK_RMENU)) ? RIGHT_ALT_PRESSED : 0;
ccc2d29c
GV		 3670 mods |= (modifier_set (VK_LWIN)) ? LEFT_WIN_PRESSED : 0;
3671 mods |= (modifier_set (VK_RWIN)) ? RIGHT_WIN_PRESSED : 0;
3672 mods |= (modifier_set (VK_APPS)) ? APPS_PRESSED : 0;
a1a80b40
GV		 3673
3674 return mods;
3675}
3676
ccc2d29c
GV		 3677static int
3678w32_get_key_modifiers (unsigned int wparam, unsigned int lparam)
da36a4d6 3679{
ccc2d29c
GV		 3680 int mods;
3681
3682 /* Convert to emacs modifiers. */
3683 mods = w32_kbd_mods_to_emacs (construct_console_modifiers (), wparam);
3684
3685 return mods;
3686}
da36a4d6 3687
ccc2d29c
GV		 3688unsigned int
3689map_keypad_keys (unsigned int virt_key, unsigned int extended)
3690{
3691 if (virt_key < VK_CLEAR || virt_key > VK_DELETE)
3692 return virt_key;
da36a4d6 3693
ccc2d29c 3694 if (virt_key == VK_RETURN)
da36a4d6
GV		 3695 return (extended ? VK_NUMPAD_ENTER : VK_RETURN);
3696
ccc2d29c
GV		 3697 if (virt_key >= VK_PRIOR && virt_key <= VK_DOWN)
3698 return (!extended ? (VK_NUMPAD_PRIOR + (virt_key - VK_PRIOR)) : virt_key);
3699
3700 if (virt_key == VK_INSERT || virt_key == VK_DELETE)
3701 return (!extended ? (VK_NUMPAD_INSERT + (virt_key - VK_INSERT)) : virt_key);
3702
3703 if (virt_key == VK_CLEAR)
3704 return (!extended ? VK_NUMPAD_CLEAR : virt_key);
3705
3706 return virt_key;
3707}
3708
3709/* List of special key combinations which w32 would normally capture,
3710 but emacs should grab instead. Not directly visible to lisp, to
3711 simplify synchronization. Each item is an integer encoding a virtual
3712 key code and modifier combination to capture. */
3713Lisp_Object w32_grabbed_keys;
3714
3715#define HOTKEY(vk,mods) make_number (((vk) & 255) | ((mods) << 8))
3716#define HOTKEY_ID(k) (XFASTINT (k) & 0xbfff)
3717#define HOTKEY_VK_CODE(k) (XFASTINT (k) & 255)
3718#define HOTKEY_MODIFIERS(k) (XFASTINT (k) >> 8)
3719
3720/* Register hot-keys for reserved key combinations when Emacs has
3721 keyboard focus, since this is the only way Emacs can receive key
3722 combinations like Alt-Tab which are used by the system. */
3723
3724static void
3725register_hot_keys (hwnd)
3726 HWND hwnd;
3727{
3728 Lisp_Object keylist;
3729
3730 /* Use GC_CONSP, since we are called asynchronously. */
3731 for (keylist = w32_grabbed_keys; GC_CONSP (keylist); keylist = XCDR (keylist))
3732 {
3733 Lisp_Object key = XCAR (keylist);
3734
3735 /* Deleted entries get set to nil. */
3736 if (!INTEGERP (key))
3737 continue;
3738
3739 RegisterHotKey (hwnd, HOTKEY_ID (key),
3740 HOTKEY_MODIFIERS (key), HOTKEY_VK_CODE (key));
3741 }
3742}
3743
3744static void
3745unregister_hot_keys (hwnd)
3746 HWND hwnd;
3747{
3748 Lisp_Object keylist;
3749
3750 /* Use GC_CONSP, since we are called asynchronously. */
3751 for (keylist = w32_grabbed_keys; GC_CONSP (keylist); keylist = XCDR (keylist))
3752 {
3753 Lisp_Object key = XCAR (keylist);
3754
3755 if (!INTEGERP (key))
3756 continue;
3757
3758 UnregisterHotKey (hwnd, HOTKEY_ID (key));
3759 }
3760}
3761
5ac45f98
GV		 3762/* Main message dispatch loop. */
3763
1edf84e7
GV		 3764static void
3765w32_msg_pump (deferred_msg * msg_buf)
5ac45f98
GV		 3766{
3767 MSG msg;
ccc2d29c
GV		 3768 int result;
3769 HWND focus_window;
93fbe8b7
GV		 3770
3771 msh_mousewheel = RegisterWindowMessage (MSH_MOUSEWHEEL);
5ac45f98 3772
5ac45f98
GV		 3773 while (GetMessage (&msg, NULL, 0, 0))
3774 {
3775 if (msg.hwnd == NULL)
3776 {
3777 switch (msg.message)
3778 {
3ef68e6b
AI		 3779 case WM_NULL:
3780 /* Produced by complete_deferred_msg; just ignore. */
3781 break;
5ac45f98 3782 case WM_EMACS_CREATEWINDOW:
fbd6baed 3783 w32_createwindow ((struct frame *) msg.wParam);
1edf84e7
GV		 3784 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0))
3785 abort ();
5ac45f98 3786 break;
dfdb4047
GV		 3787 case WM_EMACS_SETLOCALE:
3788 SetThreadLocale (msg.wParam);
3789 /* Reply is not expected. */
3790 break;
ccc2d29c
GV		 3791 case WM_EMACS_SETKEYBOARDLAYOUT:
3792 result = (int) ActivateKeyboardLayout ((HKL) msg.wParam, 0);
3793 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE,
3794 result, 0))
3795 abort ();
3796 break;
3797 case WM_EMACS_REGISTER_HOT_KEY:
3798 focus_window = GetFocus ();
3799 if (focus_window != NULL)
3800 RegisterHotKey (focus_window,
3801 HOTKEY_ID (msg.wParam),
3802 HOTKEY_MODIFIERS (msg.wParam),
3803 HOTKEY_VK_CODE (msg.wParam));
3804 /* Reply is not expected. */
3805 break;
3806 case WM_EMACS_UNREGISTER_HOT_KEY:
3807 focus_window = GetFocus ();
3808 if (focus_window != NULL)
3809 UnregisterHotKey (focus_window, HOTKEY_ID (msg.wParam));
adcc3809
GV		 3810 /* Mark item as erased. NB: this code must be
3811 thread-safe. The next line is okay because the cons
3812 cell is never made into garbage and is not relocated by
3813 GC. */
f3fbd155 3814 XSETCAR ((Lisp_Object) msg.lParam, Qnil);
ccc2d29c
GV		 3815 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0))
3816 abort ();
3817 break;
adcc3809
GV		 3818 case WM_EMACS_TOGGLE_LOCK_KEY:
3819 {
3820 int vk_code = (int) msg.wParam;
3821 int cur_state = (GetKeyState (vk_code) & 1);
3822 Lisp_Object new_state = (Lisp_Object) msg.lParam;
3823
3824 /* NB: This code must be thread-safe. It is safe to
3825 call NILP because symbols are not relocated by GC,
3826 and pointer here is not touched by GC (so the markbit
3827 can't be set). Numbers are safe because they are
3828 immediate values. */
3829 if (NILP (new_state)
3830 || (NUMBERP (new_state)
8edb0a6f 3831 && ((XUINT (new_state)) & 1) != cur_state))
adcc3809
GV		 3832 {
3833 one_w32_display_info.faked_key = vk_code;
3834
3835 keybd_event ((BYTE) vk_code,
3836 (BYTE) MapVirtualKey (vk_code, 0),
3837 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
3838 keybd_event ((BYTE) vk_code,
3839 (BYTE) MapVirtualKey (vk_code, 0),
3840 KEYEVENTF_EXTENDEDKEY | 0, 0);
3841 keybd_event ((BYTE) vk_code,
3842 (BYTE) MapVirtualKey (vk_code, 0),
3843 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
3844 cur_state = !cur_state;
3845 }
3846 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE,
3847 cur_state, 0))
3848 abort ();
3849 }
3850 break;
1edf84e7 3851 default:
1edf84e7 3852 DebPrint (("msg %x not expected by w32_msg_pump\n", msg.message));
5ac45f98
GV		 3853 }
3854 }
3855 else
3856 {
3857 DispatchMessage (&msg);
3858 }
1edf84e7
GV		 3859
3860 /* Exit nested loop when our deferred message has completed. */
3861 if (msg_buf->completed)
3862 break;
5ac45f98 3863 }
1edf84e7
GV		 3864}
3865
3866deferred_msg * deferred_msg_head;
3867
3868static deferred_msg *
3869find_deferred_msg (HWND hwnd, UINT msg)
3870{
3871 deferred_msg * item;
3872
3873 /* Don't actually need synchronization for read access, since
3874 modification of single pointer is always atomic. */
3875 /* enter_crit (); */
3876
3877 for (item = deferred_msg_head; item != NULL; item = item->next)
3878 if (item->w32msg.msg.hwnd == hwnd
3879 && item->w32msg.msg.message == msg)
3880 break;
3881
3882 /* leave_crit (); */
3883
3884 return item;
3885}
3886
3887static LRESULT
3888send_deferred_msg (deferred_msg * msg_buf,
3889 HWND hwnd,
3890 UINT msg,
3891 WPARAM wParam,
3892 LPARAM lParam)
3893{
3894 /* Only input thread can send deferred messages. */
3895 if (GetCurrentThreadId () != dwWindowsThreadId)
3896 abort ();
3897
3898 /* It is an error to send a message that is already deferred. */
3899 if (find_deferred_msg (hwnd, msg) != NULL)
3900 abort ();
3901
3902 /* Enforced synchronization is not needed because this is the only
3903 function that alters deferred_msg_head, and the following critical
3904 section is guaranteed to only be serially reentered (since only the
3905 input thread can call us). */
3906
3907 /* enter_crit (); */
3908
3909 msg_buf->completed = 0;
3910 msg_buf->next = deferred_msg_head;
3911 deferred_msg_head = msg_buf;
3912 my_post_msg (&msg_buf->w32msg, hwnd, msg, wParam, lParam);
3913
3914 /* leave_crit (); */
3915
3916 /* Start a new nested message loop to process other messages until
3917 this one is completed. */
3918 w32_msg_pump (msg_buf);
3919
3920 deferred_msg_head = msg_buf->next;
3921
3922 return msg_buf->result;
3923}
3924
3925void
3926complete_deferred_msg (HWND hwnd, UINT msg, LRESULT result)
3927{
3928 deferred_msg * msg_buf = find_deferred_msg (hwnd, msg);
3929
3930 if (msg_buf == NULL)
3ef68e6b
AI		 3931 /* Message may have been cancelled, so don't abort(). */
3932 return;
1edf84e7
GV		 3933
3934 msg_buf->result = result;
3935 msg_buf->completed = 1;
3936
3937 /* Ensure input thread is woken so it notices the completion. */
3938 PostThreadMessage (dwWindowsThreadId, WM_NULL, 0, 0);
3939}
3940
3ef68e6b
AI		 3941void
3942cancel_all_deferred_msgs ()
3943{
3944 deferred_msg * item;
3945
3946 /* Don't actually need synchronization for read access, since
3947 modification of single pointer is always atomic. */
3948 /* enter_crit (); */
3949
3950 for (item = deferred_msg_head; item != NULL; item = item->next)
3951 {
3952 item->result = 0;
3953 item->completed = 1;
3954 }
3955
3956 /* leave_crit (); */
3957
3958 /* Ensure input thread is woken so it notices the completion. */
3959 PostThreadMessage (dwWindowsThreadId, WM_NULL, 0, 0);
3960}
1edf84e7
GV		 3961
3962DWORD
3963w32_msg_worker (dw)
3964 DWORD dw;
3965{
3966 MSG msg;
3967 deferred_msg dummy_buf;
3968
3969 /* Ensure our message queue is created */
3970
3971 PeekMessage (&msg, NULL, 0, 0, PM_NOREMOVE);
5ac45f98 3972
1edf84e7
GV		 3973 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0))
3974 abort ();
3975
3976 memset (&dummy_buf, 0, sizeof (dummy_buf));
3977 dummy_buf.w32msg.msg.hwnd = NULL;
3978 dummy_buf.w32msg.msg.message = WM_NULL;
3979
3980 /* This is the inital message loop which should only exit when the
3981 application quits. */
3982 w32_msg_pump (&dummy_buf);
3983
3984 return 0;
5ac45f98
GV		 3985}
3986
3ef68e6b
AI		 3987static void
3988post_character_message (hwnd, msg, wParam, lParam, modifiers)
3989 HWND hwnd;
3990 UINT msg;
3991 WPARAM wParam;
3992 LPARAM lParam;
3993 DWORD modifiers;
3994
3995{
3996 W32Msg wmsg;
3997
3998 wmsg.dwModifiers = modifiers;
3999
4000 /* Detect quit_char and set quit-flag directly. Note that we
4001 still need to post a message to ensure the main thread will be
4002 woken up if blocked in sys_select(), but we do NOT want to post
4003 the quit_char message itself (because it will usually be as if
4004 the user had typed quit_char twice). Instead, we post a dummy
4005 message that has no particular effect. */
4006 {
4007 int c = wParam;
4008 if (isalpha (c) && wmsg.dwModifiers == ctrl_modifier)
4009 c = make_ctrl_char (c) & 0377;
7d081355
AI		 4010 if (c == quit_char
4011 || (wmsg.dwModifiers == 0 &&
4012 XFASTINT (Vw32_quit_key) && wParam == XFASTINT (Vw32_quit_key)))
3ef68e6b
AI		 4013 {
4014 Vquit_flag = Qt;
4015
4016 /* The choice of message is somewhat arbitrary, as long as
4017 the main thread handler just ignores it. */
4018 msg = WM_NULL;
4019
4020 /* Interrupt any blocking system calls. */
4021 signal_quit ();
4022
4023 /* As a safety precaution, forcibly complete any deferred
4024 messages. This is a kludge, but I don't see any particularly
4025 clean way to handle the situation where a deferred message is
4026 "dropped" in the lisp thread, and will thus never be
4027 completed, eg. by the user trying to activate the menubar
4028 when the lisp thread is busy, and then typing C-g when the
4029 menubar doesn't open promptly (with the result that the
4030 menubar never responds at all because the deferred
4031 WM_INITMENU message is never completed). Another problem
4032 situation is when the lisp thread calls SendMessage (to send
4033 a window manager command) when a message has been deferred;
4034 the lisp thread gets blocked indefinitely waiting for the
4035 deferred message to be completed, which itself is waiting for
4036 the lisp thread to respond.
4037
4038 Note that we don't want to block the input thread waiting for
4039 a reponse from the lisp thread (although that would at least
4040 solve the deadlock problem above), because we want to be able
4041 to receive C-g to interrupt the lisp thread. */
4042 cancel_all_deferred_msgs ();
4043 }
4044 }
4045
4046 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4047}
4048
ee78dc32
GV		 4049/* Main window procedure */
4050
ee78dc32 4051LRESULT CALLBACK
fbd6baed 4052w32_wnd_proc (hwnd, msg, wParam, lParam)
ee78dc32
GV		 4053 HWND hwnd;
4054 UINT msg;
4055 WPARAM wParam;
4056 LPARAM lParam;
4057{
4058 struct frame *f;
fbd6baed
GV		 4059 struct w32_display_info *dpyinfo = &one_w32_display_info;
4060 W32Msg wmsg;
84fb1139 4061 int windows_translate;
576ba81c 4062 int key;
84fb1139 4063
a6085637
KH		 4064 /* Note that it is okay to call x_window_to_frame, even though we are
4065 not running in the main lisp thread, because frame deletion
4066 requires the lisp thread to synchronize with this thread. Thus, if
4067 a frame struct is returned, it can be used without concern that the
4068 lisp thread might make it disappear while we are using it.
4069
4070 NB. Walking the frame list in this thread is safe (as long as
4071 writes of Lisp_Object slots are atomic, which they are on Windows).
4072 Although delete-frame can destructively modify the frame list while
4073 we are walking it, a garbage collection cannot occur until after
4074 delete-frame has synchronized with this thread.
4075
4076 It is also safe to use functions that make GDI calls, such as
fbd6baed 4077 w32_clear_rect, because these functions must obtain a DC handle
a6085637
KH		 4078 from the frame struct using get_frame_dc which is thread-aware. */
4079
ee78dc32
GV		 4080 switch (msg)
4081 {
4082 case WM_ERASEBKGND:
a6085637
KH		 4083 f = x_window_to_frame (dpyinfo, hwnd);
4084 if (f)
4085 {
9badad41 4086 HDC hdc = get_frame_dc (f);
a6085637 4087 GetUpdateRect (hwnd, &wmsg.rect, FALSE);
9badad41
JR		 4088 w32_clear_rect (f, hdc, &wmsg.rect);
4089 release_frame_dc (f, hdc);
ce6059da
AI		 4090
4091#if defined (W32_DEBUG_DISPLAY)
18f0b342
AI		 4092 DebPrint (("WM_ERASEBKGND (frame %p): erasing %d,%d-%d,%d\n",
4093 f,
4094 wmsg.rect.left, wmsg.rect.top,
4095 wmsg.rect.right, wmsg.rect.bottom));
ce6059da 4096#endif /* W32_DEBUG_DISPLAY */
a6085637 4097 }
5ac45f98
GV		 4098 return 1;
4099 case WM_PALETTECHANGED:
4100 /* ignore our own changes */
4101 if ((HWND)wParam != hwnd)
4102 {
a6085637
KH		 4103 f = x_window_to_frame (dpyinfo, hwnd);
4104 if (f)
4105 /* get_frame_dc will realize our palette and force all
4106 frames to be redrawn if needed. */
4107 release_frame_dc (f, get_frame_dc (f));
5ac45f98
GV		 4108 }
4109 return 0;
ee78dc32 4110 case WM_PAINT:
ce6059da 4111 {
55dcfc15
AI		 4112 PAINTSTRUCT paintStruct;
4113 RECT update_rect;
4114
18f0b342
AI		 4115 f = x_window_to_frame (dpyinfo, hwnd);
4116 if (f == 0)
4117 {
4118 DebPrint (("WM_PAINT received for unknown window %p\n", hwnd));
4119 return 0;
4120 }
4121
55dcfc15
AI		 4122 /* MSDN Docs say not to call BeginPaint if GetUpdateRect
4123 fails. Apparently this can happen under some
4124 circumstances. */
c0611964 4125 if (!w32_strict_painting || GetUpdateRect (hwnd, &update_rect, FALSE))
55dcfc15
AI		 4126 {
4127 enter_crit ();
4128 BeginPaint (hwnd, &paintStruct);
4129
c0611964
AI		 4130 if (w32_strict_painting)
4131 /* The rectangles returned by GetUpdateRect and BeginPaint
4132 do not always match. GetUpdateRect seems to be the
4133 more reliable of the two. */
4134 wmsg.rect = update_rect;
4135 else
4136 wmsg.rect = paintStruct.rcPaint;
55dcfc15
AI		 4137
4138#if defined (W32_DEBUG_DISPLAY)
18f0b342
AI		 4139 DebPrint (("WM_PAINT (frame %p): painting %d,%d-%d,%d\n",
4140 f,
4141 wmsg.rect.left, wmsg.rect.top,
4142 wmsg.rect.right, wmsg.rect.bottom));
4143 DebPrint ((" [update region is %d,%d-%d,%d]\n",
55dcfc15
AI		 4144 update_rect.left, update_rect.top,
4145 update_rect.right, update_rect.bottom));
4146#endif
4147 EndPaint (hwnd, &paintStruct);
4148 leave_crit ();
4149
4150 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4151
4152 return 0;
4153 }
c0611964
AI		 4154
4155 /* If GetUpdateRect returns 0 (meaning there is no update
4156 region), assume the whole window needs to be repainted. */
4157 GetClientRect(hwnd, &wmsg.rect);
4158 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4159 return 0;
ee78dc32 4160 }
a1a80b40 4161
ccc2d29c
GV		 4162 case WM_INPUTLANGCHANGE:
4163 /* Inform lisp thread of keyboard layout changes. */
4164 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4165
4166 /* Clear dead keys in the keyboard state; for simplicity only
4167 preserve modifier key states. */
4168 {
4169 int i;
4170 BYTE keystate[256];
4171
4172 GetKeyboardState (keystate);
4173 for (i = 0; i < 256; i++)
4174 if (1
4175 && i != VK_SHIFT
4176 && i != VK_LSHIFT
4177 && i != VK_RSHIFT
4178 && i != VK_CAPITAL
4179 && i != VK_NUMLOCK
4180 && i != VK_SCROLL
4181 && i != VK_CONTROL
4182 && i != VK_LCONTROL
4183 && i != VK_RCONTROL
4184 && i != VK_MENU
4185 && i != VK_LMENU
4186 && i != VK_RMENU
4187 && i != VK_LWIN
4188 && i != VK_RWIN)
4189 keystate[i] = 0;
4190 SetKeyboardState (keystate);
4191 }
4192 goto dflt;
4193
4194 case WM_HOTKEY:
4195 /* Synchronize hot keys with normal input. */
4196 PostMessage (hwnd, WM_KEYDOWN, HIWORD (lParam), 0);
4197 return (0);
4198
a1a80b40
GV		 4199 case WM_KEYUP:
4200 case WM_SYSKEYUP:
4201 record_keyup (wParam, lParam);
4202 goto dflt;
4203
ee78dc32
GV		 4204 case WM_KEYDOWN:
4205 case WM_SYSKEYDOWN:
ccc2d29c
GV		 4206 /* Ignore keystrokes we fake ourself; see below. */
4207 if (dpyinfo->faked_key == wParam)
4208 {
4209 dpyinfo->faked_key = 0;
576ba81c
AI		 4210 /* Make sure TranslateMessage sees them though (as long as
4211 they don't produce WM_CHAR messages). This ensures that
4212 indicator lights are toggled promptly on Windows 9x, for
4213 example. */
4214 if (lispy_function_keys[wParam] != 0)
4215 {
4216 windows_translate = 1;
4217 goto translate;
4218 }
4219 return 0;
ccc2d29c
GV		 4220 }
4221
7830e24b
RS		 4222 /* Synchronize modifiers with current keystroke. */
4223 sync_modifiers ();
a1a80b40 4224 record_keydown (wParam, lParam);
ccc2d29c 4225 wParam = map_keypad_keys (wParam, (lParam & 0x1000000L) != 0);
84fb1139
KH		 4226
4227 windows_translate = 0;
ccc2d29c
GV		 4228
4229 switch (wParam)
4230 {
4231 case VK_LWIN:
4232 if (NILP (Vw32_pass_lwindow_to_system))
4233 {
4234 /* Prevent system from acting on keyup (which opens the
4235 Start menu if no other key was pressed) by simulating a
4236 press of Space which we will ignore. */
4237 if (GetAsyncKeyState (wParam) & 1)
4238 {
adcc3809 4239 if (NUMBERP (Vw32_phantom_key_code))
576ba81c 4240 key = XUINT (Vw32_phantom_key_code) & 255;
adcc3809 4241 else
576ba81c
AI		 4242 key = VK_SPACE;
4243 dpyinfo->faked_key = key;
4244 keybd_event (key, (BYTE) MapVirtualKey (key, 0), 0, 0);
ccc2d29c
GV		 4245 }
4246 }
4247 if (!NILP (Vw32_lwindow_modifier))
4248 return 0;
4249 break;
4250 case VK_RWIN:
4251 if (NILP (Vw32_pass_rwindow_to_system))
4252 {
4253 if (GetAsyncKeyState (wParam) & 1)
4254 {
adcc3809 4255 if (NUMBERP (Vw32_phantom_key_code))
576ba81c 4256 key = XUINT (Vw32_phantom_key_code) & 255;
adcc3809 4257 else
576ba81c
AI		 4258 key = VK_SPACE;
4259 dpyinfo->faked_key = key;
4260 keybd_event (key, (BYTE) MapVirtualKey (key, 0), 0, 0);
ccc2d29c
GV		 4261 }
4262 }
4263 if (!NILP (Vw32_rwindow_modifier))
4264 return 0;
4265 break;
576ba81c 4266 case VK_APPS:
ccc2d29c
GV		 4267 if (!NILP (Vw32_apps_modifier))
4268 return 0;
4269 break;
4270 case VK_MENU:
4271 if (NILP (Vw32_pass_alt_to_system))
adcc3809
GV		 4272 /* Prevent DefWindowProc from activating the menu bar if an
4273 Alt key is pressed and released by itself. */
ccc2d29c 4274 return 0;
84fb1139 4275 windows_translate = 1;
ccc2d29c
GV		 4276 break;
4277 case VK_CAPITAL:
4278 /* Decide whether to treat as modifier or function key. */
4279 if (NILP (Vw32_enable_caps_lock))
4280 goto disable_lock_key;
adcc3809
GV		 4281 windows_translate = 1;
4282 break;
ccc2d29c
GV		 4283 case VK_NUMLOCK:
4284 /* Decide whether to treat as modifier or function key. */
4285 if (NILP (Vw32_enable_num_lock))
4286 goto disable_lock_key;
adcc3809
GV		 4287 windows_translate = 1;
4288 break;
ccc2d29c
GV		 4289 case VK_SCROLL:
4290 /* Decide whether to treat as modifier or function key. */
4291 if (NILP (Vw32_scroll_lock_modifier))
4292 goto disable_lock_key;
adcc3809
GV		 4293 windows_translate = 1;
4294 break;
ccc2d29c 4295 disable_lock_key:
adcc3809
GV		 4296 /* Ensure the appropriate lock key state (and indicator light)
4297 remains in the same state. We do this by faking another
4298 press of the relevant key. Apparently, this really is the
4299 only way to toggle the state of the indicator lights. */
4300 dpyinfo->faked_key = wParam;
4301 keybd_event ((BYTE) wParam, (BYTE) MapVirtualKey (wParam, 0),
4302 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
4303 keybd_event ((BYTE) wParam, (BYTE) MapVirtualKey (wParam, 0),
4304 KEYEVENTF_EXTENDEDKEY | 0, 0);
4305 keybd_event ((BYTE) wParam, (BYTE) MapVirtualKey (wParam, 0),
4306 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
4307 /* Ensure indicator lights are updated promptly on Windows 9x
4308 (TranslateMessage apparently does this), after forwarding
4309 input event. */
4310 post_character_message (hwnd, msg, wParam, lParam,
4311 w32_get_key_modifiers (wParam, lParam));
4312 windows_translate = 1;
ccc2d29c
GV		 4313 break;
4314 case VK_CONTROL:
4315 case VK_SHIFT:
4316 case VK_PROCESSKEY: /* Generated by IME. */
4317 windows_translate = 1;
4318 break;
adcc3809
GV		 4319 case VK_CANCEL:
4320 /* Windows maps Ctrl-Pause (aka Ctrl-Break) into VK_CANCEL,
4321 which is confusing for purposes of key binding; convert
4322 VK_CANCEL events into VK_PAUSE events. */
4323 wParam = VK_PAUSE;
4324 break;
4325 case VK_PAUSE:
4326 /* Windows maps Ctrl-NumLock into VK_PAUSE, which is confusing
4327 for purposes of key binding; convert these back into
4328 VK_NUMLOCK events, at least when we want to see NumLock key
4329 presses. (Note that there is never any possibility that
4330 VK_PAUSE with Ctrl really is C-Pause as per above.) */
4331 if (NILP (Vw32_enable_num_lock) && modifier_set (VK_CONTROL))
4332 wParam = VK_NUMLOCK;
4333 break;
ccc2d29c
GV		 4334 default:
4335 /* If not defined as a function key, change it to a WM_CHAR message. */
4336 if (lispy_function_keys[wParam] == 0)
4337 {
adcc3809
GV		 4338 DWORD modifiers = construct_console_modifiers ();
4339
ccc2d29c
GV		 4340 if (!NILP (Vw32_recognize_altgr)
4341 && modifier_set (VK_LCONTROL) && modifier_set (VK_RMENU))
4342 {
4343 /* Always let TranslateMessage handle AltGr key chords;
4344 for some reason, ToAscii doesn't always process AltGr
4345 chords correctly. */
4346 windows_translate = 1;
4347 }
adcc3809 4348 else if ((modifiers & (~SHIFT_PRESSED & ~CAPSLOCK_ON)) != 0)
ccc2d29c 4349 {
adcc3809
GV		 4350 /* Handle key chords including any modifiers other
4351 than shift directly, in order to preserve as much
4352 modifier information as possible. */
ccc2d29c
GV		 4353 if ('A' <= wParam && wParam <= 'Z')
4354 {
4355 /* Don't translate modified alphabetic keystrokes,
4356 so the user doesn't need to constantly switch
4357 layout to type control or meta keystrokes when
4358 the normal layout translates alphabetic
4359 characters to non-ascii characters. */
4360 if (!modifier_set (VK_SHIFT))
4361 wParam += ('a' - 'A');
4362 msg = WM_CHAR;
4363 }
4364 else
4365 {
4366 /* Try to handle other keystrokes by determining the
4367 base character (ie. translating the base key plus
4368 shift modifier). */
4369 int add;
4370 int isdead = 0;
4371 KEY_EVENT_RECORD key;
4372
4373 key.bKeyDown = TRUE;
4374 key.wRepeatCount = 1;
4375 key.wVirtualKeyCode = wParam;
4376 key.wVirtualScanCode = (lParam & 0xFF0000) >> 16;
4377 key.uChar.AsciiChar = 0;
adcc3809 4378 key.dwControlKeyState = modifiers;
ccc2d29c
GV		 4379
4380 add = w32_kbd_patch_key (&key);
4381 /* 0 means an unrecognised keycode, negative means
4382 dead key. Ignore both. */
4383 while (--add >= 0)
4384 {
4385 /* Forward asciified character sequence. */
4386 post_character_message
4387 (hwnd, WM_CHAR, key.uChar.AsciiChar, lParam,
4388 w32_get_key_modifiers (wParam, lParam));
4389 w32_kbd_patch_key (&key);
4390 }
4391 return 0;
4392 }
4393 }
4394 else
4395 {
4396 /* Let TranslateMessage handle everything else. */
4397 windows_translate = 1;
4398 }
4399 }
4400 }
a1a80b40 4401
adcc3809 4402 translate:
84fb1139
KH		 4403 if (windows_translate)
4404 {
e9e23e23 4405 MSG windows_msg = { hwnd, msg, wParam, lParam, 0, {0,0} };
84fb1139 4406
e9e23e23
GV		 4407 windows_msg.time = GetMessageTime ();
4408 TranslateMessage (&windows_msg);
84fb1139
KH		 4409 goto dflt;
4410 }
4411
ee78dc32
GV		 4412 /* Fall through */
4413
4414 case WM_SYSCHAR:
4415 case WM_CHAR:
ccc2d29c
GV		 4416 post_character_message (hwnd, msg, wParam, lParam,
4417 w32_get_key_modifiers (wParam, lParam));
ee78dc32 4418 break;
da36a4d6 4419
5ac45f98
GV		 4420 /* Simulate middle mouse button events when left and right buttons
4421 are used together, but only if user has two button mouse. */
ee78dc32 4422 case WM_LBUTTONDOWN:
5ac45f98 4423 case WM_RBUTTONDOWN:
7ce9aaca 4424 if (XINT (Vw32_num_mouse_buttons) > 2)
5ac45f98
GV		 4425 goto handle_plain_button;
4426
4427 {
4428 int this = (msg == WM_LBUTTONDOWN) ? LMOUSE : RMOUSE;
4429 int other = (msg == WM_LBUTTONDOWN) ? RMOUSE : LMOUSE;
4430
3cb20f4a
RS		 4431 if (button_state & this)
4432 return 0;
5ac45f98
GV		 4433
4434 if (button_state == 0)
4435 SetCapture (hwnd);
4436
4437 button_state |= this;
4438
4439 if (button_state & other)
4440 {
84fb1139 4441 if (mouse_button_timer)
5ac45f98 4442 {
84fb1139
KH		 4443 KillTimer (hwnd, mouse_button_timer);
4444 mouse_button_timer = 0;
5ac45f98
GV		 4445
4446 /* Generate middle mouse event instead. */
4447 msg = WM_MBUTTONDOWN;
4448 button_state |= MMOUSE;
4449 }
4450 else if (button_state & MMOUSE)
4451 {
4452 /* Ignore button event if we've already generated a
4453 middle mouse down event. This happens if the
4454 user releases and press one of the two buttons
4455 after we've faked a middle mouse event. */
4456 return 0;
4457 }
4458 else
4459 {
4460 /* Flush out saved message. */
84fb1139 4461 post_msg (&saved_mouse_button_msg);
5ac45f98 4462 }
fbd6baed 4463 wmsg.dwModifiers = w32_get_modifiers ();
5ac45f98
GV		 4464 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4465
4466 /* Clear message buffer. */
84fb1139 4467 saved_mouse_button_msg.msg.hwnd = 0;
5ac45f98
GV		 4468 }
4469 else
4470 {
4471 /* Hold onto message for now. */
84fb1139 4472 mouse_button_timer =
adcc3809
GV		 4473 SetTimer (hwnd, MOUSE_BUTTON_ID,
4474 XINT (Vw32_mouse_button_tolerance), NULL);
84fb1139
KH		 4475 saved_mouse_button_msg.msg.hwnd = hwnd;
4476 saved_mouse_button_msg.msg.message = msg;
4477 saved_mouse_button_msg.msg.wParam = wParam;
4478 saved_mouse_button_msg.msg.lParam = lParam;
4479 saved_mouse_button_msg.msg.time = GetMessageTime ();
fbd6baed 4480 saved_mouse_button_msg.dwModifiers = w32_get_modifiers ();
5ac45f98
GV		 4481 }
4482 }
4483 return 0;
4484
ee78dc32 4485 case WM_LBUTTONUP:
5ac45f98 4486 case WM_RBUTTONUP:
7ce9aaca 4487 if (XINT (Vw32_num_mouse_buttons) > 2)
5ac45f98
GV		 4488 goto handle_plain_button;
4489
4490 {
4491 int this = (msg == WM_LBUTTONUP) ? LMOUSE : RMOUSE;
4492 int other = (msg == WM_LBUTTONUP) ? RMOUSE : LMOUSE;
4493
3cb20f4a
RS		 4494 if ((button_state & this) == 0)
4495 return 0;
5ac45f98
GV		 4496
4497 button_state &= ~this;
4498
4499 if (button_state & MMOUSE)
4500 {
4501 /* Only generate event when second button is released. */
4502 if ((button_state & other) == 0)
4503 {
4504 msg = WM_MBUTTONUP;
4505 button_state &= ~MMOUSE;
4506
4507 if (button_state) abort ();
4508 }
4509 else
4510 return 0;
4511 }
4512 else
4513 {
4514 /* Flush out saved message if necessary. */
84fb1139 4515 if (saved_mouse_button_msg.msg.hwnd)
5ac45f98 4516 {
84fb1139 4517 post_msg (&saved_mouse_button_msg);
5ac45f98
GV		 4518 }
4519 }
fbd6baed 4520 wmsg.dwModifiers = w32_get_modifiers ();
5ac45f98
GV		 4521 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4522
4523 /* Always clear message buffer and cancel timer. */
84fb1139
KH		 4524 saved_mouse_button_msg.msg.hwnd = 0;
4525 KillTimer (hwnd, mouse_button_timer);
4526 mouse_button_timer = 0;
5ac45f98
GV		 4527
4528 if (button_state == 0)
4529 ReleaseCapture ();
4530 }
4531 return 0;
4532
ee78dc32
GV		 4533 case WM_MBUTTONDOWN:
4534 case WM_MBUTTONUP:
5ac45f98 4535 handle_plain_button:
ee78dc32
GV		 4536 {
4537 BOOL up;
1edf84e7 4538 int button;
ee78dc32 4539
1edf84e7 4540 if (parse_button (msg, &button, &up))
ee78dc32
GV		 4541 {
4542 if (up) ReleaseCapture ();
4543 else SetCapture (hwnd);
1edf84e7
GV		 4544 button = (button == 0) ? LMOUSE :
4545 ((button == 1) ? MMOUSE : RMOUSE);
4546 if (up)
4547 button_state &= ~button;
4548 else
4549 button_state |= button;
ee78dc32
GV		 4550 }
4551 }
4552
fbd6baed 4553 wmsg.dwModifiers = w32_get_modifiers ();
ee78dc32 4554 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
5ac45f98
GV		 4555 return 0;
4556
84fb1139 4557 case WM_VSCROLL:
5ac45f98 4558 case WM_MOUSEMOVE:
fbd6baed 4559 if (XINT (Vw32_mouse_move_interval) <= 0
84fb1139
KH		 4560 || (msg == WM_MOUSEMOVE && button_state == 0))
4561 {
fbd6baed 4562 wmsg.dwModifiers = w32_get_modifiers ();
84fb1139
KH		 4563 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4564 return 0;
4565 }
4566
4567 /* Hang onto mouse move and scroll messages for a bit, to avoid
4568 sending such events to Emacs faster than it can process them.
4569 If we get more events before the timer from the first message
4570 expires, we just replace the first message. */
4571
4572 if (saved_mouse_move_msg.msg.hwnd == 0)
4573 mouse_move_timer =
adcc3809
GV		 4574 SetTimer (hwnd, MOUSE_MOVE_ID,
4575 XINT (Vw32_mouse_move_interval), NULL);
84fb1139
KH		 4576
4577 /* Hold onto message for now. */
4578 saved_mouse_move_msg.msg.hwnd = hwnd;
4579 saved_mouse_move_msg.msg.message = msg;
4580 saved_mouse_move_msg.msg.wParam = wParam;
4581 saved_mouse_move_msg.msg.lParam = lParam;
4582 saved_mouse_move_msg.msg.time = GetMessageTime ();
fbd6baed 4583 saved_mouse_move_msg.dwModifiers = w32_get_modifiers ();
84fb1139
KH		 4584
4585 return 0;
4586
1edf84e7
GV		 4587 case WM_MOUSEWHEEL:
4588 wmsg.dwModifiers = w32_get_modifiers ();
4589 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4590 return 0;
4591
cb9e33d4
RS		 4592 case WM_DROPFILES:
4593 wmsg.dwModifiers = w32_get_modifiers ();
4594 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4595 return 0;
4596
84fb1139
KH		 4597 case WM_TIMER:
4598 /* Flush out saved messages if necessary. */
4599 if (wParam == mouse_button_timer)
5ac45f98 4600 {
84fb1139
KH		 4601 if (saved_mouse_button_msg.msg.hwnd)
4602 {
4603 post_msg (&saved_mouse_button_msg);
4604 saved_mouse_button_msg.msg.hwnd = 0;
4605 }
4606 KillTimer (hwnd, mouse_button_timer);
4607 mouse_button_timer = 0;
4608 }
4609 else if (wParam == mouse_move_timer)
4610 {
4611 if (saved_mouse_move_msg.msg.hwnd)
4612 {
4613 post_msg (&saved_mouse_move_msg);
4614 saved_mouse_move_msg.msg.hwnd = 0;
4615 }
4616 KillTimer (hwnd, mouse_move_timer);
4617 mouse_move_timer = 0;
5ac45f98 4618 }
5ac45f98 4619 return 0;
84fb1139
KH		 4620
4621 case WM_NCACTIVATE:
4622 /* Windows doesn't send us focus messages when putting up and
e9e23e23 4623 taking down a system popup dialog as for Ctrl-Alt-Del on Windows 95.
84fb1139
KH		 4624 The only indication we get that something happened is receiving
4625 this message afterwards. So this is a good time to reset our
4626 keyboard modifiers' state. */
4627 reset_modifiers ();
4628 goto dflt;
da36a4d6 4629
1edf84e7 4630 case WM_INITMENU:
487163ac
AI		 4631 button_state = 0;
4632 ReleaseCapture ();
1edf84e7
GV		 4633 /* We must ensure menu bar is fully constructed and up to date
4634 before allowing user interaction with it. To achieve this
4635 we send this message to the lisp thread and wait for a
4636 reply (whose value is not actually needed) to indicate that
4637 the menu bar is now ready for use, so we can now return.
4638
4639 To remain responsive in the meantime, we enter a nested message
4640 loop that can process all other messages.
4641
4642 However, we skip all this if the message results from calling
4643 TrackPopupMenu - in fact, we must NOT attempt to send the lisp
4644 thread a message because it is blocked on us at this point. We
4645 set menubar_active before calling TrackPopupMenu to indicate
4646 this (there is no possibility of confusion with real menubar
4647 being active). */
4648
4649 f = x_window_to_frame (dpyinfo, hwnd);
4650 if (f
4651 && (f->output_data.w32->menubar_active
4652 /* We can receive this message even in the absence of a
4653 menubar (ie. when the system menu is activated) - in this
4654 case we do NOT want to forward the message, otherwise it
4655 will cause the menubar to suddenly appear when the user
4656 had requested it to be turned off! */
4657 || f->output_data.w32->menubar_widget == NULL))
4658 return 0;
4659
4660 {
4661 deferred_msg msg_buf;
4662
4663 /* Detect if message has already been deferred; in this case
4664 we cannot return any sensible value to ignore this. */
4665 if (find_deferred_msg (hwnd, msg) != NULL)
4666 abort ();
4667
4668 return send_deferred_msg (&msg_buf, hwnd, msg, wParam, lParam);
4669 }
4670
4671 case WM_EXITMENULOOP:
4672 f = x_window_to_frame (dpyinfo, hwnd);
4673
4674 /* Indicate that menubar can be modified again. */
4675 if (f)
4676 f->output_data.w32->menubar_active = 0;
4677 goto dflt;
4678
126f2e35
JR		 4679 case WM_MENUSELECT:
4680 wmsg.dwModifiers = w32_get_modifiers ();
4681 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4682 return 0;
4683
87996783
GV		 4684 case WM_MEASUREITEM:
4685 f = x_window_to_frame (dpyinfo, hwnd);
4686 if (f)
4687 {
4688 MEASUREITEMSTRUCT * pMis = (MEASUREITEMSTRUCT *) lParam;
4689
4690 if (pMis->CtlType == ODT_MENU)
4691 {
4692 /* Work out dimensions for popup menu titles. */
4693 char * title = (char *) pMis->itemData;
4694 HDC hdc = GetDC (hwnd);
4695 HFONT menu_font = GetCurrentObject (hdc, OBJ_FONT);
4696 LOGFONT menu_logfont;
4697 HFONT old_font;
4698 SIZE size;
4699
4700 GetObject (menu_font, sizeof (menu_logfont), &menu_logfont);
4701 menu_logfont.lfWeight = FW_BOLD;
4702 menu_font = CreateFontIndirect (&menu_logfont);
4703 old_font = SelectObject (hdc, menu_font);
4704
dfff8a69
JR		 4705 pMis->itemHeight = GetSystemMetrics (SM_CYMENUSIZE);
4706 if (title)
4707 {
4708 GetTextExtentPoint32 (hdc, title, strlen (title), &size);
4709 pMis->itemWidth = size.cx;
4710 if (pMis->itemHeight < size.cy)
4711 pMis->itemHeight = size.cy;
4712 }
4713 else
4714 pMis->itemWidth = 0;
87996783
GV		 4715
4716 SelectObject (hdc, old_font);
4717 DeleteObject (menu_font);
4718 ReleaseDC (hwnd, hdc);
4719 return TRUE;
4720 }
4721 }
4722 return 0;
4723
4724 case WM_DRAWITEM:
4725 f = x_window_to_frame (dpyinfo, hwnd);
4726 if (f)
4727 {
4728 DRAWITEMSTRUCT * pDis = (DRAWITEMSTRUCT *) lParam;
4729
4730 if (pDis->CtlType == ODT_MENU)
4731 {
4732 /* Draw popup menu title. */
4733 char * title = (char *) pDis->itemData;
212da13b
JR		 4734 if (title)
4735 {
4736 HDC hdc = pDis->hDC;
4737 HFONT menu_font = GetCurrentObject (hdc, OBJ_FONT);
4738 LOGFONT menu_logfont;
4739 HFONT old_font;
4740
4741 GetObject (menu_font, sizeof (menu_logfont), &menu_logfont);
4742 menu_logfont.lfWeight = FW_BOLD;
4743 menu_font = CreateFontIndirect (&menu_logfont);
4744 old_font = SelectObject (hdc, menu_font);
4745
4746 /* Always draw title as if not selected. */
4747 ExtTextOut (hdc,
4748 pDis->rcItem.left
4749 + GetSystemMetrics (SM_CXMENUCHECK),
4750 pDis->rcItem.top,
4751 ETO_OPAQUE, &pDis->rcItem,
4752 title, strlen (title), NULL);
4753
4754 SelectObject (hdc, old_font);
4755 DeleteObject (menu_font);
4756 }
87996783
GV		 4757 return TRUE;
4758 }
4759 }
4760 return 0;
4761
1edf84e7
GV		 4762#if 0
4763 /* Still not right - can't distinguish between clicks in the
4764 client area of the frame from clicks forwarded from the scroll
4765 bars - may have to hook WM_NCHITTEST to remember the mouse
4766 position and then check if it is in the client area ourselves. */
4767 case WM_MOUSEACTIVATE:
4768 /* Discard the mouse click that activates a frame, allowing the
4769 user to click anywhere without changing point (or worse!).
4770 Don't eat mouse clicks on scrollbars though!! */
4771 if (LOWORD (lParam) == HTCLIENT )
4772 return MA_ACTIVATEANDEAT;
4773 goto dflt;
4774#endif
4775
1edf84e7 4776 case WM_ACTIVATEAPP:
ccc2d29c 4777 case WM_ACTIVATE:
1edf84e7
GV		 4778 case WM_WINDOWPOSCHANGED:
4779 case WM_SHOWWINDOW:
4780 /* Inform lisp thread that a frame might have just been obscured
4781 or exposed, so should recheck visibility of all frames. */
4782 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4783 goto dflt;
4784
da36a4d6 4785 case WM_SETFOCUS:
adcc3809
GV		 4786 dpyinfo->faked_key = 0;
4787 reset_modifiers ();
ccc2d29c
GV		 4788 register_hot_keys (hwnd);
4789 goto command;
8681157a 4790 case WM_KILLFOCUS:
ccc2d29c 4791 unregister_hot_keys (hwnd);
487163ac
AI		 4792 button_state = 0;
4793 ReleaseCapture ();
65906840
JR		 4794 /* Relinquish the system caret. */
4795 if (w32_system_caret_hwnd)
4796 {
4797 DestroyCaret ();
4798 w32_system_caret_hwnd = NULL;
4799 }
ee78dc32
GV		 4800 case WM_MOVE:
4801 case WM_SIZE:
ee78dc32 4802 case WM_COMMAND:
ccc2d29c 4803 command:
fbd6baed 4804 wmsg.dwModifiers = w32_get_modifiers ();
ee78dc32
GV		 4805 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4806 goto dflt;
8847d890
RS		 4807
4808 case WM_CLOSE:
fbd6baed 4809 wmsg.dwModifiers = w32_get_modifiers ();
8847d890
RS		 4810 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4811 return 0;
4812
ee78dc32
GV		 4813 case WM_WINDOWPOSCHANGING:
4814 {
4815 WINDOWPLACEMENT wp;
4816 LPWINDOWPOS lppos = (WINDOWPOS *) lParam;
1edf84e7
GV		 4817
4818 wp.length = sizeof (WINDOWPLACEMENT);
ee78dc32
GV		 4819 GetWindowPlacement (hwnd, &wp);
4820
1edf84e7 4821 if (wp.showCmd != SW_SHOWMINIMIZED && (lppos->flags & SWP_NOSIZE) == 0)
ee78dc32
GV		 4822 {
4823 RECT rect;
4824 int wdiff;
4825 int hdiff;
1edf84e7
GV		 4826 DWORD font_width;
4827 DWORD line_height;
4828 DWORD internal_border;
4829 DWORD scrollbar_extra;
ee78dc32
GV		 4830 RECT wr;
4831
5ac45f98 4832 wp.length = sizeof(wp);
ee78dc32
GV		 4833 GetWindowRect (hwnd, &wr);
4834
3c190163 4835 enter_crit ();
ee78dc32 4836
1edf84e7
GV		 4837 font_width = GetWindowLong (hwnd, WND_FONTWIDTH_INDEX);
4838 line_height = GetWindowLong (hwnd, WND_LINEHEIGHT_INDEX);
4839 internal_border = GetWindowLong (hwnd, WND_BORDER_INDEX);
4840 scrollbar_extra = GetWindowLong (hwnd, WND_SCROLLBAR_INDEX);
ee78dc32 4841
3c190163 4842 leave_crit ();
ee78dc32
GV		 4843
4844 memset (&rect, 0, sizeof (rect));
4845 AdjustWindowRect (&rect, GetWindowLong (hwnd, GWL_STYLE),
4846 GetMenu (hwnd) != NULL);
4847
1edf84e7
GV		 4848 /* Force width and height of client area to be exact
4849 multiples of the character cell dimensions. */
4850 wdiff = (lppos->cx - (rect.right - rect.left)
4851 - 2 * internal_border - scrollbar_extra)
4852 % font_width;
4853 hdiff = (lppos->cy - (rect.bottom - rect.top)
4854 - 2 * internal_border)
4855 % line_height;
ee78dc32
GV		 4856
4857 if (wdiff || hdiff)
4858 {
4859 /* For right/bottom sizing we can just fix the sizes.
4860 However for top/left sizing we will need to fix the X
4861 and Y positions as well. */
4862
4863 lppos->cx -= wdiff;
4864 lppos->cy -= hdiff;
4865
4866 if (wp.showCmd != SW_SHOWMAXIMIZED
1edf84e7 4867 && (lppos->flags & SWP_NOMOVE) == 0)
ee78dc32
GV		 4868 {
4869 if (lppos->x != wr.left || lppos->y != wr.top)
4870 {
4871 lppos->x += wdiff;
4872 lppos->y += hdiff;
4873 }
4874 else
4875 {
4876 lppos->flags |= SWP_NOMOVE;
4877 }
4878 }
4879
1edf84e7 4880 return 0;
ee78dc32
GV		 4881 }
4882 }
4883 }
ee78dc32
GV		 4884
4885 goto dflt;
1edf84e7 4886
b1f918f8
GV		 4887 case WM_GETMINMAXINFO:
4888 /* Hack to correct bug that allows Emacs frames to be resized
4889 below the Minimum Tracking Size. */
4890 ((LPMINMAXINFO) lParam)->ptMinTrackSize.y++;
bf853fee
AI		 4891 /* Hack to allow resizing the Emacs frame above the screen size.
4892 Note that Windows 9x limits coordinates to 16-bits. */
4893 ((LPMINMAXINFO) lParam)->ptMaxTrackSize.x = 32767;
4894 ((LPMINMAXINFO) lParam)->ptMaxTrackSize.y = 32767;
b1f918f8
GV		 4895 return 0;
4896
1edf84e7
GV		 4897 case WM_EMACS_CREATESCROLLBAR:
4898 return (LRESULT) w32_createscrollbar ((struct frame *) wParam,
4899 (struct scroll_bar *) lParam);
4900
5ac45f98 4901 case WM_EMACS_SHOWWINDOW:
1edf84e7
GV		 4902 return ShowWindow ((HWND) wParam, (WPARAM) lParam);
4903
dfdb4047 4904 case WM_EMACS_SETFOREGROUND:
ce6059da
AI		 4905 {
4906 HWND foreground_window;
4907 DWORD foreground_thread, retval;
4908
4909 /* On NT 5.0, and apparently Windows 98, it is necessary to
4910 attach to the thread that currently has focus in order to
4911 pull the focus away from it. */
4912 foreground_window = GetForegroundWindow ();
4913 foreground_thread = GetWindowThreadProcessId (foreground_window, NULL);
4914 if (!foreground_window
4915 || foreground_thread == GetCurrentThreadId ()
4916 || !AttachThreadInput (GetCurrentThreadId (),
4917 foreground_thread, TRUE))
4918 foreground_thread = 0;
4919
4920 retval = SetForegroundWindow ((HWND) wParam);
4921
4922 /* Detach from the previous foreground thread. */
4923 if (foreground_thread)
4924 AttachThreadInput (GetCurrentThreadId (),
4925 foreground_thread, FALSE);
4926
4927 return retval;
4928 }
dfdb4047 4929
5ac45f98
GV		 4930 case WM_EMACS_SETWINDOWPOS:
4931 {
1edf84e7
GV		 4932 WINDOWPOS * pos = (WINDOWPOS *) wParam;
4933 return SetWindowPos (hwnd, pos->hwndInsertAfter,
5ac45f98
GV		 4934 pos->x, pos->y, pos->cx, pos->cy, pos->flags);
4935 }
1edf84e7 4936
ee78dc32 4937 case WM_EMACS_DESTROYWINDOW:
cb9e33d4 4938 DragAcceptFiles ((HWND) wParam, FALSE);
1edf84e7
GV		 4939 return DestroyWindow ((HWND) wParam);
4940
65906840
JR		 4941 case WM_EMACS_DESTROY_CARET:
4942 w32_system_caret_hwnd = NULL;
4943 return DestroyCaret ();
4944
4945 case WM_EMACS_TRACK_CARET:
4946 /* If there is currently no system caret, create one. */
4947 if (w32_system_caret_hwnd == NULL)
4948 {
4949 w32_system_caret_hwnd = hwnd;
4950 CreateCaret (hwnd, NULL, w32_system_caret_width,
4951 w32_system_caret_height);
4952 }
4953 return SetCaretPos (w32_system_caret_x, w32_system_caret_y);
4954
1edf84e7
GV		 4955 case WM_EMACS_TRACKPOPUPMENU:
4956 {
4957 UINT flags;
4958 POINT *pos;
4959 int retval;
4960 pos = (POINT *)lParam;
4961 flags = TPM_CENTERALIGN;
4962 if (button_state & LMOUSE)
4963 flags |= TPM_LEFTBUTTON;
4964 else if (button_state & RMOUSE)
4965 flags |= TPM_RIGHTBUTTON;
4966
87996783
GV		 4967 /* Remember we did a SetCapture on the initial mouse down event,
4968 so for safety, we make sure the capture is cancelled now. */
4969 ReleaseCapture ();
490822ff 4970 button_state = 0;
87996783 4971
1edf84e7
GV		 4972 /* Use menubar_active to indicate that WM_INITMENU is from
4973 TrackPopupMenu below, and should be ignored. */
4974 f = x_window_to_frame (dpyinfo, hwnd);
4975 if (f)
4976 f->output_data.w32->menubar_active = 1;
4977
4978 if (TrackPopupMenu ((HMENU)wParam, flags, pos->x, pos->y,
4979 0, hwnd, NULL))
4980 {
4981 MSG amsg;
4982 /* Eat any mouse messages during popupmenu */
4983 while (PeekMessage (&amsg, hwnd, WM_MOUSEFIRST, WM_MOUSELAST,
4984 PM_REMOVE));
4985 /* Get the menu selection, if any */
4986 if (PeekMessage (&amsg, hwnd, WM_COMMAND, WM_COMMAND, PM_REMOVE))
4987 {
4988 retval = LOWORD (amsg.wParam);
4989 }
4990 else
4991 {
4992 retval = 0;
4993 }
1edf84e7
GV		 4994 }
4995 else
4996 {
4997 retval = -1;
4998 }
4999
5000 return retval;
5001 }
5002
ee78dc32 5003 default:
93fbe8b7
GV		 5004 /* Check for messages registered at runtime. */
5005 if (msg == msh_mousewheel)
5006 {
5007 wmsg.dwModifiers = w32_get_modifiers ();
5008 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
5009 return 0;
5010 }
5011
ee78dc32
GV		 5012 dflt:
5013 return DefWindowProc (hwnd, msg, wParam, lParam);
5014 }
5015
1edf84e7
GV		 5016
5017 /* The most common default return code for handled messages is 0. */
5018 return 0;
ee78dc32
GV		 5019}
5020
5021void
5022my_create_window (f)
5023 struct frame * f;
5024{
5025 MSG msg;
5026
1edf84e7
GV		 5027 if (!PostThreadMessage (dwWindowsThreadId, WM_EMACS_CREATEWINDOW, (WPARAM)f, 0))
5028 abort ();
ee78dc32
GV		 5029 GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
5030}
5031
fbd6baed 5032/* Create and set up the w32 window for frame F. */
ee78dc32
GV		 5033
5034static void
fbd6baed 5035w32_window (f, window_prompting, minibuffer_only)
ee78dc32
GV		 5036 struct frame *f;
5037 long window_prompting;
5038 int minibuffer_only;
5039{
5040 BLOCK_INPUT;
5041
5042 /* Use the resource name as the top-level window name
5043 for looking up resources. Make a non-Lisp copy
5044 for the window manager, so GC relocation won't bother it.
5045
5046 Elsewhere we specify the window name for the window manager. */
5047
5048 {
5049 char *str = (char *) XSTRING (Vx_resource_name)->data;
5050 f->namebuf = (char *) xmalloc (strlen (str) + 1);
5051 strcpy (f->namebuf, str);
5052 }
5053
5054 my_create_window (f);
5055
5056 validate_x_resource_name ();
5057
5058 /* x_set_name normally ignores requests to set the name if the
5059 requested name is the same as the current name. This is the one
5060 place where that assumption isn't correct; f->name is set, but
5061 the server hasn't been told. */
5062 {
5063 Lisp_Object name;
5064 int explicit = f->explicit_name;
5065
5066 f->explicit_name = 0;
5067 name = f->name;
5068 f->name = Qnil;
5069 x_set_name (f, name, explicit);
5070 }
5071
5072 UNBLOCK_INPUT;
5073
5074 if (!minibuffer_only && FRAME_EXTERNAL_MENU_BAR (f))
5075 initialize_frame_menubar (f);
5076
fbd6baed 5077 if (FRAME_W32_WINDOW (f) == 0)
ee78dc32
GV		 5078 error ("Unable to create window");
5079}
5080
5081/* Handle the icon stuff for this window. Perhaps later we might
5082 want an x_set_icon_position which can be called interactively as
5083 well. */
5084
5085static void
5086x_icon (f, parms)
5087 struct frame *f;
5088 Lisp_Object parms;
5089{
5090 Lisp_Object icon_x, icon_y;
5091
e9e23e23 5092 /* Set the position of the icon. Note that Windows 95 groups all
ee78dc32 5093 icons in the tray. */
6fc2811b
JR		 5094 icon_x = w32_get_arg (parms, Qicon_left, 0, 0, RES_TYPE_NUMBER);
5095 icon_y = w32_get_arg (parms, Qicon_top, 0, 0, RES_TYPE_NUMBER);
ee78dc32
GV		 5096 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
5097 {
5098 CHECK_NUMBER (icon_x, 0);
5099 CHECK_NUMBER (icon_y, 0);
5100 }
5101 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
5102 error ("Both left and top icon corners of icon must be specified");
5103
5104 BLOCK_INPUT;
5105
5106 if (! EQ (icon_x, Qunbound))
5107 x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y));
5108
1edf84e7
GV		 5109#if 0 /* TODO */
5110 /* Start up iconic or window? */
5111 x_wm_set_window_state
6fc2811b 5112 (f, (EQ (w32_get_arg (parms, Qvisibility, 0, 0, RES_TYPE_SYMBOL), Qicon)
1edf84e7
GV		 5113 ? IconicState
5114 : NormalState));
5115
5116 x_text_icon (f, (char *) XSTRING ((!NILP (f->icon_name)
5117 ? f->icon_name
5118 : f->name))->data);
5119#endif
5120
ee78dc32
GV		 5121 UNBLOCK_INPUT;
5122}
5123
6fc2811b
JR		 5124
5125static void
5126x_make_gc (f)
5127 struct frame *f;
5128{
5129 XGCValues gc_values;
5130
5131 BLOCK_INPUT;
5132
5133 /* Create the GC's of this frame.
5134 Note that many default values are used. */
5135
5136 /* Normal video */
5137 gc_values.font = f->output_data.w32->font;
5138
5139 /* Cursor has cursor-color background, background-color foreground. */
5140 gc_values.foreground = FRAME_BACKGROUND_PIXEL (f);
5141 gc_values.background = f->output_data.w32->cursor_pixel;
5142 f->output_data.w32->cursor_gc
5143 = XCreateGC (NULL, FRAME_W32_WINDOW (f),
5144 (GCFont | GCForeground | GCBackground),
5145 &gc_values);
5146
5147 /* Reliefs. */
5148 f->output_data.w32->white_relief.gc = 0;
5149 f->output_data.w32->black_relief.gc = 0;
5150
5151 UNBLOCK_INPUT;
5152}
5153
5154
937e601e
AI		 5155/* Handler for signals raised during x_create_frame and
5156 x_create_top_frame. FRAME is the frame which is partially
5157 constructed. */
5158
5159static Lisp_Object
5160unwind_create_frame (frame)
5161 Lisp_Object frame;
5162{
5163 struct frame *f = XFRAME (frame);
5164
5165 /* If frame is ``official'', nothing to do. */
5166 if (!CONSP (Vframe_list) || !EQ (XCAR (Vframe_list), frame))
5167 {
5168#ifdef GLYPH_DEBUG
5169 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
5170#endif
5171
5172 x_free_frame_resources (f);
5173
5174 /* Check that reference counts are indeed correct. */
5175 xassert (dpyinfo->reference_count == dpyinfo_refcount);
5176 xassert (dpyinfo->image_cache->refcount == image_cache_refcount);
c844a81a
GM		 5177
5178 return Qt;
937e601e
AI		 5179 }
5180
5181 return Qnil;
5182}
5183
5184
ee78dc32
GV		 5185DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
5186 1, 1, 0,
5187 "Make a new window, which is called a \"frame\" in Emacs terms.\n\
5188Returns an Emacs frame object.\n\
5189ALIST is an alist of frame parameters.\n\
5190If the parameters specify that the frame should not have a minibuffer,\n\
5191and do not specify a specific minibuffer window to use,\n\
5192then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
5193be shared by the new frame.\n\
5194\n\
5195This function is an internal primitive--use `make-frame' instead.")
5196 (parms)
5197 Lisp_Object parms;
5198{
5199 struct frame *f;
5200 Lisp_Object frame, tem;
5201 Lisp_Object name;
5202 int minibuffer_only = 0;
5203 long window_prompting = 0;
5204 int width, height;
dc220243 5205 int count = BINDING_STACK_SIZE ();
1edf84e7 5206 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
ee78dc32 5207 Lisp_Object display;
6fc2811b 5208 struct w32_display_info *dpyinfo = NULL;
ee78dc32
GV		 5209 Lisp_Object parent;
5210 struct kboard *kb;
5211
4587b026
GV		 5212 check_w32 ();
5213
ee78dc32
GV		 5214 /* Use this general default value to start with
5215 until we know if this frame has a specified name. */
5216 Vx_resource_name = Vinvocation_name;
5217
6fc2811b 5218 display = w32_get_arg (parms, Qdisplay, 0, 0, RES_TYPE_STRING);
ee78dc32
GV		 5219 if (EQ (display, Qunbound))
5220 display = Qnil;
5221 dpyinfo = check_x_display_info (display);
5222#ifdef MULTI_KBOARD
5223 kb = dpyinfo->kboard;
5224#else
5225 kb = &the_only_kboard;
5226#endif
5227
6fc2811b 5228 name = w32_get_arg (parms, Qname, "name", "Name", RES_TYPE_STRING);
ee78dc32
GV		 5229 if (!STRINGP (name)
5230 && ! EQ (name, Qunbound)
5231 && ! NILP (name))
5232 error ("Invalid frame name--not a string or nil");
5233
5234 if (STRINGP (name))
5235 Vx_resource_name = name;
5236
5237 /* See if parent window is specified. */
6fc2811b 5238 parent = w32_get_arg (parms, Qparent_id, NULL, NULL, RES_TYPE_NUMBER);
ee78dc32
GV		 5239 if (EQ (parent, Qunbound))
5240 parent = Qnil;
5241 if (! NILP (parent))
5242 CHECK_NUMBER (parent, 0);
5243
1edf84e7
GV		 5244 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
5245 /* No need to protect DISPLAY because that's not used after passing
5246 it to make_frame_without_minibuffer. */
5247 frame = Qnil;
5248 GCPRO4 (parms, parent, name, frame);
1660f34a
JR		 5249 tem = w32_get_arg (parms, Qminibuffer, "minibuffer", "Minibuffer",
5250 RES_TYPE_SYMBOL);
ee78dc32
GV		 5251 if (EQ (tem, Qnone) || NILP (tem))
5252 f = make_frame_without_minibuffer (Qnil, kb, display);
5253 else if (EQ (tem, Qonly))
5254 {
5255 f = make_minibuffer_frame ();
5256 minibuffer_only = 1;
5257 }
5258 else if (WINDOWP (tem))
5259 f = make_frame_without_minibuffer (tem, kb, display);
5260 else
5261 f = make_frame (1);
5262
1edf84e7
GV		 5263 XSETFRAME (frame, f);
5264
ee78dc32
GV		 5265 /* Note that Windows does support scroll bars. */
5266 FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
5ac45f98
GV		 5267 /* By default, make scrollbars the system standard width. */
5268 f->scroll_bar_pixel_width = GetSystemMetrics (SM_CXVSCROLL);
ee78dc32 5269
fbd6baed 5270 f->output_method = output_w32;
6fc2811b
JR		 5271 f->output_data.w32 =
5272 (struct w32_output *) xmalloc (sizeof (struct w32_output));
fbd6baed 5273 bzero (f->output_data.w32, sizeof (struct w32_output));
4587b026 5274 FRAME_FONTSET (f) = -1;
937e601e 5275 record_unwind_protect (unwind_create_frame, frame);
4587b026 5276
1edf84e7 5277 f->icon_name
6fc2811b 5278 = w32_get_arg (parms, Qicon_name, "iconName", "Title", RES_TYPE_STRING);
1edf84e7
GV		 5279 if (! STRINGP (f->icon_name))
5280 f->icon_name = Qnil;
5281
fbd6baed 5282/* FRAME_W32_DISPLAY_INFO (f) = dpyinfo; */
ee78dc32
GV		 5283#ifdef MULTI_KBOARD
5284 FRAME_KBOARD (f) = kb;
5285#endif
5286
5287 /* Specify the parent under which to make this window. */
5288
5289 if (!NILP (parent))
5290 {
1660f34a 5291 f->output_data.w32->parent_desc = (Window) XFASTINT (parent);
fbd6baed 5292 f->output_data.w32->explicit_parent = 1;
ee78dc32
GV		 5293 }
5294 else
5295 {
fbd6baed
GV		 5296 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
5297 f->output_data.w32->explicit_parent = 0;
ee78dc32
GV		 5298 }
5299
ee78dc32
GV		 5300 /* Set the name; the functions to which we pass f expect the name to
5301 be set. */
5302 if (EQ (name, Qunbound) || NILP (name))
5303 {
fbd6baed 5304 f->name = build_string (dpyinfo->w32_id_name);
ee78dc32
GV		 5305 f->explicit_name = 0;
5306 }
5307 else
5308 {
5309 f->name = name;
5310 f->explicit_name = 1;
5311 /* use the frame's title when getting resources for this frame. */
5312 specbind (Qx_resource_name, name);
5313 }
5314
5315 /* Extract the window parameters from the supplied values
5316 that are needed to determine window geometry. */
5317 {
5318 Lisp_Object font;
5319
6fc2811b
JR		 5320 font = w32_get_arg (parms, Qfont, "font", "Font", RES_TYPE_STRING);
5321
ee78dc32
GV		 5322 BLOCK_INPUT;
5323 /* First, try whatever font the caller has specified. */
5324 if (STRINGP (font))
4587b026
GV		 5325 {
5326 tem = Fquery_fontset (font, Qnil);
5327 if (STRINGP (tem))
5328 font = x_new_fontset (f, XSTRING (tem)->data);
5329 else
1075afa9 5330 font = x_new_font (f, XSTRING (font)->data);
4587b026 5331 }
ee78dc32
GV		 5332 /* Try out a font which we hope has bold and italic variations. */
5333 if (!STRINGP (font))
e39649be 5334 font = x_new_font (f, "-*-Courier New-normal-r-*-*-*-100-*-*-c-*-iso8859-1");
ee78dc32 5335 if (! STRINGP (font))
6fc2811b 5336 font = x_new_font (f, "-*-Courier-normal-r-*-*-13-*-*-*-c-*-iso8859-1");
ee78dc32
GV		 5337 /* If those didn't work, look for something which will at least work. */
5338 if (! STRINGP (font))
6fc2811b 5339 font = x_new_font (f, "-*-Fixedsys-normal-r-*-*-12-*-*-*-c-*-iso8859-1");
ee78dc32
GV		 5340 UNBLOCK_INPUT;
5341 if (! STRINGP (font))
1edf84e7 5342 font = build_string ("Fixedsys");
ee78dc32
GV		 5343
5344 x_default_parameter (f, parms, Qfont, font,
6fc2811b 5345 "font", "Font", RES_TYPE_STRING);
ee78dc32
GV		 5346 }
5347
5348 x_default_parameter (f, parms, Qborder_width, make_number (2),
1660f34a 5349 "borderWidth", "BorderWidth", RES_TYPE_NUMBER);
ee78dc32
GV		 5350 /* This defaults to 2 in order to match xterm. We recognize either
5351 internalBorderWidth or internalBorder (which is what xterm calls
5352 it). */
5353 if (NILP (Fassq (Qinternal_border_width, parms)))
5354 {
5355 Lisp_Object value;
5356
6fc2811b 5357 value = w32_get_arg (parms, Qinternal_border_width,
1660f34a 5358 "internalBorder", "InternalBorder", RES_TYPE_NUMBER);
ee78dc32
GV		 5359 if (! EQ (value, Qunbound))
5360 parms = Fcons (Fcons (Qinternal_border_width, value),
5361 parms);
5362 }
1edf84e7 5363 /* Default internalBorderWidth to 0 on Windows to match other programs. */
ee78dc32 5364 x_default_parameter (f, parms, Qinternal_border_width, make_number (0),
1660f34a
JR		 5365 "internalBorderWidth", "InternalBorder", RES_TYPE_NUMBER);
5366 x_default_parameter (f, parms, Qvertical_scroll_bars, Qright,
5367 "verticalScrollBars", "ScrollBars", RES_TYPE_SYMBOL);
ee78dc32
GV		 5368
5369 /* Also do the stuff which must be set before the window exists. */
5370 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
6fc2811b 5371 "foreground", "Foreground", RES_TYPE_STRING);
ee78dc32 5372 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
6fc2811b 5373 "background", "Background", RES_TYPE_STRING);
ee78dc32 5374 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
6fc2811b 5375 "pointerColor", "Foreground", RES_TYPE_STRING);
ee78dc32 5376 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
6fc2811b 5377 "cursorColor", "Foreground", RES_TYPE_STRING);
ee78dc32 5378 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
6fc2811b
JR		 5379 "borderColor", "BorderColor", RES_TYPE_STRING);
5380 x_default_parameter (f, parms, Qscreen_gamma, Qnil,
5381 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT);
dfff8a69
JR		 5382 x_default_parameter (f, parms, Qline_spacing, Qnil,
5383 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER);
6fc2811b 5384
ee78dc32 5385
6fc2811b
JR		 5386 /* Init faces before x_default_parameter is called for scroll-bar
5387 parameters because that function calls x_set_scroll_bar_width,
5388 which calls change_frame_size, which calls Fset_window_buffer,
5389 which runs hooks, which call Fvertical_motion. At the end, we
5390 end up in init_iterator with a null face cache, which should not
5391 happen. */
5392 init_frame_faces (f);
5393
ee78dc32 5394 x_default_parameter (f, parms, Qmenu_bar_lines, make_number (1),
6fc2811b
JR		 5395 "menuBar", "MenuBar", RES_TYPE_NUMBER);
5396 x_default_parameter (f, parms, Qtool_bar_lines, make_number (0),
5397 "toolBar", "ToolBar", RES_TYPE_NUMBER);
1edf84e7 5398 x_default_parameter (f, parms, Qbuffer_predicate, Qnil,
6fc2811b 5399 "bufferPredicate", "BufferPredicate", RES_TYPE_SYMBOL);
1edf84e7 5400 x_default_parameter (f, parms, Qtitle, Qnil,
6fc2811b 5401 "title", "Title", RES_TYPE_STRING);
ee78dc32 5402
fbd6baed
GV		 5403 f->output_data.w32->dwStyle = WS_OVERLAPPEDWINDOW;
5404 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
3cf3436e
JR		 5405
5406 /* Add the tool-bar height to the initial frame height so that the
5407 user gets a text display area of the size he specified with -g or
5408 via .Xdefaults. Later changes of the tool-bar height don't
5409 change the frame size. This is done so that users can create
5410 tall Emacs frames without having to guess how tall the tool-bar
5411 will get. */
5412 if (FRAME_TOOL_BAR_LINES (f))
5413 {
5414 int margin, relief, bar_height;
5415
5416 relief = (tool_bar_button_relief > 0
5417 ? tool_bar_button_relief
5418 : DEFAULT_TOOL_BAR_BUTTON_RELIEF);
5419
5420 if (INTEGERP (Vtool_bar_button_margin)
5421 && XINT (Vtool_bar_button_margin) > 0)
5422 margin = XFASTINT (Vtool_bar_button_margin);
5423 else if (CONSP (Vtool_bar_button_margin)
5424 && INTEGERP (XCDR (Vtool_bar_button_margin))
5425 && XINT (XCDR (Vtool_bar_button_margin)) > 0)
5426 margin = XFASTINT (XCDR (Vtool_bar_button_margin));
5427 else
5428 margin = 0;
5429
5430 bar_height = DEFAULT_TOOL_BAR_IMAGE_HEIGHT + 2 * margin + 2 * relief;
5431 f->height += (bar_height + CANON_Y_UNIT (f) - 1) / CANON_Y_UNIT (f);
5432 }
5433
ee78dc32
GV		 5434 window_prompting = x_figure_window_size (f, parms);
5435
5436 if (window_prompting & XNegative)
5437 {
5438 if (window_prompting & YNegative)
fbd6baed 5439 f->output_data.w32->win_gravity = SouthEastGravity;
ee78dc32 5440 else
fbd6baed 5441 f->output_data.w32->win_gravity = NorthEastGravity;
ee78dc32
GV		 5442 }
5443 else
5444 {
5445 if (window_prompting & YNegative)
fbd6baed 5446 f->output_data.w32->win_gravity = SouthWestGravity;
ee78dc32 5447 else
fbd6baed 5448 f->output_data.w32->win_gravity = NorthWestGravity;
ee78dc32
GV		 5449 }
5450
fbd6baed 5451 f->output_data.w32->size_hint_flags = window_prompting;
ee78dc32 5452
6fc2811b
JR		 5453 tem = w32_get_arg (parms, Qunsplittable, 0, 0, RES_TYPE_BOOLEAN);
5454 f->no_split = minibuffer_only || EQ (tem, Qt);
5455
fbd6baed 5456 w32_window (f, window_prompting, minibuffer_only);
ee78dc32 5457 x_icon (f, parms);
6fc2811b
JR		 5458
5459 x_make_gc (f);
5460
5461 /* Now consider the frame official. */
5462 FRAME_W32_DISPLAY_INFO (f)->reference_count++;
5463 Vframe_list = Fcons (frame, Vframe_list);
ee78dc32
GV		 5464
5465 /* We need to do this after creating the window, so that the
5466 icon-creation functions can say whose icon they're describing. */
5467 x_default_parameter (f, parms, Qicon_type, Qnil,
6fc2811b 5468 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL);
ee78dc32
GV		 5469
5470 x_default_parameter (f, parms, Qauto_raise, Qnil,
6fc2811b 5471 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
ee78dc32 5472 x_default_parameter (f, parms, Qauto_lower, Qnil,
6fc2811b 5473 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
ee78dc32 5474 x_default_parameter (f, parms, Qcursor_type, Qbox,
6fc2811b
JR		 5475 "cursorType", "CursorType", RES_TYPE_SYMBOL);
5476 x_default_parameter (f, parms, Qscroll_bar_width, Qnil,
5477 "scrollBarWidth", "ScrollBarWidth", RES_TYPE_NUMBER);
ee78dc32
GV		 5478
5479 /* Dimensions, especially f->height, must be done via change_frame_size.
5480 Change will not be effected unless different from the current
5481 f->height. */
5482 width = f->width;
5483 height = f->height;
dc220243 5484
1026b400
RS		 5485 f->height = 0;
5486 SET_FRAME_WIDTH (f, 0);
6fc2811b
JR		 5487 change_frame_size (f, height, width, 1, 0, 0);
5488
6fc2811b
JR		 5489 /* Tell the server what size and position, etc, we want, and how
5490 badly we want them. This should be done after we have the menu
5491 bar so that its size can be taken into account. */
ee78dc32
GV		 5492 BLOCK_INPUT;
5493 x_wm_set_size_hint (f, window_prompting, 0);
5494 UNBLOCK_INPUT;
5495
4694d762
JR		 5496 /* Set up faces after all frame parameters are known. This call
5497 also merges in face attributes specified for new frames. If we
5498 don't do this, the `menu' face for instance won't have the right
5499 colors, and the menu bar won't appear in the specified colors for
5500 new frames. */
5501 call1 (Qface_set_after_frame_default, frame);
5502
6fc2811b
JR		 5503 /* Make the window appear on the frame and enable display, unless
5504 the caller says not to. However, with explicit parent, Emacs
5505 cannot control visibility, so don't try. */
fbd6baed 5506 if (! f->output_data.w32->explicit_parent)
ee78dc32
GV		 5507 {
5508 Lisp_Object visibility;
5509
6fc2811b 5510 visibility = w32_get_arg (parms, Qvisibility, 0, 0, RES_TYPE_SYMBOL);
ee78dc32
GV		 5511 if (EQ (visibility, Qunbound))
5512 visibility = Qt;
5513
5514 if (EQ (visibility, Qicon))
5515 x_iconify_frame (f);
5516 else if (! NILP (visibility))
5517 x_make_frame_visible (f);
5518 else
5519 /* Must have been Qnil. */
5520 ;
5521 }
6fc2811b 5522 UNGCPRO;
9e57df62
GM		 5523
5524 /* Make sure windows on this frame appear in calls to next-window
5525 and similar functions. */
5526 Vwindow_list = Qnil;
5527
ee78dc32
GV		 5528 return unbind_to (count, frame);
5529}
5530
5531/* FRAME is used only to get a handle on the X display. We don't pass the
5532 display info directly because we're called from frame.c, which doesn't
5533 know about that structure. */
5534Lisp_Object
5535x_get_focus_frame (frame)
5536 struct frame *frame;
5537{
fbd6baed 5538 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (frame);
ee78dc32 5539 Lisp_Object xfocus;
fbd6baed 5540 if (! dpyinfo->w32_focus_frame)
ee78dc32
GV		 5541 return Qnil;
5542
fbd6baed 5543 XSETFRAME (xfocus, dpyinfo->w32_focus_frame);
ee78dc32
GV		 5544 return xfocus;
5545}
1edf84e7
GV		 5546
5547DEFUN ("w32-focus-frame", Fw32_focus_frame, Sw32_focus_frame, 1, 1, 0,
5548 "Give FRAME input focus, raising to foreground if necessary.")
5549 (frame)
5550 Lisp_Object frame;
5551{
5552 x_focus_on_frame (check_x_frame (frame));
5553 return Qnil;
5554}
5555
ee78dc32 5556\f
767b1ff0
JR		 5557/* Return the charset portion of a font name. */
5558char * xlfd_charset_of_font (char * fontname)
5559{
5560 char *charset, *encoding;
5561
5562 encoding = strrchr(fontname, '-');
ceb12877 5563 if (!encoding || encoding == fontname)
767b1ff0
JR		 5564 return NULL;
5565
478ea067
AI		 5566 for (charset = encoding - 1; charset >= fontname; charset--)
5567 if (*charset == '-')
5568 break;
767b1ff0 5569
478ea067 5570 if (charset == fontname || strcmp(charset, "-*-*") == 0)
767b1ff0
JR		 5571 return NULL;
5572
5573 return charset + 1;
5574}
5575
33d52f9c
GV		 5576struct font_info *w32_load_bdf_font (struct frame *f, char *fontname,
5577 int size, char* filename);
8edb0a6f 5578static Lisp_Object w32_list_bdf_fonts (Lisp_Object pattern, int max_names);
c7501041
EZ		 5579static BOOL w32_to_x_font (LOGFONT * lplf, char * lpxstr, int len,
5580 char * charset);
5581static BOOL x_to_w32_font (char *lpxstr, LOGFONT *lplogfont);
33d52f9c 5582
8edb0a6f 5583static struct font_info *
33d52f9c 5584w32_load_system_font (f,fontname,size)
55dcfc15
AI		 5585 struct frame *f;
5586 char * fontname;
5587 int size;
ee78dc32 5588{
4587b026
GV		 5589 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
5590 Lisp_Object font_names;
5591
4587b026
GV		 5592 /* Get a list of all the fonts that match this name. Once we
5593 have a list of matching fonts, we compare them against the fonts
5594 we already have loaded by comparing names. */
5595 font_names = w32_list_fonts (f, build_string (fontname), size, 100);
5596
5597 if (!NILP (font_names))
3c190163 5598 {
4587b026
GV		 5599 Lisp_Object tail;
5600 int i;
4587b026
GV		 5601
5602 /* First check if any are already loaded, as that is cheaper
5603 than loading another one. */
5604 for (i = 0; i < dpyinfo->n_fonts; i++)
8e713be6 5605 for (tail = font_names; CONSP (tail); tail = XCDR (tail))
6fc2811b
JR		 5606 if (dpyinfo->font_table[i].name
5607 && (!strcmp (dpyinfo->font_table[i].name,
5608 XSTRING (XCAR (tail))->data)
5609 || !strcmp (dpyinfo->font_table[i].full_name,
5610 XSTRING (XCAR (tail))->data)))
4587b026 5611 return (dpyinfo->font_table + i);
6fc2811b 5612
8e713be6 5613 fontname = (char *) XSTRING (XCAR (font_names))->data;
4587b026 5614 }
1075afa9 5615 else if (w32_strict_fontnames)
5ca0cd71
GV		 5616 {
5617 /* If EnumFontFamiliesEx was available, we got a full list of
5618 fonts back so stop now to avoid the possibility of loading a
5619 random font. If we had to fall back to EnumFontFamilies, the
5620 list is incomplete, so continue whether the font we want was
5621 listed or not. */
5622 HMODULE gdi32 = GetModuleHandle ("gdi32.dll");
5623 FARPROC enum_font_families_ex
1075afa9 5624 = GetProcAddress (gdi32, "EnumFontFamiliesExA");
5ca0cd71
GV		 5625 if (enum_font_families_ex)
5626 return NULL;
5627 }
4587b026
GV		 5628
5629 /* Load the font and add it to the table. */
5630 {
767b1ff0 5631 char *full_name, *encoding, *charset;
4587b026
GV		 5632 XFontStruct *font;
5633 struct font_info *fontp;
3c190163 5634 LOGFONT lf;
4587b026 5635 BOOL ok;
19c291d3 5636 int codepage;
6fc2811b 5637 int i;
5ac45f98 5638
4587b026 5639 if (!fontname || !x_to_w32_font (fontname, &lf))
3c190163 5640 return (NULL);
5ac45f98 5641
4587b026
GV		 5642 if (!*lf.lfFaceName)
5643 /* If no name was specified for the font, we get a random font
5644 from CreateFontIndirect - this is not particularly
5645 desirable, especially since CreateFontIndirect does not
5646 fill out the missing name in lf, so we never know what we
5647 ended up with. */
5648 return NULL;
5649
3c190163 5650 font = (XFontStruct *) xmalloc (sizeof (XFontStruct));
c6be3860 5651 bzero (font, sizeof (*font));
5ac45f98 5652
33d52f9c
GV		 5653 /* Set bdf to NULL to indicate that this is a Windows font. */
5654 font->bdf = NULL;
5ac45f98 5655
3c190163 5656 BLOCK_INPUT;
5ac45f98
GV		 5657
5658 font->hfont = CreateFontIndirect (&lf);
ee78dc32 5659
1a292d24
AI		 5660 if (font->hfont == NULL)
5661 {
5662 ok = FALSE;
5663 }
5664 else
5665 {
5666 HDC hdc;
5667 HANDLE oldobj;
19c291d3
AI		 5668
5669 codepage = w32_codepage_for_font (fontname);
1a292d24
AI		 5670
5671 hdc = GetDC (dpyinfo->root_window);
5672 oldobj = SelectObject (hdc, font->hfont);
5c6682be 5673
1a292d24 5674 ok = GetTextMetrics (hdc, &font->tm);
5c6682be
JR		 5675 if (codepage == CP_UNICODE)
5676 font->double_byte_p = 1;
5677 else
8b77111c
AI		 5678 {
5679 /* Unfortunately, some fonts (eg. MingLiU, a big5 ttf font)
5680 don't report themselves as double byte fonts, when
5681 patently they are. So instead of trusting
5682 GetFontLanguageInfo, we check the properties of the
5683 codepage directly, since that is ultimately what we are
5684 working from anyway. */
5685 /* font->double_byte_p = GetFontLanguageInfo(hdc) & GCP_DBCS; */
5686 CPINFO cpi = {0};
5687 GetCPInfo (codepage, &cpi);
5688 font->double_byte_p = cpi.MaxCharSize > 1;
5689 }
5c6682be 5690
1a292d24
AI		 5691 SelectObject (hdc, oldobj);
5692 ReleaseDC (dpyinfo->root_window, hdc);
6fc2811b
JR		 5693 /* Fill out details in lf according to the font that was
5694 actually loaded. */
5695 lf.lfHeight = font->tm.tmInternalLeading - font->tm.tmHeight;
5696 lf.lfWidth = font->tm.tmAveCharWidth;
5697 lf.lfWeight = font->tm.tmWeight;
5698 lf.lfItalic = font->tm.tmItalic;
5699 lf.lfCharSet = font->tm.tmCharSet;
5700 lf.lfPitchAndFamily = ((font->tm.tmPitchAndFamily & TMPF_FIXED_PITCH)
d88c567c 5701 ? VARIABLE_PITCH : FIXED_PITCH);
6fc2811b
JR		 5702 lf.lfOutPrecision = ((font->tm.tmPitchAndFamily & TMPF_VECTOR)
5703 ? OUT_STROKE_PRECIS : OUT_STRING_PRECIS);
c6be3860
AI		 5704
5705 w32_cache_char_metrics (font);
1a292d24 5706 }
5ac45f98 5707
1a292d24 5708 UNBLOCK_INPUT;
5ac45f98 5709
4587b026
GV		 5710 if (!ok)
5711 {
1a292d24
AI		 5712 w32_unload_font (dpyinfo, font);
5713 return (NULL);
5714 }
ee78dc32 5715
6fc2811b
JR		 5716 /* Find a free slot in the font table. */
5717 for (i = 0; i < dpyinfo->n_fonts; ++i)
5718 if (dpyinfo->font_table[i].name == NULL)
5719 break;
5720
5721 /* If no free slot found, maybe enlarge the font table. */
5722 if (i == dpyinfo->n_fonts
5723 && dpyinfo->n_fonts == dpyinfo->font_table_size)
4587b026 5724 {
6fc2811b
JR		 5725 int sz;
5726 dpyinfo->font_table_size = max (16, 2 * dpyinfo->font_table_size);
5727 sz = dpyinfo->font_table_size * sizeof *dpyinfo->font_table;
4587b026 5728 dpyinfo->font_table
6fc2811b 5729 = (struct font_info *) xrealloc (dpyinfo->font_table, sz);
4587b026
GV		 5730 }
5731
6fc2811b
JR		 5732 fontp = dpyinfo->font_table + i;
5733 if (i == dpyinfo->n_fonts)
5734 ++dpyinfo->n_fonts;
4587b026
GV		 5735
5736 /* Now fill in the slots of *FONTP. */
5737 BLOCK_INPUT;
5738 fontp->font = font;
6fc2811b 5739 fontp->font_idx = i;
4587b026
GV		 5740 fontp->name = (char *) xmalloc (strlen (fontname) + 1);
5741 bcopy (fontname, fontp->name, strlen (fontname) + 1);
5742
767b1ff0
JR		 5743 charset = xlfd_charset_of_font (fontname);
5744
19c291d3
AI		 5745 /* Cache the W32 codepage for a font. This makes w32_encode_char
5746 (called for every glyph during redisplay) much faster. */
5747 fontp->codepage = codepage;
5748
4587b026
GV		 5749 /* Work out the font's full name. */
5750 full_name = (char *)xmalloc (100);
767b1ff0 5751 if (full_name && w32_to_x_font (&lf, full_name, 100, charset))
4587b026
GV		 5752 fontp->full_name = full_name;
5753 else
5754 {
5755 /* If all else fails - just use the name we used to load it. */
5756 xfree (full_name);
5757 fontp->full_name = fontp->name;
5758 }
5759
5760 fontp->size = FONT_WIDTH (font);
5761 fontp->height = FONT_HEIGHT (font);
5762
5763 /* The slot `encoding' specifies how to map a character
5764 code-points (0x20..0x7F or 0x2020..0x7F7F) of each charset to
126f2e35
JR		 5765 the font code-points (0:0x20..0x7F, 1:0xA0..0xFF), or
5766 (0:0x20..0x7F, 1:0xA0..0xFF,
5767 (0:0x2020..0x7F7F, 1:0xA0A0..0xFFFF, 3:0x20A0..0x7FFF,
4587b026 5768 2:0xA020..0xFF7F). For the moment, we don't know which charset
6fc2811b 5769 uses this font. So, we set information in fontp->encoding[1]
4587b026
GV		 5770 which is never used by any charset. If mapping can't be
5771 decided, set FONT_ENCODING_NOT_DECIDED. */
33d52f9c
GV		 5772
5773 /* SJIS fonts need to be set to type 4, all others seem to work as
5774 type FONT_ENCODING_NOT_DECIDED. */
5775 encoding = strrchr (fontp->name, '-');
5776 if (encoding && stricmp (encoding+1, "sjis") == 0)
1c885fe1 5777 fontp->encoding[1] = 4;
33d52f9c 5778 else
1c885fe1 5779 fontp->encoding[1] = FONT_ENCODING_NOT_DECIDED;
4587b026
GV		 5780
5781 /* The following three values are set to 0 under W32, which is
5782 what they get set to if XGetFontProperty fails under X. */
5783 fontp->baseline_offset = 0;
5784 fontp->relative_compose = 0;
33d52f9c 5785 fontp->default_ascent = 0;
4587b026 5786
6fc2811b
JR		 5787 /* Set global flag fonts_changed_p to non-zero if the font loaded
5788 has a character with a smaller width than any other character
5789 before, or if the font loaded has a smalle>r height than any
5790 other font loaded before. If this happens, it will make a
5791 glyph matrix reallocation necessary. */
5792 fonts_changed_p = x_compute_min_glyph_bounds (f);
4587b026 5793 UNBLOCK_INPUT;
4587b026
GV		 5794 return fontp;
5795 }
5796}
5797
33d52f9c
GV		 5798/* Load font named FONTNAME of size SIZE for frame F, and return a
5799 pointer to the structure font_info while allocating it dynamically.
5800 If loading fails, return NULL. */
5801struct font_info *
5802w32_load_font (f,fontname,size)
5803struct frame *f;
5804char * fontname;
5805int size;
5806{
5807 Lisp_Object bdf_fonts;
5808 struct font_info *retval = NULL;
5809
8edb0a6f 5810 bdf_fonts = w32_list_bdf_fonts (build_string (fontname), 1);
33d52f9c
GV		 5811
5812 while (!retval && CONSP (bdf_fonts))
5813 {
5814 char *bdf_name, *bdf_file;
5815 Lisp_Object bdf_pair;
5816
8e713be6
KR		 5817 bdf_name = XSTRING (XCAR (bdf_fonts))->data;
5818 bdf_pair = Fassoc (XCAR (bdf_fonts), Vw32_bdf_filename_alist);
5819 bdf_file = XSTRING (XCDR (bdf_pair))->data;
33d52f9c
GV		 5820
5821 retval = w32_load_bdf_font (f, bdf_name, size, bdf_file);
5822
8e713be6 5823 bdf_fonts = XCDR (bdf_fonts);
33d52f9c
GV		 5824 }
5825
5826 if (retval)
5827 return retval;
5828
5829 return w32_load_system_font(f, fontname, size);
5830}
5831
5832
ee78dc32 5833void
fbd6baed
GV		 5834w32_unload_font (dpyinfo, font)
5835 struct w32_display_info *dpyinfo;
ee78dc32
GV		 5836 XFontStruct * font;
5837{
5838 if (font)
5839 {
c6be3860 5840 if (font->per_char) xfree (font->per_char);
33d52f9c
GV		 5841 if (font->bdf) w32_free_bdf_font (font->bdf);
5842
3c190163 5843 if (font->hfont) DeleteObject(font->hfont);
ee78dc32
GV		 5844 xfree (font);
5845 }
5846}
5847
fbd6baed 5848/* The font conversion stuff between x and w32 */
ee78dc32
GV		 5849
5850/* X font string is as follows (from faces.el)
5851 * (let ((- "[-?]")
5852 * (foundry "[^-]+")
5853 * (family "[^-]+")
5854 * (weight "\\(bold\\|demibold\\|medium\\)") ; 1
5855 * (weight\? "\\([^-]*\\)") ; 1
5856 * (slant "\\([ior]\\)") ; 2
5857 * (slant\? "\\([^-]?\\)") ; 2
5858 * (swidth "\\([^-]*\\)") ; 3
5859 * (adstyle "[^-]*") ; 4
5860 * (pixelsize "[0-9]+")
5861 * (pointsize "[0-9][0-9]+")
5862 * (resx "[0-9][0-9]+")
5863 * (resy "[0-9][0-9]+")
5864 * (spacing "[cmp?*]")
5865 * (avgwidth "[0-9]+")
5866 * (registry "[^-]+")
5867 * (encoding "[^-]+")
5868 * )
ee78dc32 5869 */
ee78dc32 5870
8edb0a6f 5871static LONG
fbd6baed 5872x_to_w32_weight (lpw)
ee78dc32
GV		 5873 char * lpw;
5874{
5875 if (!lpw) return (FW_DONTCARE);
5ac45f98
GV		 5876
5877 if (stricmp (lpw,"heavy") == 0) return FW_HEAVY;
5878 else if (stricmp (lpw,"extrabold") == 0) return FW_EXTRABOLD;
5879 else if (stricmp (lpw,"bold") == 0) return FW_BOLD;
5880 else if (stricmp (lpw,"demibold") == 0) return FW_SEMIBOLD;
1edf84e7 5881 else if (stricmp (lpw,"semibold") == 0) return FW_SEMIBOLD;
5ac45f98
GV		 5882 else if (stricmp (lpw,"medium") == 0) return FW_MEDIUM;
5883 else if (stricmp (lpw,"normal") == 0) return FW_NORMAL;
5884 else if (stricmp (lpw,"light") == 0) return FW_LIGHT;
5885 else if (stricmp (lpw,"extralight") == 0) return FW_EXTRALIGHT;
5886 else if (stricmp (lpw,"thin") == 0) return FW_THIN;
ee78dc32 5887 else
5ac45f98 5888 return FW_DONTCARE;
ee78dc32
GV		 5889}
5890
5ac45f98 5891
8edb0a6f 5892static char *
fbd6baed 5893w32_to_x_weight (fnweight)
ee78dc32
GV		 5894 int fnweight;
5895{
5ac45f98
GV		 5896 if (fnweight >= FW_HEAVY) return "heavy";
5897 if (fnweight >= FW_EXTRABOLD) return "extrabold";
5898 if (fnweight >= FW_BOLD) return "bold";
03f8fb34 5899 if (fnweight >= FW_SEMIBOLD) return "demibold";
5ac45f98
GV		 5900 if (fnweight >= FW_MEDIUM) return "medium";
5901 if (fnweight >= FW_NORMAL) return "normal";
5902 if (fnweight >= FW_LIGHT) return "light";
5903 if (fnweight >= FW_EXTRALIGHT) return "extralight";
5904 if (fnweight >= FW_THIN) return "thin";
5905 else
5906 return "*";
5907}
5908
8edb0a6f 5909static LONG
fbd6baed 5910x_to_w32_charset (lpcs)
5ac45f98
GV		 5911 char * lpcs;
5912{
767b1ff0 5913 Lisp_Object this_entry, w32_charset;
8b77111c
AI		 5914 char *charset;
5915 int len = strlen (lpcs);
5916
5917 /* Support "*-#nnn" format for unknown charsets. */
5918 if (strncmp (lpcs, "*-#", 3) == 0)
5919 return atoi (lpcs + 3);
5920
5921 /* Handle wildcards by ignoring them; eg. treat "big5*-*" as "big5". */
5922 charset = alloca (len + 1);
5923 strcpy (charset, lpcs);
5924 lpcs = strchr (charset, '*');
5925 if (lpcs)
5926 *lpcs = 0;
4587b026 5927
dfff8a69
JR		 5928 /* Look through w32-charset-info-alist for the character set.
5929 Format of each entry is
5930 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
5931 */
8b77111c 5932 this_entry = Fassoc (build_string(charset), Vw32_charset_info_alist);
4587b026 5933
767b1ff0
JR		 5934 if (NILP(this_entry))
5935 {
5936 /* At startup, we want iso8859-1 fonts to come up properly. */
8b77111c 5937 if (stricmp(charset, "iso8859-1") == 0)
767b1ff0
JR		 5938 return ANSI_CHARSET;
5939 else
5940 return DEFAULT_CHARSET;
5941 }
5942
5943 w32_charset = Fcar (Fcdr (this_entry));
5944
5945 // Translate Lisp symbol to number.
5946 if (w32_charset == Qw32_charset_ansi)
5947 return ANSI_CHARSET;
5948 if (w32_charset == Qw32_charset_symbol)
5949 return SYMBOL_CHARSET;
5950 if (w32_charset == Qw32_charset_shiftjis)
5951 return SHIFTJIS_CHARSET;
5952 if (w32_charset == Qw32_charset_hangeul)
5953 return HANGEUL_CHARSET;
5954 if (w32_charset == Qw32_charset_chinesebig5)
5955 return CHINESEBIG5_CHARSET;
5956 if (w32_charset == Qw32_charset_gb2312)
5957 return GB2312_CHARSET;
5958 if (w32_charset == Qw32_charset_oem)
5959 return OEM_CHARSET;
dfff8a69 5960#ifdef JOHAB_CHARSET
767b1ff0
JR		 5961 if (w32_charset == Qw32_charset_johab)
5962 return JOHAB_CHARSET;
5963 if (w32_charset == Qw32_charset_easteurope)
5964 return EASTEUROPE_CHARSET;
5965 if (w32_charset == Qw32_charset_turkish)
5966 return TURKISH_CHARSET;
5967 if (w32_charset == Qw32_charset_baltic)
5968 return BALTIC_CHARSET;
5969 if (w32_charset == Qw32_charset_russian)
5970 return RUSSIAN_CHARSET;
5971 if (w32_charset == Qw32_charset_arabic)
5972 return ARABIC_CHARSET;
5973 if (w32_charset == Qw32_charset_greek)
5974 return GREEK_CHARSET;
5975 if (w32_charset == Qw32_charset_hebrew)
5976 return HEBREW_CHARSET;
5977 if (w32_charset == Qw32_charset_vietnamese)
5978 return VIETNAMESE_CHARSET;
5979 if (w32_charset == Qw32_charset_thai)
5980 return THAI_CHARSET;
5981 if (w32_charset == Qw32_charset_mac)
5982 return MAC_CHARSET;
dfff8a69 5983#endif /* JOHAB_CHARSET */
5ac45f98 5984#ifdef UNICODE_CHARSET
767b1ff0
JR		 5985 if (w32_charset == Qw32_charset_unicode)
5986 return UNICODE_CHARSET;
5ac45f98 5987#endif
dfff8a69
JR		 5988
5989 return DEFAULT_CHARSET;
5ac45f98
GV		 5990}
5991
dfff8a69 5992
8edb0a6f 5993static char *
fbd6baed 5994w32_to_x_charset (fncharset)
5ac45f98
GV		 5995 int fncharset;
5996{
1edf84e7 5997 static char buf[16];
767b1ff0 5998 Lisp_Object charset_type;
1edf84e7 5999
5ac45f98
GV		 6000 switch (fncharset)
6001 {
767b1ff0
JR		 6002 case ANSI_CHARSET:
6003 /* Handle startup case of w32-charset-info-alist not
6004 being set up yet. */
6005 if (NILP(Vw32_charset_info_alist))
6006 return "iso8859-1";
6007 charset_type = Qw32_charset_ansi;
6008 break;
6009 case DEFAULT_CHARSET:
6010 charset_type = Qw32_charset_default;
6011 break;
6012 case SYMBOL_CHARSET:
6013 charset_type = Qw32_charset_symbol;
6014 break;
6015 case SHIFTJIS_CHARSET:
6016 charset_type = Qw32_charset_shiftjis;
6017 break;
6018 case HANGEUL_CHARSET:
6019 charset_type = Qw32_charset_hangeul;
6020 break;
6021 case GB2312_CHARSET:
6022 charset_type = Qw32_charset_gb2312;
6023 break;
6024 case CHINESEBIG5_CHARSET:
6025 charset_type = Qw32_charset_chinesebig5;
6026 break;
6027 case OEM_CHARSET:
6028 charset_type = Qw32_charset_oem;
6029 break;
4587b026
GV		 6030
6031 /* More recent versions of Windows (95 and NT4.0) define more
6032 character sets. */
6033#ifdef EASTEUROPE_CHARSET
767b1ff0
JR		 6034 case EASTEUROPE_CHARSET:
6035 charset_type = Qw32_charset_easteurope;
6036 break;
6037 case TURKISH_CHARSET:
6038 charset_type = Qw32_charset_turkish;
6039 break;
6040 case BALTIC_CHARSET:
6041 charset_type = Qw32_charset_baltic;
6042 break;
33d52f9c 6043 case RUSSIAN_CHARSET:
767b1ff0
JR		 6044 charset_type = Qw32_charset_russian;
6045 break;
6046 case ARABIC_CHARSET:
6047 charset_type = Qw32_charset_arabic;
6048 break;
6049 case GREEK_CHARSET:
6050 charset_type = Qw32_charset_greek;
6051 break;
6052 case HEBREW_CHARSET:
6053 charset_type = Qw32_charset_hebrew;
6054 break;
6055 case VIETNAMESE_CHARSET:
6056 charset_type = Qw32_charset_vietnamese;
6057 break;
6058 case THAI_CHARSET:
6059 charset_type = Qw32_charset_thai;
6060 break;
6061 case MAC_CHARSET:
6062 charset_type = Qw32_charset_mac;
6063 break;
6064 case JOHAB_CHARSET:
6065 charset_type = Qw32_charset_johab;
6066 break;
4587b026
GV		 6067#endif
6068
5ac45f98 6069#ifdef UNICODE_CHARSET
767b1ff0
JR		 6070 case UNICODE_CHARSET:
6071 charset_type = Qw32_charset_unicode;
6072 break;
5ac45f98 6073#endif
767b1ff0
JR		 6074 default:
6075 /* Encode numerical value of unknown charset. */
6076 sprintf (buf, "*-#%u", fncharset);
6077 return buf;
5ac45f98 6078 }
767b1ff0
JR		 6079
6080 {
6081 Lisp_Object rest;
6082 char * best_match = NULL;
6083
6084 /* Look through w32-charset-info-alist for the character set.
6085 Prefer ISO codepages, and prefer lower numbers in the ISO
6086 range. Only return charsets for codepages which are installed.
6087
6088 Format of each entry is
6089 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
6090 */
6091 for (rest = Vw32_charset_info_alist; CONSP (rest); rest = XCDR (rest))
6092 {
6093 char * x_charset;
6094 Lisp_Object w32_charset;
6095 Lisp_Object codepage;
6096
6097 Lisp_Object this_entry = XCAR (rest);
6098
6099 /* Skip invalid entries in alist. */
6100 if (!CONSP (this_entry) || !STRINGP (XCAR (this_entry))
6101 || !CONSP (XCDR (this_entry))
6102 || !SYMBOLP (XCAR (XCDR (this_entry))))
6103 continue;
6104
6105 x_charset = XSTRING (XCAR (this_entry))->data;
6106 w32_charset = XCAR (XCDR (this_entry));
6107 codepage = XCDR (XCDR (this_entry));
6108
6109 /* Look for Same charset and a valid codepage (or non-int
6110 which means ignore). */
6111 if (w32_charset == charset_type
6112 && (!INTEGERP (codepage) || codepage == CP_DEFAULT
6113 || IsValidCodePage (XINT (codepage))))
6114 {
6115 /* If we don't have a match already, then this is the
6116 best. */
6117 if (!best_match)
6118 best_match = x_charset;
6119 /* If this is an ISO codepage, and the best so far isn't,
6120 then this is better. */
6121 else if (stricmp (best_match, "iso") != 0
6122 && stricmp (x_charset, "iso") == 0)
6123 best_match = x_charset;
6124 /* If both are ISO8859 codepages, choose the one with the
6125 lowest number in the encoding field. */
6126 else if (stricmp (best_match, "iso8859-") == 0
6127 && stricmp (x_charset, "iso8859-") == 0)
6128 {
6129 int best_enc = atoi (best_match + 8);
6130 int this_enc = atoi (x_charset + 8);
6131 if (this_enc > 0 && this_enc < best_enc)
6132 best_match = x_charset;
6133 }
6134 }
6135 }
6136
6137 /* If no match, encode the numeric value. */
6138 if (!best_match)
6139 {
6140 sprintf (buf, "*-#%u", fncharset);
6141 return buf;
6142 }
6143
6144 strncpy(buf, best_match, 15);
6145 buf[15] = '\0';
6146 return buf;
6147 }
ee78dc32
GV		 6148}
6149
dfff8a69
JR		 6150
6151/* Get the Windows codepage corresponding to the specified font. The
6152 charset info in the font name is used to look up
6153 w32-charset-to-codepage-alist. */
6154int
6155w32_codepage_for_font (char *fontname)
6156{
767b1ff0
JR		 6157 Lisp_Object codepage, entry;
6158 char *charset_str, *charset, *end;
dfff8a69 6159
767b1ff0 6160 if (NILP (Vw32_charset_info_alist))
dfff8a69
JR		 6161 return CP_DEFAULT;
6162
767b1ff0
JR		 6163 /* Extract charset part of font string. */
6164 charset = xlfd_charset_of_font (fontname);
6165
6166 if (!charset)
ceb12877 6167 return CP_UNKNOWN;
767b1ff0 6168
8b77111c 6169 charset_str = (char *) alloca (strlen (charset) + 1);
767b1ff0
JR		 6170 strcpy (charset_str, charset);
6171
8b77111c 6172#if 0
dfff8a69
JR		 6173 /* Remove leading "*-". */
6174 if (strncmp ("*-", charset_str, 2) == 0)
6175 charset = charset_str + 2;
6176 else
8b77111c 6177#endif
dfff8a69
JR		 6178 charset = charset_str;
6179
6180 /* Stop match at wildcard (including preceding '-'). */
6181 if (end = strchr (charset, '*'))
6182 {
6183 if (end > charset && *(end-1) == '-')
6184 end--;
6185 *end = '\0';
6186 }
6187
767b1ff0
JR		 6188 entry = Fassoc (build_string(charset), Vw32_charset_info_alist);
6189 if (NILP (entry))
ceb12877 6190 return CP_UNKNOWN;
767b1ff0
JR		 6191
6192 codepage = Fcdr (Fcdr (entry));
6193
6194 if (NILP (codepage))
6195 return CP_8BIT;
6196 else if (XFASTINT (codepage) == XFASTINT (Qt))
6197 return CP_UNICODE;
6198 else if (INTEGERP (codepage))
dfff8a69
JR		 6199 return XINT (codepage);
6200 else
ceb12877 6201 return CP_UNKNOWN;
dfff8a69
JR		 6202}
6203
6204
8edb0a6f 6205static BOOL
767b1ff0 6206w32_to_x_font (lplogfont, lpxstr, len, specific_charset)
ee78dc32
GV		 6207 LOGFONT * lplogfont;
6208 char * lpxstr;
6209 int len;
767b1ff0 6210 char * specific_charset;
ee78dc32 6211{
6fc2811b 6212 char* fonttype;
f46e6225 6213 char *fontname;
3cb20f4a
RS		 6214 char height_pixels[8];
6215 char height_dpi[8];
6216 char width_pixels[8];
4587b026 6217 char *fontname_dash;
d88c567c
JR		 6218 int display_resy = one_w32_display_info.resy;
6219 int display_resx = one_w32_display_info.resx;
f46e6225
GV		 6220 int bufsz;
6221 struct coding_system coding;
3cb20f4a
RS		 6222
6223 if (!lpxstr) abort ();
ee78dc32 6224
3cb20f4a
RS		 6225 if (!lplogfont)
6226 return FALSE;
6227
6fc2811b
JR		 6228 if (lplogfont->lfOutPrecision == OUT_STRING_PRECIS)
6229 fonttype = "raster";
6230 else if (lplogfont->lfOutPrecision == OUT_STROKE_PRECIS)
6231 fonttype = "outline";
6232 else
6233 fonttype = "unknown";
6234
f46e6225
GV		 6235 setup_coding_system (Fcheck_coding_system (Vw32_system_coding_system),
6236 &coding);
aab5ac44
KH		 6237 coding.src_multibyte = 0;
6238 coding.dst_multibyte = 1;
f46e6225
GV		 6239 coding.mode |= CODING_MODE_LAST_BLOCK;
6240 bufsz = decoding_buffer_size (&coding, LF_FACESIZE);
6241
6242 fontname = alloca(sizeof(*fontname) * bufsz);
6243 decode_coding (&coding, lplogfont->lfFaceName, fontname,
6244 strlen(lplogfont->lfFaceName), bufsz - 1);
6245 *(fontname + coding.produced) = '\0';
4587b026
GV		 6246
6247 /* Replace dashes with underscores so the dashes are not
f46e6225 6248 misinterpreted. */
4587b026
GV		 6249 fontname_dash = fontname;
6250 while (fontname_dash = strchr (fontname_dash, '-'))
6251 *fontname_dash = '_';
6252
3cb20f4a 6253 if (lplogfont->lfHeight)
ee78dc32 6254 {
3cb20f4a
RS		 6255 sprintf (height_pixels, "%u", abs (lplogfont->lfHeight));
6256 sprintf (height_dpi, "%u",
33d52f9c 6257 abs (lplogfont->lfHeight) * 720 / display_resy);
5ac45f98
GV		 6258 }
6259 else
ee78dc32 6260 {
3cb20f4a
RS		 6261 strcpy (height_pixels, "*");
6262 strcpy (height_dpi, "*");
ee78dc32 6263 }
3cb20f4a
RS		 6264 if (lplogfont->lfWidth)
6265 sprintf (width_pixels, "%u", lplogfont->lfWidth * 10);
6266 else
6267 strcpy (width_pixels, "*");
6268
6269 _snprintf (lpxstr, len - 1,
6fc2811b
JR		 6270 "-%s-%s-%s-%c-normal-normal-%s-%s-%d-%d-%c-%s-%s",
6271 fonttype, /* foundry */
4587b026
GV		 6272 fontname, /* family */
6273 w32_to_x_weight (lplogfont->lfWeight), /* weight */
6274 lplogfont->lfItalic?'i':'r', /* slant */
6275 /* setwidth name */
6276 /* add style name */
6277 height_pixels, /* pixel size */
6278 height_dpi, /* point size */
33d52f9c
GV		 6279 display_resx, /* resx */
6280 display_resy, /* resy */
4587b026
GV		 6281 ((lplogfont->lfPitchAndFamily & 0x3) == VARIABLE_PITCH)
6282 ? 'p' : 'c', /* spacing */
6283 width_pixels, /* avg width */
767b1ff0
JR		 6284 specific_charset ? specific_charset
6285 : w32_to_x_charset (lplogfont->lfCharSet)
6286 /* charset registry and encoding */
3cb20f4a
RS		 6287 );
6288
ee78dc32
GV		 6289 lpxstr[len - 1] = 0; /* just to be sure */
6290 return (TRUE);
6291}
6292
8edb0a6f 6293static BOOL
fbd6baed 6294x_to_w32_font (lpxstr, lplogfont)
ee78dc32
GV		 6295 char * lpxstr;
6296 LOGFONT * lplogfont;
6297{
f46e6225
GV		 6298 struct coding_system coding;
6299
ee78dc32 6300 if (!lplogfont) return (FALSE);
f46e6225 6301
ee78dc32 6302 memset (lplogfont, 0, sizeof (*lplogfont));
5ac45f98 6303
1a292d24 6304 /* Set default value for each field. */
771c47d5 6305#if 1
ee78dc32
GV		 6306 lplogfont->lfOutPrecision = OUT_DEFAULT_PRECIS;
6307 lplogfont->lfClipPrecision = CLIP_DEFAULT_PRECIS;
6308 lplogfont->lfQuality = DEFAULT_QUALITY;
5ac45f98
GV		 6309#else
6310 /* go for maximum quality */
6311 lplogfont->lfOutPrecision = OUT_STROKE_PRECIS;
6312 lplogfont->lfClipPrecision = CLIP_STROKE_PRECIS;
6313 lplogfont->lfQuality = PROOF_QUALITY;
6314#endif
6315
1a292d24
AI		 6316 lplogfont->lfCharSet = DEFAULT_CHARSET;
6317 lplogfont->lfWeight = FW_DONTCARE;
6318 lplogfont->lfPitchAndFamily = DEFAULT_PITCH | FF_DONTCARE;
6319
5ac45f98
GV		 6320 if (!lpxstr)
6321 return FALSE;
6322
6323 /* Provide a simple escape mechanism for specifying Windows font names
6324 * directly -- if font spec does not beginning with '-', assume this
6325 * format:
6326 * "<font name>[:height in pixels[:width in pixels[:weight]]]"
6327 */
ee78dc32 6328
5ac45f98
GV		 6329 if (*lpxstr == '-')
6330 {
33d52f9c
GV		 6331 int fields, tem;
6332 char name[50], weight[20], slant, pitch, pixels[10], height[10],
8b77111c 6333 width[10], resy[10], remainder[50];
5ac45f98 6334 char * encoding;
d98c0337 6335 int dpi = one_w32_display_info.resy;
5ac45f98
GV		 6336
6337 fields = sscanf (lpxstr,
8b77111c 6338 "-%*[^-]-%49[^-]-%19[^-]-%c-%*[^-]-%*[^-]-%9[^-]-%9[^-]-%*[^-]-%9[^-]-%c-%9[^-]-%49s",
33d52f9c 6339 name, weight, &slant, pixels, height, resy, &pitch, width, remainder);
8b77111c
AI		 6340 if (fields == EOF)
6341 return (FALSE);
6342
6343 /* In the general case when wildcards cover more than one field,
6344 we don't know which field is which, so don't fill any in.
6345 However, we need to cope with this particular form, which is
6346 generated by font_list_1 (invoked by try_font_list):
6347 "-raster-6x10-*-gb2312*-*"
6348 and make sure to correctly parse the charset field. */
6349 if (fields == 3)
6350 {
6351 fields = sscanf (lpxstr,
6352 "-%*[^-]-%49[^-]-*-%49s",
6353 name, remainder);
6354 }
6355 else if (fields < 9)
6356 {
6357 fields = 0;
6358 remainder[0] = 0;
6359 }
6fc2811b 6360
5ac45f98
GV		 6361 if (fields > 0 && name[0] != '*')
6362 {
8ea3e054
RS		 6363 int bufsize;
6364 unsigned char *buf;
6365
f46e6225
GV		 6366 setup_coding_system
6367 (Fcheck_coding_system (Vw32_system_coding_system), &coding);
aab5ac44
KH		 6368 coding.src_multibyte = 1;
6369 coding.dst_multibyte = 1;
8ea3e054
RS		 6370 bufsize = encoding_buffer_size (&coding, strlen (name));
6371 buf = (unsigned char *) alloca (bufsize);
f46e6225 6372 coding.mode |= CODING_MODE_LAST_BLOCK;
8ea3e054
RS		 6373 encode_coding (&coding, name, buf, strlen (name), bufsize);
6374 if (coding.produced >= LF_FACESIZE)
6375 coding.produced = LF_FACESIZE - 1;
6376 buf[coding.produced] = 0;
6377 strcpy (lplogfont->lfFaceName, buf);
5ac45f98
GV		 6378 }
6379 else
6380 {
6fc2811b 6381 lplogfont->lfFaceName[0] = '\0';
5ac45f98
GV		 6382 }
6383
6384 fields--;
6385
fbd6baed 6386 lplogfont->lfWeight = x_to_w32_weight ((fields > 0 ? weight : ""));
5ac45f98
GV		 6387
6388 fields--;
6389
c8874f14 6390 lplogfont->lfItalic = (fields > 0 && slant == 'i');
5ac45f98
GV		 6391
6392 fields--;
6393
6394 if (fields > 0 && pixels[0] != '*')
6395 lplogfont->lfHeight = atoi (pixels);
6396
6397 fields--;
5ac45f98 6398 fields--;
33d52f9c
GV		 6399 if (fields > 0 && resy[0] != '*')
6400 {
6fc2811b 6401 tem = atoi (resy);
33d52f9c
GV		 6402 if (tem > 0) dpi = tem;
6403 }
5ac45f98 6404
33d52f9c
GV		 6405 if (fields > -1 && lplogfont->lfHeight == 0 && height[0] != '*')
6406 lplogfont->lfHeight = atoi (height) * dpi / 720;
6407
6408 if (fields > 0)
5ac45f98
GV		 6409 lplogfont->lfPitchAndFamily =
6410 (fields > 0 && pitch == 'p') ? VARIABLE_PITCH : FIXED_PITCH;
6411
6412 fields--;
6413
6414 if (fields > 0 && width[0] != '*')
6415 lplogfont->lfWidth = atoi (width) / 10;
6416
6417 fields--;
6418
4587b026 6419 /* Strip the trailing '-' if present. (it shouldn't be, as it
d88c567c 6420 fails the test against xlfd-tight-regexp in fontset.el). */
3c190163 6421 {
5ac45f98
GV		 6422 int len = strlen (remainder);
6423 if (len > 0 && remainder[len-1] == '-')
6424 remainder[len-1] = 0;
ee78dc32 6425 }
5ac45f98 6426 encoding = remainder;
8b77111c 6427#if 0
5ac45f98
GV		 6428 if (strncmp (encoding, "*-", 2) == 0)
6429 encoding += 2;
8b77111c
AI		 6430#endif
6431 lplogfont->lfCharSet = x_to_w32_charset (encoding);
5ac45f98
GV		 6432 }
6433 else
6434 {
6435 int fields;
6436 char name[100], height[10], width[10], weight[20];
a1a80b40 6437
5ac45f98
GV		 6438 fields = sscanf (lpxstr,
6439 "%99[^:]:%9[^:]:%9[^:]:%19s",
6440 name, height, width, weight);
6441
6442 if (fields == EOF) return (FALSE);
6443
6444 if (fields > 0)
6445 {
6446 strncpy (lplogfont->lfFaceName,name, LF_FACESIZE);
6447 lplogfont->lfFaceName[LF_FACESIZE-1] = 0;
6448 }
6449 else
6450 {
6451 lplogfont->lfFaceName[0] = 0;
6452 }
6453
6454 fields--;
6455
6456 if (fields > 0)
6457 lplogfont->lfHeight = atoi (height);
6458
6459 fields--;
6460
6461 if (fields > 0)
6462 lplogfont->lfWidth = atoi (width);
6463
6464 fields--;
6465
fbd6baed 6466 lplogfont->lfWeight = x_to_w32_weight ((fields > 0 ? weight : ""));
5ac45f98
GV		 6467 }
6468
6469 /* This makes TrueType fonts work better. */
6470 lplogfont->lfHeight = - abs (lplogfont->lfHeight);
6fc2811b 6471
ee78dc32
GV		 6472 return (TRUE);
6473}
6474
d88c567c
JR		 6475/* Strip the pixel height and point height from the given xlfd, and
6476 return the pixel height. If no pixel height is specified, calculate
6477 one from the point height, or if that isn't defined either, return
6478 0 (which usually signifies a scalable font).
6479*/
8edb0a6f
JR		 6480static int
6481xlfd_strip_height (char *fontname)
d88c567c 6482{
8edb0a6f 6483 int pixel_height, field_number;
d88c567c
JR		 6484 char *read_from, *write_to;
6485
6486 xassert (fontname);
6487
6488 pixel_height = field_number = 0;
6489 write_to = NULL;
6490
6491 /* Look for height fields. */
6492 for (read_from = fontname; *read_from; read_from++)
6493 {
6494 if (*read_from == '-')
6495 {
6496 field_number++;
6497 if (field_number == 7) /* Pixel height. */
6498 {
6499 read_from++;
6500 write_to = read_from;
6501
6502 /* Find end of field. */
6503 for (;*read_from && *read_from != '-'; read_from++)
6504 ;
6505
6506 /* Split the fontname at end of field. */
6507 if (*read_from)
6508 {
6509 *read_from = '\0';
6510 read_from++;
6511 }
6512 pixel_height = atoi (write_to);
6513 /* Blank out field. */
6514 if (read_from > write_to)
6515 {
6516 *write_to = '-';
6517 write_to++;
6518 }
767b1ff0 6519 /* If the pixel height field is at the end (partial xlfd),
d88c567c
JR		 6520 return now. */
6521 else
6522 return pixel_height;
6523
6524 /* If we got a pixel height, the point height can be
6525 ignored. Just blank it out and break now. */
6526 if (pixel_height)
6527 {
6528 /* Find end of point size field. */
6529 for (; *read_from && *read_from != '-'; read_from++)
6530 ;
6531
6532 if (*read_from)
6533 read_from++;
6534
6535 /* Blank out the point size field. */
6536 if (read_from > write_to)
6537 {
6538 *write_to = '-';
6539 write_to++;
6540 }
6541 else
6542 return pixel_height;
6543
6544 break;
6545 }
6546 /* If the point height is already blank, break now. */
6547 if (*read_from == '-')
6548 {
6549 read_from++;
6550 break;
6551 }
6552 }
6553 else if (field_number == 8)
6554 {
6555 /* If we didn't get a pixel height, try to get the point
6556 height and convert that. */
6557 int point_size;
6558 char *point_size_start = read_from++;
6559
6560 /* Find end of field. */
6561 for (; *read_from && *read_from != '-'; read_from++)
6562 ;
6563
6564 if (*read_from)
6565 {
6566 *read_from = '\0';
6567 read_from++;
6568 }
6569
6570 point_size = atoi (point_size_start);
6571
6572 /* Convert to pixel height. */
6573 pixel_height = point_size
6574 * one_w32_display_info.height_in / 720;
6575
6576 /* Blank out this field and break. */
6577 *write_to = '-';
6578 write_to++;
6579 break;
6580 }
6581 }
6582 }
6583
6584 /* Shift the rest of the font spec into place. */
6585 if (write_to && read_from > write_to)
6586 {
6587 for (; *read_from; read_from++, write_to++)
6588 *write_to = *read_from;
6589 *write_to = '\0';
6590 }
6591
6592 return pixel_height;
6593}
6594
6fc2811b 6595/* Assume parameter 1 is fully qualified, no wildcards. */
8edb0a6f 6596static BOOL
6fc2811b
JR		 6597w32_font_match (fontname, pattern)
6598 char * fontname;
6599 char * pattern;
ee78dc32 6600{
e7c72122 6601 char *regex = alloca (strlen (pattern) * 2 + 3);
d88c567c 6602 char *font_name_copy = alloca (strlen (fontname) + 1);
6fc2811b 6603 char *ptr;
ee78dc32 6604
d88c567c
JR		 6605 /* Copy fontname so we can modify it during comparison. */
6606 strcpy (font_name_copy, fontname);
6607
6fc2811b
JR		 6608 ptr = regex;
6609 *ptr++ = '^';
ee78dc32 6610
6fc2811b
JR		 6611 /* Turn pattern into a regexp and do a regexp match. */
6612 for (; *pattern; pattern++)
6613 {
6614 if (*pattern == '?')
6615 *ptr++ = '.';
6616 else if (*pattern == '*')
6617 {
6618 *ptr++ = '.';
6619 *ptr++ = '*';
6620 }
33d52f9c 6621 else
6fc2811b 6622 *ptr++ = *pattern;
ee78dc32 6623 }
6fc2811b
JR		 6624 *ptr = '$';
6625 *(ptr + 1) = '\0';
6626
d88c567c
JR		 6627 /* Strip out font heights and compare them seperately, since
6628 rounding error can cause mismatches. This also allows a
6629 comparison between a font that declares only a pixel height and a
6630 pattern that declares the point height.
6631 */
6632 {
6633 int font_height, pattern_height;
6634
6635 font_height = xlfd_strip_height (font_name_copy);
6636 pattern_height = xlfd_strip_height (regex);
6637
6638 /* Compare now, and don't bother doing expensive regexp matching
6639 if the heights differ. */
6640 if (font_height && pattern_height && (font_height != pattern_height))
6641 return FALSE;
6642 }
6643
6fc2811b 6644 return (fast_c_string_match_ignore_case (build_string (regex),
d88c567c 6645 font_name_copy) >= 0);
ee78dc32
GV		 6646}
6647
5ca0cd71
GV		 6648/* Callback functions, and a structure holding info they need, for
6649 listing system fonts on W32. We need one set of functions to do the
6650 job properly, but these don't work on NT 3.51 and earlier, so we
6651 have a second set which don't handle character sets properly to
6652 fall back on.
6653
6654 In both cases, there are two passes made. The first pass gets one
6655 font from each family, the second pass lists all the fonts from
6656 each family. */
6657
ee78dc32
GV		 6658typedef struct enumfont_t
6659{
6660 HDC hdc;
6661 int numFonts;
3cb20f4a 6662 LOGFONT logfont;
ee78dc32
GV		 6663 XFontStruct *size_ref;
6664 Lisp_Object *pattern;
ee78dc32
GV		 6665 Lisp_Object *tail;
6666} enumfont_t;
6667
8edb0a6f 6668static int CALLBACK
ee78dc32
GV		 6669enum_font_cb2 (lplf, lptm, FontType, lpef)
6670 ENUMLOGFONT * lplf;
6671 NEWTEXTMETRIC * lptm;
6672 int FontType;
6673 enumfont_t * lpef;
6674{
1edf84e7 6675 if (lplf->elfLogFont.lfStrikeOut || lplf->elfLogFont.lfUnderline)
ee78dc32
GV		 6676 return (1);
6677
4587b026
GV		 6678 /* Check that the character set matches if it was specified */
6679 if (lpef->logfont.lfCharSet != DEFAULT_CHARSET &&
6680 lplf->elfLogFont.lfCharSet != lpef->logfont.lfCharSet)
6681 return (1);
6682
ee78dc32
GV		 6683 {
6684 char buf[100];
4587b026 6685 Lisp_Object width = Qnil;
767b1ff0 6686 char *charset = NULL;
ee78dc32 6687
6fc2811b
JR		 6688 /* Truetype fonts do not report their true metrics until loaded */
6689 if (FontType != RASTER_FONTTYPE)
3cb20f4a 6690 {
6fc2811b
JR		 6691 if (!NILP (*(lpef->pattern)))
6692 {
6693 /* Scalable fonts are as big as you want them to be. */
6694 lplf->elfLogFont.lfHeight = lpef->logfont.lfHeight;
6695 lplf->elfLogFont.lfWidth = lpef->logfont.lfWidth;
6696 width = make_number (lpef->logfont.lfWidth);
6697 }
6698 else
6699 {
6700 lplf->elfLogFont.lfHeight = 0;
6701 lplf->elfLogFont.lfWidth = 0;
6702 }
3cb20f4a 6703 }
6fc2811b 6704
f46e6225
GV		 6705 /* Make sure the height used here is the same as everywhere
6706 else (ie character height, not cell height). */
6fc2811b
JR		 6707 if (lplf->elfLogFont.lfHeight > 0)
6708 {
6709 /* lptm can be trusted for RASTER fonts, but not scalable ones. */
6710 if (FontType == RASTER_FONTTYPE)
6711 lplf->elfLogFont.lfHeight = lptm->tmInternalLeading - lptm->tmHeight;
6712 else
6713 lplf->elfLogFont.lfHeight = -lplf->elfLogFont.lfHeight;
6714 }
4587b026 6715
767b1ff0
JR		 6716 if (!NILP (*(lpef->pattern)))
6717 {
6718 charset = xlfd_charset_of_font (XSTRING(*(lpef->pattern))->data);
6719
6720 /* Ensure that charset is valid for this font. */
6721 if (charset
6722 && (x_to_w32_charset (charset) != lplf->elfLogFont.lfCharSet))
6723 charset = NULL;
6724 }
6725
6726 /* TODO: List all relevant charsets if charset not specified. */
6727 if (!w32_to_x_font (&(lplf->elfLogFont), buf, 100, charset))
33d52f9c 6728 return (0);
ee78dc32 6729
5ca0cd71
GV		 6730 if (NILP (*(lpef->pattern))
6731 || w32_font_match (buf, XSTRING (*(lpef->pattern))->data))
ee78dc32 6732 {
4587b026 6733 *lpef->tail = Fcons (Fcons (build_string (buf), width), Qnil);
8e713be6 6734 lpef->tail = &(XCDR (*lpef->tail));
ee78dc32
GV		 6735 lpef->numFonts++;
6736 }
6737 }
6fc2811b 6738
ee78dc32
GV		 6739 return (1);
6740}
6741
8edb0a6f 6742static int CALLBACK
ee78dc32
GV		 6743enum_font_cb1 (lplf, lptm, FontType, lpef)
6744 ENUMLOGFONT * lplf;
6745 NEWTEXTMETRIC * lptm;
6746 int FontType;
6747 enumfont_t * lpef;
6748{
6749 return EnumFontFamilies (lpef->hdc,
6750 lplf->elfLogFont.lfFaceName,
6751 (FONTENUMPROC) enum_font_cb2,
6752 (LPARAM) lpef);
6753}
6754
6755
8edb0a6f 6756static int CALLBACK
5ca0cd71
GV		 6757enum_fontex_cb2 (lplf, lptm, font_type, lpef)
6758 ENUMLOGFONTEX * lplf;
6759 NEWTEXTMETRICEX * lptm;
6760 int font_type;
6761 enumfont_t * lpef;
6762{
6763 /* We are not interested in the extra info we get back from the 'Ex
6764 version - only the fact that we get character set variations
6765 enumerated seperately. */
6766 return enum_font_cb2 ((ENUMLOGFONT *) lplf, (NEWTEXTMETRIC *) lptm,
6767 font_type, lpef);
6768}
6769
8edb0a6f 6770static int CALLBACK
5ca0cd71
GV		 6771enum_fontex_cb1 (lplf, lptm, font_type, lpef)
6772 ENUMLOGFONTEX * lplf;
6773 NEWTEXTMETRICEX * lptm;
6774 int font_type;
6775 enumfont_t * lpef;
6776{
6777 HMODULE gdi32 = GetModuleHandle ("gdi32.dll");
6778 FARPROC enum_font_families_ex
6779 = GetProcAddress ( gdi32, "EnumFontFamiliesExA");
6780 /* We don't really expect EnumFontFamiliesEx to disappear once we
6781 get here, so don't bother handling it gracefully. */
6782 if (enum_font_families_ex == NULL)
6783 error ("gdi32.dll has disappeared!");
6784 return enum_font_families_ex (lpef->hdc,
6785 &lplf->elfLogFont,
6786 (FONTENUMPROC) enum_fontex_cb2,
6787 (LPARAM) lpef, 0);
6788}
6789
4587b026
GV		 6790/* Interface to fontset handler. (adapted from mw32font.c in Meadow
6791 and xterm.c in Emacs 20.3) */
6792
8edb0a6f 6793static Lisp_Object w32_list_bdf_fonts (Lisp_Object pattern, int max_names)
33d52f9c
GV		 6794{
6795 char *fontname, *ptnstr;
6796 Lisp_Object list, tem, newlist = Qnil;
55dcfc15 6797 int n_fonts = 0;
33d52f9c
GV		 6798
6799 list = Vw32_bdf_filename_alist;
6800 ptnstr = XSTRING (pattern)->data;
6801
8e713be6 6802 for ( ; CONSP (list); list = XCDR (list))
33d52f9c 6803 {
8e713be6 6804 tem = XCAR (list);
33d52f9c 6805 if (CONSP (tem))
8e713be6 6806 fontname = XSTRING (XCAR (tem))->data;
33d52f9c
GV		 6807 else if (STRINGP (tem))
6808 fontname = XSTRING (tem)->data;
6809 else
6810 continue;
6811
6812 if (w32_font_match (fontname, ptnstr))
5ca0cd71 6813 {
8e713be6 6814 newlist = Fcons (XCAR (tem), newlist);
5ca0cd71
GV		 6815 n_fonts++;
6816 if (n_fonts >= max_names)
6817 break;
6818 }
33d52f9c
GV		 6819 }
6820
6821 return newlist;
6822}
6823
8edb0a6f
JR		 6824static Lisp_Object w32_list_synthesized_fonts (FRAME_PTR f,
6825 Lisp_Object pattern,
6826 int size, int max_names);
5ca0cd71 6827
4587b026
GV		 6828/* Return a list of names of available fonts matching PATTERN on frame
6829 F. If SIZE is not 0, it is the size (maximum bound width) of fonts
6830 to be listed. Frame F NULL means we have not yet created any
6831 frame, which means we can't get proper size info, as we don't have
6832 a device context to use for GetTextMetrics.
6833 MAXNAMES sets a limit on how many fonts to match. */
6834
6835Lisp_Object
dc220243
JR		 6836w32_list_fonts (f, pattern, size, maxnames)
6837 struct frame *f;
6838 Lisp_Object pattern;
6839 int size;
6840 int maxnames;
4587b026 6841{
6fc2811b 6842 Lisp_Object patterns, key = Qnil, tem, tpat;
4587b026 6843 Lisp_Object list = Qnil, newlist = Qnil, second_best = Qnil;
33d52f9c 6844 struct w32_display_info *dpyinfo = &one_w32_display_info;
5ca0cd71 6845 int n_fonts = 0;
396594fe 6846
4587b026
GV		 6847 patterns = Fassoc (pattern, Valternate_fontname_alist);
6848 if (NILP (patterns))
6849 patterns = Fcons (pattern, Qnil);
6850
8e713be6 6851 for (; CONSP (patterns); patterns = XCDR (patterns))
4587b026
GV		 6852 {
6853 enumfont_t ef;
767b1ff0 6854 int codepage;
4587b026 6855
8e713be6 6856 tpat = XCAR (patterns);
4587b026 6857
767b1ff0
JR		 6858 if (!STRINGP (tpat))
6859 continue;
6860
6861 /* Avoid expensive EnumFontFamilies functions if we are not
6862 going to be able to output one of these anyway. */
6863 codepage = w32_codepage_for_font (XSTRING (tpat)->data);
6864 if (codepage != CP_8BIT && codepage != CP_UNICODE
ceb12877
AI		 6865 && codepage != CP_DEFAULT && codepage != CP_UNKNOWN
6866 && !IsValidCodePage(codepage))
767b1ff0
JR		 6867 continue;
6868
4587b026
GV		 6869 /* See if we cached the result for this particular query.
6870 The cache is an alist of the form:
6871 ((PATTERN (FONTNAME . WIDTH) ...) ...)
6872 */
8e713be6 6873 if (tem = XCDR (dpyinfo->name_list_element),
33d52f9c 6874 !NILP (list = Fassoc (tpat, tem)))
4587b026
GV		 6875 {
6876 list = Fcdr_safe (list);
6877 /* We have a cached list. Don't have to get the list again. */
6878 goto label_cached;
6879 }
6880
6881 BLOCK_INPUT;
6882 /* At first, put PATTERN in the cache. */
6883 list = Qnil;
33d52f9c
GV		 6884 ef.pattern = &tpat;
6885 ef.tail = &list;
4587b026 6886 ef.numFonts = 0;
33d52f9c 6887
5ca0cd71
GV		 6888 /* Use EnumFontFamiliesEx where it is available, as it knows
6889 about character sets. Fall back to EnumFontFamilies for
6890 older versions of NT that don't support the 'Ex function. */
767b1ff0 6891 x_to_w32_font (XSTRING (tpat)->data, &ef.logfont);
4587b026 6892 {
5ca0cd71
GV		 6893 LOGFONT font_match_pattern;
6894 HMODULE gdi32 = GetModuleHandle ("gdi32.dll");
6895 FARPROC enum_font_families_ex
6896 = GetProcAddress ( gdi32, "EnumFontFamiliesExA");
6897
6898 /* We do our own pattern matching so we can handle wildcards. */
6899 font_match_pattern.lfFaceName[0] = 0;
6900 font_match_pattern.lfPitchAndFamily = 0;
6901 /* We can use the charset, because if it is a wildcard it will
6902 be DEFAULT_CHARSET anyway. */
6903 font_match_pattern.lfCharSet = ef.logfont.lfCharSet;
6904
33d52f9c 6905 ef.hdc = GetDC (dpyinfo->root_window);
4587b026 6906
5ca0cd71
GV		 6907 if (enum_font_families_ex)
6908 enum_font_families_ex (ef.hdc,
6909 &font_match_pattern,
6910 (FONTENUMPROC) enum_fontex_cb1,
6911 (LPARAM) &ef, 0);
6912 else
6913 EnumFontFamilies (ef.hdc, NULL, (FONTENUMPROC) enum_font_cb1,
6914 (LPARAM)&ef);
4587b026 6915
33d52f9c 6916 ReleaseDC (dpyinfo->root_window, ef.hdc);
4587b026
GV		 6917 }
6918
6919 UNBLOCK_INPUT;
6920
6921 /* Make a list of the fonts we got back.
6922 Store that in the font cache for the display. */
f3fbd155
KR		 6923 XSETCDR (dpyinfo->name_list_element,
6924 Fcons (Fcons (tpat, list),
6925 XCDR (dpyinfo->name_list_element)));
4587b026
GV		 6926
6927 label_cached:
6928 if (NILP (list)) continue; /* Try the remaining alternatives. */
6929
6930 newlist = second_best = Qnil;
6931
6932 /* Make a list of the fonts that have the right width. */
8e713be6 6933 for (; CONSP (list); list = XCDR (list))
4587b026
GV		 6934 {
6935 int found_size;
8e713be6 6936 tem = XCAR (list);
4587b026
GV		 6937
6938 if (!CONSP (tem))
6939 continue;
8e713be6 6940 if (NILP (XCAR (tem)))
4587b026
GV		 6941 continue;
6942 if (!size)
6943 {
8e713be6 6944 newlist = Fcons (XCAR (tem), newlist);
5ca0cd71
GV		 6945 n_fonts++;
6946 if (n_fonts >= maxnames)
6947 break;
6948 else
6949 continue;
4587b026 6950 }
8e713be6 6951 if (!INTEGERP (XCDR (tem)))
4587b026
GV		 6952 {
6953 /* Since we don't yet know the size of the font, we must
6954 load it and try GetTextMetrics. */
4587b026
GV		 6955 W32FontStruct thisinfo;
6956 LOGFONT lf;
6957 HDC hdc;
6958 HANDLE oldobj;
6959
8e713be6 6960 if (!x_to_w32_font (XSTRING (XCAR (tem))->data, &lf))
4587b026
GV		 6961 continue;
6962
6963 BLOCK_INPUT;
33d52f9c 6964 thisinfo.bdf = NULL;
4587b026
GV		 6965 thisinfo.hfont = CreateFontIndirect (&lf);
6966 if (thisinfo.hfont == NULL)
6967 continue;
6968
6969 hdc = GetDC (dpyinfo->root_window);
6970 oldobj = SelectObject (hdc, thisinfo.hfont);
6971 if (GetTextMetrics (hdc, &thisinfo.tm))
f3fbd155 6972 XSETCDR (tem, make_number (FONT_WIDTH (&thisinfo)));
4587b026 6973 else
f3fbd155 6974 XSETCDR (tem, make_number (0));
4587b026
GV		 6975 SelectObject (hdc, oldobj);
6976 ReleaseDC (dpyinfo->root_window, hdc);
6977 DeleteObject(thisinfo.hfont);
6978 UNBLOCK_INPUT;
6979 }
8e713be6 6980 found_size = XINT (XCDR (tem));
4587b026 6981 if (found_size == size)
5ca0cd71 6982 {
8e713be6 6983 newlist = Fcons (XCAR (tem), newlist);
5ca0cd71
GV		 6984 n_fonts++;
6985 if (n_fonts >= maxnames)
6986 break;
6987 }
4587b026
GV		 6988 /* keep track of the closest matching size in case
6989 no exact match is found. */
6990 else if (found_size > 0)
6991 {
6992 if (NILP (second_best))
6993 second_best = tem;
5ca0cd71 6994
4587b026
GV		 6995 else if (found_size < size)
6996 {
8e713be6
KR		 6997 if (XINT (XCDR (second_best)) > size
6998 || XINT (XCDR (second_best)) < found_size)
4587b026
GV		 6999 second_best = tem;
7000 }
7001 else
7002 {
8e713be6
KR		 7003 if (XINT (XCDR (second_best)) > size
7004 && XINT (XCDR (second_best)) >
4587b026
GV		 7005 found_size)
7006 second_best = tem;
7007 }
7008 }
7009 }
7010
7011 if (!NILP (newlist))
7012 break;
7013 else if (!NILP (second_best))
7014 {
8e713be6 7015 newlist = Fcons (XCAR (second_best), Qnil);
4587b026
GV		 7016 break;
7017 }
7018 }
7019
33d52f9c 7020 /* Include any bdf fonts. */
5ca0cd71 7021 if (n_fonts < maxnames)
33d52f9c
GV		 7022 {
7023 Lisp_Object combined[2];
5ca0cd71 7024 combined[0] = w32_list_bdf_fonts (pattern, maxnames - n_fonts);
33d52f9c
GV		 7025 combined[1] = newlist;
7026 newlist = Fnconc(2, combined);
7027 }
7028
5ca0cd71
GV		 7029 /* If we can't find a font that matches, check if Windows would be
7030 able to synthesize it from a different style. */
6fc2811b 7031 if (NILP (newlist) && !NILP (Vw32_enable_synthesized_fonts))
5ca0cd71
GV		 7032 newlist = w32_list_synthesized_fonts (f, pattern, size, maxnames);
7033
4587b026
GV		 7034 return newlist;
7035}
7036
8edb0a6f 7037static Lisp_Object
5ca0cd71
GV		 7038w32_list_synthesized_fonts (f, pattern, size, max_names)
7039 FRAME_PTR f;
7040 Lisp_Object pattern;
7041 int size;
7042 int max_names;
7043{
7044 int fields;
7045 char *full_pattn, *new_pattn, foundary[50], family[50], *pattn_part2;
7046 char style[20], slant;
8edb0a6f 7047 Lisp_Object matches, tem, synthed_matches = Qnil;
5ca0cd71
GV		 7048
7049 full_pattn = XSTRING (pattern)->data;
7050
8b77111c 7051 pattn_part2 = alloca (XSTRING (pattern)->size + 1);
5ca0cd71
GV		 7052 /* Allow some space for wildcard expansion. */
7053 new_pattn = alloca (XSTRING (pattern)->size + 100);
7054
7055 fields = sscanf (full_pattn, "-%49[^-]-%49[^-]-%19[^-]-%c-%s",
7056 foundary, family, style, &slant, pattn_part2);
7057 if (fields == EOF || fields < 5)
7058 return Qnil;
7059
7060 /* If the style and slant are wildcards already there is no point
7061 checking again (and we don't want to keep recursing). */
7062 if (*style == '*' && slant == '*')
7063 return Qnil;
7064
7065 sprintf (new_pattn, "-%s-%s-*-*-%s", foundary, family, pattn_part2);
7066
7067 matches = w32_list_fonts (f, build_string (new_pattn), size, max_names);
7068
8e713be6 7069 for ( ; CONSP (matches); matches = XCDR (matches))
5ca0cd71 7070 {
8e713be6 7071 tem = XCAR (matches);
5ca0cd71
GV		 7072 if (!STRINGP (tem))
7073 continue;
7074
7075 full_pattn = XSTRING (tem)->data;
7076 fields = sscanf (full_pattn, "-%49[^-]-%49[^-]-%*[^-]-%*c-%s",
7077 foundary, family, pattn_part2);
7078 if (fields == EOF || fields < 3)
7079 continue;
7080
7081 sprintf (new_pattn, "-%s-%s-%s-%c-%s", foundary, family, style,
7082 slant, pattn_part2);
7083
7084 synthed_matches = Fcons (build_string (new_pattn),
7085 synthed_matches);
7086 }
7087
7088 return synthed_matches;
7089}
7090
7091
4587b026
GV		 7092/* Return a pointer to struct font_info of font FONT_IDX of frame F. */
7093struct font_info *
7094w32_get_font_info (f, font_idx)
7095 FRAME_PTR f;
7096 int font_idx;
7097{
7098 return (FRAME_W32_FONT_TABLE (f) + font_idx);
7099}
7100
7101
7102struct font_info*
7103w32_query_font (struct frame *f, char *fontname)
7104{
7105 int i;
7106 struct font_info *pfi;
7107
7108 pfi = FRAME_W32_FONT_TABLE (f);
7109
7110 for (i = 0; i < one_w32_display_info.n_fonts ;i++, pfi++)
7111 {
7112 if (strcmp(pfi->name, fontname) == 0) return pfi;
7113 }
7114
7115 return NULL;
7116}
7117
7118/* Find a CCL program for a font specified by FONTP, and set the member
7119 `encoder' of the structure. */
7120
7121void
7122w32_find_ccl_program (fontp)
7123 struct font_info *fontp;
7124{
3545439c 7125 Lisp_Object list, elt;
4587b026 7126
8e713be6 7127 for (list = Vfont_ccl_encoder_alist; CONSP (list); list = XCDR (list))
4587b026 7128 {
8e713be6 7129 elt = XCAR (list);
4587b026 7130 if (CONSP (elt)
8e713be6
KR		 7131 && STRINGP (XCAR (elt))
7132 && (fast_c_string_match_ignore_case (XCAR (elt), fontp->name)
4587b026 7133 >= 0))
3545439c
KH		 7134 break;
7135 }
7136 if (! NILP (list))
7137 {
17eedd00
KH		 7138 struct ccl_program *ccl
7139 = (struct ccl_program *) xmalloc (sizeof (struct ccl_program));
3545439c 7140
8e713be6 7141 if (setup_ccl_program (ccl, XCDR (elt)) < 0)
3545439c
KH		 7142 xfree (ccl);
7143 else
7144 fontp->font_encoder = ccl;
4587b026
GV		 7145 }
7146}
7147
7148\f
8edb0a6f
JR		 7149/* Find BDF files in a specified directory. (use GCPRO when calling,
7150 as this calls lisp to get a directory listing). */
7151static Lisp_Object
7152w32_find_bdf_fonts_in_dir (Lisp_Object directory)
7153{
7154 Lisp_Object filelist, list = Qnil;
7155 char fontname[100];
7156
7157 if (!STRINGP(directory))
7158 return Qnil;
7159
7160 filelist = Fdirectory_files (directory, Qt,
7161 build_string (".*\\.[bB][dD][fF]"), Qt);
7162
7163 for ( ; CONSP(filelist); filelist = XCDR (filelist))
7164 {
7165 Lisp_Object filename = XCAR (filelist);
7166 if (w32_BDF_to_x_font (XSTRING (filename)->data, fontname, 100))
7167 store_in_alist (&list, build_string (fontname), filename);
7168 }
7169 return list;
7170}
7171
6fc2811b
JR		 7172DEFUN ("w32-find-bdf-fonts", Fw32_find_bdf_fonts, Sw32_find_bdf_fonts,
7173 1, 1, 0,
7174 "Return a list of BDF fonts in DIR, suitable for appending to\n\
767b1ff0 7175w32-bdf-filename-alist. Fonts which do not contain an xlfd description\n\
6fc2811b
JR		 7176will not be included in the list. DIR may be a list of directories.")
7177 (directory)
7178 Lisp_Object directory;
7179{
7180 Lisp_Object list = Qnil;
7181 struct gcpro gcpro1, gcpro2;
ee78dc32 7182
6fc2811b
JR		 7183 if (!CONSP (directory))
7184 return w32_find_bdf_fonts_in_dir (directory);
ee78dc32 7185
6fc2811b 7186 for ( ; CONSP (directory); directory = XCDR (directory))
ee78dc32 7187 {
6fc2811b
JR		 7188 Lisp_Object pair[2];
7189 pair[0] = list;
7190 pair[1] = Qnil;
7191 GCPRO2 (directory, list);
7192 pair[1] = w32_find_bdf_fonts_in_dir( XCAR (directory) );
7193 list = Fnconc( 2, pair );
7194 UNGCPRO;
7195 }
7196 return list;
7197}
ee78dc32 7198
6fc2811b
JR		 7199\f
7200DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0,
dfff8a69 7201 "Internal function called by `color-defined-p', which see.")
6fc2811b
JR		 7202 (color, frame)
7203 Lisp_Object color, frame;
7204{
7205 XColor foo;
7206 FRAME_PTR f = check_x_frame (frame);
ee78dc32 7207
6fc2811b 7208 CHECK_STRING (color, 1);
ee78dc32 7209
6fc2811b
JR		 7210 if (w32_defined_color (f, XSTRING (color)->data, &foo, 0))
7211 return Qt;
7212 else
7213 return Qnil;
7214}
ee78dc32 7215
2d764c78 7216DEFUN ("xw-color-values", Fxw_color_values, Sxw_color_values, 1, 2, 0,
dfff8a69 7217 "Internal function called by `color-values', which see.")
ee78dc32
GV		 7218 (color, frame)
7219 Lisp_Object color, frame;
7220{
6fc2811b 7221 XColor foo;
ee78dc32
GV		 7222 FRAME_PTR f = check_x_frame (frame);
7223
7224 CHECK_STRING (color, 1);
7225
6fc2811b 7226 if (w32_defined_color (f, XSTRING (color)->data, &foo, 0))
ee78dc32
GV		 7227 {
7228 Lisp_Object rgb[3];
7229
6fc2811b
JR		 7230 rgb[0] = make_number ((GetRValue (foo.pixel) << 8)
7231 | GetRValue (foo.pixel));
7232 rgb[1] = make_number ((GetGValue (foo.pixel) << 8)
7233 | GetGValue (foo.pixel));
7234 rgb[2] = make_number ((GetBValue (foo.pixel) << 8)
7235 | GetBValue (foo.pixel));
ee78dc32
GV		 7236 return Flist (3, rgb);
7237 }
7238 else
7239 return Qnil;
7240}
7241
2d764c78 7242DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0,
dfff8a69 7243 "Internal function called by `display-color-p', which see.")
ee78dc32
GV		 7244 (display)
7245 Lisp_Object display;
7246{
fbd6baed 7247 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV		 7248
7249 if ((dpyinfo->n_planes * dpyinfo->n_cbits) <= 2)
7250 return Qnil;
7251
7252 return Qt;
7253}
7254
7255DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p, Sx_display_grayscale_p,
7256 0, 1, 0,
7257 "Return t if the X display supports shades of gray.\n\
7258Note that color displays do support shades of gray.\n\
7259The optional argument DISPLAY specifies which display to ask about.\n\
7260DISPLAY should be either a frame or a display name (a string).\n\
7261If omitted or nil, that stands for the selected frame's display.")
7262 (display)
7263 Lisp_Object display;
7264{
fbd6baed 7265 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV		 7266
7267 if ((dpyinfo->n_planes * dpyinfo->n_cbits) <= 1)
7268 return Qnil;
7269
7270 return Qt;
7271}
7272
7273DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width,
7274 0, 1, 0,
7275 "Returns the width in pixels of the X display DISPLAY.\n\
7276The optional argument DISPLAY specifies which display to ask about.\n\
7277DISPLAY should be either a frame or a display name (a string).\n\
7278If omitted or nil, that stands for the selected frame's display.")
7279 (display)
7280 Lisp_Object display;
7281{
fbd6baed 7282 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV		 7283
7284 return make_number (dpyinfo->width);
7285}
7286
7287DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
7288 Sx_display_pixel_height, 0, 1, 0,
7289 "Returns the height in pixels of the X display DISPLAY.\n\
7290The optional argument DISPLAY specifies which display to ask about.\n\
7291DISPLAY should be either a frame or a display name (a string).\n\
7292If omitted or nil, that stands for the selected frame's display.")
7293 (display)
7294 Lisp_Object display;
7295{
fbd6baed 7296 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV		 7297
7298 return make_number (dpyinfo->height);
7299}
7300
7301DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
7302 0, 1, 0,
7303 "Returns the number of bitplanes of the display DISPLAY.\n\
7304The optional argument DISPLAY specifies which display to ask about.\n\
7305DISPLAY should be either a frame or a display name (a string).\n\
7306If omitted or nil, that stands for the selected frame's display.")
7307 (display)
7308 Lisp_Object display;
7309{
fbd6baed 7310 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV		 7311
7312 return make_number (dpyinfo->n_planes * dpyinfo->n_cbits);
7313}
7314
7315DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
7316 0, 1, 0,
7317 "Returns the number of color cells of the display DISPLAY.\n\
7318The optional argument DISPLAY specifies which display to ask about.\n\
7319DISPLAY should be either a frame or a display name (a string).\n\
7320If omitted or nil, that stands for the selected frame's display.")
7321 (display)
7322 Lisp_Object display;
7323{
fbd6baed 7324 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV		 7325 HDC hdc;
7326 int cap;
7327
5ac45f98
GV		 7328 hdc = GetDC (dpyinfo->root_window);
7329 if (dpyinfo->has_palette)
7330 cap = GetDeviceCaps (hdc,SIZEPALETTE);
7331 else
7332 cap = GetDeviceCaps (hdc,NUMCOLORS);
abf8c61b
AI		 7333
7334 if (cap < 0)
7335 cap = 1 << (dpyinfo->n_planes * dpyinfo->n_cbits);
ee78dc32
GV		 7336
7337 ReleaseDC (dpyinfo->root_window, hdc);
7338
7339 return make_number (cap);
7340}
7341
7342DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
7343 Sx_server_max_request_size,
7344 0, 1, 0,
7345 "Returns the maximum request size of the server of display DISPLAY.\n\
7346The optional argument DISPLAY specifies which display to ask about.\n\
7347DISPLAY should be either a frame or a display name (a string).\n\
7348If omitted or nil, that stands for the selected frame's display.")
7349 (display)
7350 Lisp_Object display;
7351{
fbd6baed 7352 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV		 7353
7354 return make_number (1);
7355}
7356
7357DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
fbd6baed 7358 "Returns the vendor ID string of the W32 system (Microsoft).\n\
ee78dc32
GV		 7359The optional argument DISPLAY specifies which display to ask about.\n\
7360DISPLAY should be either a frame or a display name (a string).\n\
7361If omitted or nil, that stands for the selected frame's display.")
7362 (display)
7363 Lisp_Object display;
7364{
dfff8a69 7365 return build_string ("Microsoft Corp.");
ee78dc32
GV		 7366}
7367
7368DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
7369 "Returns the version numbers of the server of display DISPLAY.\n\
7370The value is a list of three integers: the major and minor\n\
7371version numbers, and the vendor-specific release\n\
7372number. See also the function `x-server-vendor'.\n\n\
7373The optional argument DISPLAY specifies which display to ask about.\n\
7374DISPLAY should be either a frame or a display name (a string).\n\
7375If omitted or nil, that stands for the selected frame's display.")
7376 (display)
7377 Lisp_Object display;
7378{
fbd6baed 7379 return Fcons (make_number (w32_major_version),
58e0f0e4
AI		 7380 Fcons (make_number (w32_minor_version),
7381 Fcons (make_number (w32_build_number), Qnil)));
ee78dc32
GV		 7382}
7383
7384DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
7385 "Returns the number of screens on the server of display DISPLAY.\n\
7386The optional argument DISPLAY specifies which display to ask about.\n\
7387DISPLAY should be either a frame or a display name (a string).\n\
7388If omitted or nil, that stands for the selected frame's display.")
7389 (display)
7390 Lisp_Object display;
7391{
ee78dc32
GV		 7392 return make_number (1);
7393}
7394
7395DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, 0,
7396 "Returns the height in millimeters of the X display DISPLAY.\n\
7397The optional argument DISPLAY specifies which display to ask about.\n\
7398DISPLAY should be either a frame or a display name (a string).\n\
7399If omitted or nil, that stands for the selected frame's display.")
7400 (display)
7401 Lisp_Object display;
7402{
fbd6baed 7403 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV		 7404 HDC hdc;
7405 int cap;
7406
5ac45f98 7407 hdc = GetDC (dpyinfo->root_window);
3c190163 7408
ee78dc32 7409 cap = GetDeviceCaps (hdc, VERTSIZE);
3c190163 7410
ee78dc32
GV		 7411 ReleaseDC (dpyinfo->root_window, hdc);
7412
7413 return make_number (cap);
7414}
7415
7416DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
7417 "Returns the width in millimeters of the X display DISPLAY.\n\
7418The optional argument DISPLAY specifies which display to ask about.\n\
7419DISPLAY should be either a frame or a display name (a string).\n\
7420If omitted or nil, that stands for the selected frame's display.")
7421 (display)
7422 Lisp_Object display;
7423{
fbd6baed 7424 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV		 7425
7426 HDC hdc;
7427 int cap;
7428
5ac45f98 7429 hdc = GetDC (dpyinfo->root_window);
3c190163 7430
ee78dc32 7431 cap = GetDeviceCaps (hdc, HORZSIZE);
3c190163 7432
ee78dc32
GV		 7433 ReleaseDC (dpyinfo->root_window, hdc);
7434
7435 return make_number (cap);
7436}
7437
7438DEFUN ("x-display-backing-store", Fx_display_backing_store,
7439 Sx_display_backing_store, 0, 1, 0,
7440 "Returns an indication of whether display DISPLAY does backing store.\n\
7441The value may be `always', `when-mapped', or `not-useful'.\n\
7442The optional argument DISPLAY specifies which display to ask about.\n\
7443DISPLAY should be either a frame or a display name (a string).\n\
7444If omitted or nil, that stands for the selected frame's display.")
7445 (display)
7446 Lisp_Object display;
7447{
7448 return intern ("not-useful");
7449}
7450
7451DEFUN ("x-display-visual-class", Fx_display_visual_class,
7452 Sx_display_visual_class, 0, 1, 0,
7453 "Returns the visual class of the display DISPLAY.\n\
7454The value is one of the symbols `static-gray', `gray-scale',\n\
7455`static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
7456The optional argument DISPLAY specifies which display to ask about.\n\
7457DISPLAY should be either a frame or a display name (a string).\n\
7458If omitted or nil, that stands for the selected frame's display.")
7459 (display)
7460 Lisp_Object display;
7461{
fbd6baed 7462 struct w32_display_info *dpyinfo = check_x_display_info (display);
abf8c61b 7463 Lisp_Object result = Qnil;
ee78dc32 7464
abf8c61b
AI		 7465 if (dpyinfo->has_palette)
7466 result = intern ("pseudo-color");
7467 else if (dpyinfo->n_planes * dpyinfo->n_cbits == 1)
7468 result = intern ("static-grey");
7469 else if (dpyinfo->n_planes * dpyinfo->n_cbits == 4)
7470 result = intern ("static-color");
7471 else if (dpyinfo->n_planes * dpyinfo->n_cbits > 8)
7472 result = intern ("true-color");
ee78dc32 7473
abf8c61b 7474 return result;
ee78dc32
GV		 7475}
7476
7477DEFUN ("x-display-save-under", Fx_display_save_under,
7478 Sx_display_save_under, 0, 1, 0,
7479 "Returns t if the display DISPLAY supports the save-under feature.\n\
7480The optional argument DISPLAY specifies which display to ask about.\n\
7481DISPLAY should be either a frame or a display name (a string).\n\
7482If omitted or nil, that stands for the selected frame's display.")
7483 (display)
7484 Lisp_Object display;
7485{
6fc2811b
JR		 7486 return Qnil;
7487}
7488\f
7489int
7490x_pixel_width (f)
7491 register struct frame *f;
7492{
7493 return PIXEL_WIDTH (f);
7494}
7495
7496int
7497x_pixel_height (f)
7498 register struct frame *f;
7499{
7500 return PIXEL_HEIGHT (f);
7501}
7502
7503int
7504x_char_width (f)
7505 register struct frame *f;
7506{
7507 return FONT_WIDTH (f->output_data.w32->font);
7508}
7509
7510int
7511x_char_height (f)
7512 register struct frame *f;
7513{
7514 return f->output_data.w32->line_height;
7515}
7516
7517int
7518x_screen_planes (f)
7519 register struct frame *f;
7520{
7521 return FRAME_W32_DISPLAY_INFO (f)->n_planes;
7522}
7523\f
7524/* Return the display structure for the display named NAME.
7525 Open a new connection if necessary. */
7526
7527struct w32_display_info *
7528x_display_info_for_name (name)
7529 Lisp_Object name;
7530{
7531 Lisp_Object names;
7532 struct w32_display_info *dpyinfo;
7533
7534 CHECK_STRING (name, 0);
7535
7536 for (dpyinfo = &one_w32_display_info, names = w32_display_name_list;
7537 dpyinfo;
7538 dpyinfo = dpyinfo->next, names = XCDR (names))
7539 {
7540 Lisp_Object tem;
7541 tem = Fstring_equal (XCAR (XCAR (names)), name);
7542 if (!NILP (tem))
7543 return dpyinfo;
7544 }
7545
7546 /* Use this general default value to start with. */
7547 Vx_resource_name = Vinvocation_name;
7548
7549 validate_x_resource_name ();
7550
7551 dpyinfo = w32_term_init (name, (unsigned char *)0,
7552 (char *) XSTRING (Vx_resource_name)->data);
7553
7554 if (dpyinfo == 0)
7555 error ("Cannot connect to server %s", XSTRING (name)->data);
7556
7557 w32_in_use = 1;
7558 XSETFASTINT (Vwindow_system_version, 3);
7559
7560 return dpyinfo;
7561}
7562
7563DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
7564 1, 3, 0, "Open a connection to a server.\n\
7565DISPLAY is the name of the display to connect to.\n\
7566Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
7567If the optional third arg MUST-SUCCEED is non-nil,\n\
7568terminate Emacs if we can't open the connection.")
7569 (display, xrm_string, must_succeed)
7570 Lisp_Object display, xrm_string, must_succeed;
7571{
7572 unsigned char *xrm_option;
7573 struct w32_display_info *dpyinfo;
7574
7575 CHECK_STRING (display, 0);
7576 if (! NILP (xrm_string))
7577 CHECK_STRING (xrm_string, 1);
7578
7579 if (! EQ (Vwindow_system, intern ("w32")))
7580 error ("Not using Microsoft Windows");
7581
7582 /* Allow color mapping to be defined externally; first look in user's
7583 HOME directory, then in Emacs etc dir for a file called rgb.txt. */
7584 {
7585 Lisp_Object color_file;
7586 struct gcpro gcpro1;
7587
7588 color_file = build_string("~/rgb.txt");
7589
7590 GCPRO1 (color_file);
7591
7592 if (NILP (Ffile_readable_p (color_file)))
7593 color_file =
7594 Fexpand_file_name (build_string ("rgb.txt"),
7595 Fsymbol_value (intern ("data-directory")));
7596
7597 Vw32_color_map = Fw32_load_color_file (color_file);
7598
7599 UNGCPRO;
7600 }
7601 if (NILP (Vw32_color_map))
7602 Vw32_color_map = Fw32_default_color_map ();
7603
7604 if (! NILP (xrm_string))
7605 xrm_option = (unsigned char *) XSTRING (xrm_string)->data;
7606 else
7607 xrm_option = (unsigned char *) 0;
7608
7609 /* Use this general default value to start with. */
7610 /* First remove .exe suffix from invocation-name - it looks ugly. */
7611 {
7612 char basename[ MAX_PATH ], *str;
7613
7614 strcpy (basename, XSTRING (Vinvocation_name)->data);
7615 str = strrchr (basename, '.');
7616 if (str) *str = 0;
7617 Vinvocation_name = build_string (basename);
7618 }
7619 Vx_resource_name = Vinvocation_name;
7620
7621 validate_x_resource_name ();
7622
7623 /* This is what opens the connection and sets x_current_display.
7624 This also initializes many symbols, such as those used for input. */
7625 dpyinfo = w32_term_init (display, xrm_option,
7626 (char *) XSTRING (Vx_resource_name)->data);
7627
7628 if (dpyinfo == 0)
7629 {
7630 if (!NILP (must_succeed))
7631 fatal ("Cannot connect to server %s.\n",
7632 XSTRING (display)->data);
7633 else
7634 error ("Cannot connect to server %s", XSTRING (display)->data);
7635 }
7636
7637 w32_in_use = 1;
7638
7639 XSETFASTINT (Vwindow_system_version, 3);
7640 return Qnil;
7641}
7642
7643DEFUN ("x-close-connection", Fx_close_connection,
7644 Sx_close_connection, 1, 1, 0,
7645 "Close the connection to DISPLAY's server.\n\
7646For DISPLAY, specify either a frame or a display name (a string).\n\
7647If DISPLAY is nil, that stands for the selected frame's display.")
7648 (display)
7649 Lisp_Object display;
7650{
7651 struct w32_display_info *dpyinfo = check_x_display_info (display);
7652 int i;
7653
7654 if (dpyinfo->reference_count > 0)
7655 error ("Display still has frames on it");
7656
7657 BLOCK_INPUT;
7658 /* Free the fonts in the font table. */
7659 for (i = 0; i < dpyinfo->n_fonts; i++)
7660 if (dpyinfo->font_table[i].name)
7661 {
126f2e35
JR		 7662 if (dpyinfo->font_table[i].name != dpyinfo->font_table[i].full_name)
7663 xfree (dpyinfo->font_table[i].full_name);
6fc2811b 7664 xfree (dpyinfo->font_table[i].name);
6fc2811b
JR		 7665 w32_unload_font (dpyinfo, dpyinfo->font_table[i].font);
7666 }
7667 x_destroy_all_bitmaps (dpyinfo);
7668
7669 x_delete_display (dpyinfo);
7670 UNBLOCK_INPUT;
7671
7672 return Qnil;
7673}
7674
7675DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0,
7676 "Return the list of display names that Emacs has connections to.")
7677 ()
7678{
7679 Lisp_Object tail, result;
7680
7681 result = Qnil;
7682 for (tail = w32_display_name_list; ! NILP (tail); tail = XCDR (tail))
7683 result = Fcons (XCAR (XCAR (tail)), result);
7684
7685 return result;
7686}
7687
7688DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize, 1, 2, 0,
7689 "If ON is non-nil, report errors as soon as the erring request is made.\n\
7690If ON is nil, allow buffering of requests.\n\
7691This is a noop on W32 systems.\n\
7692The optional second argument DISPLAY specifies which display to act on.\n\
7693DISPLAY should be either a frame or a display name (a string).\n\
7694If DISPLAY is omitted or nil, that stands for the selected frame's display.")
7695 (on, display)
7696 Lisp_Object display, on;
7697{
6fc2811b
JR		 7698 return Qnil;
7699}
7700
7701\f
7702\f
7703/***********************************************************************
7704 Image types
7705 ***********************************************************************/
7706
7707/* Value is the number of elements of vector VECTOR. */
7708
7709#define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
7710
7711/* List of supported image types. Use define_image_type to add new
7712 types. Use lookup_image_type to find a type for a given symbol. */
7713
7714static struct image_type *image_types;
7715
6fc2811b
JR		 7716/* The symbol `image' which is the car of the lists used to represent
7717 images in Lisp. */
7718
7719extern Lisp_Object Qimage;
7720
7721/* The symbol `xbm' which is used as the type symbol for XBM images. */
7722
7723Lisp_Object Qxbm;
7724
7725/* Keywords. */
7726
6fc2811b 7727extern Lisp_Object QCwidth, QCheight, QCforeground, QCbackground, QCfile;
dfff8a69
JR		 7728extern Lisp_Object QCdata;
7729Lisp_Object QCtype, QCascent, QCmargin, QCrelief;
a93f4566 7730Lisp_Object QCconversion, QCcolor_symbols, QCheuristic_mask;
3cf3436e 7731Lisp_Object QCindex, QCmatrix, QCcolor_adjustment, QCmask;
6fc2811b
JR		 7732
7733/* Other symbols. */
7734
3cf3436e 7735Lisp_Object Qlaplace, Qemboss, Qedge_detection, Qheuristic;
6fc2811b
JR		 7736
7737/* Time in seconds after which images should be removed from the cache
7738 if not displayed. */
7739
7740Lisp_Object Vimage_cache_eviction_delay;
7741
7742/* Function prototypes. */
7743
7744static void define_image_type P_ ((struct image_type *type));
7745static struct image_type *lookup_image_type P_ ((Lisp_Object symbol));
7746static void image_error P_ ((char *format, Lisp_Object, Lisp_Object));
7747static void x_laplace P_ ((struct frame *, struct image *));
3cf3436e 7748static void x_emboss P_ ((struct frame *, struct image *));
6fc2811b
JR		 7749static int x_build_heuristic_mask P_ ((struct frame *, struct image *,
7750 Lisp_Object));
7751
dfff8a69 7752
6fc2811b
JR		 7753/* Define a new image type from TYPE. This adds a copy of TYPE to
7754 image_types and adds the symbol *TYPE->type to Vimage_types. */
7755
7756static void
7757define_image_type (type)
7758 struct image_type *type;
7759{
7760 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
7761 The initialized data segment is read-only. */
7762 struct image_type *p = (struct image_type *) xmalloc (sizeof *p);
7763 bcopy (type, p, sizeof *p);
7764 p->next = image_types;
7765 image_types = p;
7766 Vimage_types = Fcons (*p->type, Vimage_types);
7767}
7768
7769
7770/* Look up image type SYMBOL, and return a pointer to its image_type
7771 structure. Value is null if SYMBOL is not a known image type. */
7772
7773static INLINE struct image_type *
7774lookup_image_type (symbol)
7775 Lisp_Object symbol;
7776{
7777 struct image_type *type;
7778
7779 for (type = image_types; type; type = type->next)
7780 if (EQ (symbol, *type->type))
7781 break;
7782
7783 return type;
7784}
7785
7786
7787/* Value is non-zero if OBJECT is a valid Lisp image specification. A
7788 valid image specification is a list whose car is the symbol
7789 `image', and whose rest is a property list. The property list must
7790 contain a value for key `:type'. That value must be the name of a
7791 supported image type. The rest of the property list depends on the
7792 image type. */
7793
7794int
7795valid_image_p (object)
7796 Lisp_Object object;
7797{
7798 int valid_p = 0;
7799
7800 if (CONSP (object) && EQ (XCAR (object), Qimage))
7801 {
3cf3436e
JR		 7802 Lisp_Object tem;
7803
7804 for (tem = XCDR (object); CONSP (tem); tem = XCDR (tem))
7805 if (EQ (XCAR (tem), QCtype))
7806 {
7807 tem = XCDR (tem);
7808 if (CONSP (tem) && SYMBOLP (XCAR (tem)))
7809 {
7810 struct image_type *type;
7811 type = lookup_image_type (XCAR (tem));
7812 if (type)
7813 valid_p = type->valid_p (object);
7814 }
7815
7816 break;
7817 }
6fc2811b
JR		 7818 }
7819
7820 return valid_p;
7821}
7822
7823
7824/* Log error message with format string FORMAT and argument ARG.
7825 Signaling an error, e.g. when an image cannot be loaded, is not a
7826 good idea because this would interrupt redisplay, and the error
7827 message display would lead to another redisplay. This function
7828 therefore simply displays a message. */
7829
7830static void
7831image_error (format, arg1, arg2)
7832 char *format;
7833 Lisp_Object arg1, arg2;
7834{
7835 add_to_log (format, arg1, arg2);
7836}
7837
7838
7839\f
7840/***********************************************************************
7841 Image specifications
7842 ***********************************************************************/
7843
7844enum image_value_type
7845{
7846 IMAGE_DONT_CHECK_VALUE_TYPE,
7847 IMAGE_STRING_VALUE,
3cf3436e 7848 IMAGE_STRING_OR_NIL_VALUE,
6fc2811b
JR		 7849 IMAGE_SYMBOL_VALUE,
7850 IMAGE_POSITIVE_INTEGER_VALUE,
8edb0a6f 7851 IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR,
6fc2811b 7852 IMAGE_NON_NEGATIVE_INTEGER_VALUE,
dfff8a69 7853 IMAGE_ASCENT_VALUE,
6fc2811b
JR		 7854 IMAGE_INTEGER_VALUE,
7855 IMAGE_FUNCTION_VALUE,
7856 IMAGE_NUMBER_VALUE,
7857 IMAGE_BOOL_VALUE
7858};
7859
7860/* Structure used when parsing image specifications. */
7861
7862struct image_keyword
7863{
7864 /* Name of keyword. */
7865 char *name;
7866
7867 /* The type of value allowed. */
7868 enum image_value_type type;
7869
7870 /* Non-zero means key must be present. */
7871 int mandatory_p;
7872
7873 /* Used to recognize duplicate keywords in a property list. */
7874 int count;
7875
7876 /* The value that was found. */
7877 Lisp_Object value;
7878};
7879
7880
7881static int parse_image_spec P_ ((Lisp_Object, struct image_keyword *,
7882 int, Lisp_Object));
7883static Lisp_Object image_spec_value P_ ((Lisp_Object, Lisp_Object, int *));
7884
7885
7886/* Parse image spec SPEC according to KEYWORDS. A valid image spec
7887 has the format (image KEYWORD VALUE ...). One of the keyword/
7888 value pairs must be `:type TYPE'. KEYWORDS is a vector of
7889 image_keywords structures of size NKEYWORDS describing other
7890 allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
7891
7892static int
7893parse_image_spec (spec, keywords, nkeywords, type)
7894 Lisp_Object spec;
7895 struct image_keyword *keywords;
7896 int nkeywords;
7897 Lisp_Object type;
7898{
7899 int i;
7900 Lisp_Object plist;
7901
7902 if (!CONSP (spec) || !EQ (XCAR (spec), Qimage))
7903 return 0;
7904
7905 plist = XCDR (spec);
7906 while (CONSP (plist))
7907 {
7908 Lisp_Object key, value;
7909
7910 /* First element of a pair must be a symbol. */
7911 key = XCAR (plist);
7912 plist = XCDR (plist);
7913 if (!SYMBOLP (key))
7914 return 0;
7915
7916 /* There must follow a value. */
7917 if (!CONSP (plist))
7918 return 0;
7919 value = XCAR (plist);
7920 plist = XCDR (plist);
7921
7922 /* Find key in KEYWORDS. Error if not found. */
7923 for (i = 0; i < nkeywords; ++i)
7924 if (strcmp (keywords[i].name, XSYMBOL (key)->name->data) == 0)
7925 break;
7926
7927 if (i == nkeywords)
7928 continue;
7929
7930 /* Record that we recognized the keyword. If a keywords
7931 was found more than once, it's an error. */
7932 keywords[i].value = value;
7933 ++keywords[i].count;
7934
7935 if (keywords[i].count > 1)
7936 return 0;
7937
7938 /* Check type of value against allowed type. */
7939 switch (keywords[i].type)
7940 {
7941 case IMAGE_STRING_VALUE:
7942 if (!STRINGP (value))
7943 return 0;
7944 break;
7945
3cf3436e
JR		 7946 case IMAGE_STRING_OR_NIL_VALUE:
7947 if (!STRINGP (value) && !NILP (value))
7948 return 0;
7949 break;
7950
6fc2811b
JR		 7951 case IMAGE_SYMBOL_VALUE:
7952 if (!SYMBOLP (value))
7953 return 0;
7954 break;
7955
7956 case IMAGE_POSITIVE_INTEGER_VALUE:
7957 if (!INTEGERP (value) || XINT (value) <= 0)
7958 return 0;
7959 break;
7960
8edb0a6f
JR		 7961 case IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR:
7962 if (INTEGERP (value) && XINT (value) >= 0)
7963 break;
7964 if (CONSP (value)
7965 && INTEGERP (XCAR (value)) && INTEGERP (XCDR (value))
7966 && XINT (XCAR (value)) >= 0 && XINT (XCDR (value)) >= 0)
7967 break;
7968 return 0;
7969
dfff8a69
JR		 7970 case IMAGE_ASCENT_VALUE:
7971 if (SYMBOLP (value) && EQ (value, Qcenter))
7972 break;
7973 else if (INTEGERP (value)
7974 && XINT (value) >= 0
7975 && XINT (value) <= 100)
7976 break;
7977 return 0;
7978
6fc2811b
JR		 7979 case IMAGE_NON_NEGATIVE_INTEGER_VALUE:
7980 if (!INTEGERP (value) || XINT (value) < 0)
7981 return 0;
7982 break;
7983
7984 case IMAGE_DONT_CHECK_VALUE_TYPE:
7985 break;
7986
7987 case IMAGE_FUNCTION_VALUE:
7988 value = indirect_function (value);
7989 if (SUBRP (value)
7990 || COMPILEDP (value)
7991 || (CONSP (value) && EQ (XCAR (value), Qlambda)))
7992 break;
7993 return 0;
7994
7995 case IMAGE_NUMBER_VALUE:
7996 if (!INTEGERP (value) && !FLOATP (value))
7997 return 0;
7998 break;
7999
8000 case IMAGE_INTEGER_VALUE:
8001 if (!INTEGERP (value))
8002 return 0;
8003 break;
8004
8005 case IMAGE_BOOL_VALUE:
8006 if (!NILP (value) && !EQ (value, Qt))
8007 return 0;
8008 break;
8009
8010 default:
8011 abort ();
8012 break;
8013 }
8014
8015 if (EQ (key, QCtype) && !EQ (type, value))
8016 return 0;
8017 }
8018
8019 /* Check that all mandatory fields are present. */
8020 for (i = 0; i < nkeywords; ++i)
8021 if (keywords[i].mandatory_p && keywords[i].count == 0)
8022 return 0;
8023
8024 return NILP (plist);
8025}
8026
8027
8028/* Return the value of KEY in image specification SPEC. Value is nil
8029 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
8030 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
8031
8032static Lisp_Object
8033image_spec_value (spec, key, found)
8034 Lisp_Object spec, key;
8035 int *found;
8036{
8037 Lisp_Object tail;
8038
8039 xassert (valid_image_p (spec));
8040
8041 for (tail = XCDR (spec);
8042 CONSP (tail) && CONSP (XCDR (tail));
8043 tail = XCDR (XCDR (tail)))
8044 {
8045 if (EQ (XCAR (tail), key))
8046 {
8047 if (found)
8048 *found = 1;
8049 return XCAR (XCDR (tail));
8050 }
8051 }
8052
8053 if (found)
8054 *found = 0;
8055 return Qnil;
8056}
8057
8058
8059
8060\f
8061/***********************************************************************
8062 Image type independent image structures
8063 ***********************************************************************/
8064
8065static struct image *make_image P_ ((Lisp_Object spec, unsigned hash));
8066static void free_image P_ ((struct frame *f, struct image *img));
8067
8068
8069/* Allocate and return a new image structure for image specification
8070 SPEC. SPEC has a hash value of HASH. */
8071
8072static struct image *
8073make_image (spec, hash)
8074 Lisp_Object spec;
8075 unsigned hash;
8076{
8077 struct image *img = (struct image *) xmalloc (sizeof *img);
8078
8079 xassert (valid_image_p (spec));
8080 bzero (img, sizeof *img);
8081 img->type = lookup_image_type (image_spec_value (spec, QCtype, NULL));
8082 xassert (img->type != NULL);
8083 img->spec = spec;
8084 img->data.lisp_val = Qnil;
8085 img->ascent = DEFAULT_IMAGE_ASCENT;
8086 img->hash = hash;
8087 return img;
8088}
8089
8090
8091/* Free image IMG which was used on frame F, including its resources. */
8092
8093static void
8094free_image (f, img)
8095 struct frame *f;
8096 struct image *img;
8097{
8098 if (img)
8099 {
8100 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
8101
8102 /* Remove IMG from the hash table of its cache. */
8103 if (img->prev)
8104 img->prev->next = img->next;
8105 else
8106 c->buckets[img->hash % IMAGE_CACHE_BUCKETS_SIZE] = img->next;
8107
8108 if (img->next)
8109 img->next->prev = img->prev;
8110
8111 c->images[img->id] = NULL;
8112
8113 /* Free resources, then free IMG. */
8114 img->type->free (f, img);
8115 xfree (img);
8116 }
8117}
8118
8119
8120/* Prepare image IMG for display on frame F. Must be called before
8121 drawing an image. */
8122
8123void
8124prepare_image_for_display (f, img)
8125 struct frame *f;
8126 struct image *img;
8127{
8128 EMACS_TIME t;
8129
8130 /* We're about to display IMG, so set its timestamp to `now'. */
8131 EMACS_GET_TIME (t);
8132 img->timestamp = EMACS_SECS (t);
8133
8134 /* If IMG doesn't have a pixmap yet, load it now, using the image
8135 type dependent loader function. */
8136 if (img->pixmap == 0 && !img->load_failed_p)
8137 img->load_failed_p = img->type->load (f, img) == 0;
8138}
8139
8140
dfff8a69
JR		 8141/* Value is the number of pixels for the ascent of image IMG when
8142 drawn in face FACE. */
8143
8144int
8145image_ascent (img, face)
8146 struct image *img;
8147 struct face *face;
8148{
8edb0a6f 8149 int height = img->height + img->vmargin;
dfff8a69
JR		 8150 int ascent;
8151
8152 if (img->ascent == CENTERED_IMAGE_ASCENT)
8153 {
8154 if (face->font)
8155 ascent = height / 2 - (FONT_DESCENT(face->font)
8156 - FONT_BASE(face->font)) / 2;
8157 else
8158 ascent = height / 2;
8159 }
8160 else
8161 ascent = height * img->ascent / 100.0;
8162
8163 return ascent;
8164}
8165
8166
6fc2811b
JR		 8167\f
8168/***********************************************************************
8169 Helper functions for X image types
8170 ***********************************************************************/
8171
8172static void x_clear_image P_ ((struct frame *f, struct image *img));
8173static unsigned long x_alloc_image_color P_ ((struct frame *f,
8174 struct image *img,
8175 Lisp_Object color_name,
8176 unsigned long dflt));
8177
8178/* Free X resources of image IMG which is used on frame F. */
8179
8180static void
8181x_clear_image (f, img)
8182 struct frame *f;
8183 struct image *img;
8184{
767b1ff0 8185#if 0 /* TODO: W32 image support */
6fc2811b
JR		 8186
8187 if (img->pixmap)
8188 {
8189 BLOCK_INPUT;
8190 XFreePixmap (NULL, img->pixmap);
8191 img->pixmap = 0;
8192 UNBLOCK_INPUT;
8193 }
8194
8195 if (img->ncolors)
8196 {
8197 int class = FRAME_W32_DISPLAY_INFO (f)->visual->class;
8198
8199 /* If display has an immutable color map, freeing colors is not
8200 necessary and some servers don't allow it. So don't do it. */
8201 if (class != StaticColor
8202 && class != StaticGray
8203 && class != TrueColor)
8204 {
8205 Colormap cmap;
8206 BLOCK_INPUT;
8207 cmap = DefaultColormapOfScreen (FRAME_W32_DISPLAY_INFO (f)->screen);
8208 XFreeColors (FRAME_W32_DISPLAY (f), cmap, img->colors,
8209 img->ncolors, 0);
8210 UNBLOCK_INPUT;
8211 }
8212
8213 xfree (img->colors);
8214 img->colors = NULL;
8215 img->ncolors = 0;
8216 }
8217#endif
8218}
8219
8220
8221/* Allocate color COLOR_NAME for image IMG on frame F. If color
8222 cannot be allocated, use DFLT. Add a newly allocated color to
8223 IMG->colors, so that it can be freed again. Value is the pixel
8224 color. */
8225
8226static unsigned long
8227x_alloc_image_color (f, img, color_name, dflt)
8228 struct frame *f;
8229 struct image *img;
8230 Lisp_Object color_name;
8231 unsigned long dflt;
8232{
767b1ff0 8233#if 0 /* TODO: allocing colors. */
6fc2811b
JR		 8234 XColor color;
8235 unsigned long result;
8236
8237 xassert (STRINGP (color_name));
8238
8239 if (w32_defined_color (f, XSTRING (color_name)->data, &color, 1))
8240 {
8241 /* This isn't called frequently so we get away with simply
8242 reallocating the color vector to the needed size, here. */
8243 ++img->ncolors;
8244 img->colors =
8245 (unsigned long *) xrealloc (img->colors,
8246 img->ncolors * sizeof *img->colors);
8247 img->colors[img->ncolors - 1] = color.pixel;
8248 result = color.pixel;
8249 }
8250 else
8251 result = dflt;
8252 return result;
8253#endif
8254 return 0;
8255}
8256
8257
8258\f
8259/***********************************************************************
8260 Image Cache
8261 ***********************************************************************/
8262
8263static void cache_image P_ ((struct frame *f, struct image *img));
3cf3436e 8264static void postprocess_image P_ ((struct frame *, struct image *));
6fc2811b
JR		 8265
8266
8267/* Return a new, initialized image cache that is allocated from the
8268 heap. Call free_image_cache to free an image cache. */
8269
8270struct image_cache *
8271make_image_cache ()
8272{
8273 struct image_cache *c = (struct image_cache *) xmalloc (sizeof *c);
8274 int size;
8275
8276 bzero (c, sizeof *c);
8277 c->size = 50;
8278 c->images = (struct image **) xmalloc (c->size * sizeof *c->images);
8279 size = IMAGE_CACHE_BUCKETS_SIZE * sizeof *c->buckets;
8280 c->buckets = (struct image **) xmalloc (size);
8281 bzero (c->buckets, size);
8282 return c;
8283}
8284
8285
8286/* Free image cache of frame F. Be aware that X frames share images
8287 caches. */
8288
8289void
8290free_image_cache (f)
8291 struct frame *f;
8292{
8293 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
8294 if (c)
8295 {
8296 int i;
8297
8298 /* Cache should not be referenced by any frame when freed. */
8299 xassert (c->refcount == 0);
8300
8301 for (i = 0; i < c->used; ++i)
8302 free_image (f, c->images[i]);
8303 xfree (c->images);
8304 xfree (c);
8305 xfree (c->buckets);
8306 FRAME_X_IMAGE_CACHE (f) = NULL;
8307 }
8308}
8309
8310
8311/* Clear image cache of frame F. FORCE_P non-zero means free all
8312 images. FORCE_P zero means clear only images that haven't been
8313 displayed for some time. Should be called from time to time to
dfff8a69
JR		 8314 reduce the number of loaded images. If image-eviction-seconds is
8315 non-nil, this frees images in the cache which weren't displayed for
6fc2811b
JR		 8316 at least that many seconds. */
8317
8318void
8319clear_image_cache (f, force_p)
8320 struct frame *f;
8321 int force_p;
8322{
8323 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
8324
8325 if (c && INTEGERP (Vimage_cache_eviction_delay))
8326 {
8327 EMACS_TIME t;
8328 unsigned long old;
8329 int i, any_freed_p = 0;
8330
8331 EMACS_GET_TIME (t);
8332 old = EMACS_SECS (t) - XFASTINT (Vimage_cache_eviction_delay);
8333
8334 for (i = 0; i < c->used; ++i)
8335 {
8336 struct image *img = c->images[i];
8337 if (img != NULL
8338 && (force_p
8339 || (img->timestamp > old)))
8340 {
8341 free_image (f, img);
8342 any_freed_p = 1;
8343 }
8344 }
8345
8346 /* We may be clearing the image cache because, for example,
8347 Emacs was iconified for a longer period of time. In that
8348 case, current matrices may still contain references to
8349 images freed above. So, clear these matrices. */
8350 if (any_freed_p)
8351 {
8352 clear_current_matrices (f);
8353 ++windows_or_buffers_changed;
8354 }
8355 }
8356}
8357
8358
8359DEFUN ("clear-image-cache", Fclear_image_cache, Sclear_image_cache,
8360 0, 1, 0,
8361 "Clear the image cache of FRAME.\n\
8362FRAME nil or omitted means use the selected frame.\n\
8363FRAME t means clear the image caches of all frames.")
8364 (frame)
8365 Lisp_Object frame;
8366{
8367 if (EQ (frame, Qt))
8368 {
8369 Lisp_Object tail;
8370
8371 FOR_EACH_FRAME (tail, frame)
8372 if (FRAME_W32_P (XFRAME (frame)))
8373 clear_image_cache (XFRAME (frame), 1);
8374 }
8375 else
8376 clear_image_cache (check_x_frame (frame), 1);
8377
8378 return Qnil;
8379}
8380
8381
3cf3436e
JR		 8382/* Compute masks and transform image IMG on frame F, as specified
8383 by the image's specification, */
8384
8385static void
8386postprocess_image (f, img)
8387 struct frame *f;
8388 struct image *img;
8389{
8390#if 0 /* TODO: image support. */
8391 /* Manipulation of the image's mask. */
8392 if (img->pixmap)
8393 {
8394 Lisp_Object conversion, spec;
8395 Lisp_Object mask;
8396
8397 spec = img->spec;
8398
8399 /* `:heuristic-mask t'
8400 `:mask heuristic'
8401 means build a mask heuristically.
8402 `:heuristic-mask (R G B)'
8403 `:mask (heuristic (R G B))'
8404 means build a mask from color (R G B) in the
8405 image.
8406 `:mask nil'
8407 means remove a mask, if any. */
8408
8409 mask = image_spec_value (spec, QCheuristic_mask, NULL);
8410 if (!NILP (mask))
8411 x_build_heuristic_mask (f, img, mask);
8412 else
8413 {
8414 int found_p;
8415
8416 mask = image_spec_value (spec, QCmask, &found_p);
8417
8418 if (EQ (mask, Qheuristic))
8419 x_build_heuristic_mask (f, img, Qt);
8420 else if (CONSP (mask)
8421 && EQ (XCAR (mask), Qheuristic))
8422 {
8423 if (CONSP (XCDR (mask)))
8424 x_build_heuristic_mask (f, img, XCAR (XCDR (mask)));
8425 else
8426 x_build_heuristic_mask (f, img, XCDR (mask));
8427 }
8428 else if (NILP (mask) && found_p && img->mask)
8429 {
8430 XFreePixmap (FRAME_X_DISPLAY (f), img->mask);
8431 img->mask = NULL;
8432 }
8433 }
8434
8435
8436 /* Should we apply an image transformation algorithm? */
8437 conversion = image_spec_value (spec, QCconversion, NULL);
8438 if (EQ (conversion, Qdisabled))
8439 x_disable_image (f, img);
8440 else if (EQ (conversion, Qlaplace))
8441 x_laplace (f, img);
8442 else if (EQ (conversion, Qemboss))
8443 x_emboss (f, img);
8444 else if (CONSP (conversion)
8445 && EQ (XCAR (conversion), Qedge_detection))
8446 {
8447 Lisp_Object tem;
8448 tem = XCDR (conversion);
8449 if (CONSP (tem))
8450 x_edge_detection (f, img,
8451 Fplist_get (tem, QCmatrix),
8452 Fplist_get (tem, QCcolor_adjustment));
8453 }
8454 }
8455#endif
8456}
8457
8458
6fc2811b
JR		 8459/* Return the id of image with Lisp specification SPEC on frame F.
8460 SPEC must be a valid Lisp image specification (see valid_image_p). */
8461
8462int
8463lookup_image (f, spec)
8464 struct frame *f;
8465 Lisp_Object spec;
8466{
8467 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
8468 struct image *img;
8469 int i;
8470 unsigned hash;
8471 struct gcpro gcpro1;
8472 EMACS_TIME now;
8473
8474 /* F must be a window-system frame, and SPEC must be a valid image
8475 specification. */
8476 xassert (FRAME_WINDOW_P (f));
8477 xassert (valid_image_p (spec));
8478
8479 GCPRO1 (spec);
8480
8481 /* Look up SPEC in the hash table of the image cache. */
8482 hash = sxhash (spec, 0);
8483 i = hash % IMAGE_CACHE_BUCKETS_SIZE;
8484
8485 for (img = c->buckets[i]; img; img = img->next)
8486 if (img->hash == hash && !NILP (Fequal (img->spec, spec)))
8487 break;
8488
8489 /* If not found, create a new image and cache it. */
8490 if (img == NULL)
8491 {
3cf3436e
JR		 8492 extern Lisp_Object Qpostscript;
8493
8edb0a6f 8494 BLOCK_INPUT;
6fc2811b
JR		 8495 img = make_image (spec, hash);
8496 cache_image (f, img);
8497 img->load_failed_p = img->type->load (f, img) == 0;
6fc2811b
JR		 8498
8499 /* If we can't load the image, and we don't have a width and
8500 height, use some arbitrary width and height so that we can
8501 draw a rectangle for it. */
8502 if (img->load_failed_p)
8503 {
8504 Lisp_Object value;
8505
8506 value = image_spec_value (spec, QCwidth, NULL);
8507 img->width = (INTEGERP (value)
8508 ? XFASTINT (value) : DEFAULT_IMAGE_WIDTH);
8509 value = image_spec_value (spec, QCheight, NULL);
8510 img->height = (INTEGERP (value)
8511 ? XFASTINT (value) : DEFAULT_IMAGE_HEIGHT);
8512 }
8513 else
8514 {
8515 /* Handle image type independent image attributes
8516 `:ascent PERCENT', `:margin MARGIN', `:relief RELIEF'. */
8edb0a6f 8517 Lisp_Object ascent, margin, relief;
6fc2811b
JR		 8518
8519 ascent = image_spec_value (spec, QCascent, NULL);
8520 if (INTEGERP (ascent))
8521 img->ascent = XFASTINT (ascent);
dfff8a69
JR		 8522 else if (EQ (ascent, Qcenter))
8523 img->ascent = CENTERED_IMAGE_ASCENT;
8524
6fc2811b
JR		 8525 margin = image_spec_value (spec, QCmargin, NULL);
8526 if (INTEGERP (margin) && XINT (margin) >= 0)
8edb0a6f
JR		 8527 img->vmargin = img->hmargin = XFASTINT (margin);
8528 else if (CONSP (margin) && INTEGERP (XCAR (margin))
8529 && INTEGERP (XCDR (margin)))
8530 {
8531 if (XINT (XCAR (margin)) > 0)
8532 img->hmargin = XFASTINT (XCAR (margin));
8533 if (XINT (XCDR (margin)) > 0)
8534 img->vmargin = XFASTINT (XCDR (margin));
8535 }
6fc2811b
JR		 8536
8537 relief = image_spec_value (spec, QCrelief, NULL);
8538 if (INTEGERP (relief))
8539 {
8540 img->relief = XINT (relief);
8edb0a6f
JR		 8541 img->hmargin += abs (img->relief);
8542 img->vmargin += abs (img->relief);
6fc2811b
JR		 8543 }
8544
3cf3436e
JR		 8545 /* Do image transformations and compute masks, unless we
8546 don't have the image yet. */
8547 if (!EQ (*img->type->type, Qpostscript))
8548 postprocess_image (f, img);
6fc2811b 8549 }
3cf3436e 8550
8edb0a6f
JR		 8551 UNBLOCK_INPUT;
8552 xassert (!interrupt_input_blocked);
6fc2811b
JR		 8553 }
8554
8555 /* We're using IMG, so set its timestamp to `now'. */
8556 EMACS_GET_TIME (now);
8557 img->timestamp = EMACS_SECS (now);
8558
8559 UNGCPRO;
8560
8561 /* Value is the image id. */
8562 return img->id;
8563}
8564
8565
8566/* Cache image IMG in the image cache of frame F. */
8567
8568static void
8569cache_image (f, img)
8570 struct frame *f;
8571 struct image *img;
8572{
8573 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
8574 int i;
8575
8576 /* Find a free slot in c->images. */
8577 for (i = 0; i < c->used; ++i)
8578 if (c->images[i] == NULL)
8579 break;
8580
8581 /* If no free slot found, maybe enlarge c->images. */
8582 if (i == c->used && c->used == c->size)
8583 {
8584 c->size *= 2;
8585 c->images = (struct image **) xrealloc (c->images,
8586 c->size * sizeof *c->images);
8587 }
8588
8589 /* Add IMG to c->images, and assign IMG an id. */
8590 c->images[i] = img;
8591 img->id = i;
8592 if (i == c->used)
8593 ++c->used;
8594
8595 /* Add IMG to the cache's hash table. */
8596 i = img->hash % IMAGE_CACHE_BUCKETS_SIZE;
8597 img->next = c->buckets[i];
8598 if (img->next)
8599 img->next->prev = img;
8600 img->prev = NULL;
8601 c->buckets[i] = img;
8602}
8603
8604
8605/* Call FN on every image in the image cache of frame F. Used to mark
8606 Lisp Objects in the image cache. */
8607
8608void
8609forall_images_in_image_cache (f, fn)
8610 struct frame *f;
8611 void (*fn) P_ ((struct image *img));
8612{
8613 if (FRAME_LIVE_P (f) && FRAME_W32_P (f))
8614 {
8615 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
8616 if (c)
8617 {
8618 int i;
8619 for (i = 0; i < c->used; ++i)
8620 if (c->images[i])
8621 fn (c->images[i]);
8622 }
8623 }
8624}
8625
8626
8627\f
8628/***********************************************************************
8629 W32 support code
8630 ***********************************************************************/
8631
767b1ff0 8632#if 0 /* TODO: W32 specific image code. */
6fc2811b
JR		 8633
8634static int x_create_x_image_and_pixmap P_ ((struct frame *, int, int, int,
8635 XImage **, Pixmap *));
8636static void x_destroy_x_image P_ ((XImage *));
8637static void x_put_x_image P_ ((struct frame *, XImage *, Pixmap, int, int));
8638
8639
8640/* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
8641 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
8642 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
8643 via xmalloc. Print error messages via image_error if an error
8644 occurs. Value is non-zero if successful. */
8645
8646static int
8647x_create_x_image_and_pixmap (f, width, height, depth, ximg, pixmap)
8648 struct frame *f;
8649 int width, height, depth;
8650 XImage **ximg;
8651 Pixmap *pixmap;
8652{
767b1ff0 8653#if 0 /* TODO: Image support for W32 */
6fc2811b
JR		 8654 Display *display = FRAME_W32_DISPLAY (f);
8655 Screen *screen = FRAME_X_SCREEN (f);
8656 Window window = FRAME_W32_WINDOW (f);
8657
8658 xassert (interrupt_input_blocked);
8659
8660 if (depth <= 0)
8661 depth = DefaultDepthOfScreen (screen);
8662 *ximg = XCreateImage (display, DefaultVisualOfScreen (screen),
8663 depth, ZPixmap, 0, NULL, width, height,
8664 depth > 16 ? 32 : depth > 8 ? 16 : 8, 0);
8665 if (*ximg == NULL)
8666 {
8667 image_error ("Unable to allocate X image", Qnil, Qnil);
8668 return 0;
8669 }
8670
8671 /* Allocate image raster. */
8672 (*ximg)->data = (char *) xmalloc ((*ximg)->bytes_per_line * height);
8673
8674 /* Allocate a pixmap of the same size. */
8675 *pixmap = XCreatePixmap (display, window, width, height, depth);
8676 if (*pixmap == 0)
8677 {
8678 x_destroy_x_image (*ximg);
8679 *ximg = NULL;
8680 image_error ("Unable to create X pixmap", Qnil, Qnil);
8681 return 0;
8682 }
8683#endif
8684 return 1;
8685}
8686
8687
8688/* Destroy XImage XIMG. Free XIMG->data. */
8689
8690static void
8691x_destroy_x_image (ximg)
8692 XImage *ximg;
8693{
8694 xassert (interrupt_input_blocked);
8695 if (ximg)
8696 {
8697 xfree (ximg->data);
8698 ximg->data = NULL;
8699 XDestroyImage (ximg);
8700 }
8701}
8702
8703
8704/* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
8705 are width and height of both the image and pixmap. */
8706
8707static void
8708x_put_x_image (f, ximg, pixmap, width, height)
8709 struct frame *f;
8710 XImage *ximg;
8711 Pixmap pixmap;
8712{
8713 GC gc;
8714
8715 xassert (interrupt_input_blocked);
8716 gc = XCreateGC (NULL, pixmap, 0, NULL);
8717 XPutImage (NULL, pixmap, gc, ximg, 0, 0, 0, 0, width, height);
8718 XFreeGC (NULL, gc);
8719}
8720
8721#endif
8722
8723\f
8724/***********************************************************************
3cf3436e 8725 File Handling
6fc2811b
JR		 8726 ***********************************************************************/
8727
8728static Lisp_Object x_find_image_file P_ ((Lisp_Object));
3cf3436e
JR		 8729static char *slurp_file P_ ((char *, int *));
8730
6fc2811b
JR		 8731
8732/* Find image file FILE. Look in data-directory, then
8733 x-bitmap-file-path. Value is the full name of the file found, or
8734 nil if not found. */
8735
8736static Lisp_Object
8737x_find_image_file (file)
8738 Lisp_Object file;
8739{
8740 Lisp_Object file_found, search_path;
8741 struct gcpro gcpro1, gcpro2;
8742 int fd;
8743
8744 file_found = Qnil;
8745 search_path = Fcons (Vdata_directory, Vx_bitmap_file_path);
8746 GCPRO2 (file_found, search_path);
8747
8748 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
c0ec53ad 8749 fd = openp (search_path, file, Qnil, &file_found, 0);
6fc2811b 8750
939d6465 8751 if (fd == -1)
6fc2811b
JR		 8752 file_found = Qnil;
8753 else
8754 close (fd);
8755
8756 UNGCPRO;
8757 return file_found;
8758}
8759
8760
3cf3436e
JR		 8761/* Read FILE into memory. Value is a pointer to a buffer allocated
8762 with xmalloc holding FILE's contents. Value is null if an error
8763 occurred. *SIZE is set to the size of the file. */
8764
8765static char *
8766slurp_file (file, size)
8767 char *file;
8768 int *size;
8769{
8770 FILE *fp = NULL;
8771 char *buf = NULL;
8772 struct stat st;
8773
8774 if (stat (file, &st) == 0
8775 && (fp = fopen (file, "r")) != NULL
8776 && (buf = (char *) xmalloc (st.st_size),
8777 fread (buf, 1, st.st_size, fp) == st.st_size))
8778 {
8779 *size = st.st_size;
8780 fclose (fp);
8781 }
8782 else
8783 {
8784 if (fp)
8785 fclose (fp);
8786 if (buf)
8787 {
8788 xfree (buf);
8789 buf = NULL;
8790 }
8791 }
8792
8793 return buf;
8794}
8795
8796
6fc2811b
JR		 8797\f
8798/***********************************************************************
8799 XBM images
8800 ***********************************************************************/
8801
8802static int xbm_load P_ ((struct frame *f, struct image *img));
8803static int xbm_load_image_from_file P_ ((struct frame *f, struct image *img,
8804 Lisp_Object file));
8805static int xbm_image_p P_ ((Lisp_Object object));
8806static int xbm_read_bitmap_file_data P_ ((char *, int *, int *,
8807 unsigned char **));
8808
8809
8810/* Indices of image specification fields in xbm_format, below. */
8811
8812enum xbm_keyword_index
8813{
8814 XBM_TYPE,
8815 XBM_FILE,
8816 XBM_WIDTH,
8817 XBM_HEIGHT,
8818 XBM_DATA,
8819 XBM_FOREGROUND,
8820 XBM_BACKGROUND,
8821 XBM_ASCENT,
8822 XBM_MARGIN,
8823 XBM_RELIEF,
8824 XBM_ALGORITHM,
8825 XBM_HEURISTIC_MASK,
8826 XBM_LAST
8827};
8828
8829/* Vector of image_keyword structures describing the format
8830 of valid XBM image specifications. */
8831
8832static struct image_keyword xbm_format[XBM_LAST] =
8833{
8834 {":type", IMAGE_SYMBOL_VALUE, 1},
8835 {":file", IMAGE_STRING_VALUE, 0},
8836 {":width", IMAGE_POSITIVE_INTEGER_VALUE, 0},
8837 {":height", IMAGE_POSITIVE_INTEGER_VALUE, 0},
8838 {":data", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
3cf3436e
JR		 8839 {":foreground", IMAGE_STRING_OR_NIL_VALUE, 0},
8840 {":background", IMAGE_STRING_OR_NIL_VALUE, 0},
6fc2811b 8841 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
8edb0a6f 8842 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
6fc2811b 8843 {":relief", IMAGE_INTEGER_VALUE, 0},
a93f4566 8844 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6fc2811b
JR		 8845 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
8846};
8847
8848/* Structure describing the image type XBM. */
8849
8850static struct image_type xbm_type =
8851{
8852 &Qxbm,
8853 xbm_image_p,
8854 xbm_load,
8855 x_clear_image,
8856 NULL
8857};
8858
8859/* Tokens returned from xbm_scan. */
8860
8861enum xbm_token
8862{
8863 XBM_TK_IDENT = 256,
8864 XBM_TK_NUMBER
8865};
8866
8867
8868/* Return non-zero if OBJECT is a valid XBM-type image specification.
8869 A valid specification is a list starting with the symbol `image'
8870 The rest of the list is a property list which must contain an
8871 entry `:type xbm..
8872
8873 If the specification specifies a file to load, it must contain
8874 an entry `:file FILENAME' where FILENAME is a string.
8875
8876 If the specification is for a bitmap loaded from memory it must
8877 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
8878 WIDTH and HEIGHT are integers > 0. DATA may be:
8879
8880 1. a string large enough to hold the bitmap data, i.e. it must
8881 have a size >= (WIDTH + 7) / 8 * HEIGHT
8882
8883 2. a bool-vector of size >= WIDTH * HEIGHT
8884
8885 3. a vector of strings or bool-vectors, one for each line of the
8886 bitmap.
8887
8888 Both the file and data forms may contain the additional entries
8889 `:background COLOR' and `:foreground COLOR'. If not present,
8890 foreground and background of the frame on which the image is
8891 displayed, is used. */
8892
8893static int
8894xbm_image_p (object)
8895 Lisp_Object object;
8896{
8897 struct image_keyword kw[XBM_LAST];
8898
8899 bcopy (xbm_format, kw, sizeof kw);
8900 if (!parse_image_spec (object, kw, XBM_LAST, Qxbm))
8901 return 0;
8902
8903 xassert (EQ (kw[XBM_TYPE].value, Qxbm));
8904
8905 if (kw[XBM_FILE].count)
8906 {
8907 if (kw[XBM_WIDTH].count || kw[XBM_HEIGHT].count || kw[XBM_DATA].count)
8908 return 0;
8909 }
8910 else
8911 {
8912 Lisp_Object data;
8913 int width, height;
8914
8915 /* Entries for `:width', `:height' and `:data' must be present. */
8916 if (!kw[XBM_WIDTH].count
8917 || !kw[XBM_HEIGHT].count
8918 || !kw[XBM_DATA].count)
8919 return 0;
8920
8921 data = kw[XBM_DATA].value;
8922 width = XFASTINT (kw[XBM_WIDTH].value);
8923 height = XFASTINT (kw[XBM_HEIGHT].value);
8924
8925 /* Check type of data, and width and height against contents of
8926 data. */
8927 if (VECTORP (data))
8928 {
8929 int i;
8930
8931 /* Number of elements of the vector must be >= height. */
8932 if (XVECTOR (data)->size < height)
8933 return 0;
8934
8935 /* Each string or bool-vector in data must be large enough
8936 for one line of the image. */
8937 for (i = 0; i < height; ++i)
8938 {
8939 Lisp_Object elt = XVECTOR (data)->contents[i];
8940
8941 if (STRINGP (elt))
8942 {
8943 if (XSTRING (elt)->size
8944 < (width + BITS_PER_CHAR - 1) / BITS_PER_CHAR)
8945 return 0;
8946 }
8947 else if (BOOL_VECTOR_P (elt))
8948 {
8949 if (XBOOL_VECTOR (elt)->size < width)
8950 return 0;
8951 }
8952 else
8953 return 0;
8954 }
8955 }
8956 else if (STRINGP (data))
8957 {
8958 if (XSTRING (data)->size
8959 < (width + BITS_PER_CHAR - 1) / BITS_PER_CHAR * height)
8960 return 0;
8961 }
8962 else if (BOOL_VECTOR_P (data))
8963 {
8964 if (XBOOL_VECTOR (data)->size < width * height)
8965 return 0;
8966 }
8967 else
8968 return 0;
8969 }
8970
8971 /* Baseline must be a value between 0 and 100 (a percentage). */
8972 if (kw[XBM_ASCENT].count
8973 && XFASTINT (kw[XBM_ASCENT].value) > 100)
8974 return 0;
8975
8976 return 1;
8977}
8978
8979
8980/* Scan a bitmap file. FP is the stream to read from. Value is
8981 either an enumerator from enum xbm_token, or a character for a
8982 single-character token, or 0 at end of file. If scanning an
8983 identifier, store the lexeme of the identifier in SVAL. If
8984 scanning a number, store its value in *IVAL. */
8985
8986static int
3cf3436e
JR		 8987xbm_scan (s, end, sval, ival)
8988 char **s, *end;
6fc2811b
JR		 8989 char *sval;
8990 int *ival;
8991{
8992 int c;
3cf3436e
JR		 8993
8994 loop:
8995
6fc2811b 8996 /* Skip white space. */
3cf3436e 8997 while (*s < end &&(c = *(*s)++, isspace (c)))
6fc2811b
JR		 8998 ;
8999
3cf3436e 9000 if (*s >= end)
6fc2811b
JR		 9001 c = 0;
9002 else if (isdigit (c))
9003 {
9004 int value = 0, digit;
9005
3cf3436e 9006 if (c == '0' && *s < end)
6fc2811b 9007 {
3cf3436e 9008 c = *(*s)++;
6fc2811b
JR		 9009 if (c == 'x' || c == 'X')
9010 {
3cf3436e 9011 while (*s < end)
6fc2811b 9012 {
3cf3436e 9013 c = *(*s)++;
6fc2811b
JR		 9014 if (isdigit (c))
9015 digit = c - '0';
9016 else if (c >= 'a' && c <= 'f')
9017 digit = c - 'a' + 10;
9018 else if (c >= 'A' && c <= 'F')
9019 digit = c - 'A' + 10;
9020 else
9021 break;
9022 value = 16 * value + digit;
9023 }
9024 }
9025 else if (isdigit (c))
9026 {
9027 value = c - '0';
3cf3436e
JR		 9028 while (*s < end
9029 && (c = *(*s)++, isdigit (c)))
6fc2811b
JR		 9030 value = 8 * value + c - '0';
9031 }
9032 }
9033 else
9034 {
9035 value = c - '0';
3cf3436e
JR		 9036 while (*s < end
9037 && (c = *(*s)++, isdigit (c)))
6fc2811b
JR		 9038 value = 10 * value + c - '0';
9039 }
9040
3cf3436e
JR		 9041 if (*s < end)
9042 *s = *s - 1;
6fc2811b
JR		 9043 *ival = value;
9044 c = XBM_TK_NUMBER;
9045 }
9046 else if (isalpha (c) || c == '_')
9047 {
9048 *sval++ = c;
3cf3436e
JR		 9049 while (*s < end
9050 && (c = *(*s)++, (isalnum (c) || c == '_')))
6fc2811b
JR		 9051 *sval++ = c;
9052 *sval = 0;
3cf3436e
JR		 9053 if (*s < end)
9054 *s = *s - 1;
6fc2811b
JR		 9055 c = XBM_TK_IDENT;
9056 }
3cf3436e
JR		 9057 else if (c == '/' && **s == '*')
9058 {
9059 /* C-style comment. */
9060 ++*s;
9061 while (**s && (**s != '*' || *(*s + 1) != '/'))
9062 ++*s;
9063 if (**s)
9064 {
9065 *s += 2;
9066 goto loop;
9067 }
9068 }
6fc2811b
JR		 9069
9070 return c;
9071}
9072
9073
9074/* Replacement for XReadBitmapFileData which isn't available under old
3cf3436e
JR		 9075 X versions. CONTENTS is a pointer to a buffer to parse; END is the
9076 buffer's end. Set *WIDTH and *HEIGHT to the width and height of
9077 the image. Return in *DATA the bitmap data allocated with xmalloc.
9078 Value is non-zero if successful. DATA null means just test if
9079 CONTENTS looks like an in-memory XBM file. */
6fc2811b
JR		 9080
9081static int
3cf3436e
JR		 9082xbm_read_bitmap_data (contents, end, width, height, data)
9083 char *contents, *end;
6fc2811b
JR		 9084 int *width, *height;
9085 unsigned char **data;
9086{
3cf3436e 9087 char *s = contents;
6fc2811b
JR		 9088 char buffer[BUFSIZ];
9089 int padding_p = 0;
9090 int v10 = 0;
9091 int bytes_per_line, i, nbytes;
9092 unsigned char *p;
9093 int value;
9094 int LA1;
9095
9096#define match() \
3cf3436e 9097 LA1 = xbm_scan (contents, end, buffer, &value)
6fc2811b
JR		 9098
9099#define expect(TOKEN) \
9100 if (LA1 != (TOKEN)) \
9101 goto failure; \
9102 else \
9103 match ()
9104
9105#define expect_ident(IDENT) \
9106 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
9107 match (); \
9108 else \
9109 goto failure
9110
6fc2811b 9111 *width = *height = -1;
3cf3436e
JR		 9112 if (data)
9113 *data = NULL;
9114 LA1 = xbm_scan (&s, end, buffer, &value);
6fc2811b
JR		 9115
9116 /* Parse defines for width, height and hot-spots. */
9117 while (LA1 == '#')
9118 {
9119 match ();
9120 expect_ident ("define");
9121 expect (XBM_TK_IDENT);
9122
9123 if (LA1 == XBM_TK_NUMBER);
9124 {
9125 char *p = strrchr (buffer, '_');
9126 p = p ? p + 1 : buffer;
9127 if (strcmp (p, "width") == 0)
9128 *width = value;
9129 else if (strcmp (p, "height") == 0)
9130 *height = value;
9131 }
9132 expect (XBM_TK_NUMBER);
9133 }
9134
9135 if (*width < 0 || *height < 0)
9136 goto failure;
3cf3436e
JR		 9137 else if (data == NULL)
9138 goto success;
6fc2811b
JR		 9139
9140 /* Parse bits. Must start with `static'. */
9141 expect_ident ("static");
9142 if (LA1 == XBM_TK_IDENT)
9143 {
9144 if (strcmp (buffer, "unsigned") == 0)
9145 {
9146 match ();
9147 expect_ident ("char");
9148 }
9149 else if (strcmp (buffer, "short") == 0)
9150 {
9151 match ();
9152 v10 = 1;
9153 if (*width % 16 && *width % 16 < 9)
9154 padding_p = 1;
9155 }
9156 else if (strcmp (buffer, "char") == 0)
9157 match ();
9158 else
9159 goto failure;
9160 }
9161 else
9162 goto failure;
9163
9164 expect (XBM_TK_IDENT);
9165 expect ('[');
9166 expect (']');
9167 expect ('=');
9168 expect ('{');
9169
9170 bytes_per_line = (*width + 7) / 8 + padding_p;
9171 nbytes = bytes_per_line * *height;
9172 p = *data = (char *) xmalloc (nbytes);
9173
9174 if (v10)
9175 {
9176
9177 for (i = 0; i < nbytes; i += 2)
9178 {
9179 int val = value;
9180 expect (XBM_TK_NUMBER);
9181
9182 *p++ = val;
9183 if (!padding_p || ((i + 2) % bytes_per_line))
9184 *p++ = value >> 8;
9185
9186 if (LA1 == ',' || LA1 == '}')
9187 match ();
9188 else
9189 goto failure;
9190 }
9191 }
9192 else
9193 {
9194 for (i = 0; i < nbytes; ++i)
9195 {
9196 int val = value;
9197 expect (XBM_TK_NUMBER);
9198
9199 *p++ = val;
9200
9201 if (LA1 == ',' || LA1 == '}')
9202 match ();
9203 else
9204 goto failure;
9205 }
9206 }
9207
3cf3436e 9208 success:
6fc2811b
JR		 9209 return 1;
9210
9211 failure:
3cf3436e
JR		 9212
9213 if (data && *data)
6fc2811b
JR		 9214 {
9215 xfree (*data);
9216 *data = NULL;
9217 }
9218 return 0;
9219
9220#undef match
9221#undef expect
9222#undef expect_ident
9223}
9224
9225
3cf3436e
JR		 9226/* Load XBM image IMG which will be displayed on frame F from buffer
9227 CONTENTS. END is the end of the buffer. Value is non-zero if
9228 successful. */
6fc2811b
JR		 9229
9230static int
3cf3436e 9231xbm_load_image (f, img, contents, end)
6fc2811b
JR		 9232 struct frame *f;
9233 struct image *img;
3cf3436e 9234 char *contents, *end;
6fc2811b
JR		 9235{
9236 int rc;
9237 unsigned char *data;
9238 int success_p = 0;
6fc2811b 9239
3cf3436e 9240 rc = xbm_read_bitmap_data (contents, end, &img->width, &img->height, &data);
6fc2811b
JR		 9241 if (rc)
9242 {
9243 int depth = one_w32_display_info.n_cbits;
9244 unsigned long foreground = FRAME_FOREGROUND_PIXEL (f);
9245 unsigned long background = FRAME_BACKGROUND_PIXEL (f);
9246 Lisp_Object value;
9247
9248 xassert (img->width > 0 && img->height > 0);
9249
9250 /* Get foreground and background colors, maybe allocate colors. */
9251 value = image_spec_value (img->spec, QCforeground, NULL);
9252 if (!NILP (value))
9253 foreground = x_alloc_image_color (f, img, value, foreground);
9254
9255 value = image_spec_value (img->spec, QCbackground, NULL);
9256 if (!NILP (value))
9257 background = x_alloc_image_color (f, img, value, background);
9258
767b1ff0 9259#if 0 /* TODO : Port image display to W32 */
6fc2811b
JR		 9260 img->pixmap
9261 = XCreatePixmapFromBitmapData (FRAME_W32_DISPLAY (f),
9262 FRAME_W32_WINDOW (f),
9263 data,
9264 img->width, img->height,
9265 foreground, background,
9266 depth);
9267 xfree (data);
9268
9269 if (img->pixmap == 0)
9270 {
9271 x_clear_image (f, img);
3cf3436e 9272 image_error ("Unable to create X pixmap for `%s'", img->spec, Qnil);
6fc2811b
JR		 9273 }
9274 else
9275 success_p = 1;
6fc2811b
JR		 9276#endif
9277 }
9278 else
9279 image_error ("Error loading XBM image `%s'", img->spec, Qnil);
9280
6fc2811b
JR		 9281 return success_p;
9282}
9283
9284
3cf3436e
JR		 9285/* Value is non-zero if DATA looks like an in-memory XBM file. */
9286
9287static int
9288xbm_file_p (data)
9289 Lisp_Object data;
9290{
9291 int w, h;
9292 return (STRINGP (data)
9293 && xbm_read_bitmap_data (XSTRING (data)->data,
9294 (XSTRING (data)->data
9295 + STRING_BYTES (XSTRING (data))),
9296 &w, &h, NULL));
9297}
9298
9299
6fc2811b
JR		 9300/* Fill image IMG which is used on frame F with pixmap data. Value is
9301 non-zero if successful. */
9302
9303static int
9304xbm_load (f, img)
9305 struct frame *f;
9306 struct image *img;
9307{
9308 int success_p = 0;
9309 Lisp_Object file_name;
9310
9311 xassert (xbm_image_p (img->spec));
9312
9313 /* If IMG->spec specifies a file name, create a non-file spec from it. */
9314 file_name = image_spec_value (img->spec, QCfile, NULL);
9315 if (STRINGP (file_name))
3cf3436e
JR		 9316 {
9317 Lisp_Object file;
9318 char *contents;
9319 int size;
9320 struct gcpro gcpro1;
9321
9322 file = x_find_image_file (file_name);
9323 GCPRO1 (file);
9324 if (!STRINGP (file))
9325 {
9326 image_error ("Cannot find image file `%s'", file_name, Qnil);
9327 UNGCPRO;
9328 return 0;
9329 }
9330
9331 contents = slurp_file (XSTRING (file)->data, &size);
9332 if (contents == NULL)
9333 {
9334 image_error ("Error loading XBM image `%s'", img->spec, Qnil);
9335 UNGCPRO;
9336 return 0;
9337 }
9338
9339 success_p = xbm_load_image (f, img, contents, contents + size);
9340 UNGCPRO;
9341 }
6fc2811b
JR		 9342 else
9343 {
9344 struct image_keyword fmt[XBM_LAST];
9345 Lisp_Object data;
9346 int depth;
9347 unsigned long foreground = FRAME_FOREGROUND_PIXEL (f);
9348 unsigned long background = FRAME_BACKGROUND_PIXEL (f);
9349 char *bits;
9350 int parsed_p;
3cf3436e
JR		 9351 int in_memory_file_p = 0;
9352
9353 /* See if data looks like an in-memory XBM file. */
9354 data = image_spec_value (img->spec, QCdata, NULL);
9355 in_memory_file_p = xbm_file_p (data);
6fc2811b
JR		 9356
9357 /* Parse the list specification. */
9358 bcopy (xbm_format, fmt, sizeof fmt);
9359 parsed_p = parse_image_spec (img->spec, fmt, XBM_LAST, Qxbm);
9360 xassert (parsed_p);
9361
9362 /* Get specified width, and height. */
3cf3436e
JR		 9363 if (!in_memory_file_p)
9364 {
9365 img->width = XFASTINT (fmt[XBM_WIDTH].value);
9366 img->height = XFASTINT (fmt[XBM_HEIGHT].value);
9367 xassert (img->width > 0 && img->height > 0);
9368 }
6fc2811b 9369 /* Get foreground and background colors, maybe allocate colors. */
3cf3436e
JR		 9370 if (fmt[XBM_FOREGROUND].count
9371 && STRINGP (fmt[XBM_FOREGROUND].value))
6fc2811b
JR		 9372 foreground = x_alloc_image_color (f, img, fmt[XBM_FOREGROUND].value,
9373 foreground);
3cf3436e
JR		 9374 if (fmt[XBM_BACKGROUND].count
9375 && STRINGP (fmt[XBM_BACKGROUND].value))
6fc2811b
JR		 9376 background = x_alloc_image_color (f, img, fmt[XBM_BACKGROUND].value,
9377 background);
9378
3cf3436e
JR		 9379 if (in_memory_file_p)
9380 success_p = xbm_load_image (f, img, XSTRING (data)->data,
9381 (XSTRING (data)->data
9382 + STRING_BYTES (XSTRING (data))));
9383 else
6fc2811b 9384 {
3cf3436e
JR		 9385 if (VECTORP (data))
9386 {
9387 int i;
9388 char *p;
9389 int nbytes = (img->width + BITS_PER_CHAR - 1) / BITS_PER_CHAR;
6fc2811b 9390
3cf3436e
JR		 9391 p = bits = (char *) alloca (nbytes * img->height);
9392 for (i = 0; i < img->height; ++i, p += nbytes)
9393 {
9394 Lisp_Object line = XVECTOR (data)->contents[i];
9395 if (STRINGP (line))
9396 bcopy (XSTRING (line)->data, p, nbytes);
9397 else
9398 bcopy (XBOOL_VECTOR (line)->data, p, nbytes);
9399 }
9400 }
9401 else if (STRINGP (data))
9402 bits = XSTRING (data)->data;
9403 else
9404 bits = XBOOL_VECTOR (data)->data;
9405#ifdef TODO /* image support. */
9406 /* Create the pixmap. */
9407 depth = DefaultDepthOfScreen (FRAME_X_SCREEN (f));
9408 img->pixmap
9409 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f),
9410 FRAME_X_WINDOW (f),
9411 bits,
9412 img->width, img->height,
9413 foreground, background,
9414 depth);
9415#endif
9416 if (img->pixmap)
9417 success_p = 1;
9418 else
6fc2811b 9419 {
3cf3436e
JR		 9420 image_error ("Unable to create pixmap for XBM image `%s'",
9421 img->spec, Qnil);
9422 x_clear_image (f, img);
6fc2811b
JR		 9423 }
9424 }
6fc2811b
JR		 9425 }
9426
9427 return success_p;
9428}
9429
9430
9431\f
9432/***********************************************************************
9433 XPM images
9434 ***********************************************************************/
9435
9436#if HAVE_XPM
9437
9438static int xpm_image_p P_ ((Lisp_Object object));
9439static int xpm_load P_ ((struct frame *f, struct image *img));
9440static int xpm_valid_color_symbols_p P_ ((Lisp_Object));
9441
9442#include "X11/xpm.h"
9443
9444/* The symbol `xpm' identifying XPM-format images. */
9445
9446Lisp_Object Qxpm;
9447
9448/* Indices of image specification fields in xpm_format, below. */
9449
9450enum xpm_keyword_index
9451{
9452 XPM_TYPE,
9453 XPM_FILE,
9454 XPM_DATA,
9455 XPM_ASCENT,
9456 XPM_MARGIN,
9457 XPM_RELIEF,
9458 XPM_ALGORITHM,
9459 XPM_HEURISTIC_MASK,
9460 XPM_COLOR_SYMBOLS,
9461 XPM_LAST
9462};
9463
9464/* Vector of image_keyword structures describing the format
9465 of valid XPM image specifications. */
9466
9467static struct image_keyword xpm_format[XPM_LAST] =
9468{
9469 {":type", IMAGE_SYMBOL_VALUE, 1},
9470 {":file", IMAGE_STRING_VALUE, 0},
9471 {":data", IMAGE_STRING_VALUE, 0},
9472 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
8edb0a6f 9473 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
6fc2811b 9474 {":relief", IMAGE_INTEGER_VALUE, 0},
a93f4566 9475 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6fc2811b
JR		 9476 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
9477 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
9478};
9479
9480/* Structure describing the image type XBM. */
9481
9482static struct image_type xpm_type =
9483{
9484 &Qxpm,
9485 xpm_image_p,
9486 xpm_load,
9487 x_clear_image,
9488 NULL
9489};
9490
9491
9492/* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
9493 for XPM images. Such a list must consist of conses whose car and
9494 cdr are strings. */
9495
9496static int
9497xpm_valid_color_symbols_p (color_symbols)
9498 Lisp_Object color_symbols;
9499{
9500 while (CONSP (color_symbols))
9501 {
9502 Lisp_Object sym = XCAR (color_symbols);
9503 if (!CONSP (sym)
9504 || !STRINGP (XCAR (sym))
9505 || !STRINGP (XCDR (sym)))
9506 break;
9507 color_symbols = XCDR (color_symbols);
9508 }
9509
9510 return NILP (color_symbols);
9511}
9512
9513
9514/* Value is non-zero if OBJECT is a valid XPM image specification. */
9515
9516static int
9517xpm_image_p (object)
9518 Lisp_Object object;
9519{
9520 struct image_keyword fmt[XPM_LAST];
9521 bcopy (xpm_format, fmt, sizeof fmt);
9522 return (parse_image_spec (object, fmt, XPM_LAST, Qxpm)
9523 /* Either `:file' or `:data' must be present. */
9524 && fmt[XPM_FILE].count + fmt[XPM_DATA].count == 1
9525 /* Either no `:color-symbols' or it's a list of conses
9526 whose car and cdr are strings. */
9527 && (fmt[XPM_COLOR_SYMBOLS].count == 0
9528 || xpm_valid_color_symbols_p (fmt[XPM_COLOR_SYMBOLS].value))
9529 && (fmt[XPM_ASCENT].count == 0
9530 || XFASTINT (fmt[XPM_ASCENT].value) < 100));
9531}
9532
9533
9534/* Load image IMG which will be displayed on frame F. Value is
9535 non-zero if successful. */
9536
9537static int
9538xpm_load (f, img)
9539 struct frame *f;
9540 struct image *img;
9541{
9542 int rc, i;
9543 XpmAttributes attrs;
9544 Lisp_Object specified_file, color_symbols;
9545
9546 /* Configure the XPM lib. Use the visual of frame F. Allocate
9547 close colors. Return colors allocated. */
9548 bzero (&attrs, sizeof attrs);
dfff8a69
JR		 9549 attrs.visual = FRAME_X_VISUAL (f);
9550 attrs.colormap = FRAME_X_COLORMAP (f);
6fc2811b 9551 attrs.valuemask |= XpmVisual;
dfff8a69 9552 attrs.valuemask |= XpmColormap;
6fc2811b 9553 attrs.valuemask |= XpmReturnAllocPixels;
dfff8a69 9554#ifdef XpmAllocCloseColors
6fc2811b
JR		 9555 attrs.alloc_close_colors = 1;
9556 attrs.valuemask |= XpmAllocCloseColors;
dfff8a69
JR		 9557#else
9558 attrs.closeness = 600;
9559 attrs.valuemask |= XpmCloseness;
9560#endif
6fc2811b
JR		 9561
9562 /* If image specification contains symbolic color definitions, add
9563 these to `attrs'. */
9564 color_symbols = image_spec_value (img->spec, QCcolor_symbols, NULL);
9565 if (CONSP (color_symbols))
9566 {
9567 Lisp_Object tail;
9568 XpmColorSymbol *xpm_syms;
9569 int i, size;
9570
9571 attrs.valuemask |= XpmColorSymbols;
9572
9573 /* Count number of symbols. */
9574 attrs.numsymbols = 0;
9575 for (tail = color_symbols; CONSP (tail); tail = XCDR (tail))
9576 ++attrs.numsymbols;
9577
9578 /* Allocate an XpmColorSymbol array. */
9579 size = attrs.numsymbols * sizeof *xpm_syms;
9580 xpm_syms = (XpmColorSymbol *) alloca (size);
9581 bzero (xpm_syms, size);
9582 attrs.colorsymbols = xpm_syms;
9583
9584 /* Fill the color symbol array. */
9585 for (tail = color_symbols, i = 0;
9586 CONSP (tail);
9587 ++i, tail = XCDR (tail))
9588 {
9589 Lisp_Object name = XCAR (XCAR (tail));
9590 Lisp_Object color = XCDR (XCAR (tail));
9591 xpm_syms[i].name = (char *) alloca (XSTRING (name)->size + 1);
9592 strcpy (xpm_syms[i].name, XSTRING (name)->data);
9593 xpm_syms[i].value = (char *) alloca (XSTRING (color)->size + 1);
9594 strcpy (xpm_syms[i].value, XSTRING (color)->data);
9595 }
9596 }
9597
9598 /* Create a pixmap for the image, either from a file, or from a
9599 string buffer containing data in the same format as an XPM file. */
9600 BLOCK_INPUT;
9601 specified_file = image_spec_value (img->spec, QCfile, NULL);
9602 if (STRINGP (specified_file))
9603 {
9604 Lisp_Object file = x_find_image_file (specified_file);
9605 if (!STRINGP (file))
9606 {
9607 image_error ("Cannot find image file `%s'", specified_file, Qnil);
9608 UNBLOCK_INPUT;
9609 return 0;
9610 }
9611
9612 rc = XpmReadFileToPixmap (NULL, FRAME_W32_WINDOW (f),
9613 XSTRING (file)->data, &img->pixmap, &img->mask,
9614 &attrs);
9615 }
9616 else
9617 {
9618 Lisp_Object buffer = image_spec_value (img->spec, QCdata, NULL);
9619 rc = XpmCreatePixmapFromBuffer (NULL, FRAME_W32_WINDOW (f),
9620 XSTRING (buffer)->data,
9621 &img->pixmap, &img->mask,
9622 &attrs);
9623 }
9624 UNBLOCK_INPUT;
9625
9626 if (rc == XpmSuccess)
9627 {
9628 /* Remember allocated colors. */
9629 img->ncolors = attrs.nalloc_pixels;
9630 img->colors = (unsigned long *) xmalloc (img->ncolors
9631 * sizeof *img->colors);
9632 for (i = 0; i < attrs.nalloc_pixels; ++i)
9633 img->colors[i] = attrs.alloc_pixels[i];
9634
9635 img->width = attrs.width;
9636 img->height = attrs.height;
9637 xassert (img->width > 0 && img->height > 0);
9638
9639 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
9640 BLOCK_INPUT;
9641 XpmFreeAttributes (&attrs);
9642 UNBLOCK_INPUT;
9643 }
9644 else
9645 {
9646 switch (rc)
9647 {
9648 case XpmOpenFailed:
9649 image_error ("Error opening XPM file (%s)", img->spec, Qnil);
9650 break;
9651
9652 case XpmFileInvalid:
9653 image_error ("Invalid XPM file (%s)", img->spec, Qnil);
9654 break;
9655
9656 case XpmNoMemory:
9657 image_error ("Out of memory (%s)", img->spec, Qnil);
9658 break;
9659
9660 case XpmColorFailed:
9661 image_error ("Color allocation error (%s)", img->spec, Qnil);
9662 break;
9663
9664 default:
9665 image_error ("Unknown error (%s)", img->spec, Qnil);
9666 break;
9667 }
9668 }
9669
9670 return rc == XpmSuccess;
9671}
9672
9673#endif /* HAVE_XPM != 0 */
9674
9675\f
767b1ff0 9676#if 0 /* TODO : Color tables on W32. */
6fc2811b
JR		 9677/***********************************************************************
9678 Color table
9679 ***********************************************************************/
9680
9681/* An entry in the color table mapping an RGB color to a pixel color. */
9682
9683struct ct_color
9684{
9685 int r, g, b;
9686 unsigned long pixel;
9687
9688 /* Next in color table collision list. */
9689 struct ct_color *next;
9690};
9691
9692/* The bucket vector size to use. Must be prime. */
9693
9694#define CT_SIZE 101
9695
9696/* Value is a hash of the RGB color given by R, G, and B. */
9697
9698#define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
9699
9700/* The color hash table. */
9701
9702struct ct_color **ct_table;
9703
9704/* Number of entries in the color table. */
9705
9706int ct_colors_allocated;
9707
9708/* Function prototypes. */
9709
9710static void init_color_table P_ ((void));
9711static void free_color_table P_ ((void));
9712static unsigned long *colors_in_color_table P_ ((int *n));
9713static unsigned long lookup_rgb_color P_ ((struct frame *f, int r, int g, int b));
9714static unsigned long lookup_pixel_color P_ ((struct frame *f, unsigned long p));
9715
9716
9717/* Initialize the color table. */
9718
9719static void
9720init_color_table ()
9721{
9722 int size = CT_SIZE * sizeof (*ct_table);
9723 ct_table = (struct ct_color **) xmalloc (size);
9724 bzero (ct_table, size);
9725 ct_colors_allocated = 0;
9726}
9727
9728
9729/* Free memory associated with the color table. */
9730
9731static void
9732free_color_table ()
9733{
9734 int i;
9735 struct ct_color *p, *next;
9736
9737 for (i = 0; i < CT_SIZE; ++i)
9738 for (p = ct_table[i]; p; p = next)
9739 {
9740 next = p->next;
9741 xfree (p);
9742 }
9743
9744 xfree (ct_table);
9745 ct_table = NULL;
9746}
9747
9748
9749/* Value is a pixel color for RGB color R, G, B on frame F. If an
9750 entry for that color already is in the color table, return the
9751 pixel color of that entry. Otherwise, allocate a new color for R,
9752 G, B, and make an entry in the color table. */
9753
9754static unsigned long
9755lookup_rgb_color (f, r, g, b)
9756 struct frame *f;
9757 int r, g, b;
9758{
9759 unsigned hash = CT_HASH_RGB (r, g, b);
9760 int i = hash % CT_SIZE;
9761 struct ct_color *p;
9762
9763 for (p = ct_table[i]; p; p = p->next)
9764 if (p->r == r && p->g == g && p->b == b)
9765 break;
9766
9767 if (p == NULL)
9768 {
9769 COLORREF color;
9770 Colormap cmap;
9771 int rc;
9772
9773 color = PALETTERGB (r, g, b);
9774
9775 ++ct_colors_allocated;
9776
9777 p = (struct ct_color *) xmalloc (sizeof *p);
9778 p->r = r;
9779 p->g = g;
9780 p->b = b;
9781 p->pixel = color;
9782 p->next = ct_table[i];
9783 ct_table[i] = p;
9784 }
9785
9786 return p->pixel;
9787}
9788
9789
9790/* Look up pixel color PIXEL which is used on frame F in the color
9791 table. If not already present, allocate it. Value is PIXEL. */
9792
9793static unsigned long
9794lookup_pixel_color (f, pixel)
9795 struct frame *f;
9796 unsigned long pixel;
9797{
9798 int i = pixel % CT_SIZE;
9799 struct ct_color *p;
9800
9801 for (p = ct_table[i]; p; p = p->next)
9802 if (p->pixel == pixel)
9803 break;
9804
9805 if (p == NULL)
9806 {
9807 XColor color;
9808 Colormap cmap;
9809 int rc;
9810
9811 BLOCK_INPUT;
9812
9813 cmap = DefaultColormapOfScreen (FRAME_X_SCREEN (f));
9814 color.pixel = pixel;
9815 XQueryColor (NULL, cmap, &color);
9816 rc = x_alloc_nearest_color (f, cmap, &color);
9817 UNBLOCK_INPUT;
9818
9819 if (rc)
9820 {
9821 ++ct_colors_allocated;
9822
9823 p = (struct ct_color *) xmalloc (sizeof *p);
9824 p->r = color.red;
9825 p->g = color.green;
9826 p->b = color.blue;
9827 p->pixel = pixel;
9828 p->next = ct_table[i];
9829 ct_table[i] = p;
9830 }
9831 else
9832 return FRAME_FOREGROUND_PIXEL (f);
9833 }
9834 return p->pixel;
9835}
9836
9837
9838/* Value is a vector of all pixel colors contained in the color table,
9839 allocated via xmalloc. Set *N to the number of colors. */
9840
9841static unsigned long *
9842colors_in_color_table (n)
9843 int *n;
9844{
9845 int i, j;
9846 struct ct_color *p;
9847 unsigned long *colors;
9848
9849 if (ct_colors_allocated == 0)
9850 {
9851 *n = 0;
9852 colors = NULL;
9853 }
9854 else
9855 {
9856 colors = (unsigned long *) xmalloc (ct_colors_allocated
9857 * sizeof *colors);
9858 *n = ct_colors_allocated;
9859
9860 for (i = j = 0; i < CT_SIZE; ++i)
9861 for (p = ct_table[i]; p; p = p->next)
9862 colors[j++] = p->pixel;
9863 }
9864
9865 return colors;
9866}
9867
767b1ff0 9868#endif /* TODO */
6fc2811b
JR		 9869
9870\f
9871/***********************************************************************
9872 Algorithms
9873 ***********************************************************************/
3cf3436e
JR		 9874#if 0 /* TODO: image support. */
9875static XColor *x_to_xcolors P_ ((struct frame *, struct image *, int));
9876static void x_from_xcolors P_ ((struct frame *, struct image *, XColor *));
9877static void x_detect_edges P_ ((struct frame *, struct image *, int[9], int));
9878
9879/* Non-zero means draw a cross on images having `:conversion
9880 disabled'. */
6fc2811b 9881
3cf3436e 9882int cross_disabled_images;
6fc2811b 9883
3cf3436e
JR		 9884/* Edge detection matrices for different edge-detection
9885 strategies. */
6fc2811b 9886
3cf3436e
JR		 9887static int emboss_matrix[9] = {
9888 /* x - 1 x x + 1 */
9889 2, -1, 0, /* y - 1 */
9890 -1, 0, 1, /* y */
9891 0, 1, -2 /* y + 1 */
9892};
9893
9894static int laplace_matrix[9] = {
9895 /* x - 1 x x + 1 */
9896 1, 0, 0, /* y - 1 */
9897 0, 0, 0, /* y */
9898 0, 0, -1 /* y + 1 */
9899};
9900
9901/* Value is the intensity of the color whose red/green/blue values
9902 are R, G, and B. */
9903
9904#define COLOR_INTENSITY(R, G, B) ((2 * (R) + 3 * (G) + (B)) / 6)
9905
9906
9907/* On frame F, return an array of XColor structures describing image
9908 IMG->pixmap. Each XColor structure has its pixel color set. RGB_P
9909 non-zero means also fill the red/green/blue members of the XColor
9910 structures. Value is a pointer to the array of XColors structures,
9911 allocated with xmalloc; it must be freed by the caller. */
9912
9913static XColor *
9914x_to_xcolors (f, img, rgb_p)
9915 struct frame *f;
9916 struct image *img;
9917 int rgb_p;
9918{
9919 int x, y;
9920 XColor *colors, *p;
9921 XImage *ximg;
9922
9923 colors = (XColor *) xmalloc (img->width * img->height * sizeof *colors);
9924
9925 /* Get the X image IMG->pixmap. */
9926 ximg = XGetImage (FRAME_X_DISPLAY (f), img->pixmap,
9927 0, 0, img->width, img->height, ~0, ZPixmap);
9928
9929 /* Fill the `pixel' members of the XColor array. I wished there
9930 were an easy and portable way to circumvent XGetPixel. */
9931 p = colors;
9932 for (y = 0; y < img->height; ++y)
9933 {
9934 XColor *row = p;
9935
9936 for (x = 0; x < img->width; ++x, ++p)
9937 p->pixel = XGetPixel (ximg, x, y);
9938
9939 if (rgb_p)
9940 x_query_colors (f, row, img->width);
9941 }
9942
9943 XDestroyImage (ximg);
9944 return colors;
9945}
9946
9947
9948/* Create IMG->pixmap from an array COLORS of XColor structures, whose
9949 RGB members are set. F is the frame on which this all happens.
9950 COLORS will be freed; an existing IMG->pixmap will be freed, too. */
6fc2811b
JR		 9951
9952static void
3cf3436e 9953x_from_xcolors (f, img, colors)
6fc2811b 9954 struct frame *f;
3cf3436e 9955 struct image *img;
6fc2811b 9956 XColor *colors;
6fc2811b 9957{
3cf3436e
JR		 9958 int x, y;
9959 XImage *oimg;
9960 Pixmap pixmap;
9961 XColor *p;
9962
9963 init_color_table ();
9964
9965 x_create_x_image_and_pixmap (f, img->width, img->height, 0,
9966 &oimg, &pixmap);
9967 p = colors;
9968 for (y = 0; y < img->height; ++y)
9969 for (x = 0; x < img->width; ++x, ++p)
9970 {
9971 unsigned long pixel;
9972 pixel = lookup_rgb_color (f, p->red, p->green, p->blue);
9973 XPutPixel (oimg, x, y, pixel);
9974 }
6fc2811b 9975
3cf3436e
JR		 9976 xfree (colors);
9977 x_clear_image_1 (f, img, 1, 0, 1);
6fc2811b 9978
3cf3436e
JR		 9979 x_put_x_image (f, oimg, pixmap, img->width, img->height);
9980 x_destroy_x_image (oimg);
9981 img->pixmap = pixmap;
9982 img->colors = colors_in_color_table (&img->ncolors);
9983 free_color_table ();
6fc2811b
JR		 9984}
9985
9986
3cf3436e
JR		 9987/* On frame F, perform edge-detection on image IMG.
9988
9989 MATRIX is a nine-element array specifying the transformation
9990 matrix. See emboss_matrix for an example.
9991
9992 COLOR_ADJUST is a color adjustment added to each pixel of the
9993 outgoing image. */
6fc2811b
JR		 9994
9995static void
3cf3436e 9996x_detect_edges (f, img, matrix, color_adjust)
6fc2811b 9997 struct frame *f;
3cf3436e
JR		 9998 struct image *img;
9999 int matrix[9], color_adjust;
6fc2811b 10000{
3cf3436e
JR		 10001 XColor *colors = x_to_xcolors (f, img, 1);
10002 XColor *new, *p;
10003 int x, y, i, sum;
10004
10005 for (i = sum = 0; i < 9; ++i)
10006 sum += abs (matrix[i]);
10007
10008#define COLOR(A, X, Y) ((A) + (Y) * img->width + (X))
10009
10010 new = (XColor *) xmalloc (img->width * img->height * sizeof *new);
10011
10012 for (y = 0; y < img->height; ++y)
10013 {
10014 p = COLOR (new, 0, y);
10015 p->red = p->green = p->blue = 0xffff/2;
10016 p = COLOR (new, img->width - 1, y);
10017 p->red = p->green = p->blue = 0xffff/2;
10018 }
6fc2811b 10019
3cf3436e
JR		 10020 for (x = 1; x < img->width - 1; ++x)
10021 {
10022 p = COLOR (new, x, 0);
10023 p->red = p->green = p->blue = 0xffff/2;
10024 p = COLOR (new, x, img->height - 1);
10025 p->red = p->green = p->blue = 0xffff/2;
10026 }
10027
10028 for (y = 1; y < img->height - 1; ++y)
10029 {
10030 p = COLOR (new, 1, y);
10031
10032 for (x = 1; x < img->width - 1; ++x, ++p)
10033 {
10034 int r, g, b, y1, x1;
10035
10036 r = g = b = i = 0;
10037 for (y1 = y - 1; y1 < y + 2; ++y1)
10038 for (x1 = x - 1; x1 < x + 2; ++x1, ++i)
10039 if (matrix[i])
10040 {
10041 XColor *t = COLOR (colors, x1, y1);
10042 r += matrix[i] * t->red;
10043 g += matrix[i] * t->green;
10044 b += matrix[i] * t->blue;
10045 }
10046
10047 r = (r / sum + color_adjust) & 0xffff;
10048 g = (g / sum + color_adjust) & 0xffff;
10049 b = (b / sum + color_adjust) & 0xffff;
10050 p->red = p->green = p->blue = COLOR_INTENSITY (r, g, b);
10051 }
10052 }
10053
10054 xfree (colors);
10055 x_from_xcolors (f, img, new);
10056
10057#undef COLOR
10058}
10059
10060
10061/* Perform the pre-defined `emboss' edge-detection on image IMG
10062 on frame F. */
10063
10064static void
10065x_emboss (f, img)
10066 struct frame *f;
10067 struct image *img;
10068{
10069 x_detect_edges (f, img, emboss_matrix, 0xffff / 2);
6fc2811b 10070}
3cf3436e 10071
6fc2811b
JR		 10072
10073/* Transform image IMG which is used on frame F with a Laplace
10074 edge-detection algorithm. The result is an image that can be used
10075 to draw disabled buttons, for example. */
10076
10077static void
10078x_laplace (f, img)
10079 struct frame *f;
10080 struct image *img;
10081{
3cf3436e
JR		 10082 x_detect_edges (f, img, laplace_matrix, 45000);
10083}
6fc2811b 10084
6fc2811b 10085
3cf3436e
JR		 10086/* Perform edge-detection on image IMG on frame F, with specified
10087 transformation matrix MATRIX and color-adjustment COLOR_ADJUST.
6fc2811b 10088
3cf3436e 10089 MATRIX must be either
6fc2811b 10090
3cf3436e
JR		 10091 - a list of at least 9 numbers in row-major form
10092 - a vector of at least 9 numbers
6fc2811b 10093
3cf3436e
JR		 10094 COLOR_ADJUST nil means use a default; otherwise it must be a
10095 number. */
6fc2811b 10096
3cf3436e
JR		 10097static void
10098x_edge_detection (f, img, matrix, color_adjust)
10099 struct frame *f;
10100 struct image *img;
10101 Lisp_Object matrix, color_adjust;
10102{
10103 int i = 0;
10104 int trans[9];
10105
10106 if (CONSP (matrix))
6fc2811b 10107 {
3cf3436e
JR		 10108 for (i = 0;
10109 i < 9 && CONSP (matrix) && NUMBERP (XCAR (matrix));
10110 ++i, matrix = XCDR (matrix))
10111 trans[i] = XFLOATINT (XCAR (matrix));
10112 }
10113 else if (VECTORP (matrix) && ASIZE (matrix) >= 9)
10114 {
10115 for (i = 0; i < 9 && NUMBERP (AREF (matrix, i)); ++i)
10116 trans[i] = XFLOATINT (AREF (matrix, i));
10117 }
10118
10119 if (NILP (color_adjust))
10120 color_adjust = make_number (0xffff / 2);
10121
10122 if (i == 9 && NUMBERP (color_adjust))
10123 x_detect_edges (f, img, trans, (int) XFLOATINT (color_adjust));
10124}
10125
6fc2811b 10126
3cf3436e 10127/* Transform image IMG on frame F so that it looks disabled. */
6fc2811b 10128
3cf3436e
JR		 10129static void
10130x_disable_image (f, img)
10131 struct frame *f;
10132 struct image *img;
10133{
10134 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
10135
10136 if (dpyinfo->n_planes >= 2)
10137 {
10138 /* Color (or grayscale). Convert to gray, and equalize. Just
10139 drawing such images with a stipple can look very odd, so
10140 we're using this method instead. */
10141 XColor *colors = x_to_xcolors (f, img, 1);
10142 XColor *p, *end;
10143 const int h = 15000;
10144 const int l = 30000;
10145
10146 for (p = colors, end = colors + img->width * img->height;
10147 p < end;
10148 ++p)
6fc2811b 10149 {
3cf3436e
JR		 10150 int i = COLOR_INTENSITY (p->red, p->green, p->blue);
10151 int i2 = (0xffff - h - l) * i / 0xffff + l;
10152 p->red = p->green = p->blue = i2;
6fc2811b
JR		 10153 }
10154
3cf3436e 10155 x_from_xcolors (f, img, colors);
6fc2811b
JR		 10156 }
10157
3cf3436e
JR		 10158 /* Draw a cross over the disabled image, if we must or if we
10159 should. */
10160 if (dpyinfo->n_planes < 2 || cross_disabled_images)
10161 {
10162 Display *dpy = FRAME_X_DISPLAY (f);
10163 GC gc;
6fc2811b 10164
3cf3436e
JR		 10165 gc = XCreateGC (dpy, img->pixmap, 0, NULL);
10166 XSetForeground (dpy, gc, BLACK_PIX_DEFAULT (f));
10167 XDrawLine (dpy, img->pixmap, gc, 0, 0,
10168 img->width - 1, img->height - 1);
10169 XDrawLine (dpy, img->pixmap, gc, 0, img->height - 1,
10170 img->width - 1, 0);
10171 XFreeGC (dpy, gc);
6fc2811b 10172
3cf3436e
JR		 10173 if (img->mask)
10174 {
10175 gc = XCreateGC (dpy, img->mask, 0, NULL);
10176 XSetForeground (dpy, gc, WHITE_PIX_DEFAULT (f));
10177 XDrawLine (dpy, img->mask, gc, 0, 0,
10178 img->width - 1, img->height - 1);
10179 XDrawLine (dpy, img->mask, gc, 0, img->height - 1,
10180 img->width - 1, 0);
10181 XFreeGC (dpy, gc);
10182 }
10183 }
6fc2811b
JR		 10184}
10185
10186
10187/* Build a mask for image IMG which is used on frame F. FILE is the
10188 name of an image file, for error messages. HOW determines how to
10189 determine the background color of IMG. If it is a list '(R G B)',
10190 with R, G, and B being integers >= 0, take that as the color of the
10191 background. Otherwise, determine the background color of IMG
10192 heuristically. Value is non-zero if successful. */
10193
10194static int
10195x_build_heuristic_mask (f, img, how)
10196 struct frame *f;
10197 struct image *img;
10198 Lisp_Object how;
10199{
6fc2811b
JR		 10200 Display *dpy = FRAME_W32_DISPLAY (f);
10201 XImage *ximg, *mask_img;
10202 int x, y, rc, look_at_corners_p;
10203 unsigned long bg;
10204
10205 BLOCK_INPUT;
10206
10207 /* Create an image and pixmap serving as mask. */
10208 rc = x_create_x_image_and_pixmap (f, img->width, img->height, 1,
10209 &mask_img, &img->mask);
10210 if (!rc)
10211 {
10212 UNBLOCK_INPUT;
10213 return 0;
10214 }
10215
10216 /* Get the X image of IMG->pixmap. */
10217 ximg = XGetImage (dpy, img->pixmap, 0, 0, img->width, img->height,
10218 ~0, ZPixmap);
10219
10220 /* Determine the background color of ximg. If HOW is `(R G B)'
10221 take that as color. Otherwise, try to determine the color
10222 heuristically. */
10223 look_at_corners_p = 1;
10224
10225 if (CONSP (how))
10226 {
10227 int rgb[3], i = 0;
10228
10229 while (i < 3
10230 && CONSP (how)
10231 && NATNUMP (XCAR (how)))
10232 {
10233 rgb[i] = XFASTINT (XCAR (how)) & 0xffff;
10234 how = XCDR (how);
10235 }
10236
10237 if (i == 3 && NILP (how))
10238 {
10239 char color_name[30];
10240 XColor exact, color;
10241 Colormap cmap;
10242
10243 sprintf (color_name, "#%04x%04x%04x", rgb[0], rgb[1], rgb[2]);
10244
10245 cmap = DefaultColormapOfScreen (FRAME_X_SCREEN (f));
10246 if (XLookupColor (dpy, cmap, color_name, &exact, &color))
10247 {
10248 bg = color.pixel;
10249 look_at_corners_p = 0;
10250 }
10251 }
10252 }
10253
10254 if (look_at_corners_p)
10255 {
10256 unsigned long corners[4];
10257 int i, best_count;
10258
10259 /* Get the colors at the corners of ximg. */
10260 corners[0] = XGetPixel (ximg, 0, 0);
10261 corners[1] = XGetPixel (ximg, img->width - 1, 0);
10262 corners[2] = XGetPixel (ximg, img->width - 1, img->height - 1);
10263 corners[3] = XGetPixel (ximg, 0, img->height - 1);
10264
10265 /* Choose the most frequently found color as background. */
10266 for (i = best_count = 0; i < 4; ++i)
10267 {
10268 int j, n;
10269
10270 for (j = n = 0; j < 4; ++j)
10271 if (corners[i] == corners[j])
10272 ++n;
10273
10274 if (n > best_count)
10275 bg = corners[i], best_count = n;
10276 }
10277 }
10278
10279 /* Set all bits in mask_img to 1 whose color in ximg is different
10280 from the background color bg. */
10281 for (y = 0; y < img->height; ++y)
10282 for (x = 0; x < img->width; ++x)
10283 XPutPixel (mask_img, x, y, XGetPixel (ximg, x, y) != bg);
10284
10285 /* Put mask_img into img->mask. */
10286 x_put_x_image (f, mask_img, img->mask, img->width, img->height);
10287 x_destroy_x_image (mask_img);
10288 XDestroyImage (ximg);
10289
10290 UNBLOCK_INPUT;
6fc2811b
JR		 10291
10292 return 1;
10293}
3cf3436e 10294#endif /* TODO */
6fc2811b
JR		 10295
10296\f
10297/***********************************************************************
10298 PBM (mono, gray, color)
10299 ***********************************************************************/
10300#ifdef HAVE_PBM
10301
10302static int pbm_image_p P_ ((Lisp_Object object));
10303static int pbm_load P_ ((struct frame *f, struct image *img));
10304static int pbm_scan_number P_ ((unsigned char **, unsigned char *));
10305
10306/* The symbol `pbm' identifying images of this type. */
10307
10308Lisp_Object Qpbm;
10309
10310/* Indices of image specification fields in gs_format, below. */
10311
10312enum pbm_keyword_index
10313{
10314 PBM_TYPE,
10315 PBM_FILE,
10316 PBM_DATA,
10317 PBM_ASCENT,
10318 PBM_MARGIN,
10319 PBM_RELIEF,
10320 PBM_ALGORITHM,
10321 PBM_HEURISTIC_MASK,
10322 PBM_LAST
10323};
10324
10325/* Vector of image_keyword structures describing the format
10326 of valid user-defined image specifications. */
10327
10328static struct image_keyword pbm_format[PBM_LAST] =
10329{
10330 {":type", IMAGE_SYMBOL_VALUE, 1},
10331 {":file", IMAGE_STRING_VALUE, 0},
10332 {":data", IMAGE_STRING_VALUE, 0},
10333 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
8edb0a6f 10334 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
6fc2811b 10335 {":relief", IMAGE_INTEGER_VALUE, 0},
a93f4566 10336 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
3cf3436e
JR		 10337 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
10338 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
10339 {":foreground", IMAGE_STRING_OR_NIL_VALUE, 0},
10340 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
6fc2811b
JR		 10341};
10342
10343/* Structure describing the image type `pbm'. */
10344
10345static struct image_type pbm_type =
10346{
10347 &Qpbm,
10348 pbm_image_p,
10349 pbm_load,
10350 x_clear_image,
10351 NULL
10352};
10353
10354
10355/* Return non-zero if OBJECT is a valid PBM image specification. */
10356
10357static int
10358pbm_image_p (object)
10359 Lisp_Object object;
10360{
10361 struct image_keyword fmt[PBM_LAST];
10362
10363 bcopy (pbm_format, fmt, sizeof fmt);
10364
10365 if (!parse_image_spec (object, fmt, PBM_LAST, Qpbm)
10366 || (fmt[PBM_ASCENT].count
10367 && XFASTINT (fmt[PBM_ASCENT].value) > 100))
10368 return 0;
10369
10370 /* Must specify either :data or :file. */
10371 return fmt[PBM_DATA].count + fmt[PBM_FILE].count == 1;
10372}
10373
10374
10375/* Scan a decimal number from *S and return it. Advance *S while
10376 reading the number. END is the end of the string. Value is -1 at
10377 end of input. */
10378
10379static int
10380pbm_scan_number (s, end)
10381 unsigned char **s, *end;
10382{
10383 int c, val = -1;
10384
10385 while (*s < end)
10386 {
10387 /* Skip white-space. */
10388 while (*s < end && (c = *(*s)++, isspace (c)))
10389 ;
10390
10391 if (c == '#')
10392 {
10393 /* Skip comment to end of line. */
10394 while (*s < end && (c = *(*s)++, c != '\n'))
10395 ;
10396 }
10397 else if (isdigit (c))
10398 {
10399 /* Read decimal number. */
10400 val = c - '0';
10401 while (*s < end && (c = *(*s)++, isdigit (c)))
10402 val = 10 * val + c - '0';
10403 break;
10404 }
10405 else
10406 break;
10407 }
10408
10409 return val;
10410}
10411
10412
10413/* Read FILE into memory. Value is a pointer to a buffer allocated
10414 with xmalloc holding FILE's contents. Value is null if an error
10415 occured. *SIZE is set to the size of the file. */
10416
10417static char *
10418pbm_read_file (file, size)
10419 Lisp_Object file;
10420 int *size;
10421{
10422 FILE *fp = NULL;
10423 char *buf = NULL;
10424 struct stat st;
10425
10426 if (stat (XSTRING (file)->data, &st) == 0
10427 && (fp = fopen (XSTRING (file)->data, "r")) != NULL
10428 && (buf = (char *) xmalloc (st.st_size),
10429 fread (buf, 1, st.st_size, fp) == st.st_size))
10430 {
10431 *size = st.st_size;
10432 fclose (fp);
10433 }
10434 else
10435 {
10436 if (fp)
10437 fclose (fp);
10438 if (buf)
10439 {
10440 xfree (buf);
10441 buf = NULL;
10442 }
10443 }
10444
10445 return buf;
10446}
10447
10448
10449/* Load PBM image IMG for use on frame F. */
10450
10451static int
10452pbm_load (f, img)
10453 struct frame *f;
10454 struct image *img;
10455{
10456 int raw_p, x, y;
10457 int width, height, max_color_idx = 0;
10458 XImage *ximg;
10459 Lisp_Object file, specified_file;
10460 enum {PBM_MONO, PBM_GRAY, PBM_COLOR} type;
10461 struct gcpro gcpro1;
10462 unsigned char *contents = NULL;
10463 unsigned char *end, *p;
10464 int size;
10465
10466 specified_file = image_spec_value (img->spec, QCfile, NULL);
10467 file = Qnil;
10468 GCPRO1 (file);
10469
10470 if (STRINGP (specified_file))
10471 {
10472 file = x_find_image_file (specified_file);
10473 if (!STRINGP (file))
10474 {
10475 image_error ("Cannot find image file `%s'", specified_file, Qnil);
10476 UNGCPRO;
10477 return 0;
10478 }
10479
3cf3436e 10480 contents = slurp_file (XSTRING (file)->data, &size);
6fc2811b
JR		 10481 if (contents == NULL)
10482 {
10483 image_error ("Error reading `%s'", file, Qnil);
10484 UNGCPRO;
10485 return 0;
10486 }
10487
10488 p = contents;
10489 end = contents + size;
10490 }
10491 else
10492 {
10493 Lisp_Object data;
10494 data = image_spec_value (img->spec, QCdata, NULL);
10495 p = XSTRING (data)->data;
10496 end = p + STRING_BYTES (XSTRING (data));
10497 }
10498
10499 /* Check magic number. */
10500 if (end - p < 2 || *p++ != 'P')
10501 {
10502 image_error ("Not a PBM image: `%s'", img->spec, Qnil);
10503 error:
10504 xfree (contents);
10505 UNGCPRO;
10506 return 0;
10507 }
10508
6fc2811b
JR		 10509 switch (*p++)
10510 {
10511 case '1':
10512 raw_p = 0, type = PBM_MONO;
10513 break;
10514
10515 case '2':
10516 raw_p = 0, type = PBM_GRAY;
10517 break;
10518
10519 case '3':
10520 raw_p = 0, type = PBM_COLOR;
10521 break;
10522
10523 case '4':
10524 raw_p = 1, type = PBM_MONO;
10525 break;
10526
10527 case '5':
10528 raw_p = 1, type = PBM_GRAY;
10529 break;
10530
10531 case '6':
10532 raw_p = 1, type = PBM_COLOR;
10533 break;
10534
10535 default:
10536 image_error ("Not a PBM image: `%s'", img->spec, Qnil);
10537 goto error;
10538 }
10539
10540 /* Read width, height, maximum color-component. Characters
10541 starting with `#' up to the end of a line are ignored. */
10542 width = pbm_scan_number (&p, end);
10543 height = pbm_scan_number (&p, end);
10544
10545 if (type != PBM_MONO)
10546 {
10547 max_color_idx = pbm_scan_number (&p, end);
10548 if (raw_p && max_color_idx > 255)
10549 max_color_idx = 255;
10550 }
10551
10552 if (width < 0
10553 || height < 0
10554 || (type != PBM_MONO && max_color_idx < 0))
10555 goto error;
10556
6fc2811b
JR		 10557 if (!x_create_x_image_and_pixmap (f, width, height, 0,
10558 &ximg, &img->pixmap))
3cf3436e
JR		 10559 goto error;
10560
6fc2811b
JR		 10561 /* Initialize the color hash table. */
10562 init_color_table ();
10563
10564 if (type == PBM_MONO)
10565 {
10566 int c = 0, g;
3cf3436e
JR		 10567 struct image_keyword fmt[PBM_LAST];
10568 unsigned long fg = FRAME_FOREGROUND_PIXEL (f);
10569 unsigned long bg = FRAME_BACKGROUND_PIXEL (f);
10570
10571 /* Parse the image specification. */
10572 bcopy (pbm_format, fmt, sizeof fmt);
10573 parse_image_spec (img->spec, fmt, PBM_LAST, Qpbm);
10574
10575 /* Get foreground and background colors, maybe allocate colors. */
10576 if (fmt[PBM_FOREGROUND].count
10577 && STRINGP (fmt[PBM_FOREGROUND].value))
10578 fg = x_alloc_image_color (f, img, fmt[PBM_FOREGROUND].value, fg);
10579 if (fmt[PBM_BACKGROUND].count
10580 && STRINGP (fmt[PBM_BACKGROUND].value))
10581 bg = x_alloc_image_color (f, img, fmt[PBM_BACKGROUND].value, bg);
6fc2811b
JR		 10582
10583 for (y = 0; y < height; ++y)
10584 for (x = 0; x < width; ++x)
10585 {
10586 if (raw_p)
10587 {
10588 if ((x & 7) == 0)
10589 c = *p++;
10590 g = c & 0x80;
10591 c <<= 1;
10592 }
10593 else
10594 g = pbm_scan_number (&p, end);
10595
3cf3436e 10596 XPutPixel (ximg, x, y, g ? fg : bg);
6fc2811b
JR		 10597 }
10598 }
10599 else
10600 {
10601 for (y = 0; y < height; ++y)
10602 for (x = 0; x < width; ++x)
10603 {
10604 int r, g, b;
10605
10606 if (type == PBM_GRAY)
10607 r = g = b = raw_p ? *p++ : pbm_scan_number (&p, end);
10608 else if (raw_p)
10609 {
10610 r = *p++;
10611 g = *p++;
10612 b = *p++;
10613 }
10614 else
10615 {
10616 r = pbm_scan_number (&p, end);
10617 g = pbm_scan_number (&p, end);
10618 b = pbm_scan_number (&p, end);
10619 }
10620
10621 if (r < 0 || g < 0 || b < 0)
10622 {
dfff8a69 10623 xfree (ximg->data);
6fc2811b
JR		 10624 ximg->data = NULL;
10625 XDestroyImage (ximg);
6fc2811b
JR		 10626 image_error ("Invalid pixel value in image `%s'",
10627 img->spec, Qnil);
10628 goto error;
10629 }
10630
10631 /* RGB values are now in the range 0..max_color_idx.
10632 Scale this to the range 0..0xffff supported by X. */
10633 r = (double) r * 65535 / max_color_idx;
10634 g = (double) g * 65535 / max_color_idx;
10635 b = (double) b * 65535 / max_color_idx;
10636 XPutPixel (ximg, x, y, lookup_rgb_color (f, r, g, b));
10637 }
10638 }
10639
10640 /* Store in IMG->colors the colors allocated for the image, and
10641 free the color table. */
10642 img->colors = colors_in_color_table (&img->ncolors);
10643 free_color_table ();
10644
10645 /* Put the image into a pixmap. */
10646 x_put_x_image (f, ximg, img->pixmap, width, height);
10647 x_destroy_x_image (ximg);
6fc2811b
JR		 10648
10649 img->width = width;
10650 img->height = height;
10651
10652 UNGCPRO;
10653 xfree (contents);
10654 return 1;
10655}
10656#endif /* HAVE_PBM */
10657
10658\f
10659/***********************************************************************
10660 PNG
10661 ***********************************************************************/
10662
10663#if HAVE_PNG
10664
10665#include <png.h>
10666
10667/* Function prototypes. */
10668
10669static int png_image_p P_ ((Lisp_Object object));
10670static int png_load P_ ((struct frame *f, struct image *img));
10671
10672/* The symbol `png' identifying images of this type. */
10673
10674Lisp_Object Qpng;
10675
10676/* Indices of image specification fields in png_format, below. */
10677
10678enum png_keyword_index
10679{
10680 PNG_TYPE,
10681 PNG_DATA,
10682 PNG_FILE,
10683 PNG_ASCENT,
10684 PNG_MARGIN,
10685 PNG_RELIEF,
10686 PNG_ALGORITHM,
10687 PNG_HEURISTIC_MASK,
10688 PNG_LAST
10689};
10690
10691/* Vector of image_keyword structures describing the format
10692 of valid user-defined image specifications. */
10693
10694static struct image_keyword png_format[PNG_LAST] =
10695{
10696 {":type", IMAGE_SYMBOL_VALUE, 1},
10697 {":data", IMAGE_STRING_VALUE, 0},
10698 {":file", IMAGE_STRING_VALUE, 0},
10699 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
8edb0a6f 10700 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
6fc2811b 10701 {":relief", IMAGE_INTEGER_VALUE, 0},
a93f4566 10702 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6fc2811b
JR		 10703 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
10704};
10705
10706/* Structure describing the image type `png'. */
10707
10708static struct image_type png_type =
10709{
10710 &Qpng,
10711 png_image_p,
10712 png_load,
10713 x_clear_image,
10714 NULL
10715};
10716
10717
10718/* Return non-zero if OBJECT is a valid PNG image specification. */
10719
10720static int
10721png_image_p (object)
10722 Lisp_Object object;
10723{
10724 struct image_keyword fmt[PNG_LAST];
10725 bcopy (png_format, fmt, sizeof fmt);
10726
10727 if (!parse_image_spec (object, fmt, PNG_LAST, Qpng)
10728 || (fmt[PNG_ASCENT].count
10729 && XFASTINT (fmt[PNG_ASCENT].value) > 100))
10730 return 0;
10731
10732 /* Must specify either the :data or :file keyword. */
10733 return fmt[PNG_FILE].count + fmt[PNG_DATA].count == 1;
10734}
10735
10736
10737/* Error and warning handlers installed when the PNG library
10738 is initialized. */
10739
10740static void
10741my_png_error (png_ptr, msg)
10742 png_struct *png_ptr;
10743 char *msg;
10744{
10745 xassert (png_ptr != NULL);
10746 image_error ("PNG error: %s", build_string (msg), Qnil);
10747 longjmp (png_ptr->jmpbuf, 1);
10748}
10749
10750
10751static void
10752my_png_warning (png_ptr, msg)
10753 png_struct *png_ptr;
10754 char *msg;
10755{
10756 xassert (png_ptr != NULL);
10757 image_error ("PNG warning: %s", build_string (msg), Qnil);
10758}
10759
6fc2811b
JR		 10760/* Memory source for PNG decoding. */
10761
10762struct png_memory_storage
10763{
10764 unsigned char *bytes; /* The data */
10765 size_t len; /* How big is it? */
10766 int index; /* Where are we? */
10767};
10768
10769
10770/* Function set as reader function when reading PNG image from memory.
10771 PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
10772 bytes from the input to DATA. */
10773
10774static void
10775png_read_from_memory (png_ptr, data, length)
10776 png_structp png_ptr;
10777 png_bytep data;
10778 png_size_t length;
10779{
10780 struct png_memory_storage *tbr
10781 = (struct png_memory_storage *) png_get_io_ptr (png_ptr);
10782
10783 if (length > tbr->len - tbr->index)
10784 png_error (png_ptr, "Read error");
10785
10786 bcopy (tbr->bytes + tbr->index, data, length);
10787 tbr->index = tbr->index + length;
10788}
10789
6fc2811b
JR		 10790/* Load PNG image IMG for use on frame F. Value is non-zero if
10791 successful. */
10792
10793static int
10794png_load (f, img)
10795 struct frame *f;
10796 struct image *img;
10797{
10798 Lisp_Object file, specified_file;
10799 Lisp_Object specified_data;
10800 int x, y, i;
10801 XImage *ximg, *mask_img = NULL;
10802 struct gcpro gcpro1;
10803 png_struct *png_ptr = NULL;
10804 png_info *info_ptr = NULL, *end_info = NULL;
10805 FILE *fp = NULL;
10806 png_byte sig[8];
10807 png_byte *pixels = NULL;
10808 png_byte **rows = NULL;
10809 png_uint_32 width, height;
10810 int bit_depth, color_type, interlace_type;
10811 png_byte channels;
10812 png_uint_32 row_bytes;
10813 int transparent_p;
10814 char *gamma_str;
10815 double screen_gamma, image_gamma;
10816 int intent;
10817 struct png_memory_storage tbr; /* Data to be read */
10818
10819 /* Find out what file to load. */
10820 specified_file = image_spec_value (img->spec, QCfile, NULL);
10821 specified_data = image_spec_value (img->spec, QCdata, NULL);
10822 file = Qnil;
10823 GCPRO1 (file);
10824
10825 if (NILP (specified_data))
10826 {
10827 file = x_find_image_file (specified_file);
10828 if (!STRINGP (file))
10829 {
10830 image_error ("Cannot find image file `%s'", specified_file, Qnil);
10831 UNGCPRO;
10832 return 0;
10833 }
10834
10835 /* Open the image file. */
10836 fp = fopen (XSTRING (file)->data, "rb");
10837 if (!fp)
10838 {
10839 image_error ("Cannot open image file `%s'", file, Qnil);
10840 UNGCPRO;
10841 fclose (fp);
10842 return 0;
10843 }
10844
10845 /* Check PNG signature. */
10846 if (fread (sig, 1, sizeof sig, fp) != sizeof sig
10847 || !png_check_sig (sig, sizeof sig))
10848 {
10849 image_error ("Not a PNG file:` %s'", file, Qnil);
10850 UNGCPRO;
10851 fclose (fp);
10852 return 0;
10853 }
10854 }
10855 else
10856 {
10857 /* Read from memory. */
10858 tbr.bytes = XSTRING (specified_data)->data;
10859 tbr.len = STRING_BYTES (XSTRING (specified_data));
10860 tbr.index = 0;
10861
10862 /* Check PNG signature. */
10863 if (tbr.len < sizeof sig
10864 || !png_check_sig (tbr.bytes, sizeof sig))
10865 {
10866 image_error ("Not a PNG image: `%s'", img->spec, Qnil);
10867 UNGCPRO;
10868 return 0;
10869 }
10870
10871 /* Need to skip past the signature. */
10872 tbr.bytes += sizeof (sig);
10873 }
10874
6fc2811b
JR		 10875 /* Initialize read and info structs for PNG lib. */
10876 png_ptr = png_create_read_struct (PNG_LIBPNG_VER_STRING, NULL,
10877 my_png_error, my_png_warning);
10878 if (!png_ptr)
10879 {
10880 if (fp) fclose (fp);
10881 UNGCPRO;
10882 return 0;
10883 }
10884
10885 info_ptr = png_create_info_struct (png_ptr);
10886 if (!info_ptr)
10887 {
10888 png_destroy_read_struct (&png_ptr, NULL, NULL);
10889 if (fp) fclose (fp);
10890 UNGCPRO;
10891 return 0;
10892 }
10893
10894 end_info = png_create_info_struct (png_ptr);
10895 if (!end_info)
10896 {
10897 png_destroy_read_struct (&png_ptr, &info_ptr, NULL);
10898 if (fp) fclose (fp);
10899 UNGCPRO;
10900 return 0;
10901 }
10902
10903 /* Set error jump-back. We come back here when the PNG library
10904 detects an error. */
10905 if (setjmp (png_ptr->jmpbuf))
10906 {
10907 error:
10908 if (png_ptr)
10909 png_destroy_read_struct (&png_ptr, &info_ptr, &end_info);
10910 xfree (pixels);
10911 xfree (rows);
10912 if (fp) fclose (fp);
10913 UNGCPRO;
10914 return 0;
10915 }
10916
10917 /* Read image info. */
10918 if (!NILP (specified_data))
10919 png_set_read_fn (png_ptr, (void *) &tbr, png_read_from_memory);
10920 else
10921 png_init_io (png_ptr, fp);
10922
10923 png_set_sig_bytes (png_ptr, sizeof sig);
10924 png_read_info (png_ptr, info_ptr);
10925 png_get_IHDR (png_ptr, info_ptr, &width, &height, &bit_depth, &color_type,
10926 &interlace_type, NULL, NULL);
10927
10928 /* If image contains simply transparency data, we prefer to
10929 construct a clipping mask. */
10930 if (png_get_valid (png_ptr, info_ptr, PNG_INFO_tRNS))
10931 transparent_p = 1;
10932 else
10933 transparent_p = 0;
10934
10935 /* This function is easier to write if we only have to handle
10936 one data format: RGB or RGBA with 8 bits per channel. Let's
10937 transform other formats into that format. */
10938
10939 /* Strip more than 8 bits per channel. */
10940 if (bit_depth == 16)
10941 png_set_strip_16 (png_ptr);
10942
10943 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
10944 if available. */
10945 png_set_expand (png_ptr);
10946
10947 /* Convert grayscale images to RGB. */
10948 if (color_type == PNG_COLOR_TYPE_GRAY
10949 || color_type == PNG_COLOR_TYPE_GRAY_ALPHA)
10950 png_set_gray_to_rgb (png_ptr);
10951
10952 /* The value 2.2 is a guess for PC monitors from PNG example.c. */
10953 gamma_str = getenv ("SCREEN_GAMMA");
10954 screen_gamma = gamma_str ? atof (gamma_str) : 2.2;
10955
10956 /* Tell the PNG lib to handle gamma correction for us. */
10957
10958#if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
10959 if (png_get_sRGB (png_ptr, info_ptr, &intent))
10960 /* There is a special chunk in the image specifying the gamma. */
10961 png_set_sRGB (png_ptr, info_ptr, intent);
10962 else
10963#endif
10964 if (png_get_gAMA (png_ptr, info_ptr, &image_gamma))
10965 /* Image contains gamma information. */
10966 png_set_gamma (png_ptr, screen_gamma, image_gamma);
10967 else
10968 /* Use a default of 0.5 for the image gamma. */
10969 png_set_gamma (png_ptr, screen_gamma, 0.5);
10970
10971 /* Handle alpha channel by combining the image with a background
10972 color. Do this only if a real alpha channel is supplied. For
10973 simple transparency, we prefer a clipping mask. */
10974 if (!transparent_p)
10975 {
10976 png_color_16 *image_background;
10977
10978 if (png_get_bKGD (png_ptr, info_ptr, &image_background))
10979 /* Image contains a background color with which to
10980 combine the image. */
10981 png_set_background (png_ptr, image_background,
10982 PNG_BACKGROUND_GAMMA_FILE, 1, 1.0);
10983 else
10984 {
10985 /* Image does not contain a background color with which
10986 to combine the image data via an alpha channel. Use
10987 the frame's background instead. */
10988 XColor color;
10989 Colormap cmap;
10990 png_color_16 frame_background;
10991
10992 BLOCK_INPUT;
10993 cmap = DefaultColormapOfScreen (FRAME_X_SCREEN (f));
10994 color.pixel = FRAME_BACKGROUND_PIXEL (f);
10995 XQueryColor (FRAME_W32_DISPLAY (f), cmap, &color);
10996 UNBLOCK_INPUT;
10997
10998 bzero (&frame_background, sizeof frame_background);
10999 frame_background.red = color.red;
11000 frame_background.green = color.green;
11001 frame_background.blue = color.blue;
11002
11003 png_set_background (png_ptr, &frame_background,
11004 PNG_BACKGROUND_GAMMA_SCREEN, 0, 1.0);
11005 }
11006 }
11007
11008 /* Update info structure. */
11009 png_read_update_info (png_ptr, info_ptr);
11010
11011 /* Get number of channels. Valid values are 1 for grayscale images
11012 and images with a palette, 2 for grayscale images with transparency
11013 information (alpha channel), 3 for RGB images, and 4 for RGB
11014 images with alpha channel, i.e. RGBA. If conversions above were
11015 sufficient we should only have 3 or 4 channels here. */
11016 channels = png_get_channels (png_ptr, info_ptr);
11017 xassert (channels == 3 || channels == 4);
11018
11019 /* Number of bytes needed for one row of the image. */
11020 row_bytes = png_get_rowbytes (png_ptr, info_ptr);
11021
11022 /* Allocate memory for the image. */
11023 pixels = (png_byte *) xmalloc (row_bytes * height * sizeof *pixels);
11024 rows = (png_byte **) xmalloc (height * sizeof *rows);
11025 for (i = 0; i < height; ++i)
11026 rows[i] = pixels + i * row_bytes;
11027
11028 /* Read the entire image. */
11029 png_read_image (png_ptr, rows);
11030 png_read_end (png_ptr, info_ptr);
11031 if (fp)
11032 {
11033 fclose (fp);
11034 fp = NULL;
11035 }
11036
11037 BLOCK_INPUT;
11038
11039 /* Create the X image and pixmap. */
11040 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg,
11041 &img->pixmap))
11042 {
11043 UNBLOCK_INPUT;
11044 goto error;
11045 }
11046
11047 /* Create an image and pixmap serving as mask if the PNG image
11048 contains an alpha channel. */
11049 if (channels == 4
11050 && !transparent_p
11051 && !x_create_x_image_and_pixmap (f, width, height, 1,
11052 &mask_img, &img->mask))
11053 {
11054 x_destroy_x_image (ximg);
11055 XFreePixmap (FRAME_W32_DISPLAY (f), img->pixmap);
11056 img->pixmap = 0;
11057 UNBLOCK_INPUT;
11058 goto error;
11059 }
11060
11061 /* Fill the X image and mask from PNG data. */
11062 init_color_table ();
11063
11064 for (y = 0; y < height; ++y)
11065 {
11066 png_byte *p = rows[y];
11067
11068 for (x = 0; x < width; ++x)
11069 {
11070 unsigned r, g, b;
11071
11072 r = *p++ << 8;
11073 g = *p++ << 8;
11074 b = *p++ << 8;
11075 XPutPixel (ximg, x, y, lookup_rgb_color (f, r, g, b));
11076
11077 /* An alpha channel, aka mask channel, associates variable
11078 transparency with an image. Where other image formats
11079 support binary transparency---fully transparent or fully
11080 opaque---PNG allows up to 254 levels of partial transparency.
11081 The PNG library implements partial transparency by combining
11082 the image with a specified background color.
11083
11084 I'm not sure how to handle this here nicely: because the
11085 background on which the image is displayed may change, for
11086 real alpha channel support, it would be necessary to create
11087 a new image for each possible background.
11088
11089 What I'm doing now is that a mask is created if we have
11090 boolean transparency information. Otherwise I'm using
11091 the frame's background color to combine the image with. */
11092
11093 if (channels == 4)
11094 {
11095 if (mask_img)
11096 XPutPixel (mask_img, x, y, *p > 0);
11097 ++p;
11098 }
11099 }
11100 }
11101
11102 /* Remember colors allocated for this image. */
11103 img->colors = colors_in_color_table (&img->ncolors);
11104 free_color_table ();
11105
11106 /* Clean up. */
11107 png_destroy_read_struct (&png_ptr, &info_ptr, &end_info);
11108 xfree (rows);
11109 xfree (pixels);
11110
11111 img->width = width;
11112 img->height = height;
11113
11114 /* Put the image into the pixmap, then free the X image and its buffer. */
11115 x_put_x_image (f, ximg, img->pixmap, width, height);
11116 x_destroy_x_image (ximg);
11117
11118 /* Same for the mask. */
11119 if (mask_img)
11120 {
11121 x_put_x_image (f, mask_img, img->mask, img->width, img->height);
11122 x_destroy_x_image (mask_img);
11123 }
11124
11125 UNBLOCK_INPUT;
11126 UNGCPRO;
11127 return 1;
11128}
11129
11130#endif /* HAVE_PNG != 0 */
11131
11132
11133\f
11134/***********************************************************************
11135 JPEG
11136 ***********************************************************************/
11137
11138#if HAVE_JPEG
11139
11140/* Work around a warning about HAVE_STDLIB_H being redefined in
11141 jconfig.h. */
11142#ifdef HAVE_STDLIB_H
11143#define HAVE_STDLIB_H_1
11144#undef HAVE_STDLIB_H
11145#endif /* HAVE_STLIB_H */
11146
11147#include <jpeglib.h>
11148#include <jerror.h>
11149#include <setjmp.h>
11150
11151#ifdef HAVE_STLIB_H_1
11152#define HAVE_STDLIB_H 1
11153#endif
11154
11155static int jpeg_image_p P_ ((Lisp_Object object));
11156static int jpeg_load P_ ((struct frame *f, struct image *img));
11157
11158/* The symbol `jpeg' identifying images of this type. */
11159
11160Lisp_Object Qjpeg;
11161
11162/* Indices of image specification fields in gs_format, below. */
11163
11164enum jpeg_keyword_index
11165{
11166 JPEG_TYPE,
11167 JPEG_DATA,
11168 JPEG_FILE,
11169 JPEG_ASCENT,
11170 JPEG_MARGIN,
11171 JPEG_RELIEF,
11172 JPEG_ALGORITHM,
11173 JPEG_HEURISTIC_MASK,
11174 JPEG_LAST
11175};
11176
11177/* Vector of image_keyword structures describing the format
11178 of valid user-defined image specifications. */
11179
11180static struct image_keyword jpeg_format[JPEG_LAST] =
11181{
11182 {":type", IMAGE_SYMBOL_VALUE, 1},
11183 {":data", IMAGE_STRING_VALUE, 0},
11184 {":file", IMAGE_STRING_VALUE, 0},
11185 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
8edb0a6f 11186 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
6fc2811b 11187 {":relief", IMAGE_INTEGER_VALUE, 0},
a93f4566 11188 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6fc2811b
JR		 11189 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
11190};
11191
11192/* Structure describing the image type `jpeg'. */
11193
11194static struct image_type jpeg_type =
11195{
11196 &Qjpeg,
11197 jpeg_image_p,
11198 jpeg_load,
11199 x_clear_image,
11200 NULL
11201};
11202
11203
11204/* Return non-zero if OBJECT is a valid JPEG image specification. */
11205
11206static int
11207jpeg_image_p (object)
11208 Lisp_Object object;
11209{
11210 struct image_keyword fmt[JPEG_LAST];
11211
11212 bcopy (jpeg_format, fmt, sizeof fmt);
11213
11214 if (!parse_image_spec (object, fmt, JPEG_LAST, Qjpeg)
11215 || (fmt[JPEG_ASCENT].count
11216 && XFASTINT (fmt[JPEG_ASCENT].value) > 100))
11217 return 0;
11218
11219 /* Must specify either the :data or :file keyword. */
11220 return fmt[JPEG_FILE].count + fmt[JPEG_DATA].count == 1;
11221}
11222
11223
11224struct my_jpeg_error_mgr
11225{
11226 struct jpeg_error_mgr pub;
11227 jmp_buf setjmp_buffer;
11228};
11229
11230static void
11231my_error_exit (cinfo)
11232 j_common_ptr cinfo;
11233{
11234 struct my_jpeg_error_mgr *mgr = (struct my_jpeg_error_mgr *) cinfo->err;
11235 longjmp (mgr->setjmp_buffer, 1);
11236}
11237
6fc2811b
JR		 11238/* Init source method for JPEG data source manager. Called by
11239 jpeg_read_header() before any data is actually read. See
11240 libjpeg.doc from the JPEG lib distribution. */
11241
11242static void
11243our_init_source (cinfo)
11244 j_decompress_ptr cinfo;
11245{
11246}
11247
11248
11249/* Fill input buffer method for JPEG data source manager. Called
11250 whenever more data is needed. We read the whole image in one step,
11251 so this only adds a fake end of input marker at the end. */
11252
11253static boolean
11254our_fill_input_buffer (cinfo)
11255 j_decompress_ptr cinfo;
11256{
11257 /* Insert a fake EOI marker. */
11258 struct jpeg_source_mgr *src = cinfo->src;
11259 static JOCTET buffer[2];
11260
11261 buffer[0] = (JOCTET) 0xFF;
11262 buffer[1] = (JOCTET) JPEG_EOI;
11263
11264 src->next_input_byte = buffer;
11265 src->bytes_in_buffer = 2;
11266 return TRUE;
11267}
11268
11269
11270/* Method to skip over NUM_BYTES bytes in the image data. CINFO->src
11271 is the JPEG data source manager. */
11272
11273static void
11274our_skip_input_data (cinfo, num_bytes)
11275 j_decompress_ptr cinfo;
11276 long num_bytes;
11277{
11278 struct jpeg_source_mgr *src = (struct jpeg_source_mgr *) cinfo->src;
11279
11280 if (src)
11281 {
11282 if (num_bytes > src->bytes_in_buffer)
11283 ERREXIT (cinfo, JERR_INPUT_EOF);
11284
11285 src->bytes_in_buffer -= num_bytes;
11286 src->next_input_byte += num_bytes;
11287 }
11288}
11289
11290
11291/* Method to terminate data source. Called by
11292 jpeg_finish_decompress() after all data has been processed. */
11293
11294static void
11295our_term_source (cinfo)
11296 j_decompress_ptr cinfo;
11297{
11298}
11299
11300
11301/* Set up the JPEG lib for reading an image from DATA which contains
11302 LEN bytes. CINFO is the decompression info structure created for
11303 reading the image. */
11304
11305static void
11306jpeg_memory_src (cinfo, data, len)
11307 j_decompress_ptr cinfo;
11308 JOCTET *data;
11309 unsigned int len;
11310{
11311 struct jpeg_source_mgr *src;
11312
11313 if (cinfo->src == NULL)
11314 {
11315 /* First time for this JPEG object? */
11316 cinfo->src = (struct jpeg_source_mgr *)
11317 (*cinfo->mem->alloc_small) ((j_common_ptr) cinfo, JPOOL_PERMANENT,
11318 sizeof (struct jpeg_source_mgr));
11319 src = (struct jpeg_source_mgr *) cinfo->src;
11320 src->next_input_byte = data;
11321 }
11322
11323 src = (struct jpeg_source_mgr *) cinfo->src;
11324 src->init_source = our_init_source;
11325 src->fill_input_buffer = our_fill_input_buffer;
11326 src->skip_input_data = our_skip_input_data;
11327 src->resync_to_restart = jpeg_resync_to_restart; /* Use default method. */
11328 src->term_source = our_term_source;
11329 src->bytes_in_buffer = len;
11330 src->next_input_byte = data;
11331}
11332
11333
11334/* Load image IMG for use on frame F. Patterned after example.c
11335 from the JPEG lib. */
11336
11337static int
11338jpeg_load (f, img)
11339 struct frame *f;
11340 struct image *img;
11341{
11342 struct jpeg_decompress_struct cinfo;
11343 struct my_jpeg_error_mgr mgr;
11344 Lisp_Object file, specified_file;
11345 Lisp_Object specified_data;
11346 FILE *fp = NULL;
11347 JSAMPARRAY buffer;
11348 int row_stride, x, y;
11349 XImage *ximg = NULL;
11350 int rc;
11351 unsigned long *colors;
11352 int width, height;
11353 struct gcpro gcpro1;
11354
11355 /* Open the JPEG file. */
11356 specified_file = image_spec_value (img->spec, QCfile, NULL);
11357 specified_data = image_spec_value (img->spec, QCdata, NULL);
11358 file = Qnil;
11359 GCPRO1 (file);
11360
6fc2811b
JR		 11361 if (NILP (specified_data))
11362 {
11363 file = x_find_image_file (specified_file);
11364 if (!STRINGP (file))
11365 {
11366 image_error ("Cannot find image file `%s'", specified_file, Qnil);
11367 UNGCPRO;
11368 return 0;
11369 }
11370
11371 fp = fopen (XSTRING (file)->data, "r");
11372 if (fp == NULL)
11373 {
11374 image_error ("Cannot open `%s'", file, Qnil);
11375 UNGCPRO;
11376 return 0;
11377 }
11378 }
11379
11380 /* Customize libjpeg's error handling to call my_error_exit when an
11381 error is detected. This function will perform a longjmp. */
11382 mgr.pub.error_exit = my_error_exit;
11383 cinfo.err = jpeg_std_error (&mgr.pub);
11384
11385 if ((rc = setjmp (mgr.setjmp_buffer)) != 0)
11386 {
11387 if (rc == 1)
11388 {
11389 /* Called from my_error_exit. Display a JPEG error. */
11390 char buffer[JMSG_LENGTH_MAX];
11391 cinfo.err->format_message ((j_common_ptr) &cinfo, buffer);
11392 image_error ("Error reading JPEG image `%s': %s", img->spec,
11393 build_string (buffer));
11394 }
11395
11396 /* Close the input file and destroy the JPEG object. */
11397 if (fp)
11398 fclose (fp);
11399 jpeg_destroy_decompress (&cinfo);
11400
11401 BLOCK_INPUT;
11402
11403 /* If we already have an XImage, free that. */
11404 x_destroy_x_image (ximg);
11405
11406 /* Free pixmap and colors. */
11407 x_clear_image (f, img);
11408
11409 UNBLOCK_INPUT;
11410 UNGCPRO;
11411 return 0;
11412 }
11413
11414 /* Create the JPEG decompression object. Let it read from fp.
11415 Read the JPEG image header. */
11416 jpeg_create_decompress (&cinfo);
11417
11418 if (NILP (specified_data))
11419 jpeg_stdio_src (&cinfo, fp);
11420 else
11421 jpeg_memory_src (&cinfo, XSTRING (specified_data)->data,
11422 STRING_BYTES (XSTRING (specified_data)));
11423
11424 jpeg_read_header (&cinfo, TRUE);
11425
11426 /* Customize decompression so that color quantization will be used.
11427 Start decompression. */
11428 cinfo.quantize_colors = TRUE;
11429 jpeg_start_decompress (&cinfo);
11430 width = img->width = cinfo.output_width;
11431 height = img->height = cinfo.output_height;
11432
11433 BLOCK_INPUT;
11434
11435 /* Create X image and pixmap. */
11436 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg,
11437 &img->pixmap))
11438 {
11439 UNBLOCK_INPUT;
11440 longjmp (mgr.setjmp_buffer, 2);
11441 }
11442
11443 /* Allocate colors. When color quantization is used,
11444 cinfo.actual_number_of_colors has been set with the number of
11445 colors generated, and cinfo.colormap is a two-dimensional array
11446 of color indices in the range 0..cinfo.actual_number_of_colors.
11447 No more than 255 colors will be generated. */
11448 {
11449 int i, ir, ig, ib;
11450
11451 if (cinfo.out_color_components > 2)
11452 ir = 0, ig = 1, ib = 2;
11453 else if (cinfo.out_color_components > 1)
11454 ir = 0, ig = 1, ib = 0;
11455 else
11456 ir = 0, ig = 0, ib = 0;
11457
11458 /* Use the color table mechanism because it handles colors that
11459 cannot be allocated nicely. Such colors will be replaced with
11460 a default color, and we don't have to care about which colors
11461 can be freed safely, and which can't. */
11462 init_color_table ();
11463 colors = (unsigned long *) alloca (cinfo.actual_number_of_colors
11464 * sizeof *colors);
11465
11466 for (i = 0; i < cinfo.actual_number_of_colors; ++i)
11467 {
11468 /* Multiply RGB values with 255 because X expects RGB values
11469 in the range 0..0xffff. */
11470 int r = cinfo.colormap[ir][i] << 8;
11471 int g = cinfo.colormap[ig][i] << 8;
11472 int b = cinfo.colormap[ib][i] << 8;
11473 colors[i] = lookup_rgb_color (f, r, g, b);
11474 }
11475
11476 /* Remember those colors actually allocated. */
11477 img->colors = colors_in_color_table (&img->ncolors);
11478 free_color_table ();
11479 }
11480
11481 /* Read pixels. */
11482 row_stride = width * cinfo.output_components;
11483 buffer = cinfo.mem->alloc_sarray ((j_common_ptr) &cinfo, JPOOL_IMAGE,
11484 row_stride, 1);
11485 for (y = 0; y < height; ++y)
11486 {
11487 jpeg_read_scanlines (&cinfo, buffer, 1);
11488 for (x = 0; x < cinfo.output_width; ++x)
11489 XPutPixel (ximg, x, y, colors[buffer[0][x]]);
11490 }
11491
11492 /* Clean up. */
11493 jpeg_finish_decompress (&cinfo);
11494 jpeg_destroy_decompress (&cinfo);
11495 if (fp)
11496 fclose (fp);
11497
11498 /* Put the image into the pixmap. */
11499 x_put_x_image (f, ximg, img->pixmap, width, height);
11500 x_destroy_x_image (ximg);
11501 UNBLOCK_INPUT;
11502 UNGCPRO;
11503 return 1;
11504}
11505
11506#endif /* HAVE_JPEG */
11507
11508
11509\f
11510/***********************************************************************
11511 TIFF
11512 ***********************************************************************/
11513
11514#if HAVE_TIFF
11515
11516#include <tiffio.h>
11517
11518static int tiff_image_p P_ ((Lisp_Object object));
11519static int tiff_load P_ ((struct frame *f, struct image *img));
11520
11521/* The symbol `tiff' identifying images of this type. */
11522
11523Lisp_Object Qtiff;
11524
11525/* Indices of image specification fields in tiff_format, below. */
11526
11527enum tiff_keyword_index
11528{
11529 TIFF_TYPE,
11530 TIFF_DATA,
11531 TIFF_FILE,
11532 TIFF_ASCENT,
11533 TIFF_MARGIN,
11534 TIFF_RELIEF,
11535 TIFF_ALGORITHM,
11536 TIFF_HEURISTIC_MASK,
11537 TIFF_LAST
11538};
11539
11540/* Vector of image_keyword structures describing the format
11541 of valid user-defined image specifications. */
11542
11543static struct image_keyword tiff_format[TIFF_LAST] =
11544{
11545 {":type", IMAGE_SYMBOL_VALUE, 1},
11546 {":data", IMAGE_STRING_VALUE, 0},
11547 {":file", IMAGE_STRING_VALUE, 0},
11548 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
8edb0a6f 11549 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
6fc2811b 11550 {":relief", IMAGE_INTEGER_VALUE, 0},
a93f4566 11551 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6fc2811b
JR		 11552 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
11553};
11554
11555/* Structure describing the image type `tiff'. */
11556
11557static struct image_type tiff_type =
11558{
11559 &Qtiff,
11560 tiff_image_p,
11561 tiff_load,
11562 x_clear_image,
11563 NULL
11564};
11565
11566
11567/* Return non-zero if OBJECT is a valid TIFF image specification. */
11568
11569static int
11570tiff_image_p (object)
11571 Lisp_Object object;
11572{
11573 struct image_keyword fmt[TIFF_LAST];
11574 bcopy (tiff_format, fmt, sizeof fmt);
11575
11576 if (!parse_image_spec (object, fmt, TIFF_LAST, Qtiff)
11577 || (fmt[TIFF_ASCENT].count
11578 && XFASTINT (fmt[TIFF_ASCENT].value) > 100))
11579 return 0;
11580
11581 /* Must specify either the :data or :file keyword. */
11582 return fmt[TIFF_FILE].count + fmt[TIFF_DATA].count == 1;
11583}
11584
11585
11586/* Reading from a memory buffer for TIFF images Based on the PNG
11587 memory source, but we have to provide a lot of extra functions.
11588 Blah.
11589
11590 We really only need to implement read and seek, but I am not
11591 convinced that the TIFF library is smart enough not to destroy
11592 itself if we only hand it the function pointers we need to
11593 override. */
11594
11595typedef struct
11596{
11597 unsigned char *bytes;
11598 size_t len;
11599 int index;
11600}
11601tiff_memory_source;
11602
11603static size_t
11604tiff_read_from_memory (data, buf, size)
11605 thandle_t data;
11606 tdata_t buf;
11607 tsize_t size;
11608{
11609 tiff_memory_source *src = (tiff_memory_source *) data;
11610
11611 if (size > src->len - src->index)
11612 return (size_t) -1;
11613 bcopy (src->bytes + src->index, buf, size);
11614 src->index += size;
11615 return size;
11616}
11617
11618static size_t
11619tiff_write_from_memory (data, buf, size)
11620 thandle_t data;
11621 tdata_t buf;
11622 tsize_t size;
11623{
11624 return (size_t) -1;
11625}
11626
11627static toff_t
11628tiff_seek_in_memory (data, off, whence)
11629 thandle_t data;
11630 toff_t off;
11631 int whence;
11632{
11633 tiff_memory_source *src = (tiff_memory_source *) data;
11634 int idx;
11635
11636 switch (whence)
11637 {
11638 case SEEK_SET: /* Go from beginning of source. */
11639 idx = off;
11640 break;
11641
11642 case SEEK_END: /* Go from end of source. */
11643 idx = src->len + off;
11644 break;
11645
11646 case SEEK_CUR: /* Go from current position. */
11647 idx = src->index + off;
11648 break;
11649
11650 default: /* Invalid `whence'. */
11651 return -1;
11652 }
11653
11654 if (idx > src->len || idx < 0)
11655 return -1;
11656
11657 src->index = idx;
11658 return src->index;
11659}
11660
11661static int
11662tiff_close_memory (data)
11663 thandle_t data;
11664{
11665 /* NOOP */
11666 return 0;
11667}
11668
11669static int
11670tiff_mmap_memory (data, pbase, psize)
11671 thandle_t data;
11672 tdata_t *pbase;
11673 toff_t *psize;
11674{
11675 /* It is already _IN_ memory. */
11676 return 0;
11677}
11678
11679static void
11680tiff_unmap_memory (data, base, size)
11681 thandle_t data;
11682 tdata_t base;
11683 toff_t size;
11684{
11685 /* We don't need to do this. */
11686}
11687
11688static toff_t
11689tiff_size_of_memory (data)
11690 thandle_t data;
11691{
11692 return ((tiff_memory_source *) data)->len;
11693}
11694
3cf3436e
JR		 11695
11696static void
11697tiff_error_handler (title, format, ap)
11698 const char *title, *format;
11699 va_list ap;
11700{
11701 char buf[512];
11702 int len;
11703
11704 len = sprintf (buf, "TIFF error: %s ", title);
11705 vsprintf (buf + len, format, ap);
11706 add_to_log (buf, Qnil, Qnil);
11707}
11708
11709
11710static void
11711tiff_warning_handler (title, format, ap)
11712 const char *title, *format;
11713 va_list ap;
11714{
11715 char buf[512];
11716 int len;
11717
11718 len = sprintf (buf, "TIFF warning: %s ", title);
11719 vsprintf (buf + len, format, ap);
11720 add_to_log (buf, Qnil, Qnil);
11721}
11722
11723
6fc2811b
JR		 11724/* Load TIFF image IMG for use on frame F. Value is non-zero if
11725 successful. */
11726
11727static int
11728tiff_load (f, img)
11729 struct frame *f;
11730 struct image *img;
11731{
11732 Lisp_Object file, specified_file;
11733 Lisp_Object specified_data;
11734 TIFF *tiff;
11735 int width, height, x, y;
11736 uint32 *buf;
11737 int rc;
11738 XImage *ximg;
11739 struct gcpro gcpro1;
11740 tiff_memory_source memsrc;
11741
11742 specified_file = image_spec_value (img->spec, QCfile, NULL);
11743 specified_data = image_spec_value (img->spec, QCdata, NULL);
11744 file = Qnil;
11745 GCPRO1 (file);
11746
3cf3436e
JR		 11747 TIFFSetErrorHandler (tiff_error_handler);
11748 TIFFSetWarningHandler (tiff_warning_handler);
11749
6fc2811b
JR		 11750 if (NILP (specified_data))
11751 {
11752 /* Read from a file */
11753 file = x_find_image_file (specified_file);
11754 if (!STRINGP (file))
3cf3436e
JR		 11755 {
11756 image_error ("Cannot find image file `%s'", file, Qnil);
11757 UNGCPRO;
11758 return 0;
11759 }
11760
6fc2811b
JR		 11761 /* Try to open the image file. */
11762 tiff = TIFFOpen (XSTRING (file)->data, "r");
11763 if (tiff == NULL)
3cf3436e
JR		 11764 {
11765 image_error ("Cannot open `%s'", file, Qnil);
11766 UNGCPRO;
11767 return 0;
11768 }
6fc2811b
JR		 11769 }
11770 else
11771 {
11772 /* Memory source! */
11773 memsrc.bytes = XSTRING (specified_data)->data;
11774 memsrc.len = STRING_BYTES (XSTRING (specified_data));
11775 memsrc.index = 0;
11776
11777 tiff = TIFFClientOpen ("memory_source", "r", &memsrc,
11778 (TIFFReadWriteProc) tiff_read_from_memory,
11779 (TIFFReadWriteProc) tiff_write_from_memory,
11780 tiff_seek_in_memory,
11781 tiff_close_memory,
11782 tiff_size_of_memory,
11783 tiff_mmap_memory,
11784 tiff_unmap_memory);
11785
11786 if (!tiff)
11787 {
11788 image_error ("Cannot open memory source for `%s'", img->spec, Qnil);
11789 UNGCPRO;
11790 return 0;
11791 }
11792 }
11793
11794 /* Get width and height of the image, and allocate a raster buffer
11795 of width x height 32-bit values. */
11796 TIFFGetField (tiff, TIFFTAG_IMAGEWIDTH, &width);
11797 TIFFGetField (tiff, TIFFTAG_IMAGELENGTH, &height);
11798 buf = (uint32 *) xmalloc (width * height * sizeof *buf);
11799
11800 rc = TIFFReadRGBAImage (tiff, width, height, buf, 0);
11801 TIFFClose (tiff);
11802 if (!rc)
11803 {
11804 image_error ("Error reading TIFF image `%s'", img->spec, Qnil);
11805 xfree (buf);
11806 UNGCPRO;
11807 return 0;
11808 }
11809
6fc2811b
JR		 11810 /* Create the X image and pixmap. */
11811 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg, &img->pixmap))
11812 {
6fc2811b
JR		 11813 xfree (buf);
11814 UNGCPRO;
11815 return 0;
11816 }
11817
11818 /* Initialize the color table. */
11819 init_color_table ();
11820
11821 /* Process the pixel raster. Origin is in the lower-left corner. */
11822 for (y = 0; y < height; ++y)
11823 {
11824 uint32 *row = buf + y * width;
11825
11826 for (x = 0; x < width; ++x)
11827 {
11828 uint32 abgr = row[x];
11829 int r = TIFFGetR (abgr) << 8;
11830 int g = TIFFGetG (abgr) << 8;
11831 int b = TIFFGetB (abgr) << 8;
11832 XPutPixel (ximg, x, height - 1 - y, lookup_rgb_color (f, r, g, b));
11833 }
11834 }
11835
11836 /* Remember the colors allocated for the image. Free the color table. */
11837 img->colors = colors_in_color_table (&img->ncolors);
11838 free_color_table ();
11839
11840 /* Put the image into the pixmap, then free the X image and its buffer. */
11841 x_put_x_image (f, ximg, img->pixmap, width, height);
11842 x_destroy_x_image (ximg);
11843 xfree (buf);
6fc2811b
JR		 11844
11845 img->width = width;
11846 img->height = height;
11847
11848 UNGCPRO;
11849 return 1;
11850}
11851
11852#endif /* HAVE_TIFF != 0 */
11853
11854
11855\f
11856/***********************************************************************
11857 GIF
11858 ***********************************************************************/
11859
11860#if HAVE_GIF
11861
11862#include <gif_lib.h>
11863
11864static int gif_image_p P_ ((Lisp_Object object));
11865static int gif_load P_ ((struct frame *f, struct image *img));
11866
11867/* The symbol `gif' identifying images of this type. */
11868
11869Lisp_Object Qgif;
11870
11871/* Indices of image specification fields in gif_format, below. */
11872
11873enum gif_keyword_index
11874{
11875 GIF_TYPE,
11876 GIF_DATA,
11877 GIF_FILE,
11878 GIF_ASCENT,
11879 GIF_MARGIN,
11880 GIF_RELIEF,
11881 GIF_ALGORITHM,
11882 GIF_HEURISTIC_MASK,
11883 GIF_IMAGE,
11884 GIF_LAST
11885};
11886
11887/* Vector of image_keyword structures describing the format
11888 of valid user-defined image specifications. */
11889
11890static struct image_keyword gif_format[GIF_LAST] =
11891{
11892 {":type", IMAGE_SYMBOL_VALUE, 1},
11893 {":data", IMAGE_STRING_VALUE, 0},
11894 {":file", IMAGE_STRING_VALUE, 0},
11895 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
8edb0a6f 11896 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
6fc2811b 11897 {":relief", IMAGE_INTEGER_VALUE, 0},
a93f4566 11898 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6fc2811b
JR		 11899 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
11900 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0}
11901};
11902
11903/* Structure describing the image type `gif'. */
11904
11905static struct image_type gif_type =
11906{
11907 &Qgif,
11908 gif_image_p,
11909 gif_load,
11910 x_clear_image,
11911 NULL
11912};
11913
11914/* Return non-zero if OBJECT is a valid GIF image specification. */
11915
11916static int
11917gif_image_p (object)
11918 Lisp_Object object;
11919{
11920 struct image_keyword fmt[GIF_LAST];
11921 bcopy (gif_format, fmt, sizeof fmt);
11922
11923 if (!parse_image_spec (object, fmt, GIF_LAST, Qgif)
11924 || (fmt[GIF_ASCENT].count
11925 && XFASTINT (fmt[GIF_ASCENT].value) > 100))
11926 return 0;
11927
11928 /* Must specify either the :data or :file keyword. */
11929 return fmt[GIF_FILE].count + fmt[GIF_DATA].count == 1;
11930}
11931
11932/* Reading a GIF image from memory
11933 Based on the PNG memory stuff to a certain extent. */
11934
11935typedef struct
11936{
11937 unsigned char *bytes;
11938 size_t len;
11939 int index;
11940}
11941gif_memory_source;
11942
11943/* Make the current memory source available to gif_read_from_memory.
11944 It's done this way because not all versions of libungif support
11945 a UserData field in the GifFileType structure. */
11946static gif_memory_source *current_gif_memory_src;
11947
11948static int
11949gif_read_from_memory (file, buf, len)
11950 GifFileType *file;
11951 GifByteType *buf;
11952 int len;
11953{
11954 gif_memory_source *src = current_gif_memory_src;
11955
11956 if (len > src->len - src->index)
11957 return -1;
11958
11959 bcopy (src->bytes + src->index, buf, len);
11960 src->index += len;
11961 return len;
11962}
11963
11964
11965/* Load GIF image IMG for use on frame F. Value is non-zero if
11966 successful. */
11967
11968static int
11969gif_load (f, img)
11970 struct frame *f;
11971 struct image *img;
11972{
11973 Lisp_Object file, specified_file;
11974 Lisp_Object specified_data;
11975 int rc, width, height, x, y, i;
11976 XImage *ximg;
11977 ColorMapObject *gif_color_map;
11978 unsigned long pixel_colors[256];
11979 GifFileType *gif;
11980 struct gcpro gcpro1;
11981 Lisp_Object image;
11982 int ino, image_left, image_top, image_width, image_height;
11983 gif_memory_source memsrc;
11984 unsigned char *raster;
11985
11986 specified_file = image_spec_value (img->spec, QCfile, NULL);
11987 specified_data = image_spec_value (img->spec, QCdata, NULL);
11988 file = Qnil;
dfff8a69 11989 GCPRO1 (file);
6fc2811b
JR		 11990
11991 if (NILP (specified_data))
11992 {
11993 file = x_find_image_file (specified_file);
6fc2811b
JR		 11994 if (!STRINGP (file))
11995 {
11996 image_error ("Cannot find image file `%s'", specified_file, Qnil);
11997 UNGCPRO;
11998 return 0;
11999 }
12000
12001 /* Open the GIF file. */
12002 gif = DGifOpenFileName (XSTRING (file)->data);
12003 if (gif == NULL)
12004 {
12005 image_error ("Cannot open `%s'", file, Qnil);
12006 UNGCPRO;
12007 return 0;
12008 }
12009 }
12010 else
12011 {
12012 /* Read from memory! */
12013 current_gif_memory_src = &memsrc;
12014 memsrc.bytes = XSTRING (specified_data)->data;
12015 memsrc.len = STRING_BYTES (XSTRING (specified_data));
12016 memsrc.index = 0;
12017
12018 gif = DGifOpen(&memsrc, gif_read_from_memory);
12019 if (!gif)
12020 {
12021 image_error ("Cannot open memory source `%s'", img->spec, Qnil);
12022 UNGCPRO;
12023 return 0;
12024 }
12025 }
12026
12027 /* Read entire contents. */
12028 rc = DGifSlurp (gif);
12029 if (rc == GIF_ERROR)
12030 {
12031 image_error ("Error reading `%s'", img->spec, Qnil);
12032 DGifCloseFile (gif);
12033 UNGCPRO;
12034 return 0;
12035 }
12036
12037 image = image_spec_value (img->spec, QCindex, NULL);
12038 ino = INTEGERP (image) ? XFASTINT (image) : 0;
12039 if (ino >= gif->ImageCount)
12040 {
12041 image_error ("Invalid image number `%s' in image `%s'",
12042 image, img->spec);
12043 DGifCloseFile (gif);
12044 UNGCPRO;
12045 return 0;
12046 }
12047
12048 width = img->width = gif->SWidth;
12049 height = img->height = gif->SHeight;
12050
12051 BLOCK_INPUT;
12052
12053 /* Create the X image and pixmap. */
12054 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg, &img->pixmap))
12055 {
12056 UNBLOCK_INPUT;
12057 DGifCloseFile (gif);
12058 UNGCPRO;
12059 return 0;
12060 }
12061
12062 /* Allocate colors. */
12063 gif_color_map = gif->SavedImages[ino].ImageDesc.ColorMap;
12064 if (!gif_color_map)
12065 gif_color_map = gif->SColorMap;
12066 init_color_table ();
12067 bzero (pixel_colors, sizeof pixel_colors);
12068
12069 for (i = 0; i < gif_color_map->ColorCount; ++i)
12070 {
12071 int r = gif_color_map->Colors[i].Red << 8;
12072 int g = gif_color_map->Colors[i].Green << 8;
12073 int b = gif_color_map->Colors[i].Blue << 8;
12074 pixel_colors[i] = lookup_rgb_color (f, r, g, b);
12075 }
12076
12077 img->colors = colors_in_color_table (&img->ncolors);
12078 free_color_table ();
12079
12080 /* Clear the part of the screen image that are not covered by
12081 the image from the GIF file. Full animated GIF support
12082 requires more than can be done here (see the gif89 spec,
12083 disposal methods). Let's simply assume that the part
12084 not covered by a sub-image is in the frame's background color. */
12085 image_top = gif->SavedImages[ino].ImageDesc.Top;
12086 image_left = gif->SavedImages[ino].ImageDesc.Left;
12087 image_width = gif->SavedImages[ino].ImageDesc.Width;
12088 image_height = gif->SavedImages[ino].ImageDesc.Height;
12089
12090 for (y = 0; y < image_top; ++y)
12091 for (x = 0; x < width; ++x)
12092 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
12093
12094 for (y = image_top + image_height; y < height; ++y)
12095 for (x = 0; x < width; ++x)
12096 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
12097
12098 for (y = image_top; y < image_top + image_height; ++y)
12099 {
12100 for (x = 0; x < image_left; ++x)
12101 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
12102 for (x = image_left + image_width; x < width; ++x)
12103 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
12104 }
12105
12106 /* Read the GIF image into the X image. We use a local variable
12107 `raster' here because RasterBits below is a char *, and invites
12108 problems with bytes >= 0x80. */
12109 raster = (unsigned char *) gif->SavedImages[ino].RasterBits;
12110
12111 if (gif->SavedImages[ino].ImageDesc.Interlace)
12112 {
12113 static int interlace_start[] = {0, 4, 2, 1};
12114 static int interlace_increment[] = {8, 8, 4, 2};
12115 int pass, inc;
12116 int row = interlace_start[0];
12117
12118 pass = 0;
12119
12120 for (y = 0; y < image_height; y++)
12121 {
12122 if (row >= image_height)
12123 {
12124 row = interlace_start[++pass];
12125 while (row >= image_height)
12126 row = interlace_start[++pass];
12127 }
12128
12129 for (x = 0; x < image_width; x++)
12130 {
12131 int i = raster[(y * image_width) + x];
12132 XPutPixel (ximg, x + image_left, row + image_top,
12133 pixel_colors[i]);
12134 }
12135
12136 row += interlace_increment[pass];
12137 }
12138 }
12139 else
12140 {
12141 for (y = 0; y < image_height; ++y)
12142 for (x = 0; x < image_width; ++x)
12143 {
12144 int i = raster[y* image_width + x];
12145 XPutPixel (ximg, x + image_left, y + image_top, pixel_colors[i]);
12146 }
12147 }
12148
12149 DGifCloseFile (gif);
12150
12151 /* Put the image into the pixmap, then free the X image and its buffer. */
12152 x_put_x_image (f, ximg, img->pixmap, width, height);
12153 x_destroy_x_image (ximg);
12154 UNBLOCK_INPUT;
12155
12156 UNGCPRO;
12157 return 1;
12158}
12159
12160#endif /* HAVE_GIF != 0 */
12161
12162
12163\f
12164/***********************************************************************
12165 Ghostscript
12166 ***********************************************************************/
12167
3cf3436e
JR		 12168Lisp_Object Qpostscript;
12169
6fc2811b
JR		 12170#ifdef HAVE_GHOSTSCRIPT
12171static int gs_image_p P_ ((Lisp_Object object));
12172static int gs_load P_ ((struct frame *f, struct image *img));
12173static void gs_clear_image P_ ((struct frame *f, struct image *img));
12174
12175/* The symbol `postscript' identifying images of this type. */
12176
6fc2811b
JR		 12177/* Keyword symbols. */
12178
12179Lisp_Object QCloader, QCbounding_box, QCpt_width, QCpt_height;
12180
12181/* Indices of image specification fields in gs_format, below. */
12182
12183enum gs_keyword_index
12184{
12185 GS_TYPE,
12186 GS_PT_WIDTH,
12187 GS_PT_HEIGHT,
12188 GS_FILE,
12189 GS_LOADER,
12190 GS_BOUNDING_BOX,
12191 GS_ASCENT,
12192 GS_MARGIN,
12193 GS_RELIEF,
12194 GS_ALGORITHM,
12195 GS_HEURISTIC_MASK,
12196 GS_LAST
12197};
12198
12199/* Vector of image_keyword structures describing the format
12200 of valid user-defined image specifications. */
12201
12202static struct image_keyword gs_format[GS_LAST] =
12203{
12204 {":type", IMAGE_SYMBOL_VALUE, 1},
12205 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE, 1},
12206 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE, 1},
12207 {":file", IMAGE_STRING_VALUE, 1},
12208 {":loader", IMAGE_FUNCTION_VALUE, 0},
12209 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE, 1},
12210 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
8edb0a6f 12211 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
6fc2811b 12212 {":relief", IMAGE_INTEGER_VALUE, 0},
a93f4566 12213 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6fc2811b
JR		 12214 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
12215};
12216
12217/* Structure describing the image type `ghostscript'. */
12218
12219static struct image_type gs_type =
12220{
12221 &Qpostscript,
12222 gs_image_p,
12223 gs_load,
12224 gs_clear_image,
12225 NULL
12226};
12227
12228
12229/* Free X resources of Ghostscript image IMG which is used on frame F. */
12230
12231static void
12232gs_clear_image (f, img)
12233 struct frame *f;
12234 struct image *img;
12235{
12236 /* IMG->data.ptr_val may contain a recorded colormap. */
12237 xfree (img->data.ptr_val);
12238 x_clear_image (f, img);
12239}
12240
12241
12242/* Return non-zero if OBJECT is a valid Ghostscript image
12243 specification. */
12244
12245static int
12246gs_image_p (object)
12247 Lisp_Object object;
12248{
12249 struct image_keyword fmt[GS_LAST];
12250 Lisp_Object tem;
12251 int i;
12252
12253 bcopy (gs_format, fmt, sizeof fmt);
12254
12255 if (!parse_image_spec (object, fmt, GS_LAST, Qpostscript)
12256 || (fmt[GS_ASCENT].count
12257 && XFASTINT (fmt[GS_ASCENT].value) > 100))
12258 return 0;
12259
12260 /* Bounding box must be a list or vector containing 4 integers. */
12261 tem = fmt[GS_BOUNDING_BOX].value;
12262 if (CONSP (tem))
12263 {
12264 for (i = 0; i < 4; ++i, tem = XCDR (tem))
12265 if (!CONSP (tem) || !INTEGERP (XCAR (tem)))
12266 return 0;
12267 if (!NILP (tem))
12268 return 0;
12269 }
12270 else if (VECTORP (tem))
12271 {
12272 if (XVECTOR (tem)->size != 4)
12273 return 0;
12274 for (i = 0; i < 4; ++i)
12275 if (!INTEGERP (XVECTOR (tem)->contents[i]))
12276 return 0;
12277 }
12278 else
12279 return 0;
12280
12281 return 1;
12282}
12283
12284
12285/* Load Ghostscript image IMG for use on frame F. Value is non-zero
12286 if successful. */
12287
12288static int
12289gs_load (f, img)
12290 struct frame *f;
12291 struct image *img;
12292{
12293 char buffer[100];
12294 Lisp_Object window_and_pixmap_id = Qnil, loader, pt_height, pt_width;
12295 struct gcpro gcpro1, gcpro2;
12296 Lisp_Object frame;
12297 double in_width, in_height;
12298 Lisp_Object pixel_colors = Qnil;
12299
12300 /* Compute pixel size of pixmap needed from the given size in the
12301 image specification. Sizes in the specification are in pt. 1 pt
12302 = 1/72 in, xdpi and ydpi are stored in the frame's X display
12303 info. */
12304 pt_width = image_spec_value (img->spec, QCpt_width, NULL);
12305 in_width = XFASTINT (pt_width) / 72.0;
12306 img->width = in_width * FRAME_W32_DISPLAY_INFO (f)->resx;
12307 pt_height = image_spec_value (img->spec, QCpt_height, NULL);
12308 in_height = XFASTINT (pt_height) / 72.0;
12309 img->height = in_height * FRAME_W32_DISPLAY_INFO (f)->resy;
12310
12311 /* Create the pixmap. */
12312 BLOCK_INPUT;
12313 xassert (img->pixmap == 0);
12314 img->pixmap = XCreatePixmap (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
12315 img->width, img->height,
12316 DefaultDepthOfScreen (FRAME_X_SCREEN (f)));
12317 UNBLOCK_INPUT;
12318
12319 if (!img->pixmap)
12320 {
12321 image_error ("Unable to create pixmap for `%s'", img->spec, Qnil);
12322 return 0;
12323 }
12324
12325 /* Call the loader to fill the pixmap. It returns a process object
12326 if successful. We do not record_unwind_protect here because
12327 other places in redisplay like calling window scroll functions
12328 don't either. Let the Lisp loader use `unwind-protect' instead. */
12329 GCPRO2 (window_and_pixmap_id, pixel_colors);
12330
12331 sprintf (buffer, "%lu %lu",
12332 (unsigned long) FRAME_W32_WINDOW (f),
12333 (unsigned long) img->pixmap);
12334 window_and_pixmap_id = build_string (buffer);
12335
12336 sprintf (buffer, "%lu %lu",
12337 FRAME_FOREGROUND_PIXEL (f),
12338 FRAME_BACKGROUND_PIXEL (f));
12339 pixel_colors = build_string (buffer);
12340
12341 XSETFRAME (frame, f);
12342 loader = image_spec_value (img->spec, QCloader, NULL);
12343 if (NILP (loader))
12344 loader = intern ("gs-load-image");
12345
12346 img->data.lisp_val = call6 (loader, frame, img->spec,
12347 make_number (img->width),
12348 make_number (img->height),
12349 window_and_pixmap_id,
12350 pixel_colors);
12351 UNGCPRO;
12352 return PROCESSP (img->data.lisp_val);
12353}
12354
12355
12356/* Kill the Ghostscript process that was started to fill PIXMAP on
12357 frame F. Called from XTread_socket when receiving an event
12358 telling Emacs that Ghostscript has finished drawing. */
12359
12360void
12361x_kill_gs_process (pixmap, f)
12362 Pixmap pixmap;
12363 struct frame *f;
12364{
12365 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
12366 int class, i;
12367 struct image *img;
12368
12369 /* Find the image containing PIXMAP. */
12370 for (i = 0; i < c->used; ++i)
12371 if (c->images[i]->pixmap == pixmap)
12372 break;
12373
3cf3436e
JR		 12374 /* Should someone in between have cleared the image cache, for
12375 instance, give up. */
12376 if (i == c->used)
12377 return;
12378
6fc2811b
JR		 12379 /* Kill the GS process. We should have found PIXMAP in the image
12380 cache and its image should contain a process object. */
6fc2811b
JR		 12381 img = c->images[i];
12382 xassert (PROCESSP (img->data.lisp_val));
12383 Fkill_process (img->data.lisp_val, Qnil);
12384 img->data.lisp_val = Qnil;
12385
12386 /* On displays with a mutable colormap, figure out the colors
12387 allocated for the image by looking at the pixels of an XImage for
12388 img->pixmap. */
12389 class = FRAME_W32_DISPLAY_INFO (f)->visual->class;
12390 if (class != StaticColor && class != StaticGray && class != TrueColor)
12391 {
12392 XImage *ximg;
12393
12394 BLOCK_INPUT;
12395
12396 /* Try to get an XImage for img->pixmep. */
12397 ximg = XGetImage (FRAME_W32_DISPLAY (f), img->pixmap,
12398 0, 0, img->width, img->height, ~0, ZPixmap);
12399 if (ximg)
12400 {
12401 int x, y;
12402
12403 /* Initialize the color table. */
12404 init_color_table ();
12405
12406 /* For each pixel of the image, look its color up in the
12407 color table. After having done so, the color table will
12408 contain an entry for each color used by the image. */
12409 for (y = 0; y < img->height; ++y)
12410 for (x = 0; x < img->width; ++x)
12411 {
12412 unsigned long pixel = XGetPixel (ximg, x, y);
12413 lookup_pixel_color (f, pixel);
12414 }
12415
12416 /* Record colors in the image. Free color table and XImage. */
12417 img->colors = colors_in_color_table (&img->ncolors);
12418 free_color_table ();
12419 XDestroyImage (ximg);
12420
12421#if 0 /* This doesn't seem to be the case. If we free the colors
12422 here, we get a BadAccess later in x_clear_image when
12423 freeing the colors. */
12424 /* We have allocated colors once, but Ghostscript has also
12425 allocated colors on behalf of us. So, to get the
12426 reference counts right, free them once. */
12427 if (img->ncolors)
3cf3436e 12428 x_free_colors (FRAME_W32_DISPLAY (f), cmap,
6fc2811b 12429 img->colors, img->ncolors, 0);
6fc2811b
JR		 12430#endif
12431 }
12432 else
12433 image_error ("Cannot get X image of `%s'; colors will not be freed",
12434 img->spec, Qnil);
12435
12436 UNBLOCK_INPUT;
12437 }
3cf3436e
JR		 12438
12439 /* Now that we have the pixmap, compute mask and transform the
12440 image if requested. */
12441 BLOCK_INPUT;
12442 postprocess_image (f, img);
12443 UNBLOCK_INPUT;
6fc2811b
JR		 12444}
12445
12446#endif /* HAVE_GHOSTSCRIPT */
12447
12448\f
12449/***********************************************************************
12450 Window properties
12451 ***********************************************************************/
12452
12453DEFUN ("x-change-window-property", Fx_change_window_property,
12454 Sx_change_window_property, 2, 3, 0,
12455 "Change window property PROP to VALUE on the X window of FRAME.\n\
12456PROP and VALUE must be strings. FRAME nil or omitted means use the\n\
12457selected frame. Value is VALUE.")
12458 (prop, value, frame)
12459 Lisp_Object frame, prop, value;
12460{
767b1ff0 12461#if 0 /* TODO : port window properties to W32 */
6fc2811b
JR		 12462 struct frame *f = check_x_frame (frame);
12463 Atom prop_atom;
12464
12465 CHECK_STRING (prop, 1);
12466 CHECK_STRING (value, 2);
12467
12468 BLOCK_INPUT;
12469 prop_atom = XInternAtom (FRAME_W32_DISPLAY (f), XSTRING (prop)->data, False);
12470 XChangeProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
12471 prop_atom, XA_STRING, 8, PropModeReplace,
12472 XSTRING (value)->data, XSTRING (value)->size);
12473
12474 /* Make sure the property is set when we return. */
12475 XFlush (FRAME_W32_DISPLAY (f));
12476 UNBLOCK_INPUT;
12477
767b1ff0 12478#endif /* TODO */
6fc2811b
JR		 12479
12480 return value;
12481}
12482
12483
12484DEFUN ("x-delete-window-property", Fx_delete_window_property,
12485 Sx_delete_window_property, 1, 2, 0,
12486 "Remove window property PROP from X window of FRAME.\n\
12487FRAME nil or omitted means use the selected frame. Value is PROP.")
12488 (prop, frame)
12489 Lisp_Object prop, frame;
12490{
767b1ff0 12491#if 0 /* TODO : port window properties to W32 */
6fc2811b
JR		 12492
12493 struct frame *f = check_x_frame (frame);
12494 Atom prop_atom;
12495
12496 CHECK_STRING (prop, 1);
12497 BLOCK_INPUT;
12498 prop_atom = XInternAtom (FRAME_W32_DISPLAY (f), XSTRING (prop)->data, False);
12499 XDeleteProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f), prop_atom);
12500
12501 /* Make sure the property is removed when we return. */
12502 XFlush (FRAME_W32_DISPLAY (f));
12503 UNBLOCK_INPUT;
767b1ff0 12504#endif /* TODO */
6fc2811b
JR		 12505
12506 return prop;
12507}
12508
12509
12510DEFUN ("x-window-property", Fx_window_property, Sx_window_property,
12511 1, 2, 0,
12512 "Value is the value of window property PROP on FRAME.\n\
12513If FRAME is nil or omitted, use the selected frame. Value is nil\n\
12514if FRAME hasn't a property with name PROP or if PROP has no string\n\
12515value.")
12516 (prop, frame)
12517 Lisp_Object prop, frame;
12518{
767b1ff0 12519#if 0 /* TODO : port window properties to W32 */
6fc2811b
JR		 12520
12521 struct frame *f = check_x_frame (frame);
12522 Atom prop_atom;
12523 int rc;
12524 Lisp_Object prop_value = Qnil;
12525 char *tmp_data = NULL;
12526 Atom actual_type;
12527 int actual_format;
12528 unsigned long actual_size, bytes_remaining;
12529
12530 CHECK_STRING (prop, 1);
12531 BLOCK_INPUT;
12532 prop_atom = XInternAtom (FRAME_W32_DISPLAY (f), XSTRING (prop)->data, False);
12533 rc = XGetWindowProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
12534 prop_atom, 0, 0, False, XA_STRING,
12535 &actual_type, &actual_format, &actual_size,
12536 &bytes_remaining, (unsigned char **) &tmp_data);
12537 if (rc == Success)
12538 {
12539 int size = bytes_remaining;
12540
12541 XFree (tmp_data);
12542 tmp_data = NULL;
12543
12544 rc = XGetWindowProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
12545 prop_atom, 0, bytes_remaining,
12546 False, XA_STRING,
12547 &actual_type, &actual_format,
12548 &actual_size, &bytes_remaining,
12549 (unsigned char **) &tmp_data);
12550 if (rc == Success)
12551 prop_value = make_string (tmp_data, size);
12552
12553 XFree (tmp_data);
12554 }
12555
12556 UNBLOCK_INPUT;
12557
12558 return prop_value;
12559
767b1ff0 12560#endif /* TODO */
6fc2811b
JR		 12561 return Qnil;
12562}
12563
12564
12565\f
12566/***********************************************************************
12567 Busy cursor
12568 ***********************************************************************/
12569
f79e6790 12570/* If non-null, an asynchronous timer that, when it expires, displays
0af913d7 12571 an hourglass cursor on all frames. */
6fc2811b 12572
0af913d7 12573static struct atimer *hourglass_atimer;
6fc2811b 12574
0af913d7 12575/* Non-zero means an hourglass cursor is currently shown. */
6fc2811b 12576
0af913d7 12577static int hourglass_shown_p;
6fc2811b 12578
0af913d7 12579/* Number of seconds to wait before displaying an hourglass cursor. */
6fc2811b 12580
0af913d7 12581static Lisp_Object Vhourglass_delay;
6fc2811b 12582
0af913d7 12583/* Default number of seconds to wait before displaying an hourglass
f79e6790
JR		 12584 cursor. */
12585
0af913d7 12586#define DEFAULT_HOURGLASS_DELAY 1
f79e6790
JR		 12587
12588/* Function prototypes. */
12589
0af913d7
GM		 12590static void show_hourglass P_ ((struct atimer *));
12591static void hide_hourglass P_ ((void));
f79e6790
JR		 12592
12593
0af913d7 12594/* Cancel a currently active hourglass timer, and start a new one. */
f79e6790
JR		 12595
12596void
0af913d7 12597start_hourglass ()
f79e6790 12598{
767b1ff0 12599#if 0 /* TODO: cursor shape changes. */
f79e6790 12600 EMACS_TIME delay;
dfff8a69 12601 int secs, usecs = 0;
f79e6790 12602
0af913d7 12603 cancel_hourglass ();
f79e6790 12604
0af913d7
GM		 12605 if (INTEGERP (Vhourglass_delay)
12606 && XINT (Vhourglass_delay) > 0)
12607 secs = XFASTINT (Vhourglass_delay);
12608 else if (FLOATP (Vhourglass_delay)
12609 && XFLOAT_DATA (Vhourglass_delay) > 0)
dfff8a69
JR		 12610 {
12611 Lisp_Object tem;
0af913d7 12612 tem = Ftruncate (Vhourglass_delay, Qnil);
dfff8a69 12613 secs = XFASTINT (tem);
0af913d7 12614 usecs = (XFLOAT_DATA (Vhourglass_delay) - secs) * 1000000;
dfff8a69 12615 }
f79e6790 12616 else
0af913d7 12617 secs = DEFAULT_HOURGLASS_DELAY;
f79e6790 12618
dfff8a69 12619 EMACS_SET_SECS_USECS (delay, secs, usecs);
0af913d7
GM		 12620 hourglass_atimer = start_atimer (ATIMER_RELATIVE, delay,
12621 show_hourglass, NULL);
f79e6790
JR		 12622#endif
12623}
12624
12625
0af913d7
GM		 12626/* Cancel the hourglass cursor timer if active, hide an hourglass
12627 cursor if shown. */
f79e6790
JR		 12628
12629void
0af913d7 12630cancel_hourglass ()
f79e6790 12631{
0af913d7 12632 if (hourglass_atimer)
dfff8a69 12633 {
0af913d7
GM		 12634 cancel_atimer (hourglass_atimer);
12635 hourglass_atimer = NULL;
dfff8a69
JR		 12636 }
12637
0af913d7
GM		 12638 if (hourglass_shown_p)
12639 hide_hourglass ();
f79e6790
JR		 12640}
12641
12642
0af913d7
GM		 12643/* Timer function of hourglass_atimer. TIMER is equal to
12644 hourglass_atimer.
f79e6790 12645
0af913d7
GM		 12646 Display an hourglass cursor on all frames by mapping the frames'
12647 hourglass_window. Set the hourglass_p flag in the frames'
12648 output_data.x structure to indicate that an hourglass cursor is
12649 shown on the frames. */
f79e6790
JR		 12650
12651static void
0af913d7 12652show_hourglass (timer)
f79e6790 12653 struct atimer *timer;
6fc2811b 12654{
767b1ff0 12655#if 0 /* TODO: cursor shape changes. */
f79e6790 12656 /* The timer implementation will cancel this timer automatically
0af913d7 12657 after this function has run. Set hourglass_atimer to null
f79e6790 12658 so that we know the timer doesn't have to be canceled. */
0af913d7 12659 hourglass_atimer = NULL;
f79e6790 12660
0af913d7 12661 if (!hourglass_shown_p)
6fc2811b
JR		 12662 {
12663 Lisp_Object rest, frame;
f79e6790
JR		 12664
12665 BLOCK_INPUT;
12666
6fc2811b 12667 FOR_EACH_FRAME (rest, frame)
dc220243 12668 if (FRAME_W32_P (XFRAME (frame)))
6fc2811b
JR		 12669 {
12670 struct frame *f = XFRAME (frame);
f79e6790 12671
0af913d7 12672 f->output_data.w32->hourglass_p = 1;
f79e6790 12673
0af913d7 12674 if (!f->output_data.w32->hourglass_window)
6fc2811b
JR		 12675 {
12676 unsigned long mask = CWCursor;
12677 XSetWindowAttributes attrs;
f79e6790 12678
0af913d7 12679 attrs.cursor = f->output_data.w32->hourglass_cursor;
f79e6790 12680
0af913d7 12681 f->output_data.w32->hourglass_window
f79e6790 12682 = XCreateWindow (FRAME_X_DISPLAY (f),
6fc2811b
JR		 12683 FRAME_OUTER_WINDOW (f),
12684 0, 0, 32000, 32000, 0, 0,
f79e6790
JR		 12685 InputOnly,
12686 CopyFromParent,
6fc2811b
JR		 12687 mask, &attrs);
12688 }
f79e6790 12689
0af913d7
GM		 12690 XMapRaised (FRAME_X_DISPLAY (f),
12691 f->output_data.w32->hourglass_window);
f79e6790 12692 XFlush (FRAME_X_DISPLAY (f));
6fc2811b 12693 }
6fc2811b 12694
0af913d7 12695 hourglass_shown_p = 1;
f79e6790
JR		 12696 UNBLOCK_INPUT;
12697 }
12698#endif
6fc2811b
JR		 12699}
12700
12701
0af913d7 12702/* Hide the hourglass cursor on all frames, if it is currently shown. */
6fc2811b 12703
f79e6790 12704static void
0af913d7 12705hide_hourglass ()
f79e6790 12706{
767b1ff0 12707#if 0 /* TODO: cursor shape changes. */
0af913d7 12708 if (hourglass_shown_p)
6fc2811b 12709 {
f79e6790
JR		 12710 Lisp_Object rest, frame;
12711
12712 BLOCK_INPUT;
12713 FOR_EACH_FRAME (rest, frame)
6fc2811b 12714 {
f79e6790
JR		 12715 struct frame *f = XFRAME (frame);
12716
dc220243 12717 if (FRAME_W32_P (f)
f79e6790 12718 /* Watch out for newly created frames. */
0af913d7 12719 && f->output_data.x->hourglass_window)
f79e6790 12720 {
0af913d7
GM		 12721 XUnmapWindow (FRAME_X_DISPLAY (f),
12722 f->output_data.x->hourglass_window);
12723 /* Sync here because XTread_socket looks at the
12724 hourglass_p flag that is reset to zero below. */
f79e6790 12725 XSync (FRAME_X_DISPLAY (f), False);
0af913d7 12726 f->output_data.x->hourglass_p = 0;
f79e6790 12727 }
6fc2811b 12728 }
6fc2811b 12729
0af913d7 12730 hourglass_shown_p = 0;
f79e6790
JR		 12731 UNBLOCK_INPUT;
12732 }
12733#endif
6fc2811b
JR		 12734}
12735
12736
12737\f
12738/***********************************************************************
12739 Tool tips
12740 ***********************************************************************/
12741
12742static Lisp_Object x_create_tip_frame P_ ((struct w32_display_info *,
3cf3436e
JR		 12743 Lisp_Object, Lisp_Object));
12744static void compute_tip_xy P_ ((struct frame *, Lisp_Object, Lisp_Object,
12745 Lisp_Object, int, int, int *, int *));
6fc2811b 12746
3cf3436e 12747/* The frame of a currently visible tooltip. */
6fc2811b 12748
937e601e 12749Lisp_Object tip_frame;
6fc2811b
JR		 12750
12751/* If non-nil, a timer started that hides the last tooltip when it
12752 fires. */
12753
12754Lisp_Object tip_timer;
12755Window tip_window;
12756
3cf3436e
JR		 12757/* If non-nil, a vector of 3 elements containing the last args
12758 with which x-show-tip was called. See there. */
12759
12760Lisp_Object last_show_tip_args;
12761
12762/* Maximum size for tooltips; a cons (COLUMNS . ROWS). */
12763
12764Lisp_Object Vx_max_tooltip_size;
12765
12766
937e601e
AI		 12767static Lisp_Object
12768unwind_create_tip_frame (frame)
12769 Lisp_Object frame;
12770{
c844a81a
GM		 12771 Lisp_Object deleted;
12772
12773 deleted = unwind_create_frame (frame);
12774 if (EQ (deleted, Qt))
12775 {
12776 tip_window = NULL;
12777 tip_frame = Qnil;
12778 }
12779
12780 return deleted;
937e601e
AI		 12781}
12782
12783
6fc2811b 12784/* Create a frame for a tooltip on the display described by DPYINFO.
3cf3436e
JR		 12785 PARMS is a list of frame parameters. TEXT is the string to
12786 display in the tip frame. Value is the frame.
937e601e
AI		 12787
12788 Note that functions called here, esp. x_default_parameter can
12789 signal errors, for instance when a specified color name is
12790 undefined. We have to make sure that we're in a consistent state
12791 when this happens. */
6fc2811b
JR		 12792
12793static Lisp_Object
3cf3436e 12794x_create_tip_frame (dpyinfo, parms, text)
6fc2811b 12795 struct w32_display_info *dpyinfo;
3cf3436e 12796 Lisp_Object parms, text;
6fc2811b 12797{
767b1ff0 12798#if 0 /* TODO : w32 version */
6fc2811b
JR		 12799 struct frame *f;
12800 Lisp_Object frame, tem;
12801 Lisp_Object name;
12802 long window_prompting = 0;
12803 int width, height;
dc220243 12804 int count = BINDING_STACK_SIZE ();
6fc2811b
JR		 12805 struct gcpro gcpro1, gcpro2, gcpro3;
12806 struct kboard *kb;
3cf3436e
JR		 12807 int face_change_count_before = face_change_count;
12808 Lisp_Object buffer;
12809 struct buffer *old_buffer;
6fc2811b
JR		 12810
12811 check_x ();
12812
12813 /* Use this general default value to start with until we know if
12814 this frame has a specified name. */
12815 Vx_resource_name = Vinvocation_name;
12816
12817#ifdef MULTI_KBOARD
12818 kb = dpyinfo->kboard;
12819#else
12820 kb = &the_only_kboard;
12821#endif
12822
12823 /* Get the name of the frame to use for resource lookup. */
12824 name = w32_get_arg (parms, Qname, "name", "Name", RES_TYPE_STRING);
12825 if (!STRINGP (name)
12826 && !EQ (name, Qunbound)
12827 && !NILP (name))
12828 error ("Invalid frame name--not a string or nil");
12829 Vx_resource_name = name;
12830
12831 frame = Qnil;
12832 GCPRO3 (parms, name, frame);
937e601e 12833 f = make_frame (1);
6fc2811b 12834 XSETFRAME (frame, f);
3cf3436e
JR		 12835
12836 buffer = Fget_buffer_create (build_string (" *tip*"));
12837 Fset_window_buffer (FRAME_ROOT_WINDOW (f), buffer);
12838 old_buffer = current_buffer;
12839 set_buffer_internal_1 (XBUFFER (buffer));
12840 current_buffer->truncate_lines = Qnil;
12841 Ferase_buffer ();
12842 Finsert (1, &text);
12843 set_buffer_internal_1 (old_buffer);
12844
6fc2811b 12845 FRAME_CAN_HAVE_SCROLL_BARS (f) = 0;
937e601e 12846 record_unwind_protect (unwind_create_tip_frame, frame);
6fc2811b 12847
3cf3436e
JR		 12848 /* By setting the output method, we're essentially saying that
12849 the frame is live, as per FRAME_LIVE_P. If we get a signal
12850 from this point on, x_destroy_window might screw up reference
12851 counts etc. */
d88c567c 12852 f->output_method = output_w32;
6fc2811b
JR		 12853 f->output_data.w32 =
12854 (struct w32_output *) xmalloc (sizeof (struct w32_output));
12855 bzero (f->output_data.w32, sizeof (struct w32_output));
12856#if 0
12857 f->output_data.w32->icon_bitmap = -1;
12858#endif
12859 f->output_data.w32->fontset = -1;
12860 f->icon_name = Qnil;
12861
937e601e
AI		 12862#ifdef GLYPH_DEBUG
12863 image_cache_refcount = FRAME_X_IMAGE_CACHE (f)->refcount;
12864 dpyinfo_refcount = dpyinfo->reference_count;
12865#endif /* GLYPH_DEBUG */
6fc2811b
JR		 12866#ifdef MULTI_KBOARD
12867 FRAME_KBOARD (f) = kb;
12868#endif
12869 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
12870 f->output_data.w32->explicit_parent = 0;
12871
12872 /* Set the name; the functions to which we pass f expect the name to
12873 be set. */
12874 if (EQ (name, Qunbound) || NILP (name))
12875 {
12876 f->name = build_string (dpyinfo->x_id_name);
12877 f->explicit_name = 0;
12878 }
12879 else
12880 {
12881 f->name = name;
12882 f->explicit_name = 1;
12883 /* use the frame's title when getting resources for this frame. */
12884 specbind (Qx_resource_name, name);
12885 }
12886
6fc2811b
JR		 12887 /* Extract the window parameters from the supplied values
12888 that are needed to determine window geometry. */
12889 {
12890 Lisp_Object font;
12891
12892 font = w32_get_arg (parms, Qfont, "font", "Font", RES_TYPE_STRING);
12893
12894 BLOCK_INPUT;
12895 /* First, try whatever font the caller has specified. */
12896 if (STRINGP (font))
12897 {
12898 tem = Fquery_fontset (font, Qnil);
12899 if (STRINGP (tem))
12900 font = x_new_fontset (f, XSTRING (tem)->data);
12901 else
12902 font = x_new_font (f, XSTRING (font)->data);
12903 }
12904
12905 /* Try out a font which we hope has bold and italic variations. */
12906 if (!STRINGP (font))
e39649be 12907 font = x_new_font (f, "-*-courier new-normal-r-*-*-*-100-*-*-*-*-iso8859-1");
6fc2811b
JR		 12908 if (!STRINGP (font))
12909 font = x_new_font (f, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
12910 if (! STRINGP (font))
12911 font = x_new_font (f, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
12912 if (! STRINGP (font))
12913 /* This was formerly the first thing tried, but it finds too many fonts
12914 and takes too long. */
12915 font = x_new_font (f, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
12916 /* If those didn't work, look for something which will at least work. */
12917 if (! STRINGP (font))
12918 font = x_new_font (f, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
12919 UNBLOCK_INPUT;
12920 if (! STRINGP (font))
12921 font = build_string ("fixed");
12922
12923 x_default_parameter (f, parms, Qfont, font,
12924 "font", "Font", RES_TYPE_STRING);
12925 }
12926
12927 x_default_parameter (f, parms, Qborder_width, make_number (2),
12928 "borderWidth", "BorderWidth", RES_TYPE_NUMBER);
12929
12930 /* This defaults to 2 in order to match xterm. We recognize either
12931 internalBorderWidth or internalBorder (which is what xterm calls
12932 it). */
12933 if (NILP (Fassq (Qinternal_border_width, parms)))
12934 {
12935 Lisp_Object value;
12936
12937 value = w32_get_arg (parms, Qinternal_border_width,
12938 "internalBorder", "internalBorder", RES_TYPE_NUMBER);
12939 if (! EQ (value, Qunbound))
12940 parms = Fcons (Fcons (Qinternal_border_width, value),
12941 parms);
12942 }
12943
12944 x_default_parameter (f, parms, Qinternal_border_width, make_number (1),
12945 "internalBorderWidth", "internalBorderWidth",
12946 RES_TYPE_NUMBER);
12947
12948 /* Also do the stuff which must be set before the window exists. */
12949 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
12950 "foreground", "Foreground", RES_TYPE_STRING);
12951 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
12952 "background", "Background", RES_TYPE_STRING);
12953 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
12954 "pointerColor", "Foreground", RES_TYPE_STRING);
12955 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
12956 "cursorColor", "Foreground", RES_TYPE_STRING);
12957 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
12958 "borderColor", "BorderColor", RES_TYPE_STRING);
12959
12960 /* Init faces before x_default_parameter is called for scroll-bar
12961 parameters because that function calls x_set_scroll_bar_width,
12962 which calls change_frame_size, which calls Fset_window_buffer,
12963 which runs hooks, which call Fvertical_motion. At the end, we
12964 end up in init_iterator with a null face cache, which should not
12965 happen. */
12966 init_frame_faces (f);
12967
12968 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
12969 window_prompting = x_figure_window_size (f, parms);
12970
12971 if (window_prompting & XNegative)
12972 {
12973 if (window_prompting & YNegative)
12974 f->output_data.w32->win_gravity = SouthEastGravity;
12975 else
12976 f->output_data.w32->win_gravity = NorthEastGravity;
12977 }
12978 else
12979 {
12980 if (window_prompting & YNegative)
12981 f->output_data.w32->win_gravity = SouthWestGravity;
12982 else
12983 f->output_data.w32->win_gravity = NorthWestGravity;
12984 }
12985
12986 f->output_data.w32->size_hint_flags = window_prompting;
12987 {
12988 XSetWindowAttributes attrs;
12989 unsigned long mask;
12990
12991 BLOCK_INPUT;
3cf3436e
JR		 12992 mask = CWBackPixel | CWOverrideRedirect | CWEventMask;
12993 if (DoesSaveUnders (dpyinfo->screen))
12994 mask |= CWSaveUnder;
12995
6fc2811b
JR		 12996 /* Window managers looks at the override-redirect flag to
12997 determine whether or net to give windows a decoration (Xlib
12998 3.2.8). */
12999 attrs.override_redirect = True;
13000 attrs.save_under = True;
13001 attrs.background_pixel = FRAME_BACKGROUND_PIXEL (f);
13002 /* Arrange for getting MapNotify and UnmapNotify events. */
13003 attrs.event_mask = StructureNotifyMask;
13004 tip_window
13005 = FRAME_W32_WINDOW (f)
13006 = XCreateWindow (FRAME_W32_DISPLAY (f),
13007 FRAME_W32_DISPLAY_INFO (f)->root_window,
13008 /* x, y, width, height */
13009 0, 0, 1, 1,
13010 /* Border. */
13011 1,
13012 CopyFromParent, InputOutput, CopyFromParent,
13013 mask, &attrs);
13014 UNBLOCK_INPUT;
13015 }
13016
13017 x_make_gc (f);
13018
13019 x_default_parameter (f, parms, Qauto_raise, Qnil,
13020 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
13021 x_default_parameter (f, parms, Qauto_lower, Qnil,
13022 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
13023 x_default_parameter (f, parms, Qcursor_type, Qbox,
13024 "cursorType", "CursorType", RES_TYPE_SYMBOL);
13025
13026 /* Dimensions, especially f->height, must be done via change_frame_size.
13027 Change will not be effected unless different from the current
13028 f->height. */
13029 width = f->width;
13030 height = f->height;
13031 f->height = 0;
13032 SET_FRAME_WIDTH (f, 0);
13033 change_frame_size (f, height, width, 1, 0, 0);
13034
3cf3436e
JR		 13035 /* Set up faces after all frame parameters are known. This call
13036 also merges in face attributes specified for new frames.
13037
13038 Frame parameters may be changed if .Xdefaults contains
13039 specifications for the default font. For example, if there is an
13040 `Emacs.default.attributeBackground: pink', the `background-color'
13041 attribute of the frame get's set, which let's the internal border
13042 of the tooltip frame appear in pink. Prevent this. */
13043 {
13044 Lisp_Object bg = Fframe_parameter (frame, Qbackground_color);
13045
13046 /* Set tip_frame here, so that */
13047 tip_frame = frame;
13048 call1 (Qface_set_after_frame_default, frame);
13049
13050 if (!EQ (bg, Fframe_parameter (frame, Qbackground_color)))
13051 Fmodify_frame_parameters (frame, Fcons (Fcons (Qbackground_color, bg),
13052 Qnil));
13053 }
13054
6fc2811b
JR		 13055 f->no_split = 1;
13056
13057 UNGCPRO;
13058
13059 /* It is now ok to make the frame official even if we get an error
13060 below. And the frame needs to be on Vframe_list or making it
13061 visible won't work. */
13062 Vframe_list = Fcons (frame, Vframe_list);
13063
13064 /* Now that the frame is official, it counts as a reference to
13065 its display. */
13066 FRAME_W32_DISPLAY_INFO (f)->reference_count++;
ee78dc32 13067
3cf3436e
JR		 13068 /* Setting attributes of faces of the tooltip frame from resources
13069 and similar will increment face_change_count, which leads to the
13070 clearing of all current matrices. Since this isn't necessary
13071 here, avoid it by resetting face_change_count to the value it
13072 had before we created the tip frame. */
13073 face_change_count = face_change_count_before;
13074
13075 /* Discard the unwind_protect. */
6fc2811b 13076 return unbind_to (count, frame);
767b1ff0 13077#endif /* TODO */
6fc2811b 13078 return Qnil;
ee78dc32
GV		 13079}
13080
3cf3436e
JR		 13081
13082/* Compute where to display tip frame F. PARMS is the list of frame
13083 parameters for F. DX and DY are specified offsets from the current
13084 location of the mouse. WIDTH and HEIGHT are the width and height
13085 of the tooltip. Return coordinates relative to the root window of
13086 the display in *ROOT_X, and *ROOT_Y. */
13087
13088static void
13089compute_tip_xy (f, parms, dx, dy, width, height, root_x, root_y)
13090 struct frame *f;
13091 Lisp_Object parms, dx, dy;
13092 int width, height;
13093 int *root_x, *root_y;
13094{
13095#ifdef TODO /* Tool tips not supported. */
13096 Lisp_Object left, top;
13097 int win_x, win_y;
13098 Window root, child;
13099 unsigned pmask;
13100
13101 /* User-specified position? */
13102 left = Fcdr (Fassq (Qleft, parms));
13103 top = Fcdr (Fassq (Qtop, parms));
13104
13105 /* Move the tooltip window where the mouse pointer is. Resize and
13106 show it. */
13107 if (!INTEGERP (left) && !INTEGERP (top))
13108 {
13109 BLOCK_INPUT;
13110 XQueryPointer (FRAME_X_DISPLAY (f), FRAME_X_DISPLAY_INFO (f)->root_window,
13111 &root, &child, root_x, root_y, &win_x, &win_y, &pmask);
13112 UNBLOCK_INPUT;
13113 }
13114
13115 if (INTEGERP (top))
13116 *root_y = XINT (top);
13117 else if (*root_y + XINT (dy) - height < 0)
13118 *root_y -= XINT (dy);
13119 else
13120 {
13121 *root_y -= height;
13122 *root_y += XINT (dy);
13123 }
13124
13125 if (INTEGERP (left))
13126 *root_x = XINT (left);
13127 else if (*root_x + XINT (dx) + width > FRAME_X_DISPLAY_INFO (f)->width)
13128 *root_x -= width + XINT (dx);
13129 else
13130 *root_x += XINT (dx);
13131
13132#endif /* Tooltip support. */
13133}
13134
13135
767b1ff0 13136#ifdef TODO /* Tooltip support not complete. */
71eab8d1 13137DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
6fc2811b 13138 "Show STRING in a \"tooltip\" window on frame FRAME.\n\
dc220243 13139A tooltip window is a small window displaying a string.\n\
71eab8d1 13140\n\
6fc2811b 13141FRAME nil or omitted means use the selected frame.\n\
71eab8d1 13142\n\
6fc2811b
JR		 13143PARMS is an optional list of frame parameters which can be\n\
13144used to change the tooltip's appearance.\n\
71eab8d1 13145\n\
6fc2811b 13146Automatically hide the tooltip after TIMEOUT seconds.\n\
71eab8d1
AI		 13147TIMEOUT nil means use the default timeout of 5 seconds.\n\
13148\n\
13149If the list of frame parameters PARAMS contains a `left' parameters,\n\
13150the tooltip is displayed at that x-position. Otherwise it is\n\
13151displayed at the mouse position, with offset DX added (default is 5 if\n\
13152DX isn't specified). Likewise for the y-position; if a `top' frame\n\
13153parameter is specified, it determines the y-position of the tooltip\n\
13154window, otherwise it is displayed at the mouse position, with offset\n\
3cf3436e
JR		 13155DY added (default is -10).\n\
13156\n\
13157A tooltip's maximum size is specified by `x-max-tooltip-size'.\n\
13158Text larger than the specified size is clipped.")
71eab8d1
AI		 13159 (string, frame, parms, timeout, dx, dy)
13160 Lisp_Object string, frame, parms, timeout, dx, dy;
ee78dc32 13161{
6fc2811b
JR		 13162 struct frame *f;
13163 struct window *w;
3cf3436e
JR		 13164 Lisp_Object buffer, top, left, max_width, max_height;
13165 int root_x, root_y;
6fc2811b
JR		 13166 struct buffer *old_buffer;
13167 struct text_pos pos;
13168 int i, width, height;
6fc2811b
JR		 13169 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
13170 int old_windows_or_buffers_changed = windows_or_buffers_changed;
13171 int count = specpdl_ptr - specpdl;
13172
13173 specbind (Qinhibit_redisplay, Qt);
ee78dc32 13174
dfff8a69 13175 GCPRO4 (string, parms, frame, timeout);
ee78dc32 13176
6fc2811b
JR		 13177 CHECK_STRING (string, 0);
13178 f = check_x_frame (frame);
13179 if (NILP (timeout))
13180 timeout = make_number (5);
13181 else
13182 CHECK_NATNUM (timeout, 2);
ee78dc32 13183
71eab8d1
AI		 13184 if (NILP (dx))
13185 dx = make_number (5);
13186 else
13187 CHECK_NUMBER (dx, 5);
13188
13189 if (NILP (dy))
dc220243 13190 dy = make_number (-10);
71eab8d1
AI		 13191 else
13192 CHECK_NUMBER (dy, 6);
13193
dc220243
JR		 13194 if (NILP (last_show_tip_args))
13195 last_show_tip_args = Fmake_vector (make_number (3), Qnil);
13196
13197 if (!NILP (tip_frame))
13198 {
13199 Lisp_Object last_string = AREF (last_show_tip_args, 0);
13200 Lisp_Object last_frame = AREF (last_show_tip_args, 1);
13201 Lisp_Object last_parms = AREF (last_show_tip_args, 2);
13202
13203 if (EQ (frame, last_frame)
13204 && !NILP (Fequal (last_string, string))
13205 && !NILP (Fequal (last_parms, parms)))
13206 {
13207 struct frame *f = XFRAME (tip_frame);
13208
13209 /* Only DX and DY have changed. */
13210 if (!NILP (tip_timer))
13211 {
13212 Lisp_Object timer = tip_timer;
13213 tip_timer = Qnil;
13214 call1 (Qcancel_timer, timer);
13215 }
13216
13217 BLOCK_INPUT;
13218 compute_tip_xy (f, parms, dx, dy, &root_x, &root_y);
13219 XMoveWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
13220 root_x, root_y - PIXEL_HEIGHT (f));
13221 UNBLOCK_INPUT;
13222 goto start_timer;
13223 }
13224 }
13225
6fc2811b
JR		 13226 /* Hide a previous tip, if any. */
13227 Fx_hide_tip ();
ee78dc32 13228
dc220243
JR		 13229 ASET (last_show_tip_args, 0, string);
13230 ASET (last_show_tip_args, 1, frame);
13231 ASET (last_show_tip_args, 2, parms);
13232
6fc2811b
JR		 13233 /* Add default values to frame parameters. */
13234 if (NILP (Fassq (Qname, parms)))
13235 parms = Fcons (Fcons (Qname, build_string ("tooltip")), parms);
13236 if (NILP (Fassq (Qinternal_border_width, parms)))
13237 parms = Fcons (Fcons (Qinternal_border_width, make_number (3)), parms);
13238 if (NILP (Fassq (Qborder_width, parms)))
13239 parms = Fcons (Fcons (Qborder_width, make_number (1)), parms);
13240 if (NILP (Fassq (Qborder_color, parms)))
13241 parms = Fcons (Fcons (Qborder_color, build_string ("lightyellow")), parms);
13242 if (NILP (Fassq (Qbackground_color, parms)))
13243 parms = Fcons (Fcons (Qbackground_color, build_string ("lightyellow")),
13244 parms);
13245
13246 /* Create a frame for the tooltip, and record it in the global
13247 variable tip_frame. */
13248 frame = x_create_tip_frame (FRAME_W32_DISPLAY_INFO (f), parms);
937e601e 13249 f = XFRAME (frame);
6fc2811b 13250
3cf3436e 13251 /* Set up the frame's root window. */
6fc2811b
JR		 13252 w = XWINDOW (FRAME_ROOT_WINDOW (f));
13253 w->left = w->top = make_number (0);
3cf3436e
JR		 13254
13255 if (CONSP (Vx_max_tooltip_size)
13256 && INTEGERP (XCAR (Vx_max_tooltip_size))
13257 && XINT (XCAR (Vx_max_tooltip_size)) > 0
13258 && INTEGERP (XCDR (Vx_max_tooltip_size))
13259 && XINT (XCDR (Vx_max_tooltip_size)) > 0)
13260 {
13261 w->width = XCAR (Vx_max_tooltip_size);
13262 w->height = XCDR (Vx_max_tooltip_size);
13263 }
13264 else
13265 {
13266 w->width = make_number (80);
13267 w->height = make_number (40);
13268 }
13269
13270 f->window_width = XINT (w->width);
6fc2811b
JR		 13271 adjust_glyphs (f);
13272 w->pseudo_window_p = 1;
13273
13274 /* Display the tooltip text in a temporary buffer. */
6fc2811b 13275 old_buffer = current_buffer;
3cf3436e
JR		 13276 set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f))->buffer));
13277 current_buffer->truncate_lines = Qnil;
6fc2811b
JR		 13278 clear_glyph_matrix (w->desired_matrix);
13279 clear_glyph_matrix (w->current_matrix);
13280 SET_TEXT_POS (pos, BEGV, BEGV_BYTE);
13281 try_window (FRAME_ROOT_WINDOW (f), pos);
13282
13283 /* Compute width and height of the tooltip. */
13284 width = height = 0;
13285 for (i = 0; i < w->desired_matrix->nrows; ++i)
ee78dc32 13286 {
6fc2811b
JR		 13287 struct glyph_row *row = &w->desired_matrix->rows[i];
13288 struct glyph *last;
13289 int row_width;
13290
13291 /* Stop at the first empty row at the end. */
13292 if (!row->enabled_p || !row->displays_text_p)
13293 break;
13294
13295 /* Let the row go over the full width of the frame. */
13296 row->full_width_p = 1;
13297
13298 /* There's a glyph at the end of rows that is use to place
13299 the cursor there. Don't include the width of this glyph. */
13300 if (row->used[TEXT_AREA])
13301 {
13302 last = &row->glyphs[TEXT_AREA][row->used[TEXT_AREA] - 1];
13303 row_width = row->pixel_width - last->pixel_width;
13304 }
13305 else
13306 row_width = row->pixel_width;
13307
13308 height += row->height;
13309 width = max (width, row_width);
ee78dc32
GV		 13310 }
13311
6fc2811b
JR		 13312 /* Add the frame's internal border to the width and height the X
13313 window should have. */
13314 height += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
13315 width += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
ee78dc32 13316
6fc2811b
JR		 13317 /* Move the tooltip window where the mouse pointer is. Resize and
13318 show it. */
3cf3436e 13319 compute_tip_xy (f, parms, dx, dy, width, height, &root_x, &root_y);
71eab8d1 13320
71eab8d1
AI		 13321 BLOCK_INPUT;
13322 XMoveResizeWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
13323 root_x, root_y - height, width, height);
13324 XMapRaised (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f));
6fc2811b 13325 UNBLOCK_INPUT;
ee78dc32 13326
6fc2811b
JR		 13327 /* Draw into the window. */
13328 w->must_be_updated_p = 1;
13329 update_single_window (w, 1);
ee78dc32 13330
6fc2811b
JR		 13331 /* Restore original current buffer. */
13332 set_buffer_internal_1 (old_buffer);
13333 windows_or_buffers_changed = old_windows_or_buffers_changed;
ee78dc32 13334
dc220243 13335 start_timer:
6fc2811b
JR		 13336 /* Let the tip disappear after timeout seconds. */
13337 tip_timer = call3 (intern ("run-at-time"), timeout, Qnil,
13338 intern ("x-hide-tip"));
ee78dc32 13339
dfff8a69 13340 UNGCPRO;
6fc2811b 13341 return unbind_to (count, Qnil);
ee78dc32
GV		 13342}
13343
ee78dc32 13344
6fc2811b
JR		 13345DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0,
13346 "Hide the current tooltip window, if there is any.\n\
3cf3436e 13347Value is t if tooltip was open, nil otherwise.")
6fc2811b
JR		 13348 ()
13349{
937e601e
AI		 13350 int count;
13351 Lisp_Object deleted, frame, timer;
13352 struct gcpro gcpro1, gcpro2;
13353
13354 /* Return quickly if nothing to do. */
13355 if (NILP (tip_timer) && NILP (tip_frame))
13356 return Qnil;
13357
13358 frame = tip_frame;
13359 timer = tip_timer;
13360 GCPRO2 (frame, timer);
13361 tip_frame = tip_timer = deleted = Qnil;
6fc2811b 13362
937e601e 13363 count = BINDING_STACK_SIZE ();
6fc2811b 13364 specbind (Qinhibit_redisplay, Qt);
937e601e 13365 specbind (Qinhibit_quit, Qt);
6fc2811b 13366
937e601e 13367 if (!NILP (timer))
dc220243 13368 call1 (Qcancel_timer, timer);
ee78dc32 13369
937e601e 13370 if (FRAMEP (frame))
6fc2811b 13371 {
937e601e
AI		 13372 Fdelete_frame (frame, Qnil);
13373 deleted = Qt;
6fc2811b 13374 }
1edf84e7 13375
937e601e
AI		 13376 UNGCPRO;
13377 return unbind_to (count, deleted);
6fc2811b 13378}
767b1ff0 13379#endif
5ac45f98 13380
5ac45f98 13381
6fc2811b
JR		 13382\f
13383/***********************************************************************
13384 File selection dialog
13385 ***********************************************************************/
13386
13387extern Lisp_Object Qfile_name_history;
13388
13389DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 4, 0,
13390 "Read file name, prompting with PROMPT in directory DIR.\n\
13391Use a file selection dialog.\n\
13392Select DEFAULT-FILENAME in the dialog's file selection box, if\n\
3cf3436e 13393specified. Ensure that file exists if MUSTMATCH is non-nil.")
6fc2811b
JR		 13394 (prompt, dir, default_filename, mustmatch)
13395 Lisp_Object prompt, dir, default_filename, mustmatch;
13396{
13397 struct frame *f = SELECTED_FRAME ();
13398 Lisp_Object file = Qnil;
13399 int count = specpdl_ptr - specpdl;
13400 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
13401 char filename[MAX_PATH + 1];
13402 char init_dir[MAX_PATH + 1];
13403 int use_dialog_p = 1;
13404
13405 GCPRO5 (prompt, dir, default_filename, mustmatch, file);
13406 CHECK_STRING (prompt, 0);
13407 CHECK_STRING (dir, 1);
13408
13409 /* Create the dialog with PROMPT as title, using DIR as initial
13410 directory and using "*" as pattern. */
13411 dir = Fexpand_file_name (dir, Qnil);
13412 strncpy (init_dir, XSTRING (dir)->data, MAX_PATH);
13413 init_dir[MAX_PATH] = '\0';
13414 unixtodos_filename (init_dir);
13415
13416 if (STRINGP (default_filename))
13417 {
13418 char *file_name_only;
13419 char *full_path_name = XSTRING (default_filename)->data;
5ac45f98 13420
6fc2811b 13421 unixtodos_filename (full_path_name);
5ac45f98 13422
6fc2811b
JR		 13423 file_name_only = strrchr (full_path_name, '\\');
13424 if (!file_name_only)
13425 file_name_only = full_path_name;
13426 else
13427 {
13428 file_name_only++;
5ac45f98 13429
6fc2811b
JR		 13430 /* If default_file_name is a directory, don't use the open
13431 file dialog, as it does not support selecting
13432 directories. */
13433 if (!(*file_name_only))
13434 use_dialog_p = 0;
13435 }
ee78dc32 13436
6fc2811b
JR		 13437 strncpy (filename, file_name_only, MAX_PATH);
13438 filename[MAX_PATH] = '\0';
13439 }
ee78dc32 13440 else
6fc2811b 13441 filename[0] = '\0';
ee78dc32 13442
6fc2811b
JR		 13443 if (use_dialog_p)
13444 {
13445 OPENFILENAME file_details;
5ac45f98 13446
6fc2811b
JR		 13447 /* Prevent redisplay. */
13448 specbind (Qinhibit_redisplay, Qt);
13449 BLOCK_INPUT;
ee78dc32 13450
6fc2811b
JR		 13451 bzero (&file_details, sizeof (file_details));
13452 file_details.lStructSize = sizeof (file_details);
13453 file_details.hwndOwner = FRAME_W32_WINDOW (f);
3cf3436e
JR		 13454 /* Undocumented Bug in Common File Dialog:
13455 If a filter is not specified, shell links are not resolved. */
13456 file_details.lpstrFilter = "ALL Files (*.*)\0*.*\0\0";
6fc2811b
JR		 13457 file_details.lpstrFile = filename;
13458 file_details.nMaxFile = sizeof (filename);
13459 file_details.lpstrInitialDir = init_dir;
13460 file_details.lpstrTitle = XSTRING (prompt)->data;
13461 file_details.Flags = OFN_HIDEREADONLY | OFN_NOCHANGEDIR;
ee78dc32 13462
6fc2811b
JR		 13463 if (!NILP (mustmatch))
13464 file_details.Flags |= OFN_FILEMUSTEXIST | OFN_PATHMUSTEXIST;
ee78dc32 13465
6fc2811b
JR		 13466 if (GetOpenFileName (&file_details))
13467 {
13468 dostounix_filename (filename);
13469 file = build_string (filename);
13470 }
ee78dc32 13471 else
6fc2811b
JR		 13472 file = Qnil;
13473
13474 UNBLOCK_INPUT;
13475 file = unbind_to (count, file);
ee78dc32 13476 }
6fc2811b
JR		 13477 /* Open File dialog will not allow folders to be selected, so resort
13478 to minibuffer completing reads for directories. */
13479 else
13480 file = Fcompleting_read (prompt, intern ("read-file-name-internal"),
13481 dir, mustmatch, dir, Qfile_name_history,
13482 default_filename, Qnil);
ee78dc32 13483
6fc2811b 13484 UNGCPRO;
1edf84e7 13485
6fc2811b
JR		 13486 /* Make "Cancel" equivalent to C-g. */
13487 if (NILP (file))
13488 Fsignal (Qquit, Qnil);
ee78dc32 13489
dfff8a69 13490 return unbind_to (count, file);
6fc2811b 13491}
ee78dc32 13492
ee78dc32 13493
6fc2811b
JR		 13494\f
13495/***********************************************************************
13496 Tests
13497 ***********************************************************************/
ee78dc32 13498
6fc2811b 13499#if GLYPH_DEBUG
ee78dc32 13500
6fc2811b
JR		 13501DEFUN ("imagep", Fimagep, Simagep, 1, 1, 0,
13502 "Value is non-nil if SPEC is a valid image specification.")
13503 (spec)
13504 Lisp_Object spec;
13505{
13506 return valid_image_p (spec) ? Qt : Qnil;
ee78dc32
GV		 13507}
13508
ee78dc32 13509
6fc2811b
JR		 13510DEFUN ("lookup-image", Flookup_image, Slookup_image, 1, 1, 0, "")
13511 (spec)
13512 Lisp_Object spec;
13513{
13514 int id = -1;
13515
13516 if (valid_image_p (spec))
13517 id = lookup_image (SELECTED_FRAME (), spec);
ee78dc32 13518
6fc2811b
JR		 13519 debug_print (spec);
13520 return make_number (id);
ee78dc32
GV		 13521}
13522
6fc2811b 13523#endif /* GLYPH_DEBUG != 0 */
ee78dc32 13524
ee78dc32
GV		 13525
13526\f
6fc2811b
JR		 13527/***********************************************************************
13528 w32 specialized functions
13529 ***********************************************************************/
ee78dc32 13530
fbd6baed
GV		 13531DEFUN ("w32-select-font", Fw32_select_font, Sw32_select_font, 0, 1, 0,
13532 "This will display the W32 font dialog and return an X font string corresponding to the selection.")
ee78dc32
GV		 13533 (frame)
13534 Lisp_Object frame;
13535{
13536 FRAME_PTR f = check_x_frame (frame);
13537 CHOOSEFONT cf;
13538 LOGFONT lf;
f46e6225
GV		 13539 TEXTMETRIC tm;
13540 HDC hdc;
13541 HANDLE oldobj;
ee78dc32
GV		 13542 char buf[100];
13543
13544 bzero (&cf, sizeof (cf));
f46e6225 13545 bzero (&lf, sizeof (lf));
ee78dc32
GV		 13546
13547 cf.lStructSize = sizeof (cf);
fbd6baed 13548 cf.hwndOwner = FRAME_W32_WINDOW (f);
6fc2811b 13549 cf.Flags = CF_FORCEFONTEXIST | CF_SCREENFONTS;
ee78dc32
GV		 13550 cf.lpLogFont = &lf;
13551
f46e6225
GV		 13552 /* Initialize as much of the font details as we can from the current
13553 default font. */
13554 hdc = GetDC (FRAME_W32_WINDOW (f));
13555 oldobj = SelectObject (hdc, FRAME_FONT (f)->hfont);
13556 GetTextFace (hdc, LF_FACESIZE, lf.lfFaceName);
13557 if (GetTextMetrics (hdc, &tm))
13558 {
13559 lf.lfHeight = tm.tmInternalLeading - tm.tmHeight;
13560 lf.lfWeight = tm.tmWeight;
13561 lf.lfItalic = tm.tmItalic;
13562 lf.lfUnderline = tm.tmUnderlined;
13563 lf.lfStrikeOut = tm.tmStruckOut;
f46e6225
GV		 13564 lf.lfCharSet = tm.tmCharSet;
13565 cf.Flags |= CF_INITTOLOGFONTSTRUCT;
13566 }
13567 SelectObject (hdc, oldobj);
6fc2811b 13568 ReleaseDC (FRAME_W32_WINDOW (f), hdc);
f46e6225 13569
767b1ff0 13570 if (!ChooseFont (&cf) || !w32_to_x_font (&lf, buf, 100, NULL))
3c190163 13571 return Qnil;
ee78dc32
GV		 13572
13573 return build_string (buf);
13574}
13575
1edf84e7
GV		 13576DEFUN ("w32-send-sys-command", Fw32_send_sys_command, Sw32_send_sys_command, 1, 2, 0,
13577 "Send frame a Windows WM_SYSCOMMAND message of type COMMAND.\n\
13578Some useful values for command are 0xf030 to maximise frame (0xf020\n\
13579to minimize), 0xf120 to restore frame to original size, and 0xf100\n\
13580to activate the menubar for keyboard access. 0xf140 activates the\n\
13581screen saver if defined.\n\
13582\n\
13583If optional parameter FRAME is not specified, use selected frame.")
13584 (command, frame)
13585 Lisp_Object command, frame;
13586{
1edf84e7
GV		 13587 FRAME_PTR f = check_x_frame (frame);
13588
13589 CHECK_NUMBER (command, 0);
13590
ce6059da 13591 PostMessage (FRAME_W32_WINDOW (f), WM_SYSCOMMAND, XINT (command), 0);
1edf84e7
GV		 13592
13593 return Qnil;
13594}
13595
55dcfc15
AI		 13596DEFUN ("w32-shell-execute", Fw32_shell_execute, Sw32_shell_execute, 2, 4, 0,
13597 "Get Windows to perform OPERATION on DOCUMENT.\n\
13598This is a wrapper around the ShellExecute system function, which\n\
13599invokes the application registered to handle OPERATION for DOCUMENT.\n\
6fc2811b
JR		 13600OPERATION is typically \"open\", \"print\" or \"explore\" (but can be\n\
13601nil for the default action), and DOCUMENT is typically the name of a\n\
13602document file or URL, but can also be a program executable to run or\n\
13603a directory to open in the Windows Explorer.\n\
55dcfc15 13604\n\
6fc2811b
JR		 13605If DOCUMENT is a program executable, PARAMETERS can be a string\n\
13606containing command line parameters, but otherwise should be nil.\n\
55dcfc15
AI		 13607\n\
13608SHOW-FLAG can be used to control whether the invoked application is hidden\n\
6fc2811b 13609or minimized. If SHOW-FLAG is nil, the application is displayed normally,\n\
55dcfc15
AI		 13610otherwise it is an integer representing a ShowWindow flag:\n\
13611\n\
13612 0 - start hidden\n\
13613 1 - start normally\n\
13614 3 - start maximized\n\
13615 6 - start minimized")
13616 (operation, document, parameters, show_flag)
13617 Lisp_Object operation, document, parameters, show_flag;
13618{
13619 Lisp_Object current_dir;
13620
55dcfc15
AI		 13621 CHECK_STRING (document, 0);
13622
13623 /* Encode filename and current directory. */
13624 current_dir = ENCODE_FILE (current_buffer->directory);
13625 document = ENCODE_FILE (document);
13626 if ((int) ShellExecute (NULL,
6fc2811b
JR		 13627 (STRINGP (operation) ?
13628 XSTRING (operation)->data : NULL),
55dcfc15
AI		 13629 XSTRING (document)->data,
13630 (STRINGP (parameters) ?
13631 XSTRING (parameters)->data : NULL),
13632 XSTRING (current_dir)->data,
13633 (INTEGERP (show_flag) ?
13634 XINT (show_flag) : SW_SHOWDEFAULT))
13635 > 32)
13636 return Qt;
90d97e64 13637 error ("ShellExecute failed: %s", w32_strerror (0));
55dcfc15
AI		 13638}
13639
ccc2d29c
GV		 13640/* Lookup virtual keycode from string representing the name of a
13641 non-ascii keystroke into the corresponding virtual key, using
13642 lispy_function_keys. */
13643static int
13644lookup_vk_code (char *key)
13645{
13646 int i;
13647
13648 for (i = 0; i < 256; i++)
13649 if (lispy_function_keys[i] != 0
13650 && strcmp (lispy_function_keys[i], key) == 0)
13651 return i;
13652
13653 return -1;
13654}
13655
13656/* Convert a one-element vector style key sequence to a hot key
13657 definition. */
13658static int
13659w32_parse_hot_key (key)
13660 Lisp_Object key;
13661{
13662 /* Copied from Fdefine_key and store_in_keymap. */
13663 register Lisp_Object c;
13664 int vk_code;
13665 int lisp_modifiers;
13666 int w32_modifiers;
13667 struct gcpro gcpro1;
13668
13669 CHECK_VECTOR (key, 0);
13670
13671 if (XFASTINT (Flength (key)) != 1)
13672 return Qnil;
13673
13674 GCPRO1 (key);
13675
13676 c = Faref (key, make_number (0));
13677
13678 if (CONSP (c) && lucid_event_type_list_p (c))
13679 c = Fevent_convert_list (c);
13680
13681 UNGCPRO;
13682
13683 if (! INTEGERP (c) && ! SYMBOLP (c))
13684 error ("Key definition is invalid");
13685
13686 /* Work out the base key and the modifiers. */
13687 if (SYMBOLP (c))
13688 {
13689 c = parse_modifiers (c);
13690 lisp_modifiers = Fcar (Fcdr (c));
13691 c = Fcar (c);
13692 if (!SYMBOLP (c))
13693 abort ();
13694 vk_code = lookup_vk_code (XSYMBOL (c)->name->data);
13695 }
13696 else if (INTEGERP (c))
13697 {
13698 lisp_modifiers = XINT (c) & ~CHARACTERBITS;
13699 /* Many ascii characters are their own virtual key code. */
13700 vk_code = XINT (c) & CHARACTERBITS;
13701 }
13702
13703 if (vk_code < 0 || vk_code > 255)
13704 return Qnil;
13705
13706 if ((lisp_modifiers & meta_modifier) != 0
13707 && !NILP (Vw32_alt_is_meta))
13708 lisp_modifiers |= alt_modifier;
13709
71eab8d1
AI		 13710 /* Supply defs missing from mingw32. */
13711#ifndef MOD_ALT
13712#define MOD_ALT 0x0001
13713#define MOD_CONTROL 0x0002
13714#define MOD_SHIFT 0x0004
13715#define MOD_WIN 0x0008
13716#endif
13717
ccc2d29c
GV		 13718 /* Convert lisp modifiers to Windows hot-key form. */
13719 w32_modifiers = (lisp_modifiers & hyper_modifier) ? MOD_WIN : 0;
13720 w32_modifiers |= (lisp_modifiers & alt_modifier) ? MOD_ALT : 0;
13721 w32_modifiers |= (lisp_modifiers & ctrl_modifier) ? MOD_CONTROL : 0;
13722 w32_modifiers |= (lisp_modifiers & shift_modifier) ? MOD_SHIFT : 0;
13723
13724 return HOTKEY (vk_code, w32_modifiers);
13725}
13726
13727DEFUN ("w32-register-hot-key", Fw32_register_hot_key, Sw32_register_hot_key, 1, 1, 0,
13728 "Register KEY as a hot-key combination.\n\
13729Certain key combinations like Alt-Tab are reserved for system use on\n\
13730Windows, and therefore are normally intercepted by the system. However,\n\
13731most of these key combinations can be received by registering them as\n\
13732hot-keys, overriding their special meaning.\n\
13733\n\
13734KEY must be a one element key definition in vector form that would be\n\
13735acceptable to `define-key' (e.g. [A-tab] for Alt-Tab). The meta\n\
13736modifier is interpreted as Alt if `w32-alt-is-meta' is t, and hyper\n\
13737is always interpreted as the Windows modifier keys.\n\
13738\n\
13739The return value is the hotkey-id if registered, otherwise nil.")
13740 (key)
13741 Lisp_Object key;
13742{
13743 key = w32_parse_hot_key (key);
13744
13745 if (NILP (Fmemq (key, w32_grabbed_keys)))
13746 {
13747 /* Reuse an empty slot if possible. */
13748 Lisp_Object item = Fmemq (Qnil, w32_grabbed_keys);
13749
13750 /* Safe to add new key to list, even if we have focus. */
13751 if (NILP (item))
13752 w32_grabbed_keys = Fcons (key, w32_grabbed_keys);
13753 else
f3fbd155 13754 XSETCAR (item, key);
ccc2d29c
GV		 13755
13756 /* Notify input thread about new hot-key definition, so that it
13757 takes effect without needing to switch focus. */
13758 PostThreadMessage (dwWindowsThreadId, WM_EMACS_REGISTER_HOT_KEY,
13759 (WPARAM) key, 0);
13760 }
13761
13762 return key;
13763}
13764
13765DEFUN ("w32-unregister-hot-key", Fw32_unregister_hot_key, Sw32_unregister_hot_key, 1, 1, 0,
13766 "Unregister HOTKEY as a hot-key combination.")
13767 (key)
13768 Lisp_Object key;
13769{
13770 Lisp_Object item;
13771
13772 if (!INTEGERP (key))
13773 key = w32_parse_hot_key (key);
13774
13775 item = Fmemq (key, w32_grabbed_keys);
13776
13777 if (!NILP (item))
13778 {
13779 /* Notify input thread about hot-key definition being removed, so
13780 that it takes effect without needing focus switch. */
13781 if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_UNREGISTER_HOT_KEY,
13782 (WPARAM) XINT (XCAR (item)), (LPARAM) item))
13783 {
13784 MSG msg;
13785 GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
13786 }
13787 return Qt;
13788 }
13789 return Qnil;
13790}
13791
13792DEFUN ("w32-registered-hot-keys", Fw32_registered_hot_keys, Sw32_registered_hot_keys, 0, 0, 0,
13793 "Return list of registered hot-key IDs.")
13794 ()
13795{
13796 return Fcopy_sequence (w32_grabbed_keys);
13797}
13798
13799DEFUN ("w32-reconstruct-hot-key", Fw32_reconstruct_hot_key, Sw32_reconstruct_hot_key, 1, 1, 0,
13800 "Convert hot-key ID to a lisp key combination.")
13801 (hotkeyid)
13802 Lisp_Object hotkeyid;
13803{
13804 int vk_code, w32_modifiers;
13805 Lisp_Object key;
13806
13807 CHECK_NUMBER (hotkeyid, 0);
13808
13809 vk_code = HOTKEY_VK_CODE (hotkeyid);
13810 w32_modifiers = HOTKEY_MODIFIERS (hotkeyid);
13811
13812 if (lispy_function_keys[vk_code])
13813 key = intern (lispy_function_keys[vk_code]);
13814 else
13815 key = make_number (vk_code);
13816
13817 key = Fcons (key, Qnil);
13818 if (w32_modifiers & MOD_SHIFT)
3ef68e6b 13819 key = Fcons (Qshift, key);
ccc2d29c 13820 if (w32_modifiers & MOD_CONTROL)
3ef68e6b 13821 key = Fcons (Qctrl, key);
ccc2d29c 13822 if (w32_modifiers & MOD_ALT)
3ef68e6b 13823 key = Fcons (NILP (Vw32_alt_is_meta) ? Qalt : Qmeta, key);
ccc2d29c 13824 if (w32_modifiers & MOD_WIN)
3ef68e6b 13825 key = Fcons (Qhyper, key);
ccc2d29c
GV		 13826
13827 return key;
13828}
adcc3809
GV		 13829
13830DEFUN ("w32-toggle-lock-key", Fw32_toggle_lock_key, Sw32_toggle_lock_key, 1, 2, 0,
13831 "Toggle the state of the lock key KEY.\n\
13832KEY can be `capslock', `kp-numlock', or `scroll'.\n\
13833If the optional parameter NEW-STATE is a number, then the state of KEY\n\
13834is set to off if the low bit of NEW-STATE is zero, otherwise on.")
13835 (key, new_state)
13836 Lisp_Object key, new_state;
13837{
13838 int vk_code;
adcc3809
GV		 13839
13840 if (EQ (key, intern ("capslock")))
13841 vk_code = VK_CAPITAL;
13842 else if (EQ (key, intern ("kp-numlock")))
13843 vk_code = VK_NUMLOCK;
13844 else if (EQ (key, intern ("scroll")))
13845 vk_code = VK_SCROLL;
13846 else
13847 return Qnil;
13848
13849 if (!dwWindowsThreadId)
13850 return make_number (w32_console_toggle_lock_key (vk_code, new_state));
13851
13852 if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_TOGGLE_LOCK_KEY,
13853 (WPARAM) vk_code, (LPARAM) new_state))
13854 {
13855 MSG msg;
13856 GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
13857 return make_number (msg.wParam);
13858 }
13859 return Qnil;
13860}
ee78dc32 13861\f
2254bcde
AI		 13862DEFUN ("file-system-info", Ffile_system_info, Sfile_system_info, 1, 1, 0,
13863 "Return storage information about the file system FILENAME is on.\n\
13864Value is a list of floats (TOTAL FREE AVAIL), where TOTAL is the total\n\
13865storage of the file system, FREE is the free storage, and AVAIL is the\n\
13866storage available to a non-superuser. All 3 numbers are in bytes.\n\
13867If the underlying system call fails, value is nil.")
13868 (filename)
13869 Lisp_Object filename;
13870{
13871 Lisp_Object encoded, value;
13872
13873 CHECK_STRING (filename, 0);
13874 filename = Fexpand_file_name (filename, Qnil);
13875 encoded = ENCODE_FILE (filename);
13876
13877 value = Qnil;
13878
13879 /* Determining the required information on Windows turns out, sadly,
13880 to be more involved than one would hope. The original Win32 api
13881 call for this will return bogus information on some systems, but we
13882 must dynamically probe for the replacement api, since that was
13883 added rather late on. */
13884 {
13885 HMODULE hKernel = GetModuleHandle ("kernel32");
13886 BOOL (*pfn_GetDiskFreeSpaceEx)
13887 (char *, PULARGE_INTEGER, PULARGE_INTEGER, PULARGE_INTEGER)
13888 = (void *) GetProcAddress (hKernel, "GetDiskFreeSpaceEx");
13889
13890 /* On Windows, we may need to specify the root directory of the
13891 volume holding FILENAME. */
13892 char rootname[MAX_PATH];
13893 char *name = XSTRING (encoded)->data;
13894
13895 /* find the root name of the volume if given */
13896 if (isalpha (name[0]) && name[1] == ':')
13897 {
13898 rootname[0] = name[0];
13899 rootname[1] = name[1];
13900 rootname[2] = '\\';
13901 rootname[3] = 0;
13902 }
13903 else if (IS_DIRECTORY_SEP (name[0]) && IS_DIRECTORY_SEP (name[1]))
13904 {
13905 char *str = rootname;
13906 int slashes = 4;
13907 do
13908 {
13909 if (IS_DIRECTORY_SEP (*name) && --slashes == 0)
13910 break;
13911 *str++ = *name++;
13912 }
13913 while ( *name );
13914
13915 *str++ = '\\';
13916 *str = 0;
13917 }
13918
13919 if (pfn_GetDiskFreeSpaceEx)
13920 {
13921 LARGE_INTEGER availbytes;
13922 LARGE_INTEGER freebytes;
13923 LARGE_INTEGER totalbytes;
13924
13925 if (pfn_GetDiskFreeSpaceEx(rootname,
13926 &availbytes,
13927 &totalbytes,
13928 &freebytes))
13929 value = list3 (make_float ((double) totalbytes.QuadPart),
13930 make_float ((double) freebytes.QuadPart),
13931 make_float ((double) availbytes.QuadPart));
13932 }
13933 else
13934 {
13935 DWORD sectors_per_cluster;
13936 DWORD bytes_per_sector;
13937 DWORD free_clusters;
13938 DWORD total_clusters;
13939
13940 if (GetDiskFreeSpace(rootname,
13941 &sectors_per_cluster,
13942 &bytes_per_sector,
13943 &free_clusters,
13944 &total_clusters))
13945 value = list3 (make_float ((double) total_clusters
13946 * sectors_per_cluster * bytes_per_sector),
13947 make_float ((double) free_clusters
13948 * sectors_per_cluster * bytes_per_sector),
13949 make_float ((double) free_clusters
13950 * sectors_per_cluster * bytes_per_sector));
13951 }
13952 }
13953
13954 return value;
13955}
13956\f
fbd6baed 13957syms_of_w32fns ()
ee78dc32 13958{
1edf84e7
GV		 13959 /* This is zero if not using MS-Windows. */
13960 w32_in_use = 0;
13961
ee78dc32
GV		 13962 /* The section below is built by the lisp expression at the top of the file,
13963 just above where these variables are declared. */
13964 /*&&& init symbols here &&&*/
13965 Qauto_raise = intern ("auto-raise");
13966 staticpro (&Qauto_raise);
13967 Qauto_lower = intern ("auto-lower");
13968 staticpro (&Qauto_lower);
ee78dc32
GV		 13969 Qbar = intern ("bar");
13970 staticpro (&Qbar);
13971 Qborder_color = intern ("border-color");
13972 staticpro (&Qborder_color);
13973 Qborder_width = intern ("border-width");
13974 staticpro (&Qborder_width);
13975 Qbox = intern ("box");
13976 staticpro (&Qbox);
13977 Qcursor_color = intern ("cursor-color");
13978 staticpro (&Qcursor_color);
13979 Qcursor_type = intern ("cursor-type");
13980 staticpro (&Qcursor_type);
ee78dc32
GV		 13981 Qgeometry = intern ("geometry");
13982 staticpro (&Qgeometry);
13983 Qicon_left = intern ("icon-left");
13984 staticpro (&Qicon_left);
13985 Qicon_top = intern ("icon-top");
13986 staticpro (&Qicon_top);
13987 Qicon_type = intern ("icon-type");
13988 staticpro (&Qicon_type);
13989 Qicon_name = intern ("icon-name");
13990 staticpro (&Qicon_name);
13991 Qinternal_border_width = intern ("internal-border-width");
13992 staticpro (&Qinternal_border_width);
13993 Qleft = intern ("left");
13994 staticpro (&Qleft);
1026b400
RS		 13995 Qright = intern ("right");
13996 staticpro (&Qright);
ee78dc32
GV		 13997 Qmouse_color = intern ("mouse-color");
13998 staticpro (&Qmouse_color);
13999 Qnone = intern ("none");
14000 staticpro (&Qnone);
14001 Qparent_id = intern ("parent-id");
14002 staticpro (&Qparent_id);
14003 Qscroll_bar_width = intern ("scroll-bar-width");
14004 staticpro (&Qscroll_bar_width);
14005 Qsuppress_icon = intern ("suppress-icon");
14006 staticpro (&Qsuppress_icon);
ee78dc32
GV		 14007 Qundefined_color = intern ("undefined-color");
14008 staticpro (&Qundefined_color);
14009 Qvertical_scroll_bars = intern ("vertical-scroll-bars");
14010 staticpro (&Qvertical_scroll_bars);
14011 Qvisibility = intern ("visibility");
14012 staticpro (&Qvisibility);
14013 Qwindow_id = intern ("window-id");
14014 staticpro (&Qwindow_id);
14015 Qx_frame_parameter = intern ("x-frame-parameter");
14016 staticpro (&Qx_frame_parameter);
14017 Qx_resource_name = intern ("x-resource-name");
14018 staticpro (&Qx_resource_name);
14019 Quser_position = intern ("user-position");
14020 staticpro (&Quser_position);
14021 Quser_size = intern ("user-size");
14022 staticpro (&Quser_size);
6fc2811b
JR		 14023 Qscreen_gamma = intern ("screen-gamma");
14024 staticpro (&Qscreen_gamma);
dfff8a69
JR		 14025 Qline_spacing = intern ("line-spacing");
14026 staticpro (&Qline_spacing);
14027 Qcenter = intern ("center");
14028 staticpro (&Qcenter);
dc220243
JR		 14029 Qcancel_timer = intern ("cancel-timer");
14030 staticpro (&Qcancel_timer);
ee78dc32
GV		 14031 /* This is the end of symbol initialization. */
14032
adcc3809
GV		 14033 Qhyper = intern ("hyper");
14034 staticpro (&Qhyper);
14035 Qsuper = intern ("super");
14036 staticpro (&Qsuper);
14037 Qmeta = intern ("meta");
14038 staticpro (&Qmeta);
14039 Qalt = intern ("alt");
14040 staticpro (&Qalt);
14041 Qctrl = intern ("ctrl");
14042 staticpro (&Qctrl);
14043 Qcontrol = intern ("control");
14044 staticpro (&Qcontrol);
14045 Qshift = intern ("shift");
14046 staticpro (&Qshift);
14047
6fc2811b
JR		 14048 /* Text property `display' should be nonsticky by default. */
14049 Vtext_property_default_nonsticky
14050 = Fcons (Fcons (Qdisplay, Qt), Vtext_property_default_nonsticky);
14051
14052
14053 Qlaplace = intern ("laplace");
14054 staticpro (&Qlaplace);
3cf3436e
JR		 14055 Qemboss = intern ("emboss");
14056 staticpro (&Qemboss);
14057 Qedge_detection = intern ("edge-detection");
14058 staticpro (&Qedge_detection);
14059 Qheuristic = intern ("heuristic");
14060 staticpro (&Qheuristic);
14061 QCmatrix = intern (":matrix");
14062 staticpro (&QCmatrix);
14063 QCcolor_adjustment = intern (":color-adjustment");
14064 staticpro (&QCcolor_adjustment);
14065 QCmask = intern (":mask");
14066 staticpro (&QCmask);
6fc2811b 14067
4b817373
RS		 14068 Qface_set_after_frame_default = intern ("face-set-after-frame-default");
14069 staticpro (&Qface_set_after_frame_default);
14070
ee78dc32
GV		 14071 Fput (Qundefined_color, Qerror_conditions,
14072 Fcons (Qundefined_color, Fcons (Qerror, Qnil)));
14073 Fput (Qundefined_color, Qerror_message,
14074 build_string ("Undefined color"));
14075
ccc2d29c
GV		 14076 staticpro (&w32_grabbed_keys);
14077 w32_grabbed_keys = Qnil;
14078
fbd6baed 14079 DEFVAR_LISP ("w32-color-map", &Vw32_color_map,
ccc2d29c 14080 "An array of color name mappings for windows.");
fbd6baed 14081 Vw32_color_map = Qnil;
ee78dc32 14082
fbd6baed 14083 DEFVAR_LISP ("w32-pass-alt-to-system", &Vw32_pass_alt_to_system,
da36a4d6
GV		 14084 "Non-nil if alt key presses are passed on to Windows.\n\
14085When non-nil, for example, alt pressed and released and then space will\n\
14086open the System menu. When nil, Emacs silently swallows alt key events.");
fbd6baed 14087 Vw32_pass_alt_to_system = Qnil;
da36a4d6 14088
fbd6baed 14089 DEFVAR_LISP ("w32-alt-is-meta", &Vw32_alt_is_meta,
8c205c63
RS		 14090 "Non-nil if the alt key is to be considered the same as the meta key.\n\
14091When nil, Emacs will translate the alt key to the Alt modifier, and not Meta.");
fbd6baed 14092 Vw32_alt_is_meta = Qt;
8c205c63 14093
7d081355
AI		 14094 DEFVAR_INT ("w32-quit-key", &Vw32_quit_key,
14095 "If non-zero, the virtual key code for an alternative quit key.");
14096 XSETINT (Vw32_quit_key, 0);
14097
ccc2d29c
GV		 14098 DEFVAR_LISP ("w32-pass-lwindow-to-system",
14099 &Vw32_pass_lwindow_to_system,
14100 "Non-nil if the left \"Windows\" key is passed on to Windows.\n\
14101When non-nil, the Start menu is opened by tapping the key.");
14102 Vw32_pass_lwindow_to_system = Qt;
14103
14104 DEFVAR_LISP ("w32-pass-rwindow-to-system",
14105 &Vw32_pass_rwindow_to_system,
14106 "Non-nil if the right \"Windows\" key is passed on to Windows.\n\
14107When non-nil, the Start menu is opened by tapping the key.");
14108 Vw32_pass_rwindow_to_system = Qt;
14109
adcc3809
GV		 14110 DEFVAR_INT ("w32-phantom-key-code",
14111 &Vw32_phantom_key_code,
14112 "Virtual key code used to generate \"phantom\" key presses.\n\
14113Value is a number between 0 and 255.\n\
14114\n\
14115Phantom key presses are generated in order to stop the system from\n\
14116acting on \"Windows\" key events when `w32-pass-lwindow-to-system' or\n\
14117`w32-pass-rwindow-to-system' is nil.");
ce6059da
AI		 14118 /* Although 255 is technically not a valid key code, it works and
14119 means that this hack won't interfere with any real key code. */
14120 Vw32_phantom_key_code = 255;
adcc3809 14121
ccc2d29c
GV		 14122 DEFVAR_LISP ("w32-enable-num-lock",
14123 &Vw32_enable_num_lock,
14124 "Non-nil if Num Lock should act normally.\n\
14125Set to nil to see Num Lock as the key `kp-numlock'.");
14126 Vw32_enable_num_lock = Qt;
14127
14128 DEFVAR_LISP ("w32-enable-caps-lock",
14129 &Vw32_enable_caps_lock,
14130 "Non-nil if Caps Lock should act normally.\n\
14131Set to nil to see Caps Lock as the key `capslock'.");
14132 Vw32_enable_caps_lock = Qt;
14133
14134 DEFVAR_LISP ("w32-scroll-lock-modifier",
14135 &Vw32_scroll_lock_modifier,
14136 "Modifier to use for the Scroll Lock on state.\n\
14137The value can be hyper, super, meta, alt, control or shift for the\n\
14138respective modifier, or nil to see Scroll Lock as the key `scroll'.\n\
14139Any other value will cause the key to be ignored.");
14140 Vw32_scroll_lock_modifier = Qt;
14141
14142 DEFVAR_LISP ("w32-lwindow-modifier",
14143 &Vw32_lwindow_modifier,
14144 "Modifier to use for the left \"Windows\" key.\n\
14145The value can be hyper, super, meta, alt, control or shift for the\n\
14146respective modifier, or nil to appear as the key `lwindow'.\n\
14147Any other value will cause the key to be ignored.");
14148 Vw32_lwindow_modifier = Qnil;
14149
14150 DEFVAR_LISP ("w32-rwindow-modifier",
14151 &Vw32_rwindow_modifier,
14152 "Modifier to use for the right \"Windows\" key.\n\
14153The value can be hyper, super, meta, alt, control or shift for the\n\
14154respective modifier, or nil to appear as the key `rwindow'.\n\
14155Any other value will cause the key to be ignored.");
14156 Vw32_rwindow_modifier = Qnil;
14157
14158 DEFVAR_LISP ("w32-apps-modifier",
14159 &Vw32_apps_modifier,
14160 "Modifier to use for the \"Apps\" key.\n\
14161The value can be hyper, super, meta, alt, control or shift for the\n\
14162respective modifier, or nil to appear as the key `apps'.\n\
14163Any other value will cause the key to be ignored.");
14164 Vw32_apps_modifier = Qnil;
da36a4d6 14165
212da13b 14166 DEFVAR_LISP ("w32-enable-synthesized-fonts", &Vw32_enable_synthesized_fonts,
6fc2811b
JR		 14167 "Non-nil enables selection of artificially italicized and bold fonts.");
14168 Vw32_enable_synthesized_fonts = Qnil;
5ac45f98 14169
fbd6baed 14170 DEFVAR_LISP ("w32-enable-palette", &Vw32_enable_palette,
6fc2811b 14171 "Non-nil enables Windows palette management to map colors exactly.");
fbd6baed 14172 Vw32_enable_palette = Qt;
5ac45f98 14173
fbd6baed
GV		 14174 DEFVAR_INT ("w32-mouse-button-tolerance",
14175 &Vw32_mouse_button_tolerance,
6fc2811b 14176 "Analogue of double click interval for faking middle mouse events.\n\
5ac45f98
GV		 14177The value is the minimum time in milliseconds that must elapse between\n\
14178left/right button down events before they are considered distinct events.\n\
14179If both mouse buttons are depressed within this interval, a middle mouse\n\
14180button down event is generated instead.");
fbd6baed 14181 XSETINT (Vw32_mouse_button_tolerance, GetDoubleClickTime () / 2);
5ac45f98 14182
fbd6baed
GV		 14183 DEFVAR_INT ("w32-mouse-move-interval",
14184 &Vw32_mouse_move_interval,
84fb1139
KH		 14185 "Minimum interval between mouse move events.\n\
14186The value is the minimum time in milliseconds that must elapse between\n\
14187successive mouse move (or scroll bar drag) events before they are\n\
14188reported as lisp events.");
247be837 14189 XSETINT (Vw32_mouse_move_interval, 0);
84fb1139 14190
ee78dc32
GV		 14191 init_x_parm_symbols ();
14192
14193 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path,
fbd6baed 14194 "List of directories to search for bitmap files for w32.");
ee78dc32
GV		 14195 Vx_bitmap_file_path = decode_env_path ((char *) 0, "PATH");
14196
14197 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape,
14198 "The shape of the pointer when over text.\n\
14199Changing the value does not affect existing frames\n\
14200unless you set the mouse color.");
14201 Vx_pointer_shape = Qnil;
14202
14203 DEFVAR_LISP ("x-resource-name", &Vx_resource_name,
14204 "The name Emacs uses to look up resources; for internal use only.\n\
14205`x-get-resource' uses this as the first component of the instance name\n\
14206when requesting resource values.\n\
14207Emacs initially sets `x-resource-name' to the name under which Emacs\n\
14208was invoked, or to the value specified with the `-name' or `-rn'\n\
14209switches, if present.");
14210 Vx_resource_name = Qnil;
14211
14212 Vx_nontext_pointer_shape = Qnil;
14213
14214 Vx_mode_pointer_shape = Qnil;
14215
0af913d7 14216 DEFVAR_LISP ("x-hourglass-pointer-shape", &Vx_hourglass_pointer_shape,
6fc2811b
JR		 14217 "The shape of the pointer when Emacs is busy.\n\
14218This variable takes effect when you create a new frame\n\
14219or when you set the mouse color.");
0af913d7 14220 Vx_hourglass_pointer_shape = Qnil;
6fc2811b 14221
0af913d7
GM		 14222 DEFVAR_BOOL ("display-hourglass", &display_hourglass_p,
14223 "Non-zero means Emacs displays an hourglass pointer on window systems.");
14224 display_hourglass_p = 1;
6fc2811b 14225
0af913d7
GM		 14226 DEFVAR_LISP ("hourglass-delay", &Vhourglass_delay,
14227 "*Seconds to wait before displaying an hourglass pointer.\n\
dfff8a69 14228Value must be an integer or float.");
0af913d7 14229 Vhourglass_delay = make_number (DEFAULT_HOURGLASS_DELAY);
f79e6790 14230
6fc2811b 14231 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
ee78dc32
GV		 14232 &Vx_sensitive_text_pointer_shape,
14233 "The shape of the pointer when over mouse-sensitive text.\n\
14234This variable takes effect when you create a new frame\n\
14235or when you set the mouse color.");
14236 Vx_sensitive_text_pointer_shape = Qnil;
14237
4694d762
JR		 14238 DEFVAR_LISP ("x-window-horizontal-drag-cursor",
14239 &Vx_window_horizontal_drag_shape,
14240 "Pointer shape to use for indicating a window can be dragged horizontally.\n\
14241This variable takes effect when you create a new frame\n\
14242or when you set the mouse color.");
14243 Vx_window_horizontal_drag_shape = Qnil;
14244
ee78dc32
GV		 14245 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel,
14246 "A string indicating the foreground color of the cursor box.");
14247 Vx_cursor_fore_pixel = Qnil;
14248
3cf3436e
JR		 14249 DEFVAR_LISP ("x-max-tooltip-size", &Vx_max_tooltip_size,
14250 "Maximum size for tooltips. Value is a pair (COLUMNS . ROWS).\n\
14251Text larger than this is clipped.");
14252 Vx_max_tooltip_size = Fcons (make_number (80), make_number (40));
14253
ee78dc32
GV		 14254 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager,
14255 "Non-nil if no window manager is in use.\n\
14256Emacs doesn't try to figure this out; this is always nil\n\
14257unless you set it to something else.");
14258 /* We don't have any way to find this out, so set it to nil
14259 and maybe the user would like to set it to t. */
14260 Vx_no_window_manager = Qnil;
14261
4587b026
GV		 14262 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
14263 &Vx_pixel_size_width_font_regexp,
14264 "Regexp matching a font name whose width is the same as `PIXEL_SIZE'.\n\
14265\n\
14266Since Emacs gets width of a font matching with this regexp from\n\
14267PIXEL_SIZE field of the name, font finding mechanism gets faster for\n\
14268such a font. This is especially effective for such large fonts as\n\
14269Chinese, Japanese, and Korean.");
14270 Vx_pixel_size_width_font_regexp = Qnil;
14271
6fc2811b
JR		 14272 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay,
14273 "Time after which cached images are removed from the cache.\n\
14274When an image has not been displayed this many seconds, remove it\n\
14275from the image cache. Value must be an integer or nil with nil\n\
14276meaning don't clear the cache.");
14277 Vimage_cache_eviction_delay = make_number (30 * 60);
14278
33d52f9c
GV		 14279 DEFVAR_LISP ("w32-bdf-filename-alist",
14280 &Vw32_bdf_filename_alist,
14281 "List of bdf fonts and their corresponding filenames.");
14282 Vw32_bdf_filename_alist = Qnil;
14283
1075afa9
GV		 14284 DEFVAR_BOOL ("w32-strict-fontnames",
14285 &w32_strict_fontnames,
14286 "Non-nil means only use fonts that are exact matches for those requested.\n\
14287Default is nil, which allows old fontnames that are not XLFD compliant,\n\
14288and allows third-party CJK display to work by specifying false charset\n\
14289fields to trick Emacs into translating to Big5, SJIS etc.\n\
14290Setting this to t will prevent wrong fonts being selected when\n\
14291fontsets are automatically created.");
14292 w32_strict_fontnames = 0;
14293
c0611964
AI		 14294 DEFVAR_BOOL ("w32-strict-painting",
14295 &w32_strict_painting,
14296 "Non-nil means use strict rules for repainting frames.\n\
14297Set this to nil to get the old behaviour for repainting; this should\n\
14298only be necessary if the default setting causes problems.");
14299 w32_strict_painting = 1;
14300
f46e6225
GV		 14301 DEFVAR_LISP ("w32-system-coding-system",
14302 &Vw32_system_coding_system,
14303 "Coding system used by Windows system functions, such as for font names.");
14304 Vw32_system_coding_system = Qnil;
14305
dfff8a69
JR		 14306 DEFVAR_LISP ("w32-charset-info-alist",
14307 &Vw32_charset_info_alist,
14308 "Alist linking Emacs character sets to Windows fonts\n\
14309and codepages. Each entry should be of the form:\n\
14310\n\
14311 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE))\n\
14312\n\
14313where CHARSET_NAME is a string used in font names to identify the charset,\n\
14314WINDOWS_CHARSET is a symbol that can be one of:\n\
14315w32-charset-ansi, w32-charset-default, w32-charset-symbol,\n\
767b1ff0 14316w32-charset-shiftjis, w32-charset-hangeul, w32-charset-gb2312,\n\
dfff8a69
JR		 14317w32-charset-chinesebig5, "
14318#ifdef JOHAB_CHARSET
14319"w32-charset-johab, w32-charset-hebrew,\n\
14320w32-charset-arabic, w32-charset-greek, w32-charset-turkish,\n\
14321w32-charset-vietnamese, w32-charset-thai, w32-charset-easteurope,\n\
14322w32-charset-russian, w32-charset-mac, w32-charset-baltic,\n"
14323#endif
14324#ifdef UNICODE_CHARSET
14325"w32-charset-unicode, "
14326#endif
14327"or w32-charset-oem.\n\
14328CODEPAGE should be an integer specifying the codepage that should be used\n\
14329to display the character set, t to do no translation and output as Unicode,\n\
14330or nil to do no translation and output as 8 bit (or multibyte on far-east\n\
14331versions of Windows) characters.");
14332 Vw32_charset_info_alist = Qnil;
14333
14334 staticpro (&Qw32_charset_ansi);
14335 Qw32_charset_ansi = intern ("w32-charset-ansi");
14336 staticpro (&Qw32_charset_symbol);
14337 Qw32_charset_symbol = intern ("w32-charset-symbol");
14338 staticpro (&Qw32_charset_shiftjis);
14339 Qw32_charset_shiftjis = intern ("w32-charset-shiftjis");
767b1ff0
JR		 14340 staticpro (&Qw32_charset_hangeul);
14341 Qw32_charset_hangeul = intern ("w32-charset-hangeul");
dfff8a69
JR		 14342 staticpro (&Qw32_charset_chinesebig5);
14343 Qw32_charset_chinesebig5 = intern ("w32-charset-chinesebig5");
14344 staticpro (&Qw32_charset_gb2312);
14345 Qw32_charset_gb2312 = intern ("w32-charset-gb2312");
14346 staticpro (&Qw32_charset_oem);
14347 Qw32_charset_oem = intern ("w32-charset-oem");
14348
14349#ifdef JOHAB_CHARSET
14350 {
14351 static int w32_extra_charsets_defined = 1;
767b1ff0 14352 DEFVAR_BOOL ("w32-extra-charsets-defined", &w32_extra_charsets_defined, "");
dfff8a69
JR		 14353
14354 staticpro (&Qw32_charset_johab);
14355 Qw32_charset_johab = intern ("w32-charset-johab");
14356 staticpro (&Qw32_charset_easteurope);
14357 Qw32_charset_easteurope = intern ("w32-charset-easteurope");
14358 staticpro (&Qw32_charset_turkish);
14359 Qw32_charset_turkish = intern ("w32-charset-turkish");
14360 staticpro (&Qw32_charset_baltic);
14361 Qw32_charset_baltic = intern ("w32-charset-baltic");
14362 staticpro (&Qw32_charset_russian);
14363 Qw32_charset_russian = intern ("w32-charset-russian");
14364 staticpro (&Qw32_charset_arabic);
14365 Qw32_charset_arabic = intern ("w32-charset-arabic");
14366 staticpro (&Qw32_charset_greek);
14367 Qw32_charset_greek = intern ("w32-charset-greek");
14368 staticpro (&Qw32_charset_hebrew);
14369 Qw32_charset_hebrew = intern ("w32-charset-hebrew");
767b1ff0
JR		 14370 staticpro (&Qw32_charset_vietnamese);
14371 Qw32_charset_vietnamese = intern ("w32-charset-vietnamese");
dfff8a69
JR		 14372 staticpro (&Qw32_charset_thai);
14373 Qw32_charset_thai = intern ("w32-charset-thai");
14374 staticpro (&Qw32_charset_mac);
14375 Qw32_charset_mac = intern ("w32-charset-mac");
14376 }
14377#endif
14378
14379#ifdef UNICODE_CHARSET
14380 {
14381 static int w32_unicode_charset_defined = 1;
14382 DEFVAR_BOOL ("w32-unicode-charset-defined",
767b1ff0 14383 &w32_unicode_charset_defined, "");
dfff8a69
JR		 14384
14385 staticpro (&Qw32_charset_unicode);
14386 Qw32_charset_unicode = intern ("w32-charset-unicode");
14387#endif
14388
ee78dc32 14389 defsubr (&Sx_get_resource);
767b1ff0 14390#if 0 /* TODO: Port to W32 */
6fc2811b
JR		 14391 defsubr (&Sx_change_window_property);
14392 defsubr (&Sx_delete_window_property);
14393 defsubr (&Sx_window_property);
14394#endif
2d764c78 14395 defsubr (&Sxw_display_color_p);
ee78dc32 14396 defsubr (&Sx_display_grayscale_p);
2d764c78
EZ		 14397 defsubr (&Sxw_color_defined_p);
14398 defsubr (&Sxw_color_values);
ee78dc32
GV		 14399 defsubr (&Sx_server_max_request_size);
14400 defsubr (&Sx_server_vendor);
14401 defsubr (&Sx_server_version);
14402 defsubr (&Sx_display_pixel_width);
14403 defsubr (&Sx_display_pixel_height);
14404 defsubr (&Sx_display_mm_width);
14405 defsubr (&Sx_display_mm_height);
14406 defsubr (&Sx_display_screens);
14407 defsubr (&Sx_display_planes);
14408 defsubr (&Sx_display_color_cells);
14409 defsubr (&Sx_display_visual_class);
14410 defsubr (&Sx_display_backing_store);
14411 defsubr (&Sx_display_save_under);
14412 defsubr (&Sx_parse_geometry);
14413 defsubr (&Sx_create_frame);
ee78dc32
GV		 14414 defsubr (&Sx_open_connection);
14415 defsubr (&Sx_close_connection);
14416 defsubr (&Sx_display_list);
14417 defsubr (&Sx_synchronize);
14418
fbd6baed 14419 /* W32 specific functions */
ee78dc32 14420
1edf84e7 14421 defsubr (&Sw32_focus_frame);
fbd6baed
GV		 14422 defsubr (&Sw32_select_font);
14423 defsubr (&Sw32_define_rgb_color);
14424 defsubr (&Sw32_default_color_map);
14425 defsubr (&Sw32_load_color_file);
1edf84e7 14426 defsubr (&Sw32_send_sys_command);
55dcfc15 14427 defsubr (&Sw32_shell_execute);
ccc2d29c
GV		 14428 defsubr (&Sw32_register_hot_key);
14429 defsubr (&Sw32_unregister_hot_key);
14430 defsubr (&Sw32_registered_hot_keys);
14431 defsubr (&Sw32_reconstruct_hot_key);
adcc3809 14432 defsubr (&Sw32_toggle_lock_key);
33d52f9c 14433 defsubr (&Sw32_find_bdf_fonts);
4587b026 14434
2254bcde
AI		 14435 defsubr (&Sfile_system_info);
14436
4587b026
GV		 14437 /* Setting callback functions for fontset handler. */
14438 get_font_info_func = w32_get_font_info;
6fc2811b
JR		 14439
14440#if 0 /* This function pointer doesn't seem to be used anywhere.
14441 And the pointer assigned has the wrong type, anyway. */
4587b026 14442 list_fonts_func = w32_list_fonts;
6fc2811b
JR		 14443#endif
14444
4587b026
GV		 14445 load_font_func = w32_load_font;
14446 find_ccl_program_func = w32_find_ccl_program;
14447 query_font_func = w32_query_font;
14448 set_frame_fontset_func = x_set_font;
14449 check_window_system_func = check_w32;
6fc2811b 14450
767b1ff0 14451#if 0 /* TODO Image support for W32 */
6fc2811b
JR		 14452 /* Images. */
14453 Qxbm = intern ("xbm");
14454 staticpro (&Qxbm);
14455 QCtype = intern (":type");
14456 staticpro (&QCtype);
a93f4566
GM		 14457 QCconversion = intern (":conversion");
14458 staticpro (&QCconversion);
6fc2811b
JR		 14459 QCheuristic_mask = intern (":heuristic-mask");
14460 staticpro (&QCheuristic_mask);
14461 QCcolor_symbols = intern (":color-symbols");
14462 staticpro (&QCcolor_symbols);
6fc2811b
JR		 14463 QCascent = intern (":ascent");
14464 staticpro (&QCascent);
14465 QCmargin = intern (":margin");
14466 staticpro (&QCmargin);
14467 QCrelief = intern (":relief");
14468 staticpro (&QCrelief);
14469 Qpostscript = intern ("postscript");
14470 staticpro (&Qpostscript);
14471 QCloader = intern (":loader");
14472 staticpro (&QCloader);
14473 QCbounding_box = intern (":bounding-box");
14474 staticpro (&QCbounding_box);
14475 QCpt_width = intern (":pt-width");
14476 staticpro (&QCpt_width);
14477 QCpt_height = intern (":pt-height");
14478 staticpro (&QCpt_height);
14479 QCindex = intern (":index");
14480 staticpro (&QCindex);
14481 Qpbm = intern ("pbm");
14482 staticpro (&Qpbm);
14483
14484#if HAVE_XPM
14485 Qxpm = intern ("xpm");
14486 staticpro (&Qxpm);
14487#endif
14488
14489#if HAVE_JPEG
14490 Qjpeg = intern ("jpeg");
14491 staticpro (&Qjpeg);
14492#endif
14493
14494#if HAVE_TIFF
14495 Qtiff = intern ("tiff");
14496 staticpro (&Qtiff);
14497#endif
14498
14499#if HAVE_GIF
14500 Qgif = intern ("gif");
14501 staticpro (&Qgif);
14502#endif
14503
14504#if HAVE_PNG
14505 Qpng = intern ("png");
14506 staticpro (&Qpng);
14507#endif
14508
14509 defsubr (&Sclear_image_cache);
14510
14511#if GLYPH_DEBUG
14512 defsubr (&Simagep);
14513 defsubr (&Slookup_image);
14514#endif
767b1ff0 14515#endif /* TODO */
6fc2811b 14516
0af913d7
GM		 14517 hourglass_atimer = NULL;
14518 hourglass_shown_p = 0;
767b1ff0 14519#ifdef TODO /* Tooltip support not complete. */
6fc2811b
JR		 14520 defsubr (&Sx_show_tip);
14521 defsubr (&Sx_hide_tip);
767b1ff0 14522#endif
6fc2811b 14523 tip_timer = Qnil;
57fa2774
JR		 14524 staticpro (&tip_timer);
14525 tip_frame = Qnil;
14526 staticpro (&tip_frame);
6fc2811b
JR		 14527
14528 defsubr (&Sx_file_dialog);
14529}
14530
14531
14532void
14533init_xfns ()
14534{
14535 image_types = NULL;
14536 Vimage_types = Qnil;
14537
767b1ff0 14538#if 0 /* TODO : Image support for W32 */
6fc2811b
JR		 14539 define_image_type (&xbm_type);
14540 define_image_type (&gs_type);
14541 define_image_type (&pbm_type);
14542
14543#if HAVE_XPM
14544 define_image_type (&xpm_type);
14545#endif
14546
14547#if HAVE_JPEG
14548 define_image_type (&jpeg_type);
14549#endif
14550
14551#if HAVE_TIFF
14552 define_image_type (&tiff_type);
14553#endif
14554
14555#if HAVE_GIF
14556 define_image_type (&gif_type);
14557#endif
14558
14559#if HAVE_PNG
14560 define_image_type (&png_type);
14561#endif
767b1ff0 14562#endif /* TODO */
ee78dc32
GV		 14563}
14564
14565#undef abort
14566
14567void
fbd6baed 14568w32_abort()
ee78dc32 14569{
5ac45f98
GV		 14570 int button;
14571 button = MessageBox (NULL,
14572 "A fatal error has occurred!\n\n"
14573 "Select Abort to exit, Retry to debug, Ignore to continue",
14574 "Emacs Abort Dialog",
14575 MB_ICONEXCLAMATION | MB_TASKMODAL
14576 | MB_SETFOREGROUND | MB_ABORTRETRYIGNORE);
14577 switch (button)
14578 {
14579 case IDRETRY:
14580 DebugBreak ();
14581 break;
14582 case IDIGNORE:
14583 break;
14584 case IDABORT:
14585 default:
14586 abort ();
14587 break;
14588 }
ee78dc32 14589}
d573caac 14590
83c75055
GV		 14591/* For convenience when debugging. */
14592int
14593w32_last_error()
14594{
14595 return GetLastError ();
14596}
Unnamed repository; edit this file 'description' to name the repository.