HCoop / bpt / emacs.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
(Fx_file_dialog): Pass a filter to GetOpenFileName.
[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
ee78dc32 310\f
1edf84e7
GV		 311/* Error if we are not connected to MS-Windows. */
312void
313check_w32 ()
314{
315 if (! w32_in_use)
316 error ("MS-Windows not in use or not initialized");
317}
318
319/* Nonzero if we can use mouse menus.
320 You should not call this unless HAVE_MENUS is defined. */
321
322int
323have_menus_p ()
324{
325 return w32_in_use;
326}
327
ee78dc32 328/* Extract a frame as a FRAME_PTR, defaulting to the selected frame
fbd6baed 329 and checking validity for W32. */
ee78dc32
GV		 330
331FRAME_PTR
332check_x_frame (frame)
333 Lisp_Object frame;
334{
335 FRAME_PTR f;
336
337 if (NILP (frame))
6fc2811b
JR		 338 frame = selected_frame;
339 CHECK_LIVE_FRAME (frame, 0);
340 f = XFRAME (frame);
fbd6baed
GV		 341 if (! FRAME_W32_P (f))
342 error ("non-w32 frame used");
ee78dc32
GV		 343 return f;
344}
345
346/* Let the user specify an display with a frame.
fbd6baed 347 nil stands for the selected frame--or, if that is not a w32 frame,
ee78dc32
GV		 348 the first display on the list. */
349
fbd6baed 350static struct w32_display_info *
ee78dc32
GV		 351check_x_display_info (frame)
352 Lisp_Object frame;
353{
354 if (NILP (frame))
355 {
6fc2811b
JR		 356 struct frame *sf = XFRAME (selected_frame);
357
358 if (FRAME_W32_P (sf) && FRAME_LIVE_P (sf))
359 return FRAME_W32_DISPLAY_INFO (sf);
ee78dc32 360 else
fbd6baed 361 return &one_w32_display_info;
ee78dc32
GV		 362 }
363 else if (STRINGP (frame))
364 return x_display_info_for_name (frame);
365 else
366 {
367 FRAME_PTR f;
368
369 CHECK_LIVE_FRAME (frame, 0);
370 f = XFRAME (frame);
fbd6baed
GV		 371 if (! FRAME_W32_P (f))
372 error ("non-w32 frame used");
373 return FRAME_W32_DISPLAY_INFO (f);
ee78dc32
GV		 374 }
375}
376\f
fbd6baed 377/* Return the Emacs frame-object corresponding to an w32 window.
ee78dc32
GV		 378 It could be the frame's main window or an icon window. */
379
380/* This function can be called during GC, so use GC_xxx type test macros. */
381
382struct frame *
383x_window_to_frame (dpyinfo, wdesc)
fbd6baed 384 struct w32_display_info *dpyinfo;
ee78dc32
GV		 385 HWND wdesc;
386{
387 Lisp_Object tail, frame;
388 struct frame *f;
389
8e713be6 390 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
ee78dc32 391 {
8e713be6 392 frame = XCAR (tail);
ee78dc32
GV		 393 if (!GC_FRAMEP (frame))
394 continue;
395 f = XFRAME (frame);
2d764c78 396 if (!FRAME_W32_P (f) || FRAME_W32_DISPLAY_INFO (f) != dpyinfo)
ee78dc32 397 continue;
0af913d7 398 if (f->output_data.w32->hourglass_window == wdesc)
f79e6790
JR		 399 return f;
400
767b1ff0 401 /* TODO: Check tooltips when supported. */
fbd6baed 402 if (FRAME_W32_WINDOW (f) == wdesc)
ee78dc32
GV		 403 return f;
404 }
405 return 0;
406}
407
408\f
409
410/* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
411 id, which is just an int that this section returns. Bitmaps are
412 reference counted so they can be shared among frames.
413
414 Bitmap indices are guaranteed to be > 0, so a negative number can
415 be used to indicate no bitmap.
416
417 If you use x_create_bitmap_from_data, then you must keep track of
418 the bitmaps yourself. That is, creating a bitmap from the same
419 data more than once will not be caught. */
420
421
422/* Functions to access the contents of a bitmap, given an id. */
423
424int
425x_bitmap_height (f, id)
426 FRAME_PTR f;
427 int id;
428{
fbd6baed 429 return FRAME_W32_DISPLAY_INFO (f)->bitmaps[id - 1].height;
ee78dc32
GV		 430}
431
432int
433x_bitmap_width (f, id)
434 FRAME_PTR f;
435 int id;
436{
fbd6baed 437 return FRAME_W32_DISPLAY_INFO (f)->bitmaps[id - 1].width;
ee78dc32
GV		 438}
439
440int
441x_bitmap_pixmap (f, id)
442 FRAME_PTR f;
443 int id;
444{
fbd6baed 445 return (int) FRAME_W32_DISPLAY_INFO (f)->bitmaps[id - 1].pixmap;
ee78dc32
GV		 446}
447
448
449/* Allocate a new bitmap record. Returns index of new record. */
450
451static int
452x_allocate_bitmap_record (f)
453 FRAME_PTR f;
454{
fbd6baed 455 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
ee78dc32
GV		 456 int i;
457
458 if (dpyinfo->bitmaps == NULL)
459 {
460 dpyinfo->bitmaps_size = 10;
461 dpyinfo->bitmaps
fbd6baed 462 = (struct w32_bitmap_record *) xmalloc (dpyinfo->bitmaps_size * sizeof (struct w32_bitmap_record));
ee78dc32
GV		 463 dpyinfo->bitmaps_last = 1;
464 return 1;
465 }
466
467 if (dpyinfo->bitmaps_last < dpyinfo->bitmaps_size)
468 return ++dpyinfo->bitmaps_last;
469
470 for (i = 0; i < dpyinfo->bitmaps_size; ++i)
471 if (dpyinfo->bitmaps[i].refcount == 0)
472 return i + 1;
473
474 dpyinfo->bitmaps_size *= 2;
475 dpyinfo->bitmaps
fbd6baed
GV		 476 = (struct w32_bitmap_record *) xrealloc (dpyinfo->bitmaps,
477 dpyinfo->bitmaps_size * sizeof (struct w32_bitmap_record));
ee78dc32
GV		 478 return ++dpyinfo->bitmaps_last;
479}
480
481/* Add one reference to the reference count of the bitmap with id ID. */
482
483void
484x_reference_bitmap (f, id)
485 FRAME_PTR f;
486 int id;
487{
fbd6baed 488 ++FRAME_W32_DISPLAY_INFO (f)->bitmaps[id - 1].refcount;
ee78dc32
GV		 489}
490
491/* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
492
493int
494x_create_bitmap_from_data (f, bits, width, height)
495 struct frame *f;
496 char *bits;
497 unsigned int width, height;
498{
fbd6baed 499 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
ee78dc32
GV		 500 Pixmap bitmap;
501 int id;
502
503 bitmap = CreateBitmap (width, height,
fbd6baed
GV		 504 FRAME_W32_DISPLAY_INFO (XFRAME (frame))->n_planes,
505 FRAME_W32_DISPLAY_INFO (XFRAME (frame))->n_cbits,
ee78dc32
GV		 506 bits);
507
508 if (! bitmap)
509 return -1;
510
511 id = x_allocate_bitmap_record (f);
512 dpyinfo->bitmaps[id - 1].pixmap = bitmap;
513 dpyinfo->bitmaps[id - 1].file = NULL;
514 dpyinfo->bitmaps[id - 1].hinst = NULL;
515 dpyinfo->bitmaps[id - 1].refcount = 1;
516 dpyinfo->bitmaps[id - 1].depth = 1;
517 dpyinfo->bitmaps[id - 1].height = height;
518 dpyinfo->bitmaps[id - 1].width = width;
519
520 return id;
521}
522
523/* Create bitmap from file FILE for frame F. */
524
525int
526x_create_bitmap_from_file (f, file)
527 struct frame *f;
528 Lisp_Object file;
529{
530 return -1;
767b1ff0 531#if 0 /* TODO : bitmap support */
fbd6baed 532 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
ee78dc32 533 unsigned int width, height;
6fc2811b 534 HBITMAP bitmap;
ee78dc32
GV		 535 int xhot, yhot, result, id;
536 Lisp_Object found;
537 int fd;
538 char *filename;
539 HINSTANCE hinst;
540
541 /* Look for an existing bitmap with the same name. */
542 for (id = 0; id < dpyinfo->bitmaps_last; ++id)
543 {
544 if (dpyinfo->bitmaps[id].refcount
545 && dpyinfo->bitmaps[id].file
546 && !strcmp (dpyinfo->bitmaps[id].file, (char *) XSTRING (file)->data))
547 {
548 ++dpyinfo->bitmaps[id].refcount;
549 return id + 1;
550 }
551 }
552
553 /* Search bitmap-file-path for the file, if appropriate. */
c0ec53ad 554 fd = openp (Vx_bitmap_file_path, file, Qnil, &found, 0);
ee78dc32
GV		 555 if (fd < 0)
556 return -1;
6fc2811b 557 emacs_close (fd);
ee78dc32
GV		 558
559 filename = (char *) XSTRING (found)->data;
560
561 hinst = LoadLibraryEx (filename, NULL, LOAD_LIBRARY_AS_DATAFILE);
562
563 if (hinst == NULL)
564 return -1;
565
566
fbd6baed 567 result = XReadBitmapFile (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
ee78dc32
GV		 568 filename, &width, &height, &bitmap, &xhot, &yhot);
569 if (result != BitmapSuccess)
570 return -1;
571
572 id = x_allocate_bitmap_record (f);
573 dpyinfo->bitmaps[id - 1].pixmap = bitmap;
574 dpyinfo->bitmaps[id - 1].refcount = 1;
575 dpyinfo->bitmaps[id - 1].file = (char *) xmalloc (XSTRING (file)->size + 1);
576 dpyinfo->bitmaps[id - 1].depth = 1;
577 dpyinfo->bitmaps[id - 1].height = height;
578 dpyinfo->bitmaps[id - 1].width = width;
579 strcpy (dpyinfo->bitmaps[id - 1].file, XSTRING (file)->data);
580
581 return id;
767b1ff0 582#endif /* TODO */
ee78dc32
GV		 583}
584
585/* Remove reference to bitmap with id number ID. */
586
33d52f9c 587void
ee78dc32
GV		 588x_destroy_bitmap (f, id)
589 FRAME_PTR f;
590 int id;
591{
fbd6baed 592 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
ee78dc32
GV		 593
594 if (id > 0)
595 {
596 --dpyinfo->bitmaps[id - 1].refcount;
597 if (dpyinfo->bitmaps[id - 1].refcount == 0)
598 {
599 BLOCK_INPUT;
600 DeleteObject (dpyinfo->bitmaps[id - 1].pixmap);
601 if (dpyinfo->bitmaps[id - 1].file)
602 {
6fc2811b 603 xfree (dpyinfo->bitmaps[id - 1].file);
ee78dc32
GV		 604 dpyinfo->bitmaps[id - 1].file = NULL;
605 }
606 UNBLOCK_INPUT;
607 }
608 }
609}
610
611/* Free all the bitmaps for the display specified by DPYINFO. */
612
613static void
614x_destroy_all_bitmaps (dpyinfo)
fbd6baed 615 struct w32_display_info *dpyinfo;
ee78dc32
GV		 616{
617 int i;
618 for (i = 0; i < dpyinfo->bitmaps_last; i++)
619 if (dpyinfo->bitmaps[i].refcount > 0)
620 {
621 DeleteObject (dpyinfo->bitmaps[i].pixmap);
622 if (dpyinfo->bitmaps[i].file)
6fc2811b 623 xfree (dpyinfo->bitmaps[i].file);
ee78dc32
GV		 624 }
625 dpyinfo->bitmaps_last = 0;
626}
627\f
fbd6baed 628/* Connect the frame-parameter names for W32 frames
ee78dc32
GV		 629 to the ways of passing the parameter values to the window system.
630
631 The name of a parameter, as a Lisp symbol,
632 has an `x-frame-parameter' property which is an integer in Lisp
633 but can be interpreted as an `enum x_frame_parm' in C. */
634
635enum x_frame_parm
636{
637 X_PARM_FOREGROUND_COLOR,
638 X_PARM_BACKGROUND_COLOR,
639 X_PARM_MOUSE_COLOR,
640 X_PARM_CURSOR_COLOR,
641 X_PARM_BORDER_COLOR,
642 X_PARM_ICON_TYPE,
643 X_PARM_FONT,
644 X_PARM_BORDER_WIDTH,
645 X_PARM_INTERNAL_BORDER_WIDTH,
646 X_PARM_NAME,
647 X_PARM_AUTORAISE,
648 X_PARM_AUTOLOWER,
649 X_PARM_VERT_SCROLL_BAR,
650 X_PARM_VISIBILITY,
651 X_PARM_MENU_BAR_LINES
652};
653
654
655struct x_frame_parm_table
656{
657 char *name;
6fc2811b 658 void (*setter) P_ ((struct frame *, Lisp_Object, Lisp_Object));
ee78dc32
GV		 659};
660
937e601e
AI		 661static Lisp_Object unwind_create_frame P_ ((Lisp_Object));
662static Lisp_Object unwind_create_tip_frame P_ ((Lisp_Object));
663static void x_change_window_heights P_ ((Lisp_Object, int));
767b1ff0 664/* TODO: Native Input Method support; see x_create_im. */
6fc2811b 665void x_set_foreground_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
dfff8a69 666static void x_set_line_spacing P_ ((struct frame *, Lisp_Object, Lisp_Object));
6fc2811b
JR		 667void x_set_background_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
668void x_set_mouse_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
669void x_set_cursor_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
670void x_set_border_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
671void x_set_cursor_type P_ ((struct frame *, Lisp_Object, Lisp_Object));
672void x_set_icon_type P_ ((struct frame *, Lisp_Object, Lisp_Object));
673void x_set_icon_name P_ ((struct frame *, Lisp_Object, Lisp_Object));
674void x_set_font P_ ((struct frame *, Lisp_Object, Lisp_Object));
675void x_set_border_width P_ ((struct frame *, Lisp_Object, Lisp_Object));
676void x_set_internal_border_width P_ ((struct frame *, Lisp_Object,
677 Lisp_Object));
678void x_explicitly_set_name P_ ((struct frame *, Lisp_Object, Lisp_Object));
679void x_set_autoraise P_ ((struct frame *, Lisp_Object, Lisp_Object));
680void x_set_autolower P_ ((struct frame *, Lisp_Object, Lisp_Object));
681void x_set_vertical_scroll_bars P_ ((struct frame *, Lisp_Object,
682 Lisp_Object));
683void x_set_visibility P_ ((struct frame *, Lisp_Object, Lisp_Object));
684void x_set_menu_bar_lines P_ ((struct frame *, Lisp_Object, Lisp_Object));
685void x_set_scroll_bar_width P_ ((struct frame *, Lisp_Object, Lisp_Object));
686void x_set_title P_ ((struct frame *, Lisp_Object, Lisp_Object));
687void x_set_unsplittable P_ ((struct frame *, Lisp_Object, Lisp_Object));
688void x_set_tool_bar_lines P_ ((struct frame *, Lisp_Object, Lisp_Object));
689static void x_set_screen_gamma P_ ((struct frame *, Lisp_Object, Lisp_Object));
3cf3436e
JR		 690static void x_edge_detection P_ ((struct frame *, struct image *, Lisp_Object,
691 Lisp_Object));
ee78dc32
GV		 692
693static struct x_frame_parm_table x_frame_parms[] =
694{
1edf84e7
GV		 695 "auto-raise", x_set_autoraise,
696 "auto-lower", x_set_autolower,
ee78dc32 697 "background-color", x_set_background_color,
ee78dc32 698 "border-color", x_set_border_color,
1edf84e7
GV		 699 "border-width", x_set_border_width,
700 "cursor-color", x_set_cursor_color,
ee78dc32 701 "cursor-type", x_set_cursor_type,
ee78dc32 702 "font", x_set_font,
1edf84e7
GV		 703 "foreground-color", x_set_foreground_color,
704 "icon-name", x_set_icon_name,
705 "icon-type", x_set_icon_type,
ee78dc32 706 "internal-border-width", x_set_internal_border_width,
ee78dc32 707 "menu-bar-lines", x_set_menu_bar_lines,
1edf84e7
GV		 708 "mouse-color", x_set_mouse_color,
709 "name", x_explicitly_set_name,
ee78dc32 710 "scroll-bar-width", x_set_scroll_bar_width,
1edf84e7 711 "title", x_set_title,
ee78dc32 712 "unsplittable", x_set_unsplittable,
1edf84e7
GV		 713 "vertical-scroll-bars", x_set_vertical_scroll_bars,
714 "visibility", x_set_visibility,
6fc2811b 715 "tool-bar-lines", x_set_tool_bar_lines,
dfff8a69
JR		 716 "screen-gamma", x_set_screen_gamma,
717 "line-spacing", x_set_line_spacing
ee78dc32
GV		 718};
719
720/* Attach the `x-frame-parameter' properties to
fbd6baed 721 the Lisp symbol names of parameters relevant to W32. */
ee78dc32 722
dfff8a69 723void
ee78dc32
GV		 724init_x_parm_symbols ()
725{
726 int i;
727
728 for (i = 0; i < sizeof (x_frame_parms) / sizeof (x_frame_parms[0]); i++)
729 Fput (intern (x_frame_parms[i].name), Qx_frame_parameter,
730 make_number (i));
731}
732\f
dfff8a69 733/* Change the parameters of frame F as specified by ALIST.
ee78dc32
GV		 734 If a parameter is not specially recognized, do nothing;
735 otherwise call the `x_set_...' function for that parameter. */
736
737void
738x_set_frame_parameters (f, alist)
739 FRAME_PTR f;
740 Lisp_Object alist;
741{
742 Lisp_Object tail;
743
744 /* If both of these parameters are present, it's more efficient to
745 set them both at once. So we wait until we've looked at the
746 entire list before we set them. */
b839712d 747 int width, height;
ee78dc32
GV		 748
749 /* Same here. */
750 Lisp_Object left, top;
751
752 /* Same with these. */
753 Lisp_Object icon_left, icon_top;
754
755 /* Record in these vectors all the parms specified. */
756 Lisp_Object *parms;
757 Lisp_Object *values;
a797a73d 758 int i, p;
ee78dc32
GV		 759 int left_no_change = 0, top_no_change = 0;
760 int icon_left_no_change = 0, icon_top_no_change = 0;
761
5878523b
RS		 762 struct gcpro gcpro1, gcpro2;
763
ee78dc32
GV		 764 i = 0;
765 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
766 i++;
767
768 parms = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
769 values = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
770
771 /* Extract parm names and values into those vectors. */
772
773 i = 0;
774 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
775 {
6fc2811b 776 Lisp_Object elt;
ee78dc32
GV		 777
778 elt = Fcar (tail);
779 parms[i] = Fcar (elt);
780 values[i] = Fcdr (elt);
781 i++;
782 }
5878523b
RS		 783 /* TAIL and ALIST are not used again below here. */
784 alist = tail = Qnil;
785
786 GCPRO2 (*parms, *values);
787 gcpro1.nvars = i;
788 gcpro2.nvars = i;
789
790 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
791 because their values appear in VALUES and strings are not valid. */
b839712d 792 top = left = Qunbound;
ee78dc32
GV		 793 icon_left = icon_top = Qunbound;
794
b839712d 795 /* Provide default values for HEIGHT and WIDTH. */
dfff8a69
JR		 796 if (FRAME_NEW_WIDTH (f))
797 width = FRAME_NEW_WIDTH (f);
798 else
799 width = FRAME_WIDTH (f);
800
801 if (FRAME_NEW_HEIGHT (f))
802 height = FRAME_NEW_HEIGHT (f);
803 else
804 height = FRAME_HEIGHT (f);
b839712d 805
a797a73d
GV		 806 /* Process foreground_color and background_color before anything else.
807 They are independent of other properties, but other properties (e.g.,
808 cursor_color) are dependent upon them. */
809 for (p = 0; p < i; p++)
810 {
811 Lisp_Object prop, val;
812
813 prop = parms[p];
814 val = values[p];
815 if (EQ (prop, Qforeground_color) || EQ (prop, Qbackground_color))
816 {
817 register Lisp_Object param_index, old_value;
818
819 param_index = Fget (prop, Qx_frame_parameter);
820 old_value = get_frame_param (f, prop);
821 store_frame_param (f, prop, val);
822 if (NATNUMP (param_index)
823 && (XFASTINT (param_index)
824 < sizeof (x_frame_parms)/sizeof (x_frame_parms[0])))
825 (*x_frame_parms[XINT (param_index)].setter)(f, val, old_value);
826 }
827 }
828
ee78dc32
GV		 829 /* Now process them in reverse of specified order. */
830 for (i--; i >= 0; i--)
831 {
832 Lisp_Object prop, val;
833
834 prop = parms[i];
835 val = values[i];
836
b839712d
RS		 837 if (EQ (prop, Qwidth) && NUMBERP (val))
838 width = XFASTINT (val);
839 else if (EQ (prop, Qheight) && NUMBERP (val))
840 height = XFASTINT (val);
ee78dc32
GV		 841 else if (EQ (prop, Qtop))
842 top = val;
843 else if (EQ (prop, Qleft))
844 left = val;
845 else if (EQ (prop, Qicon_top))
846 icon_top = val;
847 else if (EQ (prop, Qicon_left))
848 icon_left = val;
a797a73d
GV		 849 else if (EQ (prop, Qforeground_color) || EQ (prop, Qbackground_color))
850 /* Processed above. */
851 continue;
ee78dc32
GV		 852 else
853 {
854 register Lisp_Object param_index, old_value;
855
856 param_index = Fget (prop, Qx_frame_parameter);
857 old_value = get_frame_param (f, prop);
858 store_frame_param (f, prop, val);
859 if (NATNUMP (param_index)
860 && (XFASTINT (param_index)
861 < sizeof (x_frame_parms)/sizeof (x_frame_parms[0])))
3c190163 862 (*x_frame_parms[XINT (param_index)].setter)(f, val, old_value);
ee78dc32
GV		 863 }
864 }
865
866 /* Don't die if just one of these was set. */
867 if (EQ (left, Qunbound))
868 {
869 left_no_change = 1;
fbd6baed
GV		 870 if (f->output_data.w32->left_pos < 0)
871 left = Fcons (Qplus, Fcons (make_number (f->output_data.w32->left_pos), Qnil));
ee78dc32 872 else
fbd6baed 873 XSETINT (left, f->output_data.w32->left_pos);
ee78dc32
GV		 874 }
875 if (EQ (top, Qunbound))
876 {
877 top_no_change = 1;
fbd6baed
GV		 878 if (f->output_data.w32->top_pos < 0)
879 top = Fcons (Qplus, Fcons (make_number (f->output_data.w32->top_pos), Qnil));
ee78dc32 880 else
fbd6baed 881 XSETINT (top, f->output_data.w32->top_pos);
ee78dc32
GV		 882 }
883
884 /* If one of the icon positions was not set, preserve or default it. */
885 if (EQ (icon_left, Qunbound) || ! INTEGERP (icon_left))
886 {
887 icon_left_no_change = 1;
888 icon_left = Fcdr (Fassq (Qicon_left, f->param_alist));
889 if (NILP (icon_left))
890 XSETINT (icon_left, 0);
891 }
892 if (EQ (icon_top, Qunbound) || ! INTEGERP (icon_top))
893 {
894 icon_top_no_change = 1;
895 icon_top = Fcdr (Fassq (Qicon_top, f->param_alist));
896 if (NILP (icon_top))
897 XSETINT (icon_top, 0);
898 }
899
ee78dc32
GV		 900 /* Don't set these parameters unless they've been explicitly
901 specified. The window might be mapped or resized while we're in
902 this function, and we don't want to override that unless the lisp
903 code has asked for it.
904
905 Don't set these parameters unless they actually differ from the
906 window's current parameters; the window may not actually exist
907 yet. */
908 {
909 Lisp_Object frame;
910
911 check_frame_size (f, &height, &width);
912
913 XSETFRAME (frame, f);
914
dfff8a69
JR		 915 if (width != FRAME_WIDTH (f)
916 || height != FRAME_HEIGHT (f)
917 || FRAME_NEW_HEIGHT (f) || FRAME_NEW_WIDTH (f))
b839712d 918 Fset_frame_size (frame, make_number (width), make_number (height));
ee78dc32
GV		 919
920 if ((!NILP (left) || !NILP (top))
921 && ! (left_no_change && top_no_change)
fbd6baed
GV		 922 && ! (NUMBERP (left) && XINT (left) == f->output_data.w32->left_pos
923 && NUMBERP (top) && XINT (top) == f->output_data.w32->top_pos))
ee78dc32
GV		 924 {
925 int leftpos = 0;
926 int toppos = 0;
927
928 /* Record the signs. */
fbd6baed 929 f->output_data.w32->size_hint_flags &= ~ (XNegative | YNegative);
ee78dc32 930 if (EQ (left, Qminus))
fbd6baed 931 f->output_data.w32->size_hint_flags |= XNegative;
ee78dc32
GV		 932 else if (INTEGERP (left))
933 {
934 leftpos = XINT (left);
935 if (leftpos < 0)
fbd6baed 936 f->output_data.w32->size_hint_flags |= XNegative;
ee78dc32 937 }
8e713be6
KR		 938 else if (CONSP (left) && EQ (XCAR (left), Qminus)
939 && CONSP (XCDR (left))
940 && INTEGERP (XCAR (XCDR (left))))
ee78dc32 941 {
8e713be6 942 leftpos = - XINT (XCAR (XCDR (left)));
fbd6baed 943 f->output_data.w32->size_hint_flags |= XNegative;
ee78dc32 944 }
8e713be6
KR		 945 else if (CONSP (left) && EQ (XCAR (left), Qplus)
946 && CONSP (XCDR (left))
947 && INTEGERP (XCAR (XCDR (left))))
ee78dc32 948 {
8e713be6 949 leftpos = XINT (XCAR (XCDR (left)));
ee78dc32
GV		 950 }
951
952 if (EQ (top, Qminus))
fbd6baed 953 f->output_data.w32->size_hint_flags |= YNegative;
ee78dc32
GV		 954 else if (INTEGERP (top))
955 {
956 toppos = XINT (top);
957 if (toppos < 0)
fbd6baed 958 f->output_data.w32->size_hint_flags |= YNegative;
ee78dc32 959 }
8e713be6
KR		 960 else if (CONSP (top) && EQ (XCAR (top), Qminus)
961 && CONSP (XCDR (top))
962 && INTEGERP (XCAR (XCDR (top))))
ee78dc32 963 {
8e713be6 964 toppos = - XINT (XCAR (XCDR (top)));
fbd6baed 965 f->output_data.w32->size_hint_flags |= YNegative;
ee78dc32 966 }
8e713be6
KR		 967 else if (CONSP (top) && EQ (XCAR (top), Qplus)
968 && CONSP (XCDR (top))
969 && INTEGERP (XCAR (XCDR (top))))
ee78dc32 970 {
8e713be6 971 toppos = XINT (XCAR (XCDR (top)));
ee78dc32
GV		 972 }
973
974
975 /* Store the numeric value of the position. */
fbd6baed
GV		 976 f->output_data.w32->top_pos = toppos;
977 f->output_data.w32->left_pos = leftpos;
ee78dc32 978
fbd6baed 979 f->output_data.w32->win_gravity = NorthWestGravity;
ee78dc32
GV		 980
981 /* Actually set that position, and convert to absolute. */
982 x_set_offset (f, leftpos, toppos, -1);
983 }
984
985 if ((!NILP (icon_left) || !NILP (icon_top))
986 && ! (icon_left_no_change && icon_top_no_change))
987 x_wm_set_icon_position (f, XINT (icon_left), XINT (icon_top));
988 }
5878523b
RS		 989
990 UNGCPRO;
ee78dc32
GV		 991}
992
993/* Store the screen positions of frame F into XPTR and YPTR.
994 These are the positions of the containing window manager window,
995 not Emacs's own window. */
996
997void
998x_real_positions (f, xptr, yptr)
999 FRAME_PTR f;
1000 int *xptr, *yptr;
1001{
1002 POINT pt;
3c190163
GV		 1003
1004 {
1005 RECT rect;
ee78dc32 1006
fbd6baed
GV		 1007 GetClientRect(FRAME_W32_WINDOW(f), &rect);
1008 AdjustWindowRect(&rect, f->output_data.w32->dwStyle, FRAME_EXTERNAL_MENU_BAR(f));
ee78dc32 1009
3c190163
GV		 1010 pt.x = rect.left;
1011 pt.y = rect.top;
1012 }
ee78dc32 1013
fbd6baed 1014 ClientToScreen (FRAME_W32_WINDOW(f), &pt);
ee78dc32
GV		 1015
1016 *xptr = pt.x;
1017 *yptr = pt.y;
1018}
1019
1020/* Insert a description of internally-recorded parameters of frame X
1021 into the parameter alist *ALISTPTR that is to be given to the user.
fbd6baed 1022 Only parameters that are specific to W32
ee78dc32
GV		 1023 and whose values are not correctly recorded in the frame's
1024 param_alist need to be considered here. */
1025
dfff8a69 1026void
ee78dc32
GV		 1027x_report_frame_params (f, alistptr)
1028 struct frame *f;
1029 Lisp_Object *alistptr;
1030{
1031 char buf[16];
1032 Lisp_Object tem;
1033
1034 /* Represent negative positions (off the top or left screen edge)
1035 in a way that Fmodify_frame_parameters will understand correctly. */
fbd6baed
GV		 1036 XSETINT (tem, f->output_data.w32->left_pos);
1037 if (f->output_data.w32->left_pos >= 0)
ee78dc32
GV		 1038 store_in_alist (alistptr, Qleft, tem);
1039 else
1040 store_in_alist (alistptr, Qleft, Fcons (Qplus, Fcons (tem, Qnil)));
1041
fbd6baed
GV		 1042 XSETINT (tem, f->output_data.w32->top_pos);
1043 if (f->output_data.w32->top_pos >= 0)
ee78dc32
GV		 1044 store_in_alist (alistptr, Qtop, tem);
1045 else
1046 store_in_alist (alistptr, Qtop, Fcons (Qplus, Fcons (tem, Qnil)));
1047
1048 store_in_alist (alistptr, Qborder_width,
fbd6baed 1049 make_number (f->output_data.w32->border_width));
ee78dc32 1050 store_in_alist (alistptr, Qinternal_border_width,
fbd6baed
GV		 1051 make_number (f->output_data.w32->internal_border_width));
1052 sprintf (buf, "%ld", (long) FRAME_W32_WINDOW (f));
ee78dc32
GV		 1053 store_in_alist (alistptr, Qwindow_id,
1054 build_string (buf));
1055 store_in_alist (alistptr, Qicon_name, f->icon_name);
1056 FRAME_SAMPLE_VISIBILITY (f);
1057 store_in_alist (alistptr, Qvisibility,
1058 (FRAME_VISIBLE_P (f) ? Qt
1059 : FRAME_ICONIFIED_P (f) ? Qicon : Qnil));
1060 store_in_alist (alistptr, Qdisplay,
8e713be6 1061 XCAR (FRAME_W32_DISPLAY_INFO (f)->name_list_element));
ee78dc32
GV		 1062}
1063\f
1064
fbd6baed 1065DEFUN ("w32-define-rgb-color", Fw32_define_rgb_color, Sw32_define_rgb_color, 4, 4, 0,
5ac45f98 1066 "Convert RGB numbers to a windows color reference and associate with NAME (a string).\n\
fbd6baed 1067This adds or updates a named color to w32-color-map, making it available for use.\n\
5ac45f98
GV		 1068The original entry's RGB ref is returned, or nil if the entry is new.")
1069 (red, green, blue, name)
1070 Lisp_Object red, green, blue, name;
ee78dc32 1071{
5ac45f98
GV		 1072 Lisp_Object rgb;
1073 Lisp_Object oldrgb = Qnil;
1074 Lisp_Object entry;
1075
1076 CHECK_NUMBER (red, 0);
1077 CHECK_NUMBER (green, 0);
1078 CHECK_NUMBER (blue, 0);
1079 CHECK_STRING (name, 0);
ee78dc32 1080
5ac45f98 1081 XSET (rgb, Lisp_Int, RGB(XUINT (red), XUINT (green), XUINT (blue)));
ee78dc32 1082
5ac45f98 1083 BLOCK_INPUT;
ee78dc32 1084
fbd6baed
GV		 1085 /* replace existing entry in w32-color-map or add new entry. */
1086 entry = Fassoc (name, Vw32_color_map);
5ac45f98
GV		 1087 if (NILP (entry))
1088 {
1089 entry = Fcons (name, rgb);
fbd6baed 1090 Vw32_color_map = Fcons (entry, Vw32_color_map);
5ac45f98
GV		 1091 }
1092 else
1093 {
1094 oldrgb = Fcdr (entry);
1095 Fsetcdr (entry, rgb);
1096 }
1097
1098 UNBLOCK_INPUT;
1099
1100 return (oldrgb);
ee78dc32
GV		 1101}
1102
fbd6baed 1103DEFUN ("w32-load-color-file", Fw32_load_color_file, Sw32_load_color_file, 1, 1, 0,
5ac45f98 1104 "Create an alist of color entries from an external file (ie. rgb.txt).\n\
fbd6baed 1105Assign this value to w32-color-map to replace the existing color map.\n\
5ac45f98
GV		 1106\
1107The file should define one named RGB color per line like so:\
1108 R G B name\n\
1109where R,G,B are numbers between 0 and 255 and name is an arbitrary string.")
1110 (filename)
1111 Lisp_Object filename;
1112{
1113 FILE *fp;
1114 Lisp_Object cmap = Qnil;
1115 Lisp_Object abspath;
1116
1117 CHECK_STRING (filename, 0);
1118 abspath = Fexpand_file_name (filename, Qnil);
1119
1120 fp = fopen (XSTRING (filename)->data, "rt");
1121 if (fp)
1122 {
1123 char buf[512];
1124 int red, green, blue;
1125 int num;
1126
1127 BLOCK_INPUT;
1128
1129 while (fgets (buf, sizeof (buf), fp) != NULL) {
1130 if (sscanf (buf, "%u %u %u %n", &red, &green, &blue, &num) == 3)
1131 {
1132 char *name = buf + num;
1133 num = strlen (name) - 1;
1134 if (name[num] == '\n')
1135 name[num] = 0;
1136 cmap = Fcons (Fcons (build_string (name),
1137 make_number (RGB (red, green, blue))),
1138 cmap);
1139 }
1140 }
1141 fclose (fp);
1142
1143 UNBLOCK_INPUT;
1144 }
1145
1146 return cmap;
1147}
ee78dc32 1148
fbd6baed 1149/* The default colors for the w32 color map */
ee78dc32
GV		 1150typedef struct colormap_t
1151{
1152 char *name;
1153 COLORREF colorref;
1154} colormap_t;
1155
fbd6baed 1156colormap_t w32_color_map[] =
ee78dc32 1157{
1da8a614
GV		 1158 {"snow" , PALETTERGB (255,250,250)},
1159 {"ghost white" , PALETTERGB (248,248,255)},
1160 {"GhostWhite" , PALETTERGB (248,248,255)},
1161 {"white smoke" , PALETTERGB (245,245,245)},
1162 {"WhiteSmoke" , PALETTERGB (245,245,245)},
1163 {"gainsboro" , PALETTERGB (220,220,220)},
1164 {"floral white" , PALETTERGB (255,250,240)},
1165 {"FloralWhite" , PALETTERGB (255,250,240)},
1166 {"old lace" , PALETTERGB (253,245,230)},
1167 {"OldLace" , PALETTERGB (253,245,230)},
1168 {"linen" , PALETTERGB (250,240,230)},
1169 {"antique white" , PALETTERGB (250,235,215)},
1170 {"AntiqueWhite" , PALETTERGB (250,235,215)},
1171 {"papaya whip" , PALETTERGB (255,239,213)},
1172 {"PapayaWhip" , PALETTERGB (255,239,213)},
1173 {"blanched almond" , PALETTERGB (255,235,205)},
1174 {"BlanchedAlmond" , PALETTERGB (255,235,205)},
1175 {"bisque" , PALETTERGB (255,228,196)},
1176 {"peach puff" , PALETTERGB (255,218,185)},
1177 {"PeachPuff" , PALETTERGB (255,218,185)},
1178 {"navajo white" , PALETTERGB (255,222,173)},
1179 {"NavajoWhite" , PALETTERGB (255,222,173)},
1180 {"moccasin" , PALETTERGB (255,228,181)},
1181 {"cornsilk" , PALETTERGB (255,248,220)},
1182 {"ivory" , PALETTERGB (255,255,240)},
1183 {"lemon chiffon" , PALETTERGB (255,250,205)},
1184 {"LemonChiffon" , PALETTERGB (255,250,205)},
1185 {"seashell" , PALETTERGB (255,245,238)},
1186 {"honeydew" , PALETTERGB (240,255,240)},
1187 {"mint cream" , PALETTERGB (245,255,250)},
1188 {"MintCream" , PALETTERGB (245,255,250)},
1189 {"azure" , PALETTERGB (240,255,255)},
1190 {"alice blue" , PALETTERGB (240,248,255)},
1191 {"AliceBlue" , PALETTERGB (240,248,255)},
1192 {"lavender" , PALETTERGB (230,230,250)},
1193 {"lavender blush" , PALETTERGB (255,240,245)},
1194 {"LavenderBlush" , PALETTERGB (255,240,245)},
1195 {"misty rose" , PALETTERGB (255,228,225)},
1196 {"MistyRose" , PALETTERGB (255,228,225)},
1197 {"white" , PALETTERGB (255,255,255)},
1198 {"black" , PALETTERGB ( 0, 0, 0)},
1199 {"dark slate gray" , PALETTERGB ( 47, 79, 79)},
1200 {"DarkSlateGray" , PALETTERGB ( 47, 79, 79)},
1201 {"dark slate grey" , PALETTERGB ( 47, 79, 79)},
1202 {"DarkSlateGrey" , PALETTERGB ( 47, 79, 79)},
1203 {"dim gray" , PALETTERGB (105,105,105)},
1204 {"DimGray" , PALETTERGB (105,105,105)},
1205 {"dim grey" , PALETTERGB (105,105,105)},
1206 {"DimGrey" , PALETTERGB (105,105,105)},
1207 {"slate gray" , PALETTERGB (112,128,144)},
1208 {"SlateGray" , PALETTERGB (112,128,144)},
1209 {"slate grey" , PALETTERGB (112,128,144)},
1210 {"SlateGrey" , PALETTERGB (112,128,144)},
1211 {"light slate gray" , PALETTERGB (119,136,153)},
1212 {"LightSlateGray" , PALETTERGB (119,136,153)},
1213 {"light slate grey" , PALETTERGB (119,136,153)},
1214 {"LightSlateGrey" , PALETTERGB (119,136,153)},
1215 {"gray" , PALETTERGB (190,190,190)},
1216 {"grey" , PALETTERGB (190,190,190)},
1217 {"light grey" , PALETTERGB (211,211,211)},
1218 {"LightGrey" , PALETTERGB (211,211,211)},
1219 {"light gray" , PALETTERGB (211,211,211)},
1220 {"LightGray" , PALETTERGB (211,211,211)},
1221 {"midnight blue" , PALETTERGB ( 25, 25,112)},
1222 {"MidnightBlue" , PALETTERGB ( 25, 25,112)},
1223 {"navy" , PALETTERGB ( 0, 0,128)},
1224 {"navy blue" , PALETTERGB ( 0, 0,128)},
1225 {"NavyBlue" , PALETTERGB ( 0, 0,128)},
1226 {"cornflower blue" , PALETTERGB (100,149,237)},
1227 {"CornflowerBlue" , PALETTERGB (100,149,237)},
1228 {"dark slate blue" , PALETTERGB ( 72, 61,139)},
1229 {"DarkSlateBlue" , PALETTERGB ( 72, 61,139)},
1230 {"slate blue" , PALETTERGB (106, 90,205)},
1231 {"SlateBlue" , PALETTERGB (106, 90,205)},
1232 {"medium slate blue" , PALETTERGB (123,104,238)},
1233 {"MediumSlateBlue" , PALETTERGB (123,104,238)},
1234 {"light slate blue" , PALETTERGB (132,112,255)},
1235 {"LightSlateBlue" , PALETTERGB (132,112,255)},
1236 {"medium blue" , PALETTERGB ( 0, 0,205)},
1237 {"MediumBlue" , PALETTERGB ( 0, 0,205)},
1238 {"royal blue" , PALETTERGB ( 65,105,225)},
1239 {"RoyalBlue" , PALETTERGB ( 65,105,225)},
1240 {"blue" , PALETTERGB ( 0, 0,255)},
1241 {"dodger blue" , PALETTERGB ( 30,144,255)},
1242 {"DodgerBlue" , PALETTERGB ( 30,144,255)},
1243 {"deep sky blue" , PALETTERGB ( 0,191,255)},
1244 {"DeepSkyBlue" , PALETTERGB ( 0,191,255)},
1245 {"sky blue" , PALETTERGB (135,206,235)},
1246 {"SkyBlue" , PALETTERGB (135,206,235)},
1247 {"light sky blue" , PALETTERGB (135,206,250)},
1248 {"LightSkyBlue" , PALETTERGB (135,206,250)},
1249 {"steel blue" , PALETTERGB ( 70,130,180)},
1250 {"SteelBlue" , PALETTERGB ( 70,130,180)},
1251 {"light steel blue" , PALETTERGB (176,196,222)},
1252 {"LightSteelBlue" , PALETTERGB (176,196,222)},
1253 {"light blue" , PALETTERGB (173,216,230)},
1254 {"LightBlue" , PALETTERGB (173,216,230)},
1255 {"powder blue" , PALETTERGB (176,224,230)},
1256 {"PowderBlue" , PALETTERGB (176,224,230)},
1257 {"pale turquoise" , PALETTERGB (175,238,238)},
1258 {"PaleTurquoise" , PALETTERGB (175,238,238)},
1259 {"dark turquoise" , PALETTERGB ( 0,206,209)},
1260 {"DarkTurquoise" , PALETTERGB ( 0,206,209)},
1261 {"medium turquoise" , PALETTERGB ( 72,209,204)},
1262 {"MediumTurquoise" , PALETTERGB ( 72,209,204)},
1263 {"turquoise" , PALETTERGB ( 64,224,208)},
1264 {"cyan" , PALETTERGB ( 0,255,255)},
1265 {"light cyan" , PALETTERGB (224,255,255)},
1266 {"LightCyan" , PALETTERGB (224,255,255)},
1267 {"cadet blue" , PALETTERGB ( 95,158,160)},
1268 {"CadetBlue" , PALETTERGB ( 95,158,160)},
1269 {"medium aquamarine" , PALETTERGB (102,205,170)},
1270 {"MediumAquamarine" , PALETTERGB (102,205,170)},
1271 {"aquamarine" , PALETTERGB (127,255,212)},
1272 {"dark green" , PALETTERGB ( 0,100, 0)},
1273 {"DarkGreen" , PALETTERGB ( 0,100, 0)},
1274 {"dark olive green" , PALETTERGB ( 85,107, 47)},
1275 {"DarkOliveGreen" , PALETTERGB ( 85,107, 47)},
1276 {"dark sea green" , PALETTERGB (143,188,143)},
1277 {"DarkSeaGreen" , PALETTERGB (143,188,143)},
1278 {"sea green" , PALETTERGB ( 46,139, 87)},
1279 {"SeaGreen" , PALETTERGB ( 46,139, 87)},
1280 {"medium sea green" , PALETTERGB ( 60,179,113)},
1281 {"MediumSeaGreen" , PALETTERGB ( 60,179,113)},
1282 {"light sea green" , PALETTERGB ( 32,178,170)},
1283 {"LightSeaGreen" , PALETTERGB ( 32,178,170)},
1284 {"pale green" , PALETTERGB (152,251,152)},
1285 {"PaleGreen" , PALETTERGB (152,251,152)},
1286 {"spring green" , PALETTERGB ( 0,255,127)},
1287 {"SpringGreen" , PALETTERGB ( 0,255,127)},
1288 {"lawn green" , PALETTERGB (124,252, 0)},
1289 {"LawnGreen" , PALETTERGB (124,252, 0)},
1290 {"green" , PALETTERGB ( 0,255, 0)},
1291 {"chartreuse" , PALETTERGB (127,255, 0)},
1292 {"medium spring green" , PALETTERGB ( 0,250,154)},
1293 {"MediumSpringGreen" , PALETTERGB ( 0,250,154)},
1294 {"green yellow" , PALETTERGB (173,255, 47)},
1295 {"GreenYellow" , PALETTERGB (173,255, 47)},
1296 {"lime green" , PALETTERGB ( 50,205, 50)},
1297 {"LimeGreen" , PALETTERGB ( 50,205, 50)},
1298 {"yellow green" , PALETTERGB (154,205, 50)},
1299 {"YellowGreen" , PALETTERGB (154,205, 50)},
1300 {"forest green" , PALETTERGB ( 34,139, 34)},
1301 {"ForestGreen" , PALETTERGB ( 34,139, 34)},
1302 {"olive drab" , PALETTERGB (107,142, 35)},
1303 {"OliveDrab" , PALETTERGB (107,142, 35)},
1304 {"dark khaki" , PALETTERGB (189,183,107)},
1305 {"DarkKhaki" , PALETTERGB (189,183,107)},
1306 {"khaki" , PALETTERGB (240,230,140)},
1307 {"pale goldenrod" , PALETTERGB (238,232,170)},
1308 {"PaleGoldenrod" , PALETTERGB (238,232,170)},
1309 {"light goldenrod yellow" , PALETTERGB (250,250,210)},
1310 {"LightGoldenrodYellow" , PALETTERGB (250,250,210)},
1311 {"light yellow" , PALETTERGB (255,255,224)},
1312 {"LightYellow" , PALETTERGB (255,255,224)},
1313 {"yellow" , PALETTERGB (255,255, 0)},
1314 {"gold" , PALETTERGB (255,215, 0)},
1315 {"light goldenrod" , PALETTERGB (238,221,130)},
1316 {"LightGoldenrod" , PALETTERGB (238,221,130)},
1317 {"goldenrod" , PALETTERGB (218,165, 32)},
1318 {"dark goldenrod" , PALETTERGB (184,134, 11)},
1319 {"DarkGoldenrod" , PALETTERGB (184,134, 11)},
1320 {"rosy brown" , PALETTERGB (188,143,143)},
1321 {"RosyBrown" , PALETTERGB (188,143,143)},
1322 {"indian red" , PALETTERGB (205, 92, 92)},
1323 {"IndianRed" , PALETTERGB (205, 92, 92)},
1324 {"saddle brown" , PALETTERGB (139, 69, 19)},
1325 {"SaddleBrown" , PALETTERGB (139, 69, 19)},
1326 {"sienna" , PALETTERGB (160, 82, 45)},
1327 {"peru" , PALETTERGB (205,133, 63)},
1328 {"burlywood" , PALETTERGB (222,184,135)},
1329 {"beige" , PALETTERGB (245,245,220)},
1330 {"wheat" , PALETTERGB (245,222,179)},
1331 {"sandy brown" , PALETTERGB (244,164, 96)},
1332 {"SandyBrown" , PALETTERGB (244,164, 96)},
1333 {"tan" , PALETTERGB (210,180,140)},
1334 {"chocolate" , PALETTERGB (210,105, 30)},
1335 {"firebrick" , PALETTERGB (178,34, 34)},
1336 {"brown" , PALETTERGB (165,42, 42)},
1337 {"dark salmon" , PALETTERGB (233,150,122)},
1338 {"DarkSalmon" , PALETTERGB (233,150,122)},
1339 {"salmon" , PALETTERGB (250,128,114)},
1340 {"light salmon" , PALETTERGB (255,160,122)},
1341 {"LightSalmon" , PALETTERGB (255,160,122)},
1342 {"orange" , PALETTERGB (255,165, 0)},
1343 {"dark orange" , PALETTERGB (255,140, 0)},
1344 {"DarkOrange" , PALETTERGB (255,140, 0)},
1345 {"coral" , PALETTERGB (255,127, 80)},
1346 {"light coral" , PALETTERGB (240,128,128)},
1347 {"LightCoral" , PALETTERGB (240,128,128)},
1348 {"tomato" , PALETTERGB (255, 99, 71)},
1349 {"orange red" , PALETTERGB (255, 69, 0)},
1350 {"OrangeRed" , PALETTERGB (255, 69, 0)},
1351 {"red" , PALETTERGB (255, 0, 0)},
1352 {"hot pink" , PALETTERGB (255,105,180)},
1353 {"HotPink" , PALETTERGB (255,105,180)},
1354 {"deep pink" , PALETTERGB (255, 20,147)},
1355 {"DeepPink" , PALETTERGB (255, 20,147)},
1356 {"pink" , PALETTERGB (255,192,203)},
1357 {"light pink" , PALETTERGB (255,182,193)},
1358 {"LightPink" , PALETTERGB (255,182,193)},
1359 {"pale violet red" , PALETTERGB (219,112,147)},
1360 {"PaleVioletRed" , PALETTERGB (219,112,147)},
1361 {"maroon" , PALETTERGB (176, 48, 96)},
1362 {"medium violet red" , PALETTERGB (199, 21,133)},
1363 {"MediumVioletRed" , PALETTERGB (199, 21,133)},
1364 {"violet red" , PALETTERGB (208, 32,144)},
1365 {"VioletRed" , PALETTERGB (208, 32,144)},
1366 {"magenta" , PALETTERGB (255, 0,255)},
1367 {"violet" , PALETTERGB (238,130,238)},
1368 {"plum" , PALETTERGB (221,160,221)},
1369 {"orchid" , PALETTERGB (218,112,214)},
1370 {"medium orchid" , PALETTERGB (186, 85,211)},
1371 {"MediumOrchid" , PALETTERGB (186, 85,211)},
1372 {"dark orchid" , PALETTERGB (153, 50,204)},
1373 {"DarkOrchid" , PALETTERGB (153, 50,204)},
1374 {"dark violet" , PALETTERGB (148, 0,211)},
1375 {"DarkViolet" , PALETTERGB (148, 0,211)},
1376 {"blue violet" , PALETTERGB (138, 43,226)},
1377 {"BlueViolet" , PALETTERGB (138, 43,226)},
1378 {"purple" , PALETTERGB (160, 32,240)},
1379 {"medium purple" , PALETTERGB (147,112,219)},
1380 {"MediumPurple" , PALETTERGB (147,112,219)},
1381 {"thistle" , PALETTERGB (216,191,216)},
1382 {"gray0" , PALETTERGB ( 0, 0, 0)},
1383 {"grey0" , PALETTERGB ( 0, 0, 0)},
1384 {"dark grey" , PALETTERGB (169,169,169)},
1385 {"DarkGrey" , PALETTERGB (169,169,169)},
1386 {"dark gray" , PALETTERGB (169,169,169)},
1387 {"DarkGray" , PALETTERGB (169,169,169)},
1388 {"dark blue" , PALETTERGB ( 0, 0,139)},
1389 {"DarkBlue" , PALETTERGB ( 0, 0,139)},
1390 {"dark cyan" , PALETTERGB ( 0,139,139)},
1391 {"DarkCyan" , PALETTERGB ( 0,139,139)},
1392 {"dark magenta" , PALETTERGB (139, 0,139)},
1393 {"DarkMagenta" , PALETTERGB (139, 0,139)},
1394 {"dark red" , PALETTERGB (139, 0, 0)},
1395 {"DarkRed" , PALETTERGB (139, 0, 0)},
1396 {"light green" , PALETTERGB (144,238,144)},
1397 {"LightGreen" , PALETTERGB (144,238,144)},
ee78dc32
GV		 1398};
1399
fbd6baed 1400DEFUN ("w32-default-color-map", Fw32_default_color_map, Sw32_default_color_map,
ee78dc32
GV		 1401 0, 0, 0, "Return the default color map.")
1402 ()
1403{
1404 int i;
fbd6baed 1405 colormap_t *pc = w32_color_map;
ee78dc32
GV		 1406 Lisp_Object cmap;
1407
1408 BLOCK_INPUT;
1409
1410 cmap = Qnil;
1411
fbd6baed 1412 for (i = 0; i < sizeof (w32_color_map) / sizeof (w32_color_map[0]);
ee78dc32
GV		 1413 pc++, i++)
1414 cmap = Fcons (Fcons (build_string (pc->name),
1415 make_number (pc->colorref)),
1416 cmap);
1417
1418 UNBLOCK_INPUT;
1419
1420 return (cmap);
1421}
ee78dc32
GV		 1422
1423Lisp_Object
fbd6baed 1424w32_to_x_color (rgb)
ee78dc32
GV		 1425 Lisp_Object rgb;
1426{
1427 Lisp_Object color;
1428
1429 CHECK_NUMBER (rgb, 0);
1430
1431 BLOCK_INPUT;
1432
fbd6baed 1433 color = Frassq (rgb, Vw32_color_map);
ee78dc32
GV		 1434
1435 UNBLOCK_INPUT;
1436
1437 if (!NILP (color))
1438 return (Fcar (color));
1439 else
1440 return Qnil;
1441}
1442
5d7fed93
GV		 1443COLORREF
1444w32_color_map_lookup (colorname)
1445 char *colorname;
1446{
1447 Lisp_Object tail, ret = Qnil;
1448
1449 BLOCK_INPUT;
1450
1451 for (tail = Vw32_color_map; !NILP (tail); tail = Fcdr (tail))
1452 {
1453 register Lisp_Object elt, tem;
1454
1455 elt = Fcar (tail);
1456 if (!CONSP (elt)) continue;
1457
1458 tem = Fcar (elt);
1459
1460 if (lstrcmpi (XSTRING (tem)->data, colorname) == 0)
1461 {
1462 ret = XUINT (Fcdr (elt));
1463 break;
1464 }
1465
1466 QUIT;
1467 }
1468
1469
1470 UNBLOCK_INPUT;
1471
1472 return ret;
1473}
1474
ee78dc32 1475COLORREF
fbd6baed 1476x_to_w32_color (colorname)
ee78dc32
GV		 1477 char * colorname;
1478{
8edb0a6f
JR		 1479 register Lisp_Object ret = Qnil;
1480
ee78dc32 1481 BLOCK_INPUT;
1edf84e7
GV		 1482
1483 if (colorname[0] == '#')
1484 {
1485 /* Could be an old-style RGB Device specification. */
1486 char *color;
1487 int size;
1488 color = colorname + 1;
1489
1490 size = strlen(color);
1491 if (size == 3 || size == 6 || size == 9 || size == 12)
1492 {
1493 UINT colorval;
1494 int i, pos;
1495 pos = 0;
1496 size /= 3;
1497 colorval = 0;
1498
1499 for (i = 0; i < 3; i++)
1500 {
1501 char *end;
1502 char t;
1503 unsigned long value;
1504
1505 /* The check for 'x' in the following conditional takes into
1506 account the fact that strtol allows a "0x" in front of
1507 our numbers, and we don't. */
1508 if (!isxdigit(color[0]) || color[1] == 'x')
1509 break;
1510 t = color[size];
1511 color[size] = '\0';
1512 value = strtoul(color, &end, 16);
1513 color[size] = t;
1514 if (errno == ERANGE || end - color != size)
1515 break;
1516 switch (size)
1517 {
1518 case 1:
1519 value = value * 0x10;
1520 break;
1521 case 2:
1522 break;
1523 case 3:
1524 value /= 0x10;
1525 break;
1526 case 4:
1527 value /= 0x100;
1528 break;
1529 }
1530 colorval |= (value << pos);
1531 pos += 0x8;
1532 if (i == 2)
1533 {
1534 UNBLOCK_INPUT;
1535 return (colorval);
1536 }
1537 color = end;
1538 }
1539 }
1540 }
1541 else if (strnicmp(colorname, "rgb:", 4) == 0)
1542 {
1543 char *color;
1544 UINT colorval;
1545 int i, pos;
1546 pos = 0;
1547
1548 colorval = 0;
1549 color = colorname + 4;
1550 for (i = 0; i < 3; i++)
1551 {
1552 char *end;
1553 unsigned long value;
1554
1555 /* The check for 'x' in the following conditional takes into
1556 account the fact that strtol allows a "0x" in front of
1557 our numbers, and we don't. */
1558 if (!isxdigit(color[0]) || color[1] == 'x')
1559 break;
1560 value = strtoul(color, &end, 16);
1561 if (errno == ERANGE)
1562 break;
1563 switch (end - color)
1564 {
1565 case 1:
1566 value = value * 0x10 + value;
1567 break;
1568 case 2:
1569 break;
1570 case 3:
1571 value /= 0x10;
1572 break;
1573 case 4:
1574 value /= 0x100;
1575 break;
1576 default:
1577 value = ULONG_MAX;
1578 }
1579 if (value == ULONG_MAX)
1580 break;
1581 colorval |= (value << pos);
1582 pos += 0x8;
1583 if (i == 2)
1584 {
1585 if (*end != '\0')
1586 break;
1587 UNBLOCK_INPUT;
1588 return (colorval);
1589 }
1590 if (*end != '/')
1591 break;
1592 color = end + 1;
1593 }
1594 }
1595 else if (strnicmp(colorname, "rgbi:", 5) == 0)
1596 {
1597 /* This is an RGB Intensity specification. */
1598 char *color;
1599 UINT colorval;
1600 int i, pos;
1601 pos = 0;
1602
1603 colorval = 0;
1604 color = colorname + 5;
1605 for (i = 0; i < 3; i++)
1606 {
1607 char *end;
1608 double value;
1609 UINT val;
1610
1611 value = strtod(color, &end);
1612 if (errno == ERANGE)
1613 break;
1614 if (value < 0.0 || value > 1.0)
1615 break;
1616 val = (UINT)(0x100 * value);
1617 /* We used 0x100 instead of 0xFF to give an continuous
1618 range between 0.0 and 1.0 inclusive. The next statement
1619 fixes the 1.0 case. */
1620 if (val == 0x100)
1621 val = 0xFF;
1622 colorval |= (val << pos);
1623 pos += 0x8;
1624 if (i == 2)
1625 {
1626 if (*end != '\0')
1627 break;
1628 UNBLOCK_INPUT;
1629 return (colorval);
1630 }
1631 if (*end != '/')
1632 break;
1633 color = end + 1;
1634 }
1635 }
1636 /* I am not going to attempt to handle any of the CIE color schemes
1637 or TekHVC, since I don't know the algorithms for conversion to
1638 RGB. */
f695b4b1
GV		 1639
1640 /* If we fail to lookup the color name in w32_color_map, then check the
1641 colorname to see if it can be crudely approximated: If the X color
1642 ends in a number (e.g., "darkseagreen2"), strip the number and
1643 return the result of looking up the base color name. */
1644 ret = w32_color_map_lookup (colorname);
1645 if (NILP (ret))
ee78dc32 1646 {
f695b4b1 1647 int len = strlen (colorname);
ee78dc32 1648
f695b4b1
GV		 1649 if (isdigit (colorname[len - 1]))
1650 {
8b77111c 1651 char *ptr, *approx = alloca (len + 1);
ee78dc32 1652
f695b4b1
GV		 1653 strcpy (approx, colorname);
1654 ptr = &approx[len - 1];
1655 while (ptr > approx && isdigit (*ptr))
1656 *ptr-- = '\0';
ee78dc32 1657
f695b4b1 1658 ret = w32_color_map_lookup (approx);
ee78dc32 1659 }
ee78dc32
GV		 1660 }
1661
1662 UNBLOCK_INPUT;
ee78dc32
GV		 1663 return ret;
1664}
1665
5ac45f98
GV		 1666
1667void
fbd6baed 1668w32_regenerate_palette (FRAME_PTR f)
5ac45f98 1669{
fbd6baed 1670 struct w32_palette_entry * list;
5ac45f98
GV		 1671 LOGPALETTE * log_palette;
1672 HPALETTE new_palette;
1673 int i;
1674
1675 /* don't bother trying to create palette if not supported */
fbd6baed 1676 if (! FRAME_W32_DISPLAY_INFO (f)->has_palette)
5ac45f98
GV		 1677 return;
1678
1679 log_palette = (LOGPALETTE *)
1680 alloca (sizeof (LOGPALETTE) +
fbd6baed 1681 FRAME_W32_DISPLAY_INFO (f)->num_colors * sizeof (PALETTEENTRY));
5ac45f98 1682 log_palette->palVersion = 0x300;
fbd6baed 1683 log_palette->palNumEntries = FRAME_W32_DISPLAY_INFO (f)->num_colors;
5ac45f98 1684
fbd6baed 1685 list = FRAME_W32_DISPLAY_INFO (f)->color_list;
5ac45f98 1686 for (i = 0;
fbd6baed 1687 i < FRAME_W32_DISPLAY_INFO (f)->num_colors;
5ac45f98
GV		 1688 i++, list = list->next)
1689 log_palette->palPalEntry[i] = list->entry;
1690
1691 new_palette = CreatePalette (log_palette);
1692
1693 enter_crit ();
1694
fbd6baed
GV		 1695 if (FRAME_W32_DISPLAY_INFO (f)->palette)
1696 DeleteObject (FRAME_W32_DISPLAY_INFO (f)->palette);
1697 FRAME_W32_DISPLAY_INFO (f)->palette = new_palette;
5ac45f98
GV		 1698
1699 /* Realize display palette and garbage all frames. */
1700 release_frame_dc (f, get_frame_dc (f));
1701
1702 leave_crit ();
1703}
1704
fbd6baed
GV		 1705#define W32_COLOR(pe) RGB (pe.peRed, pe.peGreen, pe.peBlue)
1706#define SET_W32_COLOR(pe, color) \
5ac45f98
GV		 1707 do \
1708 { \
1709 pe.peRed = GetRValue (color); \
1710 pe.peGreen = GetGValue (color); \
1711 pe.peBlue = GetBValue (color); \
1712 pe.peFlags = 0; \
1713 } while (0)
1714
1715#if 0
1716/* Keep these around in case we ever want to track color usage. */
1717void
fbd6baed 1718w32_map_color (FRAME_PTR f, COLORREF color)
5ac45f98 1719{
fbd6baed 1720 struct w32_palette_entry * list = FRAME_W32_DISPLAY_INFO (f)->color_list;
5ac45f98 1721
fbd6baed 1722 if (NILP (Vw32_enable_palette))
5ac45f98
GV		 1723 return;
1724
1725 /* check if color is already mapped */
1726 while (list)
1727 {
fbd6baed 1728 if (W32_COLOR (list->entry) == color)
5ac45f98
GV		 1729 {
1730 ++list->refcount;
1731 return;
1732 }
1733 list = list->next;
1734 }
1735
1736 /* not already mapped, so add to list and recreate Windows palette */
fbd6baed
GV		 1737 list = (struct w32_palette_entry *)
1738 xmalloc (sizeof (struct w32_palette_entry));
1739 SET_W32_COLOR (list->entry, color);
5ac45f98 1740 list->refcount = 1;
fbd6baed
GV		 1741 list->next = FRAME_W32_DISPLAY_INFO (f)->color_list;
1742 FRAME_W32_DISPLAY_INFO (f)->color_list = list;
1743 FRAME_W32_DISPLAY_INFO (f)->num_colors++;
5ac45f98
GV		 1744
1745 /* set flag that palette must be regenerated */
fbd6baed 1746 FRAME_W32_DISPLAY_INFO (f)->regen_palette = TRUE;
5ac45f98
GV		 1747}
1748
1749void
fbd6baed 1750w32_unmap_color (FRAME_PTR f, COLORREF color)
5ac45f98 1751{
fbd6baed
GV		 1752 struct w32_palette_entry * list = FRAME_W32_DISPLAY_INFO (f)->color_list;
1753 struct w32_palette_entry **prev = &FRAME_W32_DISPLAY_INFO (f)->color_list;
5ac45f98 1754
fbd6baed 1755 if (NILP (Vw32_enable_palette))
5ac45f98
GV		 1756 return;
1757
1758 /* check if color is already mapped */
1759 while (list)
1760 {
fbd6baed 1761 if (W32_COLOR (list->entry) == color)
5ac45f98
GV		 1762 {
1763 if (--list->refcount == 0)
1764 {
1765 *prev = list->next;
1766 xfree (list);
fbd6baed 1767 FRAME_W32_DISPLAY_INFO (f)->num_colors--;
5ac45f98
GV		 1768 break;
1769 }
1770 else
1771 return;
1772 }
1773 prev = &list->next;
1774 list = list->next;
1775 }
1776
1777 /* set flag that palette must be regenerated */
fbd6baed 1778 FRAME_W32_DISPLAY_INFO (f)->regen_palette = TRUE;
5ac45f98
GV		 1779}
1780#endif
1781
6fc2811b
JR		 1782
1783/* Gamma-correct COLOR on frame F. */
1784
1785void
1786gamma_correct (f, color)
1787 struct frame *f;
1788 COLORREF *color;
1789{
1790 if (f->gamma)
1791 {
1792 *color = PALETTERGB (
1793 pow (GetRValue (*color) / 255.0, f->gamma) * 255.0 + 0.5,
1794 pow (GetGValue (*color) / 255.0, f->gamma) * 255.0 + 0.5,
1795 pow (GetBValue (*color) / 255.0, f->gamma) * 255.0 + 0.5);
1796 }
1797}
1798
1799
ee78dc32
GV		 1800/* Decide if color named COLOR is valid for the display associated with
1801 the selected frame; if so, return the rgb values in COLOR_DEF.
1802 If ALLOC is nonzero, allocate a new colormap cell. */
1803
1804int
6fc2811b 1805w32_defined_color (f, color, color_def, alloc)
ee78dc32
GV		 1806 FRAME_PTR f;
1807 char *color;
6fc2811b 1808 XColor *color_def;
ee78dc32
GV		 1809 int alloc;
1810{
1811 register Lisp_Object tem;
6fc2811b 1812 COLORREF w32_color_ref;
3c190163 1813
fbd6baed 1814 tem = x_to_w32_color (color);
3c190163 1815
ee78dc32
GV		 1816 if (!NILP (tem))
1817 {
d88c567c
JR		 1818 if (f)
1819 {
1820 /* Apply gamma correction. */
1821 w32_color_ref = XUINT (tem);
1822 gamma_correct (f, &w32_color_ref);
1823 XSETINT (tem, w32_color_ref);
1824 }
9badad41
JR		 1825
1826 /* Map this color to the palette if it is enabled. */
fbd6baed 1827 if (!NILP (Vw32_enable_palette))
5ac45f98 1828 {
fbd6baed 1829 struct w32_palette_entry * entry =
d88c567c 1830 one_w32_display_info.color_list;
fbd6baed 1831 struct w32_palette_entry ** prev =
d88c567c 1832 &one_w32_display_info.color_list;
5ac45f98
GV		 1833
1834 /* check if color is already mapped */
1835 while (entry)
1836 {
fbd6baed 1837 if (W32_COLOR (entry->entry) == XUINT (tem))
5ac45f98
GV		 1838 break;
1839 prev = &entry->next;
1840 entry = entry->next;
1841 }
1842
1843 if (entry == NULL && alloc)
1844 {
1845 /* not already mapped, so add to list */
fbd6baed
GV		 1846 entry = (struct w32_palette_entry *)
1847 xmalloc (sizeof (struct w32_palette_entry));
1848 SET_W32_COLOR (entry->entry, XUINT (tem));
5ac45f98
GV		 1849 entry->next = NULL;
1850 *prev = entry;
d88c567c 1851 one_w32_display_info.num_colors++;
5ac45f98
GV		 1852
1853 /* set flag that palette must be regenerated */
d88c567c 1854 one_w32_display_info.regen_palette = TRUE;
5ac45f98
GV		 1855 }
1856 }
1857 /* Ensure COLORREF value is snapped to nearest color in (default)
1858 palette by simulating the PALETTERGB macro. This works whether
1859 or not the display device has a palette. */
6fc2811b
JR		 1860 w32_color_ref = XUINT (tem) | 0x2000000;
1861
6fc2811b
JR		 1862 color_def->pixel = w32_color_ref;
1863 color_def->red = GetRValue (w32_color_ref);
1864 color_def->green = GetGValue (w32_color_ref);
1865 color_def->blue = GetBValue (w32_color_ref);
1866
ee78dc32 1867 return 1;
5ac45f98 1868 }
7fb46567 1869 else
3c190163
GV		 1870 {
1871 return 0;
1872 }
ee78dc32
GV		 1873}
1874
1875/* Given a string ARG naming a color, compute a pixel value from it
1876 suitable for screen F.
1877 If F is not a color screen, return DEF (default) regardless of what
1878 ARG says. */
1879
1880int
1881x_decode_color (f, arg, def)
1882 FRAME_PTR f;
1883 Lisp_Object arg;
1884 int def;
1885{
6fc2811b 1886 XColor cdef;
ee78dc32
GV		 1887
1888 CHECK_STRING (arg, 0);
1889
1890 if (strcmp (XSTRING (arg)->data, "black") == 0)
1891 return BLACK_PIX_DEFAULT (f);
1892 else if (strcmp (XSTRING (arg)->data, "white") == 0)
1893 return WHITE_PIX_DEFAULT (f);
1894
fbd6baed 1895 if ((FRAME_W32_DISPLAY_INFO (f)->n_planes * FRAME_W32_DISPLAY_INFO (f)->n_cbits) == 1)
ee78dc32
GV		 1896 return def;
1897
6fc2811b 1898 /* w32_defined_color is responsible for coping with failures
ee78dc32 1899 by looking for a near-miss. */
6fc2811b
JR		 1900 if (w32_defined_color (f, XSTRING (arg)->data, &cdef, 1))
1901 return cdef.pixel;
ee78dc32
GV		 1902
1903 /* defined_color failed; return an ultimate default. */
1904 return def;
1905}
1906\f
dfff8a69
JR		 1907/* Change the `line-spacing' frame parameter of frame F. OLD_VALUE is
1908 the previous value of that parameter, NEW_VALUE is the new value. */
1909
1910static void
1911x_set_line_spacing (f, new_value, old_value)
1912 struct frame *f;
1913 Lisp_Object new_value, old_value;
1914{
1915 if (NILP (new_value))
1916 f->extra_line_spacing = 0;
1917 else if (NATNUMP (new_value))
1918 f->extra_line_spacing = XFASTINT (new_value);
1919 else
1a948b17 1920 Fsignal (Qerror, Fcons (build_string ("Invalid line-spacing"),
dfff8a69
JR		 1921 Fcons (new_value, Qnil)));
1922 if (FRAME_VISIBLE_P (f))
1923 redraw_frame (f);
1924}
1925
1926
6fc2811b
JR		 1927/* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
1928 the previous value of that parameter, NEW_VALUE is the new value. */
1929
1930static void
1931x_set_screen_gamma (f, new_value, old_value)
1932 struct frame *f;
1933 Lisp_Object new_value, old_value;
1934{
1935 if (NILP (new_value))
1936 f->gamma = 0;
1937 else if (NUMBERP (new_value) && XFLOATINT (new_value) > 0)
1938 /* The value 0.4545 is the normal viewing gamma. */
1939 f->gamma = 1.0 / (0.4545 * XFLOATINT (new_value));
1940 else
1a948b17 1941 Fsignal (Qerror, Fcons (build_string ("Invalid screen-gamma"),
6fc2811b
JR		 1942 Fcons (new_value, Qnil)));
1943
1944 clear_face_cache (0);
1945}
1946
1947
ee78dc32
GV		 1948/* Functions called only from `x_set_frame_param'
1949 to set individual parameters.
1950
fbd6baed 1951 If FRAME_W32_WINDOW (f) is 0,
ee78dc32
GV		 1952 the frame is being created and its window does not exist yet.
1953 In that case, just record the parameter's new value
1954 in the standard place; do not attempt to change the window. */
1955
1956void
1957x_set_foreground_color (f, arg, oldval)
1958 struct frame *f;
1959 Lisp_Object arg, oldval;
1960{
3cf3436e
JR		 1961 struct w32_output *x = f->output_data.w32;
1962 PIX_TYPE fg, old_fg;
1963
1964 fg = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1965 old_fg = FRAME_FOREGROUND_PIXEL (f);
1966 FRAME_FOREGROUND_PIXEL (f) = fg;
5ac45f98 1967
fbd6baed 1968 if (FRAME_W32_WINDOW (f) != 0)
ee78dc32 1969 {
3cf3436e
JR		 1970 if (x->cursor_pixel == old_fg)
1971 x->cursor_pixel = fg;
1972
6fc2811b 1973 update_face_from_frame_parameter (f, Qforeground_color, arg);
ee78dc32
GV		 1974 if (FRAME_VISIBLE_P (f))
1975 redraw_frame (f);
1976 }
1977}
1978
1979void
1980x_set_background_color (f, arg, oldval)
1981 struct frame *f;
1982 Lisp_Object arg, oldval;
1983{
6fc2811b 1984 FRAME_BACKGROUND_PIXEL (f)
ee78dc32
GV		 1985 = x_decode_color (f, arg, WHITE_PIX_DEFAULT (f));
1986
fbd6baed 1987 if (FRAME_W32_WINDOW (f) != 0)
ee78dc32 1988 {
6fc2811b
JR		 1989 SetWindowLong (FRAME_W32_WINDOW (f), WND_BACKGROUND_INDEX,
1990 FRAME_BACKGROUND_PIXEL (f));
ee78dc32 1991
6fc2811b 1992 update_face_from_frame_parameter (f, Qbackground_color, arg);
ee78dc32
GV		 1993
1994 if (FRAME_VISIBLE_P (f))
1995 redraw_frame (f);
1996 }
1997}
1998
1999void
2000x_set_mouse_color (f, arg, oldval)
2001 struct frame *f;
2002 Lisp_Object arg, oldval;
2003{
ee78dc32 2004 Cursor cursor, nontext_cursor, mode_cursor, cross_cursor;
dfc465d3 2005 int count;
ee78dc32
GV		 2006 int mask_color;
2007
2008 if (!EQ (Qnil, arg))
fbd6baed 2009 f->output_data.w32->mouse_pixel
ee78dc32 2010 = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
6fc2811b
JR		 2011 mask_color = FRAME_BACKGROUND_PIXEL (f);
2012
2013 /* Don't let pointers be invisible. */
fbd6baed 2014 if (mask_color == f->output_data.w32->mouse_pixel
6fc2811b
JR		 2015 && mask_color == FRAME_BACKGROUND_PIXEL (f))
2016 f->output_data.w32->mouse_pixel = FRAME_FOREGROUND_PIXEL (f);
ee78dc32 2017
767b1ff0 2018#if 0 /* TODO : cursor changes */
ee78dc32
GV		 2019 BLOCK_INPUT;
2020
2021 /* It's not okay to crash if the user selects a screwy cursor. */
fadca6c6 2022 count = x_catch_errors (FRAME_W32_DISPLAY (f));
ee78dc32
GV		 2023
2024 if (!EQ (Qnil, Vx_pointer_shape))
2025 {
2026 CHECK_NUMBER (Vx_pointer_shape, 0);
fbd6baed 2027 cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XINT (Vx_pointer_shape));
ee78dc32
GV		 2028 }
2029 else
fbd6baed
GV		 2030 cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_xterm);
2031 x_check_errors (FRAME_W32_DISPLAY (f), "bad text pointer cursor: %s");
ee78dc32
GV		 2032
2033 if (!EQ (Qnil, Vx_nontext_pointer_shape))
2034 {
2035 CHECK_NUMBER (Vx_nontext_pointer_shape, 0);
fbd6baed 2036 nontext_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f),
ee78dc32
GV		 2037 XINT (Vx_nontext_pointer_shape));
2038 }
2039 else
fbd6baed
GV		 2040 nontext_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_left_ptr);
2041 x_check_errors (FRAME_W32_DISPLAY (f), "bad nontext pointer cursor: %s");
ee78dc32 2042
0af913d7 2043 if (!EQ (Qnil, Vx_hourglass_pointer_shape))
6fc2811b 2044 {
0af913d7
GM		 2045 CHECK_NUMBER (Vx_hourglass_pointer_shape, 0);
2046 hourglass_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f),
2047 XINT (Vx_hourglass_pointer_shape));
6fc2811b
JR		 2048 }
2049 else
0af913d7 2050 hourglass_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_watch);
6fc2811b
JR		 2051 x_check_errors (FRAME_W32_DISPLAY (f), "bad busy pointer cursor: %s");
2052
2053 x_check_errors (FRAME_W32_DISPLAY (f), "bad nontext pointer cursor: %s");
ee78dc32
GV		 2054 if (!EQ (Qnil, Vx_mode_pointer_shape))
2055 {
2056 CHECK_NUMBER (Vx_mode_pointer_shape, 0);
fbd6baed 2057 mode_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f),
ee78dc32
GV		 2058 XINT (Vx_mode_pointer_shape));
2059 }
2060 else
fbd6baed
GV		 2061 mode_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_xterm);
2062 x_check_errors (FRAME_W32_DISPLAY (f), "bad modeline pointer cursor: %s");
ee78dc32
GV		 2063
2064 if (!EQ (Qnil, Vx_sensitive_text_pointer_shape))
2065 {
2066 CHECK_NUMBER (Vx_sensitive_text_pointer_shape, 0);
2067 cross_cursor
fbd6baed 2068 = XCreateFontCursor (FRAME_W32_DISPLAY (f),
ee78dc32
GV		 2069 XINT (Vx_sensitive_text_pointer_shape));
2070 }
2071 else
fbd6baed 2072 cross_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_crosshair);
ee78dc32 2073
4694d762
JR		 2074 if (!NILP (Vx_window_horizontal_drag_shape))
2075 {
2076 CHECK_NUMBER (Vx_window_horizontal_drag_shape, 0);
2077 horizontal_drag_cursor
2078 = XCreateFontCursor (FRAME_X_DISPLAY (f),
2079 XINT (Vx_window_horizontal_drag_shape));
2080 }
2081 else
2082 horizontal_drag_cursor
2083 = XCreateFontCursor (FRAME_X_DISPLAY (f), XC_sb_h_double_arrow);
2084
ee78dc32 2085 /* Check and report errors with the above calls. */
fbd6baed 2086 x_check_errors (FRAME_W32_DISPLAY (f), "can't set cursor shape: %s");
fadca6c6 2087 x_uncatch_errors (FRAME_W32_DISPLAY (f), count);
ee78dc32
GV		 2088
2089 {
2090 XColor fore_color, back_color;
2091
fbd6baed 2092 fore_color.pixel = f->output_data.w32->mouse_pixel;
ee78dc32 2093 back_color.pixel = mask_color;
fbd6baed
GV		 2094 XQueryColor (FRAME_W32_DISPLAY (f),
2095 DefaultColormap (FRAME_W32_DISPLAY (f),
2096 DefaultScreen (FRAME_W32_DISPLAY (f))),
ee78dc32 2097 &fore_color);
fbd6baed
GV		 2098 XQueryColor (FRAME_W32_DISPLAY (f),
2099 DefaultColormap (FRAME_W32_DISPLAY (f),
2100 DefaultScreen (FRAME_W32_DISPLAY (f))),
ee78dc32 2101 &back_color);
fbd6baed 2102 XRecolorCursor (FRAME_W32_DISPLAY (f), cursor,
ee78dc32 2103 &fore_color, &back_color);
fbd6baed 2104 XRecolorCursor (FRAME_W32_DISPLAY (f), nontext_cursor,
ee78dc32 2105 &fore_color, &back_color);
fbd6baed 2106 XRecolorCursor (FRAME_W32_DISPLAY (f), mode_cursor,
ee78dc32 2107 &fore_color, &back_color);
fbd6baed 2108 XRecolorCursor (FRAME_W32_DISPLAY (f), cross_cursor,
ee78dc32 2109 &fore_color, &back_color);
0af913d7 2110 XRecolorCursor (FRAME_W32_DISPLAY (f), hourglass_cursor,
6fc2811b 2111 &fore_color, &back_color);
ee78dc32
GV		 2112 }
2113
fbd6baed 2114 if (FRAME_W32_WINDOW (f) != 0)
6fc2811b 2115 XDefineCursor (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f), cursor);
ee78dc32 2116
fbd6baed
GV		 2117 if (cursor != f->output_data.w32->text_cursor && f->output_data.w32->text_cursor != 0)
2118 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->text_cursor);
2119 f->output_data.w32->text_cursor = cursor;
2120
2121 if (nontext_cursor != f->output_data.w32->nontext_cursor
2122 && f->output_data.w32->nontext_cursor != 0)
2123 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->nontext_cursor);
2124 f->output_data.w32->nontext_cursor = nontext_cursor;
2125
0af913d7
GM		 2126 if (hourglass_cursor != f->output_data.w32->hourglass_cursor
2127 && f->output_data.w32->hourglass_cursor != 0)
2128 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->hourglass_cursor);
2129 f->output_data.w32->hourglass_cursor = hourglass_cursor;
6fc2811b 2130
fbd6baed
GV		 2131 if (mode_cursor != f->output_data.w32->modeline_cursor
2132 && f->output_data.w32->modeline_cursor != 0)
2133 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->modeline_cursor);
2134 f->output_data.w32->modeline_cursor = mode_cursor;
6fc2811b 2135
fbd6baed
GV		 2136 if (cross_cursor != f->output_data.w32->cross_cursor
2137 && f->output_data.w32->cross_cursor != 0)
2138 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->cross_cursor);
2139 f->output_data.w32->cross_cursor = cross_cursor;
2140
2141 XFlush (FRAME_W32_DISPLAY (f));
ee78dc32 2142 UNBLOCK_INPUT;
6fc2811b
JR		 2143
2144 update_face_from_frame_parameter (f, Qmouse_color, arg);
767b1ff0 2145#endif /* TODO */
ee78dc32
GV		 2146}
2147
70a0239a
JR		 2148/* Defined in w32term.c. */
2149void x_update_cursor (struct frame *f, int on_p);
2150
ee78dc32
GV		 2151void
2152x_set_cursor_color (f, arg, oldval)
2153 struct frame *f;
2154 Lisp_Object arg, oldval;
2155{
70a0239a 2156 unsigned long fore_pixel, pixel;
ee78dc32 2157
dfff8a69 2158 if (!NILP (Vx_cursor_fore_pixel))
ee78dc32 2159 fore_pixel = x_decode_color (f, Vx_cursor_fore_pixel,
70a0239a 2160 WHITE_PIX_DEFAULT (f));
ee78dc32 2161 else
6fc2811b 2162 fore_pixel = FRAME_BACKGROUND_PIXEL (f);
70a0239a 2163
6759f872 2164 pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
ee78dc32
GV		 2165
2166 /* Make sure that the cursor color differs from the background color. */
70a0239a 2167 if (pixel == FRAME_BACKGROUND_PIXEL (f))
ee78dc32 2168 {
70a0239a
JR		 2169 pixel = f->output_data.w32->mouse_pixel;
2170 if (pixel == fore_pixel)
6fc2811b 2171 fore_pixel = FRAME_BACKGROUND_PIXEL (f);
ee78dc32 2172 }
70a0239a 2173
6fc2811b 2174 FRAME_FOREGROUND_PIXEL (f) = fore_pixel;
70a0239a 2175 f->output_data.w32->cursor_pixel = pixel;
ee78dc32 2176
fbd6baed 2177 if (FRAME_W32_WINDOW (f) != 0)
ee78dc32
GV		 2178 {
2179 if (FRAME_VISIBLE_P (f))
2180 {
70a0239a
JR		 2181 x_update_cursor (f, 0);
2182 x_update_cursor (f, 1);
ee78dc32
GV		 2183 }
2184 }
6fc2811b
JR		 2185
2186 update_face_from_frame_parameter (f, Qcursor_color, arg);
ee78dc32
GV		 2187}
2188
33d52f9c
GV		 2189/* Set the border-color of frame F to pixel value PIX.
2190 Note that this does not fully take effect if done before
2191 F has an window. */
2192void
2193x_set_border_pixel (f, pix)
2194 struct frame *f;
2195 int pix;
2196{
2197 f->output_data.w32->border_pixel = pix;
2198
2199 if (FRAME_W32_WINDOW (f) != 0 && f->output_data.w32->border_width > 0)
2200 {
2201 if (FRAME_VISIBLE_P (f))
2202 redraw_frame (f);
2203 }
2204}
2205
ee78dc32
GV		 2206/* Set the border-color of frame F to value described by ARG.
2207 ARG can be a string naming a color.
2208 The border-color is used for the border that is drawn by the server.
2209 Note that this does not fully take effect if done before
2210 F has a window; it must be redone when the window is created. */
2211
2212void
2213x_set_border_color (f, arg, oldval)
2214 struct frame *f;
2215 Lisp_Object arg, oldval;
2216{
ee78dc32
GV		 2217 int pix;
2218
2219 CHECK_STRING (arg, 0);
ee78dc32 2220 pix = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
ee78dc32 2221 x_set_border_pixel (f, pix);
6fc2811b 2222 update_face_from_frame_parameter (f, Qborder_color, arg);
ee78dc32
GV		 2223}
2224
dfff8a69
JR		 2225/* Value is the internal representation of the specified cursor type
2226 ARG. If type is BAR_CURSOR, return in *WIDTH the specified width
2227 of the bar cursor. */
2228
2229enum text_cursor_kinds
2230x_specified_cursor_type (arg, width)
2231 Lisp_Object arg;
2232 int *width;
ee78dc32 2233{
dfff8a69
JR		 2234 enum text_cursor_kinds type;
2235
ee78dc32
GV		 2236 if (EQ (arg, Qbar))
2237 {
dfff8a69
JR		 2238 type = BAR_CURSOR;
2239 *width = 2;
ee78dc32 2240 }
dfff8a69
JR		 2241 else if (CONSP (arg)
2242 && EQ (XCAR (arg), Qbar)
2243 && INTEGERP (XCDR (arg))
2244 && XINT (XCDR (arg)) >= 0)
ee78dc32 2245 {
dfff8a69
JR		 2246 type = BAR_CURSOR;
2247 *width = XINT (XCDR (arg));
ee78dc32 2248 }
dfff8a69
JR		 2249 else if (NILP (arg))
2250 type = NO_CURSOR;
ee78dc32
GV		 2251 else
2252 /* Treat anything unknown as "box cursor".
2253 It was bad to signal an error; people have trouble fixing
2254 .Xdefaults with Emacs, when it has something bad in it. */
dfff8a69
JR		 2255 type = FILLED_BOX_CURSOR;
2256
2257 return type;
2258}
2259
2260void
2261x_set_cursor_type (f, arg, oldval)
2262 FRAME_PTR f;
2263 Lisp_Object arg, oldval;
2264{
2265 int width;
2266
2267 FRAME_DESIRED_CURSOR (f) = x_specified_cursor_type (arg, &width);
2268 f->output_data.w32->cursor_width = width;
ee78dc32
GV		 2269
2270 /* Make sure the cursor gets redrawn. This is overkill, but how
2271 often do people change cursor types? */
2272 update_mode_lines++;
2273}
dfff8a69 2274\f
ee78dc32
GV		 2275void
2276x_set_icon_type (f, arg, oldval)
2277 struct frame *f;
2278 Lisp_Object arg, oldval;
2279{
ee78dc32
GV		 2280 int result;
2281
eb7576ce
GV		 2282 if (NILP (arg) && NILP (oldval))
2283 return;
2284
2285 if (STRINGP (arg) && STRINGP (oldval)
2286 && EQ (Fstring_equal (oldval, arg), Qt))
2287 return;
2288
2289 if (SYMBOLP (arg) && SYMBOLP (oldval) && EQ (arg, oldval))
ee78dc32
GV		 2290 return;
2291
2292 BLOCK_INPUT;
ee78dc32 2293
eb7576ce 2294 result = x_bitmap_icon (f, arg);
ee78dc32
GV		 2295 if (result)
2296 {
2297 UNBLOCK_INPUT;
2298 error ("No icon window available");
2299 }
2300
ee78dc32 2301 UNBLOCK_INPUT;
ee78dc32
GV		 2302}
2303
2304/* Return non-nil if frame F wants a bitmap icon. */
2305
2306Lisp_Object
2307x_icon_type (f)
2308 FRAME_PTR f;
2309{
2310 Lisp_Object tem;
2311
2312 tem = assq_no_quit (Qicon_type, f->param_alist);
2313 if (CONSP (tem))
8e713be6 2314 return XCDR (tem);
ee78dc32
GV		 2315 else
2316 return Qnil;
2317}
2318
2319void
2320x_set_icon_name (f, arg, oldval)
2321 struct frame *f;
2322 Lisp_Object arg, oldval;
2323{
ee78dc32
GV		 2324 if (STRINGP (arg))
2325 {
2326 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
2327 return;
2328 }
2329 else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
2330 return;
2331
2332 f->icon_name = arg;
2333
2334#if 0
fbd6baed 2335 if (f->output_data.w32->icon_bitmap != 0)
ee78dc32
GV		 2336 return;
2337
2338 BLOCK_INPUT;
2339
2340 result = x_text_icon (f,
1edf84e7 2341 (char *) XSTRING ((!NILP (f->icon_name)
ee78dc32 2342 ? f->icon_name
1edf84e7
GV		 2343 : !NILP (f->title)
2344 ? f->title
ee78dc32
GV		 2345 : f->name))->data);
2346
2347 if (result)
2348 {
2349 UNBLOCK_INPUT;
2350 error ("No icon window available");
2351 }
2352
2353 /* If the window was unmapped (and its icon was mapped),
2354 the new icon is not mapped, so map the window in its stead. */
2355 if (FRAME_VISIBLE_P (f))
2356 {
2357#ifdef USE_X_TOOLKIT
fbd6baed 2358 XtPopup (f->output_data.w32->widget, XtGrabNone);
ee78dc32 2359#endif
fbd6baed 2360 XMapWindow (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f));
ee78dc32
GV		 2361 }
2362
fbd6baed 2363 XFlush (FRAME_W32_DISPLAY (f));
ee78dc32
GV		 2364 UNBLOCK_INPUT;
2365#endif
2366}
2367
2368extern Lisp_Object x_new_font ();
4587b026 2369extern Lisp_Object x_new_fontset();
ee78dc32
GV		 2370
2371void
2372x_set_font (f, arg, oldval)
2373 struct frame *f;
2374 Lisp_Object arg, oldval;
2375{
2376 Lisp_Object result;
4587b026 2377 Lisp_Object fontset_name;
4b817373 2378 Lisp_Object frame;
3cf3436e 2379 int old_fontset = FRAME_FONTSET(f);
ee78dc32
GV		 2380
2381 CHECK_STRING (arg, 1);
2382
4587b026
GV		 2383 fontset_name = Fquery_fontset (arg, Qnil);
2384
ee78dc32 2385 BLOCK_INPUT;
4587b026
GV		 2386 result = (STRINGP (fontset_name)
2387 ? x_new_fontset (f, XSTRING (fontset_name)->data)
2388 : x_new_font (f, XSTRING (arg)->data));
ee78dc32
GV		 2389 UNBLOCK_INPUT;
2390
2391 if (EQ (result, Qnil))
dfff8a69 2392 error ("Font `%s' is not defined", XSTRING (arg)->data);
ee78dc32 2393 else if (EQ (result, Qt))
dfff8a69 2394 error ("The characters of the given font have varying widths");
ee78dc32
GV		 2395 else if (STRINGP (result))
2396 {
3cf3436e
JR		 2397 if (STRINGP (fontset_name))
2398 {
2399 /* Fontset names are built from ASCII font names, so the
2400 names may be equal despite there was a change. */
2401 if (old_fontset == FRAME_FONTSET (f))
2402 return;
2403 }
2404 else if (!NILP (Fequal (result, oldval)))
dc220243 2405 return;
3cf3436e 2406
ee78dc32 2407 store_frame_param (f, Qfont, result);
6fc2811b 2408 recompute_basic_faces (f);
ee78dc32
GV		 2409 }
2410 else
2411 abort ();
4b817373 2412
6fc2811b
JR		 2413 do_pending_window_change (0);
2414
2415 /* Don't call `face-set-after-frame-default' when faces haven't been
2416 initialized yet. This is the case when called from
2417 Fx_create_frame. In that case, the X widget or window doesn't
2418 exist either, and we can end up in x_report_frame_params with a
2419 null widget which gives a segfault. */
2420 if (FRAME_FACE_CACHE (f))
2421 {
2422 XSETFRAME (frame, f);
2423 call1 (Qface_set_after_frame_default, frame);
2424 }
ee78dc32
GV		 2425}
2426
2427void
2428x_set_border_width (f, arg, oldval)
2429 struct frame *f;
2430 Lisp_Object arg, oldval;
2431{
2432 CHECK_NUMBER (arg, 0);
2433
fbd6baed 2434 if (XINT (arg) == f->output_data.w32->border_width)
ee78dc32
GV		 2435 return;
2436
fbd6baed 2437 if (FRAME_W32_WINDOW (f) != 0)
ee78dc32
GV		 2438 error ("Cannot change the border width of a window");
2439
fbd6baed 2440 f->output_data.w32->border_width = XINT (arg);
ee78dc32
GV		 2441}
2442
2443void
2444x_set_internal_border_width (f, arg, oldval)
2445 struct frame *f;
2446 Lisp_Object arg, oldval;
2447{
fbd6baed 2448 int old = f->output_data.w32->internal_border_width;
ee78dc32
GV		 2449
2450 CHECK_NUMBER (arg, 0);
fbd6baed
GV		 2451 f->output_data.w32->internal_border_width = XINT (arg);
2452 if (f->output_data.w32->internal_border_width < 0)
2453 f->output_data.w32->internal_border_width = 0;
ee78dc32 2454
fbd6baed 2455 if (f->output_data.w32->internal_border_width == old)
ee78dc32
GV		 2456 return;
2457
fbd6baed 2458 if (FRAME_W32_WINDOW (f) != 0)
ee78dc32 2459 {
ee78dc32 2460 x_set_window_size (f, 0, f->width, f->height);
ee78dc32 2461 SET_FRAME_GARBAGED (f);
6fc2811b 2462 do_pending_window_change (0);
ee78dc32
GV		 2463 }
2464}
2465
2466void
2467x_set_visibility (f, value, oldval)
2468 struct frame *f;
2469 Lisp_Object value, oldval;
2470{
2471 Lisp_Object frame;
2472 XSETFRAME (frame, f);
2473
2474 if (NILP (value))
2475 Fmake_frame_invisible (frame, Qt);
2476 else if (EQ (value, Qicon))
2477 Ficonify_frame (frame);
2478 else
2479 Fmake_frame_visible (frame);
2480}
2481
a1258667
JR		 2482\f
2483/* Change window heights in windows rooted in WINDOW by N lines. */
2484
2485static void
2486x_change_window_heights (window, n)
2487 Lisp_Object window;
2488 int n;
2489{
2490 struct window *w = XWINDOW (window);
2491
2492 XSETFASTINT (w->top, XFASTINT (w->top) + n);
2493 XSETFASTINT (w->height, XFASTINT (w->height) - n);
2494
2495 if (INTEGERP (w->orig_top))
2496 XSETFASTINT (w->orig_top, XFASTINT (w->orig_top) + n);
2497 if (INTEGERP (w->orig_height))
2498 XSETFASTINT (w->orig_height, XFASTINT (w->orig_height) - n);
2499
2500 /* Handle just the top child in a vertical split. */
2501 if (!NILP (w->vchild))
2502 x_change_window_heights (w->vchild, n);
2503
2504 /* Adjust all children in a horizontal split. */
2505 for (window = w->hchild; !NILP (window); window = w->next)
2506 {
2507 w = XWINDOW (window);
2508 x_change_window_heights (window, n);
2509 }
2510}
2511
ee78dc32
GV		 2512void
2513x_set_menu_bar_lines (f, value, oldval)
2514 struct frame *f;
2515 Lisp_Object value, oldval;
2516{
2517 int nlines;
2518 int olines = FRAME_MENU_BAR_LINES (f);
2519
2520 /* Right now, menu bars don't work properly in minibuf-only frames;
2521 most of the commands try to apply themselves to the minibuffer
6fc2811b 2522 frame itself, and get an error because you can't switch buffers
ee78dc32
GV		 2523 in or split the minibuffer window. */
2524 if (FRAME_MINIBUF_ONLY_P (f))
2525 return;
2526
2527 if (INTEGERP (value))
2528 nlines = XINT (value);
2529 else
2530 nlines = 0;
2531
2532 FRAME_MENU_BAR_LINES (f) = 0;
2533 if (nlines)
2534 FRAME_EXTERNAL_MENU_BAR (f) = 1;
2535 else
2536 {
2537 if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
2538 free_frame_menubar (f);
2539 FRAME_EXTERNAL_MENU_BAR (f) = 0;
1edf84e7
GV		 2540
2541 /* Adjust the frame size so that the client (text) dimensions
2542 remain the same. This depends on FRAME_EXTERNAL_MENU_BAR being
2543 set correctly. */
2544 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
6fc2811b 2545 do_pending_window_change (0);
ee78dc32 2546 }
6fc2811b
JR		 2547 adjust_glyphs (f);
2548}
2549
2550
2551/* Set the number of lines used for the tool bar of frame F to VALUE.
2552 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
2553 is the old number of tool bar lines. This function changes the
2554 height of all windows on frame F to match the new tool bar height.
2555 The frame's height doesn't change. */
2556
2557void
2558x_set_tool_bar_lines (f, value, oldval)
2559 struct frame *f;
2560 Lisp_Object value, oldval;
2561{
36f8209a
JR		 2562 int delta, nlines, root_height;
2563 Lisp_Object root_window;
6fc2811b 2564
dc220243
JR		 2565 /* Treat tool bars like menu bars. */
2566 if (FRAME_MINIBUF_ONLY_P (f))
2567 return;
2568
6fc2811b
JR		 2569 /* Use VALUE only if an integer >= 0. */
2570 if (INTEGERP (value) && XINT (value) >= 0)
2571 nlines = XFASTINT (value);
2572 else
2573 nlines = 0;
2574
2575 /* Make sure we redisplay all windows in this frame. */
2576 ++windows_or_buffers_changed;
2577
2578 delta = nlines - FRAME_TOOL_BAR_LINES (f);
36f8209a
JR		 2579
2580 /* Don't resize the tool-bar to more than we have room for. */
2581 root_window = FRAME_ROOT_WINDOW (f);
2582 root_height = XINT (XWINDOW (root_window)->height);
2583 if (root_height - delta < 1)
2584 {
2585 delta = root_height - 1;
2586 nlines = FRAME_TOOL_BAR_LINES (f) + delta;
2587 }
2588
6fc2811b 2589 FRAME_TOOL_BAR_LINES (f) = nlines;
36f8209a 2590 x_change_window_heights (root_window, delta);
6fc2811b 2591 adjust_glyphs (f);
36f8209a
JR		 2592
2593 /* We also have to make sure that the internal border at the top of
2594 the frame, below the menu bar or tool bar, is redrawn when the
2595 tool bar disappears. This is so because the internal border is
2596 below the tool bar if one is displayed, but is below the menu bar
2597 if there isn't a tool bar. The tool bar draws into the area
2598 below the menu bar. */
2599 if (FRAME_W32_WINDOW (f) && FRAME_TOOL_BAR_LINES (f) == 0)
2600 {
2601 updating_frame = f;
2602 clear_frame ();
2603 clear_current_matrices (f);
2604 updating_frame = NULL;
2605 }
2606
2607 /* If the tool bar gets smaller, the internal border below it
2608 has to be cleared. It was formerly part of the display
2609 of the larger tool bar, and updating windows won't clear it. */
2610 if (delta < 0)
2611 {
2612 int height = FRAME_INTERNAL_BORDER_WIDTH (f);
2613 int width = PIXEL_WIDTH (f);
2614 int y = nlines * CANON_Y_UNIT (f);
2615
2616 BLOCK_INPUT;
2617 {
2618 HDC hdc = get_frame_dc (f);
2619 w32_clear_area (f, hdc, 0, y, width, height);
2620 release_frame_dc (f, hdc);
2621 }
2622 UNBLOCK_INPUT;
3cf3436e
JR		 2623
2624 if (WINDOWP (f->tool_bar_window))
2625 clear_glyph_matrix (XWINDOW (f->tool_bar_window)->current_matrix);
36f8209a 2626 }
ee78dc32
GV		 2627}
2628
6fc2811b 2629
ee78dc32 2630/* Change the name of frame F to NAME. If NAME is nil, set F's name to
fbd6baed 2631 w32_id_name.
ee78dc32
GV		 2632
2633 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2634 name; if NAME is a string, set F's name to NAME and set
2635 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2636
2637 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2638 suggesting a new name, which lisp code should override; if
2639 F->explicit_name is set, ignore the new name; otherwise, set it. */
2640
2641void
2642x_set_name (f, name, explicit)
2643 struct frame *f;
2644 Lisp_Object name;
2645 int explicit;
2646{
2647 /* Make sure that requests from lisp code override requests from
2648 Emacs redisplay code. */
2649 if (explicit)
2650 {
2651 /* If we're switching from explicit to implicit, we had better
2652 update the mode lines and thereby update the title. */
2653 if (f->explicit_name && NILP (name))
2654 update_mode_lines = 1;
2655
2656 f->explicit_name = ! NILP (name);
2657 }
2658 else if (f->explicit_name)
2659 return;
2660
fbd6baed 2661 /* If NAME is nil, set the name to the w32_id_name. */
ee78dc32
GV		 2662 if (NILP (name))
2663 {
2664 /* Check for no change needed in this very common case
2665 before we do any consing. */
fbd6baed 2666 if (!strcmp (FRAME_W32_DISPLAY_INFO (f)->w32_id_name,
ee78dc32
GV		 2667 XSTRING (f->name)->data))
2668 return;
fbd6baed 2669 name = build_string (FRAME_W32_DISPLAY_INFO (f)->w32_id_name);
ee78dc32
GV		 2670 }
2671 else
2672 CHECK_STRING (name, 0);
2673
2674 /* Don't change the name if it's already NAME. */
2675 if (! NILP (Fstring_equal (name, f->name)))
2676 return;
2677
1edf84e7
GV		 2678 f->name = name;
2679
2680 /* For setting the frame title, the title parameter should override
2681 the name parameter. */
2682 if (! NILP (f->title))
2683 name = f->title;
2684
fbd6baed 2685 if (FRAME_W32_WINDOW (f))
ee78dc32 2686 {
6fc2811b 2687 if (STRING_MULTIBYTE (name))
dfff8a69 2688 name = ENCODE_SYSTEM (name);
6fc2811b 2689
ee78dc32 2690 BLOCK_INPUT;
fbd6baed 2691 SetWindowText(FRAME_W32_WINDOW (f), XSTRING (name)->data);
ee78dc32
GV		 2692 UNBLOCK_INPUT;
2693 }
ee78dc32
GV		 2694}
2695
2696/* This function should be called when the user's lisp code has
2697 specified a name for the frame; the name will override any set by the
2698 redisplay code. */
2699void
2700x_explicitly_set_name (f, arg, oldval)
2701 FRAME_PTR f;
2702 Lisp_Object arg, oldval;
2703{
2704 x_set_name (f, arg, 1);
2705}
2706
2707/* This function should be called by Emacs redisplay code to set the
2708 name; names set this way will never override names set by the user's
2709 lisp code. */
2710void
2711x_implicitly_set_name (f, arg, oldval)
2712 FRAME_PTR f;
2713 Lisp_Object arg, oldval;
2714{
2715 x_set_name (f, arg, 0);
2716}
1edf84e7
GV		 2717\f
2718/* Change the title of frame F to NAME.
2719 If NAME is nil, use the frame name as the title.
2720
2721 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2722 name; if NAME is a string, set F's name to NAME and set
2723 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2724
2725 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2726 suggesting a new name, which lisp code should override; if
2727 F->explicit_name is set, ignore the new name; otherwise, set it. */
ee78dc32 2728
1edf84e7 2729void
6fc2811b 2730x_set_title (f, name, old_name)
1edf84e7 2731 struct frame *f;
6fc2811b 2732 Lisp_Object name, old_name;
1edf84e7
GV		 2733{
2734 /* Don't change the title if it's already NAME. */
2735 if (EQ (name, f->title))
2736 return;
2737
2738 update_mode_lines = 1;
2739
2740 f->title = name;
2741
2742 if (NILP (name))
2743 name = f->name;
2744
2745 if (FRAME_W32_WINDOW (f))
2746 {
6fc2811b 2747 if (STRING_MULTIBYTE (name))
dfff8a69 2748 name = ENCODE_SYSTEM (name);
6fc2811b 2749
1edf84e7
GV		 2750 BLOCK_INPUT;
2751 SetWindowText(FRAME_W32_WINDOW (f), XSTRING (name)->data);
2752 UNBLOCK_INPUT;
2753 }
2754}
2755\f
ee78dc32
GV		 2756void
2757x_set_autoraise (f, arg, oldval)
2758 struct frame *f;
2759 Lisp_Object arg, oldval;
2760{
2761 f->auto_raise = !EQ (Qnil, arg);
2762}
2763
2764void
2765x_set_autolower (f, arg, oldval)
2766 struct frame *f;
2767 Lisp_Object arg, oldval;
2768{
2769 f->auto_lower = !EQ (Qnil, arg);
2770}
2771
2772void
2773x_set_unsplittable (f, arg, oldval)
2774 struct frame *f;
2775 Lisp_Object arg, oldval;
2776{
2777 f->no_split = !NILP (arg);
2778}
2779
2780void
2781x_set_vertical_scroll_bars (f, arg, oldval)
2782 struct frame *f;
2783 Lisp_Object arg, oldval;
2784{
1026b400
RS		 2785 if ((EQ (arg, Qleft) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f))
2786 || (EQ (arg, Qright) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f))
2787 || (NILP (arg) && FRAME_HAS_VERTICAL_SCROLL_BARS (f))
2788 || (!NILP (arg) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f)))
ee78dc32 2789 {
1026b400
RS		 2790 FRAME_VERTICAL_SCROLL_BAR_TYPE (f) = NILP (arg) ?
2791 vertical_scroll_bar_none :
87996783
GV		 2792 /* Put scroll bars on the right by default, as is conventional
2793 on MS-Windows. */
2794 EQ (Qleft, arg)
2795 ? vertical_scroll_bar_left
2796 : vertical_scroll_bar_right;
ee78dc32
GV		 2797
2798 /* We set this parameter before creating the window for the
2799 frame, so we can get the geometry right from the start.
2800 However, if the window hasn't been created yet, we shouldn't
2801 call x_set_window_size. */
fbd6baed 2802 if (FRAME_W32_WINDOW (f))
ee78dc32 2803 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
6fc2811b 2804 do_pending_window_change (0);
ee78dc32
GV		 2805 }
2806}
2807
2808void
2809x_set_scroll_bar_width (f, arg, oldval)
2810 struct frame *f;
2811 Lisp_Object arg, oldval;
2812{
6fc2811b
JR		 2813 int wid = FONT_WIDTH (f->output_data.w32->font);
2814
ee78dc32
GV		 2815 if (NILP (arg))
2816 {
6fc2811b
JR		 2817 FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = GetSystemMetrics (SM_CXVSCROLL);
2818 FRAME_SCROLL_BAR_COLS (f) = (FRAME_SCROLL_BAR_PIXEL_WIDTH (f) +
2819 wid - 1) / wid;
2820 if (FRAME_W32_WINDOW (f))
2821 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
2822 do_pending_window_change (0);
ee78dc32
GV		 2823 }
2824 else if (INTEGERP (arg) && XINT (arg) > 0
2825 && XFASTINT (arg) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f))
2826 {
ee78dc32 2827 FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = XFASTINT (arg);
6fc2811b
JR		 2828 FRAME_SCROLL_BAR_COLS (f) = (FRAME_SCROLL_BAR_PIXEL_WIDTH (f)
2829 + wid-1) / wid;
fbd6baed 2830 if (FRAME_W32_WINDOW (f))
ee78dc32 2831 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
6fc2811b 2832 do_pending_window_change (0);
ee78dc32 2833 }
6fc2811b
JR		 2834 change_frame_size (f, 0, FRAME_WIDTH (f), 0, 0, 0);
2835 XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.hpos = 0;
2836 XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.x = 0;
ee78dc32
GV		 2837}
2838\f
2839/* Subroutines of creating an frame. */
2840
2841/* Make sure that Vx_resource_name is set to a reasonable value.
2842 Fix it up, or set it to `emacs' if it is too hopeless. */
2843
2844static void
2845validate_x_resource_name ()
2846{
6fc2811b 2847 int len = 0;
ee78dc32
GV		 2848 /* Number of valid characters in the resource name. */
2849 int good_count = 0;
2850 /* Number of invalid characters in the resource name. */
2851 int bad_count = 0;
2852 Lisp_Object new;
2853 int i;
2854
2855 if (STRINGP (Vx_resource_name))
2856 {
2857 unsigned char *p = XSTRING (Vx_resource_name)->data;
2858 int i;
2859
dfff8a69 2860 len = STRING_BYTES (XSTRING (Vx_resource_name));
ee78dc32
GV		 2861
2862 /* Only letters, digits, - and _ are valid in resource names.
2863 Count the valid characters and count the invalid ones. */
2864 for (i = 0; i < len; i++)
2865 {
2866 int c = p[i];
2867 if (! ((c >= 'a' && c <= 'z')
2868 || (c >= 'A' && c <= 'Z')
2869 || (c >= '0' && c <= '9')
2870 || c == '-' || c == '_'))
2871 bad_count++;
2872 else
2873 good_count++;
2874 }
2875 }
2876 else
2877 /* Not a string => completely invalid. */
2878 bad_count = 5, good_count = 0;
2879
2880 /* If name is valid already, return. */
2881 if (bad_count == 0)
2882 return;
2883
2884 /* If name is entirely invalid, or nearly so, use `emacs'. */
2885 if (good_count == 0
2886 || (good_count == 1 && bad_count > 0))
2887 {
2888 Vx_resource_name = build_string ("emacs");
2889 return;
2890 }
2891
2892 /* Name is partly valid. Copy it and replace the invalid characters
2893 with underscores. */
2894
2895 Vx_resource_name = new = Fcopy_sequence (Vx_resource_name);
2896
2897 for (i = 0; i < len; i++)
2898 {
2899 int c = XSTRING (new)->data[i];
2900 if (! ((c >= 'a' && c <= 'z')
2901 || (c >= 'A' && c <= 'Z')
2902 || (c >= '0' && c <= '9')
2903 || c == '-' || c == '_'))
2904 XSTRING (new)->data[i] = '_';
2905 }
2906}
2907
2908
2909extern char *x_get_string_resource ();
2910
2911DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 2, 4, 0,
2912 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
2913This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
2914class, where INSTANCE is the name under which Emacs was invoked, or\n\
2915the name specified by the `-name' or `-rn' command-line arguments.\n\
2916\n\
2917The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
2918class, respectively. You must specify both of them or neither.\n\
2919If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
2920and the class is `Emacs.CLASS.SUBCLASS'.")
2921 (attribute, class, component, subclass)
2922 Lisp_Object attribute, class, component, subclass;
2923{
2924 register char *value;
2925 char *name_key;
2926 char *class_key;
2927
2928 CHECK_STRING (attribute, 0);
2929 CHECK_STRING (class, 0);
2930
2931 if (!NILP (component))
2932 CHECK_STRING (component, 1);
2933 if (!NILP (subclass))
2934 CHECK_STRING (subclass, 2);
2935 if (NILP (component) != NILP (subclass))
2936 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2937
2938 validate_x_resource_name ();
2939
2940 /* Allocate space for the components, the dots which separate them,
2941 and the final '\0'. Make them big enough for the worst case. */
dfff8a69 2942 name_key = (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name))
ee78dc32 2943 + (STRINGP (component)
dfff8a69
JR		 2944 ? STRING_BYTES (XSTRING (component)) : 0)
2945 + STRING_BYTES (XSTRING (attribute))
ee78dc32
GV		 2946 + 3);
2947
2948 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
dfff8a69 2949 + STRING_BYTES (XSTRING (class))
ee78dc32 2950 + (STRINGP (subclass)
dfff8a69 2951 ? STRING_BYTES (XSTRING (subclass)) : 0)
ee78dc32
GV		 2952 + 3);
2953
2954 /* Start with emacs.FRAMENAME for the name (the specific one)
2955 and with `Emacs' for the class key (the general one). */
2956 strcpy (name_key, XSTRING (Vx_resource_name)->data);
2957 strcpy (class_key, EMACS_CLASS);
2958
2959 strcat (class_key, ".");
2960 strcat (class_key, XSTRING (class)->data);
2961
2962 if (!NILP (component))
2963 {
2964 strcat (class_key, ".");
2965 strcat (class_key, XSTRING (subclass)->data);
2966
2967 strcat (name_key, ".");
2968 strcat (name_key, XSTRING (component)->data);
2969 }
2970
2971 strcat (name_key, ".");
2972 strcat (name_key, XSTRING (attribute)->data);
2973
2974 value = x_get_string_resource (Qnil,
2975 name_key, class_key);
2976
2977 if (value != (char *) 0)
2978 return build_string (value);
2979 else
2980 return Qnil;
2981}
2982
2983/* Used when C code wants a resource value. */
2984
2985char *
2986x_get_resource_string (attribute, class)
2987 char *attribute, *class;
2988{
ee78dc32
GV		 2989 char *name_key;
2990 char *class_key;
6fc2811b 2991 struct frame *sf = SELECTED_FRAME ();
ee78dc32
GV		 2992
2993 /* Allocate space for the components, the dots which separate them,
2994 and the final '\0'. */
dfff8a69 2995 name_key = (char *) alloca (STRING_BYTES (XSTRING (Vinvocation_name))
ee78dc32
GV		 2996 + strlen (attribute) + 2);
2997 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
2998 + strlen (class) + 2);
2999
3000 sprintf (name_key, "%s.%s",
3001 XSTRING (Vinvocation_name)->data,
3002 attribute);
3003 sprintf (class_key, "%s.%s", EMACS_CLASS, class);
3004
6fc2811b 3005 return x_get_string_resource (sf, name_key, class_key);
ee78dc32
GV		 3006}
3007
3008/* Types we might convert a resource string into. */
3009enum resource_types
6fc2811b
JR		 3010{
3011 RES_TYPE_NUMBER,
3012 RES_TYPE_FLOAT,
3013 RES_TYPE_BOOLEAN,
3014 RES_TYPE_STRING,
3015 RES_TYPE_SYMBOL
3016};
ee78dc32
GV		 3017
3018/* Return the value of parameter PARAM.
3019
3020 First search ALIST, then Vdefault_frame_alist, then the X defaults
3021 database, using ATTRIBUTE as the attribute name and CLASS as its class.
3022
3023 Convert the resource to the type specified by desired_type.
3024
3025 If no default is specified, return Qunbound. If you call
6fc2811b 3026 w32_get_arg, make sure you deal with Qunbound in a reasonable way,
ee78dc32
GV		 3027 and don't let it get stored in any Lisp-visible variables! */
3028
3029static Lisp_Object
6fc2811b 3030w32_get_arg (alist, param, attribute, class, type)
ee78dc32
GV		 3031 Lisp_Object alist, param;
3032 char *attribute;
3033 char *class;
3034 enum resource_types type;
3035{
3036 register Lisp_Object tem;
3037
3038 tem = Fassq (param, alist);
3039 if (EQ (tem, Qnil))
3040 tem = Fassq (param, Vdefault_frame_alist);
3041 if (EQ (tem, Qnil))
3042 {
3043
3044 if (attribute)
3045 {
3046 tem = Fx_get_resource (build_string (attribute),
3047 build_string (class),
3048 Qnil, Qnil);
3049
3050 if (NILP (tem))
3051 return Qunbound;
3052
3053 switch (type)
3054 {
6fc2811b 3055 case RES_TYPE_NUMBER:
ee78dc32
GV		 3056 return make_number (atoi (XSTRING (tem)->data));
3057
6fc2811b
JR		 3058 case RES_TYPE_FLOAT:
3059 return make_float (atof (XSTRING (tem)->data));
3060
3061 case RES_TYPE_BOOLEAN:
ee78dc32
GV		 3062 tem = Fdowncase (tem);
3063 if (!strcmp (XSTRING (tem)->data, "on")
3064 || !strcmp (XSTRING (tem)->data, "true"))
3065 return Qt;
3066 else
3067 return Qnil;
3068
6fc2811b 3069 case RES_TYPE_STRING:
ee78dc32
GV		 3070 return tem;
3071
6fc2811b 3072 case RES_TYPE_SYMBOL:
ee78dc32
GV		 3073 /* As a special case, we map the values `true' and `on'
3074 to Qt, and `false' and `off' to Qnil. */
3075 {
3076 Lisp_Object lower;
3077 lower = Fdowncase (tem);
3078 if (!strcmp (XSTRING (lower)->data, "on")
3079 || !strcmp (XSTRING (lower)->data, "true"))
3080 return Qt;
3081 else if (!strcmp (XSTRING (lower)->data, "off")
3082 || !strcmp (XSTRING (lower)->data, "false"))
3083 return Qnil;
3084 else
3085 return Fintern (tem, Qnil);
3086 }
3087
3088 default:
3089 abort ();
3090 }
3091 }
3092 else
3093 return Qunbound;
3094 }
3095 return Fcdr (tem);
3096}
3097
3098/* Record in frame F the specified or default value according to ALIST
dfff8a69
JR		 3099 of the parameter named PROP (a Lisp symbol).
3100 If no value is specified for PROP, look for an X default for XPROP
ee78dc32
GV		 3101 on the frame named NAME.
3102 If that is not found either, use the value DEFLT. */
3103
3104static Lisp_Object
3105x_default_parameter (f, alist, prop, deflt, xprop, xclass, type)
3106 struct frame *f;
3107 Lisp_Object alist;
3108 Lisp_Object prop;
3109 Lisp_Object deflt;
3110 char *xprop;
3111 char *xclass;
3112 enum resource_types type;
3113{
3114 Lisp_Object tem;
3115
6fc2811b 3116 tem = w32_get_arg (alist, prop, xprop, xclass, type);
ee78dc32
GV		 3117 if (EQ (tem, Qunbound))
3118 tem = deflt;
3119 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
3120 return tem;
3121}
3122\f
3123DEFUN ("x-parse-geometry", Fx_parse_geometry, Sx_parse_geometry, 1, 1, 0,
3124 "Parse an X-style geometry string STRING.\n\
3125Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
3126The properties returned may include `top', `left', `height', and `width'.\n\
3127The value of `left' or `top' may be an integer,\n\
3128or a list (+ N) meaning N pixels relative to top/left corner,\n\
3129or a list (- N) meaning -N pixels relative to bottom/right corner.")
3130 (string)
3131 Lisp_Object string;
3132{
3133 int geometry, x, y;
3134 unsigned int width, height;
3135 Lisp_Object result;
3136
3137 CHECK_STRING (string, 0);
3138
3139 geometry = XParseGeometry ((char *) XSTRING (string)->data,
3140 &x, &y, &width, &height);
3141
3142 result = Qnil;
3143 if (geometry & XValue)
3144 {
3145 Lisp_Object element;
3146
3147 if (x >= 0 && (geometry & XNegative))
3148 element = Fcons (Qleft, Fcons (Qminus, Fcons (make_number (-x), Qnil)));
3149 else if (x < 0 && ! (geometry & XNegative))
3150 element = Fcons (Qleft, Fcons (Qplus, Fcons (make_number (x), Qnil)));
3151 else
3152 element = Fcons (Qleft, make_number (x));
3153 result = Fcons (element, result);
3154 }
3155
3156 if (geometry & YValue)
3157 {
3158 Lisp_Object element;
3159
3160 if (y >= 0 && (geometry & YNegative))
3161 element = Fcons (Qtop, Fcons (Qminus, Fcons (make_number (-y), Qnil)));
3162 else if (y < 0 && ! (geometry & YNegative))
3163 element = Fcons (Qtop, Fcons (Qplus, Fcons (make_number (y), Qnil)));
3164 else
3165 element = Fcons (Qtop, make_number (y));
3166 result = Fcons (element, result);
3167 }
3168
3169 if (geometry & WidthValue)
3170 result = Fcons (Fcons (Qwidth, make_number (width)), result);
3171 if (geometry & HeightValue)
3172 result = Fcons (Fcons (Qheight, make_number (height)), result);
3173
3174 return result;
3175}
3176
3177/* Calculate the desired size and position of this window,
3178 and return the flags saying which aspects were specified.
3179
3180 This function does not make the coordinates positive. */
3181
3182#define DEFAULT_ROWS 40
3183#define DEFAULT_COLS 80
3184
3185static int
3186x_figure_window_size (f, parms)
3187 struct frame *f;
3188 Lisp_Object parms;
3189{
3190 register Lisp_Object tem0, tem1, tem2;
ee78dc32
GV		 3191 long window_prompting = 0;
3192
3193 /* Default values if we fall through.
3194 Actually, if that happens we should get
3195 window manager prompting. */
1026b400 3196 SET_FRAME_WIDTH (f, DEFAULT_COLS);
ee78dc32
GV		 3197 f->height = DEFAULT_ROWS;
3198 /* Window managers expect that if program-specified
3199 positions are not (0,0), they're intentional, not defaults. */
fbd6baed
GV		 3200 f->output_data.w32->top_pos = 0;
3201 f->output_data.w32->left_pos = 0;
ee78dc32 3202
35b41202
JR		 3203 /* Ensure that old new_width and new_height will not override the
3204 values set here. */
3205 FRAME_NEW_WIDTH (f) = 0;
3206 FRAME_NEW_HEIGHT (f) = 0;
3207
6fc2811b
JR		 3208 tem0 = w32_get_arg (parms, Qheight, 0, 0, RES_TYPE_NUMBER);
3209 tem1 = w32_get_arg (parms, Qwidth, 0, 0, RES_TYPE_NUMBER);
3210 tem2 = w32_get_arg (parms, Quser_size, 0, 0, RES_TYPE_NUMBER);
ee78dc32
GV		 3211 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
3212 {
3213 if (!EQ (tem0, Qunbound))
3214 {
3215 CHECK_NUMBER (tem0, 0);
3216 f->height = XINT (tem0);
3217 }
3218 if (!EQ (tem1, Qunbound))
3219 {
3220 CHECK_NUMBER (tem1, 0);
1026b400 3221 SET_FRAME_WIDTH (f, XINT (tem1));
ee78dc32
GV		 3222 }
3223 if (!NILP (tem2) && !EQ (tem2, Qunbound))
3224 window_prompting |= USSize;
3225 else
3226 window_prompting |= PSize;
3227 }
3228
fbd6baed 3229 f->output_data.w32->vertical_scroll_bar_extra
ee78dc32
GV		 3230 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f)
3231 ? 0
3232 : FRAME_SCROLL_BAR_PIXEL_WIDTH (f) > 0
3233 ? FRAME_SCROLL_BAR_PIXEL_WIDTH (f)
fbd6baed 3234 : (FRAME_SCROLL_BAR_COLS (f) * FONT_WIDTH (f->output_data.w32->font)));
6fc2811b
JR		 3235 f->output_data.w32->flags_areas_extra
3236 = FRAME_FLAGS_AREA_WIDTH (f);
fbd6baed
GV		 3237 f->output_data.w32->pixel_width = CHAR_TO_PIXEL_WIDTH (f, f->width);
3238 f->output_data.w32->pixel_height = CHAR_TO_PIXEL_HEIGHT (f, f->height);
ee78dc32 3239
6fc2811b
JR		 3240 tem0 = w32_get_arg (parms, Qtop, 0, 0, RES_TYPE_NUMBER);
3241 tem1 = w32_get_arg (parms, Qleft, 0, 0, RES_TYPE_NUMBER);
3242 tem2 = w32_get_arg (parms, Quser_position, 0, 0, RES_TYPE_NUMBER);
ee78dc32
GV		 3243 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
3244 {
3245 if (EQ (tem0, Qminus))
3246 {
fbd6baed 3247 f->output_data.w32->top_pos = 0;
ee78dc32
GV		 3248 window_prompting |= YNegative;
3249 }
8e713be6
KR		 3250 else if (CONSP (tem0) && EQ (XCAR (tem0), Qminus)
3251 && CONSP (XCDR (tem0))
3252 && INTEGERP (XCAR (XCDR (tem0))))
ee78dc32 3253 {
8e713be6 3254 f->output_data.w32->top_pos = - XINT (XCAR (XCDR (tem0)));
ee78dc32
GV		 3255 window_prompting |= YNegative;
3256 }
8e713be6
KR		 3257 else if (CONSP (tem0) && EQ (XCAR (tem0), Qplus)
3258 && CONSP (XCDR (tem0))
3259 && INTEGERP (XCAR (XCDR (tem0))))
ee78dc32 3260 {
8e713be6 3261 f->output_data.w32->top_pos = XINT (XCAR (XCDR (tem0)));
ee78dc32
GV		 3262 }
3263 else if (EQ (tem0, Qunbound))
fbd6baed 3264 f->output_data.w32->top_pos = 0;
ee78dc32
GV		 3265 else
3266 {
3267 CHECK_NUMBER (tem0, 0);
fbd6baed
GV		 3268 f->output_data.w32->top_pos = XINT (tem0);
3269 if (f->output_data.w32->top_pos < 0)
ee78dc32
GV		 3270 window_prompting |= YNegative;
3271 }
3272
3273 if (EQ (tem1, Qminus))
3274 {
fbd6baed 3275 f->output_data.w32->left_pos = 0;
ee78dc32
GV		 3276 window_prompting |= XNegative;
3277 }
8e713be6
KR		 3278 else if (CONSP (tem1) && EQ (XCAR (tem1), Qminus)
3279 && CONSP (XCDR (tem1))
3280 && INTEGERP (XCAR (XCDR (tem1))))
ee78dc32 3281 {
8e713be6 3282 f->output_data.w32->left_pos = - XINT (XCAR (XCDR (tem1)));
ee78dc32
GV		 3283 window_prompting |= XNegative;
3284 }
8e713be6
KR		 3285 else if (CONSP (tem1) && EQ (XCAR (tem1), Qplus)
3286 && CONSP (XCDR (tem1))
3287 && INTEGERP (XCAR (XCDR (tem1))))
ee78dc32 3288 {
8e713be6 3289 f->output_data.w32->left_pos = XINT (XCAR (XCDR (tem1)));
ee78dc32
GV		 3290 }
3291 else if (EQ (tem1, Qunbound))
fbd6baed 3292 f->output_data.w32->left_pos = 0;
ee78dc32
GV		 3293 else
3294 {
3295 CHECK_NUMBER (tem1, 0);
fbd6baed
GV		 3296 f->output_data.w32->left_pos = XINT (tem1);
3297 if (f->output_data.w32->left_pos < 0)
ee78dc32
GV		 3298 window_prompting |= XNegative;
3299 }
3300
3301 if (!NILP (tem2) && ! EQ (tem2, Qunbound))
3302 window_prompting |= USPosition;
3303 else
3304 window_prompting |= PPosition;
3305 }
3306
3307 return window_prompting;
3308}
3309
3310\f
3311
fbd6baed 3312extern LRESULT CALLBACK w32_wnd_proc ();
ee78dc32
GV		 3313
3314BOOL
fbd6baed 3315w32_init_class (hinst)
ee78dc32
GV		 3316 HINSTANCE hinst;
3317{
3318 WNDCLASS wc;
3319
5ac45f98 3320 wc.style = CS_HREDRAW | CS_VREDRAW;
fbd6baed 3321 wc.lpfnWndProc = (WNDPROC) w32_wnd_proc;
ee78dc32
GV		 3322 wc.cbClsExtra = 0;
3323 wc.cbWndExtra = WND_EXTRA_BYTES;
3324 wc.hInstance = hinst;
3325 wc.hIcon = LoadIcon (hinst, EMACS_CLASS);
3326 wc.hCursor = LoadCursor (NULL, IDC_ARROW);
4587b026 3327 wc.hbrBackground = NULL; /* GetStockObject (WHITE_BRUSH); */
ee78dc32
GV		 3328 wc.lpszMenuName = NULL;
3329 wc.lpszClassName = EMACS_CLASS;
3330
3331 return (RegisterClass (&wc));
3332}
3333
3334HWND
fbd6baed 3335w32_createscrollbar (f, bar)
ee78dc32
GV		 3336 struct frame *f;
3337 struct scroll_bar * bar;
3338{
3339 return (CreateWindow ("SCROLLBAR", "", SBS_VERT | WS_CHILD | WS_VISIBLE,
3340 /* Position and size of scroll bar. */
6fc2811b
JR		 3341 XINT(bar->left) + VERTICAL_SCROLL_BAR_WIDTH_TRIM,
3342 XINT(bar->top),
3343 XINT(bar->width) - VERTICAL_SCROLL_BAR_WIDTH_TRIM * 2,
3344 XINT(bar->height),
fbd6baed 3345 FRAME_W32_WINDOW (f),
ee78dc32
GV		 3346 NULL,
3347 hinst,
3348 NULL));
3349}
3350
3351void
fbd6baed 3352w32_createwindow (f)
ee78dc32
GV		 3353 struct frame *f;
3354{
3355 HWND hwnd;
1edf84e7
GV		 3356 RECT rect;
3357
3358 rect.left = rect.top = 0;
3359 rect.right = PIXEL_WIDTH (f);
3360 rect.bottom = PIXEL_HEIGHT (f);
3361
3362 AdjustWindowRect (&rect, f->output_data.w32->dwStyle,
3363 FRAME_EXTERNAL_MENU_BAR (f));
ee78dc32
GV		 3364
3365 /* Do first time app init */
3366
3367 if (!hprevinst)
3368 {
fbd6baed 3369 w32_init_class (hinst);
ee78dc32
GV		 3370 }
3371
1edf84e7
GV		 3372 FRAME_W32_WINDOW (f) = hwnd
3373 = CreateWindow (EMACS_CLASS,
3374 f->namebuf,
9ead1b60 3375 f->output_data.w32->dwStyle | WS_CLIPCHILDREN,
1edf84e7
GV		 3376 f->output_data.w32->left_pos,
3377 f->output_data.w32->top_pos,
3378 rect.right - rect.left,
3379 rect.bottom - rect.top,
3380 NULL,
3381 NULL,
3382 hinst,
3383 NULL);
3384
ee78dc32
GV		 3385 if (hwnd)
3386 {
1edf84e7
GV		 3387 SetWindowLong (hwnd, WND_FONTWIDTH_INDEX, FONT_WIDTH (f->output_data.w32->font));
3388 SetWindowLong (hwnd, WND_LINEHEIGHT_INDEX, f->output_data.w32->line_height);
3389 SetWindowLong (hwnd, WND_BORDER_INDEX, f->output_data.w32->internal_border_width);
3390 SetWindowLong (hwnd, WND_SCROLLBAR_INDEX, f->output_data.w32->vertical_scroll_bar_extra);
6fc2811b 3391 SetWindowLong (hwnd, WND_BACKGROUND_INDEX, FRAME_BACKGROUND_PIXEL (f));
ee78dc32 3392
cb9e33d4
RS		 3393 /* Enable drag-n-drop. */
3394 DragAcceptFiles (hwnd, TRUE);
3395
5ac45f98
GV		 3396 /* Do this to discard the default setting specified by our parent. */
3397 ShowWindow (hwnd, SW_HIDE);
3c190163 3398 }
3c190163
GV		 3399}
3400
ee78dc32
GV		 3401void
3402my_post_msg (wmsg, hwnd, msg, wParam, lParam)
fbd6baed 3403 W32Msg * wmsg;
ee78dc32
GV		 3404 HWND hwnd;
3405 UINT msg;
3406 WPARAM wParam;
3407 LPARAM lParam;
3408{
3409 wmsg->msg.hwnd = hwnd;
3410 wmsg->msg.message = msg;
3411 wmsg->msg.wParam = wParam;
3412 wmsg->msg.lParam = lParam;
3413 wmsg->msg.time = GetMessageTime ();
3414
3415 post_msg (wmsg);
3416}
3417
e9e23e23 3418/* GetKeyState and MapVirtualKey on Windows 95 do not actually distinguish
a1a80b40
GV		 3419 between left and right keys as advertised. We test for this
3420 support dynamically, and set a flag when the support is absent. If
3421 absent, we keep track of the left and right control and alt keys
3422 ourselves. This is particularly necessary on keyboards that rely
3423 upon the AltGr key, which is represented as having the left control
3424 and right alt keys pressed. For these keyboards, we need to know
3425 when the left alt key has been pressed in addition to the AltGr key
3426 so that we can properly support M-AltGr-key sequences (such as M-@
3427 on Swedish keyboards). */
3428
3429#define EMACS_LCONTROL 0
3430#define EMACS_RCONTROL 1
3431#define EMACS_LMENU 2
3432#define EMACS_RMENU 3
3433
3434static int modifiers[4];
3435static int modifiers_recorded;
3436static int modifier_key_support_tested;
3437
3438static void
3439test_modifier_support (unsigned int wparam)
3440{
3441 unsigned int l, r;
3442
3443 if (wparam != VK_CONTROL && wparam != VK_MENU)
3444 return;
3445 if (wparam == VK_CONTROL)
3446 {
3447 l = VK_LCONTROL;
3448 r = VK_RCONTROL;
3449 }
3450 else
3451 {
3452 l = VK_LMENU;
3453 r = VK_RMENU;
3454 }
3455 if (!(GetKeyState (l) & 0x8000) && !(GetKeyState (r) & 0x8000))
3456 modifiers_recorded = 1;
3457 else
3458 modifiers_recorded = 0;
3459 modifier_key_support_tested = 1;
3460}
3461
3462static void
3463record_keydown (unsigned int wparam, unsigned int lparam)
3464{
3465 int i;
3466
3467 if (!modifier_key_support_tested)
3468 test_modifier_support (wparam);
3469
3470 if ((wparam != VK_CONTROL && wparam != VK_MENU) || !modifiers_recorded)
3471 return;
3472
3473 if (wparam == VK_CONTROL)
3474 i = (lparam & 0x1000000) ? EMACS_RCONTROL : EMACS_LCONTROL;
3475 else
3476 i = (lparam & 0x1000000) ? EMACS_RMENU : EMACS_LMENU;
3477
3478 modifiers[i] = 1;
3479}
3480
3481static void
3482record_keyup (unsigned int wparam, unsigned int lparam)
3483{
3484 int i;
3485
3486 if ((wparam != VK_CONTROL && wparam != VK_MENU) || !modifiers_recorded)
3487 return;
3488
3489 if (wparam == VK_CONTROL)
3490 i = (lparam & 0x1000000) ? EMACS_RCONTROL : EMACS_LCONTROL;
3491 else
3492 i = (lparam & 0x1000000) ? EMACS_RMENU : EMACS_LMENU;
3493
3494 modifiers[i] = 0;
3495}
3496
da36a4d6
GV		 3497/* Emacs can lose focus while a modifier key has been pressed. When
3498 it regains focus, be conservative and clear all modifiers since
3499 we cannot reconstruct the left and right modifier state. */
3500static void
3501reset_modifiers ()
3502{
8681157a
RS		 3503 SHORT ctrl, alt;
3504
adcc3809
GV		 3505 if (GetFocus () == NULL)
3506 /* Emacs doesn't have keyboard focus. Do nothing. */
da36a4d6 3507 return;
8681157a
RS		 3508
3509 ctrl = GetAsyncKeyState (VK_CONTROL);
3510 alt = GetAsyncKeyState (VK_MENU);
3511
8681157a
RS		 3512 if (!(ctrl & 0x08000))
3513 /* Clear any recorded control modifier state. */
3514 modifiers[EMACS_RCONTROL] = modifiers[EMACS_LCONTROL] = 0;
3515
3516 if (!(alt & 0x08000))
3517 /* Clear any recorded alt modifier state. */
3518 modifiers[EMACS_RMENU] = modifiers[EMACS_LMENU] = 0;
3519
adcc3809
GV		 3520 /* Update the state of all modifier keys, because modifiers used in
3521 hot-key combinations can get stuck on if Emacs loses focus as a
3522 result of a hot-key being pressed. */
3523 {
3524 BYTE keystate[256];
3525
3526#define CURRENT_STATE(key) ((GetAsyncKeyState (key) & 0x8000) >> 8)
3527
3528 GetKeyboardState (keystate);
3529 keystate[VK_SHIFT] = CURRENT_STATE (VK_SHIFT);
3530 keystate[VK_CONTROL] = CURRENT_STATE (VK_CONTROL);
3531 keystate[VK_LCONTROL] = CURRENT_STATE (VK_LCONTROL);
3532 keystate[VK_RCONTROL] = CURRENT_STATE (VK_RCONTROL);
3533 keystate[VK_MENU] = CURRENT_STATE (VK_MENU);
3534 keystate[VK_LMENU] = CURRENT_STATE (VK_LMENU);
3535 keystate[VK_RMENU] = CURRENT_STATE (VK_RMENU);
3536 keystate[VK_LWIN] = CURRENT_STATE (VK_LWIN);
3537 keystate[VK_RWIN] = CURRENT_STATE (VK_RWIN);
3538 keystate[VK_APPS] = CURRENT_STATE (VK_APPS);
3539 SetKeyboardState (keystate);
3540 }
da36a4d6
GV		 3541}
3542
7830e24b
RS		 3543/* Synchronize modifier state with what is reported with the current
3544 keystroke. Even if we cannot distinguish between left and right
3545 modifier keys, we know that, if no modifiers are set, then neither
3546 the left or right modifier should be set. */
3547static void
3548sync_modifiers ()
3549{
3550 if (!modifiers_recorded)
3551 return;
3552
3553 if (!(GetKeyState (VK_CONTROL) & 0x8000))
3554 modifiers[EMACS_RCONTROL] = modifiers[EMACS_LCONTROL] = 0;
3555
3556 if (!(GetKeyState (VK_MENU) & 0x8000))
3557 modifiers[EMACS_RMENU] = modifiers[EMACS_LMENU] = 0;
3558}
3559
a1a80b40
GV		 3560static int
3561modifier_set (int vkey)
3562{
ccc2d29c 3563 if (vkey == VK_CAPITAL || vkey == VK_SCROLL)
891560d6 3564 return (GetKeyState (vkey) & 0x1);
a1a80b40
GV		 3565 if (!modifiers_recorded)
3566 return (GetKeyState (vkey) & 0x8000);
3567
3568 switch (vkey)
3569 {
3570 case VK_LCONTROL:
3571 return modifiers[EMACS_LCONTROL];
3572 case VK_RCONTROL:
3573 return modifiers[EMACS_RCONTROL];
3574 case VK_LMENU:
3575 return modifiers[EMACS_LMENU];
3576 case VK_RMENU:
3577 return modifiers[EMACS_RMENU];
a1a80b40
GV		 3578 }
3579 return (GetKeyState (vkey) & 0x8000);
3580}
3581
ccc2d29c
GV		 3582/* Convert between the modifier bits W32 uses and the modifier bits
3583 Emacs uses. */
3584
3585unsigned int
3586w32_key_to_modifier (int key)
3587{
3588 Lisp_Object key_mapping;
3589
3590 switch (key)
3591 {
3592 case VK_LWIN:
3593 key_mapping = Vw32_lwindow_modifier;
3594 break;
3595 case VK_RWIN:
3596 key_mapping = Vw32_rwindow_modifier;
3597 break;
3598 case VK_APPS:
3599 key_mapping = Vw32_apps_modifier;
3600 break;
3601 case VK_SCROLL:
3602 key_mapping = Vw32_scroll_lock_modifier;
3603 break;
3604 default:
3605 key_mapping = Qnil;
3606 }
3607
adcc3809
GV		 3608 /* NB. This code runs in the input thread, asychronously to the lisp
3609 thread, so we must be careful to ensure access to lisp data is
3610 thread-safe. The following code is safe because the modifier
3611 variable values are updated atomically from lisp and symbols are
3612 not relocated by GC. Also, we don't have to worry about seeing GC
3613 markbits here. */
3614 if (EQ (key_mapping, Qhyper))
ccc2d29c 3615 return hyper_modifier;
adcc3809 3616 if (EQ (key_mapping, Qsuper))
ccc2d29c 3617 return super_modifier;
adcc3809 3618 if (EQ (key_mapping, Qmeta))
ccc2d29c 3619 return meta_modifier;
adcc3809 3620 if (EQ (key_mapping, Qalt))
ccc2d29c 3621 return alt_modifier;
adcc3809 3622 if (EQ (key_mapping, Qctrl))
ccc2d29c 3623 return ctrl_modifier;
adcc3809 3624 if (EQ (key_mapping, Qcontrol)) /* synonym for ctrl */
ccc2d29c 3625 return ctrl_modifier;
adcc3809 3626 if (EQ (key_mapping, Qshift))
ccc2d29c
GV		 3627 return shift_modifier;
3628
3629 /* Don't generate any modifier if not explicitly requested. */
3630 return 0;
3631}
3632
3633unsigned int
3634w32_get_modifiers ()
3635{
3636 return ((modifier_set (VK_SHIFT) ? shift_modifier : 0) |
3637 (modifier_set (VK_CONTROL) ? ctrl_modifier : 0) |
3638 (modifier_set (VK_LWIN) ? w32_key_to_modifier (VK_LWIN) : 0) |
3639 (modifier_set (VK_RWIN) ? w32_key_to_modifier (VK_RWIN) : 0) |
3640 (modifier_set (VK_APPS) ? w32_key_to_modifier (VK_APPS) : 0) |
3641 (modifier_set (VK_SCROLL) ? w32_key_to_modifier (VK_SCROLL) : 0) |
3642 (modifier_set (VK_MENU) ?
3643 ((NILP (Vw32_alt_is_meta)) ? alt_modifier : meta_modifier) : 0));
3644}
3645
a1a80b40
GV		 3646/* We map the VK_* modifiers into console modifier constants
3647 so that we can use the same routines to handle both console
3648 and window input. */
3649
3650static int
ccc2d29c 3651construct_console_modifiers ()
a1a80b40
GV		 3652{
3653 int mods;
3654
a1a80b40
GV		 3655 mods = 0;
3656 mods |= (modifier_set (VK_SHIFT)) ? SHIFT_PRESSED : 0;
3657 mods |= (modifier_set (VK_CAPITAL)) ? CAPSLOCK_ON : 0;
ccc2d29c
GV		 3658 mods |= (modifier_set (VK_SCROLL)) ? SCROLLLOCK_ON : 0;
3659 mods |= (modifier_set (VK_NUMLOCK)) ? NUMLOCK_ON : 0;
a1a80b40
GV		 3660 mods |= (modifier_set (VK_LCONTROL)) ? LEFT_CTRL_PRESSED : 0;
3661 mods |= (modifier_set (VK_RCONTROL)) ? RIGHT_CTRL_PRESSED : 0;
3662 mods |= (modifier_set (VK_LMENU)) ? LEFT_ALT_PRESSED : 0;
3663 mods |= (modifier_set (VK_RMENU)) ? RIGHT_ALT_PRESSED : 0;
ccc2d29c
GV		 3664 mods |= (modifier_set (VK_LWIN)) ? LEFT_WIN_PRESSED : 0;
3665 mods |= (modifier_set (VK_RWIN)) ? RIGHT_WIN_PRESSED : 0;
3666 mods |= (modifier_set (VK_APPS)) ? APPS_PRESSED : 0;
a1a80b40
GV		 3667
3668 return mods;
3669}
3670
ccc2d29c
GV		 3671static int
3672w32_get_key_modifiers (unsigned int wparam, unsigned int lparam)
da36a4d6 3673{
ccc2d29c
GV		 3674 int mods;
3675
3676 /* Convert to emacs modifiers. */
3677 mods = w32_kbd_mods_to_emacs (construct_console_modifiers (), wparam);
3678
3679 return mods;
3680}
da36a4d6 3681
ccc2d29c
GV		 3682unsigned int
3683map_keypad_keys (unsigned int virt_key, unsigned int extended)
3684{
3685 if (virt_key < VK_CLEAR || virt_key > VK_DELETE)
3686 return virt_key;
da36a4d6 3687
ccc2d29c 3688 if (virt_key == VK_RETURN)
da36a4d6
GV		 3689 return (extended ? VK_NUMPAD_ENTER : VK_RETURN);
3690
ccc2d29c
GV		 3691 if (virt_key >= VK_PRIOR && virt_key <= VK_DOWN)
3692 return (!extended ? (VK_NUMPAD_PRIOR + (virt_key - VK_PRIOR)) : virt_key);
3693
3694 if (virt_key == VK_INSERT || virt_key == VK_DELETE)
3695 return (!extended ? (VK_NUMPAD_INSERT + (virt_key - VK_INSERT)) : virt_key);
3696
3697 if (virt_key == VK_CLEAR)
3698 return (!extended ? VK_NUMPAD_CLEAR : virt_key);
3699
3700 return virt_key;
3701}
3702
3703/* List of special key combinations which w32 would normally capture,
3704 but emacs should grab instead. Not directly visible to lisp, to
3705 simplify synchronization. Each item is an integer encoding a virtual
3706 key code and modifier combination to capture. */
3707Lisp_Object w32_grabbed_keys;
3708
3709#define HOTKEY(vk,mods) make_number (((vk) & 255) | ((mods) << 8))
3710#define HOTKEY_ID(k) (XFASTINT (k) & 0xbfff)
3711#define HOTKEY_VK_CODE(k) (XFASTINT (k) & 255)
3712#define HOTKEY_MODIFIERS(k) (XFASTINT (k) >> 8)
3713
3714/* Register hot-keys for reserved key combinations when Emacs has
3715 keyboard focus, since this is the only way Emacs can receive key
3716 combinations like Alt-Tab which are used by the system. */
3717
3718static void
3719register_hot_keys (hwnd)
3720 HWND hwnd;
3721{
3722 Lisp_Object keylist;
3723
3724 /* Use GC_CONSP, since we are called asynchronously. */
3725 for (keylist = w32_grabbed_keys; GC_CONSP (keylist); keylist = XCDR (keylist))
3726 {
3727 Lisp_Object key = XCAR (keylist);
3728
3729 /* Deleted entries get set to nil. */
3730 if (!INTEGERP (key))
3731 continue;
3732
3733 RegisterHotKey (hwnd, HOTKEY_ID (key),
3734 HOTKEY_MODIFIERS (key), HOTKEY_VK_CODE (key));
3735 }
3736}
3737
3738static void
3739unregister_hot_keys (hwnd)
3740 HWND hwnd;
3741{
3742 Lisp_Object keylist;
3743
3744 /* Use GC_CONSP, since we are called asynchronously. */
3745 for (keylist = w32_grabbed_keys; GC_CONSP (keylist); keylist = XCDR (keylist))
3746 {
3747 Lisp_Object key = XCAR (keylist);
3748
3749 if (!INTEGERP (key))
3750 continue;
3751
3752 UnregisterHotKey (hwnd, HOTKEY_ID (key));
3753 }
3754}
3755
5ac45f98
GV		 3756/* Main message dispatch loop. */
3757
1edf84e7
GV		 3758static void
3759w32_msg_pump (deferred_msg * msg_buf)
5ac45f98
GV		 3760{
3761 MSG msg;
ccc2d29c
GV		 3762 int result;
3763 HWND focus_window;
93fbe8b7
GV		 3764
3765 msh_mousewheel = RegisterWindowMessage (MSH_MOUSEWHEEL);
5ac45f98 3766
5ac45f98
GV		 3767 while (GetMessage (&msg, NULL, 0, 0))
3768 {
3769 if (msg.hwnd == NULL)
3770 {
3771 switch (msg.message)
3772 {
3ef68e6b
AI		 3773 case WM_NULL:
3774 /* Produced by complete_deferred_msg; just ignore. */
3775 break;
5ac45f98 3776 case WM_EMACS_CREATEWINDOW:
fbd6baed 3777 w32_createwindow ((struct frame *) msg.wParam);
1edf84e7
GV		 3778 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0))
3779 abort ();
5ac45f98 3780 break;
dfdb4047
GV		 3781 case WM_EMACS_SETLOCALE:
3782 SetThreadLocale (msg.wParam);
3783 /* Reply is not expected. */
3784 break;
ccc2d29c
GV		 3785 case WM_EMACS_SETKEYBOARDLAYOUT:
3786 result = (int) ActivateKeyboardLayout ((HKL) msg.wParam, 0);
3787 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE,
3788 result, 0))
3789 abort ();
3790 break;
3791 case WM_EMACS_REGISTER_HOT_KEY:
3792 focus_window = GetFocus ();
3793 if (focus_window != NULL)
3794 RegisterHotKey (focus_window,
3795 HOTKEY_ID (msg.wParam),
3796 HOTKEY_MODIFIERS (msg.wParam),
3797 HOTKEY_VK_CODE (msg.wParam));
3798 /* Reply is not expected. */
3799 break;
3800 case WM_EMACS_UNREGISTER_HOT_KEY:
3801 focus_window = GetFocus ();
3802 if (focus_window != NULL)
3803 UnregisterHotKey (focus_window, HOTKEY_ID (msg.wParam));
adcc3809
GV		 3804 /* Mark item as erased. NB: this code must be
3805 thread-safe. The next line is okay because the cons
3806 cell is never made into garbage and is not relocated by
3807 GC. */
f3fbd155 3808 XSETCAR ((Lisp_Object) msg.lParam, Qnil);
ccc2d29c
GV		 3809 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0))
3810 abort ();
3811 break;
adcc3809
GV		 3812 case WM_EMACS_TOGGLE_LOCK_KEY:
3813 {
3814 int vk_code = (int) msg.wParam;
3815 int cur_state = (GetKeyState (vk_code) & 1);
3816 Lisp_Object new_state = (Lisp_Object) msg.lParam;
3817
3818 /* NB: This code must be thread-safe. It is safe to
3819 call NILP because symbols are not relocated by GC,
3820 and pointer here is not touched by GC (so the markbit
3821 can't be set). Numbers are safe because they are
3822 immediate values. */
3823 if (NILP (new_state)
3824 || (NUMBERP (new_state)
8edb0a6f 3825 && ((XUINT (new_state)) & 1) != cur_state))
adcc3809
GV		 3826 {
3827 one_w32_display_info.faked_key = vk_code;
3828
3829 keybd_event ((BYTE) vk_code,
3830 (BYTE) MapVirtualKey (vk_code, 0),
3831 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
3832 keybd_event ((BYTE) vk_code,
3833 (BYTE) MapVirtualKey (vk_code, 0),
3834 KEYEVENTF_EXTENDEDKEY | 0, 0);
3835 keybd_event ((BYTE) vk_code,
3836 (BYTE) MapVirtualKey (vk_code, 0),
3837 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
3838 cur_state = !cur_state;
3839 }
3840 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE,
3841 cur_state, 0))
3842 abort ();
3843 }
3844 break;
1edf84e7 3845 default:
1edf84e7 3846 DebPrint (("msg %x not expected by w32_msg_pump\n", msg.message));
5ac45f98
GV		 3847 }
3848 }
3849 else
3850 {
3851 DispatchMessage (&msg);
3852 }
1edf84e7
GV		 3853
3854 /* Exit nested loop when our deferred message has completed. */
3855 if (msg_buf->completed)
3856 break;
5ac45f98 3857 }
1edf84e7
GV		 3858}
3859
3860deferred_msg * deferred_msg_head;
3861
3862static deferred_msg *
3863find_deferred_msg (HWND hwnd, UINT msg)
3864{
3865 deferred_msg * item;
3866
3867 /* Don't actually need synchronization for read access, since
3868 modification of single pointer is always atomic. */
3869 /* enter_crit (); */
3870
3871 for (item = deferred_msg_head; item != NULL; item = item->next)
3872 if (item->w32msg.msg.hwnd == hwnd
3873 && item->w32msg.msg.message == msg)
3874 break;
3875
3876 /* leave_crit (); */
3877
3878 return item;
3879}
3880
3881static LRESULT
3882send_deferred_msg (deferred_msg * msg_buf,
3883 HWND hwnd,
3884 UINT msg,
3885 WPARAM wParam,
3886 LPARAM lParam)
3887{
3888 /* Only input thread can send deferred messages. */
3889 if (GetCurrentThreadId () != dwWindowsThreadId)
3890 abort ();
3891
3892 /* It is an error to send a message that is already deferred. */
3893 if (find_deferred_msg (hwnd, msg) != NULL)
3894 abort ();
3895
3896 /* Enforced synchronization is not needed because this is the only
3897 function that alters deferred_msg_head, and the following critical
3898 section is guaranteed to only be serially reentered (since only the
3899 input thread can call us). */
3900
3901 /* enter_crit (); */
3902
3903 msg_buf->completed = 0;
3904 msg_buf->next = deferred_msg_head;
3905 deferred_msg_head = msg_buf;
3906 my_post_msg (&msg_buf->w32msg, hwnd, msg, wParam, lParam);
3907
3908 /* leave_crit (); */
3909
3910 /* Start a new nested message loop to process other messages until
3911 this one is completed. */
3912 w32_msg_pump (msg_buf);
3913
3914 deferred_msg_head = msg_buf->next;
3915
3916 return msg_buf->result;
3917}
3918
3919void
3920complete_deferred_msg (HWND hwnd, UINT msg, LRESULT result)
3921{
3922 deferred_msg * msg_buf = find_deferred_msg (hwnd, msg);
3923
3924 if (msg_buf == NULL)
3ef68e6b
AI		 3925 /* Message may have been cancelled, so don't abort(). */
3926 return;
1edf84e7
GV		 3927
3928 msg_buf->result = result;
3929 msg_buf->completed = 1;
3930
3931 /* Ensure input thread is woken so it notices the completion. */
3932 PostThreadMessage (dwWindowsThreadId, WM_NULL, 0, 0);
3933}
3934
3ef68e6b
AI		 3935void
3936cancel_all_deferred_msgs ()
3937{
3938 deferred_msg * item;
3939
3940 /* Don't actually need synchronization for read access, since
3941 modification of single pointer is always atomic. */
3942 /* enter_crit (); */
3943
3944 for (item = deferred_msg_head; item != NULL; item = item->next)
3945 {
3946 item->result = 0;
3947 item->completed = 1;
3948 }
3949
3950 /* leave_crit (); */
3951
3952 /* Ensure input thread is woken so it notices the completion. */
3953 PostThreadMessage (dwWindowsThreadId, WM_NULL, 0, 0);
3954}
1edf84e7
GV		 3955
3956DWORD
3957w32_msg_worker (dw)
3958 DWORD dw;
3959{
3960 MSG msg;
3961 deferred_msg dummy_buf;
3962
3963 /* Ensure our message queue is created */
3964
3965 PeekMessage (&msg, NULL, 0, 0, PM_NOREMOVE);
5ac45f98 3966
1edf84e7
GV		 3967 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0))
3968 abort ();
3969
3970 memset (&dummy_buf, 0, sizeof (dummy_buf));
3971 dummy_buf.w32msg.msg.hwnd = NULL;
3972 dummy_buf.w32msg.msg.message = WM_NULL;
3973
3974 /* This is the inital message loop which should only exit when the
3975 application quits. */
3976 w32_msg_pump (&dummy_buf);
3977
3978 return 0;
5ac45f98
GV		 3979}
3980
3ef68e6b
AI		 3981static void
3982post_character_message (hwnd, msg, wParam, lParam, modifiers)
3983 HWND hwnd;
3984 UINT msg;
3985 WPARAM wParam;
3986 LPARAM lParam;
3987 DWORD modifiers;
3988
3989{
3990 W32Msg wmsg;
3991
3992 wmsg.dwModifiers = modifiers;
3993
3994 /* Detect quit_char and set quit-flag directly. Note that we
3995 still need to post a message to ensure the main thread will be
3996 woken up if blocked in sys_select(), but we do NOT want to post
3997 the quit_char message itself (because it will usually be as if
3998 the user had typed quit_char twice). Instead, we post a dummy
3999 message that has no particular effect. */
4000 {
4001 int c = wParam;
4002 if (isalpha (c) && wmsg.dwModifiers == ctrl_modifier)
4003 c = make_ctrl_char (c) & 0377;
7d081355
AI		 4004 if (c == quit_char
4005 || (wmsg.dwModifiers == 0 &&
4006 XFASTINT (Vw32_quit_key) && wParam == XFASTINT (Vw32_quit_key)))
3ef68e6b
AI		 4007 {
4008 Vquit_flag = Qt;
4009
4010 /* The choice of message is somewhat arbitrary, as long as
4011 the main thread handler just ignores it. */
4012 msg = WM_NULL;
4013
4014 /* Interrupt any blocking system calls. */
4015 signal_quit ();
4016
4017 /* As a safety precaution, forcibly complete any deferred
4018 messages. This is a kludge, but I don't see any particularly
4019 clean way to handle the situation where a deferred message is
4020 "dropped" in the lisp thread, and will thus never be
4021 completed, eg. by the user trying to activate the menubar
4022 when the lisp thread is busy, and then typing C-g when the
4023 menubar doesn't open promptly (with the result that the
4024 menubar never responds at all because the deferred
4025 WM_INITMENU message is never completed). Another problem
4026 situation is when the lisp thread calls SendMessage (to send
4027 a window manager command) when a message has been deferred;
4028 the lisp thread gets blocked indefinitely waiting for the
4029 deferred message to be completed, which itself is waiting for
4030 the lisp thread to respond.
4031
4032 Note that we don't want to block the input thread waiting for
4033 a reponse from the lisp thread (although that would at least
4034 solve the deadlock problem above), because we want to be able
4035 to receive C-g to interrupt the lisp thread. */
4036 cancel_all_deferred_msgs ();
4037 }
4038 }
4039
4040 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4041}
4042
ee78dc32
GV		 4043/* Main window procedure */
4044
ee78dc32 4045LRESULT CALLBACK
fbd6baed 4046w32_wnd_proc (hwnd, msg, wParam, lParam)
ee78dc32
GV		 4047 HWND hwnd;
4048 UINT msg;
4049 WPARAM wParam;
4050 LPARAM lParam;
4051{
4052 struct frame *f;
fbd6baed
GV		 4053 struct w32_display_info *dpyinfo = &one_w32_display_info;
4054 W32Msg wmsg;
84fb1139 4055 int windows_translate;
576ba81c 4056 int key;
84fb1139 4057
a6085637
KH		 4058 /* Note that it is okay to call x_window_to_frame, even though we are
4059 not running in the main lisp thread, because frame deletion
4060 requires the lisp thread to synchronize with this thread. Thus, if
4061 a frame struct is returned, it can be used without concern that the
4062 lisp thread might make it disappear while we are using it.
4063
4064 NB. Walking the frame list in this thread is safe (as long as
4065 writes of Lisp_Object slots are atomic, which they are on Windows).
4066 Although delete-frame can destructively modify the frame list while
4067 we are walking it, a garbage collection cannot occur until after
4068 delete-frame has synchronized with this thread.
4069
4070 It is also safe to use functions that make GDI calls, such as
fbd6baed 4071 w32_clear_rect, because these functions must obtain a DC handle
a6085637
KH		 4072 from the frame struct using get_frame_dc which is thread-aware. */
4073
ee78dc32
GV		 4074 switch (msg)
4075 {
4076 case WM_ERASEBKGND:
a6085637
KH		 4077 f = x_window_to_frame (dpyinfo, hwnd);
4078 if (f)
4079 {
9badad41 4080 HDC hdc = get_frame_dc (f);
a6085637 4081 GetUpdateRect (hwnd, &wmsg.rect, FALSE);
9badad41
JR		 4082 w32_clear_rect (f, hdc, &wmsg.rect);
4083 release_frame_dc (f, hdc);
ce6059da
AI		 4084
4085#if defined (W32_DEBUG_DISPLAY)
18f0b342
AI		 4086 DebPrint (("WM_ERASEBKGND (frame %p): erasing %d,%d-%d,%d\n",
4087 f,
4088 wmsg.rect.left, wmsg.rect.top,
4089 wmsg.rect.right, wmsg.rect.bottom));
ce6059da 4090#endif /* W32_DEBUG_DISPLAY */
a6085637 4091 }
5ac45f98
GV		 4092 return 1;
4093 case WM_PALETTECHANGED:
4094 /* ignore our own changes */
4095 if ((HWND)wParam != hwnd)
4096 {
a6085637
KH		 4097 f = x_window_to_frame (dpyinfo, hwnd);
4098 if (f)
4099 /* get_frame_dc will realize our palette and force all
4100 frames to be redrawn if needed. */
4101 release_frame_dc (f, get_frame_dc (f));
5ac45f98
GV		 4102 }
4103 return 0;
ee78dc32 4104 case WM_PAINT:
ce6059da 4105 {
55dcfc15
AI		 4106 PAINTSTRUCT paintStruct;
4107 RECT update_rect;
4108
18f0b342
AI		 4109 f = x_window_to_frame (dpyinfo, hwnd);
4110 if (f == 0)
4111 {
4112 DebPrint (("WM_PAINT received for unknown window %p\n", hwnd));
4113 return 0;
4114 }
4115
55dcfc15
AI		 4116 /* MSDN Docs say not to call BeginPaint if GetUpdateRect
4117 fails. Apparently this can happen under some
4118 circumstances. */
c0611964 4119 if (!w32_strict_painting || GetUpdateRect (hwnd, &update_rect, FALSE))
55dcfc15
AI		 4120 {
4121 enter_crit ();
4122 BeginPaint (hwnd, &paintStruct);
4123
c0611964
AI		 4124 if (w32_strict_painting)
4125 /* The rectangles returned by GetUpdateRect and BeginPaint
4126 do not always match. GetUpdateRect seems to be the
4127 more reliable of the two. */
4128 wmsg.rect = update_rect;
4129 else
4130 wmsg.rect = paintStruct.rcPaint;
55dcfc15
AI		 4131
4132#if defined (W32_DEBUG_DISPLAY)
18f0b342
AI		 4133 DebPrint (("WM_PAINT (frame %p): painting %d,%d-%d,%d\n",
4134 f,
4135 wmsg.rect.left, wmsg.rect.top,
4136 wmsg.rect.right, wmsg.rect.bottom));
4137 DebPrint ((" [update region is %d,%d-%d,%d]\n",
55dcfc15
AI		 4138 update_rect.left, update_rect.top,
4139 update_rect.right, update_rect.bottom));
4140#endif
4141 EndPaint (hwnd, &paintStruct);
4142 leave_crit ();
4143
4144 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4145
4146 return 0;
4147 }
c0611964
AI		 4148
4149 /* If GetUpdateRect returns 0 (meaning there is no update
4150 region), assume the whole window needs to be repainted. */
4151 GetClientRect(hwnd, &wmsg.rect);
4152 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4153 return 0;
ee78dc32 4154 }
a1a80b40 4155
ccc2d29c
GV		 4156 case WM_INPUTLANGCHANGE:
4157 /* Inform lisp thread of keyboard layout changes. */
4158 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4159
4160 /* Clear dead keys in the keyboard state; for simplicity only
4161 preserve modifier key states. */
4162 {
4163 int i;
4164 BYTE keystate[256];
4165
4166 GetKeyboardState (keystate);
4167 for (i = 0; i < 256; i++)
4168 if (1
4169 && i != VK_SHIFT
4170 && i != VK_LSHIFT
4171 && i != VK_RSHIFT
4172 && i != VK_CAPITAL
4173 && i != VK_NUMLOCK
4174 && i != VK_SCROLL
4175 && i != VK_CONTROL
4176 && i != VK_LCONTROL
4177 && i != VK_RCONTROL
4178 && i != VK_MENU
4179 && i != VK_LMENU
4180 && i != VK_RMENU
4181 && i != VK_LWIN
4182 && i != VK_RWIN)
4183 keystate[i] = 0;
4184 SetKeyboardState (keystate);
4185 }
4186 goto dflt;
4187
4188 case WM_HOTKEY:
4189 /* Synchronize hot keys with normal input. */
4190 PostMessage (hwnd, WM_KEYDOWN, HIWORD (lParam), 0);
4191 return (0);
4192
a1a80b40
GV		 4193 case WM_KEYUP:
4194 case WM_SYSKEYUP:
4195 record_keyup (wParam, lParam);
4196 goto dflt;
4197
ee78dc32
GV		 4198 case WM_KEYDOWN:
4199 case WM_SYSKEYDOWN:
ccc2d29c
GV		 4200 /* Ignore keystrokes we fake ourself; see below. */
4201 if (dpyinfo->faked_key == wParam)
4202 {
4203 dpyinfo->faked_key = 0;
576ba81c
AI		 4204 /* Make sure TranslateMessage sees them though (as long as
4205 they don't produce WM_CHAR messages). This ensures that
4206 indicator lights are toggled promptly on Windows 9x, for
4207 example. */
4208 if (lispy_function_keys[wParam] != 0)
4209 {
4210 windows_translate = 1;
4211 goto translate;
4212 }
4213 return 0;
ccc2d29c
GV		 4214 }
4215
7830e24b
RS		 4216 /* Synchronize modifiers with current keystroke. */
4217 sync_modifiers ();
a1a80b40 4218 record_keydown (wParam, lParam);
ccc2d29c 4219 wParam = map_keypad_keys (wParam, (lParam & 0x1000000L) != 0);
84fb1139
KH		 4220
4221 windows_translate = 0;
ccc2d29c
GV		 4222
4223 switch (wParam)
4224 {
4225 case VK_LWIN:
4226 if (NILP (Vw32_pass_lwindow_to_system))
4227 {
4228 /* Prevent system from acting on keyup (which opens the
4229 Start menu if no other key was pressed) by simulating a
4230 press of Space which we will ignore. */
4231 if (GetAsyncKeyState (wParam) & 1)
4232 {
adcc3809 4233 if (NUMBERP (Vw32_phantom_key_code))
576ba81c 4234 key = XUINT (Vw32_phantom_key_code) & 255;
adcc3809 4235 else
576ba81c
AI		 4236 key = VK_SPACE;
4237 dpyinfo->faked_key = key;
4238 keybd_event (key, (BYTE) MapVirtualKey (key, 0), 0, 0);
ccc2d29c
GV		 4239 }
4240 }
4241 if (!NILP (Vw32_lwindow_modifier))
4242 return 0;
4243 break;
4244 case VK_RWIN:
4245 if (NILP (Vw32_pass_rwindow_to_system))
4246 {
4247 if (GetAsyncKeyState (wParam) & 1)
4248 {
adcc3809 4249 if (NUMBERP (Vw32_phantom_key_code))
576ba81c 4250 key = XUINT (Vw32_phantom_key_code) & 255;
adcc3809 4251 else
576ba81c
AI		 4252 key = VK_SPACE;
4253 dpyinfo->faked_key = key;
4254 keybd_event (key, (BYTE) MapVirtualKey (key, 0), 0, 0);
ccc2d29c
GV		 4255 }
4256 }
4257 if (!NILP (Vw32_rwindow_modifier))
4258 return 0;
4259 break;
576ba81c 4260 case VK_APPS:
ccc2d29c
GV		 4261 if (!NILP (Vw32_apps_modifier))
4262 return 0;
4263 break;
4264 case VK_MENU:
4265 if (NILP (Vw32_pass_alt_to_system))
adcc3809
GV		 4266 /* Prevent DefWindowProc from activating the menu bar if an
4267 Alt key is pressed and released by itself. */
ccc2d29c 4268 return 0;
84fb1139 4269 windows_translate = 1;
ccc2d29c
GV		 4270 break;
4271 case VK_CAPITAL:
4272 /* Decide whether to treat as modifier or function key. */
4273 if (NILP (Vw32_enable_caps_lock))
4274 goto disable_lock_key;
adcc3809
GV		 4275 windows_translate = 1;
4276 break;
ccc2d29c
GV		 4277 case VK_NUMLOCK:
4278 /* Decide whether to treat as modifier or function key. */
4279 if (NILP (Vw32_enable_num_lock))
4280 goto disable_lock_key;
adcc3809
GV		 4281 windows_translate = 1;
4282 break;
ccc2d29c
GV		 4283 case VK_SCROLL:
4284 /* Decide whether to treat as modifier or function key. */
4285 if (NILP (Vw32_scroll_lock_modifier))
4286 goto disable_lock_key;
adcc3809
GV		 4287 windows_translate = 1;
4288 break;
ccc2d29c 4289 disable_lock_key:
adcc3809
GV		 4290 /* Ensure the appropriate lock key state (and indicator light)
4291 remains in the same state. We do this by faking another
4292 press of the relevant key. Apparently, this really is the
4293 only way to toggle the state of the indicator lights. */
4294 dpyinfo->faked_key = wParam;
4295 keybd_event ((BYTE) wParam, (BYTE) MapVirtualKey (wParam, 0),
4296 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
4297 keybd_event ((BYTE) wParam, (BYTE) MapVirtualKey (wParam, 0),
4298 KEYEVENTF_EXTENDEDKEY | 0, 0);
4299 keybd_event ((BYTE) wParam, (BYTE) MapVirtualKey (wParam, 0),
4300 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
4301 /* Ensure indicator lights are updated promptly on Windows 9x
4302 (TranslateMessage apparently does this), after forwarding
4303 input event. */
4304 post_character_message (hwnd, msg, wParam, lParam,
4305 w32_get_key_modifiers (wParam, lParam));
4306 windows_translate = 1;
ccc2d29c
GV		 4307 break;
4308 case VK_CONTROL:
4309 case VK_SHIFT:
4310 case VK_PROCESSKEY: /* Generated by IME. */
4311 windows_translate = 1;
4312 break;
adcc3809
GV		 4313 case VK_CANCEL:
4314 /* Windows maps Ctrl-Pause (aka Ctrl-Break) into VK_CANCEL,
4315 which is confusing for purposes of key binding; convert
4316 VK_CANCEL events into VK_PAUSE events. */
4317 wParam = VK_PAUSE;
4318 break;
4319 case VK_PAUSE:
4320 /* Windows maps Ctrl-NumLock into VK_PAUSE, which is confusing
4321 for purposes of key binding; convert these back into
4322 VK_NUMLOCK events, at least when we want to see NumLock key
4323 presses. (Note that there is never any possibility that
4324 VK_PAUSE with Ctrl really is C-Pause as per above.) */
4325 if (NILP (Vw32_enable_num_lock) && modifier_set (VK_CONTROL))
4326 wParam = VK_NUMLOCK;
4327 break;
ccc2d29c
GV		 4328 default:
4329 /* If not defined as a function key, change it to a WM_CHAR message. */
4330 if (lispy_function_keys[wParam] == 0)
4331 {
adcc3809
GV		 4332 DWORD modifiers = construct_console_modifiers ();
4333
ccc2d29c
GV		 4334 if (!NILP (Vw32_recognize_altgr)
4335 && modifier_set (VK_LCONTROL) && modifier_set (VK_RMENU))
4336 {
4337 /* Always let TranslateMessage handle AltGr key chords;
4338 for some reason, ToAscii doesn't always process AltGr
4339 chords correctly. */
4340 windows_translate = 1;
4341 }
adcc3809 4342 else if ((modifiers & (~SHIFT_PRESSED & ~CAPSLOCK_ON)) != 0)
ccc2d29c 4343 {
adcc3809
GV		 4344 /* Handle key chords including any modifiers other
4345 than shift directly, in order to preserve as much
4346 modifier information as possible. */
ccc2d29c
GV		 4347 if ('A' <= wParam && wParam <= 'Z')
4348 {
4349 /* Don't translate modified alphabetic keystrokes,
4350 so the user doesn't need to constantly switch
4351 layout to type control or meta keystrokes when
4352 the normal layout translates alphabetic
4353 characters to non-ascii characters. */
4354 if (!modifier_set (VK_SHIFT))
4355 wParam += ('a' - 'A');
4356 msg = WM_CHAR;
4357 }
4358 else
4359 {
4360 /* Try to handle other keystrokes by determining the
4361 base character (ie. translating the base key plus
4362 shift modifier). */
4363 int add;
4364 int isdead = 0;
4365 KEY_EVENT_RECORD key;
4366
4367 key.bKeyDown = TRUE;
4368 key.wRepeatCount = 1;
4369 key.wVirtualKeyCode = wParam;
4370 key.wVirtualScanCode = (lParam & 0xFF0000) >> 16;
4371 key.uChar.AsciiChar = 0;
adcc3809 4372 key.dwControlKeyState = modifiers;
ccc2d29c
GV		 4373
4374 add = w32_kbd_patch_key (&key);
4375 /* 0 means an unrecognised keycode, negative means
4376 dead key. Ignore both. */
4377 while (--add >= 0)
4378 {
4379 /* Forward asciified character sequence. */
4380 post_character_message
4381 (hwnd, WM_CHAR, key.uChar.AsciiChar, lParam,
4382 w32_get_key_modifiers (wParam, lParam));
4383 w32_kbd_patch_key (&key);
4384 }
4385 return 0;
4386 }
4387 }
4388 else
4389 {
4390 /* Let TranslateMessage handle everything else. */
4391 windows_translate = 1;
4392 }
4393 }
4394 }
a1a80b40 4395
adcc3809 4396 translate:
84fb1139
KH		 4397 if (windows_translate)
4398 {
e9e23e23 4399 MSG windows_msg = { hwnd, msg, wParam, lParam, 0, {0,0} };
84fb1139 4400
e9e23e23
GV		 4401 windows_msg.time = GetMessageTime ();
4402 TranslateMessage (&windows_msg);
84fb1139
KH		 4403 goto dflt;
4404 }
4405
ee78dc32
GV		 4406 /* Fall through */
4407
4408 case WM_SYSCHAR:
4409 case WM_CHAR:
ccc2d29c
GV		 4410 post_character_message (hwnd, msg, wParam, lParam,
4411 w32_get_key_modifiers (wParam, lParam));
ee78dc32 4412 break;
da36a4d6 4413
5ac45f98
GV		 4414 /* Simulate middle mouse button events when left and right buttons
4415 are used together, but only if user has two button mouse. */
ee78dc32 4416 case WM_LBUTTONDOWN:
5ac45f98 4417 case WM_RBUTTONDOWN:
7ce9aaca 4418 if (XINT (Vw32_num_mouse_buttons) > 2)
5ac45f98
GV		 4419 goto handle_plain_button;
4420
4421 {
4422 int this = (msg == WM_LBUTTONDOWN) ? LMOUSE : RMOUSE;
4423 int other = (msg == WM_LBUTTONDOWN) ? RMOUSE : LMOUSE;
4424
3cb20f4a
RS		 4425 if (button_state & this)
4426 return 0;
5ac45f98
GV		 4427
4428 if (button_state == 0)
4429 SetCapture (hwnd);
4430
4431 button_state |= this;
4432
4433 if (button_state & other)
4434 {
84fb1139 4435 if (mouse_button_timer)
5ac45f98 4436 {
84fb1139
KH		 4437 KillTimer (hwnd, mouse_button_timer);
4438 mouse_button_timer = 0;
5ac45f98
GV		 4439
4440 /* Generate middle mouse event instead. */
4441 msg = WM_MBUTTONDOWN;
4442 button_state |= MMOUSE;
4443 }
4444 else if (button_state & MMOUSE)
4445 {
4446 /* Ignore button event if we've already generated a
4447 middle mouse down event. This happens if the
4448 user releases and press one of the two buttons
4449 after we've faked a middle mouse event. */
4450 return 0;
4451 }
4452 else
4453 {
4454 /* Flush out saved message. */
84fb1139 4455 post_msg (&saved_mouse_button_msg);
5ac45f98 4456 }
fbd6baed 4457 wmsg.dwModifiers = w32_get_modifiers ();
5ac45f98
GV		 4458 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4459
4460 /* Clear message buffer. */
84fb1139 4461 saved_mouse_button_msg.msg.hwnd = 0;
5ac45f98
GV		 4462 }
4463 else
4464 {
4465 /* Hold onto message for now. */
84fb1139 4466 mouse_button_timer =
adcc3809
GV		 4467 SetTimer (hwnd, MOUSE_BUTTON_ID,
4468 XINT (Vw32_mouse_button_tolerance), NULL);
84fb1139
KH		 4469 saved_mouse_button_msg.msg.hwnd = hwnd;
4470 saved_mouse_button_msg.msg.message = msg;
4471 saved_mouse_button_msg.msg.wParam = wParam;
4472 saved_mouse_button_msg.msg.lParam = lParam;
4473 saved_mouse_button_msg.msg.time = GetMessageTime ();
fbd6baed 4474 saved_mouse_button_msg.dwModifiers = w32_get_modifiers ();
5ac45f98
GV		 4475 }
4476 }
4477 return 0;
4478
ee78dc32 4479 case WM_LBUTTONUP:
5ac45f98 4480 case WM_RBUTTONUP:
7ce9aaca 4481 if (XINT (Vw32_num_mouse_buttons) > 2)
5ac45f98
GV		 4482 goto handle_plain_button;
4483
4484 {
4485 int this = (msg == WM_LBUTTONUP) ? LMOUSE : RMOUSE;
4486 int other = (msg == WM_LBUTTONUP) ? RMOUSE : LMOUSE;
4487
3cb20f4a
RS		 4488 if ((button_state & this) == 0)
4489 return 0;
5ac45f98
GV		 4490
4491 button_state &= ~this;
4492
4493 if (button_state & MMOUSE)
4494 {
4495 /* Only generate event when second button is released. */
4496 if ((button_state & other) == 0)
4497 {
4498 msg = WM_MBUTTONUP;
4499 button_state &= ~MMOUSE;
4500
4501 if (button_state) abort ();
4502 }
4503 else
4504 return 0;
4505 }
4506 else
4507 {
4508 /* Flush out saved message if necessary. */
84fb1139 4509 if (saved_mouse_button_msg.msg.hwnd)
5ac45f98 4510 {
84fb1139 4511 post_msg (&saved_mouse_button_msg);
5ac45f98
GV		 4512 }
4513 }
fbd6baed 4514 wmsg.dwModifiers = w32_get_modifiers ();
5ac45f98
GV		 4515 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4516
4517 /* Always clear message buffer and cancel timer. */
84fb1139
KH		 4518 saved_mouse_button_msg.msg.hwnd = 0;
4519 KillTimer (hwnd, mouse_button_timer);
4520 mouse_button_timer = 0;
5ac45f98
GV		 4521
4522 if (button_state == 0)
4523 ReleaseCapture ();
4524 }
4525 return 0;
4526
ee78dc32
GV		 4527 case WM_MBUTTONDOWN:
4528 case WM_MBUTTONUP:
5ac45f98 4529 handle_plain_button:
ee78dc32
GV		 4530 {
4531 BOOL up;
1edf84e7 4532 int button;
ee78dc32 4533
1edf84e7 4534 if (parse_button (msg, &button, &up))
ee78dc32
GV		 4535 {
4536 if (up) ReleaseCapture ();
4537 else SetCapture (hwnd);
1edf84e7
GV		 4538 button = (button == 0) ? LMOUSE :
4539 ((button == 1) ? MMOUSE : RMOUSE);
4540 if (up)
4541 button_state &= ~button;
4542 else
4543 button_state |= button;
ee78dc32
GV		 4544 }
4545 }
4546
fbd6baed 4547 wmsg.dwModifiers = w32_get_modifiers ();
ee78dc32 4548 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
5ac45f98
GV		 4549 return 0;
4550
84fb1139 4551 case WM_VSCROLL:
5ac45f98 4552 case WM_MOUSEMOVE:
fbd6baed 4553 if (XINT (Vw32_mouse_move_interval) <= 0
84fb1139
KH		 4554 || (msg == WM_MOUSEMOVE && button_state == 0))
4555 {
fbd6baed 4556 wmsg.dwModifiers = w32_get_modifiers ();
84fb1139
KH		 4557 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4558 return 0;
4559 }
4560
4561 /* Hang onto mouse move and scroll messages for a bit, to avoid
4562 sending such events to Emacs faster than it can process them.
4563 If we get more events before the timer from the first message
4564 expires, we just replace the first message. */
4565
4566 if (saved_mouse_move_msg.msg.hwnd == 0)
4567 mouse_move_timer =
adcc3809
GV		 4568 SetTimer (hwnd, MOUSE_MOVE_ID,
4569 XINT (Vw32_mouse_move_interval), NULL);
84fb1139
KH		 4570
4571 /* Hold onto message for now. */
4572 saved_mouse_move_msg.msg.hwnd = hwnd;
4573 saved_mouse_move_msg.msg.message = msg;
4574 saved_mouse_move_msg.msg.wParam = wParam;
4575 saved_mouse_move_msg.msg.lParam = lParam;
4576 saved_mouse_move_msg.msg.time = GetMessageTime ();
fbd6baed 4577 saved_mouse_move_msg.dwModifiers = w32_get_modifiers ();
84fb1139
KH		 4578
4579 return 0;
4580
1edf84e7
GV		 4581 case WM_MOUSEWHEEL:
4582 wmsg.dwModifiers = w32_get_modifiers ();
4583 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4584 return 0;
4585
cb9e33d4
RS		 4586 case WM_DROPFILES:
4587 wmsg.dwModifiers = w32_get_modifiers ();
4588 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4589 return 0;
4590
84fb1139
KH		 4591 case WM_TIMER:
4592 /* Flush out saved messages if necessary. */
4593 if (wParam == mouse_button_timer)
5ac45f98 4594 {
84fb1139
KH		 4595 if (saved_mouse_button_msg.msg.hwnd)
4596 {
4597 post_msg (&saved_mouse_button_msg);
4598 saved_mouse_button_msg.msg.hwnd = 0;
4599 }
4600 KillTimer (hwnd, mouse_button_timer);
4601 mouse_button_timer = 0;
4602 }
4603 else if (wParam == mouse_move_timer)
4604 {
4605 if (saved_mouse_move_msg.msg.hwnd)
4606 {
4607 post_msg (&saved_mouse_move_msg);
4608 saved_mouse_move_msg.msg.hwnd = 0;
4609 }
4610 KillTimer (hwnd, mouse_move_timer);
4611 mouse_move_timer = 0;
5ac45f98 4612 }
5ac45f98 4613 return 0;
84fb1139
KH		 4614
4615 case WM_NCACTIVATE:
4616 /* Windows doesn't send us focus messages when putting up and
e9e23e23 4617 taking down a system popup dialog as for Ctrl-Alt-Del on Windows 95.
84fb1139
KH		 4618 The only indication we get that something happened is receiving
4619 this message afterwards. So this is a good time to reset our
4620 keyboard modifiers' state. */
4621 reset_modifiers ();
4622 goto dflt;
da36a4d6 4623
1edf84e7 4624 case WM_INITMENU:
487163ac
AI		 4625 button_state = 0;
4626 ReleaseCapture ();
1edf84e7
GV		 4627 /* We must ensure menu bar is fully constructed and up to date
4628 before allowing user interaction with it. To achieve this
4629 we send this message to the lisp thread and wait for a
4630 reply (whose value is not actually needed) to indicate that
4631 the menu bar is now ready for use, so we can now return.
4632
4633 To remain responsive in the meantime, we enter a nested message
4634 loop that can process all other messages.
4635
4636 However, we skip all this if the message results from calling
4637 TrackPopupMenu - in fact, we must NOT attempt to send the lisp
4638 thread a message because it is blocked on us at this point. We
4639 set menubar_active before calling TrackPopupMenu to indicate
4640 this (there is no possibility of confusion with real menubar
4641 being active). */
4642
4643 f = x_window_to_frame (dpyinfo, hwnd);
4644 if (f
4645 && (f->output_data.w32->menubar_active
4646 /* We can receive this message even in the absence of a
4647 menubar (ie. when the system menu is activated) - in this
4648 case we do NOT want to forward the message, otherwise it
4649 will cause the menubar to suddenly appear when the user
4650 had requested it to be turned off! */
4651 || f->output_data.w32->menubar_widget == NULL))
4652 return 0;
4653
4654 {
4655 deferred_msg msg_buf;
4656
4657 /* Detect if message has already been deferred; in this case
4658 we cannot return any sensible value to ignore this. */
4659 if (find_deferred_msg (hwnd, msg) != NULL)
4660 abort ();
4661
4662 return send_deferred_msg (&msg_buf, hwnd, msg, wParam, lParam);
4663 }
4664
4665 case WM_EXITMENULOOP:
4666 f = x_window_to_frame (dpyinfo, hwnd);
4667
4668 /* Indicate that menubar can be modified again. */
4669 if (f)
4670 f->output_data.w32->menubar_active = 0;
4671 goto dflt;
4672
126f2e35
JR		 4673 case WM_MENUSELECT:
4674 wmsg.dwModifiers = w32_get_modifiers ();
4675 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4676 return 0;
4677
87996783
GV		 4678 case WM_MEASUREITEM:
4679 f = x_window_to_frame (dpyinfo, hwnd);
4680 if (f)
4681 {
4682 MEASUREITEMSTRUCT * pMis = (MEASUREITEMSTRUCT *) lParam;
4683
4684 if (pMis->CtlType == ODT_MENU)
4685 {
4686 /* Work out dimensions for popup menu titles. */
4687 char * title = (char *) pMis->itemData;
4688 HDC hdc = GetDC (hwnd);
4689 HFONT menu_font = GetCurrentObject (hdc, OBJ_FONT);
4690 LOGFONT menu_logfont;
4691 HFONT old_font;
4692 SIZE size;
4693
4694 GetObject (menu_font, sizeof (menu_logfont), &menu_logfont);
4695 menu_logfont.lfWeight = FW_BOLD;
4696 menu_font = CreateFontIndirect (&menu_logfont);
4697 old_font = SelectObject (hdc, menu_font);
4698
dfff8a69
JR		 4699 pMis->itemHeight = GetSystemMetrics (SM_CYMENUSIZE);
4700 if (title)
4701 {
4702 GetTextExtentPoint32 (hdc, title, strlen (title), &size);
4703 pMis->itemWidth = size.cx;
4704 if (pMis->itemHeight < size.cy)
4705 pMis->itemHeight = size.cy;
4706 }
4707 else
4708 pMis->itemWidth = 0;
87996783
GV		 4709
4710 SelectObject (hdc, old_font);
4711 DeleteObject (menu_font);
4712 ReleaseDC (hwnd, hdc);
4713 return TRUE;
4714 }
4715 }
4716 return 0;
4717
4718 case WM_DRAWITEM:
4719 f = x_window_to_frame (dpyinfo, hwnd);
4720 if (f)
4721 {
4722 DRAWITEMSTRUCT * pDis = (DRAWITEMSTRUCT *) lParam;
4723
4724 if (pDis->CtlType == ODT_MENU)
4725 {
4726 /* Draw popup menu title. */
4727 char * title = (char *) pDis->itemData;
212da13b
JR		 4728 if (title)
4729 {
4730 HDC hdc = pDis->hDC;
4731 HFONT menu_font = GetCurrentObject (hdc, OBJ_FONT);
4732 LOGFONT menu_logfont;
4733 HFONT old_font;
4734
4735 GetObject (menu_font, sizeof (menu_logfont), &menu_logfont);
4736 menu_logfont.lfWeight = FW_BOLD;
4737 menu_font = CreateFontIndirect (&menu_logfont);
4738 old_font = SelectObject (hdc, menu_font);
4739
4740 /* Always draw title as if not selected. */
4741 ExtTextOut (hdc,
4742 pDis->rcItem.left
4743 + GetSystemMetrics (SM_CXMENUCHECK),
4744 pDis->rcItem.top,
4745 ETO_OPAQUE, &pDis->rcItem,
4746 title, strlen (title), NULL);
4747
4748 SelectObject (hdc, old_font);
4749 DeleteObject (menu_font);
4750 }
87996783
GV		 4751 return TRUE;
4752 }
4753 }
4754 return 0;
4755
1edf84e7
GV		 4756#if 0
4757 /* Still not right - can't distinguish between clicks in the
4758 client area of the frame from clicks forwarded from the scroll
4759 bars - may have to hook WM_NCHITTEST to remember the mouse
4760 position and then check if it is in the client area ourselves. */
4761 case WM_MOUSEACTIVATE:
4762 /* Discard the mouse click that activates a frame, allowing the
4763 user to click anywhere without changing point (or worse!).
4764 Don't eat mouse clicks on scrollbars though!! */
4765 if (LOWORD (lParam) == HTCLIENT )
4766 return MA_ACTIVATEANDEAT;
4767 goto dflt;
4768#endif
4769
1edf84e7 4770 case WM_ACTIVATEAPP:
ccc2d29c 4771 case WM_ACTIVATE:
1edf84e7
GV		 4772 case WM_WINDOWPOSCHANGED:
4773 case WM_SHOWWINDOW:
4774 /* Inform lisp thread that a frame might have just been obscured
4775 or exposed, so should recheck visibility of all frames. */
4776 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4777 goto dflt;
4778
da36a4d6 4779 case WM_SETFOCUS:
adcc3809
GV		 4780 dpyinfo->faked_key = 0;
4781 reset_modifiers ();
ccc2d29c
GV		 4782 register_hot_keys (hwnd);
4783 goto command;
8681157a 4784 case WM_KILLFOCUS:
ccc2d29c 4785 unregister_hot_keys (hwnd);
487163ac
AI		 4786 button_state = 0;
4787 ReleaseCapture ();
ee78dc32
GV		 4788 case WM_MOVE:
4789 case WM_SIZE:
ee78dc32 4790 case WM_COMMAND:
ccc2d29c 4791 command:
fbd6baed 4792 wmsg.dwModifiers = w32_get_modifiers ();
ee78dc32
GV		 4793 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4794 goto dflt;
8847d890
RS		 4795
4796 case WM_CLOSE:
fbd6baed 4797 wmsg.dwModifiers = w32_get_modifiers ();
8847d890
RS		 4798 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4799 return 0;
4800
ee78dc32
GV		 4801 case WM_WINDOWPOSCHANGING:
4802 {
4803 WINDOWPLACEMENT wp;
4804 LPWINDOWPOS lppos = (WINDOWPOS *) lParam;
1edf84e7
GV		 4805
4806 wp.length = sizeof (WINDOWPLACEMENT);
ee78dc32
GV		 4807 GetWindowPlacement (hwnd, &wp);
4808
1edf84e7 4809 if (wp.showCmd != SW_SHOWMINIMIZED && (lppos->flags & SWP_NOSIZE) == 0)
ee78dc32
GV		 4810 {
4811 RECT rect;
4812 int wdiff;
4813 int hdiff;
1edf84e7
GV		 4814 DWORD font_width;
4815 DWORD line_height;
4816 DWORD internal_border;
4817 DWORD scrollbar_extra;
ee78dc32
GV		 4818 RECT wr;
4819
5ac45f98 4820 wp.length = sizeof(wp);
ee78dc32
GV		 4821 GetWindowRect (hwnd, &wr);
4822
3c190163 4823 enter_crit ();
ee78dc32 4824
1edf84e7
GV		 4825 font_width = GetWindowLong (hwnd, WND_FONTWIDTH_INDEX);
4826 line_height = GetWindowLong (hwnd, WND_LINEHEIGHT_INDEX);
4827 internal_border = GetWindowLong (hwnd, WND_BORDER_INDEX);
4828 scrollbar_extra = GetWindowLong (hwnd, WND_SCROLLBAR_INDEX);
ee78dc32 4829
3c190163 4830 leave_crit ();
ee78dc32
GV		 4831
4832 memset (&rect, 0, sizeof (rect));
4833 AdjustWindowRect (&rect, GetWindowLong (hwnd, GWL_STYLE),
4834 GetMenu (hwnd) != NULL);
4835
1edf84e7
GV		 4836 /* Force width and height of client area to be exact
4837 multiples of the character cell dimensions. */
4838 wdiff = (lppos->cx - (rect.right - rect.left)
4839 - 2 * internal_border - scrollbar_extra)
4840 % font_width;
4841 hdiff = (lppos->cy - (rect.bottom - rect.top)
4842 - 2 * internal_border)
4843 % line_height;
ee78dc32
GV		 4844
4845 if (wdiff || hdiff)
4846 {
4847 /* For right/bottom sizing we can just fix the sizes.
4848 However for top/left sizing we will need to fix the X
4849 and Y positions as well. */
4850
4851 lppos->cx -= wdiff;
4852 lppos->cy -= hdiff;
4853
4854 if (wp.showCmd != SW_SHOWMAXIMIZED
1edf84e7 4855 && (lppos->flags & SWP_NOMOVE) == 0)
ee78dc32
GV		 4856 {
4857 if (lppos->x != wr.left || lppos->y != wr.top)
4858 {
4859 lppos->x += wdiff;
4860 lppos->y += hdiff;
4861 }
4862 else
4863 {
4864 lppos->flags |= SWP_NOMOVE;
4865 }
4866 }
4867
1edf84e7 4868 return 0;
ee78dc32
GV		 4869 }
4870 }
4871 }
ee78dc32
GV		 4872
4873 goto dflt;
1edf84e7 4874
b1f918f8
GV		 4875 case WM_GETMINMAXINFO:
4876 /* Hack to correct bug that allows Emacs frames to be resized
4877 below the Minimum Tracking Size. */
4878 ((LPMINMAXINFO) lParam)->ptMinTrackSize.y++;
bf853fee
AI		 4879 /* Hack to allow resizing the Emacs frame above the screen size.
4880 Note that Windows 9x limits coordinates to 16-bits. */
4881 ((LPMINMAXINFO) lParam)->ptMaxTrackSize.x = 32767;
4882 ((LPMINMAXINFO) lParam)->ptMaxTrackSize.y = 32767;
b1f918f8
GV		 4883 return 0;
4884
1edf84e7
GV		 4885 case WM_EMACS_CREATESCROLLBAR:
4886 return (LRESULT) w32_createscrollbar ((struct frame *) wParam,
4887 (struct scroll_bar *) lParam);
4888
5ac45f98 4889 case WM_EMACS_SHOWWINDOW:
1edf84e7
GV		 4890 return ShowWindow ((HWND) wParam, (WPARAM) lParam);
4891
dfdb4047 4892 case WM_EMACS_SETFOREGROUND:
ce6059da
AI		 4893 {
4894 HWND foreground_window;
4895 DWORD foreground_thread, retval;
4896
4897 /* On NT 5.0, and apparently Windows 98, it is necessary to
4898 attach to the thread that currently has focus in order to
4899 pull the focus away from it. */
4900 foreground_window = GetForegroundWindow ();
4901 foreground_thread = GetWindowThreadProcessId (foreground_window, NULL);
4902 if (!foreground_window
4903 || foreground_thread == GetCurrentThreadId ()
4904 || !AttachThreadInput (GetCurrentThreadId (),
4905 foreground_thread, TRUE))
4906 foreground_thread = 0;
4907
4908 retval = SetForegroundWindow ((HWND) wParam);
4909
4910 /* Detach from the previous foreground thread. */
4911 if (foreground_thread)
4912 AttachThreadInput (GetCurrentThreadId (),
4913 foreground_thread, FALSE);
4914
4915 return retval;
4916 }
dfdb4047 4917
5ac45f98
GV		 4918 case WM_EMACS_SETWINDOWPOS:
4919 {
1edf84e7
GV		 4920 WINDOWPOS * pos = (WINDOWPOS *) wParam;
4921 return SetWindowPos (hwnd, pos->hwndInsertAfter,
5ac45f98
GV		 4922 pos->x, pos->y, pos->cx, pos->cy, pos->flags);
4923 }
1edf84e7 4924
ee78dc32 4925 case WM_EMACS_DESTROYWINDOW:
cb9e33d4 4926 DragAcceptFiles ((HWND) wParam, FALSE);
1edf84e7
GV		 4927 return DestroyWindow ((HWND) wParam);
4928
4929 case WM_EMACS_TRACKPOPUPMENU:
4930 {
4931 UINT flags;
4932 POINT *pos;
4933 int retval;
4934 pos = (POINT *)lParam;
4935 flags = TPM_CENTERALIGN;
4936 if (button_state & LMOUSE)
4937 flags |= TPM_LEFTBUTTON;
4938 else if (button_state & RMOUSE)
4939 flags |= TPM_RIGHTBUTTON;
4940
87996783
GV		 4941 /* Remember we did a SetCapture on the initial mouse down event,
4942 so for safety, we make sure the capture is cancelled now. */
4943 ReleaseCapture ();
490822ff 4944 button_state = 0;
87996783 4945
1edf84e7
GV		 4946 /* Use menubar_active to indicate that WM_INITMENU is from
4947 TrackPopupMenu below, and should be ignored. */
4948 f = x_window_to_frame (dpyinfo, hwnd);
4949 if (f)
4950 f->output_data.w32->menubar_active = 1;
4951
4952 if (TrackPopupMenu ((HMENU)wParam, flags, pos->x, pos->y,
4953 0, hwnd, NULL))
4954 {
4955 MSG amsg;
4956 /* Eat any mouse messages during popupmenu */
4957 while (PeekMessage (&amsg, hwnd, WM_MOUSEFIRST, WM_MOUSELAST,
4958 PM_REMOVE));
4959 /* Get the menu selection, if any */
4960 if (PeekMessage (&amsg, hwnd, WM_COMMAND, WM_COMMAND, PM_REMOVE))
4961 {
4962 retval = LOWORD (amsg.wParam);
4963 }
4964 else
4965 {
4966 retval = 0;
4967 }
1edf84e7
GV		 4968 }
4969 else
4970 {
4971 retval = -1;
4972 }
4973
4974 return retval;
4975 }
4976
ee78dc32 4977 default:
93fbe8b7
GV		 4978 /* Check for messages registered at runtime. */
4979 if (msg == msh_mousewheel)
4980 {
4981 wmsg.dwModifiers = w32_get_modifiers ();
4982 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4983 return 0;
4984 }
4985
ee78dc32
GV		 4986 dflt:
4987 return DefWindowProc (hwnd, msg, wParam, lParam);
4988 }
4989
1edf84e7
GV		 4990
4991 /* The most common default return code for handled messages is 0. */
4992 return 0;
ee78dc32
GV		 4993}
4994
4995void
4996my_create_window (f)
4997 struct frame * f;
4998{
4999 MSG msg;
5000
1edf84e7
GV		 5001 if (!PostThreadMessage (dwWindowsThreadId, WM_EMACS_CREATEWINDOW, (WPARAM)f, 0))
5002 abort ();
ee78dc32
GV		 5003 GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
5004}
5005
fbd6baed 5006/* Create and set up the w32 window for frame F. */
ee78dc32
GV		 5007
5008static void
fbd6baed 5009w32_window (f, window_prompting, minibuffer_only)
ee78dc32
GV		 5010 struct frame *f;
5011 long window_prompting;
5012 int minibuffer_only;
5013{
5014 BLOCK_INPUT;
5015
5016 /* Use the resource name as the top-level window name
5017 for looking up resources. Make a non-Lisp copy
5018 for the window manager, so GC relocation won't bother it.
5019
5020 Elsewhere we specify the window name for the window manager. */
5021
5022 {
5023 char *str = (char *) XSTRING (Vx_resource_name)->data;
5024 f->namebuf = (char *) xmalloc (strlen (str) + 1);
5025 strcpy (f->namebuf, str);
5026 }
5027
5028 my_create_window (f);
5029
5030 validate_x_resource_name ();
5031
5032 /* x_set_name normally ignores requests to set the name if the
5033 requested name is the same as the current name. This is the one
5034 place where that assumption isn't correct; f->name is set, but
5035 the server hasn't been told. */
5036 {
5037 Lisp_Object name;
5038 int explicit = f->explicit_name;
5039
5040 f->explicit_name = 0;
5041 name = f->name;
5042 f->name = Qnil;
5043 x_set_name (f, name, explicit);
5044 }
5045
5046 UNBLOCK_INPUT;
5047
5048 if (!minibuffer_only && FRAME_EXTERNAL_MENU_BAR (f))
5049 initialize_frame_menubar (f);
5050
fbd6baed 5051 if (FRAME_W32_WINDOW (f) == 0)
ee78dc32
GV		 5052 error ("Unable to create window");
5053}
5054
5055/* Handle the icon stuff for this window. Perhaps later we might
5056 want an x_set_icon_position which can be called interactively as
5057 well. */
5058
5059static void
5060x_icon (f, parms)
5061 struct frame *f;
5062 Lisp_Object parms;
5063{
5064 Lisp_Object icon_x, icon_y;
5065
e9e23e23 5066 /* Set the position of the icon. Note that Windows 95 groups all
ee78dc32 5067 icons in the tray. */
6fc2811b
JR		 5068 icon_x = w32_get_arg (parms, Qicon_left, 0, 0, RES_TYPE_NUMBER);
5069 icon_y = w32_get_arg (parms, Qicon_top, 0, 0, RES_TYPE_NUMBER);
ee78dc32
GV		 5070 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
5071 {
5072 CHECK_NUMBER (icon_x, 0);
5073 CHECK_NUMBER (icon_y, 0);
5074 }
5075 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
5076 error ("Both left and top icon corners of icon must be specified");
5077
5078 BLOCK_INPUT;
5079
5080 if (! EQ (icon_x, Qunbound))
5081 x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y));
5082
1edf84e7
GV		 5083#if 0 /* TODO */
5084 /* Start up iconic or window? */
5085 x_wm_set_window_state
6fc2811b 5086 (f, (EQ (w32_get_arg (parms, Qvisibility, 0, 0, RES_TYPE_SYMBOL), Qicon)
1edf84e7
GV		 5087 ? IconicState
5088 : NormalState));
5089
5090 x_text_icon (f, (char *) XSTRING ((!NILP (f->icon_name)
5091 ? f->icon_name
5092 : f->name))->data);
5093#endif
5094
ee78dc32
GV		 5095 UNBLOCK_INPUT;
5096}
5097
6fc2811b
JR		 5098
5099static void
5100x_make_gc (f)
5101 struct frame *f;
5102{
5103 XGCValues gc_values;
5104
5105 BLOCK_INPUT;
5106
5107 /* Create the GC's of this frame.
5108 Note that many default values are used. */
5109
5110 /* Normal video */
5111 gc_values.font = f->output_data.w32->font;
5112
5113 /* Cursor has cursor-color background, background-color foreground. */
5114 gc_values.foreground = FRAME_BACKGROUND_PIXEL (f);
5115 gc_values.background = f->output_data.w32->cursor_pixel;
5116 f->output_data.w32->cursor_gc
5117 = XCreateGC (NULL, FRAME_W32_WINDOW (f),
5118 (GCFont | GCForeground | GCBackground),
5119 &gc_values);
5120
5121 /* Reliefs. */
5122 f->output_data.w32->white_relief.gc = 0;
5123 f->output_data.w32->black_relief.gc = 0;
5124
5125 UNBLOCK_INPUT;
5126}
5127
5128
937e601e
AI		 5129/* Handler for signals raised during x_create_frame and
5130 x_create_top_frame. FRAME is the frame which is partially
5131 constructed. */
5132
5133static Lisp_Object
5134unwind_create_frame (frame)
5135 Lisp_Object frame;
5136{
5137 struct frame *f = XFRAME (frame);
5138
5139 /* If frame is ``official'', nothing to do. */
5140 if (!CONSP (Vframe_list) || !EQ (XCAR (Vframe_list), frame))
5141 {
5142#ifdef GLYPH_DEBUG
5143 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
5144#endif
5145
5146 x_free_frame_resources (f);
5147
5148 /* Check that reference counts are indeed correct. */
5149 xassert (dpyinfo->reference_count == dpyinfo_refcount);
5150 xassert (dpyinfo->image_cache->refcount == image_cache_refcount);
c844a81a
GM		 5151
5152 return Qt;
937e601e
AI		 5153 }
5154
5155 return Qnil;
5156}
5157
5158
ee78dc32
GV		 5159DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
5160 1, 1, 0,
5161 "Make a new window, which is called a \"frame\" in Emacs terms.\n\
5162Returns an Emacs frame object.\n\
5163ALIST is an alist of frame parameters.\n\
5164If the parameters specify that the frame should not have a minibuffer,\n\
5165and do not specify a specific minibuffer window to use,\n\
5166then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
5167be shared by the new frame.\n\
5168\n\
5169This function is an internal primitive--use `make-frame' instead.")
5170 (parms)
5171 Lisp_Object parms;
5172{
5173 struct frame *f;
5174 Lisp_Object frame, tem;
5175 Lisp_Object name;
5176 int minibuffer_only = 0;
5177 long window_prompting = 0;
5178 int width, height;
dc220243 5179 int count = BINDING_STACK_SIZE ();
1edf84e7 5180 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
ee78dc32 5181 Lisp_Object display;
6fc2811b 5182 struct w32_display_info *dpyinfo = NULL;
ee78dc32
GV		 5183 Lisp_Object parent;
5184 struct kboard *kb;
5185
4587b026
GV		 5186 check_w32 ();
5187
ee78dc32
GV		 5188 /* Use this general default value to start with
5189 until we know if this frame has a specified name. */
5190 Vx_resource_name = Vinvocation_name;
5191
6fc2811b 5192 display = w32_get_arg (parms, Qdisplay, 0, 0, RES_TYPE_STRING);
ee78dc32
GV		 5193 if (EQ (display, Qunbound))
5194 display = Qnil;
5195 dpyinfo = check_x_display_info (display);
5196#ifdef MULTI_KBOARD
5197 kb = dpyinfo->kboard;
5198#else
5199 kb = &the_only_kboard;
5200#endif
5201
6fc2811b 5202 name = w32_get_arg (parms, Qname, "name", "Name", RES_TYPE_STRING);
ee78dc32
GV		 5203 if (!STRINGP (name)
5204 && ! EQ (name, Qunbound)
5205 && ! NILP (name))
5206 error ("Invalid frame name--not a string or nil");
5207
5208 if (STRINGP (name))
5209 Vx_resource_name = name;
5210
5211 /* See if parent window is specified. */
6fc2811b 5212 parent = w32_get_arg (parms, Qparent_id, NULL, NULL, RES_TYPE_NUMBER);
ee78dc32
GV		 5213 if (EQ (parent, Qunbound))
5214 parent = Qnil;
5215 if (! NILP (parent))
5216 CHECK_NUMBER (parent, 0);
5217
1edf84e7
GV		 5218 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
5219 /* No need to protect DISPLAY because that's not used after passing
5220 it to make_frame_without_minibuffer. */
5221 frame = Qnil;
5222 GCPRO4 (parms, parent, name, frame);
1660f34a
JR		 5223 tem = w32_get_arg (parms, Qminibuffer, "minibuffer", "Minibuffer",
5224 RES_TYPE_SYMBOL);
ee78dc32
GV		 5225 if (EQ (tem, Qnone) || NILP (tem))
5226 f = make_frame_without_minibuffer (Qnil, kb, display);
5227 else if (EQ (tem, Qonly))
5228 {
5229 f = make_minibuffer_frame ();
5230 minibuffer_only = 1;
5231 }
5232 else if (WINDOWP (tem))
5233 f = make_frame_without_minibuffer (tem, kb, display);
5234 else
5235 f = make_frame (1);
5236
1edf84e7
GV		 5237 XSETFRAME (frame, f);
5238
ee78dc32
GV		 5239 /* Note that Windows does support scroll bars. */
5240 FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
5ac45f98
GV		 5241 /* By default, make scrollbars the system standard width. */
5242 f->scroll_bar_pixel_width = GetSystemMetrics (SM_CXVSCROLL);
ee78dc32 5243
fbd6baed 5244 f->output_method = output_w32;
6fc2811b
JR		 5245 f->output_data.w32 =
5246 (struct w32_output *) xmalloc (sizeof (struct w32_output));
fbd6baed 5247 bzero (f->output_data.w32, sizeof (struct w32_output));
4587b026 5248 FRAME_FONTSET (f) = -1;
937e601e 5249 record_unwind_protect (unwind_create_frame, frame);
4587b026 5250
1edf84e7 5251 f->icon_name
6fc2811b 5252 = w32_get_arg (parms, Qicon_name, "iconName", "Title", RES_TYPE_STRING);
1edf84e7
GV		 5253 if (! STRINGP (f->icon_name))
5254 f->icon_name = Qnil;
5255
fbd6baed 5256/* FRAME_W32_DISPLAY_INFO (f) = dpyinfo; */
ee78dc32
GV		 5257#ifdef MULTI_KBOARD
5258 FRAME_KBOARD (f) = kb;
5259#endif
5260
5261 /* Specify the parent under which to make this window. */
5262
5263 if (!NILP (parent))
5264 {
1660f34a 5265 f->output_data.w32->parent_desc = (Window) XFASTINT (parent);
fbd6baed 5266 f->output_data.w32->explicit_parent = 1;
ee78dc32
GV		 5267 }
5268 else
5269 {
fbd6baed
GV		 5270 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
5271 f->output_data.w32->explicit_parent = 0;
ee78dc32
GV		 5272 }
5273
ee78dc32
GV		 5274 /* Set the name; the functions to which we pass f expect the name to
5275 be set. */
5276 if (EQ (name, Qunbound) || NILP (name))
5277 {
fbd6baed 5278 f->name = build_string (dpyinfo->w32_id_name);
ee78dc32
GV		 5279 f->explicit_name = 0;
5280 }
5281 else
5282 {
5283 f->name = name;
5284 f->explicit_name = 1;
5285 /* use the frame's title when getting resources for this frame. */
5286 specbind (Qx_resource_name, name);
5287 }
5288
5289 /* Extract the window parameters from the supplied values
5290 that are needed to determine window geometry. */
5291 {
5292 Lisp_Object font;
5293
6fc2811b
JR		 5294 font = w32_get_arg (parms, Qfont, "font", "Font", RES_TYPE_STRING);
5295
ee78dc32
GV		 5296 BLOCK_INPUT;
5297 /* First, try whatever font the caller has specified. */
5298 if (STRINGP (font))
4587b026
GV		 5299 {
5300 tem = Fquery_fontset (font, Qnil);
5301 if (STRINGP (tem))
5302 font = x_new_fontset (f, XSTRING (tem)->data);
5303 else
1075afa9 5304 font = x_new_font (f, XSTRING (font)->data);
4587b026 5305 }
ee78dc32
GV		 5306 /* Try out a font which we hope has bold and italic variations. */
5307 if (!STRINGP (font))
e39649be 5308 font = x_new_font (f, "-*-Courier New-normal-r-*-*-*-100-*-*-c-*-iso8859-1");
ee78dc32 5309 if (! STRINGP (font))
6fc2811b 5310 font = x_new_font (f, "-*-Courier-normal-r-*-*-13-*-*-*-c-*-iso8859-1");
ee78dc32
GV		 5311 /* If those didn't work, look for something which will at least work. */
5312 if (! STRINGP (font))
6fc2811b 5313 font = x_new_font (f, "-*-Fixedsys-normal-r-*-*-12-*-*-*-c-*-iso8859-1");
ee78dc32
GV		 5314 UNBLOCK_INPUT;
5315 if (! STRINGP (font))
1edf84e7 5316 font = build_string ("Fixedsys");
ee78dc32
GV		 5317
5318 x_default_parameter (f, parms, Qfont, font,
6fc2811b 5319 "font", "Font", RES_TYPE_STRING);
ee78dc32
GV		 5320 }
5321
5322 x_default_parameter (f, parms, Qborder_width, make_number (2),
1660f34a 5323 "borderWidth", "BorderWidth", RES_TYPE_NUMBER);
ee78dc32
GV		 5324 /* This defaults to 2 in order to match xterm. We recognize either
5325 internalBorderWidth or internalBorder (which is what xterm calls
5326 it). */
5327 if (NILP (Fassq (Qinternal_border_width, parms)))
5328 {
5329 Lisp_Object value;
5330
6fc2811b 5331 value = w32_get_arg (parms, Qinternal_border_width,
1660f34a 5332 "internalBorder", "InternalBorder", RES_TYPE_NUMBER);
ee78dc32
GV		 5333 if (! EQ (value, Qunbound))
5334 parms = Fcons (Fcons (Qinternal_border_width, value),
5335 parms);
5336 }
1edf84e7 5337 /* Default internalBorderWidth to 0 on Windows to match other programs. */
ee78dc32 5338 x_default_parameter (f, parms, Qinternal_border_width, make_number (0),
1660f34a
JR		 5339 "internalBorderWidth", "InternalBorder", RES_TYPE_NUMBER);
5340 x_default_parameter (f, parms, Qvertical_scroll_bars, Qright,
5341 "verticalScrollBars", "ScrollBars", RES_TYPE_SYMBOL);
ee78dc32
GV		 5342
5343 /* Also do the stuff which must be set before the window exists. */
5344 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
6fc2811b 5345 "foreground", "Foreground", RES_TYPE_STRING);
ee78dc32 5346 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
6fc2811b 5347 "background", "Background", RES_TYPE_STRING);
ee78dc32 5348 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
6fc2811b 5349 "pointerColor", "Foreground", RES_TYPE_STRING);
ee78dc32 5350 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
6fc2811b 5351 "cursorColor", "Foreground", RES_TYPE_STRING);
ee78dc32 5352 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
6fc2811b
JR		 5353 "borderColor", "BorderColor", RES_TYPE_STRING);
5354 x_default_parameter (f, parms, Qscreen_gamma, Qnil,
5355 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT);
dfff8a69
JR		 5356 x_default_parameter (f, parms, Qline_spacing, Qnil,
5357 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER);
6fc2811b 5358
ee78dc32 5359
6fc2811b
JR		 5360 /* Init faces before x_default_parameter is called for scroll-bar
5361 parameters because that function calls x_set_scroll_bar_width,
5362 which calls change_frame_size, which calls Fset_window_buffer,
5363 which runs hooks, which call Fvertical_motion. At the end, we
5364 end up in init_iterator with a null face cache, which should not
5365 happen. */
5366 init_frame_faces (f);
5367
ee78dc32 5368 x_default_parameter (f, parms, Qmenu_bar_lines, make_number (1),
6fc2811b
JR		 5369 "menuBar", "MenuBar", RES_TYPE_NUMBER);
5370 x_default_parameter (f, parms, Qtool_bar_lines, make_number (0),
5371 "toolBar", "ToolBar", RES_TYPE_NUMBER);
1edf84e7 5372 x_default_parameter (f, parms, Qbuffer_predicate, Qnil,
6fc2811b 5373 "bufferPredicate", "BufferPredicate", RES_TYPE_SYMBOL);
1edf84e7 5374 x_default_parameter (f, parms, Qtitle, Qnil,
6fc2811b 5375 "title", "Title", RES_TYPE_STRING);
ee78dc32 5376
fbd6baed
GV		 5377 f->output_data.w32->dwStyle = WS_OVERLAPPEDWINDOW;
5378 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
3cf3436e
JR		 5379
5380 /* Add the tool-bar height to the initial frame height so that the
5381 user gets a text display area of the size he specified with -g or
5382 via .Xdefaults. Later changes of the tool-bar height don't
5383 change the frame size. This is done so that users can create
5384 tall Emacs frames without having to guess how tall the tool-bar
5385 will get. */
5386 if (FRAME_TOOL_BAR_LINES (f))
5387 {
5388 int margin, relief, bar_height;
5389
5390 relief = (tool_bar_button_relief > 0
5391 ? tool_bar_button_relief
5392 : DEFAULT_TOOL_BAR_BUTTON_RELIEF);
5393
5394 if (INTEGERP (Vtool_bar_button_margin)
5395 && XINT (Vtool_bar_button_margin) > 0)
5396 margin = XFASTINT (Vtool_bar_button_margin);
5397 else if (CONSP (Vtool_bar_button_margin)
5398 && INTEGERP (XCDR (Vtool_bar_button_margin))
5399 && XINT (XCDR (Vtool_bar_button_margin)) > 0)
5400 margin = XFASTINT (XCDR (Vtool_bar_button_margin));
5401 else
5402 margin = 0;
5403
5404 bar_height = DEFAULT_TOOL_BAR_IMAGE_HEIGHT + 2 * margin + 2 * relief;
5405 f->height += (bar_height + CANON_Y_UNIT (f) - 1) / CANON_Y_UNIT (f);
5406 }
5407
ee78dc32
GV		 5408 window_prompting = x_figure_window_size (f, parms);
5409
5410 if (window_prompting & XNegative)
5411 {
5412 if (window_prompting & YNegative)
fbd6baed 5413 f->output_data.w32->win_gravity = SouthEastGravity;
ee78dc32 5414 else
fbd6baed 5415 f->output_data.w32->win_gravity = NorthEastGravity;
ee78dc32
GV		 5416 }
5417 else
5418 {
5419 if (window_prompting & YNegative)
fbd6baed 5420 f->output_data.w32->win_gravity = SouthWestGravity;
ee78dc32 5421 else
fbd6baed 5422 f->output_data.w32->win_gravity = NorthWestGravity;
ee78dc32
GV		 5423 }
5424
fbd6baed 5425 f->output_data.w32->size_hint_flags = window_prompting;
ee78dc32 5426
6fc2811b
JR		 5427 tem = w32_get_arg (parms, Qunsplittable, 0, 0, RES_TYPE_BOOLEAN);
5428 f->no_split = minibuffer_only || EQ (tem, Qt);
5429
fbd6baed 5430 w32_window (f, window_prompting, minibuffer_only);
ee78dc32 5431 x_icon (f, parms);
6fc2811b
JR		 5432
5433 x_make_gc (f);
5434
5435 /* Now consider the frame official. */
5436 FRAME_W32_DISPLAY_INFO (f)->reference_count++;
5437 Vframe_list = Fcons (frame, Vframe_list);
ee78dc32
GV		 5438
5439 /* We need to do this after creating the window, so that the
5440 icon-creation functions can say whose icon they're describing. */
5441 x_default_parameter (f, parms, Qicon_type, Qnil,
6fc2811b 5442 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL);
ee78dc32
GV		 5443
5444 x_default_parameter (f, parms, Qauto_raise, Qnil,
6fc2811b 5445 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
ee78dc32 5446 x_default_parameter (f, parms, Qauto_lower, Qnil,
6fc2811b 5447 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
ee78dc32 5448 x_default_parameter (f, parms, Qcursor_type, Qbox,
6fc2811b
JR		 5449 "cursorType", "CursorType", RES_TYPE_SYMBOL);
5450 x_default_parameter (f, parms, Qscroll_bar_width, Qnil,
5451 "scrollBarWidth", "ScrollBarWidth", RES_TYPE_NUMBER);
ee78dc32
GV		 5452
5453 /* Dimensions, especially f->height, must be done via change_frame_size.
5454 Change will not be effected unless different from the current
5455 f->height. */
5456 width = f->width;
5457 height = f->height;
dc220243 5458
1026b400
RS		 5459 f->height = 0;
5460 SET_FRAME_WIDTH (f, 0);
6fc2811b
JR		 5461 change_frame_size (f, height, width, 1, 0, 0);
5462
6fc2811b
JR		 5463 /* Tell the server what size and position, etc, we want, and how
5464 badly we want them. This should be done after we have the menu
5465 bar so that its size can be taken into account. */
ee78dc32
GV		 5466 BLOCK_INPUT;
5467 x_wm_set_size_hint (f, window_prompting, 0);
5468 UNBLOCK_INPUT;
5469
4694d762
JR		 5470 /* Set up faces after all frame parameters are known. This call
5471 also merges in face attributes specified for new frames. If we
5472 don't do this, the `menu' face for instance won't have the right
5473 colors, and the menu bar won't appear in the specified colors for
5474 new frames. */
5475 call1 (Qface_set_after_frame_default, frame);
5476
6fc2811b
JR		 5477 /* Make the window appear on the frame and enable display, unless
5478 the caller says not to. However, with explicit parent, Emacs
5479 cannot control visibility, so don't try. */
fbd6baed 5480 if (! f->output_data.w32->explicit_parent)
ee78dc32
GV		 5481 {
5482 Lisp_Object visibility;
5483
6fc2811b 5484 visibility = w32_get_arg (parms, Qvisibility, 0, 0, RES_TYPE_SYMBOL);
ee78dc32
GV		 5485 if (EQ (visibility, Qunbound))
5486 visibility = Qt;
5487
5488 if (EQ (visibility, Qicon))
5489 x_iconify_frame (f);
5490 else if (! NILP (visibility))
5491 x_make_frame_visible (f);
5492 else
5493 /* Must have been Qnil. */
5494 ;
5495 }
6fc2811b 5496 UNGCPRO;
9e57df62
GM		 5497
5498 /* Make sure windows on this frame appear in calls to next-window
5499 and similar functions. */
5500 Vwindow_list = Qnil;
5501
ee78dc32
GV		 5502 return unbind_to (count, frame);
5503}
5504
5505/* FRAME is used only to get a handle on the X display. We don't pass the
5506 display info directly because we're called from frame.c, which doesn't
5507 know about that structure. */
5508Lisp_Object
5509x_get_focus_frame (frame)
5510 struct frame *frame;
5511{
fbd6baed 5512 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (frame);
ee78dc32 5513 Lisp_Object xfocus;
fbd6baed 5514 if (! dpyinfo->w32_focus_frame)
ee78dc32
GV		 5515 return Qnil;
5516
fbd6baed 5517 XSETFRAME (xfocus, dpyinfo->w32_focus_frame);
ee78dc32
GV		 5518 return xfocus;
5519}
1edf84e7
GV		 5520
5521DEFUN ("w32-focus-frame", Fw32_focus_frame, Sw32_focus_frame, 1, 1, 0,
5522 "Give FRAME input focus, raising to foreground if necessary.")
5523 (frame)
5524 Lisp_Object frame;
5525{
5526 x_focus_on_frame (check_x_frame (frame));
5527 return Qnil;
5528}
5529
ee78dc32 5530\f
767b1ff0
JR		 5531/* Return the charset portion of a font name. */
5532char * xlfd_charset_of_font (char * fontname)
5533{
5534 char *charset, *encoding;
5535
5536 encoding = strrchr(fontname, '-');
ceb12877 5537 if (!encoding || encoding == fontname)
767b1ff0
JR		 5538 return NULL;
5539
478ea067
AI		 5540 for (charset = encoding - 1; charset >= fontname; charset--)
5541 if (*charset == '-')
5542 break;
767b1ff0 5543
478ea067 5544 if (charset == fontname || strcmp(charset, "-*-*") == 0)
767b1ff0
JR		 5545 return NULL;
5546
5547 return charset + 1;
5548}
5549
33d52f9c
GV		 5550struct font_info *w32_load_bdf_font (struct frame *f, char *fontname,
5551 int size, char* filename);
8edb0a6f 5552static Lisp_Object w32_list_bdf_fonts (Lisp_Object pattern, int max_names);
c7501041
EZ		 5553static BOOL w32_to_x_font (LOGFONT * lplf, char * lpxstr, int len,
5554 char * charset);
5555static BOOL x_to_w32_font (char *lpxstr, LOGFONT *lplogfont);
33d52f9c 5556
8edb0a6f 5557static struct font_info *
33d52f9c 5558w32_load_system_font (f,fontname,size)
55dcfc15
AI		 5559 struct frame *f;
5560 char * fontname;
5561 int size;
ee78dc32 5562{
4587b026
GV		 5563 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
5564 Lisp_Object font_names;
5565
4587b026
GV		 5566 /* Get a list of all the fonts that match this name. Once we
5567 have a list of matching fonts, we compare them against the fonts
5568 we already have loaded by comparing names. */
5569 font_names = w32_list_fonts (f, build_string (fontname), size, 100);
5570
5571 if (!NILP (font_names))
3c190163 5572 {
4587b026
GV		 5573 Lisp_Object tail;
5574 int i;
4587b026
GV		 5575
5576 /* First check if any are already loaded, as that is cheaper
5577 than loading another one. */
5578 for (i = 0; i < dpyinfo->n_fonts; i++)
8e713be6 5579 for (tail = font_names; CONSP (tail); tail = XCDR (tail))
6fc2811b
JR		 5580 if (dpyinfo->font_table[i].name
5581 && (!strcmp (dpyinfo->font_table[i].name,
5582 XSTRING (XCAR (tail))->data)
5583 || !strcmp (dpyinfo->font_table[i].full_name,
5584 XSTRING (XCAR (tail))->data)))
4587b026 5585 return (dpyinfo->font_table + i);
6fc2811b 5586
8e713be6 5587 fontname = (char *) XSTRING (XCAR (font_names))->data;
4587b026 5588 }
1075afa9 5589 else if (w32_strict_fontnames)
5ca0cd71
GV		 5590 {
5591 /* If EnumFontFamiliesEx was available, we got a full list of
5592 fonts back so stop now to avoid the possibility of loading a
5593 random font. If we had to fall back to EnumFontFamilies, the
5594 list is incomplete, so continue whether the font we want was
5595 listed or not. */
5596 HMODULE gdi32 = GetModuleHandle ("gdi32.dll");
5597 FARPROC enum_font_families_ex
1075afa9 5598 = GetProcAddress (gdi32, "EnumFontFamiliesExA");
5ca0cd71
GV		 5599 if (enum_font_families_ex)
5600 return NULL;
5601 }
4587b026
GV		 5602
5603 /* Load the font and add it to the table. */
5604 {
767b1ff0 5605 char *full_name, *encoding, *charset;
4587b026
GV		 5606 XFontStruct *font;
5607 struct font_info *fontp;
3c190163 5608 LOGFONT lf;
4587b026 5609 BOOL ok;
19c291d3 5610 int codepage;
6fc2811b 5611 int i;
5ac45f98 5612
4587b026 5613 if (!fontname || !x_to_w32_font (fontname, &lf))
3c190163 5614 return (NULL);
5ac45f98 5615
4587b026
GV		 5616 if (!*lf.lfFaceName)
5617 /* If no name was specified for the font, we get a random font
5618 from CreateFontIndirect - this is not particularly
5619 desirable, especially since CreateFontIndirect does not
5620 fill out the missing name in lf, so we never know what we
5621 ended up with. */
5622 return NULL;
5623
3c190163 5624 font = (XFontStruct *) xmalloc (sizeof (XFontStruct));
c6be3860 5625 bzero (font, sizeof (*font));
5ac45f98 5626
33d52f9c
GV		 5627 /* Set bdf to NULL to indicate that this is a Windows font. */
5628 font->bdf = NULL;
5ac45f98 5629
3c190163 5630 BLOCK_INPUT;
5ac45f98
GV		 5631
5632 font->hfont = CreateFontIndirect (&lf);
ee78dc32 5633
1a292d24
AI		 5634 if (font->hfont == NULL)
5635 {
5636 ok = FALSE;
5637 }
5638 else
5639 {
5640 HDC hdc;
5641 HANDLE oldobj;
19c291d3
AI		 5642
5643 codepage = w32_codepage_for_font (fontname);
1a292d24
AI		 5644
5645 hdc = GetDC (dpyinfo->root_window);
5646 oldobj = SelectObject (hdc, font->hfont);
5c6682be 5647
1a292d24 5648 ok = GetTextMetrics (hdc, &font->tm);
5c6682be
JR		 5649 if (codepage == CP_UNICODE)
5650 font->double_byte_p = 1;
5651 else
8b77111c
AI		 5652 {
5653 /* Unfortunately, some fonts (eg. MingLiU, a big5 ttf font)
5654 don't report themselves as double byte fonts, when
5655 patently they are. So instead of trusting
5656 GetFontLanguageInfo, we check the properties of the
5657 codepage directly, since that is ultimately what we are
5658 working from anyway. */
5659 /* font->double_byte_p = GetFontLanguageInfo(hdc) & GCP_DBCS; */
5660 CPINFO cpi = {0};
5661 GetCPInfo (codepage, &cpi);
5662 font->double_byte_p = cpi.MaxCharSize > 1;
5663 }
5c6682be 5664
1a292d24
AI		 5665 SelectObject (hdc, oldobj);
5666 ReleaseDC (dpyinfo->root_window, hdc);
6fc2811b
JR		 5667 /* Fill out details in lf according to the font that was
5668 actually loaded. */
5669 lf.lfHeight = font->tm.tmInternalLeading - font->tm.tmHeight;
5670 lf.lfWidth = font->tm.tmAveCharWidth;
5671 lf.lfWeight = font->tm.tmWeight;
5672 lf.lfItalic = font->tm.tmItalic;
5673 lf.lfCharSet = font->tm.tmCharSet;
5674 lf.lfPitchAndFamily = ((font->tm.tmPitchAndFamily & TMPF_FIXED_PITCH)
d88c567c 5675 ? VARIABLE_PITCH : FIXED_PITCH);
6fc2811b
JR		 5676 lf.lfOutPrecision = ((font->tm.tmPitchAndFamily & TMPF_VECTOR)
5677 ? OUT_STROKE_PRECIS : OUT_STRING_PRECIS);
c6be3860
AI		 5678
5679 w32_cache_char_metrics (font);
1a292d24 5680 }
5ac45f98 5681
1a292d24 5682 UNBLOCK_INPUT;
5ac45f98 5683
4587b026
GV		 5684 if (!ok)
5685 {
1a292d24
AI		 5686 w32_unload_font (dpyinfo, font);
5687 return (NULL);
5688 }
ee78dc32 5689
6fc2811b
JR		 5690 /* Find a free slot in the font table. */
5691 for (i = 0; i < dpyinfo->n_fonts; ++i)
5692 if (dpyinfo->font_table[i].name == NULL)
5693 break;
5694
5695 /* If no free slot found, maybe enlarge the font table. */
5696 if (i == dpyinfo->n_fonts
5697 && dpyinfo->n_fonts == dpyinfo->font_table_size)
4587b026 5698 {
6fc2811b
JR		 5699 int sz;
5700 dpyinfo->font_table_size = max (16, 2 * dpyinfo->font_table_size);
5701 sz = dpyinfo->font_table_size * sizeof *dpyinfo->font_table;
4587b026 5702 dpyinfo->font_table
6fc2811b 5703 = (struct font_info *) xrealloc (dpyinfo->font_table, sz);
4587b026
GV		 5704 }
5705
6fc2811b
JR		 5706 fontp = dpyinfo->font_table + i;
5707 if (i == dpyinfo->n_fonts)
5708 ++dpyinfo->n_fonts;
4587b026
GV		 5709
5710 /* Now fill in the slots of *FONTP. */
5711 BLOCK_INPUT;
5712 fontp->font = font;
6fc2811b 5713 fontp->font_idx = i;
4587b026
GV		 5714 fontp->name = (char *) xmalloc (strlen (fontname) + 1);
5715 bcopy (fontname, fontp->name, strlen (fontname) + 1);
5716
767b1ff0
JR		 5717 charset = xlfd_charset_of_font (fontname);
5718
19c291d3
AI		 5719 /* Cache the W32 codepage for a font. This makes w32_encode_char
5720 (called for every glyph during redisplay) much faster. */
5721 fontp->codepage = codepage;
5722
4587b026
GV		 5723 /* Work out the font's full name. */
5724 full_name = (char *)xmalloc (100);
767b1ff0 5725 if (full_name && w32_to_x_font (&lf, full_name, 100, charset))
4587b026
GV		 5726 fontp->full_name = full_name;
5727 else
5728 {
5729 /* If all else fails - just use the name we used to load it. */
5730 xfree (full_name);
5731 fontp->full_name = fontp->name;
5732 }
5733
5734 fontp->size = FONT_WIDTH (font);
5735 fontp->height = FONT_HEIGHT (font);
5736
5737 /* The slot `encoding' specifies how to map a character
5738 code-points (0x20..0x7F or 0x2020..0x7F7F) of each charset to
126f2e35
JR		 5739 the font code-points (0:0x20..0x7F, 1:0xA0..0xFF), or
5740 (0:0x20..0x7F, 1:0xA0..0xFF,
5741 (0:0x2020..0x7F7F, 1:0xA0A0..0xFFFF, 3:0x20A0..0x7FFF,
4587b026 5742 2:0xA020..0xFF7F). For the moment, we don't know which charset
6fc2811b 5743 uses this font. So, we set information in fontp->encoding[1]
4587b026
GV		 5744 which is never used by any charset. If mapping can't be
5745 decided, set FONT_ENCODING_NOT_DECIDED. */
33d52f9c
GV		 5746
5747 /* SJIS fonts need to be set to type 4, all others seem to work as
5748 type FONT_ENCODING_NOT_DECIDED. */
5749 encoding = strrchr (fontp->name, '-');
5750 if (encoding && stricmp (encoding+1, "sjis") == 0)
1c885fe1 5751 fontp->encoding[1] = 4;
33d52f9c 5752 else
1c885fe1 5753 fontp->encoding[1] = FONT_ENCODING_NOT_DECIDED;
4587b026
GV		 5754
5755 /* The following three values are set to 0 under W32, which is
5756 what they get set to if XGetFontProperty fails under X. */
5757 fontp->baseline_offset = 0;
5758 fontp->relative_compose = 0;
33d52f9c 5759 fontp->default_ascent = 0;
4587b026 5760
6fc2811b
JR		 5761 /* Set global flag fonts_changed_p to non-zero if the font loaded
5762 has a character with a smaller width than any other character
5763 before, or if the font loaded has a smalle>r height than any
5764 other font loaded before. If this happens, it will make a
5765 glyph matrix reallocation necessary. */
5766 fonts_changed_p = x_compute_min_glyph_bounds (f);
4587b026 5767 UNBLOCK_INPUT;
4587b026
GV		 5768 return fontp;
5769 }
5770}
5771
33d52f9c
GV		 5772/* Load font named FONTNAME of size SIZE for frame F, and return a
5773 pointer to the structure font_info while allocating it dynamically.
5774 If loading fails, return NULL. */
5775struct font_info *
5776w32_load_font (f,fontname,size)
5777struct frame *f;
5778char * fontname;
5779int size;
5780{
5781 Lisp_Object bdf_fonts;
5782 struct font_info *retval = NULL;
5783
8edb0a6f 5784 bdf_fonts = w32_list_bdf_fonts (build_string (fontname), 1);
33d52f9c
GV		 5785
5786 while (!retval && CONSP (bdf_fonts))
5787 {
5788 char *bdf_name, *bdf_file;
5789 Lisp_Object bdf_pair;
5790
8e713be6
KR		 5791 bdf_name = XSTRING (XCAR (bdf_fonts))->data;
5792 bdf_pair = Fassoc (XCAR (bdf_fonts), Vw32_bdf_filename_alist);
5793 bdf_file = XSTRING (XCDR (bdf_pair))->data;
33d52f9c
GV		 5794
5795 retval = w32_load_bdf_font (f, bdf_name, size, bdf_file);
5796
8e713be6 5797 bdf_fonts = XCDR (bdf_fonts);
33d52f9c
GV		 5798 }
5799
5800 if (retval)
5801 return retval;
5802
5803 return w32_load_system_font(f, fontname, size);
5804}
5805
5806
ee78dc32 5807void
fbd6baed
GV		 5808w32_unload_font (dpyinfo, font)
5809 struct w32_display_info *dpyinfo;
ee78dc32
GV		 5810 XFontStruct * font;
5811{
5812 if (font)
5813 {
c6be3860 5814 if (font->per_char) xfree (font->per_char);
33d52f9c
GV		 5815 if (font->bdf) w32_free_bdf_font (font->bdf);
5816
3c190163 5817 if (font->hfont) DeleteObject(font->hfont);
ee78dc32
GV		 5818 xfree (font);
5819 }
5820}
5821
fbd6baed 5822/* The font conversion stuff between x and w32 */
ee78dc32
GV		 5823
5824/* X font string is as follows (from faces.el)
5825 * (let ((- "[-?]")
5826 * (foundry "[^-]+")
5827 * (family "[^-]+")
5828 * (weight "\\(bold\\|demibold\\|medium\\)") ; 1
5829 * (weight\? "\\([^-]*\\)") ; 1
5830 * (slant "\\([ior]\\)") ; 2
5831 * (slant\? "\\([^-]?\\)") ; 2
5832 * (swidth "\\([^-]*\\)") ; 3
5833 * (adstyle "[^-]*") ; 4
5834 * (pixelsize "[0-9]+")
5835 * (pointsize "[0-9][0-9]+")
5836 * (resx "[0-9][0-9]+")
5837 * (resy "[0-9][0-9]+")
5838 * (spacing "[cmp?*]")
5839 * (avgwidth "[0-9]+")
5840 * (registry "[^-]+")
5841 * (encoding "[^-]+")
5842 * )
ee78dc32 5843 */
ee78dc32 5844
8edb0a6f 5845static LONG
fbd6baed 5846x_to_w32_weight (lpw)
ee78dc32
GV		 5847 char * lpw;
5848{
5849 if (!lpw) return (FW_DONTCARE);
5ac45f98
GV		 5850
5851 if (stricmp (lpw,"heavy") == 0) return FW_HEAVY;
5852 else if (stricmp (lpw,"extrabold") == 0) return FW_EXTRABOLD;
5853 else if (stricmp (lpw,"bold") == 0) return FW_BOLD;
5854 else if (stricmp (lpw,"demibold") == 0) return FW_SEMIBOLD;
1edf84e7 5855 else if (stricmp (lpw,"semibold") == 0) return FW_SEMIBOLD;
5ac45f98
GV		 5856 else if (stricmp (lpw,"medium") == 0) return FW_MEDIUM;
5857 else if (stricmp (lpw,"normal") == 0) return FW_NORMAL;
5858 else if (stricmp (lpw,"light") == 0) return FW_LIGHT;
5859 else if (stricmp (lpw,"extralight") == 0) return FW_EXTRALIGHT;
5860 else if (stricmp (lpw,"thin") == 0) return FW_THIN;
ee78dc32 5861 else
5ac45f98 5862 return FW_DONTCARE;
ee78dc32
GV		 5863}
5864
5ac45f98 5865
8edb0a6f 5866static char *
fbd6baed 5867w32_to_x_weight (fnweight)
ee78dc32
GV		 5868 int fnweight;
5869{
5ac45f98
GV		 5870 if (fnweight >= FW_HEAVY) return "heavy";
5871 if (fnweight >= FW_EXTRABOLD) return "extrabold";
5872 if (fnweight >= FW_BOLD) return "bold";
03f8fb34 5873 if (fnweight >= FW_SEMIBOLD) return "demibold";
5ac45f98
GV		 5874 if (fnweight >= FW_MEDIUM) return "medium";
5875 if (fnweight >= FW_NORMAL) return "normal";
5876 if (fnweight >= FW_LIGHT) return "light";
5877 if (fnweight >= FW_EXTRALIGHT) return "extralight";
5878 if (fnweight >= FW_THIN) return "thin";
5879 else
5880 return "*";
5881}
5882
8edb0a6f 5883static LONG
fbd6baed 5884x_to_w32_charset (lpcs)
5ac45f98
GV		 5885 char * lpcs;
5886{
767b1ff0 5887 Lisp_Object this_entry, w32_charset;
8b77111c
AI		 5888 char *charset;
5889 int len = strlen (lpcs);
5890
5891 /* Support "*-#nnn" format for unknown charsets. */
5892 if (strncmp (lpcs, "*-#", 3) == 0)
5893 return atoi (lpcs + 3);
5894
5895 /* Handle wildcards by ignoring them; eg. treat "big5*-*" as "big5". */
5896 charset = alloca (len + 1);
5897 strcpy (charset, lpcs);
5898 lpcs = strchr (charset, '*');
5899 if (lpcs)
5900 *lpcs = 0;
4587b026 5901
dfff8a69
JR		 5902 /* Look through w32-charset-info-alist for the character set.
5903 Format of each entry is
5904 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
5905 */
8b77111c 5906 this_entry = Fassoc (build_string(charset), Vw32_charset_info_alist);
4587b026 5907
767b1ff0
JR		 5908 if (NILP(this_entry))
5909 {
5910 /* At startup, we want iso8859-1 fonts to come up properly. */
8b77111c 5911 if (stricmp(charset, "iso8859-1") == 0)
767b1ff0
JR		 5912 return ANSI_CHARSET;
5913 else
5914 return DEFAULT_CHARSET;
5915 }
5916
5917 w32_charset = Fcar (Fcdr (this_entry));
5918
5919 // Translate Lisp symbol to number.
5920 if (w32_charset == Qw32_charset_ansi)
5921 return ANSI_CHARSET;
5922 if (w32_charset == Qw32_charset_symbol)
5923 return SYMBOL_CHARSET;
5924 if (w32_charset == Qw32_charset_shiftjis)
5925 return SHIFTJIS_CHARSET;
5926 if (w32_charset == Qw32_charset_hangeul)
5927 return HANGEUL_CHARSET;
5928 if (w32_charset == Qw32_charset_chinesebig5)
5929 return CHINESEBIG5_CHARSET;
5930 if (w32_charset == Qw32_charset_gb2312)
5931 return GB2312_CHARSET;
5932 if (w32_charset == Qw32_charset_oem)
5933 return OEM_CHARSET;
dfff8a69 5934#ifdef JOHAB_CHARSET
767b1ff0
JR		 5935 if (w32_charset == Qw32_charset_johab)
5936 return JOHAB_CHARSET;
5937 if (w32_charset == Qw32_charset_easteurope)
5938 return EASTEUROPE_CHARSET;
5939 if (w32_charset == Qw32_charset_turkish)
5940 return TURKISH_CHARSET;
5941 if (w32_charset == Qw32_charset_baltic)
5942 return BALTIC_CHARSET;
5943 if (w32_charset == Qw32_charset_russian)
5944 return RUSSIAN_CHARSET;
5945 if (w32_charset == Qw32_charset_arabic)
5946 return ARABIC_CHARSET;
5947 if (w32_charset == Qw32_charset_greek)
5948 return GREEK_CHARSET;
5949 if (w32_charset == Qw32_charset_hebrew)
5950 return HEBREW_CHARSET;
5951 if (w32_charset == Qw32_charset_vietnamese)
5952 return VIETNAMESE_CHARSET;
5953 if (w32_charset == Qw32_charset_thai)
5954 return THAI_CHARSET;
5955 if (w32_charset == Qw32_charset_mac)
5956 return MAC_CHARSET;
dfff8a69 5957#endif /* JOHAB_CHARSET */
5ac45f98 5958#ifdef UNICODE_CHARSET
767b1ff0
JR		 5959 if (w32_charset == Qw32_charset_unicode)
5960 return UNICODE_CHARSET;
5ac45f98 5961#endif
dfff8a69
JR		 5962
5963 return DEFAULT_CHARSET;
5ac45f98
GV		 5964}
5965
dfff8a69 5966
8edb0a6f 5967static char *
fbd6baed 5968w32_to_x_charset (fncharset)
5ac45f98
GV		 5969 int fncharset;
5970{
1edf84e7 5971 static char buf[16];
767b1ff0 5972 Lisp_Object charset_type;
1edf84e7 5973
5ac45f98
GV		 5974 switch (fncharset)
5975 {
767b1ff0
JR		 5976 case ANSI_CHARSET:
5977 /* Handle startup case of w32-charset-info-alist not
5978 being set up yet. */
5979 if (NILP(Vw32_charset_info_alist))
5980 return "iso8859-1";
5981 charset_type = Qw32_charset_ansi;
5982 break;
5983 case DEFAULT_CHARSET:
5984 charset_type = Qw32_charset_default;
5985 break;
5986 case SYMBOL_CHARSET:
5987 charset_type = Qw32_charset_symbol;
5988 break;
5989 case SHIFTJIS_CHARSET:
5990 charset_type = Qw32_charset_shiftjis;
5991 break;
5992 case HANGEUL_CHARSET:
5993 charset_type = Qw32_charset_hangeul;
5994 break;
5995 case GB2312_CHARSET:
5996 charset_type = Qw32_charset_gb2312;
5997 break;
5998 case CHINESEBIG5_CHARSET:
5999 charset_type = Qw32_charset_chinesebig5;
6000 break;
6001 case OEM_CHARSET:
6002 charset_type = Qw32_charset_oem;
6003 break;
4587b026
GV		 6004
6005 /* More recent versions of Windows (95 and NT4.0) define more
6006 character sets. */
6007#ifdef EASTEUROPE_CHARSET
767b1ff0
JR		 6008 case EASTEUROPE_CHARSET:
6009 charset_type = Qw32_charset_easteurope;
6010 break;
6011 case TURKISH_CHARSET:
6012 charset_type = Qw32_charset_turkish;
6013 break;
6014 case BALTIC_CHARSET:
6015 charset_type = Qw32_charset_baltic;
6016 break;
33d52f9c 6017 case RUSSIAN_CHARSET:
767b1ff0
JR		 6018 charset_type = Qw32_charset_russian;
6019 break;
6020 case ARABIC_CHARSET:
6021 charset_type = Qw32_charset_arabic;
6022 break;
6023 case GREEK_CHARSET:
6024 charset_type = Qw32_charset_greek;
6025 break;
6026 case HEBREW_CHARSET:
6027 charset_type = Qw32_charset_hebrew;
6028 break;
6029 case VIETNAMESE_CHARSET:
6030 charset_type = Qw32_charset_vietnamese;
6031 break;
6032 case THAI_CHARSET:
6033 charset_type = Qw32_charset_thai;
6034 break;
6035 case MAC_CHARSET:
6036 charset_type = Qw32_charset_mac;
6037 break;
6038 case JOHAB_CHARSET:
6039 charset_type = Qw32_charset_johab;
6040 break;
4587b026
GV		 6041#endif
6042
5ac45f98 6043#ifdef UNICODE_CHARSET
767b1ff0
JR		 6044 case UNICODE_CHARSET:
6045 charset_type = Qw32_charset_unicode;
6046 break;
5ac45f98 6047#endif
767b1ff0
JR		 6048 default:
6049 /* Encode numerical value of unknown charset. */
6050 sprintf (buf, "*-#%u", fncharset);
6051 return buf;
5ac45f98 6052 }
767b1ff0
JR		 6053
6054 {
6055 Lisp_Object rest;
6056 char * best_match = NULL;
6057
6058 /* Look through w32-charset-info-alist for the character set.
6059 Prefer ISO codepages, and prefer lower numbers in the ISO
6060 range. Only return charsets for codepages which are installed.
6061
6062 Format of each entry is
6063 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
6064 */
6065 for (rest = Vw32_charset_info_alist; CONSP (rest); rest = XCDR (rest))
6066 {
6067 char * x_charset;
6068 Lisp_Object w32_charset;
6069 Lisp_Object codepage;
6070
6071 Lisp_Object this_entry = XCAR (rest);
6072
6073 /* Skip invalid entries in alist. */
6074 if (!CONSP (this_entry) || !STRINGP (XCAR (this_entry))
6075 || !CONSP (XCDR (this_entry))
6076 || !SYMBOLP (XCAR (XCDR (this_entry))))
6077 continue;
6078
6079 x_charset = XSTRING (XCAR (this_entry))->data;
6080 w32_charset = XCAR (XCDR (this_entry));
6081 codepage = XCDR (XCDR (this_entry));
6082
6083 /* Look for Same charset and a valid codepage (or non-int
6084 which means ignore). */
6085 if (w32_charset == charset_type
6086 && (!INTEGERP (codepage) || codepage == CP_DEFAULT
6087 || IsValidCodePage (XINT (codepage))))
6088 {
6089 /* If we don't have a match already, then this is the
6090 best. */
6091 if (!best_match)
6092 best_match = x_charset;
6093 /* If this is an ISO codepage, and the best so far isn't,
6094 then this is better. */
6095 else if (stricmp (best_match, "iso") != 0
6096 && stricmp (x_charset, "iso") == 0)
6097 best_match = x_charset;
6098 /* If both are ISO8859 codepages, choose the one with the
6099 lowest number in the encoding field. */
6100 else if (stricmp (best_match, "iso8859-") == 0
6101 && stricmp (x_charset, "iso8859-") == 0)
6102 {
6103 int best_enc = atoi (best_match + 8);
6104 int this_enc = atoi (x_charset + 8);
6105 if (this_enc > 0 && this_enc < best_enc)
6106 best_match = x_charset;
6107 }
6108 }
6109 }
6110
6111 /* If no match, encode the numeric value. */
6112 if (!best_match)
6113 {
6114 sprintf (buf, "*-#%u", fncharset);
6115 return buf;
6116 }
6117
6118 strncpy(buf, best_match, 15);
6119 buf[15] = '\0';
6120 return buf;
6121 }
ee78dc32
GV		 6122}
6123
dfff8a69
JR		 6124
6125/* Get the Windows codepage corresponding to the specified font. The
6126 charset info in the font name is used to look up
6127 w32-charset-to-codepage-alist. */
6128int
6129w32_codepage_for_font (char *fontname)
6130{
767b1ff0
JR		 6131 Lisp_Object codepage, entry;
6132 char *charset_str, *charset, *end;
dfff8a69 6133
767b1ff0 6134 if (NILP (Vw32_charset_info_alist))
dfff8a69
JR		 6135 return CP_DEFAULT;
6136
767b1ff0
JR		 6137 /* Extract charset part of font string. */
6138 charset = xlfd_charset_of_font (fontname);
6139
6140 if (!charset)
ceb12877 6141 return CP_UNKNOWN;
767b1ff0 6142
8b77111c 6143 charset_str = (char *) alloca (strlen (charset) + 1);
767b1ff0
JR		 6144 strcpy (charset_str, charset);
6145
8b77111c 6146#if 0
dfff8a69
JR		 6147 /* Remove leading "*-". */
6148 if (strncmp ("*-", charset_str, 2) == 0)
6149 charset = charset_str + 2;
6150 else
8b77111c 6151#endif
dfff8a69
JR		 6152 charset = charset_str;
6153
6154 /* Stop match at wildcard (including preceding '-'). */
6155 if (end = strchr (charset, '*'))
6156 {
6157 if (end > charset && *(end-1) == '-')
6158 end--;
6159 *end = '\0';
6160 }
6161
767b1ff0
JR		 6162 entry = Fassoc (build_string(charset), Vw32_charset_info_alist);
6163 if (NILP (entry))
ceb12877 6164 return CP_UNKNOWN;
767b1ff0
JR		 6165
6166 codepage = Fcdr (Fcdr (entry));
6167
6168 if (NILP (codepage))
6169 return CP_8BIT;
6170 else if (XFASTINT (codepage) == XFASTINT (Qt))
6171 return CP_UNICODE;
6172 else if (INTEGERP (codepage))
dfff8a69
JR		 6173 return XINT (codepage);
6174 else
ceb12877 6175 return CP_UNKNOWN;
dfff8a69
JR		 6176}
6177
6178
8edb0a6f 6179static BOOL
767b1ff0 6180w32_to_x_font (lplogfont, lpxstr, len, specific_charset)
ee78dc32
GV		 6181 LOGFONT * lplogfont;
6182 char * lpxstr;
6183 int len;
767b1ff0 6184 char * specific_charset;
ee78dc32 6185{
6fc2811b 6186 char* fonttype;
f46e6225 6187 char *fontname;
3cb20f4a
RS		 6188 char height_pixels[8];
6189 char height_dpi[8];
6190 char width_pixels[8];
4587b026 6191 char *fontname_dash;
d88c567c
JR		 6192 int display_resy = one_w32_display_info.resy;
6193 int display_resx = one_w32_display_info.resx;
f46e6225
GV		 6194 int bufsz;
6195 struct coding_system coding;
3cb20f4a
RS		 6196
6197 if (!lpxstr) abort ();
ee78dc32 6198
3cb20f4a
RS		 6199 if (!lplogfont)
6200 return FALSE;
6201
6fc2811b
JR		 6202 if (lplogfont->lfOutPrecision == OUT_STRING_PRECIS)
6203 fonttype = "raster";
6204 else if (lplogfont->lfOutPrecision == OUT_STROKE_PRECIS)
6205 fonttype = "outline";
6206 else
6207 fonttype = "unknown";
6208
f46e6225
GV		 6209 setup_coding_system (Fcheck_coding_system (Vw32_system_coding_system),
6210 &coding);
aab5ac44
KH		 6211 coding.src_multibyte = 0;
6212 coding.dst_multibyte = 1;
f46e6225
GV		 6213 coding.mode |= CODING_MODE_LAST_BLOCK;
6214 bufsz = decoding_buffer_size (&coding, LF_FACESIZE);
6215
6216 fontname = alloca(sizeof(*fontname) * bufsz);
6217 decode_coding (&coding, lplogfont->lfFaceName, fontname,
6218 strlen(lplogfont->lfFaceName), bufsz - 1);
6219 *(fontname + coding.produced) = '\0';
4587b026
GV		 6220
6221 /* Replace dashes with underscores so the dashes are not
f46e6225 6222 misinterpreted. */
4587b026
GV		 6223 fontname_dash = fontname;
6224 while (fontname_dash = strchr (fontname_dash, '-'))
6225 *fontname_dash = '_';
6226
3cb20f4a 6227 if (lplogfont->lfHeight)
ee78dc32 6228 {
3cb20f4a
RS		 6229 sprintf (height_pixels, "%u", abs (lplogfont->lfHeight));
6230 sprintf (height_dpi, "%u",
33d52f9c 6231 abs (lplogfont->lfHeight) * 720 / display_resy);
5ac45f98
GV		 6232 }
6233 else
ee78dc32 6234 {
3cb20f4a
RS		 6235 strcpy (height_pixels, "*");
6236 strcpy (height_dpi, "*");
ee78dc32 6237 }
3cb20f4a
RS		 6238 if (lplogfont->lfWidth)
6239 sprintf (width_pixels, "%u", lplogfont->lfWidth * 10);
6240 else
6241 strcpy (width_pixels, "*");
6242
6243 _snprintf (lpxstr, len - 1,
6fc2811b
JR		 6244 "-%s-%s-%s-%c-normal-normal-%s-%s-%d-%d-%c-%s-%s",
6245 fonttype, /* foundry */
4587b026
GV		 6246 fontname, /* family */
6247 w32_to_x_weight (lplogfont->lfWeight), /* weight */
6248 lplogfont->lfItalic?'i':'r', /* slant */
6249 /* setwidth name */
6250 /* add style name */
6251 height_pixels, /* pixel size */
6252 height_dpi, /* point size */
33d52f9c
GV		 6253 display_resx, /* resx */
6254 display_resy, /* resy */
4587b026
GV		 6255 ((lplogfont->lfPitchAndFamily & 0x3) == VARIABLE_PITCH)
6256 ? 'p' : 'c', /* spacing */
6257 width_pixels, /* avg width */
767b1ff0
JR		 6258 specific_charset ? specific_charset
6259 : w32_to_x_charset (lplogfont->lfCharSet)
6260 /* charset registry and encoding */
3cb20f4a
RS		 6261 );
6262
ee78dc32
GV		 6263 lpxstr[len - 1] = 0; /* just to be sure */
6264 return (TRUE);
6265}
6266
8edb0a6f 6267static BOOL
fbd6baed 6268x_to_w32_font (lpxstr, lplogfont)
ee78dc32
GV		 6269 char * lpxstr;
6270 LOGFONT * lplogfont;
6271{
f46e6225
GV		 6272 struct coding_system coding;
6273
ee78dc32 6274 if (!lplogfont) return (FALSE);
f46e6225 6275
ee78dc32 6276 memset (lplogfont, 0, sizeof (*lplogfont));
5ac45f98 6277
1a292d24 6278 /* Set default value for each field. */
771c47d5 6279#if 1
ee78dc32
GV		 6280 lplogfont->lfOutPrecision = OUT_DEFAULT_PRECIS;
6281 lplogfont->lfClipPrecision = CLIP_DEFAULT_PRECIS;
6282 lplogfont->lfQuality = DEFAULT_QUALITY;
5ac45f98
GV		 6283#else
6284 /* go for maximum quality */
6285 lplogfont->lfOutPrecision = OUT_STROKE_PRECIS;
6286 lplogfont->lfClipPrecision = CLIP_STROKE_PRECIS;
6287 lplogfont->lfQuality = PROOF_QUALITY;
6288#endif
6289
1a292d24
AI		 6290 lplogfont->lfCharSet = DEFAULT_CHARSET;
6291 lplogfont->lfWeight = FW_DONTCARE;
6292 lplogfont->lfPitchAndFamily = DEFAULT_PITCH | FF_DONTCARE;
6293
5ac45f98
GV		 6294 if (!lpxstr)
6295 return FALSE;
6296
6297 /* Provide a simple escape mechanism for specifying Windows font names
6298 * directly -- if font spec does not beginning with '-', assume this
6299 * format:
6300 * "<font name>[:height in pixels[:width in pixels[:weight]]]"
6301 */
ee78dc32 6302
5ac45f98
GV		 6303 if (*lpxstr == '-')
6304 {
33d52f9c
GV		 6305 int fields, tem;
6306 char name[50], weight[20], slant, pitch, pixels[10], height[10],
8b77111c 6307 width[10], resy[10], remainder[50];
5ac45f98 6308 char * encoding;
d98c0337 6309 int dpi = one_w32_display_info.resy;
5ac45f98
GV		 6310
6311 fields = sscanf (lpxstr,
8b77111c 6312 "-%*[^-]-%49[^-]-%19[^-]-%c-%*[^-]-%*[^-]-%9[^-]-%9[^-]-%*[^-]-%9[^-]-%c-%9[^-]-%49s",
33d52f9c 6313 name, weight, &slant, pixels, height, resy, &pitch, width, remainder);
8b77111c
AI		 6314 if (fields == EOF)
6315 return (FALSE);
6316
6317 /* In the general case when wildcards cover more than one field,
6318 we don't know which field is which, so don't fill any in.
6319 However, we need to cope with this particular form, which is
6320 generated by font_list_1 (invoked by try_font_list):
6321 "-raster-6x10-*-gb2312*-*"
6322 and make sure to correctly parse the charset field. */
6323 if (fields == 3)
6324 {
6325 fields = sscanf (lpxstr,
6326 "-%*[^-]-%49[^-]-*-%49s",
6327 name, remainder);
6328 }
6329 else if (fields < 9)
6330 {
6331 fields = 0;
6332 remainder[0] = 0;
6333 }
6fc2811b 6334
5ac45f98
GV		 6335 if (fields > 0 && name[0] != '*')
6336 {
8ea3e054
RS		 6337 int bufsize;
6338 unsigned char *buf;
6339
f46e6225
GV		 6340 setup_coding_system
6341 (Fcheck_coding_system (Vw32_system_coding_system), &coding);
aab5ac44
KH		 6342 coding.src_multibyte = 1;
6343 coding.dst_multibyte = 1;
8ea3e054
RS		 6344 bufsize = encoding_buffer_size (&coding, strlen (name));
6345 buf = (unsigned char *) alloca (bufsize);
f46e6225 6346 coding.mode |= CODING_MODE_LAST_BLOCK;
8ea3e054
RS		 6347 encode_coding (&coding, name, buf, strlen (name), bufsize);
6348 if (coding.produced >= LF_FACESIZE)
6349 coding.produced = LF_FACESIZE - 1;
6350 buf[coding.produced] = 0;
6351 strcpy (lplogfont->lfFaceName, buf);
5ac45f98
GV		 6352 }
6353 else
6354 {
6fc2811b 6355 lplogfont->lfFaceName[0] = '\0';
5ac45f98
GV		 6356 }
6357
6358 fields--;
6359
fbd6baed 6360 lplogfont->lfWeight = x_to_w32_weight ((fields > 0 ? weight : ""));
5ac45f98
GV		 6361
6362 fields--;
6363
c8874f14 6364 lplogfont->lfItalic = (fields > 0 && slant == 'i');
5ac45f98
GV		 6365
6366 fields--;
6367
6368 if (fields > 0 && pixels[0] != '*')
6369 lplogfont->lfHeight = atoi (pixels);
6370
6371 fields--;
5ac45f98 6372 fields--;
33d52f9c
GV		 6373 if (fields > 0 && resy[0] != '*')
6374 {
6fc2811b 6375 tem = atoi (resy);
33d52f9c
GV		 6376 if (tem > 0) dpi = tem;
6377 }
5ac45f98 6378
33d52f9c
GV		 6379 if (fields > -1 && lplogfont->lfHeight == 0 && height[0] != '*')
6380 lplogfont->lfHeight = atoi (height) * dpi / 720;
6381
6382 if (fields > 0)
5ac45f98
GV		 6383 lplogfont->lfPitchAndFamily =
6384 (fields > 0 && pitch == 'p') ? VARIABLE_PITCH : FIXED_PITCH;
6385
6386 fields--;
6387
6388 if (fields > 0 && width[0] != '*')
6389 lplogfont->lfWidth = atoi (width) / 10;
6390
6391 fields--;
6392
4587b026 6393 /* Strip the trailing '-' if present. (it shouldn't be, as it
d88c567c 6394 fails the test against xlfd-tight-regexp in fontset.el). */
3c190163 6395 {
5ac45f98
GV		 6396 int len = strlen (remainder);
6397 if (len > 0 && remainder[len-1] == '-')
6398 remainder[len-1] = 0;
ee78dc32 6399 }
5ac45f98 6400 encoding = remainder;
8b77111c 6401#if 0
5ac45f98
GV		 6402 if (strncmp (encoding, "*-", 2) == 0)
6403 encoding += 2;
8b77111c
AI		 6404#endif
6405 lplogfont->lfCharSet = x_to_w32_charset (encoding);
5ac45f98
GV		 6406 }
6407 else
6408 {
6409 int fields;
6410 char name[100], height[10], width[10], weight[20];
a1a80b40 6411
5ac45f98
GV		 6412 fields = sscanf (lpxstr,
6413 "%99[^:]:%9[^:]:%9[^:]:%19s",
6414 name, height, width, weight);
6415
6416 if (fields == EOF) return (FALSE);
6417
6418 if (fields > 0)
6419 {
6420 strncpy (lplogfont->lfFaceName,name, LF_FACESIZE);
6421 lplogfont->lfFaceName[LF_FACESIZE-1] = 0;
6422 }
6423 else
6424 {
6425 lplogfont->lfFaceName[0] = 0;
6426 }
6427
6428 fields--;
6429
6430 if (fields > 0)
6431 lplogfont->lfHeight = atoi (height);
6432
6433 fields--;
6434
6435 if (fields > 0)
6436 lplogfont->lfWidth = atoi (width);
6437
6438 fields--;
6439
fbd6baed 6440 lplogfont->lfWeight = x_to_w32_weight ((fields > 0 ? weight : ""));
5ac45f98
GV		 6441 }
6442
6443 /* This makes TrueType fonts work better. */
6444 lplogfont->lfHeight = - abs (lplogfont->lfHeight);
6fc2811b 6445
ee78dc32
GV		 6446 return (TRUE);
6447}
6448
d88c567c
JR		 6449/* Strip the pixel height and point height from the given xlfd, and
6450 return the pixel height. If no pixel height is specified, calculate
6451 one from the point height, or if that isn't defined either, return
6452 0 (which usually signifies a scalable font).
6453*/
8edb0a6f
JR		 6454static int
6455xlfd_strip_height (char *fontname)
d88c567c 6456{
8edb0a6f 6457 int pixel_height, field_number;
d88c567c
JR		 6458 char *read_from, *write_to;
6459
6460 xassert (fontname);
6461
6462 pixel_height = field_number = 0;
6463 write_to = NULL;
6464
6465 /* Look for height fields. */
6466 for (read_from = fontname; *read_from; read_from++)
6467 {
6468 if (*read_from == '-')
6469 {
6470 field_number++;
6471 if (field_number == 7) /* Pixel height. */
6472 {
6473 read_from++;
6474 write_to = read_from;
6475
6476 /* Find end of field. */
6477 for (;*read_from && *read_from != '-'; read_from++)
6478 ;
6479
6480 /* Split the fontname at end of field. */
6481 if (*read_from)
6482 {
6483 *read_from = '\0';
6484 read_from++;
6485 }
6486 pixel_height = atoi (write_to);
6487 /* Blank out field. */
6488 if (read_from > write_to)
6489 {
6490 *write_to = '-';
6491 write_to++;
6492 }
767b1ff0 6493 /* If the pixel height field is at the end (partial xlfd),
d88c567c
JR		 6494 return now. */
6495 else
6496 return pixel_height;
6497
6498 /* If we got a pixel height, the point height can be
6499 ignored. Just blank it out and break now. */
6500 if (pixel_height)
6501 {
6502 /* Find end of point size field. */
6503 for (; *read_from && *read_from != '-'; read_from++)
6504 ;
6505
6506 if (*read_from)
6507 read_from++;
6508
6509 /* Blank out the point size field. */
6510 if (read_from > write_to)
6511 {
6512 *write_to = '-';
6513 write_to++;
6514 }
6515 else
6516 return pixel_height;
6517
6518 break;
6519 }
6520 /* If the point height is already blank, break now. */
6521 if (*read_from == '-')
6522 {
6523 read_from++;
6524 break;
6525 }
6526 }
6527 else if (field_number == 8)
6528 {
6529 /* If we didn't get a pixel height, try to get the point
6530 height and convert that. */
6531 int point_size;
6532 char *point_size_start = read_from++;
6533
6534 /* Find end of field. */
6535 for (; *read_from && *read_from != '-'; read_from++)
6536 ;
6537
6538 if (*read_from)
6539 {
6540 *read_from = '\0';
6541 read_from++;
6542 }
6543
6544 point_size = atoi (point_size_start);
6545
6546 /* Convert to pixel height. */
6547 pixel_height = point_size
6548 * one_w32_display_info.height_in / 720;
6549
6550 /* Blank out this field and break. */
6551 *write_to = '-';
6552 write_to++;
6553 break;
6554 }
6555 }
6556 }
6557
6558 /* Shift the rest of the font spec into place. */
6559 if (write_to && read_from > write_to)
6560 {
6561 for (; *read_from; read_from++, write_to++)
6562 *write_to = *read_from;
6563 *write_to = '\0';
6564 }
6565
6566 return pixel_height;
6567}
6568
6fc2811b 6569/* Assume parameter 1 is fully qualified, no wildcards. */
8edb0a6f 6570static BOOL
6fc2811b
JR		 6571w32_font_match (fontname, pattern)
6572 char * fontname;
6573 char * pattern;
ee78dc32 6574{
e7c72122 6575 char *regex = alloca (strlen (pattern) * 2 + 3);
d88c567c 6576 char *font_name_copy = alloca (strlen (fontname) + 1);
6fc2811b 6577 char *ptr;
ee78dc32 6578
d88c567c
JR		 6579 /* Copy fontname so we can modify it during comparison. */
6580 strcpy (font_name_copy, fontname);
6581
6fc2811b
JR		 6582 ptr = regex;
6583 *ptr++ = '^';
ee78dc32 6584
6fc2811b
JR		 6585 /* Turn pattern into a regexp and do a regexp match. */
6586 for (; *pattern; pattern++)
6587 {
6588 if (*pattern == '?')
6589 *ptr++ = '.';
6590 else if (*pattern == '*')
6591 {
6592 *ptr++ = '.';
6593 *ptr++ = '*';
6594 }
33d52f9c 6595 else
6fc2811b 6596 *ptr++ = *pattern;
ee78dc32 6597 }
6fc2811b
JR		 6598 *ptr = '$';
6599 *(ptr + 1) = '\0';
6600
d88c567c
JR		 6601 /* Strip out font heights and compare them seperately, since
6602 rounding error can cause mismatches. This also allows a
6603 comparison between a font that declares only a pixel height and a
6604 pattern that declares the point height.
6605 */
6606 {
6607 int font_height, pattern_height;
6608
6609 font_height = xlfd_strip_height (font_name_copy);
6610 pattern_height = xlfd_strip_height (regex);
6611
6612 /* Compare now, and don't bother doing expensive regexp matching
6613 if the heights differ. */
6614 if (font_height && pattern_height && (font_height != pattern_height))
6615 return FALSE;
6616 }
6617
6fc2811b 6618 return (fast_c_string_match_ignore_case (build_string (regex),
d88c567c 6619 font_name_copy) >= 0);
ee78dc32
GV		 6620}
6621
5ca0cd71
GV		 6622/* Callback functions, and a structure holding info they need, for
6623 listing system fonts on W32. We need one set of functions to do the
6624 job properly, but these don't work on NT 3.51 and earlier, so we
6625 have a second set which don't handle character sets properly to
6626 fall back on.
6627
6628 In both cases, there are two passes made. The first pass gets one
6629 font from each family, the second pass lists all the fonts from
6630 each family. */
6631
ee78dc32
GV		 6632typedef struct enumfont_t
6633{
6634 HDC hdc;
6635 int numFonts;
3cb20f4a 6636 LOGFONT logfont;
ee78dc32
GV		 6637 XFontStruct *size_ref;
6638 Lisp_Object *pattern;
ee78dc32
GV		 6639 Lisp_Object *tail;
6640} enumfont_t;
6641
8edb0a6f 6642static int CALLBACK
ee78dc32
GV		 6643enum_font_cb2 (lplf, lptm, FontType, lpef)
6644 ENUMLOGFONT * lplf;
6645 NEWTEXTMETRIC * lptm;
6646 int FontType;
6647 enumfont_t * lpef;
6648{
1edf84e7 6649 if (lplf->elfLogFont.lfStrikeOut || lplf->elfLogFont.lfUnderline)
ee78dc32
GV		 6650 return (1);
6651
4587b026
GV		 6652 /* Check that the character set matches if it was specified */
6653 if (lpef->logfont.lfCharSet != DEFAULT_CHARSET &&
6654 lplf->elfLogFont.lfCharSet != lpef->logfont.lfCharSet)
6655 return (1);
6656
ee78dc32
GV		 6657 {
6658 char buf[100];
4587b026 6659 Lisp_Object width = Qnil;
767b1ff0 6660 char *charset = NULL;
ee78dc32 6661
6fc2811b
JR		 6662 /* Truetype fonts do not report their true metrics until loaded */
6663 if (FontType != RASTER_FONTTYPE)
3cb20f4a 6664 {
6fc2811b
JR		 6665 if (!NILP (*(lpef->pattern)))
6666 {
6667 /* Scalable fonts are as big as you want them to be. */
6668 lplf->elfLogFont.lfHeight = lpef->logfont.lfHeight;
6669 lplf->elfLogFont.lfWidth = lpef->logfont.lfWidth;
6670 width = make_number (lpef->logfont.lfWidth);
6671 }
6672 else
6673 {
6674 lplf->elfLogFont.lfHeight = 0;
6675 lplf->elfLogFont.lfWidth = 0;
6676 }
3cb20f4a 6677 }
6fc2811b 6678
f46e6225
GV		 6679 /* Make sure the height used here is the same as everywhere
6680 else (ie character height, not cell height). */
6fc2811b
JR		 6681 if (lplf->elfLogFont.lfHeight > 0)
6682 {
6683 /* lptm can be trusted for RASTER fonts, but not scalable ones. */
6684 if (FontType == RASTER_FONTTYPE)
6685 lplf->elfLogFont.lfHeight = lptm->tmInternalLeading - lptm->tmHeight;
6686 else
6687 lplf->elfLogFont.lfHeight = -lplf->elfLogFont.lfHeight;
6688 }
4587b026 6689
767b1ff0
JR		 6690 if (!NILP (*(lpef->pattern)))
6691 {
6692 charset = xlfd_charset_of_font (XSTRING(*(lpef->pattern))->data);
6693
6694 /* Ensure that charset is valid for this font. */
6695 if (charset
6696 && (x_to_w32_charset (charset) != lplf->elfLogFont.lfCharSet))
6697 charset = NULL;
6698 }
6699
6700 /* TODO: List all relevant charsets if charset not specified. */
6701 if (!w32_to_x_font (&(lplf->elfLogFont), buf, 100, charset))
33d52f9c 6702 return (0);
ee78dc32 6703
5ca0cd71
GV		 6704 if (NILP (*(lpef->pattern))
6705 || w32_font_match (buf, XSTRING (*(lpef->pattern))->data))
ee78dc32 6706 {
4587b026 6707 *lpef->tail = Fcons (Fcons (build_string (buf), width), Qnil);
8e713be6 6708 lpef->tail = &(XCDR (*lpef->tail));
ee78dc32
GV		 6709 lpef->numFonts++;
6710 }
6711 }
6fc2811b 6712
ee78dc32
GV		 6713 return (1);
6714}
6715
8edb0a6f 6716static int CALLBACK
ee78dc32
GV		 6717enum_font_cb1 (lplf, lptm, FontType, lpef)
6718 ENUMLOGFONT * lplf;
6719 NEWTEXTMETRIC * lptm;
6720 int FontType;
6721 enumfont_t * lpef;
6722{
6723 return EnumFontFamilies (lpef->hdc,
6724 lplf->elfLogFont.lfFaceName,
6725 (FONTENUMPROC) enum_font_cb2,
6726 (LPARAM) lpef);
6727}
6728
6729
8edb0a6f 6730static int CALLBACK
5ca0cd71
GV		 6731enum_fontex_cb2 (lplf, lptm, font_type, lpef)
6732 ENUMLOGFONTEX * lplf;
6733 NEWTEXTMETRICEX * lptm;
6734 int font_type;
6735 enumfont_t * lpef;
6736{
6737 /* We are not interested in the extra info we get back from the 'Ex
6738 version - only the fact that we get character set variations
6739 enumerated seperately. */
6740 return enum_font_cb2 ((ENUMLOGFONT *) lplf, (NEWTEXTMETRIC *) lptm,
6741 font_type, lpef);
6742}
6743
8edb0a6f 6744static int CALLBACK
5ca0cd71
GV		 6745enum_fontex_cb1 (lplf, lptm, font_type, lpef)
6746 ENUMLOGFONTEX * lplf;
6747 NEWTEXTMETRICEX * lptm;
6748 int font_type;
6749 enumfont_t * lpef;
6750{
6751 HMODULE gdi32 = GetModuleHandle ("gdi32.dll");
6752 FARPROC enum_font_families_ex
6753 = GetProcAddress ( gdi32, "EnumFontFamiliesExA");
6754 /* We don't really expect EnumFontFamiliesEx to disappear once we
6755 get here, so don't bother handling it gracefully. */
6756 if (enum_font_families_ex == NULL)
6757 error ("gdi32.dll has disappeared!");
6758 return enum_font_families_ex (lpef->hdc,
6759 &lplf->elfLogFont,
6760 (FONTENUMPROC) enum_fontex_cb2,
6761 (LPARAM) lpef, 0);
6762}
6763
4587b026
GV		 6764/* Interface to fontset handler. (adapted from mw32font.c in Meadow
6765 and xterm.c in Emacs 20.3) */
6766
8edb0a6f 6767static Lisp_Object w32_list_bdf_fonts (Lisp_Object pattern, int max_names)
33d52f9c
GV		 6768{
6769 char *fontname, *ptnstr;
6770 Lisp_Object list, tem, newlist = Qnil;
55dcfc15 6771 int n_fonts = 0;
33d52f9c
GV		 6772
6773 list = Vw32_bdf_filename_alist;
6774 ptnstr = XSTRING (pattern)->data;
6775
8e713be6 6776 for ( ; CONSP (list); list = XCDR (list))
33d52f9c 6777 {
8e713be6 6778 tem = XCAR (list);
33d52f9c 6779 if (CONSP (tem))
8e713be6 6780 fontname = XSTRING (XCAR (tem))->data;
33d52f9c
GV		 6781 else if (STRINGP (tem))
6782 fontname = XSTRING (tem)->data;
6783 else
6784 continue;
6785
6786 if (w32_font_match (fontname, ptnstr))
5ca0cd71 6787 {
8e713be6 6788 newlist = Fcons (XCAR (tem), newlist);
5ca0cd71
GV		 6789 n_fonts++;
6790 if (n_fonts >= max_names)
6791 break;
6792 }
33d52f9c
GV		 6793 }
6794
6795 return newlist;
6796}
6797
8edb0a6f
JR		 6798static Lisp_Object w32_list_synthesized_fonts (FRAME_PTR f,
6799 Lisp_Object pattern,
6800 int size, int max_names);
5ca0cd71 6801
4587b026
GV		 6802/* Return a list of names of available fonts matching PATTERN on frame
6803 F. If SIZE is not 0, it is the size (maximum bound width) of fonts
6804 to be listed. Frame F NULL means we have not yet created any
6805 frame, which means we can't get proper size info, as we don't have
6806 a device context to use for GetTextMetrics.
6807 MAXNAMES sets a limit on how many fonts to match. */
6808
6809Lisp_Object
dc220243
JR		 6810w32_list_fonts (f, pattern, size, maxnames)
6811 struct frame *f;
6812 Lisp_Object pattern;
6813 int size;
6814 int maxnames;
4587b026 6815{
6fc2811b 6816 Lisp_Object patterns, key = Qnil, tem, tpat;
4587b026 6817 Lisp_Object list = Qnil, newlist = Qnil, second_best = Qnil;
33d52f9c 6818 struct w32_display_info *dpyinfo = &one_w32_display_info;
5ca0cd71 6819 int n_fonts = 0;
396594fe 6820
4587b026
GV		 6821 patterns = Fassoc (pattern, Valternate_fontname_alist);
6822 if (NILP (patterns))
6823 patterns = Fcons (pattern, Qnil);
6824
8e713be6 6825 for (; CONSP (patterns); patterns = XCDR (patterns))
4587b026
GV		 6826 {
6827 enumfont_t ef;
767b1ff0 6828 int codepage;
4587b026 6829
8e713be6 6830 tpat = XCAR (patterns);
4587b026 6831
767b1ff0
JR		 6832 if (!STRINGP (tpat))
6833 continue;
6834
6835 /* Avoid expensive EnumFontFamilies functions if we are not
6836 going to be able to output one of these anyway. */
6837 codepage = w32_codepage_for_font (XSTRING (tpat)->data);
6838 if (codepage != CP_8BIT && codepage != CP_UNICODE
ceb12877
AI		 6839 && codepage != CP_DEFAULT && codepage != CP_UNKNOWN
6840 && !IsValidCodePage(codepage))
767b1ff0
JR		 6841 continue;
6842
4587b026
GV		 6843 /* See if we cached the result for this particular query.
6844 The cache is an alist of the form:
6845 ((PATTERN (FONTNAME . WIDTH) ...) ...)
6846 */
8e713be6 6847 if (tem = XCDR (dpyinfo->name_list_element),
33d52f9c 6848 !NILP (list = Fassoc (tpat, tem)))
4587b026
GV		 6849 {
6850 list = Fcdr_safe (list);
6851 /* We have a cached list. Don't have to get the list again. */
6852 goto label_cached;
6853 }
6854
6855 BLOCK_INPUT;
6856 /* At first, put PATTERN in the cache. */
6857 list = Qnil;
33d52f9c
GV		 6858 ef.pattern = &tpat;
6859 ef.tail = &list;
4587b026 6860 ef.numFonts = 0;
33d52f9c 6861
5ca0cd71
GV		 6862 /* Use EnumFontFamiliesEx where it is available, as it knows
6863 about character sets. Fall back to EnumFontFamilies for
6864 older versions of NT that don't support the 'Ex function. */
767b1ff0 6865 x_to_w32_font (XSTRING (tpat)->data, &ef.logfont);
4587b026 6866 {
5ca0cd71
GV		 6867 LOGFONT font_match_pattern;
6868 HMODULE gdi32 = GetModuleHandle ("gdi32.dll");
6869 FARPROC enum_font_families_ex
6870 = GetProcAddress ( gdi32, "EnumFontFamiliesExA");
6871
6872 /* We do our own pattern matching so we can handle wildcards. */
6873 font_match_pattern.lfFaceName[0] = 0;
6874 font_match_pattern.lfPitchAndFamily = 0;
6875 /* We can use the charset, because if it is a wildcard it will
6876 be DEFAULT_CHARSET anyway. */
6877 font_match_pattern.lfCharSet = ef.logfont.lfCharSet;
6878
33d52f9c 6879 ef.hdc = GetDC (dpyinfo->root_window);
4587b026 6880
5ca0cd71
GV		 6881 if (enum_font_families_ex)
6882 enum_font_families_ex (ef.hdc,
6883 &font_match_pattern,
6884 (FONTENUMPROC) enum_fontex_cb1,
6885 (LPARAM) &ef, 0);
6886 else
6887 EnumFontFamilies (ef.hdc, NULL, (FONTENUMPROC) enum_font_cb1,
6888 (LPARAM)&ef);
4587b026 6889
33d52f9c 6890 ReleaseDC (dpyinfo->root_window, ef.hdc);
4587b026
GV		 6891 }
6892
6893 UNBLOCK_INPUT;
6894
6895 /* Make a list of the fonts we got back.
6896 Store that in the font cache for the display. */
f3fbd155
KR		 6897 XSETCDR (dpyinfo->name_list_element,
6898 Fcons (Fcons (tpat, list),
6899 XCDR (dpyinfo->name_list_element)));
4587b026
GV		 6900
6901 label_cached:
6902 if (NILP (list)) continue; /* Try the remaining alternatives. */
6903
6904 newlist = second_best = Qnil;
6905
6906 /* Make a list of the fonts that have the right width. */
8e713be6 6907 for (; CONSP (list); list = XCDR (list))
4587b026
GV		 6908 {
6909 int found_size;
8e713be6 6910 tem = XCAR (list);
4587b026
GV		 6911
6912 if (!CONSP (tem))
6913 continue;
8e713be6 6914 if (NILP (XCAR (tem)))
4587b026
GV		 6915 continue;
6916 if (!size)
6917 {
8e713be6 6918 newlist = Fcons (XCAR (tem), newlist);
5ca0cd71
GV		 6919 n_fonts++;
6920 if (n_fonts >= maxnames)
6921 break;
6922 else
6923 continue;
4587b026 6924 }
8e713be6 6925 if (!INTEGERP (XCDR (tem)))
4587b026
GV		 6926 {
6927 /* Since we don't yet know the size of the font, we must
6928 load it and try GetTextMetrics. */
4587b026
GV		 6929 W32FontStruct thisinfo;
6930 LOGFONT lf;
6931 HDC hdc;
6932 HANDLE oldobj;
6933
8e713be6 6934 if (!x_to_w32_font (XSTRING (XCAR (tem))->data, &lf))
4587b026
GV		 6935 continue;
6936
6937 BLOCK_INPUT;
33d52f9c 6938 thisinfo.bdf = NULL;
4587b026
GV		 6939 thisinfo.hfont = CreateFontIndirect (&lf);
6940 if (thisinfo.hfont == NULL)
6941 continue;
6942
6943 hdc = GetDC (dpyinfo->root_window);
6944 oldobj = SelectObject (hdc, thisinfo.hfont);
6945 if (GetTextMetrics (hdc, &thisinfo.tm))
f3fbd155 6946 XSETCDR (tem, make_number (FONT_WIDTH (&thisinfo)));
4587b026 6947 else
f3fbd155 6948 XSETCDR (tem, make_number (0));
4587b026
GV		 6949 SelectObject (hdc, oldobj);
6950 ReleaseDC (dpyinfo->root_window, hdc);
6951 DeleteObject(thisinfo.hfont);
6952 UNBLOCK_INPUT;
6953 }
8e713be6 6954 found_size = XINT (XCDR (tem));
4587b026 6955 if (found_size == size)
5ca0cd71 6956 {
8e713be6 6957 newlist = Fcons (XCAR (tem), newlist);
5ca0cd71
GV		 6958 n_fonts++;
6959 if (n_fonts >= maxnames)
6960 break;
6961 }
4587b026
GV		 6962 /* keep track of the closest matching size in case
6963 no exact match is found. */
6964 else if (found_size > 0)
6965 {
6966 if (NILP (second_best))
6967 second_best = tem;
5ca0cd71 6968
4587b026
GV		 6969 else if (found_size < size)
6970 {
8e713be6
KR		 6971 if (XINT (XCDR (second_best)) > size
6972 || XINT (XCDR (second_best)) < found_size)
4587b026
GV		 6973 second_best = tem;
6974 }
6975 else
6976 {
8e713be6
KR		 6977 if (XINT (XCDR (second_best)) > size
6978 && XINT (XCDR (second_best)) >
4587b026
GV		 6979 found_size)
6980 second_best = tem;
6981 }
6982 }
6983 }
6984
6985 if (!NILP (newlist))
6986 break;
6987 else if (!NILP (second_best))
6988 {
8e713be6 6989 newlist = Fcons (XCAR (second_best), Qnil);
4587b026
GV		 6990 break;
6991 }
6992 }
6993
33d52f9c 6994 /* Include any bdf fonts. */
5ca0cd71 6995 if (n_fonts < maxnames)
33d52f9c
GV		 6996 {
6997 Lisp_Object combined[2];
5ca0cd71 6998 combined[0] = w32_list_bdf_fonts (pattern, maxnames - n_fonts);
33d52f9c
GV		 6999 combined[1] = newlist;
7000 newlist = Fnconc(2, combined);
7001 }
7002
5ca0cd71
GV		 7003 /* If we can't find a font that matches, check if Windows would be
7004 able to synthesize it from a different style. */
6fc2811b 7005 if (NILP (newlist) && !NILP (Vw32_enable_synthesized_fonts))
5ca0cd71
GV		 7006 newlist = w32_list_synthesized_fonts (f, pattern, size, maxnames);
7007
4587b026
GV		 7008 return newlist;
7009}
7010
8edb0a6f 7011static Lisp_Object
5ca0cd71
GV		 7012w32_list_synthesized_fonts (f, pattern, size, max_names)
7013 FRAME_PTR f;
7014 Lisp_Object pattern;
7015 int size;
7016 int max_names;
7017{
7018 int fields;
7019 char *full_pattn, *new_pattn, foundary[50], family[50], *pattn_part2;
7020 char style[20], slant;
8edb0a6f 7021 Lisp_Object matches, tem, synthed_matches = Qnil;
5ca0cd71
GV		 7022
7023 full_pattn = XSTRING (pattern)->data;
7024
8b77111c 7025 pattn_part2 = alloca (XSTRING (pattern)->size + 1);
5ca0cd71
GV		 7026 /* Allow some space for wildcard expansion. */
7027 new_pattn = alloca (XSTRING (pattern)->size + 100);
7028
7029 fields = sscanf (full_pattn, "-%49[^-]-%49[^-]-%19[^-]-%c-%s",
7030 foundary, family, style, &slant, pattn_part2);
7031 if (fields == EOF || fields < 5)
7032 return Qnil;
7033
7034 /* If the style and slant are wildcards already there is no point
7035 checking again (and we don't want to keep recursing). */
7036 if (*style == '*' && slant == '*')
7037 return Qnil;
7038
7039 sprintf (new_pattn, "-%s-%s-*-*-%s", foundary, family, pattn_part2);
7040
7041 matches = w32_list_fonts (f, build_string (new_pattn), size, max_names);
7042
8e713be6 7043 for ( ; CONSP (matches); matches = XCDR (matches))
5ca0cd71 7044 {
8e713be6 7045 tem = XCAR (matches);
5ca0cd71
GV		 7046 if (!STRINGP (tem))
7047 continue;
7048
7049 full_pattn = XSTRING (tem)->data;
7050 fields = sscanf (full_pattn, "-%49[^-]-%49[^-]-%*[^-]-%*c-%s",
7051 foundary, family, pattn_part2);
7052 if (fields == EOF || fields < 3)
7053 continue;
7054
7055 sprintf (new_pattn, "-%s-%s-%s-%c-%s", foundary, family, style,
7056 slant, pattn_part2);
7057
7058 synthed_matches = Fcons (build_string (new_pattn),
7059 synthed_matches);
7060 }
7061
7062 return synthed_matches;
7063}
7064
7065
4587b026
GV		 7066/* Return a pointer to struct font_info of font FONT_IDX of frame F. */
7067struct font_info *
7068w32_get_font_info (f, font_idx)
7069 FRAME_PTR f;
7070 int font_idx;
7071{
7072 return (FRAME_W32_FONT_TABLE (f) + font_idx);
7073}
7074
7075
7076struct font_info*
7077w32_query_font (struct frame *f, char *fontname)
7078{
7079 int i;
7080 struct font_info *pfi;
7081
7082 pfi = FRAME_W32_FONT_TABLE (f);
7083
7084 for (i = 0; i < one_w32_display_info.n_fonts ;i++, pfi++)
7085 {
7086 if (strcmp(pfi->name, fontname) == 0) return pfi;
7087 }
7088
7089 return NULL;
7090}
7091
7092/* Find a CCL program for a font specified by FONTP, and set the member
7093 `encoder' of the structure. */
7094
7095void
7096w32_find_ccl_program (fontp)
7097 struct font_info *fontp;
7098{
3545439c 7099 Lisp_Object list, elt;
4587b026 7100
8e713be6 7101 for (list = Vfont_ccl_encoder_alist; CONSP (list); list = XCDR (list))
4587b026 7102 {
8e713be6 7103 elt = XCAR (list);
4587b026 7104 if (CONSP (elt)
8e713be6
KR		 7105 && STRINGP (XCAR (elt))
7106 && (fast_c_string_match_ignore_case (XCAR (elt), fontp->name)
4587b026 7107 >= 0))
3545439c
KH		 7108 break;
7109 }
7110 if (! NILP (list))
7111 {
17eedd00
KH		 7112 struct ccl_program *ccl
7113 = (struct ccl_program *) xmalloc (sizeof (struct ccl_program));
3545439c 7114
8e713be6 7115 if (setup_ccl_program (ccl, XCDR (elt)) < 0)
3545439c
KH		 7116 xfree (ccl);
7117 else
7118 fontp->font_encoder = ccl;
4587b026
GV		 7119 }
7120}
7121
7122\f
8edb0a6f
JR		 7123/* Find BDF files in a specified directory. (use GCPRO when calling,
7124 as this calls lisp to get a directory listing). */
7125static Lisp_Object
7126w32_find_bdf_fonts_in_dir (Lisp_Object directory)
7127{
7128 Lisp_Object filelist, list = Qnil;
7129 char fontname[100];
7130
7131 if (!STRINGP(directory))
7132 return Qnil;
7133
7134 filelist = Fdirectory_files (directory, Qt,
7135 build_string (".*\\.[bB][dD][fF]"), Qt);
7136
7137 for ( ; CONSP(filelist); filelist = XCDR (filelist))
7138 {
7139 Lisp_Object filename = XCAR (filelist);
7140 if (w32_BDF_to_x_font (XSTRING (filename)->data, fontname, 100))
7141 store_in_alist (&list, build_string (fontname), filename);
7142 }
7143 return list;
7144}
7145
6fc2811b
JR		 7146DEFUN ("w32-find-bdf-fonts", Fw32_find_bdf_fonts, Sw32_find_bdf_fonts,
7147 1, 1, 0,
7148 "Return a list of BDF fonts in DIR, suitable for appending to\n\
767b1ff0 7149w32-bdf-filename-alist. Fonts which do not contain an xlfd description\n\
6fc2811b
JR		 7150will not be included in the list. DIR may be a list of directories.")
7151 (directory)
7152 Lisp_Object directory;
7153{
7154 Lisp_Object list = Qnil;
7155 struct gcpro gcpro1, gcpro2;
ee78dc32 7156
6fc2811b
JR		 7157 if (!CONSP (directory))
7158 return w32_find_bdf_fonts_in_dir (directory);
ee78dc32 7159
6fc2811b 7160 for ( ; CONSP (directory); directory = XCDR (directory))
ee78dc32 7161 {
6fc2811b
JR		 7162 Lisp_Object pair[2];
7163 pair[0] = list;
7164 pair[1] = Qnil;
7165 GCPRO2 (directory, list);
7166 pair[1] = w32_find_bdf_fonts_in_dir( XCAR (directory) );
7167 list = Fnconc( 2, pair );
7168 UNGCPRO;
7169 }
7170 return list;
7171}
ee78dc32 7172
6fc2811b
JR		 7173\f
7174DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0,
dfff8a69 7175 "Internal function called by `color-defined-p', which see.")
6fc2811b
JR		 7176 (color, frame)
7177 Lisp_Object color, frame;
7178{
7179 XColor foo;
7180 FRAME_PTR f = check_x_frame (frame);
ee78dc32 7181
6fc2811b 7182 CHECK_STRING (color, 1);
ee78dc32 7183
6fc2811b
JR		 7184 if (w32_defined_color (f, XSTRING (color)->data, &foo, 0))
7185 return Qt;
7186 else
7187 return Qnil;
7188}
ee78dc32 7189
2d764c78 7190DEFUN ("xw-color-values", Fxw_color_values, Sxw_color_values, 1, 2, 0,
dfff8a69 7191 "Internal function called by `color-values', which see.")
ee78dc32
GV		 7192 (color, frame)
7193 Lisp_Object color, frame;
7194{
6fc2811b 7195 XColor foo;
ee78dc32
GV		 7196 FRAME_PTR f = check_x_frame (frame);
7197
7198 CHECK_STRING (color, 1);
7199
6fc2811b 7200 if (w32_defined_color (f, XSTRING (color)->data, &foo, 0))
ee78dc32
GV		 7201 {
7202 Lisp_Object rgb[3];
7203
6fc2811b
JR		 7204 rgb[0] = make_number ((GetRValue (foo.pixel) << 8)
7205 | GetRValue (foo.pixel));
7206 rgb[1] = make_number ((GetGValue (foo.pixel) << 8)
7207 | GetGValue (foo.pixel));
7208 rgb[2] = make_number ((GetBValue (foo.pixel) << 8)
7209 | GetBValue (foo.pixel));
ee78dc32
GV		 7210 return Flist (3, rgb);
7211 }
7212 else
7213 return Qnil;
7214}
7215
2d764c78 7216DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0,
dfff8a69 7217 "Internal function called by `display-color-p', which see.")
ee78dc32
GV		 7218 (display)
7219 Lisp_Object display;
7220{
fbd6baed 7221 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV		 7222
7223 if ((dpyinfo->n_planes * dpyinfo->n_cbits) <= 2)
7224 return Qnil;
7225
7226 return Qt;
7227}
7228
7229DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p, Sx_display_grayscale_p,
7230 0, 1, 0,
7231 "Return t if the X display supports shades of gray.\n\
7232Note that color displays do support shades of gray.\n\
7233The optional argument DISPLAY specifies which display to ask about.\n\
7234DISPLAY should be either a frame or a display name (a string).\n\
7235If omitted or nil, that stands for the selected frame's display.")
7236 (display)
7237 Lisp_Object display;
7238{
fbd6baed 7239 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV		 7240
7241 if ((dpyinfo->n_planes * dpyinfo->n_cbits) <= 1)
7242 return Qnil;
7243
7244 return Qt;
7245}
7246
7247DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width,
7248 0, 1, 0,
7249 "Returns the width in pixels of the X display DISPLAY.\n\
7250The optional argument DISPLAY specifies which display to ask about.\n\
7251DISPLAY should be either a frame or a display name (a string).\n\
7252If omitted or nil, that stands for the selected frame's display.")
7253 (display)
7254 Lisp_Object display;
7255{
fbd6baed 7256 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV		 7257
7258 return make_number (dpyinfo->width);
7259}
7260
7261DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
7262 Sx_display_pixel_height, 0, 1, 0,
7263 "Returns the height in pixels of the X display DISPLAY.\n\
7264The optional argument DISPLAY specifies which display to ask about.\n\
7265DISPLAY should be either a frame or a display name (a string).\n\
7266If omitted or nil, that stands for the selected frame's display.")
7267 (display)
7268 Lisp_Object display;
7269{
fbd6baed 7270 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV		 7271
7272 return make_number (dpyinfo->height);
7273}
7274
7275DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
7276 0, 1, 0,
7277 "Returns the number of bitplanes of the display DISPLAY.\n\
7278The optional argument DISPLAY specifies which display to ask about.\n\
7279DISPLAY should be either a frame or a display name (a string).\n\
7280If omitted or nil, that stands for the selected frame's display.")
7281 (display)
7282 Lisp_Object display;
7283{
fbd6baed 7284 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV		 7285
7286 return make_number (dpyinfo->n_planes * dpyinfo->n_cbits);
7287}
7288
7289DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
7290 0, 1, 0,
7291 "Returns the number of color cells of the display DISPLAY.\n\
7292The optional argument DISPLAY specifies which display to ask about.\n\
7293DISPLAY should be either a frame or a display name (a string).\n\
7294If omitted or nil, that stands for the selected frame's display.")
7295 (display)
7296 Lisp_Object display;
7297{
fbd6baed 7298 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV		 7299 HDC hdc;
7300 int cap;
7301
5ac45f98
GV		 7302 hdc = GetDC (dpyinfo->root_window);
7303 if (dpyinfo->has_palette)
7304 cap = GetDeviceCaps (hdc,SIZEPALETTE);
7305 else
7306 cap = GetDeviceCaps (hdc,NUMCOLORS);
abf8c61b
AI		 7307
7308 if (cap < 0)
7309 cap = 1 << (dpyinfo->n_planes * dpyinfo->n_cbits);
ee78dc32
GV		 7310
7311 ReleaseDC (dpyinfo->root_window, hdc);
7312
7313 return make_number (cap);
7314}
7315
7316DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
7317 Sx_server_max_request_size,
7318 0, 1, 0,
7319 "Returns the maximum request size of the server of display DISPLAY.\n\
7320The optional argument DISPLAY specifies which display to ask about.\n\
7321DISPLAY should be either a frame or a display name (a string).\n\
7322If omitted or nil, that stands for the selected frame's display.")
7323 (display)
7324 Lisp_Object display;
7325{
fbd6baed 7326 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV		 7327
7328 return make_number (1);
7329}
7330
7331DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
fbd6baed 7332 "Returns the vendor ID string of the W32 system (Microsoft).\n\
ee78dc32
GV		 7333The optional argument DISPLAY specifies which display to ask about.\n\
7334DISPLAY should be either a frame or a display name (a string).\n\
7335If omitted or nil, that stands for the selected frame's display.")
7336 (display)
7337 Lisp_Object display;
7338{
dfff8a69 7339 return build_string ("Microsoft Corp.");
ee78dc32
GV		 7340}
7341
7342DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
7343 "Returns the version numbers of the server of display DISPLAY.\n\
7344The value is a list of three integers: the major and minor\n\
7345version numbers, and the vendor-specific release\n\
7346number. See also the function `x-server-vendor'.\n\n\
7347The optional argument DISPLAY specifies which display to ask about.\n\
7348DISPLAY should be either a frame or a display name (a string).\n\
7349If omitted or nil, that stands for the selected frame's display.")
7350 (display)
7351 Lisp_Object display;
7352{
fbd6baed 7353 return Fcons (make_number (w32_major_version),
58e0f0e4
AI		 7354 Fcons (make_number (w32_minor_version),
7355 Fcons (make_number (w32_build_number), Qnil)));
ee78dc32
GV		 7356}
7357
7358DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
7359 "Returns the number of screens on the server of display DISPLAY.\n\
7360The optional argument DISPLAY specifies which display to ask about.\n\
7361DISPLAY should be either a frame or a display name (a string).\n\
7362If omitted or nil, that stands for the selected frame's display.")
7363 (display)
7364 Lisp_Object display;
7365{
ee78dc32
GV		 7366 return make_number (1);
7367}
7368
7369DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, 0,
7370 "Returns the height in millimeters of the X display DISPLAY.\n\
7371The optional argument DISPLAY specifies which display to ask about.\n\
7372DISPLAY should be either a frame or a display name (a string).\n\
7373If omitted or nil, that stands for the selected frame's display.")
7374 (display)
7375 Lisp_Object display;
7376{
fbd6baed 7377 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV		 7378 HDC hdc;
7379 int cap;
7380
5ac45f98 7381 hdc = GetDC (dpyinfo->root_window);
3c190163 7382
ee78dc32 7383 cap = GetDeviceCaps (hdc, VERTSIZE);
3c190163 7384
ee78dc32
GV		 7385 ReleaseDC (dpyinfo->root_window, hdc);
7386
7387 return make_number (cap);
7388}
7389
7390DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
7391 "Returns the width in millimeters of the X display DISPLAY.\n\
7392The optional argument DISPLAY specifies which display to ask about.\n\
7393DISPLAY should be either a frame or a display name (a string).\n\
7394If omitted or nil, that stands for the selected frame's display.")
7395 (display)
7396 Lisp_Object display;
7397{
fbd6baed 7398 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV		 7399
7400 HDC hdc;
7401 int cap;
7402
5ac45f98 7403 hdc = GetDC (dpyinfo->root_window);
3c190163 7404
ee78dc32 7405 cap = GetDeviceCaps (hdc, HORZSIZE);
3c190163 7406
ee78dc32
GV		 7407 ReleaseDC (dpyinfo->root_window, hdc);
7408
7409 return make_number (cap);
7410}
7411
7412DEFUN ("x-display-backing-store", Fx_display_backing_store,
7413 Sx_display_backing_store, 0, 1, 0,
7414 "Returns an indication of whether display DISPLAY does backing store.\n\
7415The value may be `always', `when-mapped', or `not-useful'.\n\
7416The optional argument DISPLAY specifies which display to ask about.\n\
7417DISPLAY should be either a frame or a display name (a string).\n\
7418If omitted or nil, that stands for the selected frame's display.")
7419 (display)
7420 Lisp_Object display;
7421{
7422 return intern ("not-useful");
7423}
7424
7425DEFUN ("x-display-visual-class", Fx_display_visual_class,
7426 Sx_display_visual_class, 0, 1, 0,
7427 "Returns the visual class of the display DISPLAY.\n\
7428The value is one of the symbols `static-gray', `gray-scale',\n\
7429`static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
7430The optional argument DISPLAY specifies which display to ask about.\n\
7431DISPLAY should be either a frame or a display name (a string).\n\
7432If omitted or nil, that stands for the selected frame's display.")
7433 (display)
7434 Lisp_Object display;
7435{
fbd6baed 7436 struct w32_display_info *dpyinfo = check_x_display_info (display);
abf8c61b 7437 Lisp_Object result = Qnil;
ee78dc32 7438
abf8c61b
AI		 7439 if (dpyinfo->has_palette)
7440 result = intern ("pseudo-color");
7441 else if (dpyinfo->n_planes * dpyinfo->n_cbits == 1)
7442 result = intern ("static-grey");
7443 else if (dpyinfo->n_planes * dpyinfo->n_cbits == 4)
7444 result = intern ("static-color");
7445 else if (dpyinfo->n_planes * dpyinfo->n_cbits > 8)
7446 result = intern ("true-color");
ee78dc32 7447
abf8c61b 7448 return result;
ee78dc32
GV		 7449}
7450
7451DEFUN ("x-display-save-under", Fx_display_save_under,
7452 Sx_display_save_under, 0, 1, 0,
7453 "Returns t if the display DISPLAY supports the save-under feature.\n\
7454The optional argument DISPLAY specifies which display to ask about.\n\
7455DISPLAY should be either a frame or a display name (a string).\n\
7456If omitted or nil, that stands for the selected frame's display.")
7457 (display)
7458 Lisp_Object display;
7459{
6fc2811b
JR		 7460 return Qnil;
7461}
7462\f
7463int
7464x_pixel_width (f)
7465 register struct frame *f;
7466{
7467 return PIXEL_WIDTH (f);
7468}
7469
7470int
7471x_pixel_height (f)
7472 register struct frame *f;
7473{
7474 return PIXEL_HEIGHT (f);
7475}
7476
7477int
7478x_char_width (f)
7479 register struct frame *f;
7480{
7481 return FONT_WIDTH (f->output_data.w32->font);
7482}
7483
7484int
7485x_char_height (f)
7486 register struct frame *f;
7487{
7488 return f->output_data.w32->line_height;
7489}
7490
7491int
7492x_screen_planes (f)
7493 register struct frame *f;
7494{
7495 return FRAME_W32_DISPLAY_INFO (f)->n_planes;
7496}
7497\f
7498/* Return the display structure for the display named NAME.
7499 Open a new connection if necessary. */
7500
7501struct w32_display_info *
7502x_display_info_for_name (name)
7503 Lisp_Object name;
7504{
7505 Lisp_Object names;
7506 struct w32_display_info *dpyinfo;
7507
7508 CHECK_STRING (name, 0);
7509
7510 for (dpyinfo = &one_w32_display_info, names = w32_display_name_list;
7511 dpyinfo;
7512 dpyinfo = dpyinfo->next, names = XCDR (names))
7513 {
7514 Lisp_Object tem;
7515 tem = Fstring_equal (XCAR (XCAR (names)), name);
7516 if (!NILP (tem))
7517 return dpyinfo;
7518 }
7519
7520 /* Use this general default value to start with. */
7521 Vx_resource_name = Vinvocation_name;
7522
7523 validate_x_resource_name ();
7524
7525 dpyinfo = w32_term_init (name, (unsigned char *)0,
7526 (char *) XSTRING (Vx_resource_name)->data);
7527
7528 if (dpyinfo == 0)
7529 error ("Cannot connect to server %s", XSTRING (name)->data);
7530
7531 w32_in_use = 1;
7532 XSETFASTINT (Vwindow_system_version, 3);
7533
7534 return dpyinfo;
7535}
7536
7537DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
7538 1, 3, 0, "Open a connection to a server.\n\
7539DISPLAY is the name of the display to connect to.\n\
7540Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
7541If the optional third arg MUST-SUCCEED is non-nil,\n\
7542terminate Emacs if we can't open the connection.")
7543 (display, xrm_string, must_succeed)
7544 Lisp_Object display, xrm_string, must_succeed;
7545{
7546 unsigned char *xrm_option;
7547 struct w32_display_info *dpyinfo;
7548
7549 CHECK_STRING (display, 0);
7550 if (! NILP (xrm_string))
7551 CHECK_STRING (xrm_string, 1);
7552
7553 if (! EQ (Vwindow_system, intern ("w32")))
7554 error ("Not using Microsoft Windows");
7555
7556 /* Allow color mapping to be defined externally; first look in user's
7557 HOME directory, then in Emacs etc dir for a file called rgb.txt. */
7558 {
7559 Lisp_Object color_file;
7560 struct gcpro gcpro1;
7561
7562 color_file = build_string("~/rgb.txt");
7563
7564 GCPRO1 (color_file);
7565
7566 if (NILP (Ffile_readable_p (color_file)))
7567 color_file =
7568 Fexpand_file_name (build_string ("rgb.txt"),
7569 Fsymbol_value (intern ("data-directory")));
7570
7571 Vw32_color_map = Fw32_load_color_file (color_file);
7572
7573 UNGCPRO;
7574 }
7575 if (NILP (Vw32_color_map))
7576 Vw32_color_map = Fw32_default_color_map ();
7577
7578 if (! NILP (xrm_string))
7579 xrm_option = (unsigned char *) XSTRING (xrm_string)->data;
7580 else
7581 xrm_option = (unsigned char *) 0;
7582
7583 /* Use this general default value to start with. */
7584 /* First remove .exe suffix from invocation-name - it looks ugly. */
7585 {
7586 char basename[ MAX_PATH ], *str;
7587
7588 strcpy (basename, XSTRING (Vinvocation_name)->data);
7589 str = strrchr (basename, '.');
7590 if (str) *str = 0;
7591 Vinvocation_name = build_string (basename);
7592 }
7593 Vx_resource_name = Vinvocation_name;
7594
7595 validate_x_resource_name ();
7596
7597 /* This is what opens the connection and sets x_current_display.
7598 This also initializes many symbols, such as those used for input. */
7599 dpyinfo = w32_term_init (display, xrm_option,
7600 (char *) XSTRING (Vx_resource_name)->data);
7601
7602 if (dpyinfo == 0)
7603 {
7604 if (!NILP (must_succeed))
7605 fatal ("Cannot connect to server %s.\n",
7606 XSTRING (display)->data);
7607 else
7608 error ("Cannot connect to server %s", XSTRING (display)->data);
7609 }
7610
7611 w32_in_use = 1;
7612
7613 XSETFASTINT (Vwindow_system_version, 3);
7614 return Qnil;
7615}
7616
7617DEFUN ("x-close-connection", Fx_close_connection,
7618 Sx_close_connection, 1, 1, 0,
7619 "Close the connection to DISPLAY's server.\n\
7620For DISPLAY, specify either a frame or a display name (a string).\n\
7621If DISPLAY is nil, that stands for the selected frame's display.")
7622 (display)
7623 Lisp_Object display;
7624{
7625 struct w32_display_info *dpyinfo = check_x_display_info (display);
7626 int i;
7627
7628 if (dpyinfo->reference_count > 0)
7629 error ("Display still has frames on it");
7630
7631 BLOCK_INPUT;
7632 /* Free the fonts in the font table. */
7633 for (i = 0; i < dpyinfo->n_fonts; i++)
7634 if (dpyinfo->font_table[i].name)
7635 {
126f2e35
JR		 7636 if (dpyinfo->font_table[i].name != dpyinfo->font_table[i].full_name)
7637 xfree (dpyinfo->font_table[i].full_name);
6fc2811b 7638 xfree (dpyinfo->font_table[i].name);
6fc2811b
JR		 7639 w32_unload_font (dpyinfo, dpyinfo->font_table[i].font);
7640 }
7641 x_destroy_all_bitmaps (dpyinfo);
7642
7643 x_delete_display (dpyinfo);
7644 UNBLOCK_INPUT;
7645
7646 return Qnil;
7647}
7648
7649DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0,
7650 "Return the list of display names that Emacs has connections to.")
7651 ()
7652{
7653 Lisp_Object tail, result;
7654
7655 result = Qnil;
7656 for (tail = w32_display_name_list; ! NILP (tail); tail = XCDR (tail))
7657 result = Fcons (XCAR (XCAR (tail)), result);
7658
7659 return result;
7660}
7661
7662DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize, 1, 2, 0,
7663 "If ON is non-nil, report errors as soon as the erring request is made.\n\
7664If ON is nil, allow buffering of requests.\n\
7665This is a noop on W32 systems.\n\
7666The optional second argument DISPLAY specifies which display to act on.\n\
7667DISPLAY should be either a frame or a display name (a string).\n\
7668If DISPLAY is omitted or nil, that stands for the selected frame's display.")
7669 (on, display)
7670 Lisp_Object display, on;
7671{
6fc2811b
JR		 7672 return Qnil;
7673}
7674
7675\f
7676\f
7677/***********************************************************************
7678 Image types
7679 ***********************************************************************/
7680
7681/* Value is the number of elements of vector VECTOR. */
7682
7683#define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
7684
7685/* List of supported image types. Use define_image_type to add new
7686 types. Use lookup_image_type to find a type for a given symbol. */
7687
7688static struct image_type *image_types;
7689
6fc2811b
JR		 7690/* The symbol `image' which is the car of the lists used to represent
7691 images in Lisp. */
7692
7693extern Lisp_Object Qimage;
7694
7695/* The symbol `xbm' which is used as the type symbol for XBM images. */
7696
7697Lisp_Object Qxbm;
7698
7699/* Keywords. */
7700
6fc2811b 7701extern Lisp_Object QCwidth, QCheight, QCforeground, QCbackground, QCfile;
dfff8a69
JR		 7702extern Lisp_Object QCdata;
7703Lisp_Object QCtype, QCascent, QCmargin, QCrelief;
a93f4566 7704Lisp_Object QCconversion, QCcolor_symbols, QCheuristic_mask;
3cf3436e 7705Lisp_Object QCindex, QCmatrix, QCcolor_adjustment, QCmask;
6fc2811b
JR		 7706
7707/* Other symbols. */
7708
3cf3436e 7709Lisp_Object Qlaplace, Qemboss, Qedge_detection, Qheuristic;
6fc2811b
JR		 7710
7711/* Time in seconds after which images should be removed from the cache
7712 if not displayed. */
7713
7714Lisp_Object Vimage_cache_eviction_delay;
7715
7716/* Function prototypes. */
7717
7718static void define_image_type P_ ((struct image_type *type));
7719static struct image_type *lookup_image_type P_ ((Lisp_Object symbol));
7720static void image_error P_ ((char *format, Lisp_Object, Lisp_Object));
7721static void x_laplace P_ ((struct frame *, struct image *));
3cf3436e 7722static void x_emboss P_ ((struct frame *, struct image *));
6fc2811b
JR		 7723static int x_build_heuristic_mask P_ ((struct frame *, struct image *,
7724 Lisp_Object));
7725
dfff8a69 7726
6fc2811b
JR		 7727/* Define a new image type from TYPE. This adds a copy of TYPE to
7728 image_types and adds the symbol *TYPE->type to Vimage_types. */
7729
7730static void
7731define_image_type (type)
7732 struct image_type *type;
7733{
7734 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
7735 The initialized data segment is read-only. */
7736 struct image_type *p = (struct image_type *) xmalloc (sizeof *p);
7737 bcopy (type, p, sizeof *p);
7738 p->next = image_types;
7739 image_types = p;
7740 Vimage_types = Fcons (*p->type, Vimage_types);
7741}
7742
7743
7744/* Look up image type SYMBOL, and return a pointer to its image_type
7745 structure. Value is null if SYMBOL is not a known image type. */
7746
7747static INLINE struct image_type *
7748lookup_image_type (symbol)
7749 Lisp_Object symbol;
7750{
7751 struct image_type *type;
7752
7753 for (type = image_types; type; type = type->next)
7754 if (EQ (symbol, *type->type))
7755 break;
7756
7757 return type;
7758}
7759
7760
7761/* Value is non-zero if OBJECT is a valid Lisp image specification. A
7762 valid image specification is a list whose car is the symbol
7763 `image', and whose rest is a property list. The property list must
7764 contain a value for key `:type'. That value must be the name of a
7765 supported image type. The rest of the property list depends on the
7766 image type. */
7767
7768int
7769valid_image_p (object)
7770 Lisp_Object object;
7771{
7772 int valid_p = 0;
7773
7774 if (CONSP (object) && EQ (XCAR (object), Qimage))
7775 {
3cf3436e
JR		 7776 Lisp_Object tem;
7777
7778 for (tem = XCDR (object); CONSP (tem); tem = XCDR (tem))
7779 if (EQ (XCAR (tem), QCtype))
7780 {
7781 tem = XCDR (tem);
7782 if (CONSP (tem) && SYMBOLP (XCAR (tem)))
7783 {
7784 struct image_type *type;
7785 type = lookup_image_type (XCAR (tem));
7786 if (type)
7787 valid_p = type->valid_p (object);
7788 }
7789
7790 break;
7791 }
6fc2811b
JR		 7792 }
7793
7794 return valid_p;
7795}
7796
7797
7798/* Log error message with format string FORMAT and argument ARG.
7799 Signaling an error, e.g. when an image cannot be loaded, is not a
7800 good idea because this would interrupt redisplay, and the error
7801 message display would lead to another redisplay. This function
7802 therefore simply displays a message. */
7803
7804static void
7805image_error (format, arg1, arg2)
7806 char *format;
7807 Lisp_Object arg1, arg2;
7808{
7809 add_to_log (format, arg1, arg2);
7810}
7811
7812
7813\f
7814/***********************************************************************
7815 Image specifications
7816 ***********************************************************************/
7817
7818enum image_value_type
7819{
7820 IMAGE_DONT_CHECK_VALUE_TYPE,
7821 IMAGE_STRING_VALUE,
3cf3436e 7822 IMAGE_STRING_OR_NIL_VALUE,
6fc2811b
JR		 7823 IMAGE_SYMBOL_VALUE,
7824 IMAGE_POSITIVE_INTEGER_VALUE,
8edb0a6f 7825 IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR,
6fc2811b 7826 IMAGE_NON_NEGATIVE_INTEGER_VALUE,
dfff8a69 7827 IMAGE_ASCENT_VALUE,
6fc2811b
JR		 7828 IMAGE_INTEGER_VALUE,
7829 IMAGE_FUNCTION_VALUE,
7830 IMAGE_NUMBER_VALUE,
7831 IMAGE_BOOL_VALUE
7832};
7833
7834/* Structure used when parsing image specifications. */
7835
7836struct image_keyword
7837{
7838 /* Name of keyword. */
7839 char *name;
7840
7841 /* The type of value allowed. */
7842 enum image_value_type type;
7843
7844 /* Non-zero means key must be present. */
7845 int mandatory_p;
7846
7847 /* Used to recognize duplicate keywords in a property list. */
7848 int count;
7849
7850 /* The value that was found. */
7851 Lisp_Object value;
7852};
7853
7854
7855static int parse_image_spec P_ ((Lisp_Object, struct image_keyword *,
7856 int, Lisp_Object));
7857static Lisp_Object image_spec_value P_ ((Lisp_Object, Lisp_Object, int *));
7858
7859
7860/* Parse image spec SPEC according to KEYWORDS. A valid image spec
7861 has the format (image KEYWORD VALUE ...). One of the keyword/
7862 value pairs must be `:type TYPE'. KEYWORDS is a vector of
7863 image_keywords structures of size NKEYWORDS describing other
7864 allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
7865
7866static int
7867parse_image_spec (spec, keywords, nkeywords, type)
7868 Lisp_Object spec;
7869 struct image_keyword *keywords;
7870 int nkeywords;
7871 Lisp_Object type;
7872{
7873 int i;
7874 Lisp_Object plist;
7875
7876 if (!CONSP (spec) || !EQ (XCAR (spec), Qimage))
7877 return 0;
7878
7879 plist = XCDR (spec);
7880 while (CONSP (plist))
7881 {
7882 Lisp_Object key, value;
7883
7884 /* First element of a pair must be a symbol. */
7885 key = XCAR (plist);
7886 plist = XCDR (plist);
7887 if (!SYMBOLP (key))
7888 return 0;
7889
7890 /* There must follow a value. */
7891 if (!CONSP (plist))
7892 return 0;
7893 value = XCAR (plist);
7894 plist = XCDR (plist);
7895
7896 /* Find key in KEYWORDS. Error if not found. */
7897 for (i = 0; i < nkeywords; ++i)
7898 if (strcmp (keywords[i].name, XSYMBOL (key)->name->data) == 0)
7899 break;
7900
7901 if (i == nkeywords)
7902 continue;
7903
7904 /* Record that we recognized the keyword. If a keywords
7905 was found more than once, it's an error. */
7906 keywords[i].value = value;
7907 ++keywords[i].count;
7908
7909 if (keywords[i].count > 1)
7910 return 0;
7911
7912 /* Check type of value against allowed type. */
7913 switch (keywords[i].type)
7914 {
7915 case IMAGE_STRING_VALUE:
7916 if (!STRINGP (value))
7917 return 0;
7918 break;
7919
3cf3436e
JR		 7920 case IMAGE_STRING_OR_NIL_VALUE:
7921 if (!STRINGP (value) && !NILP (value))
7922 return 0;
7923 break;
7924
6fc2811b
JR		 7925 case IMAGE_SYMBOL_VALUE:
7926 if (!SYMBOLP (value))
7927 return 0;
7928 break;
7929
7930 case IMAGE_POSITIVE_INTEGER_VALUE:
7931 if (!INTEGERP (value) || XINT (value) <= 0)
7932 return 0;
7933 break;
7934
8edb0a6f
JR		 7935 case IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR:
7936 if (INTEGERP (value) && XINT (value) >= 0)
7937 break;
7938 if (CONSP (value)
7939 && INTEGERP (XCAR (value)) && INTEGERP (XCDR (value))
7940 && XINT (XCAR (value)) >= 0 && XINT (XCDR (value)) >= 0)
7941 break;
7942 return 0;
7943
dfff8a69
JR		 7944 case IMAGE_ASCENT_VALUE:
7945 if (SYMBOLP (value) && EQ (value, Qcenter))
7946 break;
7947 else if (INTEGERP (value)
7948 && XINT (value) >= 0
7949 && XINT (value) <= 100)
7950 break;
7951 return 0;
7952
6fc2811b
JR		 7953 case IMAGE_NON_NEGATIVE_INTEGER_VALUE:
7954 if (!INTEGERP (value) || XINT (value) < 0)
7955 return 0;
7956 break;
7957
7958 case IMAGE_DONT_CHECK_VALUE_TYPE:
7959 break;
7960
7961 case IMAGE_FUNCTION_VALUE:
7962 value = indirect_function (value);
7963 if (SUBRP (value)
7964 || COMPILEDP (value)
7965 || (CONSP (value) && EQ (XCAR (value), Qlambda)))
7966 break;
7967 return 0;
7968
7969 case IMAGE_NUMBER_VALUE:
7970 if (!INTEGERP (value) && !FLOATP (value))
7971 return 0;
7972 break;
7973
7974 case IMAGE_INTEGER_VALUE:
7975 if (!INTEGERP (value))
7976 return 0;
7977 break;
7978
7979 case IMAGE_BOOL_VALUE:
7980 if (!NILP (value) && !EQ (value, Qt))
7981 return 0;
7982 break;
7983
7984 default:
7985 abort ();
7986 break;
7987 }
7988
7989 if (EQ (key, QCtype) && !EQ (type, value))
7990 return 0;
7991 }
7992
7993 /* Check that all mandatory fields are present. */
7994 for (i = 0; i < nkeywords; ++i)
7995 if (keywords[i].mandatory_p && keywords[i].count == 0)
7996 return 0;
7997
7998 return NILP (plist);
7999}
8000
8001
8002/* Return the value of KEY in image specification SPEC. Value is nil
8003 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
8004 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
8005
8006static Lisp_Object
8007image_spec_value (spec, key, found)
8008 Lisp_Object spec, key;
8009 int *found;
8010{
8011 Lisp_Object tail;
8012
8013 xassert (valid_image_p (spec));
8014
8015 for (tail = XCDR (spec);
8016 CONSP (tail) && CONSP (XCDR (tail));
8017 tail = XCDR (XCDR (tail)))
8018 {
8019 if (EQ (XCAR (tail), key))
8020 {
8021 if (found)
8022 *found = 1;
8023 return XCAR (XCDR (tail));
8024 }
8025 }
8026
8027 if (found)
8028 *found = 0;
8029 return Qnil;
8030}
8031
8032
8033
8034\f
8035/***********************************************************************
8036 Image type independent image structures
8037 ***********************************************************************/
8038
8039static struct image *make_image P_ ((Lisp_Object spec, unsigned hash));
8040static void free_image P_ ((struct frame *f, struct image *img));
8041
8042
8043/* Allocate and return a new image structure for image specification
8044 SPEC. SPEC has a hash value of HASH. */
8045
8046static struct image *
8047make_image (spec, hash)
8048 Lisp_Object spec;
8049 unsigned hash;
8050{
8051 struct image *img = (struct image *) xmalloc (sizeof *img);
8052
8053 xassert (valid_image_p (spec));
8054 bzero (img, sizeof *img);
8055 img->type = lookup_image_type (image_spec_value (spec, QCtype, NULL));
8056 xassert (img->type != NULL);
8057 img->spec = spec;
8058 img->data.lisp_val = Qnil;
8059 img->ascent = DEFAULT_IMAGE_ASCENT;
8060 img->hash = hash;
8061 return img;
8062}
8063
8064
8065/* Free image IMG which was used on frame F, including its resources. */
8066
8067static void
8068free_image (f, img)
8069 struct frame *f;
8070 struct image *img;
8071{
8072 if (img)
8073 {
8074 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
8075
8076 /* Remove IMG from the hash table of its cache. */
8077 if (img->prev)
8078 img->prev->next = img->next;
8079 else
8080 c->buckets[img->hash % IMAGE_CACHE_BUCKETS_SIZE] = img->next;
8081
8082 if (img->next)
8083 img->next->prev = img->prev;
8084
8085 c->images[img->id] = NULL;
8086
8087 /* Free resources, then free IMG. */
8088 img->type->free (f, img);
8089 xfree (img);
8090 }
8091}
8092
8093
8094/* Prepare image IMG for display on frame F. Must be called before
8095 drawing an image. */
8096
8097void
8098prepare_image_for_display (f, img)
8099 struct frame *f;
8100 struct image *img;
8101{
8102 EMACS_TIME t;
8103
8104 /* We're about to display IMG, so set its timestamp to `now'. */
8105 EMACS_GET_TIME (t);
8106 img->timestamp = EMACS_SECS (t);
8107
8108 /* If IMG doesn't have a pixmap yet, load it now, using the image
8109 type dependent loader function. */
8110 if (img->pixmap == 0 && !img->load_failed_p)
8111 img->load_failed_p = img->type->load (f, img) == 0;
8112}
8113
8114
dfff8a69
JR		 8115/* Value is the number of pixels for the ascent of image IMG when
8116 drawn in face FACE. */
8117
8118int
8119image_ascent (img, face)
8120 struct image *img;
8121 struct face *face;
8122{
8edb0a6f 8123 int height = img->height + img->vmargin;
dfff8a69
JR		 8124 int ascent;
8125
8126 if (img->ascent == CENTERED_IMAGE_ASCENT)
8127 {
8128 if (face->font)
8129 ascent = height / 2 - (FONT_DESCENT(face->font)
8130 - FONT_BASE(face->font)) / 2;
8131 else
8132 ascent = height / 2;
8133 }
8134 else
8135 ascent = height * img->ascent / 100.0;
8136
8137 return ascent;
8138}
8139
8140
6fc2811b
JR		 8141\f
8142/***********************************************************************
8143 Helper functions for X image types
8144 ***********************************************************************/
8145
8146static void x_clear_image P_ ((struct frame *f, struct image *img));
8147static unsigned long x_alloc_image_color P_ ((struct frame *f,
8148 struct image *img,
8149 Lisp_Object color_name,
8150 unsigned long dflt));
8151
8152/* Free X resources of image IMG which is used on frame F. */
8153
8154static void
8155x_clear_image (f, img)
8156 struct frame *f;
8157 struct image *img;
8158{
767b1ff0 8159#if 0 /* TODO: W32 image support */
6fc2811b
JR		 8160
8161 if (img->pixmap)
8162 {
8163 BLOCK_INPUT;
8164 XFreePixmap (NULL, img->pixmap);
8165 img->pixmap = 0;
8166 UNBLOCK_INPUT;
8167 }
8168
8169 if (img->ncolors)
8170 {
8171 int class = FRAME_W32_DISPLAY_INFO (f)->visual->class;
8172
8173 /* If display has an immutable color map, freeing colors is not
8174 necessary and some servers don't allow it. So don't do it. */
8175 if (class != StaticColor
8176 && class != StaticGray
8177 && class != TrueColor)
8178 {
8179 Colormap cmap;
8180 BLOCK_INPUT;
8181 cmap = DefaultColormapOfScreen (FRAME_W32_DISPLAY_INFO (f)->screen);
8182 XFreeColors (FRAME_W32_DISPLAY (f), cmap, img->colors,
8183 img->ncolors, 0);
8184 UNBLOCK_INPUT;
8185 }
8186
8187 xfree (img->colors);
8188 img->colors = NULL;
8189 img->ncolors = 0;
8190 }
8191#endif
8192}
8193
8194
8195/* Allocate color COLOR_NAME for image IMG on frame F. If color
8196 cannot be allocated, use DFLT. Add a newly allocated color to
8197 IMG->colors, so that it can be freed again. Value is the pixel
8198 color. */
8199
8200static unsigned long
8201x_alloc_image_color (f, img, color_name, dflt)
8202 struct frame *f;
8203 struct image *img;
8204 Lisp_Object color_name;
8205 unsigned long dflt;
8206{
767b1ff0 8207#if 0 /* TODO: allocing colors. */
6fc2811b
JR		 8208 XColor color;
8209 unsigned long result;
8210
8211 xassert (STRINGP (color_name));
8212
8213 if (w32_defined_color (f, XSTRING (color_name)->data, &color, 1))
8214 {
8215 /* This isn't called frequently so we get away with simply
8216 reallocating the color vector to the needed size, here. */
8217 ++img->ncolors;
8218 img->colors =
8219 (unsigned long *) xrealloc (img->colors,
8220 img->ncolors * sizeof *img->colors);
8221 img->colors[img->ncolors - 1] = color.pixel;
8222 result = color.pixel;
8223 }
8224 else
8225 result = dflt;
8226 return result;
8227#endif
8228 return 0;
8229}
8230
8231
8232\f
8233/***********************************************************************
8234 Image Cache
8235 ***********************************************************************/
8236
8237static void cache_image P_ ((struct frame *f, struct image *img));
3cf3436e 8238static void postprocess_image P_ ((struct frame *, struct image *));
6fc2811b
JR		 8239
8240
8241/* Return a new, initialized image cache that is allocated from the
8242 heap. Call free_image_cache to free an image cache. */
8243
8244struct image_cache *
8245make_image_cache ()
8246{
8247 struct image_cache *c = (struct image_cache *) xmalloc (sizeof *c);
8248 int size;
8249
8250 bzero (c, sizeof *c);
8251 c->size = 50;
8252 c->images = (struct image **) xmalloc (c->size * sizeof *c->images);
8253 size = IMAGE_CACHE_BUCKETS_SIZE * sizeof *c->buckets;
8254 c->buckets = (struct image **) xmalloc (size);
8255 bzero (c->buckets, size);
8256 return c;
8257}
8258
8259
8260/* Free image cache of frame F. Be aware that X frames share images
8261 caches. */
8262
8263void
8264free_image_cache (f)
8265 struct frame *f;
8266{
8267 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
8268 if (c)
8269 {
8270 int i;
8271
8272 /* Cache should not be referenced by any frame when freed. */
8273 xassert (c->refcount == 0);
8274
8275 for (i = 0; i < c->used; ++i)
8276 free_image (f, c->images[i]);
8277 xfree (c->images);
8278 xfree (c);
8279 xfree (c->buckets);
8280 FRAME_X_IMAGE_CACHE (f) = NULL;
8281 }
8282}
8283
8284
8285/* Clear image cache of frame F. FORCE_P non-zero means free all
8286 images. FORCE_P zero means clear only images that haven't been
8287 displayed for some time. Should be called from time to time to
dfff8a69
JR		 8288 reduce the number of loaded images. If image-eviction-seconds is
8289 non-nil, this frees images in the cache which weren't displayed for
6fc2811b
JR		 8290 at least that many seconds. */
8291
8292void
8293clear_image_cache (f, force_p)
8294 struct frame *f;
8295 int force_p;
8296{
8297 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
8298
8299 if (c && INTEGERP (Vimage_cache_eviction_delay))
8300 {
8301 EMACS_TIME t;
8302 unsigned long old;
8303 int i, any_freed_p = 0;
8304
8305 EMACS_GET_TIME (t);
8306 old = EMACS_SECS (t) - XFASTINT (Vimage_cache_eviction_delay);
8307
8308 for (i = 0; i < c->used; ++i)
8309 {
8310 struct image *img = c->images[i];
8311 if (img != NULL
8312 && (force_p
8313 || (img->timestamp > old)))
8314 {
8315 free_image (f, img);
8316 any_freed_p = 1;
8317 }
8318 }
8319
8320 /* We may be clearing the image cache because, for example,
8321 Emacs was iconified for a longer period of time. In that
8322 case, current matrices may still contain references to
8323 images freed above. So, clear these matrices. */
8324 if (any_freed_p)
8325 {
8326 clear_current_matrices (f);
8327 ++windows_or_buffers_changed;
8328 }
8329 }
8330}
8331
8332
8333DEFUN ("clear-image-cache", Fclear_image_cache, Sclear_image_cache,
8334 0, 1, 0,
8335 "Clear the image cache of FRAME.\n\
8336FRAME nil or omitted means use the selected frame.\n\
8337FRAME t means clear the image caches of all frames.")
8338 (frame)
8339 Lisp_Object frame;
8340{
8341 if (EQ (frame, Qt))
8342 {
8343 Lisp_Object tail;
8344
8345 FOR_EACH_FRAME (tail, frame)
8346 if (FRAME_W32_P (XFRAME (frame)))
8347 clear_image_cache (XFRAME (frame), 1);
8348 }
8349 else
8350 clear_image_cache (check_x_frame (frame), 1);
8351
8352 return Qnil;
8353}
8354
8355
3cf3436e
JR		 8356/* Compute masks and transform image IMG on frame F, as specified
8357 by the image's specification, */
8358
8359static void
8360postprocess_image (f, img)
8361 struct frame *f;
8362 struct image *img;
8363{
8364#if 0 /* TODO: image support. */
8365 /* Manipulation of the image's mask. */
8366 if (img->pixmap)
8367 {
8368 Lisp_Object conversion, spec;
8369 Lisp_Object mask;
8370
8371 spec = img->spec;
8372
8373 /* `:heuristic-mask t'
8374 `:mask heuristic'
8375 means build a mask heuristically.
8376 `:heuristic-mask (R G B)'
8377 `:mask (heuristic (R G B))'
8378 means build a mask from color (R G B) in the
8379 image.
8380 `:mask nil'
8381 means remove a mask, if any. */
8382
8383 mask = image_spec_value (spec, QCheuristic_mask, NULL);
8384 if (!NILP (mask))
8385 x_build_heuristic_mask (f, img, mask);
8386 else
8387 {
8388 int found_p;
8389
8390 mask = image_spec_value (spec, QCmask, &found_p);
8391
8392 if (EQ (mask, Qheuristic))
8393 x_build_heuristic_mask (f, img, Qt);
8394 else if (CONSP (mask)
8395 && EQ (XCAR (mask), Qheuristic))
8396 {
8397 if (CONSP (XCDR (mask)))
8398 x_build_heuristic_mask (f, img, XCAR (XCDR (mask)));
8399 else
8400 x_build_heuristic_mask (f, img, XCDR (mask));
8401 }
8402 else if (NILP (mask) && found_p && img->mask)
8403 {
8404 XFreePixmap (FRAME_X_DISPLAY (f), img->mask);
8405 img->mask = NULL;
8406 }
8407 }
8408
8409
8410 /* Should we apply an image transformation algorithm? */
8411 conversion = image_spec_value (spec, QCconversion, NULL);
8412 if (EQ (conversion, Qdisabled))
8413 x_disable_image (f, img);
8414 else if (EQ (conversion, Qlaplace))
8415 x_laplace (f, img);
8416 else if (EQ (conversion, Qemboss))
8417 x_emboss (f, img);
8418 else if (CONSP (conversion)
8419 && EQ (XCAR (conversion), Qedge_detection))
8420 {
8421 Lisp_Object tem;
8422 tem = XCDR (conversion);
8423 if (CONSP (tem))
8424 x_edge_detection (f, img,
8425 Fplist_get (tem, QCmatrix),
8426 Fplist_get (tem, QCcolor_adjustment));
8427 }
8428 }
8429#endif
8430}
8431
8432
6fc2811b
JR		 8433/* Return the id of image with Lisp specification SPEC on frame F.
8434 SPEC must be a valid Lisp image specification (see valid_image_p). */
8435
8436int
8437lookup_image (f, spec)
8438 struct frame *f;
8439 Lisp_Object spec;
8440{
8441 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
8442 struct image *img;
8443 int i;
8444 unsigned hash;
8445 struct gcpro gcpro1;
8446 EMACS_TIME now;
8447
8448 /* F must be a window-system frame, and SPEC must be a valid image
8449 specification. */
8450 xassert (FRAME_WINDOW_P (f));
8451 xassert (valid_image_p (spec));
8452
8453 GCPRO1 (spec);
8454
8455 /* Look up SPEC in the hash table of the image cache. */
8456 hash = sxhash (spec, 0);
8457 i = hash % IMAGE_CACHE_BUCKETS_SIZE;
8458
8459 for (img = c->buckets[i]; img; img = img->next)
8460 if (img->hash == hash && !NILP (Fequal (img->spec, spec)))
8461 break;
8462
8463 /* If not found, create a new image and cache it. */
8464 if (img == NULL)
8465 {
3cf3436e
JR		 8466 extern Lisp_Object Qpostscript;
8467
8edb0a6f 8468 BLOCK_INPUT;
6fc2811b
JR		 8469 img = make_image (spec, hash);
8470 cache_image (f, img);
8471 img->load_failed_p = img->type->load (f, img) == 0;
6fc2811b
JR		 8472
8473 /* If we can't load the image, and we don't have a width and
8474 height, use some arbitrary width and height so that we can
8475 draw a rectangle for it. */
8476 if (img->load_failed_p)
8477 {
8478 Lisp_Object value;
8479
8480 value = image_spec_value (spec, QCwidth, NULL);
8481 img->width = (INTEGERP (value)
8482 ? XFASTINT (value) : DEFAULT_IMAGE_WIDTH);
8483 value = image_spec_value (spec, QCheight, NULL);
8484 img->height = (INTEGERP (value)
8485 ? XFASTINT (value) : DEFAULT_IMAGE_HEIGHT);
8486 }
8487 else
8488 {
8489 /* Handle image type independent image attributes
8490 `:ascent PERCENT', `:margin MARGIN', `:relief RELIEF'. */
8edb0a6f 8491 Lisp_Object ascent, margin, relief;
6fc2811b
JR		 8492
8493 ascent = image_spec_value (spec, QCascent, NULL);
8494 if (INTEGERP (ascent))
8495 img->ascent = XFASTINT (ascent);
dfff8a69
JR		 8496 else if (EQ (ascent, Qcenter))
8497 img->ascent = CENTERED_IMAGE_ASCENT;
8498
6fc2811b
JR		 8499 margin = image_spec_value (spec, QCmargin, NULL);
8500 if (INTEGERP (margin) && XINT (margin) >= 0)
8edb0a6f
JR		 8501 img->vmargin = img->hmargin = XFASTINT (margin);
8502 else if (CONSP (margin) && INTEGERP (XCAR (margin))
8503 && INTEGERP (XCDR (margin)))
8504 {
8505 if (XINT (XCAR (margin)) > 0)
8506 img->hmargin = XFASTINT (XCAR (margin));
8507 if (XINT (XCDR (margin)) > 0)
8508 img->vmargin = XFASTINT (XCDR (margin));
8509 }
6fc2811b
JR		 8510
8511 relief = image_spec_value (spec, QCrelief, NULL);
8512 if (INTEGERP (relief))
8513 {
8514 img->relief = XINT (relief);
8edb0a6f
JR		 8515 img->hmargin += abs (img->relief);
8516 img->vmargin += abs (img->relief);
6fc2811b
JR		 8517 }
8518
3cf3436e
JR		 8519 /* Do image transformations and compute masks, unless we
8520 don't have the image yet. */
8521 if (!EQ (*img->type->type, Qpostscript))
8522 postprocess_image (f, img);
6fc2811b 8523 }
3cf3436e 8524
8edb0a6f
JR		 8525 UNBLOCK_INPUT;
8526 xassert (!interrupt_input_blocked);
6fc2811b
JR		 8527 }
8528
8529 /* We're using IMG, so set its timestamp to `now'. */
8530 EMACS_GET_TIME (now);
8531 img->timestamp = EMACS_SECS (now);
8532
8533 UNGCPRO;
8534
8535 /* Value is the image id. */
8536 return img->id;
8537}
8538
8539
8540/* Cache image IMG in the image cache of frame F. */
8541
8542static void
8543cache_image (f, img)
8544 struct frame *f;
8545 struct image *img;
8546{
8547 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
8548 int i;
8549
8550 /* Find a free slot in c->images. */
8551 for (i = 0; i < c->used; ++i)
8552 if (c->images[i] == NULL)
8553 break;
8554
8555 /* If no free slot found, maybe enlarge c->images. */
8556 if (i == c->used && c->used == c->size)
8557 {
8558 c->size *= 2;
8559 c->images = (struct image **) xrealloc (c->images,
8560 c->size * sizeof *c->images);
8561 }
8562
8563 /* Add IMG to c->images, and assign IMG an id. */
8564 c->images[i] = img;
8565 img->id = i;
8566 if (i == c->used)
8567 ++c->used;
8568
8569 /* Add IMG to the cache's hash table. */
8570 i = img->hash % IMAGE_CACHE_BUCKETS_SIZE;
8571 img->next = c->buckets[i];
8572 if (img->next)
8573 img->next->prev = img;
8574 img->prev = NULL;
8575 c->buckets[i] = img;
8576}
8577
8578
8579/* Call FN on every image in the image cache of frame F. Used to mark
8580 Lisp Objects in the image cache. */
8581
8582void
8583forall_images_in_image_cache (f, fn)
8584 struct frame *f;
8585 void (*fn) P_ ((struct image *img));
8586{
8587 if (FRAME_LIVE_P (f) && FRAME_W32_P (f))
8588 {
8589 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
8590 if (c)
8591 {
8592 int i;
8593 for (i = 0; i < c->used; ++i)
8594 if (c->images[i])
8595 fn (c->images[i]);
8596 }
8597 }
8598}
8599
8600
8601\f
8602/***********************************************************************
8603 W32 support code
8604 ***********************************************************************/
8605
767b1ff0 8606#if 0 /* TODO: W32 specific image code. */
6fc2811b
JR		 8607
8608static int x_create_x_image_and_pixmap P_ ((struct frame *, int, int, int,
8609 XImage **, Pixmap *));
8610static void x_destroy_x_image P_ ((XImage *));
8611static void x_put_x_image P_ ((struct frame *, XImage *, Pixmap, int, int));
8612
8613
8614/* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
8615 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
8616 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
8617 via xmalloc. Print error messages via image_error if an error
8618 occurs. Value is non-zero if successful. */
8619
8620static int
8621x_create_x_image_and_pixmap (f, width, height, depth, ximg, pixmap)
8622 struct frame *f;
8623 int width, height, depth;
8624 XImage **ximg;
8625 Pixmap *pixmap;
8626{
767b1ff0 8627#if 0 /* TODO: Image support for W32 */
6fc2811b
JR		 8628 Display *display = FRAME_W32_DISPLAY (f);
8629 Screen *screen = FRAME_X_SCREEN (f);
8630 Window window = FRAME_W32_WINDOW (f);
8631
8632 xassert (interrupt_input_blocked);
8633
8634 if (depth <= 0)
8635 depth = DefaultDepthOfScreen (screen);
8636 *ximg = XCreateImage (display, DefaultVisualOfScreen (screen),
8637 depth, ZPixmap, 0, NULL, width, height,
8638 depth > 16 ? 32 : depth > 8 ? 16 : 8, 0);
8639 if (*ximg == NULL)
8640 {
8641 image_error ("Unable to allocate X image", Qnil, Qnil);
8642 return 0;
8643 }
8644
8645 /* Allocate image raster. */
8646 (*ximg)->data = (char *) xmalloc ((*ximg)->bytes_per_line * height);
8647
8648 /* Allocate a pixmap of the same size. */
8649 *pixmap = XCreatePixmap (display, window, width, height, depth);
8650 if (*pixmap == 0)
8651 {
8652 x_destroy_x_image (*ximg);
8653 *ximg = NULL;
8654 image_error ("Unable to create X pixmap", Qnil, Qnil);
8655 return 0;
8656 }
8657#endif
8658 return 1;
8659}
8660
8661
8662/* Destroy XImage XIMG. Free XIMG->data. */
8663
8664static void
8665x_destroy_x_image (ximg)
8666 XImage *ximg;
8667{
8668 xassert (interrupt_input_blocked);
8669 if (ximg)
8670 {
8671 xfree (ximg->data);
8672 ximg->data = NULL;
8673 XDestroyImage (ximg);
8674 }
8675}
8676
8677
8678/* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
8679 are width and height of both the image and pixmap. */
8680
8681static void
8682x_put_x_image (f, ximg, pixmap, width, height)
8683 struct frame *f;
8684 XImage *ximg;
8685 Pixmap pixmap;
8686{
8687 GC gc;
8688
8689 xassert (interrupt_input_blocked);
8690 gc = XCreateGC (NULL, pixmap, 0, NULL);
8691 XPutImage (NULL, pixmap, gc, ximg, 0, 0, 0, 0, width, height);
8692 XFreeGC (NULL, gc);
8693}
8694
8695#endif
8696
8697\f
8698/***********************************************************************
3cf3436e 8699 File Handling
6fc2811b
JR		 8700 ***********************************************************************/
8701
8702static Lisp_Object x_find_image_file P_ ((Lisp_Object));
3cf3436e
JR		 8703static char *slurp_file P_ ((char *, int *));
8704
6fc2811b
JR		 8705
8706/* Find image file FILE. Look in data-directory, then
8707 x-bitmap-file-path. Value is the full name of the file found, or
8708 nil if not found. */
8709
8710static Lisp_Object
8711x_find_image_file (file)
8712 Lisp_Object file;
8713{
8714 Lisp_Object file_found, search_path;
8715 struct gcpro gcpro1, gcpro2;
8716 int fd;
8717
8718 file_found = Qnil;
8719 search_path = Fcons (Vdata_directory, Vx_bitmap_file_path);
8720 GCPRO2 (file_found, search_path);
8721
8722 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
c0ec53ad 8723 fd = openp (search_path, file, Qnil, &file_found, 0);
6fc2811b 8724
939d6465 8725 if (fd == -1)
6fc2811b
JR		 8726 file_found = Qnil;
8727 else
8728 close (fd);
8729
8730 UNGCPRO;
8731 return file_found;
8732}
8733
8734
3cf3436e
JR		 8735/* Read FILE into memory. Value is a pointer to a buffer allocated
8736 with xmalloc holding FILE's contents. Value is null if an error
8737 occurred. *SIZE is set to the size of the file. */
8738
8739static char *
8740slurp_file (file, size)
8741 char *file;
8742 int *size;
8743{
8744 FILE *fp = NULL;
8745 char *buf = NULL;
8746 struct stat st;
8747
8748 if (stat (file, &st) == 0
8749 && (fp = fopen (file, "r")) != NULL
8750 && (buf = (char *) xmalloc (st.st_size),
8751 fread (buf, 1, st.st_size, fp) == st.st_size))
8752 {
8753 *size = st.st_size;
8754 fclose (fp);
8755 }
8756 else
8757 {
8758 if (fp)
8759 fclose (fp);
8760 if (buf)
8761 {
8762 xfree (buf);
8763 buf = NULL;
8764 }
8765 }
8766
8767 return buf;
8768}
8769
8770
6fc2811b
JR		 8771\f
8772/***********************************************************************
8773 XBM images
8774 ***********************************************************************/
8775
8776static int xbm_load P_ ((struct frame *f, struct image *img));
8777static int xbm_load_image_from_file P_ ((struct frame *f, struct image *img,
8778 Lisp_Object file));
8779static int xbm_image_p P_ ((Lisp_Object object));
8780static int xbm_read_bitmap_file_data P_ ((char *, int *, int *,
8781 unsigned char **));
8782
8783
8784/* Indices of image specification fields in xbm_format, below. */
8785
8786enum xbm_keyword_index
8787{
8788 XBM_TYPE,
8789 XBM_FILE,
8790 XBM_WIDTH,
8791 XBM_HEIGHT,
8792 XBM_DATA,
8793 XBM_FOREGROUND,
8794 XBM_BACKGROUND,
8795 XBM_ASCENT,
8796 XBM_MARGIN,
8797 XBM_RELIEF,
8798 XBM_ALGORITHM,
8799 XBM_HEURISTIC_MASK,
8800 XBM_LAST
8801};
8802
8803/* Vector of image_keyword structures describing the format
8804 of valid XBM image specifications. */
8805
8806static struct image_keyword xbm_format[XBM_LAST] =
8807{
8808 {":type", IMAGE_SYMBOL_VALUE, 1},
8809 {":file", IMAGE_STRING_VALUE, 0},
8810 {":width", IMAGE_POSITIVE_INTEGER_VALUE, 0},
8811 {":height", IMAGE_POSITIVE_INTEGER_VALUE, 0},
8812 {":data", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
3cf3436e
JR		 8813 {":foreground", IMAGE_STRING_OR_NIL_VALUE, 0},
8814 {":background", IMAGE_STRING_OR_NIL_VALUE, 0},
6fc2811b 8815 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
8edb0a6f 8816 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
6fc2811b 8817 {":relief", IMAGE_INTEGER_VALUE, 0},
a93f4566 8818 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6fc2811b
JR		 8819 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
8820};
8821
8822/* Structure describing the image type XBM. */
8823
8824static struct image_type xbm_type =
8825{
8826 &Qxbm,
8827 xbm_image_p,
8828 xbm_load,
8829 x_clear_image,
8830 NULL
8831};
8832
8833/* Tokens returned from xbm_scan. */
8834
8835enum xbm_token
8836{
8837 XBM_TK_IDENT = 256,
8838 XBM_TK_NUMBER
8839};
8840
8841
8842/* Return non-zero if OBJECT is a valid XBM-type image specification.
8843 A valid specification is a list starting with the symbol `image'
8844 The rest of the list is a property list which must contain an
8845 entry `:type xbm..
8846
8847 If the specification specifies a file to load, it must contain
8848 an entry `:file FILENAME' where FILENAME is a string.
8849
8850 If the specification is for a bitmap loaded from memory it must
8851 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
8852 WIDTH and HEIGHT are integers > 0. DATA may be:
8853
8854 1. a string large enough to hold the bitmap data, i.e. it must
8855 have a size >= (WIDTH + 7) / 8 * HEIGHT
8856
8857 2. a bool-vector of size >= WIDTH * HEIGHT
8858
8859 3. a vector of strings or bool-vectors, one for each line of the
8860 bitmap.
8861
8862 Both the file and data forms may contain the additional entries
8863 `:background COLOR' and `:foreground COLOR'. If not present,
8864 foreground and background of the frame on which the image is
8865 displayed, is used. */
8866
8867static int
8868xbm_image_p (object)
8869 Lisp_Object object;
8870{
8871 struct image_keyword kw[XBM_LAST];
8872
8873 bcopy (xbm_format, kw, sizeof kw);
8874 if (!parse_image_spec (object, kw, XBM_LAST, Qxbm))
8875 return 0;
8876
8877 xassert (EQ (kw[XBM_TYPE].value, Qxbm));
8878
8879 if (kw[XBM_FILE].count)
8880 {
8881 if (kw[XBM_WIDTH].count || kw[XBM_HEIGHT].count || kw[XBM_DATA].count)
8882 return 0;
8883 }
8884 else
8885 {
8886 Lisp_Object data;
8887 int width, height;
8888
8889 /* Entries for `:width', `:height' and `:data' must be present. */
8890 if (!kw[XBM_WIDTH].count
8891 || !kw[XBM_HEIGHT].count
8892 || !kw[XBM_DATA].count)
8893 return 0;
8894
8895 data = kw[XBM_DATA].value;
8896 width = XFASTINT (kw[XBM_WIDTH].value);
8897 height = XFASTINT (kw[XBM_HEIGHT].value);
8898
8899 /* Check type of data, and width and height against contents of
8900 data. */
8901 if (VECTORP (data))
8902 {
8903 int i;
8904
8905 /* Number of elements of the vector must be >= height. */
8906 if (XVECTOR (data)->size < height)
8907 return 0;
8908
8909 /* Each string or bool-vector in data must be large enough
8910 for one line of the image. */
8911 for (i = 0; i < height; ++i)
8912 {
8913 Lisp_Object elt = XVECTOR (data)->contents[i];
8914
8915 if (STRINGP (elt))
8916 {
8917 if (XSTRING (elt)->size
8918 < (width + BITS_PER_CHAR - 1) / BITS_PER_CHAR)
8919 return 0;
8920 }
8921 else if (BOOL_VECTOR_P (elt))
8922 {
8923 if (XBOOL_VECTOR (elt)->size < width)
8924 return 0;
8925 }
8926 else
8927 return 0;
8928 }
8929 }
8930 else if (STRINGP (data))
8931 {
8932 if (XSTRING (data)->size
8933 < (width + BITS_PER_CHAR - 1) / BITS_PER_CHAR * height)
8934 return 0;
8935 }
8936 else if (BOOL_VECTOR_P (data))
8937 {
8938 if (XBOOL_VECTOR (data)->size < width * height)
8939 return 0;
8940 }
8941 else
8942 return 0;
8943 }
8944
8945 /* Baseline must be a value between 0 and 100 (a percentage). */
8946 if (kw[XBM_ASCENT].count
8947 && XFASTINT (kw[XBM_ASCENT].value) > 100)
8948 return 0;
8949
8950 return 1;
8951}
8952
8953
8954/* Scan a bitmap file. FP is the stream to read from. Value is
8955 either an enumerator from enum xbm_token, or a character for a
8956 single-character token, or 0 at end of file. If scanning an
8957 identifier, store the lexeme of the identifier in SVAL. If
8958 scanning a number, store its value in *IVAL. */
8959
8960static int
3cf3436e
JR		 8961xbm_scan (s, end, sval, ival)
8962 char **s, *end;
6fc2811b
JR		 8963 char *sval;
8964 int *ival;
8965{
8966 int c;
3cf3436e
JR		 8967
8968 loop:
8969
6fc2811b 8970 /* Skip white space. */
3cf3436e 8971 while (*s < end &&(c = *(*s)++, isspace (c)))
6fc2811b
JR		 8972 ;
8973
3cf3436e 8974 if (*s >= end)
6fc2811b
JR		 8975 c = 0;
8976 else if (isdigit (c))
8977 {
8978 int value = 0, digit;
8979
3cf3436e 8980 if (c == '0' && *s < end)
6fc2811b 8981 {
3cf3436e 8982 c = *(*s)++;
6fc2811b
JR		 8983 if (c == 'x' || c == 'X')
8984 {
3cf3436e 8985 while (*s < end)
6fc2811b 8986 {
3cf3436e 8987 c = *(*s)++;
6fc2811b
JR		 8988 if (isdigit (c))
8989 digit = c - '0';
8990 else if (c >= 'a' && c <= 'f')
8991 digit = c - 'a' + 10;
8992 else if (c >= 'A' && c <= 'F')
8993 digit = c - 'A' + 10;
8994 else
8995 break;
8996 value = 16 * value + digit;
8997 }
8998 }
8999 else if (isdigit (c))
9000 {
9001 value = c - '0';
3cf3436e
JR		 9002 while (*s < end
9003 && (c = *(*s)++, isdigit (c)))
6fc2811b
JR		 9004 value = 8 * value + c - '0';
9005 }
9006 }
9007 else
9008 {
9009 value = c - '0';
3cf3436e
JR		 9010 while (*s < end
9011 && (c = *(*s)++, isdigit (c)))
6fc2811b
JR		 9012 value = 10 * value + c - '0';
9013 }
9014
3cf3436e
JR		 9015 if (*s < end)
9016 *s = *s - 1;
6fc2811b
JR		 9017 *ival = value;
9018 c = XBM_TK_NUMBER;
9019 }
9020 else if (isalpha (c) || c == '_')
9021 {
9022 *sval++ = c;
3cf3436e
JR		 9023 while (*s < end
9024 && (c = *(*s)++, (isalnum (c) || c == '_')))
6fc2811b
JR		 9025 *sval++ = c;
9026 *sval = 0;
3cf3436e
JR		 9027 if (*s < end)
9028 *s = *s - 1;
6fc2811b
JR		 9029 c = XBM_TK_IDENT;
9030 }
3cf3436e
JR		 9031 else if (c == '/' && **s == '*')
9032 {
9033 /* C-style comment. */
9034 ++*s;
9035 while (**s && (**s != '*' || *(*s + 1) != '/'))
9036 ++*s;
9037 if (**s)
9038 {
9039 *s += 2;
9040 goto loop;
9041 }
9042 }
6fc2811b
JR		 9043
9044 return c;
9045}
9046
9047
9048/* Replacement for XReadBitmapFileData which isn't available under old
3cf3436e
JR		 9049 X versions. CONTENTS is a pointer to a buffer to parse; END is the
9050 buffer's end. Set *WIDTH and *HEIGHT to the width and height of
9051 the image. Return in *DATA the bitmap data allocated with xmalloc.
9052 Value is non-zero if successful. DATA null means just test if
9053 CONTENTS looks like an in-memory XBM file. */
6fc2811b
JR		 9054
9055static int
3cf3436e
JR		 9056xbm_read_bitmap_data (contents, end, width, height, data)
9057 char *contents, *end;
6fc2811b
JR		 9058 int *width, *height;
9059 unsigned char **data;
9060{
3cf3436e 9061 char *s = contents;
6fc2811b
JR		 9062 char buffer[BUFSIZ];
9063 int padding_p = 0;
9064 int v10 = 0;
9065 int bytes_per_line, i, nbytes;
9066 unsigned char *p;
9067 int value;
9068 int LA1;
9069
9070#define match() \
3cf3436e 9071 LA1 = xbm_scan (contents, end, buffer, &value)
6fc2811b
JR		 9072
9073#define expect(TOKEN) \
9074 if (LA1 != (TOKEN)) \
9075 goto failure; \
9076 else \
9077 match ()
9078
9079#define expect_ident(IDENT) \
9080 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
9081 match (); \
9082 else \
9083 goto failure
9084
6fc2811b 9085 *width = *height = -1;
3cf3436e
JR		 9086 if (data)
9087 *data = NULL;
9088 LA1 = xbm_scan (&s, end, buffer, &value);
6fc2811b
JR		 9089
9090 /* Parse defines for width, height and hot-spots. */
9091 while (LA1 == '#')
9092 {
9093 match ();
9094 expect_ident ("define");
9095 expect (XBM_TK_IDENT);
9096
9097 if (LA1 == XBM_TK_NUMBER);
9098 {
9099 char *p = strrchr (buffer, '_');
9100 p = p ? p + 1 : buffer;
9101 if (strcmp (p, "width") == 0)
9102 *width = value;
9103 else if (strcmp (p, "height") == 0)
9104 *height = value;
9105 }
9106 expect (XBM_TK_NUMBER);
9107 }
9108
9109 if (*width < 0 || *height < 0)
9110 goto failure;
3cf3436e
JR		 9111 else if (data == NULL)
9112 goto success;
6fc2811b
JR		 9113
9114 /* Parse bits. Must start with `static'. */
9115 expect_ident ("static");
9116 if (LA1 == XBM_TK_IDENT)
9117 {
9118 if (strcmp (buffer, "unsigned") == 0)
9119 {
9120 match ();
9121 expect_ident ("char");
9122 }
9123 else if (strcmp (buffer, "short") == 0)
9124 {
9125 match ();
9126 v10 = 1;
9127 if (*width % 16 && *width % 16 < 9)
9128 padding_p = 1;
9129 }
9130 else if (strcmp (buffer, "char") == 0)
9131 match ();
9132 else
9133 goto failure;
9134 }
9135 else
9136 goto failure;
9137
9138 expect (XBM_TK_IDENT);
9139 expect ('[');
9140 expect (']');
9141 expect ('=');
9142 expect ('{');
9143
9144 bytes_per_line = (*width + 7) / 8 + padding_p;
9145 nbytes = bytes_per_line * *height;
9146 p = *data = (char *) xmalloc (nbytes);
9147
9148 if (v10)
9149 {
9150
9151 for (i = 0; i < nbytes; i += 2)
9152 {
9153 int val = value;
9154 expect (XBM_TK_NUMBER);
9155
9156 *p++ = val;
9157 if (!padding_p || ((i + 2) % bytes_per_line))
9158 *p++ = value >> 8;
9159
9160 if (LA1 == ',' || LA1 == '}')
9161 match ();
9162 else
9163 goto failure;
9164 }
9165 }
9166 else
9167 {
9168 for (i = 0; i < nbytes; ++i)
9169 {
9170 int val = value;
9171 expect (XBM_TK_NUMBER);
9172
9173 *p++ = val;
9174
9175 if (LA1 == ',' || LA1 == '}')
9176 match ();
9177 else
9178 goto failure;
9179 }
9180 }
9181
3cf3436e 9182 success:
6fc2811b
JR		 9183 return 1;
9184
9185 failure:
3cf3436e
JR		 9186
9187 if (data && *data)
6fc2811b
JR		 9188 {
9189 xfree (*data);
9190 *data = NULL;
9191 }
9192 return 0;
9193
9194#undef match
9195#undef expect
9196#undef expect_ident
9197}
9198
9199
3cf3436e
JR		 9200/* Load XBM image IMG which will be displayed on frame F from buffer
9201 CONTENTS. END is the end of the buffer. Value is non-zero if
9202 successful. */
6fc2811b
JR		 9203
9204static int
3cf3436e 9205xbm_load_image (f, img, contents, end)
6fc2811b
JR		 9206 struct frame *f;
9207 struct image *img;
3cf3436e 9208 char *contents, *end;
6fc2811b
JR		 9209{
9210 int rc;
9211 unsigned char *data;
9212 int success_p = 0;
6fc2811b 9213
3cf3436e 9214 rc = xbm_read_bitmap_data (contents, end, &img->width, &img->height, &data);
6fc2811b
JR		 9215 if (rc)
9216 {
9217 int depth = one_w32_display_info.n_cbits;
9218 unsigned long foreground = FRAME_FOREGROUND_PIXEL (f);
9219 unsigned long background = FRAME_BACKGROUND_PIXEL (f);
9220 Lisp_Object value;
9221
9222 xassert (img->width > 0 && img->height > 0);
9223
9224 /* Get foreground and background colors, maybe allocate colors. */
9225 value = image_spec_value (img->spec, QCforeground, NULL);
9226 if (!NILP (value))
9227 foreground = x_alloc_image_color (f, img, value, foreground);
9228
9229 value = image_spec_value (img->spec, QCbackground, NULL);
9230 if (!NILP (value))
9231 background = x_alloc_image_color (f, img, value, background);
9232
767b1ff0 9233#if 0 /* TODO : Port image display to W32 */
6fc2811b
JR		 9234 img->pixmap
9235 = XCreatePixmapFromBitmapData (FRAME_W32_DISPLAY (f),
9236 FRAME_W32_WINDOW (f),
9237 data,
9238 img->width, img->height,
9239 foreground, background,
9240 depth);
9241 xfree (data);
9242
9243 if (img->pixmap == 0)
9244 {
9245 x_clear_image (f, img);
3cf3436e 9246 image_error ("Unable to create X pixmap for `%s'", img->spec, Qnil);
6fc2811b
JR		 9247 }
9248 else
9249 success_p = 1;
6fc2811b
JR		 9250#endif
9251 }
9252 else
9253 image_error ("Error loading XBM image `%s'", img->spec, Qnil);
9254
6fc2811b
JR		 9255 return success_p;
9256}
9257
9258
3cf3436e
JR		 9259/* Value is non-zero if DATA looks like an in-memory XBM file. */
9260
9261static int
9262xbm_file_p (data)
9263 Lisp_Object data;
9264{
9265 int w, h;
9266 return (STRINGP (data)
9267 && xbm_read_bitmap_data (XSTRING (data)->data,
9268 (XSTRING (data)->data
9269 + STRING_BYTES (XSTRING (data))),
9270 &w, &h, NULL));
9271}
9272
9273
6fc2811b
JR		 9274/* Fill image IMG which is used on frame F with pixmap data. Value is
9275 non-zero if successful. */
9276
9277static int
9278xbm_load (f, img)
9279 struct frame *f;
9280 struct image *img;
9281{
9282 int success_p = 0;
9283 Lisp_Object file_name;
9284
9285 xassert (xbm_image_p (img->spec));
9286
9287 /* If IMG->spec specifies a file name, create a non-file spec from it. */
9288 file_name = image_spec_value (img->spec, QCfile, NULL);
9289 if (STRINGP (file_name))
3cf3436e
JR		 9290 {
9291 Lisp_Object file;
9292 char *contents;
9293 int size;
9294 struct gcpro gcpro1;
9295
9296 file = x_find_image_file (file_name);
9297 GCPRO1 (file);
9298 if (!STRINGP (file))
9299 {
9300 image_error ("Cannot find image file `%s'", file_name, Qnil);
9301 UNGCPRO;
9302 return 0;
9303 }
9304
9305 contents = slurp_file (XSTRING (file)->data, &size);
9306 if (contents == NULL)
9307 {
9308 image_error ("Error loading XBM image `%s'", img->spec, Qnil);
9309 UNGCPRO;
9310 return 0;
9311 }
9312
9313 success_p = xbm_load_image (f, img, contents, contents + size);
9314 UNGCPRO;
9315 }
6fc2811b
JR		 9316 else
9317 {
9318 struct image_keyword fmt[XBM_LAST];
9319 Lisp_Object data;
9320 int depth;
9321 unsigned long foreground = FRAME_FOREGROUND_PIXEL (f);
9322 unsigned long background = FRAME_BACKGROUND_PIXEL (f);
9323 char *bits;
9324 int parsed_p;
3cf3436e
JR		 9325 int in_memory_file_p = 0;
9326
9327 /* See if data looks like an in-memory XBM file. */
9328 data = image_spec_value (img->spec, QCdata, NULL);
9329 in_memory_file_p = xbm_file_p (data);
6fc2811b
JR		 9330
9331 /* Parse the list specification. */
9332 bcopy (xbm_format, fmt, sizeof fmt);
9333 parsed_p = parse_image_spec (img->spec, fmt, XBM_LAST, Qxbm);
9334 xassert (parsed_p);
9335
9336 /* Get specified width, and height. */
3cf3436e
JR		 9337 if (!in_memory_file_p)
9338 {
9339 img->width = XFASTINT (fmt[XBM_WIDTH].value);
9340 img->height = XFASTINT (fmt[XBM_HEIGHT].value);
9341 xassert (img->width > 0 && img->height > 0);
9342 }
6fc2811b 9343 /* Get foreground and background colors, maybe allocate colors. */
3cf3436e
JR		 9344 if (fmt[XBM_FOREGROUND].count
9345 && STRINGP (fmt[XBM_FOREGROUND].value))
6fc2811b
JR		 9346 foreground = x_alloc_image_color (f, img, fmt[XBM_FOREGROUND].value,
9347 foreground);
3cf3436e
JR		 9348 if (fmt[XBM_BACKGROUND].count
9349 && STRINGP (fmt[XBM_BACKGROUND].value))
6fc2811b
JR		 9350 background = x_alloc_image_color (f, img, fmt[XBM_BACKGROUND].value,
9351 background);
9352
3cf3436e
JR		 9353 if (in_memory_file_p)
9354 success_p = xbm_load_image (f, img, XSTRING (data)->data,
9355 (XSTRING (data)->data
9356 + STRING_BYTES (XSTRING (data))));
9357 else
6fc2811b 9358 {
3cf3436e
JR		 9359 if (VECTORP (data))
9360 {
9361 int i;
9362 char *p;
9363 int nbytes = (img->width + BITS_PER_CHAR - 1) / BITS_PER_CHAR;
6fc2811b 9364
3cf3436e
JR		 9365 p = bits = (char *) alloca (nbytes * img->height);
9366 for (i = 0; i < img->height; ++i, p += nbytes)
9367 {
9368 Lisp_Object line = XVECTOR (data)->contents[i];
9369 if (STRINGP (line))
9370 bcopy (XSTRING (line)->data, p, nbytes);
9371 else
9372 bcopy (XBOOL_VECTOR (line)->data, p, nbytes);
9373 }
9374 }
9375 else if (STRINGP (data))
9376 bits = XSTRING (data)->data;
9377 else
9378 bits = XBOOL_VECTOR (data)->data;
9379#ifdef TODO /* image support. */
9380 /* Create the pixmap. */
9381 depth = DefaultDepthOfScreen (FRAME_X_SCREEN (f));
9382 img->pixmap
9383 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f),
9384 FRAME_X_WINDOW (f),
9385 bits,
9386 img->width, img->height,
9387 foreground, background,
9388 depth);
9389#endif
9390 if (img->pixmap)
9391 success_p = 1;
9392 else
6fc2811b 9393 {
3cf3436e
JR		 9394 image_error ("Unable to create pixmap for XBM image `%s'",
9395 img->spec, Qnil);
9396 x_clear_image (f, img);
6fc2811b
JR		 9397 }
9398 }
6fc2811b
JR		 9399 }
9400
9401 return success_p;
9402}
9403
9404
9405\f
9406/***********************************************************************
9407 XPM images
9408 ***********************************************************************/
9409
9410#if HAVE_XPM
9411
9412static int xpm_image_p P_ ((Lisp_Object object));
9413static int xpm_load P_ ((struct frame *f, struct image *img));
9414static int xpm_valid_color_symbols_p P_ ((Lisp_Object));
9415
9416#include "X11/xpm.h"
9417
9418/* The symbol `xpm' identifying XPM-format images. */
9419
9420Lisp_Object Qxpm;
9421
9422/* Indices of image specification fields in xpm_format, below. */
9423
9424enum xpm_keyword_index
9425{
9426 XPM_TYPE,
9427 XPM_FILE,
9428 XPM_DATA,
9429 XPM_ASCENT,
9430 XPM_MARGIN,
9431 XPM_RELIEF,
9432 XPM_ALGORITHM,
9433 XPM_HEURISTIC_MASK,
9434 XPM_COLOR_SYMBOLS,
9435 XPM_LAST
9436};
9437
9438/* Vector of image_keyword structures describing the format
9439 of valid XPM image specifications. */
9440
9441static struct image_keyword xpm_format[XPM_LAST] =
9442{
9443 {":type", IMAGE_SYMBOL_VALUE, 1},
9444 {":file", IMAGE_STRING_VALUE, 0},
9445 {":data", IMAGE_STRING_VALUE, 0},
9446 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
8edb0a6f 9447 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
6fc2811b 9448 {":relief", IMAGE_INTEGER_VALUE, 0},
a93f4566 9449 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6fc2811b
JR		 9450 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
9451 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
9452};
9453
9454/* Structure describing the image type XBM. */
9455
9456static struct image_type xpm_type =
9457{
9458 &Qxpm,
9459 xpm_image_p,
9460 xpm_load,
9461 x_clear_image,
9462 NULL
9463};
9464
9465
9466/* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
9467 for XPM images. Such a list must consist of conses whose car and
9468 cdr are strings. */
9469
9470static int
9471xpm_valid_color_symbols_p (color_symbols)
9472 Lisp_Object color_symbols;
9473{
9474 while (CONSP (color_symbols))
9475 {
9476 Lisp_Object sym = XCAR (color_symbols);
9477 if (!CONSP (sym)
9478 || !STRINGP (XCAR (sym))
9479 || !STRINGP (XCDR (sym)))
9480 break;
9481 color_symbols = XCDR (color_symbols);
9482 }
9483
9484 return NILP (color_symbols);
9485}
9486
9487
9488/* Value is non-zero if OBJECT is a valid XPM image specification. */
9489
9490static int
9491xpm_image_p (object)
9492 Lisp_Object object;
9493{
9494 struct image_keyword fmt[XPM_LAST];
9495 bcopy (xpm_format, fmt, sizeof fmt);
9496 return (parse_image_spec (object, fmt, XPM_LAST, Qxpm)
9497 /* Either `:file' or `:data' must be present. */
9498 && fmt[XPM_FILE].count + fmt[XPM_DATA].count == 1
9499 /* Either no `:color-symbols' or it's a list of conses
9500 whose car and cdr are strings. */
9501 && (fmt[XPM_COLOR_SYMBOLS].count == 0
9502 || xpm_valid_color_symbols_p (fmt[XPM_COLOR_SYMBOLS].value))
9503 && (fmt[XPM_ASCENT].count == 0
9504 || XFASTINT (fmt[XPM_ASCENT].value) < 100));
9505}
9506
9507
9508/* Load image IMG which will be displayed on frame F. Value is
9509 non-zero if successful. */
9510
9511static int
9512xpm_load (f, img)
9513 struct frame *f;
9514 struct image *img;
9515{
9516 int rc, i;
9517 XpmAttributes attrs;
9518 Lisp_Object specified_file, color_symbols;
9519
9520 /* Configure the XPM lib. Use the visual of frame F. Allocate
9521 close colors. Return colors allocated. */
9522 bzero (&attrs, sizeof attrs);
dfff8a69
JR		 9523 attrs.visual = FRAME_X_VISUAL (f);
9524 attrs.colormap = FRAME_X_COLORMAP (f);
6fc2811b 9525 attrs.valuemask |= XpmVisual;
dfff8a69 9526 attrs.valuemask |= XpmColormap;
6fc2811b 9527 attrs.valuemask |= XpmReturnAllocPixels;
dfff8a69 9528#ifdef XpmAllocCloseColors
6fc2811b
JR		 9529 attrs.alloc_close_colors = 1;
9530 attrs.valuemask |= XpmAllocCloseColors;
dfff8a69
JR		 9531#else
9532 attrs.closeness = 600;
9533 attrs.valuemask |= XpmCloseness;
9534#endif
6fc2811b
JR		 9535
9536 /* If image specification contains symbolic color definitions, add
9537 these to `attrs'. */
9538 color_symbols = image_spec_value (img->spec, QCcolor_symbols, NULL);
9539 if (CONSP (color_symbols))
9540 {
9541 Lisp_Object tail;
9542 XpmColorSymbol *xpm_syms;
9543 int i, size;
9544
9545 attrs.valuemask |= XpmColorSymbols;
9546
9547 /* Count number of symbols. */
9548 attrs.numsymbols = 0;
9549 for (tail = color_symbols; CONSP (tail); tail = XCDR (tail))
9550 ++attrs.numsymbols;
9551
9552 /* Allocate an XpmColorSymbol array. */
9553 size = attrs.numsymbols * sizeof *xpm_syms;
9554 xpm_syms = (XpmColorSymbol *) alloca (size);
9555 bzero (xpm_syms, size);
9556 attrs.colorsymbols = xpm_syms;
9557
9558 /* Fill the color symbol array. */
9559 for (tail = color_symbols, i = 0;
9560 CONSP (tail);
9561 ++i, tail = XCDR (tail))
9562 {
9563 Lisp_Object name = XCAR (XCAR (tail));
9564 Lisp_Object color = XCDR (XCAR (tail));
9565 xpm_syms[i].name = (char *) alloca (XSTRING (name)->size + 1);
9566 strcpy (xpm_syms[i].name, XSTRING (name)->data);
9567 xpm_syms[i].value = (char *) alloca (XSTRING (color)->size + 1);
9568 strcpy (xpm_syms[i].value, XSTRING (color)->data);
9569 }
9570 }
9571
9572 /* Create a pixmap for the image, either from a file, or from a
9573 string buffer containing data in the same format as an XPM file. */
9574 BLOCK_INPUT;
9575 specified_file = image_spec_value (img->spec, QCfile, NULL);
9576 if (STRINGP (specified_file))
9577 {
9578 Lisp_Object file = x_find_image_file (specified_file);
9579 if (!STRINGP (file))
9580 {
9581 image_error ("Cannot find image file `%s'", specified_file, Qnil);
9582 UNBLOCK_INPUT;
9583 return 0;
9584 }
9585
9586 rc = XpmReadFileToPixmap (NULL, FRAME_W32_WINDOW (f),
9587 XSTRING (file)->data, &img->pixmap, &img->mask,
9588 &attrs);
9589 }
9590 else
9591 {
9592 Lisp_Object buffer = image_spec_value (img->spec, QCdata, NULL);
9593 rc = XpmCreatePixmapFromBuffer (NULL, FRAME_W32_WINDOW (f),
9594 XSTRING (buffer)->data,
9595 &img->pixmap, &img->mask,
9596 &attrs);
9597 }
9598 UNBLOCK_INPUT;
9599
9600 if (rc == XpmSuccess)
9601 {
9602 /* Remember allocated colors. */
9603 img->ncolors = attrs.nalloc_pixels;
9604 img->colors = (unsigned long *) xmalloc (img->ncolors
9605 * sizeof *img->colors);
9606 for (i = 0; i < attrs.nalloc_pixels; ++i)
9607 img->colors[i] = attrs.alloc_pixels[i];
9608
9609 img->width = attrs.width;
9610 img->height = attrs.height;
9611 xassert (img->width > 0 && img->height > 0);
9612
9613 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
9614 BLOCK_INPUT;
9615 XpmFreeAttributes (&attrs);
9616 UNBLOCK_INPUT;
9617 }
9618 else
9619 {
9620 switch (rc)
9621 {
9622 case XpmOpenFailed:
9623 image_error ("Error opening XPM file (%s)", img->spec, Qnil);
9624 break;
9625
9626 case XpmFileInvalid:
9627 image_error ("Invalid XPM file (%s)", img->spec, Qnil);
9628 break;
9629
9630 case XpmNoMemory:
9631 image_error ("Out of memory (%s)", img->spec, Qnil);
9632 break;
9633
9634 case XpmColorFailed:
9635 image_error ("Color allocation error (%s)", img->spec, Qnil);
9636 break;
9637
9638 default:
9639 image_error ("Unknown error (%s)", img->spec, Qnil);
9640 break;
9641 }
9642 }
9643
9644 return rc == XpmSuccess;
9645}
9646
9647#endif /* HAVE_XPM != 0 */
9648
9649\f
767b1ff0 9650#if 0 /* TODO : Color tables on W32. */
6fc2811b
JR		 9651/***********************************************************************
9652 Color table
9653 ***********************************************************************/
9654
9655/* An entry in the color table mapping an RGB color to a pixel color. */
9656
9657struct ct_color
9658{
9659 int r, g, b;
9660 unsigned long pixel;
9661
9662 /* Next in color table collision list. */
9663 struct ct_color *next;
9664};
9665
9666/* The bucket vector size to use. Must be prime. */
9667
9668#define CT_SIZE 101
9669
9670/* Value is a hash of the RGB color given by R, G, and B. */
9671
9672#define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
9673
9674/* The color hash table. */
9675
9676struct ct_color **ct_table;
9677
9678/* Number of entries in the color table. */
9679
9680int ct_colors_allocated;
9681
9682/* Function prototypes. */
9683
9684static void init_color_table P_ ((void));
9685static void free_color_table P_ ((void));
9686static unsigned long *colors_in_color_table P_ ((int *n));
9687static unsigned long lookup_rgb_color P_ ((struct frame *f, int r, int g, int b));
9688static unsigned long lookup_pixel_color P_ ((struct frame *f, unsigned long p));
9689
9690
9691/* Initialize the color table. */
9692
9693static void
9694init_color_table ()
9695{
9696 int size = CT_SIZE * sizeof (*ct_table);
9697 ct_table = (struct ct_color **) xmalloc (size);
9698 bzero (ct_table, size);
9699 ct_colors_allocated = 0;
9700}
9701
9702
9703/* Free memory associated with the color table. */
9704
9705static void
9706free_color_table ()
9707{
9708 int i;
9709 struct ct_color *p, *next;
9710
9711 for (i = 0; i < CT_SIZE; ++i)
9712 for (p = ct_table[i]; p; p = next)
9713 {
9714 next = p->next;
9715 xfree (p);
9716 }
9717
9718 xfree (ct_table);
9719 ct_table = NULL;
9720}
9721
9722
9723/* Value is a pixel color for RGB color R, G, B on frame F. If an
9724 entry for that color already is in the color table, return the
9725 pixel color of that entry. Otherwise, allocate a new color for R,
9726 G, B, and make an entry in the color table. */
9727
9728static unsigned long
9729lookup_rgb_color (f, r, g, b)
9730 struct frame *f;
9731 int r, g, b;
9732{
9733 unsigned hash = CT_HASH_RGB (r, g, b);
9734 int i = hash % CT_SIZE;
9735 struct ct_color *p;
9736
9737 for (p = ct_table[i]; p; p = p->next)
9738 if (p->r == r && p->g == g && p->b == b)
9739 break;
9740
9741 if (p == NULL)
9742 {
9743 COLORREF color;
9744 Colormap cmap;
9745 int rc;
9746
9747 color = PALETTERGB (r, g, b);
9748
9749 ++ct_colors_allocated;
9750
9751 p = (struct ct_color *) xmalloc (sizeof *p);
9752 p->r = r;
9753 p->g = g;
9754 p->b = b;
9755 p->pixel = color;
9756 p->next = ct_table[i];
9757 ct_table[i] = p;
9758 }
9759
9760 return p->pixel;
9761}
9762
9763
9764/* Look up pixel color PIXEL which is used on frame F in the color
9765 table. If not already present, allocate it. Value is PIXEL. */
9766
9767static unsigned long
9768lookup_pixel_color (f, pixel)
9769 struct frame *f;
9770 unsigned long pixel;
9771{
9772 int i = pixel % CT_SIZE;
9773 struct ct_color *p;
9774
9775 for (p = ct_table[i]; p; p = p->next)
9776 if (p->pixel == pixel)
9777 break;
9778
9779 if (p == NULL)
9780 {
9781 XColor color;
9782 Colormap cmap;
9783 int rc;
9784
9785 BLOCK_INPUT;
9786
9787 cmap = DefaultColormapOfScreen (FRAME_X_SCREEN (f));
9788 color.pixel = pixel;
9789 XQueryColor (NULL, cmap, &color);
9790 rc = x_alloc_nearest_color (f, cmap, &color);
9791 UNBLOCK_INPUT;
9792
9793 if (rc)
9794 {
9795 ++ct_colors_allocated;
9796
9797 p = (struct ct_color *) xmalloc (sizeof *p);
9798 p->r = color.red;
9799 p->g = color.green;
9800 p->b = color.blue;
9801 p->pixel = pixel;
9802 p->next = ct_table[i];
9803 ct_table[i] = p;
9804 }
9805 else
9806 return FRAME_FOREGROUND_PIXEL (f);
9807 }
9808 return p->pixel;
9809}
9810
9811
9812/* Value is a vector of all pixel colors contained in the color table,
9813 allocated via xmalloc. Set *N to the number of colors. */
9814
9815static unsigned long *
9816colors_in_color_table (n)
9817 int *n;
9818{
9819 int i, j;
9820 struct ct_color *p;
9821 unsigned long *colors;
9822
9823 if (ct_colors_allocated == 0)
9824 {
9825 *n = 0;
9826 colors = NULL;
9827 }
9828 else
9829 {
9830 colors = (unsigned long *) xmalloc (ct_colors_allocated
9831 * sizeof *colors);
9832 *n = ct_colors_allocated;
9833
9834 for (i = j = 0; i < CT_SIZE; ++i)
9835 for (p = ct_table[i]; p; p = p->next)
9836 colors[j++] = p->pixel;
9837 }
9838
9839 return colors;
9840}
9841
767b1ff0 9842#endif /* TODO */
6fc2811b
JR		 9843
9844\f
9845/***********************************************************************
9846 Algorithms
9847 ***********************************************************************/
3cf3436e
JR		 9848#if 0 /* TODO: image support. */
9849static XColor *x_to_xcolors P_ ((struct frame *, struct image *, int));
9850static void x_from_xcolors P_ ((struct frame *, struct image *, XColor *));
9851static void x_detect_edges P_ ((struct frame *, struct image *, int[9], int));
9852
9853/* Non-zero means draw a cross on images having `:conversion
9854 disabled'. */
6fc2811b 9855
3cf3436e 9856int cross_disabled_images;
6fc2811b 9857
3cf3436e
JR		 9858/* Edge detection matrices for different edge-detection
9859 strategies. */
6fc2811b 9860
3cf3436e
JR		 9861static int emboss_matrix[9] = {
9862 /* x - 1 x x + 1 */
9863 2, -1, 0, /* y - 1 */
9864 -1, 0, 1, /* y */
9865 0, 1, -2 /* y + 1 */
9866};
9867
9868static int laplace_matrix[9] = {
9869 /* x - 1 x x + 1 */
9870 1, 0, 0, /* y - 1 */
9871 0, 0, 0, /* y */
9872 0, 0, -1 /* y + 1 */
9873};
9874
9875/* Value is the intensity of the color whose red/green/blue values
9876 are R, G, and B. */
9877
9878#define COLOR_INTENSITY(R, G, B) ((2 * (R) + 3 * (G) + (B)) / 6)
9879
9880
9881/* On frame F, return an array of XColor structures describing image
9882 IMG->pixmap. Each XColor structure has its pixel color set. RGB_P
9883 non-zero means also fill the red/green/blue members of the XColor
9884 structures. Value is a pointer to the array of XColors structures,
9885 allocated with xmalloc; it must be freed by the caller. */
9886
9887static XColor *
9888x_to_xcolors (f, img, rgb_p)
9889 struct frame *f;
9890 struct image *img;
9891 int rgb_p;
9892{
9893 int x, y;
9894 XColor *colors, *p;
9895 XImage *ximg;
9896
9897 colors = (XColor *) xmalloc (img->width * img->height * sizeof *colors);
9898
9899 /* Get the X image IMG->pixmap. */
9900 ximg = XGetImage (FRAME_X_DISPLAY (f), img->pixmap,
9901 0, 0, img->width, img->height, ~0, ZPixmap);
9902
9903 /* Fill the `pixel' members of the XColor array. I wished there
9904 were an easy and portable way to circumvent XGetPixel. */
9905 p = colors;
9906 for (y = 0; y < img->height; ++y)
9907 {
9908 XColor *row = p;
9909
9910 for (x = 0; x < img->width; ++x, ++p)
9911 p->pixel = XGetPixel (ximg, x, y);
9912
9913 if (rgb_p)
9914 x_query_colors (f, row, img->width);
9915 }
9916
9917 XDestroyImage (ximg);
9918 return colors;
9919}
9920
9921
9922/* Create IMG->pixmap from an array COLORS of XColor structures, whose
9923 RGB members are set. F is the frame on which this all happens.
9924 COLORS will be freed; an existing IMG->pixmap will be freed, too. */
6fc2811b
JR		 9925
9926static void
3cf3436e 9927x_from_xcolors (f, img, colors)
6fc2811b 9928 struct frame *f;
3cf3436e 9929 struct image *img;
6fc2811b 9930 XColor *colors;
6fc2811b 9931{
3cf3436e
JR		 9932 int x, y;
9933 XImage *oimg;
9934 Pixmap pixmap;
9935 XColor *p;
9936
9937 init_color_table ();
9938
9939 x_create_x_image_and_pixmap (f, img->width, img->height, 0,
9940 &oimg, &pixmap);
9941 p = colors;
9942 for (y = 0; y < img->height; ++y)
9943 for (x = 0; x < img->width; ++x, ++p)
9944 {
9945 unsigned long pixel;
9946 pixel = lookup_rgb_color (f, p->red, p->green, p->blue);
9947 XPutPixel (oimg, x, y, pixel);
9948 }
6fc2811b 9949
3cf3436e
JR		 9950 xfree (colors);
9951 x_clear_image_1 (f, img, 1, 0, 1);
6fc2811b 9952
3cf3436e
JR		 9953 x_put_x_image (f, oimg, pixmap, img->width, img->height);
9954 x_destroy_x_image (oimg);
9955 img->pixmap = pixmap;
9956 img->colors = colors_in_color_table (&img->ncolors);
9957 free_color_table ();
6fc2811b
JR		 9958}
9959
9960
3cf3436e
JR		 9961/* On frame F, perform edge-detection on image IMG.
9962
9963 MATRIX is a nine-element array specifying the transformation
9964 matrix. See emboss_matrix for an example.
9965
9966 COLOR_ADJUST is a color adjustment added to each pixel of the
9967 outgoing image. */
6fc2811b
JR		 9968
9969static void
3cf3436e 9970x_detect_edges (f, img, matrix, color_adjust)
6fc2811b 9971 struct frame *f;
3cf3436e
JR		 9972 struct image *img;
9973 int matrix[9], color_adjust;
6fc2811b 9974{
3cf3436e
JR		 9975 XColor *colors = x_to_xcolors (f, img, 1);
9976 XColor *new, *p;
9977 int x, y, i, sum;
9978
9979 for (i = sum = 0; i < 9; ++i)
9980 sum += abs (matrix[i]);
9981
9982#define COLOR(A, X, Y) ((A) + (Y) * img->width + (X))
9983
9984 new = (XColor *) xmalloc (img->width * img->height * sizeof *new);
9985
9986 for (y = 0; y < img->height; ++y)
9987 {
9988 p = COLOR (new, 0, y);
9989 p->red = p->green = p->blue = 0xffff/2;
9990 p = COLOR (new, img->width - 1, y);
9991 p->red = p->green = p->blue = 0xffff/2;
9992 }
6fc2811b 9993
3cf3436e
JR		 9994 for (x = 1; x < img->width - 1; ++x)
9995 {
9996 p = COLOR (new, x, 0);
9997 p->red = p->green = p->blue = 0xffff/2;
9998 p = COLOR (new, x, img->height - 1);
9999 p->red = p->green = p->blue = 0xffff/2;
10000 }
10001
10002 for (y = 1; y < img->height - 1; ++y)
10003 {
10004 p = COLOR (new, 1, y);
10005
10006 for (x = 1; x < img->width - 1; ++x, ++p)
10007 {
10008 int r, g, b, y1, x1;
10009
10010 r = g = b = i = 0;
10011 for (y1 = y - 1; y1 < y + 2; ++y1)
10012 for (x1 = x - 1; x1 < x + 2; ++x1, ++i)
10013 if (matrix[i])
10014 {
10015 XColor *t = COLOR (colors, x1, y1);
10016 r += matrix[i] * t->red;
10017 g += matrix[i] * t->green;
10018 b += matrix[i] * t->blue;
10019 }
10020
10021 r = (r / sum + color_adjust) & 0xffff;
10022 g = (g / sum + color_adjust) & 0xffff;
10023 b = (b / sum + color_adjust) & 0xffff;
10024 p->red = p->green = p->blue = COLOR_INTENSITY (r, g, b);
10025 }
10026 }
10027
10028 xfree (colors);
10029 x_from_xcolors (f, img, new);
10030
10031#undef COLOR
10032}
10033
10034
10035/* Perform the pre-defined `emboss' edge-detection on image IMG
10036 on frame F. */
10037
10038static void
10039x_emboss (f, img)
10040 struct frame *f;
10041 struct image *img;
10042{
10043 x_detect_edges (f, img, emboss_matrix, 0xffff / 2);
6fc2811b 10044}
3cf3436e 10045
6fc2811b
JR		 10046
10047/* Transform image IMG which is used on frame F with a Laplace
10048 edge-detection algorithm. The result is an image that can be used
10049 to draw disabled buttons, for example. */
10050
10051static void
10052x_laplace (f, img)
10053 struct frame *f;
10054 struct image *img;
10055{
3cf3436e
JR		 10056 x_detect_edges (f, img, laplace_matrix, 45000);
10057}
6fc2811b 10058
6fc2811b 10059
3cf3436e
JR		 10060/* Perform edge-detection on image IMG on frame F, with specified
10061 transformation matrix MATRIX and color-adjustment COLOR_ADJUST.
6fc2811b 10062
3cf3436e 10063 MATRIX must be either
6fc2811b 10064
3cf3436e
JR		 10065 - a list of at least 9 numbers in row-major form
10066 - a vector of at least 9 numbers
6fc2811b 10067
3cf3436e
JR		 10068 COLOR_ADJUST nil means use a default; otherwise it must be a
10069 number. */
6fc2811b 10070
3cf3436e
JR		 10071static void
10072x_edge_detection (f, img, matrix, color_adjust)
10073 struct frame *f;
10074 struct image *img;
10075 Lisp_Object matrix, color_adjust;
10076{
10077 int i = 0;
10078 int trans[9];
10079
10080 if (CONSP (matrix))
6fc2811b 10081 {
3cf3436e
JR		 10082 for (i = 0;
10083 i < 9 && CONSP (matrix) && NUMBERP (XCAR (matrix));
10084 ++i, matrix = XCDR (matrix))
10085 trans[i] = XFLOATINT (XCAR (matrix));
10086 }
10087 else if (VECTORP (matrix) && ASIZE (matrix) >= 9)
10088 {
10089 for (i = 0; i < 9 && NUMBERP (AREF (matrix, i)); ++i)
10090 trans[i] = XFLOATINT (AREF (matrix, i));
10091 }
10092
10093 if (NILP (color_adjust))
10094 color_adjust = make_number (0xffff / 2);
10095
10096 if (i == 9 && NUMBERP (color_adjust))
10097 x_detect_edges (f, img, trans, (int) XFLOATINT (color_adjust));
10098}
10099
6fc2811b 10100
3cf3436e 10101/* Transform image IMG on frame F so that it looks disabled. */
6fc2811b 10102
3cf3436e
JR		 10103static void
10104x_disable_image (f, img)
10105 struct frame *f;
10106 struct image *img;
10107{
10108 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
10109
10110 if (dpyinfo->n_planes >= 2)
10111 {
10112 /* Color (or grayscale). Convert to gray, and equalize. Just
10113 drawing such images with a stipple can look very odd, so
10114 we're using this method instead. */
10115 XColor *colors = x_to_xcolors (f, img, 1);
10116 XColor *p, *end;
10117 const int h = 15000;
10118 const int l = 30000;
10119
10120 for (p = colors, end = colors + img->width * img->height;
10121 p < end;
10122 ++p)
6fc2811b 10123 {
3cf3436e
JR		 10124 int i = COLOR_INTENSITY (p->red, p->green, p->blue);
10125 int i2 = (0xffff - h - l) * i / 0xffff + l;
10126 p->red = p->green = p->blue = i2;
6fc2811b
JR		 10127 }
10128
3cf3436e 10129 x_from_xcolors (f, img, colors);
6fc2811b
JR		 10130 }
10131
3cf3436e
JR		 10132 /* Draw a cross over the disabled image, if we must or if we
10133 should. */
10134 if (dpyinfo->n_planes < 2 || cross_disabled_images)
10135 {
10136 Display *dpy = FRAME_X_DISPLAY (f);
10137 GC gc;
6fc2811b 10138
3cf3436e
JR		 10139 gc = XCreateGC (dpy, img->pixmap, 0, NULL);
10140 XSetForeground (dpy, gc, BLACK_PIX_DEFAULT (f));
10141 XDrawLine (dpy, img->pixmap, gc, 0, 0,
10142 img->width - 1, img->height - 1);
10143 XDrawLine (dpy, img->pixmap, gc, 0, img->height - 1,
10144 img->width - 1, 0);
10145 XFreeGC (dpy, gc);
6fc2811b 10146
3cf3436e
JR		 10147 if (img->mask)
10148 {
10149 gc = XCreateGC (dpy, img->mask, 0, NULL);
10150 XSetForeground (dpy, gc, WHITE_PIX_DEFAULT (f));
10151 XDrawLine (dpy, img->mask, gc, 0, 0,
10152 img->width - 1, img->height - 1);
10153 XDrawLine (dpy, img->mask, gc, 0, img->height - 1,
10154 img->width - 1, 0);
10155 XFreeGC (dpy, gc);
10156 }
10157 }
6fc2811b
JR		 10158}
10159
10160
10161/* Build a mask for image IMG which is used on frame F. FILE is the
10162 name of an image file, for error messages. HOW determines how to
10163 determine the background color of IMG. If it is a list '(R G B)',
10164 with R, G, and B being integers >= 0, take that as the color of the
10165 background. Otherwise, determine the background color of IMG
10166 heuristically. Value is non-zero if successful. */
10167
10168static int
10169x_build_heuristic_mask (f, img, how)
10170 struct frame *f;
10171 struct image *img;
10172 Lisp_Object how;
10173{
6fc2811b
JR		 10174 Display *dpy = FRAME_W32_DISPLAY (f);
10175 XImage *ximg, *mask_img;
10176 int x, y, rc, look_at_corners_p;
10177 unsigned long bg;
10178
10179 BLOCK_INPUT;
10180
10181 /* Create an image and pixmap serving as mask. */
10182 rc = x_create_x_image_and_pixmap (f, img->width, img->height, 1,
10183 &mask_img, &img->mask);
10184 if (!rc)
10185 {
10186 UNBLOCK_INPUT;
10187 return 0;
10188 }
10189
10190 /* Get the X image of IMG->pixmap. */
10191 ximg = XGetImage (dpy, img->pixmap, 0, 0, img->width, img->height,
10192 ~0, ZPixmap);
10193
10194 /* Determine the background color of ximg. If HOW is `(R G B)'
10195 take that as color. Otherwise, try to determine the color
10196 heuristically. */
10197 look_at_corners_p = 1;
10198
10199 if (CONSP (how))
10200 {
10201 int rgb[3], i = 0;
10202
10203 while (i < 3
10204 && CONSP (how)
10205 && NATNUMP (XCAR (how)))
10206 {
10207 rgb[i] = XFASTINT (XCAR (how)) & 0xffff;
10208 how = XCDR (how);
10209 }
10210
10211 if (i == 3 && NILP (how))
10212 {
10213 char color_name[30];
10214 XColor exact, color;
10215 Colormap cmap;
10216
10217 sprintf (color_name, "#%04x%04x%04x", rgb[0], rgb[1], rgb[2]);
10218
10219 cmap = DefaultColormapOfScreen (FRAME_X_SCREEN (f));
10220 if (XLookupColor (dpy, cmap, color_name, &exact, &color))
10221 {
10222 bg = color.pixel;
10223 look_at_corners_p = 0;
10224 }
10225 }
10226 }
10227
10228 if (look_at_corners_p)
10229 {
10230 unsigned long corners[4];
10231 int i, best_count;
10232
10233 /* Get the colors at the corners of ximg. */
10234 corners[0] = XGetPixel (ximg, 0, 0);
10235 corners[1] = XGetPixel (ximg, img->width - 1, 0);
10236 corners[2] = XGetPixel (ximg, img->width - 1, img->height - 1);
10237 corners[3] = XGetPixel (ximg, 0, img->height - 1);
10238
10239 /* Choose the most frequently found color as background. */
10240 for (i = best_count = 0; i < 4; ++i)
10241 {
10242 int j, n;
10243
10244 for (j = n = 0; j < 4; ++j)
10245 if (corners[i] == corners[j])
10246 ++n;
10247
10248 if (n > best_count)
10249 bg = corners[i], best_count = n;
10250 }
10251 }
10252
10253 /* Set all bits in mask_img to 1 whose color in ximg is different
10254 from the background color bg. */
10255 for (y = 0; y < img->height; ++y)
10256 for (x = 0; x < img->width; ++x)
10257 XPutPixel (mask_img, x, y, XGetPixel (ximg, x, y) != bg);
10258
10259 /* Put mask_img into img->mask. */
10260 x_put_x_image (f, mask_img, img->mask, img->width, img->height);
10261 x_destroy_x_image (mask_img);
10262 XDestroyImage (ximg);
10263
10264 UNBLOCK_INPUT;
6fc2811b
JR		 10265
10266 return 1;
10267}
3cf3436e 10268#endif /* TODO */
6fc2811b
JR		 10269
10270\f
10271/***********************************************************************
10272 PBM (mono, gray, color)
10273 ***********************************************************************/
10274#ifdef HAVE_PBM
10275
10276static int pbm_image_p P_ ((Lisp_Object object));
10277static int pbm_load P_ ((struct frame *f, struct image *img));
10278static int pbm_scan_number P_ ((unsigned char **, unsigned char *));
10279
10280/* The symbol `pbm' identifying images of this type. */
10281
10282Lisp_Object Qpbm;
10283
10284/* Indices of image specification fields in gs_format, below. */
10285
10286enum pbm_keyword_index
10287{
10288 PBM_TYPE,
10289 PBM_FILE,
10290 PBM_DATA,
10291 PBM_ASCENT,
10292 PBM_MARGIN,
10293 PBM_RELIEF,
10294 PBM_ALGORITHM,
10295 PBM_HEURISTIC_MASK,
10296 PBM_LAST
10297};
10298
10299/* Vector of image_keyword structures describing the format
10300 of valid user-defined image specifications. */
10301
10302static struct image_keyword pbm_format[PBM_LAST] =
10303{
10304 {":type", IMAGE_SYMBOL_VALUE, 1},
10305 {":file", IMAGE_STRING_VALUE, 0},
10306 {":data", IMAGE_STRING_VALUE, 0},
10307 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
8edb0a6f 10308 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
6fc2811b 10309 {":relief", IMAGE_INTEGER_VALUE, 0},
a93f4566 10310 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
3cf3436e
JR		 10311 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
10312 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
10313 {":foreground", IMAGE_STRING_OR_NIL_VALUE, 0},
10314 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
6fc2811b
JR		 10315};
10316
10317/* Structure describing the image type `pbm'. */
10318
10319static struct image_type pbm_type =
10320{
10321 &Qpbm,
10322 pbm_image_p,
10323 pbm_load,
10324 x_clear_image,
10325 NULL
10326};
10327
10328
10329/* Return non-zero if OBJECT is a valid PBM image specification. */
10330
10331static int
10332pbm_image_p (object)
10333 Lisp_Object object;
10334{
10335 struct image_keyword fmt[PBM_LAST];
10336
10337 bcopy (pbm_format, fmt, sizeof fmt);
10338
10339 if (!parse_image_spec (object, fmt, PBM_LAST, Qpbm)
10340 || (fmt[PBM_ASCENT].count
10341 && XFASTINT (fmt[PBM_ASCENT].value) > 100))
10342 return 0;
10343
10344 /* Must specify either :data or :file. */
10345 return fmt[PBM_DATA].count + fmt[PBM_FILE].count == 1;
10346}
10347
10348
10349/* Scan a decimal number from *S and return it. Advance *S while
10350 reading the number. END is the end of the string. Value is -1 at
10351 end of input. */
10352
10353static int
10354pbm_scan_number (s, end)
10355 unsigned char **s, *end;
10356{
10357 int c, val = -1;
10358
10359 while (*s < end)
10360 {
10361 /* Skip white-space. */
10362 while (*s < end && (c = *(*s)++, isspace (c)))
10363 ;
10364
10365 if (c == '#')
10366 {
10367 /* Skip comment to end of line. */
10368 while (*s < end && (c = *(*s)++, c != '\n'))
10369 ;
10370 }
10371 else if (isdigit (c))
10372 {
10373 /* Read decimal number. */
10374 val = c - '0';
10375 while (*s < end && (c = *(*s)++, isdigit (c)))
10376 val = 10 * val + c - '0';
10377 break;
10378 }
10379 else
10380 break;
10381 }
10382
10383 return val;
10384}
10385
10386
10387/* Read FILE into memory. Value is a pointer to a buffer allocated
10388 with xmalloc holding FILE's contents. Value is null if an error
10389 occured. *SIZE is set to the size of the file. */
10390
10391static char *
10392pbm_read_file (file, size)
10393 Lisp_Object file;
10394 int *size;
10395{
10396 FILE *fp = NULL;
10397 char *buf = NULL;
10398 struct stat st;
10399
10400 if (stat (XSTRING (file)->data, &st) == 0
10401 && (fp = fopen (XSTRING (file)->data, "r")) != NULL
10402 && (buf = (char *) xmalloc (st.st_size),
10403 fread (buf, 1, st.st_size, fp) == st.st_size))
10404 {
10405 *size = st.st_size;
10406 fclose (fp);
10407 }
10408 else
10409 {
10410 if (fp)
10411 fclose (fp);
10412 if (buf)
10413 {
10414 xfree (buf);
10415 buf = NULL;
10416 }
10417 }
10418
10419 return buf;
10420}
10421
10422
10423/* Load PBM image IMG for use on frame F. */
10424
10425static int
10426pbm_load (f, img)
10427 struct frame *f;
10428 struct image *img;
10429{
10430 int raw_p, x, y;
10431 int width, height, max_color_idx = 0;
10432 XImage *ximg;
10433 Lisp_Object file, specified_file;
10434 enum {PBM_MONO, PBM_GRAY, PBM_COLOR} type;
10435 struct gcpro gcpro1;
10436 unsigned char *contents = NULL;
10437 unsigned char *end, *p;
10438 int size;
10439
10440 specified_file = image_spec_value (img->spec, QCfile, NULL);
10441 file = Qnil;
10442 GCPRO1 (file);
10443
10444 if (STRINGP (specified_file))
10445 {
10446 file = x_find_image_file (specified_file);
10447 if (!STRINGP (file))
10448 {
10449 image_error ("Cannot find image file `%s'", specified_file, Qnil);
10450 UNGCPRO;
10451 return 0;
10452 }
10453
3cf3436e 10454 contents = slurp_file (XSTRING (file)->data, &size);
6fc2811b
JR		 10455 if (contents == NULL)
10456 {
10457 image_error ("Error reading `%s'", file, Qnil);
10458 UNGCPRO;
10459 return 0;
10460 }
10461
10462 p = contents;
10463 end = contents + size;
10464 }
10465 else
10466 {
10467 Lisp_Object data;
10468 data = image_spec_value (img->spec, QCdata, NULL);
10469 p = XSTRING (data)->data;
10470 end = p + STRING_BYTES (XSTRING (data));
10471 }
10472
10473 /* Check magic number. */
10474 if (end - p < 2 || *p++ != 'P')
10475 {
10476 image_error ("Not a PBM image: `%s'", img->spec, Qnil);
10477 error:
10478 xfree (contents);
10479 UNGCPRO;
10480 return 0;
10481 }
10482
6fc2811b
JR		 10483 switch (*p++)
10484 {
10485 case '1':
10486 raw_p = 0, type = PBM_MONO;
10487 break;
10488
10489 case '2':
10490 raw_p = 0, type = PBM_GRAY;
10491 break;
10492
10493 case '3':
10494 raw_p = 0, type = PBM_COLOR;
10495 break;
10496
10497 case '4':
10498 raw_p = 1, type = PBM_MONO;
10499 break;
10500
10501 case '5':
10502 raw_p = 1, type = PBM_GRAY;
10503 break;
10504
10505 case '6':
10506 raw_p = 1, type = PBM_COLOR;
10507 break;
10508
10509 default:
10510 image_error ("Not a PBM image: `%s'", img->spec, Qnil);
10511 goto error;
10512 }
10513
10514 /* Read width, height, maximum color-component. Characters
10515 starting with `#' up to the end of a line are ignored. */
10516 width = pbm_scan_number (&p, end);
10517 height = pbm_scan_number (&p, end);
10518
10519 if (type != PBM_MONO)
10520 {
10521 max_color_idx = pbm_scan_number (&p, end);
10522 if (raw_p && max_color_idx > 255)
10523 max_color_idx = 255;
10524 }
10525
10526 if (width < 0
10527 || height < 0
10528 || (type != PBM_MONO && max_color_idx < 0))
10529 goto error;
10530
6fc2811b
JR		 10531 if (!x_create_x_image_and_pixmap (f, width, height, 0,
10532 &ximg, &img->pixmap))
3cf3436e
JR		 10533 goto error;
10534
6fc2811b
JR		 10535 /* Initialize the color hash table. */
10536 init_color_table ();
10537
10538 if (type == PBM_MONO)
10539 {
10540 int c = 0, g;
3cf3436e
JR		 10541 struct image_keyword fmt[PBM_LAST];
10542 unsigned long fg = FRAME_FOREGROUND_PIXEL (f);
10543 unsigned long bg = FRAME_BACKGROUND_PIXEL (f);
10544
10545 /* Parse the image specification. */
10546 bcopy (pbm_format, fmt, sizeof fmt);
10547 parse_image_spec (img->spec, fmt, PBM_LAST, Qpbm);
10548
10549 /* Get foreground and background colors, maybe allocate colors. */
10550 if (fmt[PBM_FOREGROUND].count
10551 && STRINGP (fmt[PBM_FOREGROUND].value))
10552 fg = x_alloc_image_color (f, img, fmt[PBM_FOREGROUND].value, fg);
10553 if (fmt[PBM_BACKGROUND].count
10554 && STRINGP (fmt[PBM_BACKGROUND].value))
10555 bg = x_alloc_image_color (f, img, fmt[PBM_BACKGROUND].value, bg);
6fc2811b
JR		 10556
10557 for (y = 0; y < height; ++y)
10558 for (x = 0; x < width; ++x)
10559 {
10560 if (raw_p)
10561 {
10562 if ((x & 7) == 0)
10563 c = *p++;
10564 g = c & 0x80;
10565 c <<= 1;
10566 }
10567 else
10568 g = pbm_scan_number (&p, end);
10569
3cf3436e 10570 XPutPixel (ximg, x, y, g ? fg : bg);
6fc2811b
JR		 10571 }
10572 }
10573 else
10574 {
10575 for (y = 0; y < height; ++y)
10576 for (x = 0; x < width; ++x)
10577 {
10578 int r, g, b;
10579
10580 if (type == PBM_GRAY)
10581 r = g = b = raw_p ? *p++ : pbm_scan_number (&p, end);
10582 else if (raw_p)
10583 {
10584 r = *p++;
10585 g = *p++;
10586 b = *p++;
10587 }
10588 else
10589 {
10590 r = pbm_scan_number (&p, end);
10591 g = pbm_scan_number (&p, end);
10592 b = pbm_scan_number (&p, end);
10593 }
10594
10595 if (r < 0 || g < 0 || b < 0)
10596 {
dfff8a69 10597 xfree (ximg->data);
6fc2811b
JR		 10598 ximg->data = NULL;
10599 XDestroyImage (ximg);
6fc2811b
JR		 10600 image_error ("Invalid pixel value in image `%s'",
10601 img->spec, Qnil);
10602 goto error;
10603 }
10604
10605 /* RGB values are now in the range 0..max_color_idx.
10606 Scale this to the range 0..0xffff supported by X. */
10607 r = (double) r * 65535 / max_color_idx;
10608 g = (double) g * 65535 / max_color_idx;
10609 b = (double) b * 65535 / max_color_idx;
10610 XPutPixel (ximg, x, y, lookup_rgb_color (f, r, g, b));
10611 }
10612 }
10613
10614 /* Store in IMG->colors the colors allocated for the image, and
10615 free the color table. */
10616 img->colors = colors_in_color_table (&img->ncolors);
10617 free_color_table ();
10618
10619 /* Put the image into a pixmap. */
10620 x_put_x_image (f, ximg, img->pixmap, width, height);
10621 x_destroy_x_image (ximg);
6fc2811b
JR		 10622
10623 img->width = width;
10624 img->height = height;
10625
10626 UNGCPRO;
10627 xfree (contents);
10628 return 1;
10629}
10630#endif /* HAVE_PBM */
10631
10632\f
10633/***********************************************************************
10634 PNG
10635 ***********************************************************************/
10636
10637#if HAVE_PNG
10638
10639#include <png.h>
10640
10641/* Function prototypes. */
10642
10643static int png_image_p P_ ((Lisp_Object object));
10644static int png_load P_ ((struct frame *f, struct image *img));
10645
10646/* The symbol `png' identifying images of this type. */
10647
10648Lisp_Object Qpng;
10649
10650/* Indices of image specification fields in png_format, below. */
10651
10652enum png_keyword_index
10653{
10654 PNG_TYPE,
10655 PNG_DATA,
10656 PNG_FILE,
10657 PNG_ASCENT,
10658 PNG_MARGIN,
10659 PNG_RELIEF,
10660 PNG_ALGORITHM,
10661 PNG_HEURISTIC_MASK,
10662 PNG_LAST
10663};
10664
10665/* Vector of image_keyword structures describing the format
10666 of valid user-defined image specifications. */
10667
10668static struct image_keyword png_format[PNG_LAST] =
10669{
10670 {":type", IMAGE_SYMBOL_VALUE, 1},
10671 {":data", IMAGE_STRING_VALUE, 0},
10672 {":file", IMAGE_STRING_VALUE, 0},
10673 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
8edb0a6f 10674 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
6fc2811b 10675 {":relief", IMAGE_INTEGER_VALUE, 0},
a93f4566 10676 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6fc2811b
JR		 10677 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
10678};
10679
10680/* Structure describing the image type `png'. */
10681
10682static struct image_type png_type =
10683{
10684 &Qpng,
10685 png_image_p,
10686 png_load,
10687 x_clear_image,
10688 NULL
10689};
10690
10691
10692/* Return non-zero if OBJECT is a valid PNG image specification. */
10693
10694static int
10695png_image_p (object)
10696 Lisp_Object object;
10697{
10698 struct image_keyword fmt[PNG_LAST];
10699 bcopy (png_format, fmt, sizeof fmt);
10700
10701 if (!parse_image_spec (object, fmt, PNG_LAST, Qpng)
10702 || (fmt[PNG_ASCENT].count
10703 && XFASTINT (fmt[PNG_ASCENT].value) > 100))
10704 return 0;
10705
10706 /* Must specify either the :data or :file keyword. */
10707 return fmt[PNG_FILE].count + fmt[PNG_DATA].count == 1;
10708}
10709
10710
10711/* Error and warning handlers installed when the PNG library
10712 is initialized. */
10713
10714static void
10715my_png_error (png_ptr, msg)
10716 png_struct *png_ptr;
10717 char *msg;
10718{
10719 xassert (png_ptr != NULL);
10720 image_error ("PNG error: %s", build_string (msg), Qnil);
10721 longjmp (png_ptr->jmpbuf, 1);
10722}
10723
10724
10725static void
10726my_png_warning (png_ptr, msg)
10727 png_struct *png_ptr;
10728 char *msg;
10729{
10730 xassert (png_ptr != NULL);
10731 image_error ("PNG warning: %s", build_string (msg), Qnil);
10732}
10733
6fc2811b
JR		 10734/* Memory source for PNG decoding. */
10735
10736struct png_memory_storage
10737{
10738 unsigned char *bytes; /* The data */
10739 size_t len; /* How big is it? */
10740 int index; /* Where are we? */
10741};
10742
10743
10744/* Function set as reader function when reading PNG image from memory.
10745 PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
10746 bytes from the input to DATA. */
10747
10748static void
10749png_read_from_memory (png_ptr, data, length)
10750 png_structp png_ptr;
10751 png_bytep data;
10752 png_size_t length;
10753{
10754 struct png_memory_storage *tbr
10755 = (struct png_memory_storage *) png_get_io_ptr (png_ptr);
10756
10757 if (length > tbr->len - tbr->index)
10758 png_error (png_ptr, "Read error");
10759
10760 bcopy (tbr->bytes + tbr->index, data, length);
10761 tbr->index = tbr->index + length;
10762}
10763
6fc2811b
JR		 10764/* Load PNG image IMG for use on frame F. Value is non-zero if
10765 successful. */
10766
10767static int
10768png_load (f, img)
10769 struct frame *f;
10770 struct image *img;
10771{
10772 Lisp_Object file, specified_file;
10773 Lisp_Object specified_data;
10774 int x, y, i;
10775 XImage *ximg, *mask_img = NULL;
10776 struct gcpro gcpro1;
10777 png_struct *png_ptr = NULL;
10778 png_info *info_ptr = NULL, *end_info = NULL;
10779 FILE *fp = NULL;
10780 png_byte sig[8];
10781 png_byte *pixels = NULL;
10782 png_byte **rows = NULL;
10783 png_uint_32 width, height;
10784 int bit_depth, color_type, interlace_type;
10785 png_byte channels;
10786 png_uint_32 row_bytes;
10787 int transparent_p;
10788 char *gamma_str;
10789 double screen_gamma, image_gamma;
10790 int intent;
10791 struct png_memory_storage tbr; /* Data to be read */
10792
10793 /* Find out what file to load. */
10794 specified_file = image_spec_value (img->spec, QCfile, NULL);
10795 specified_data = image_spec_value (img->spec, QCdata, NULL);
10796 file = Qnil;
10797 GCPRO1 (file);
10798
10799 if (NILP (specified_data))
10800 {
10801 file = x_find_image_file (specified_file);
10802 if (!STRINGP (file))
10803 {
10804 image_error ("Cannot find image file `%s'", specified_file, Qnil);
10805 UNGCPRO;
10806 return 0;
10807 }
10808
10809 /* Open the image file. */
10810 fp = fopen (XSTRING (file)->data, "rb");
10811 if (!fp)
10812 {
10813 image_error ("Cannot open image file `%s'", file, Qnil);
10814 UNGCPRO;
10815 fclose (fp);
10816 return 0;
10817 }
10818
10819 /* Check PNG signature. */
10820 if (fread (sig, 1, sizeof sig, fp) != sizeof sig
10821 || !png_check_sig (sig, sizeof sig))
10822 {
10823 image_error ("Not a PNG file:` %s'", file, Qnil);
10824 UNGCPRO;
10825 fclose (fp);
10826 return 0;
10827 }
10828 }
10829 else
10830 {
10831 /* Read from memory. */
10832 tbr.bytes = XSTRING (specified_data)->data;
10833 tbr.len = STRING_BYTES (XSTRING (specified_data));
10834 tbr.index = 0;
10835
10836 /* Check PNG signature. */
10837 if (tbr.len < sizeof sig
10838 || !png_check_sig (tbr.bytes, sizeof sig))
10839 {
10840 image_error ("Not a PNG image: `%s'", img->spec, Qnil);
10841 UNGCPRO;
10842 return 0;
10843 }
10844
10845 /* Need to skip past the signature. */
10846 tbr.bytes += sizeof (sig);
10847 }
10848
6fc2811b
JR		 10849 /* Initialize read and info structs for PNG lib. */
10850 png_ptr = png_create_read_struct (PNG_LIBPNG_VER_STRING, NULL,
10851 my_png_error, my_png_warning);
10852 if (!png_ptr)
10853 {
10854 if (fp) fclose (fp);
10855 UNGCPRO;
10856 return 0;
10857 }
10858
10859 info_ptr = png_create_info_struct (png_ptr);
10860 if (!info_ptr)
10861 {
10862 png_destroy_read_struct (&png_ptr, NULL, NULL);
10863 if (fp) fclose (fp);
10864 UNGCPRO;
10865 return 0;
10866 }
10867
10868 end_info = png_create_info_struct (png_ptr);
10869 if (!end_info)
10870 {
10871 png_destroy_read_struct (&png_ptr, &info_ptr, NULL);
10872 if (fp) fclose (fp);
10873 UNGCPRO;
10874 return 0;
10875 }
10876
10877 /* Set error jump-back. We come back here when the PNG library
10878 detects an error. */
10879 if (setjmp (png_ptr->jmpbuf))
10880 {
10881 error:
10882 if (png_ptr)
10883 png_destroy_read_struct (&png_ptr, &info_ptr, &end_info);
10884 xfree (pixels);
10885 xfree (rows);
10886 if (fp) fclose (fp);
10887 UNGCPRO;
10888 return 0;
10889 }
10890
10891 /* Read image info. */
10892 if (!NILP (specified_data))
10893 png_set_read_fn (png_ptr, (void *) &tbr, png_read_from_memory);
10894 else
10895 png_init_io (png_ptr, fp);
10896
10897 png_set_sig_bytes (png_ptr, sizeof sig);
10898 png_read_info (png_ptr, info_ptr);
10899 png_get_IHDR (png_ptr, info_ptr, &width, &height, &bit_depth, &color_type,
10900 &interlace_type, NULL, NULL);
10901
10902 /* If image contains simply transparency data, we prefer to
10903 construct a clipping mask. */
10904 if (png_get_valid (png_ptr, info_ptr, PNG_INFO_tRNS))
10905 transparent_p = 1;
10906 else
10907 transparent_p = 0;
10908
10909 /* This function is easier to write if we only have to handle
10910 one data format: RGB or RGBA with 8 bits per channel. Let's
10911 transform other formats into that format. */
10912
10913 /* Strip more than 8 bits per channel. */
10914 if (bit_depth == 16)
10915 png_set_strip_16 (png_ptr);
10916
10917 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
10918 if available. */
10919 png_set_expand (png_ptr);
10920
10921 /* Convert grayscale images to RGB. */
10922 if (color_type == PNG_COLOR_TYPE_GRAY
10923 || color_type == PNG_COLOR_TYPE_GRAY_ALPHA)
10924 png_set_gray_to_rgb (png_ptr);
10925
10926 /* The value 2.2 is a guess for PC monitors from PNG example.c. */
10927 gamma_str = getenv ("SCREEN_GAMMA");
10928 screen_gamma = gamma_str ? atof (gamma_str) : 2.2;
10929
10930 /* Tell the PNG lib to handle gamma correction for us. */
10931
10932#if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
10933 if (png_get_sRGB (png_ptr, info_ptr, &intent))
10934 /* There is a special chunk in the image specifying the gamma. */
10935 png_set_sRGB (png_ptr, info_ptr, intent);
10936 else
10937#endif
10938 if (png_get_gAMA (png_ptr, info_ptr, &image_gamma))
10939 /* Image contains gamma information. */
10940 png_set_gamma (png_ptr, screen_gamma, image_gamma);
10941 else
10942 /* Use a default of 0.5 for the image gamma. */
10943 png_set_gamma (png_ptr, screen_gamma, 0.5);
10944
10945 /* Handle alpha channel by combining the image with a background
10946 color. Do this only if a real alpha channel is supplied. For
10947 simple transparency, we prefer a clipping mask. */
10948 if (!transparent_p)
10949 {
10950 png_color_16 *image_background;
10951
10952 if (png_get_bKGD (png_ptr, info_ptr, &image_background))
10953 /* Image contains a background color with which to
10954 combine the image. */
10955 png_set_background (png_ptr, image_background,
10956 PNG_BACKGROUND_GAMMA_FILE, 1, 1.0);
10957 else
10958 {
10959 /* Image does not contain a background color with which
10960 to combine the image data via an alpha channel. Use
10961 the frame's background instead. */
10962 XColor color;
10963 Colormap cmap;
10964 png_color_16 frame_background;
10965
10966 BLOCK_INPUT;
10967 cmap = DefaultColormapOfScreen (FRAME_X_SCREEN (f));
10968 color.pixel = FRAME_BACKGROUND_PIXEL (f);
10969 XQueryColor (FRAME_W32_DISPLAY (f), cmap, &color);
10970 UNBLOCK_INPUT;
10971
10972 bzero (&frame_background, sizeof frame_background);
10973 frame_background.red = color.red;
10974 frame_background.green = color.green;
10975 frame_background.blue = color.blue;
10976
10977 png_set_background (png_ptr, &frame_background,
10978 PNG_BACKGROUND_GAMMA_SCREEN, 0, 1.0);
10979 }
10980 }
10981
10982 /* Update info structure. */
10983 png_read_update_info (png_ptr, info_ptr);
10984
10985 /* Get number of channels. Valid values are 1 for grayscale images
10986 and images with a palette, 2 for grayscale images with transparency
10987 information (alpha channel), 3 for RGB images, and 4 for RGB
10988 images with alpha channel, i.e. RGBA. If conversions above were
10989 sufficient we should only have 3 or 4 channels here. */
10990 channels = png_get_channels (png_ptr, info_ptr);
10991 xassert (channels == 3 || channels == 4);
10992
10993 /* Number of bytes needed for one row of the image. */
10994 row_bytes = png_get_rowbytes (png_ptr, info_ptr);
10995
10996 /* Allocate memory for the image. */
10997 pixels = (png_byte *) xmalloc (row_bytes * height * sizeof *pixels);
10998 rows = (png_byte **) xmalloc (height * sizeof *rows);
10999 for (i = 0; i < height; ++i)
11000 rows[i] = pixels + i * row_bytes;
11001
11002 /* Read the entire image. */
11003 png_read_image (png_ptr, rows);
11004 png_read_end (png_ptr, info_ptr);
11005 if (fp)
11006 {
11007 fclose (fp);
11008 fp = NULL;
11009 }
11010
11011 BLOCK_INPUT;
11012
11013 /* Create the X image and pixmap. */
11014 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg,
11015 &img->pixmap))
11016 {
11017 UNBLOCK_INPUT;
11018 goto error;
11019 }
11020
11021 /* Create an image and pixmap serving as mask if the PNG image
11022 contains an alpha channel. */
11023 if (channels == 4
11024 && !transparent_p
11025 && !x_create_x_image_and_pixmap (f, width, height, 1,
11026 &mask_img, &img->mask))
11027 {
11028 x_destroy_x_image (ximg);
11029 XFreePixmap (FRAME_W32_DISPLAY (f), img->pixmap);
11030 img->pixmap = 0;
11031 UNBLOCK_INPUT;
11032 goto error;
11033 }
11034
11035 /* Fill the X image and mask from PNG data. */
11036 init_color_table ();
11037
11038 for (y = 0; y < height; ++y)
11039 {
11040 png_byte *p = rows[y];
11041
11042 for (x = 0; x < width; ++x)
11043 {
11044 unsigned r, g, b;
11045
11046 r = *p++ << 8;
11047 g = *p++ << 8;
11048 b = *p++ << 8;
11049 XPutPixel (ximg, x, y, lookup_rgb_color (f, r, g, b));
11050
11051 /* An alpha channel, aka mask channel, associates variable
11052 transparency with an image. Where other image formats
11053 support binary transparency---fully transparent or fully
11054 opaque---PNG allows up to 254 levels of partial transparency.
11055 The PNG library implements partial transparency by combining
11056 the image with a specified background color.
11057
11058 I'm not sure how to handle this here nicely: because the
11059 background on which the image is displayed may change, for
11060 real alpha channel support, it would be necessary to create
11061 a new image for each possible background.
11062
11063 What I'm doing now is that a mask is created if we have
11064 boolean transparency information. Otherwise I'm using
11065 the frame's background color to combine the image with. */
11066
11067 if (channels == 4)
11068 {
11069 if (mask_img)
11070 XPutPixel (mask_img, x, y, *p > 0);
11071 ++p;
11072 }
11073 }
11074 }
11075
11076 /* Remember colors allocated for this image. */
11077 img->colors = colors_in_color_table (&img->ncolors);
11078 free_color_table ();
11079
11080 /* Clean up. */
11081 png_destroy_read_struct (&png_ptr, &info_ptr, &end_info);
11082 xfree (rows);
11083 xfree (pixels);
11084
11085 img->width = width;
11086 img->height = height;
11087
11088 /* Put the image into the pixmap, then free the X image and its buffer. */
11089 x_put_x_image (f, ximg, img->pixmap, width, height);
11090 x_destroy_x_image (ximg);
11091
11092 /* Same for the mask. */
11093 if (mask_img)
11094 {
11095 x_put_x_image (f, mask_img, img->mask, img->width, img->height);
11096 x_destroy_x_image (mask_img);
11097 }
11098
11099 UNBLOCK_INPUT;
11100 UNGCPRO;
11101 return 1;
11102}
11103
11104#endif /* HAVE_PNG != 0 */
11105
11106
11107\f
11108/***********************************************************************
11109 JPEG
11110 ***********************************************************************/
11111
11112#if HAVE_JPEG
11113
11114/* Work around a warning about HAVE_STDLIB_H being redefined in
11115 jconfig.h. */
11116#ifdef HAVE_STDLIB_H
11117#define HAVE_STDLIB_H_1
11118#undef HAVE_STDLIB_H
11119#endif /* HAVE_STLIB_H */
11120
11121#include <jpeglib.h>
11122#include <jerror.h>
11123#include <setjmp.h>
11124
11125#ifdef HAVE_STLIB_H_1
11126#define HAVE_STDLIB_H 1
11127#endif
11128
11129static int jpeg_image_p P_ ((Lisp_Object object));
11130static int jpeg_load P_ ((struct frame *f, struct image *img));
11131
11132/* The symbol `jpeg' identifying images of this type. */
11133
11134Lisp_Object Qjpeg;
11135
11136/* Indices of image specification fields in gs_format, below. */
11137
11138enum jpeg_keyword_index
11139{
11140 JPEG_TYPE,
11141 JPEG_DATA,
11142 JPEG_FILE,
11143 JPEG_ASCENT,
11144 JPEG_MARGIN,
11145 JPEG_RELIEF,
11146 JPEG_ALGORITHM,
11147 JPEG_HEURISTIC_MASK,
11148 JPEG_LAST
11149};
11150
11151/* Vector of image_keyword structures describing the format
11152 of valid user-defined image specifications. */
11153
11154static struct image_keyword jpeg_format[JPEG_LAST] =
11155{
11156 {":type", IMAGE_SYMBOL_VALUE, 1},
11157 {":data", IMAGE_STRING_VALUE, 0},
11158 {":file", IMAGE_STRING_VALUE, 0},
11159 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
8edb0a6f 11160 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
6fc2811b 11161 {":relief", IMAGE_INTEGER_VALUE, 0},
a93f4566 11162 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6fc2811b
JR		 11163 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
11164};
11165
11166/* Structure describing the image type `jpeg'. */
11167
11168static struct image_type jpeg_type =
11169{
11170 &Qjpeg,
11171 jpeg_image_p,
11172 jpeg_load,
11173 x_clear_image,
11174 NULL
11175};
11176
11177
11178/* Return non-zero if OBJECT is a valid JPEG image specification. */
11179
11180static int
11181jpeg_image_p (object)
11182 Lisp_Object object;
11183{
11184 struct image_keyword fmt[JPEG_LAST];
11185
11186 bcopy (jpeg_format, fmt, sizeof fmt);
11187
11188 if (!parse_image_spec (object, fmt, JPEG_LAST, Qjpeg)
11189 || (fmt[JPEG_ASCENT].count
11190 && XFASTINT (fmt[JPEG_ASCENT].value) > 100))
11191 return 0;
11192
11193 /* Must specify either the :data or :file keyword. */
11194 return fmt[JPEG_FILE].count + fmt[JPEG_DATA].count == 1;
11195}
11196
11197
11198struct my_jpeg_error_mgr
11199{
11200 struct jpeg_error_mgr pub;
11201 jmp_buf setjmp_buffer;
11202};
11203
11204static void
11205my_error_exit (cinfo)
11206 j_common_ptr cinfo;
11207{
11208 struct my_jpeg_error_mgr *mgr = (struct my_jpeg_error_mgr *) cinfo->err;
11209 longjmp (mgr->setjmp_buffer, 1);
11210}
11211
6fc2811b
JR		 11212/* Init source method for JPEG data source manager. Called by
11213 jpeg_read_header() before any data is actually read. See
11214 libjpeg.doc from the JPEG lib distribution. */
11215
11216static void
11217our_init_source (cinfo)
11218 j_decompress_ptr cinfo;
11219{
11220}
11221
11222
11223/* Fill input buffer method for JPEG data source manager. Called
11224 whenever more data is needed. We read the whole image in one step,
11225 so this only adds a fake end of input marker at the end. */
11226
11227static boolean
11228our_fill_input_buffer (cinfo)
11229 j_decompress_ptr cinfo;
11230{
11231 /* Insert a fake EOI marker. */
11232 struct jpeg_source_mgr *src = cinfo->src;
11233 static JOCTET buffer[2];
11234
11235 buffer[0] = (JOCTET) 0xFF;
11236 buffer[1] = (JOCTET) JPEG_EOI;
11237
11238 src->next_input_byte = buffer;
11239 src->bytes_in_buffer = 2;
11240 return TRUE;
11241}
11242
11243
11244/* Method to skip over NUM_BYTES bytes in the image data. CINFO->src
11245 is the JPEG data source manager. */
11246
11247static void
11248our_skip_input_data (cinfo, num_bytes)
11249 j_decompress_ptr cinfo;
11250 long num_bytes;
11251{
11252 struct jpeg_source_mgr *src = (struct jpeg_source_mgr *) cinfo->src;
11253
11254 if (src)
11255 {
11256 if (num_bytes > src->bytes_in_buffer)
11257 ERREXIT (cinfo, JERR_INPUT_EOF);
11258
11259 src->bytes_in_buffer -= num_bytes;
11260 src->next_input_byte += num_bytes;
11261 }
11262}
11263
11264
11265/* Method to terminate data source. Called by
11266 jpeg_finish_decompress() after all data has been processed. */
11267
11268static void
11269our_term_source (cinfo)
11270 j_decompress_ptr cinfo;
11271{
11272}
11273
11274
11275/* Set up the JPEG lib for reading an image from DATA which contains
11276 LEN bytes. CINFO is the decompression info structure created for
11277 reading the image. */
11278
11279static void
11280jpeg_memory_src (cinfo, data, len)
11281 j_decompress_ptr cinfo;
11282 JOCTET *data;
11283 unsigned int len;
11284{
11285 struct jpeg_source_mgr *src;
11286
11287 if (cinfo->src == NULL)
11288 {
11289 /* First time for this JPEG object? */
11290 cinfo->src = (struct jpeg_source_mgr *)
11291 (*cinfo->mem->alloc_small) ((j_common_ptr) cinfo, JPOOL_PERMANENT,
11292 sizeof (struct jpeg_source_mgr));
11293 src = (struct jpeg_source_mgr *) cinfo->src;
11294 src->next_input_byte = data;
11295 }
11296
11297 src = (struct jpeg_source_mgr *) cinfo->src;
11298 src->init_source = our_init_source;
11299 src->fill_input_buffer = our_fill_input_buffer;
11300 src->skip_input_data = our_skip_input_data;
11301 src->resync_to_restart = jpeg_resync_to_restart; /* Use default method. */
11302 src->term_source = our_term_source;
11303 src->bytes_in_buffer = len;
11304 src->next_input_byte = data;
11305}
11306
11307
11308/* Load image IMG for use on frame F. Patterned after example.c
11309 from the JPEG lib. */
11310
11311static int
11312jpeg_load (f, img)
11313 struct frame *f;
11314 struct image *img;
11315{
11316 struct jpeg_decompress_struct cinfo;
11317 struct my_jpeg_error_mgr mgr;
11318 Lisp_Object file, specified_file;
11319 Lisp_Object specified_data;
11320 FILE *fp = NULL;
11321 JSAMPARRAY buffer;
11322 int row_stride, x, y;
11323 XImage *ximg = NULL;
11324 int rc;
11325 unsigned long *colors;
11326 int width, height;
11327 struct gcpro gcpro1;
11328
11329 /* Open the JPEG file. */
11330 specified_file = image_spec_value (img->spec, QCfile, NULL);
11331 specified_data = image_spec_value (img->spec, QCdata, NULL);
11332 file = Qnil;
11333 GCPRO1 (file);
11334
6fc2811b
JR		 11335 if (NILP (specified_data))
11336 {
11337 file = x_find_image_file (specified_file);
11338 if (!STRINGP (file))
11339 {
11340 image_error ("Cannot find image file `%s'", specified_file, Qnil);
11341 UNGCPRO;
11342 return 0;
11343 }
11344
11345 fp = fopen (XSTRING (file)->data, "r");
11346 if (fp == NULL)
11347 {
11348 image_error ("Cannot open `%s'", file, Qnil);
11349 UNGCPRO;
11350 return 0;
11351 }
11352 }
11353
11354 /* Customize libjpeg's error handling to call my_error_exit when an
11355 error is detected. This function will perform a longjmp. */
11356 mgr.pub.error_exit = my_error_exit;
11357 cinfo.err = jpeg_std_error (&mgr.pub);
11358
11359 if ((rc = setjmp (mgr.setjmp_buffer)) != 0)
11360 {
11361 if (rc == 1)
11362 {
11363 /* Called from my_error_exit. Display a JPEG error. */
11364 char buffer[JMSG_LENGTH_MAX];
11365 cinfo.err->format_message ((j_common_ptr) &cinfo, buffer);
11366 image_error ("Error reading JPEG image `%s': %s", img->spec,
11367 build_string (buffer));
11368 }
11369
11370 /* Close the input file and destroy the JPEG object. */
11371 if (fp)
11372 fclose (fp);
11373 jpeg_destroy_decompress (&cinfo);
11374
11375 BLOCK_INPUT;
11376
11377 /* If we already have an XImage, free that. */
11378 x_destroy_x_image (ximg);
11379
11380 /* Free pixmap and colors. */
11381 x_clear_image (f, img);
11382
11383 UNBLOCK_INPUT;
11384 UNGCPRO;
11385 return 0;
11386 }
11387
11388 /* Create the JPEG decompression object. Let it read from fp.
11389 Read the JPEG image header. */
11390 jpeg_create_decompress (&cinfo);
11391
11392 if (NILP (specified_data))
11393 jpeg_stdio_src (&cinfo, fp);
11394 else
11395 jpeg_memory_src (&cinfo, XSTRING (specified_data)->data,
11396 STRING_BYTES (XSTRING (specified_data)));
11397
11398 jpeg_read_header (&cinfo, TRUE);
11399
11400 /* Customize decompression so that color quantization will be used.
11401 Start decompression. */
11402 cinfo.quantize_colors = TRUE;
11403 jpeg_start_decompress (&cinfo);
11404 width = img->width = cinfo.output_width;
11405 height = img->height = cinfo.output_height;
11406
11407 BLOCK_INPUT;
11408
11409 /* Create X image and pixmap. */
11410 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg,
11411 &img->pixmap))
11412 {
11413 UNBLOCK_INPUT;
11414 longjmp (mgr.setjmp_buffer, 2);
11415 }
11416
11417 /* Allocate colors. When color quantization is used,
11418 cinfo.actual_number_of_colors has been set with the number of
11419 colors generated, and cinfo.colormap is a two-dimensional array
11420 of color indices in the range 0..cinfo.actual_number_of_colors.
11421 No more than 255 colors will be generated. */
11422 {
11423 int i, ir, ig, ib;
11424
11425 if (cinfo.out_color_components > 2)
11426 ir = 0, ig = 1, ib = 2;
11427 else if (cinfo.out_color_components > 1)
11428 ir = 0, ig = 1, ib = 0;
11429 else
11430 ir = 0, ig = 0, ib = 0;
11431
11432 /* Use the color table mechanism because it handles colors that
11433 cannot be allocated nicely. Such colors will be replaced with
11434 a default color, and we don't have to care about which colors
11435 can be freed safely, and which can't. */
11436 init_color_table ();
11437 colors = (unsigned long *) alloca (cinfo.actual_number_of_colors
11438 * sizeof *colors);
11439
11440 for (i = 0; i < cinfo.actual_number_of_colors; ++i)
11441 {
11442 /* Multiply RGB values with 255 because X expects RGB values
11443 in the range 0..0xffff. */
11444 int r = cinfo.colormap[ir][i] << 8;
11445 int g = cinfo.colormap[ig][i] << 8;
11446 int b = cinfo.colormap[ib][i] << 8;
11447 colors[i] = lookup_rgb_color (f, r, g, b);
11448 }
11449
11450 /* Remember those colors actually allocated. */
11451 img->colors = colors_in_color_table (&img->ncolors);
11452 free_color_table ();
11453 }
11454
11455 /* Read pixels. */
11456 row_stride = width * cinfo.output_components;
11457 buffer = cinfo.mem->alloc_sarray ((j_common_ptr) &cinfo, JPOOL_IMAGE,
11458 row_stride, 1);
11459 for (y = 0; y < height; ++y)
11460 {
11461 jpeg_read_scanlines (&cinfo, buffer, 1);
11462 for (x = 0; x < cinfo.output_width; ++x)
11463 XPutPixel (ximg, x, y, colors[buffer[0][x]]);
11464 }
11465
11466 /* Clean up. */
11467 jpeg_finish_decompress (&cinfo);
11468 jpeg_destroy_decompress (&cinfo);
11469 if (fp)
11470 fclose (fp);
11471
11472 /* Put the image into the pixmap. */
11473 x_put_x_image (f, ximg, img->pixmap, width, height);
11474 x_destroy_x_image (ximg);
11475 UNBLOCK_INPUT;
11476 UNGCPRO;
11477 return 1;
11478}
11479
11480#endif /* HAVE_JPEG */
11481
11482
11483\f
11484/***********************************************************************
11485 TIFF
11486 ***********************************************************************/
11487
11488#if HAVE_TIFF
11489
11490#include <tiffio.h>
11491
11492static int tiff_image_p P_ ((Lisp_Object object));
11493static int tiff_load P_ ((struct frame *f, struct image *img));
11494
11495/* The symbol `tiff' identifying images of this type. */
11496
11497Lisp_Object Qtiff;
11498
11499/* Indices of image specification fields in tiff_format, below. */
11500
11501enum tiff_keyword_index
11502{
11503 TIFF_TYPE,
11504 TIFF_DATA,
11505 TIFF_FILE,
11506 TIFF_ASCENT,
11507 TIFF_MARGIN,
11508 TIFF_RELIEF,
11509 TIFF_ALGORITHM,
11510 TIFF_HEURISTIC_MASK,
11511 TIFF_LAST
11512};
11513
11514/* Vector of image_keyword structures describing the format
11515 of valid user-defined image specifications. */
11516
11517static struct image_keyword tiff_format[TIFF_LAST] =
11518{
11519 {":type", IMAGE_SYMBOL_VALUE, 1},
11520 {":data", IMAGE_STRING_VALUE, 0},
11521 {":file", IMAGE_STRING_VALUE, 0},
11522 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
8edb0a6f 11523 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
6fc2811b 11524 {":relief", IMAGE_INTEGER_VALUE, 0},
a93f4566 11525 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6fc2811b
JR		 11526 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
11527};
11528
11529/* Structure describing the image type `tiff'. */
11530
11531static struct image_type tiff_type =
11532{
11533 &Qtiff,
11534 tiff_image_p,
11535 tiff_load,
11536 x_clear_image,
11537 NULL
11538};
11539
11540
11541/* Return non-zero if OBJECT is a valid TIFF image specification. */
11542
11543static int
11544tiff_image_p (object)
11545 Lisp_Object object;
11546{
11547 struct image_keyword fmt[TIFF_LAST];
11548 bcopy (tiff_format, fmt, sizeof fmt);
11549
11550 if (!parse_image_spec (object, fmt, TIFF_LAST, Qtiff)
11551 || (fmt[TIFF_ASCENT].count
11552 && XFASTINT (fmt[TIFF_ASCENT].value) > 100))
11553 return 0;
11554
11555 /* Must specify either the :data or :file keyword. */
11556 return fmt[TIFF_FILE].count + fmt[TIFF_DATA].count == 1;
11557}
11558
11559
11560/* Reading from a memory buffer for TIFF images Based on the PNG
11561 memory source, but we have to provide a lot of extra functions.
11562 Blah.
11563
11564 We really only need to implement read and seek, but I am not
11565 convinced that the TIFF library is smart enough not to destroy
11566 itself if we only hand it the function pointers we need to
11567 override. */
11568
11569typedef struct
11570{
11571 unsigned char *bytes;
11572 size_t len;
11573 int index;
11574}
11575tiff_memory_source;
11576
11577static size_t
11578tiff_read_from_memory (data, buf, size)
11579 thandle_t data;
11580 tdata_t buf;
11581 tsize_t size;
11582{
11583 tiff_memory_source *src = (tiff_memory_source *) data;
11584
11585 if (size > src->len - src->index)
11586 return (size_t) -1;
11587 bcopy (src->bytes + src->index, buf, size);
11588 src->index += size;
11589 return size;
11590}
11591
11592static size_t
11593tiff_write_from_memory (data, buf, size)
11594 thandle_t data;
11595 tdata_t buf;
11596 tsize_t size;
11597{
11598 return (size_t) -1;
11599}
11600
11601static toff_t
11602tiff_seek_in_memory (data, off, whence)
11603 thandle_t data;
11604 toff_t off;
11605 int whence;
11606{
11607 tiff_memory_source *src = (tiff_memory_source *) data;
11608 int idx;
11609
11610 switch (whence)
11611 {
11612 case SEEK_SET: /* Go from beginning of source. */
11613 idx = off;
11614 break;
11615
11616 case SEEK_END: /* Go from end of source. */
11617 idx = src->len + off;
11618 break;
11619
11620 case SEEK_CUR: /* Go from current position. */
11621 idx = src->index + off;
11622 break;
11623
11624 default: /* Invalid `whence'. */
11625 return -1;
11626 }
11627
11628 if (idx > src->len || idx < 0)
11629 return -1;
11630
11631 src->index = idx;
11632 return src->index;
11633}
11634
11635static int
11636tiff_close_memory (data)
11637 thandle_t data;
11638{
11639 /* NOOP */
11640 return 0;
11641}
11642
11643static int
11644tiff_mmap_memory (data, pbase, psize)
11645 thandle_t data;
11646 tdata_t *pbase;
11647 toff_t *psize;
11648{
11649 /* It is already _IN_ memory. */
11650 return 0;
11651}
11652
11653static void
11654tiff_unmap_memory (data, base, size)
11655 thandle_t data;
11656 tdata_t base;
11657 toff_t size;
11658{
11659 /* We don't need to do this. */
11660}
11661
11662static toff_t
11663tiff_size_of_memory (data)
11664 thandle_t data;
11665{
11666 return ((tiff_memory_source *) data)->len;
11667}
11668
3cf3436e
JR		 11669
11670static void
11671tiff_error_handler (title, format, ap)
11672 const char *title, *format;
11673 va_list ap;
11674{
11675 char buf[512];
11676 int len;
11677
11678 len = sprintf (buf, "TIFF error: %s ", title);
11679 vsprintf (buf + len, format, ap);
11680 add_to_log (buf, Qnil, Qnil);
11681}
11682
11683
11684static void
11685tiff_warning_handler (title, format, ap)
11686 const char *title, *format;
11687 va_list ap;
11688{
11689 char buf[512];
11690 int len;
11691
11692 len = sprintf (buf, "TIFF warning: %s ", title);
11693 vsprintf (buf + len, format, ap);
11694 add_to_log (buf, Qnil, Qnil);
11695}
11696
11697
6fc2811b
JR		 11698/* Load TIFF image IMG for use on frame F. Value is non-zero if
11699 successful. */
11700
11701static int
11702tiff_load (f, img)
11703 struct frame *f;
11704 struct image *img;
11705{
11706 Lisp_Object file, specified_file;
11707 Lisp_Object specified_data;
11708 TIFF *tiff;
11709 int width, height, x, y;
11710 uint32 *buf;
11711 int rc;
11712 XImage *ximg;
11713 struct gcpro gcpro1;
11714 tiff_memory_source memsrc;
11715
11716 specified_file = image_spec_value (img->spec, QCfile, NULL);
11717 specified_data = image_spec_value (img->spec, QCdata, NULL);
11718 file = Qnil;
11719 GCPRO1 (file);
11720
3cf3436e
JR		 11721 TIFFSetErrorHandler (tiff_error_handler);
11722 TIFFSetWarningHandler (tiff_warning_handler);
11723
6fc2811b
JR		 11724 if (NILP (specified_data))
11725 {
11726 /* Read from a file */
11727 file = x_find_image_file (specified_file);
11728 if (!STRINGP (file))
3cf3436e
JR		 11729 {
11730 image_error ("Cannot find image file `%s'", file, Qnil);
11731 UNGCPRO;
11732 return 0;
11733 }
11734
6fc2811b
JR		 11735 /* Try to open the image file. */
11736 tiff = TIFFOpen (XSTRING (file)->data, "r");
11737 if (tiff == NULL)
3cf3436e
JR		 11738 {
11739 image_error ("Cannot open `%s'", file, Qnil);
11740 UNGCPRO;
11741 return 0;
11742 }
6fc2811b
JR		 11743 }
11744 else
11745 {
11746 /* Memory source! */
11747 memsrc.bytes = XSTRING (specified_data)->data;
11748 memsrc.len = STRING_BYTES (XSTRING (specified_data));
11749 memsrc.index = 0;
11750
11751 tiff = TIFFClientOpen ("memory_source", "r", &memsrc,
11752 (TIFFReadWriteProc) tiff_read_from_memory,
11753 (TIFFReadWriteProc) tiff_write_from_memory,
11754 tiff_seek_in_memory,
11755 tiff_close_memory,
11756 tiff_size_of_memory,
11757 tiff_mmap_memory,
11758 tiff_unmap_memory);
11759
11760 if (!tiff)
11761 {
11762 image_error ("Cannot open memory source for `%s'", img->spec, Qnil);
11763 UNGCPRO;
11764 return 0;
11765 }
11766 }
11767
11768 /* Get width and height of the image, and allocate a raster buffer
11769 of width x height 32-bit values. */
11770 TIFFGetField (tiff, TIFFTAG_IMAGEWIDTH, &width);
11771 TIFFGetField (tiff, TIFFTAG_IMAGELENGTH, &height);
11772 buf = (uint32 *) xmalloc (width * height * sizeof *buf);
11773
11774 rc = TIFFReadRGBAImage (tiff, width, height, buf, 0);
11775 TIFFClose (tiff);
11776 if (!rc)
11777 {
11778 image_error ("Error reading TIFF image `%s'", img->spec, Qnil);
11779 xfree (buf);
11780 UNGCPRO;
11781 return 0;
11782 }
11783
6fc2811b
JR		 11784 /* Create the X image and pixmap. */
11785 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg, &img->pixmap))
11786 {
6fc2811b
JR		 11787 xfree (buf);
11788 UNGCPRO;
11789 return 0;
11790 }
11791
11792 /* Initialize the color table. */
11793 init_color_table ();
11794
11795 /* Process the pixel raster. Origin is in the lower-left corner. */
11796 for (y = 0; y < height; ++y)
11797 {
11798 uint32 *row = buf + y * width;
11799
11800 for (x = 0; x < width; ++x)
11801 {
11802 uint32 abgr = row[x];
11803 int r = TIFFGetR (abgr) << 8;
11804 int g = TIFFGetG (abgr) << 8;
11805 int b = TIFFGetB (abgr) << 8;
11806 XPutPixel (ximg, x, height - 1 - y, lookup_rgb_color (f, r, g, b));
11807 }
11808 }
11809
11810 /* Remember the colors allocated for the image. Free the color table. */
11811 img->colors = colors_in_color_table (&img->ncolors);
11812 free_color_table ();
11813
11814 /* Put the image into the pixmap, then free the X image and its buffer. */
11815 x_put_x_image (f, ximg, img->pixmap, width, height);
11816 x_destroy_x_image (ximg);
11817 xfree (buf);
6fc2811b
JR		 11818
11819 img->width = width;
11820 img->height = height;
11821
11822 UNGCPRO;
11823 return 1;
11824}
11825
11826#endif /* HAVE_TIFF != 0 */
11827
11828
11829\f
11830/***********************************************************************
11831 GIF
11832 ***********************************************************************/
11833
11834#if HAVE_GIF
11835
11836#include <gif_lib.h>
11837
11838static int gif_image_p P_ ((Lisp_Object object));
11839static int gif_load P_ ((struct frame *f, struct image *img));
11840
11841/* The symbol `gif' identifying images of this type. */
11842
11843Lisp_Object Qgif;
11844
11845/* Indices of image specification fields in gif_format, below. */
11846
11847enum gif_keyword_index
11848{
11849 GIF_TYPE,
11850 GIF_DATA,
11851 GIF_FILE,
11852 GIF_ASCENT,
11853 GIF_MARGIN,
11854 GIF_RELIEF,
11855 GIF_ALGORITHM,
11856 GIF_HEURISTIC_MASK,
11857 GIF_IMAGE,
11858 GIF_LAST
11859};
11860
11861/* Vector of image_keyword structures describing the format
11862 of valid user-defined image specifications. */
11863
11864static struct image_keyword gif_format[GIF_LAST] =
11865{
11866 {":type", IMAGE_SYMBOL_VALUE, 1},
11867 {":data", IMAGE_STRING_VALUE, 0},
11868 {":file", IMAGE_STRING_VALUE, 0},
11869 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
8edb0a6f 11870 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
6fc2811b 11871 {":relief", IMAGE_INTEGER_VALUE, 0},
a93f4566 11872 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6fc2811b
JR		 11873 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
11874 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0}
11875};
11876
11877/* Structure describing the image type `gif'. */
11878
11879static struct image_type gif_type =
11880{
11881 &Qgif,
11882 gif_image_p,
11883 gif_load,
11884 x_clear_image,
11885 NULL
11886};
11887
11888/* Return non-zero if OBJECT is a valid GIF image specification. */
11889
11890static int
11891gif_image_p (object)
11892 Lisp_Object object;
11893{
11894 struct image_keyword fmt[GIF_LAST];
11895 bcopy (gif_format, fmt, sizeof fmt);
11896
11897 if (!parse_image_spec (object, fmt, GIF_LAST, Qgif)
11898 || (fmt[GIF_ASCENT].count
11899 && XFASTINT (fmt[GIF_ASCENT].value) > 100))
11900 return 0;
11901
11902 /* Must specify either the :data or :file keyword. */
11903 return fmt[GIF_FILE].count + fmt[GIF_DATA].count == 1;
11904}
11905
11906/* Reading a GIF image from memory
11907 Based on the PNG memory stuff to a certain extent. */
11908
11909typedef struct
11910{
11911 unsigned char *bytes;
11912 size_t len;
11913 int index;
11914}
11915gif_memory_source;
11916
11917/* Make the current memory source available to gif_read_from_memory.
11918 It's done this way because not all versions of libungif support
11919 a UserData field in the GifFileType structure. */
11920static gif_memory_source *current_gif_memory_src;
11921
11922static int
11923gif_read_from_memory (file, buf, len)
11924 GifFileType *file;
11925 GifByteType *buf;
11926 int len;
11927{
11928 gif_memory_source *src = current_gif_memory_src;
11929
11930 if (len > src->len - src->index)
11931 return -1;
11932
11933 bcopy (src->bytes + src->index, buf, len);
11934 src->index += len;
11935 return len;
11936}
11937
11938
11939/* Load GIF image IMG for use on frame F. Value is non-zero if
11940 successful. */
11941
11942static int
11943gif_load (f, img)
11944 struct frame *f;
11945 struct image *img;
11946{
11947 Lisp_Object file, specified_file;
11948 Lisp_Object specified_data;
11949 int rc, width, height, x, y, i;
11950 XImage *ximg;
11951 ColorMapObject *gif_color_map;
11952 unsigned long pixel_colors[256];
11953 GifFileType *gif;
11954 struct gcpro gcpro1;
11955 Lisp_Object image;
11956 int ino, image_left, image_top, image_width, image_height;
11957 gif_memory_source memsrc;
11958 unsigned char *raster;
11959
11960 specified_file = image_spec_value (img->spec, QCfile, NULL);
11961 specified_data = image_spec_value (img->spec, QCdata, NULL);
11962 file = Qnil;
dfff8a69 11963 GCPRO1 (file);
6fc2811b
JR		 11964
11965 if (NILP (specified_data))
11966 {
11967 file = x_find_image_file (specified_file);
6fc2811b
JR		 11968 if (!STRINGP (file))
11969 {
11970 image_error ("Cannot find image file `%s'", specified_file, Qnil);
11971 UNGCPRO;
11972 return 0;
11973 }
11974
11975 /* Open the GIF file. */
11976 gif = DGifOpenFileName (XSTRING (file)->data);
11977 if (gif == NULL)
11978 {
11979 image_error ("Cannot open `%s'", file, Qnil);
11980 UNGCPRO;
11981 return 0;
11982 }
11983 }
11984 else
11985 {
11986 /* Read from memory! */
11987 current_gif_memory_src = &memsrc;
11988 memsrc.bytes = XSTRING (specified_data)->data;
11989 memsrc.len = STRING_BYTES (XSTRING (specified_data));
11990 memsrc.index = 0;
11991
11992 gif = DGifOpen(&memsrc, gif_read_from_memory);
11993 if (!gif)
11994 {
11995 image_error ("Cannot open memory source `%s'", img->spec, Qnil);
11996 UNGCPRO;
11997 return 0;
11998 }
11999 }
12000
12001 /* Read entire contents. */
12002 rc = DGifSlurp (gif);
12003 if (rc == GIF_ERROR)
12004 {
12005 image_error ("Error reading `%s'", img->spec, Qnil);
12006 DGifCloseFile (gif);
12007 UNGCPRO;
12008 return 0;
12009 }
12010
12011 image = image_spec_value (img->spec, QCindex, NULL);
12012 ino = INTEGERP (image) ? XFASTINT (image) : 0;
12013 if (ino >= gif->ImageCount)
12014 {
12015 image_error ("Invalid image number `%s' in image `%s'",
12016 image, img->spec);
12017 DGifCloseFile (gif);
12018 UNGCPRO;
12019 return 0;
12020 }
12021
12022 width = img->width = gif->SWidth;
12023 height = img->height = gif->SHeight;
12024
12025 BLOCK_INPUT;
12026
12027 /* Create the X image and pixmap. */
12028 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg, &img->pixmap))
12029 {
12030 UNBLOCK_INPUT;
12031 DGifCloseFile (gif);
12032 UNGCPRO;
12033 return 0;
12034 }
12035
12036 /* Allocate colors. */
12037 gif_color_map = gif->SavedImages[ino].ImageDesc.ColorMap;
12038 if (!gif_color_map)
12039 gif_color_map = gif->SColorMap;
12040 init_color_table ();
12041 bzero (pixel_colors, sizeof pixel_colors);
12042
12043 for (i = 0; i < gif_color_map->ColorCount; ++i)
12044 {
12045 int r = gif_color_map->Colors[i].Red << 8;
12046 int g = gif_color_map->Colors[i].Green << 8;
12047 int b = gif_color_map->Colors[i].Blue << 8;
12048 pixel_colors[i] = lookup_rgb_color (f, r, g, b);
12049 }
12050
12051 img->colors = colors_in_color_table (&img->ncolors);
12052 free_color_table ();
12053
12054 /* Clear the part of the screen image that are not covered by
12055 the image from the GIF file. Full animated GIF support
12056 requires more than can be done here (see the gif89 spec,
12057 disposal methods). Let's simply assume that the part
12058 not covered by a sub-image is in the frame's background color. */
12059 image_top = gif->SavedImages[ino].ImageDesc.Top;
12060 image_left = gif->SavedImages[ino].ImageDesc.Left;
12061 image_width = gif->SavedImages[ino].ImageDesc.Width;
12062 image_height = gif->SavedImages[ino].ImageDesc.Height;
12063
12064 for (y = 0; y < image_top; ++y)
12065 for (x = 0; x < width; ++x)
12066 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
12067
12068 for (y = image_top + image_height; y < height; ++y)
12069 for (x = 0; x < width; ++x)
12070 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
12071
12072 for (y = image_top; y < image_top + image_height; ++y)
12073 {
12074 for (x = 0; x < image_left; ++x)
12075 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
12076 for (x = image_left + image_width; x < width; ++x)
12077 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
12078 }
12079
12080 /* Read the GIF image into the X image. We use a local variable
12081 `raster' here because RasterBits below is a char *, and invites
12082 problems with bytes >= 0x80. */
12083 raster = (unsigned char *) gif->SavedImages[ino].RasterBits;
12084
12085 if (gif->SavedImages[ino].ImageDesc.Interlace)
12086 {
12087 static int interlace_start[] = {0, 4, 2, 1};
12088 static int interlace_increment[] = {8, 8, 4, 2};
12089 int pass, inc;
12090 int row = interlace_start[0];
12091
12092 pass = 0;
12093
12094 for (y = 0; y < image_height; y++)
12095 {
12096 if (row >= image_height)
12097 {
12098 row = interlace_start[++pass];
12099 while (row >= image_height)
12100 row = interlace_start[++pass];
12101 }
12102
12103 for (x = 0; x < image_width; x++)
12104 {
12105 int i = raster[(y * image_width) + x];
12106 XPutPixel (ximg, x + image_left, row + image_top,
12107 pixel_colors[i]);
12108 }
12109
12110 row += interlace_increment[pass];
12111 }
12112 }
12113 else
12114 {
12115 for (y = 0; y < image_height; ++y)
12116 for (x = 0; x < image_width; ++x)
12117 {
12118 int i = raster[y* image_width + x];
12119 XPutPixel (ximg, x + image_left, y + image_top, pixel_colors[i]);
12120 }
12121 }
12122
12123 DGifCloseFile (gif);
12124
12125 /* Put the image into the pixmap, then free the X image and its buffer. */
12126 x_put_x_image (f, ximg, img->pixmap, width, height);
12127 x_destroy_x_image (ximg);
12128 UNBLOCK_INPUT;
12129
12130 UNGCPRO;
12131 return 1;
12132}
12133
12134#endif /* HAVE_GIF != 0 */
12135
12136
12137\f
12138/***********************************************************************
12139 Ghostscript
12140 ***********************************************************************/
12141
3cf3436e
JR		 12142Lisp_Object Qpostscript;
12143
6fc2811b
JR		 12144#ifdef HAVE_GHOSTSCRIPT
12145static int gs_image_p P_ ((Lisp_Object object));
12146static int gs_load P_ ((struct frame *f, struct image *img));
12147static void gs_clear_image P_ ((struct frame *f, struct image *img));
12148
12149/* The symbol `postscript' identifying images of this type. */
12150
6fc2811b
JR		 12151/* Keyword symbols. */
12152
12153Lisp_Object QCloader, QCbounding_box, QCpt_width, QCpt_height;
12154
12155/* Indices of image specification fields in gs_format, below. */
12156
12157enum gs_keyword_index
12158{
12159 GS_TYPE,
12160 GS_PT_WIDTH,
12161 GS_PT_HEIGHT,
12162 GS_FILE,
12163 GS_LOADER,
12164 GS_BOUNDING_BOX,
12165 GS_ASCENT,
12166 GS_MARGIN,
12167 GS_RELIEF,
12168 GS_ALGORITHM,
12169 GS_HEURISTIC_MASK,
12170 GS_LAST
12171};
12172
12173/* Vector of image_keyword structures describing the format
12174 of valid user-defined image specifications. */
12175
12176static struct image_keyword gs_format[GS_LAST] =
12177{
12178 {":type", IMAGE_SYMBOL_VALUE, 1},
12179 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE, 1},
12180 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE, 1},
12181 {":file", IMAGE_STRING_VALUE, 1},
12182 {":loader", IMAGE_FUNCTION_VALUE, 0},
12183 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE, 1},
12184 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
8edb0a6f 12185 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
6fc2811b 12186 {":relief", IMAGE_INTEGER_VALUE, 0},
a93f4566 12187 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6fc2811b
JR		 12188 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
12189};
12190
12191/* Structure describing the image type `ghostscript'. */
12192
12193static struct image_type gs_type =
12194{
12195 &Qpostscript,
12196 gs_image_p,
12197 gs_load,
12198 gs_clear_image,
12199 NULL
12200};
12201
12202
12203/* Free X resources of Ghostscript image IMG which is used on frame F. */
12204
12205static void
12206gs_clear_image (f, img)
12207 struct frame *f;
12208 struct image *img;
12209{
12210 /* IMG->data.ptr_val may contain a recorded colormap. */
12211 xfree (img->data.ptr_val);
12212 x_clear_image (f, img);
12213}
12214
12215
12216/* Return non-zero if OBJECT is a valid Ghostscript image
12217 specification. */
12218
12219static int
12220gs_image_p (object)
12221 Lisp_Object object;
12222{
12223 struct image_keyword fmt[GS_LAST];
12224 Lisp_Object tem;
12225 int i;
12226
12227 bcopy (gs_format, fmt, sizeof fmt);
12228
12229 if (!parse_image_spec (object, fmt, GS_LAST, Qpostscript)
12230 || (fmt[GS_ASCENT].count
12231 && XFASTINT (fmt[GS_ASCENT].value) > 100))
12232 return 0;
12233
12234 /* Bounding box must be a list or vector containing 4 integers. */
12235 tem = fmt[GS_BOUNDING_BOX].value;
12236 if (CONSP (tem))
12237 {
12238 for (i = 0; i < 4; ++i, tem = XCDR (tem))
12239 if (!CONSP (tem) || !INTEGERP (XCAR (tem)))
12240 return 0;
12241 if (!NILP (tem))
12242 return 0;
12243 }
12244 else if (VECTORP (tem))
12245 {
12246 if (XVECTOR (tem)->size != 4)
12247 return 0;
12248 for (i = 0; i < 4; ++i)
12249 if (!INTEGERP (XVECTOR (tem)->contents[i]))
12250 return 0;
12251 }
12252 else
12253 return 0;
12254
12255 return 1;
12256}
12257
12258
12259/* Load Ghostscript image IMG for use on frame F. Value is non-zero
12260 if successful. */
12261
12262static int
12263gs_load (f, img)
12264 struct frame *f;
12265 struct image *img;
12266{
12267 char buffer[100];
12268 Lisp_Object window_and_pixmap_id = Qnil, loader, pt_height, pt_width;
12269 struct gcpro gcpro1, gcpro2;
12270 Lisp_Object frame;
12271 double in_width, in_height;
12272 Lisp_Object pixel_colors = Qnil;
12273
12274 /* Compute pixel size of pixmap needed from the given size in the
12275 image specification. Sizes in the specification are in pt. 1 pt
12276 = 1/72 in, xdpi and ydpi are stored in the frame's X display
12277 info. */
12278 pt_width = image_spec_value (img->spec, QCpt_width, NULL);
12279 in_width = XFASTINT (pt_width) / 72.0;
12280 img->width = in_width * FRAME_W32_DISPLAY_INFO (f)->resx;
12281 pt_height = image_spec_value (img->spec, QCpt_height, NULL);
12282 in_height = XFASTINT (pt_height) / 72.0;
12283 img->height = in_height * FRAME_W32_DISPLAY_INFO (f)->resy;
12284
12285 /* Create the pixmap. */
12286 BLOCK_INPUT;
12287 xassert (img->pixmap == 0);
12288 img->pixmap = XCreatePixmap (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
12289 img->width, img->height,
12290 DefaultDepthOfScreen (FRAME_X_SCREEN (f)));
12291 UNBLOCK_INPUT;
12292
12293 if (!img->pixmap)
12294 {
12295 image_error ("Unable to create pixmap for `%s'", img->spec, Qnil);
12296 return 0;
12297 }
12298
12299 /* Call the loader to fill the pixmap. It returns a process object
12300 if successful. We do not record_unwind_protect here because
12301 other places in redisplay like calling window scroll functions
12302 don't either. Let the Lisp loader use `unwind-protect' instead. */
12303 GCPRO2 (window_and_pixmap_id, pixel_colors);
12304
12305 sprintf (buffer, "%lu %lu",
12306 (unsigned long) FRAME_W32_WINDOW (f),
12307 (unsigned long) img->pixmap);
12308 window_and_pixmap_id = build_string (buffer);
12309
12310 sprintf (buffer, "%lu %lu",
12311 FRAME_FOREGROUND_PIXEL (f),
12312 FRAME_BACKGROUND_PIXEL (f));
12313 pixel_colors = build_string (buffer);
12314
12315 XSETFRAME (frame, f);
12316 loader = image_spec_value (img->spec, QCloader, NULL);
12317 if (NILP (loader))
12318 loader = intern ("gs-load-image");
12319
12320 img->data.lisp_val = call6 (loader, frame, img->spec,
12321 make_number (img->width),
12322 make_number (img->height),
12323 window_and_pixmap_id,
12324 pixel_colors);
12325 UNGCPRO;
12326 return PROCESSP (img->data.lisp_val);
12327}
12328
12329
12330/* Kill the Ghostscript process that was started to fill PIXMAP on
12331 frame F. Called from XTread_socket when receiving an event
12332 telling Emacs that Ghostscript has finished drawing. */
12333
12334void
12335x_kill_gs_process (pixmap, f)
12336 Pixmap pixmap;
12337 struct frame *f;
12338{
12339 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
12340 int class, i;
12341 struct image *img;
12342
12343 /* Find the image containing PIXMAP. */
12344 for (i = 0; i < c->used; ++i)
12345 if (c->images[i]->pixmap == pixmap)
12346 break;
12347
3cf3436e
JR		 12348 /* Should someone in between have cleared the image cache, for
12349 instance, give up. */
12350 if (i == c->used)
12351 return;
12352
6fc2811b
JR		 12353 /* Kill the GS process. We should have found PIXMAP in the image
12354 cache and its image should contain a process object. */
6fc2811b
JR		 12355 img = c->images[i];
12356 xassert (PROCESSP (img->data.lisp_val));
12357 Fkill_process (img->data.lisp_val, Qnil);
12358 img->data.lisp_val = Qnil;
12359
12360 /* On displays with a mutable colormap, figure out the colors
12361 allocated for the image by looking at the pixels of an XImage for
12362 img->pixmap. */
12363 class = FRAME_W32_DISPLAY_INFO (f)->visual->class;
12364 if (class != StaticColor && class != StaticGray && class != TrueColor)
12365 {
12366 XImage *ximg;
12367
12368 BLOCK_INPUT;
12369
12370 /* Try to get an XImage for img->pixmep. */
12371 ximg = XGetImage (FRAME_W32_DISPLAY (f), img->pixmap,
12372 0, 0, img->width, img->height, ~0, ZPixmap);
12373 if (ximg)
12374 {
12375 int x, y;
12376
12377 /* Initialize the color table. */
12378 init_color_table ();
12379
12380 /* For each pixel of the image, look its color up in the
12381 color table. After having done so, the color table will
12382 contain an entry for each color used by the image. */
12383 for (y = 0; y < img->height; ++y)
12384 for (x = 0; x < img->width; ++x)
12385 {
12386 unsigned long pixel = XGetPixel (ximg, x, y);
12387 lookup_pixel_color (f, pixel);
12388 }
12389
12390 /* Record colors in the image. Free color table and XImage. */
12391 img->colors = colors_in_color_table (&img->ncolors);
12392 free_color_table ();
12393 XDestroyImage (ximg);
12394
12395#if 0 /* This doesn't seem to be the case. If we free the colors
12396 here, we get a BadAccess later in x_clear_image when
12397 freeing the colors. */
12398 /* We have allocated colors once, but Ghostscript has also
12399 allocated colors on behalf of us. So, to get the
12400 reference counts right, free them once. */
12401 if (img->ncolors)
3cf3436e 12402 x_free_colors (FRAME_W32_DISPLAY (f), cmap,
6fc2811b 12403 img->colors, img->ncolors, 0);
6fc2811b
JR		 12404#endif
12405 }
12406 else
12407 image_error ("Cannot get X image of `%s'; colors will not be freed",
12408 img->spec, Qnil);
12409
12410 UNBLOCK_INPUT;
12411 }
3cf3436e
JR		 12412
12413 /* Now that we have the pixmap, compute mask and transform the
12414 image if requested. */
12415 BLOCK_INPUT;
12416 postprocess_image (f, img);
12417 UNBLOCK_INPUT;
6fc2811b
JR		 12418}
12419
12420#endif /* HAVE_GHOSTSCRIPT */
12421
12422\f
12423/***********************************************************************
12424 Window properties
12425 ***********************************************************************/
12426
12427DEFUN ("x-change-window-property", Fx_change_window_property,
12428 Sx_change_window_property, 2, 3, 0,
12429 "Change window property PROP to VALUE on the X window of FRAME.\n\
12430PROP and VALUE must be strings. FRAME nil or omitted means use the\n\
12431selected frame. Value is VALUE.")
12432 (prop, value, frame)
12433 Lisp_Object frame, prop, value;
12434{
767b1ff0 12435#if 0 /* TODO : port window properties to W32 */
6fc2811b
JR		 12436 struct frame *f = check_x_frame (frame);
12437 Atom prop_atom;
12438
12439 CHECK_STRING (prop, 1);
12440 CHECK_STRING (value, 2);
12441
12442 BLOCK_INPUT;
12443 prop_atom = XInternAtom (FRAME_W32_DISPLAY (f), XSTRING (prop)->data, False);
12444 XChangeProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
12445 prop_atom, XA_STRING, 8, PropModeReplace,
12446 XSTRING (value)->data, XSTRING (value)->size);
12447
12448 /* Make sure the property is set when we return. */
12449 XFlush (FRAME_W32_DISPLAY (f));
12450 UNBLOCK_INPUT;
12451
767b1ff0 12452#endif /* TODO */
6fc2811b
JR		 12453
12454 return value;
12455}
12456
12457
12458DEFUN ("x-delete-window-property", Fx_delete_window_property,
12459 Sx_delete_window_property, 1, 2, 0,
12460 "Remove window property PROP from X window of FRAME.\n\
12461FRAME nil or omitted means use the selected frame. Value is PROP.")
12462 (prop, frame)
12463 Lisp_Object prop, frame;
12464{
767b1ff0 12465#if 0 /* TODO : port window properties to W32 */
6fc2811b
JR		 12466
12467 struct frame *f = check_x_frame (frame);
12468 Atom prop_atom;
12469
12470 CHECK_STRING (prop, 1);
12471 BLOCK_INPUT;
12472 prop_atom = XInternAtom (FRAME_W32_DISPLAY (f), XSTRING (prop)->data, False);
12473 XDeleteProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f), prop_atom);
12474
12475 /* Make sure the property is removed when we return. */
12476 XFlush (FRAME_W32_DISPLAY (f));
12477 UNBLOCK_INPUT;
767b1ff0 12478#endif /* TODO */
6fc2811b
JR		 12479
12480 return prop;
12481}
12482
12483
12484DEFUN ("x-window-property", Fx_window_property, Sx_window_property,
12485 1, 2, 0,
12486 "Value is the value of window property PROP on FRAME.\n\
12487If FRAME is nil or omitted, use the selected frame. Value is nil\n\
12488if FRAME hasn't a property with name PROP or if PROP has no string\n\
12489value.")
12490 (prop, frame)
12491 Lisp_Object prop, frame;
12492{
767b1ff0 12493#if 0 /* TODO : port window properties to W32 */
6fc2811b
JR		 12494
12495 struct frame *f = check_x_frame (frame);
12496 Atom prop_atom;
12497 int rc;
12498 Lisp_Object prop_value = Qnil;
12499 char *tmp_data = NULL;
12500 Atom actual_type;
12501 int actual_format;
12502 unsigned long actual_size, bytes_remaining;
12503
12504 CHECK_STRING (prop, 1);
12505 BLOCK_INPUT;
12506 prop_atom = XInternAtom (FRAME_W32_DISPLAY (f), XSTRING (prop)->data, False);
12507 rc = XGetWindowProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
12508 prop_atom, 0, 0, False, XA_STRING,
12509 &actual_type, &actual_format, &actual_size,
12510 &bytes_remaining, (unsigned char **) &tmp_data);
12511 if (rc == Success)
12512 {
12513 int size = bytes_remaining;
12514
12515 XFree (tmp_data);
12516 tmp_data = NULL;
12517
12518 rc = XGetWindowProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
12519 prop_atom, 0, bytes_remaining,
12520 False, XA_STRING,
12521 &actual_type, &actual_format,
12522 &actual_size, &bytes_remaining,
12523 (unsigned char **) &tmp_data);
12524 if (rc == Success)
12525 prop_value = make_string (tmp_data, size);
12526
12527 XFree (tmp_data);
12528 }
12529
12530 UNBLOCK_INPUT;
12531
12532 return prop_value;
12533
767b1ff0 12534#endif /* TODO */
6fc2811b
JR		 12535 return Qnil;
12536}
12537
12538
12539\f
12540/***********************************************************************
12541 Busy cursor
12542 ***********************************************************************/
12543
f79e6790 12544/* If non-null, an asynchronous timer that, when it expires, displays
0af913d7 12545 an hourglass cursor on all frames. */
6fc2811b 12546
0af913d7 12547static struct atimer *hourglass_atimer;
6fc2811b 12548
0af913d7 12549/* Non-zero means an hourglass cursor is currently shown. */
6fc2811b 12550
0af913d7 12551static int hourglass_shown_p;
6fc2811b 12552
0af913d7 12553/* Number of seconds to wait before displaying an hourglass cursor. */
6fc2811b 12554
0af913d7 12555static Lisp_Object Vhourglass_delay;
6fc2811b 12556
0af913d7 12557/* Default number of seconds to wait before displaying an hourglass
f79e6790
JR		 12558 cursor. */
12559
0af913d7 12560#define DEFAULT_HOURGLASS_DELAY 1
f79e6790
JR		 12561
12562/* Function prototypes. */
12563
0af913d7
GM		 12564static void show_hourglass P_ ((struct atimer *));
12565static void hide_hourglass P_ ((void));
f79e6790
JR		 12566
12567
0af913d7 12568/* Cancel a currently active hourglass timer, and start a new one. */
f79e6790
JR		 12569
12570void
0af913d7 12571start_hourglass ()
f79e6790 12572{
767b1ff0 12573#if 0 /* TODO: cursor shape changes. */
f79e6790 12574 EMACS_TIME delay;
dfff8a69 12575 int secs, usecs = 0;
f79e6790 12576
0af913d7 12577 cancel_hourglass ();
f79e6790 12578
0af913d7
GM		 12579 if (INTEGERP (Vhourglass_delay)
12580 && XINT (Vhourglass_delay) > 0)
12581 secs = XFASTINT (Vhourglass_delay);
12582 else if (FLOATP (Vhourglass_delay)
12583 && XFLOAT_DATA (Vhourglass_delay) > 0)
dfff8a69
JR		 12584 {
12585 Lisp_Object tem;
0af913d7 12586 tem = Ftruncate (Vhourglass_delay, Qnil);
dfff8a69 12587 secs = XFASTINT (tem);
0af913d7 12588 usecs = (XFLOAT_DATA (Vhourglass_delay) - secs) * 1000000;
dfff8a69 12589 }
f79e6790 12590 else
0af913d7 12591 secs = DEFAULT_HOURGLASS_DELAY;
f79e6790 12592
dfff8a69 12593 EMACS_SET_SECS_USECS (delay, secs, usecs);
0af913d7
GM		 12594 hourglass_atimer = start_atimer (ATIMER_RELATIVE, delay,
12595 show_hourglass, NULL);
f79e6790
JR		 12596#endif
12597}
12598
12599
0af913d7
GM		 12600/* Cancel the hourglass cursor timer if active, hide an hourglass
12601 cursor if shown. */
f79e6790
JR		 12602
12603void
0af913d7 12604cancel_hourglass ()
f79e6790 12605{
0af913d7 12606 if (hourglass_atimer)
dfff8a69 12607 {
0af913d7
GM		 12608 cancel_atimer (hourglass_atimer);
12609 hourglass_atimer = NULL;
dfff8a69
JR		 12610 }
12611
0af913d7
GM		 12612 if (hourglass_shown_p)
12613 hide_hourglass ();
f79e6790
JR		 12614}
12615
12616
0af913d7
GM		 12617/* Timer function of hourglass_atimer. TIMER is equal to
12618 hourglass_atimer.
f79e6790 12619
0af913d7
GM		 12620 Display an hourglass cursor on all frames by mapping the frames'
12621 hourglass_window. Set the hourglass_p flag in the frames'
12622 output_data.x structure to indicate that an hourglass cursor is
12623 shown on the frames. */
f79e6790
JR		 12624
12625static void
0af913d7 12626show_hourglass (timer)
f79e6790 12627 struct atimer *timer;
6fc2811b 12628{
767b1ff0 12629#if 0 /* TODO: cursor shape changes. */
f79e6790 12630 /* The timer implementation will cancel this timer automatically
0af913d7 12631 after this function has run. Set hourglass_atimer to null
f79e6790 12632 so that we know the timer doesn't have to be canceled. */
0af913d7 12633 hourglass_atimer = NULL;
f79e6790 12634
0af913d7 12635 if (!hourglass_shown_p)
6fc2811b
JR		 12636 {
12637 Lisp_Object rest, frame;
f79e6790
JR		 12638
12639 BLOCK_INPUT;
12640
6fc2811b 12641 FOR_EACH_FRAME (rest, frame)
dc220243 12642 if (FRAME_W32_P (XFRAME (frame)))
6fc2811b
JR		 12643 {
12644 struct frame *f = XFRAME (frame);
f79e6790 12645
0af913d7 12646 f->output_data.w32->hourglass_p = 1;
f79e6790 12647
0af913d7 12648 if (!f->output_data.w32->hourglass_window)
6fc2811b
JR		 12649 {
12650 unsigned long mask = CWCursor;
12651 XSetWindowAttributes attrs;
f79e6790 12652
0af913d7 12653 attrs.cursor = f->output_data.w32->hourglass_cursor;
f79e6790 12654
0af913d7 12655 f->output_data.w32->hourglass_window
f79e6790 12656 = XCreateWindow (FRAME_X_DISPLAY (f),
6fc2811b
JR		 12657 FRAME_OUTER_WINDOW (f),
12658 0, 0, 32000, 32000, 0, 0,
f79e6790
JR		 12659 InputOnly,
12660 CopyFromParent,
6fc2811b
JR		 12661 mask, &attrs);
12662 }
f79e6790 12663
0af913d7
GM		 12664 XMapRaised (FRAME_X_DISPLAY (f),
12665 f->output_data.w32->hourglass_window);
f79e6790 12666 XFlush (FRAME_X_DISPLAY (f));
6fc2811b 12667 }
6fc2811b 12668
0af913d7 12669 hourglass_shown_p = 1;
f79e6790
JR		 12670 UNBLOCK_INPUT;
12671 }
12672#endif
6fc2811b
JR		 12673}
12674
12675
0af913d7 12676/* Hide the hourglass cursor on all frames, if it is currently shown. */
6fc2811b 12677
f79e6790 12678static void
0af913d7 12679hide_hourglass ()
f79e6790 12680{
767b1ff0 12681#if 0 /* TODO: cursor shape changes. */
0af913d7 12682 if (hourglass_shown_p)
6fc2811b 12683 {
f79e6790
JR		 12684 Lisp_Object rest, frame;
12685
12686 BLOCK_INPUT;
12687 FOR_EACH_FRAME (rest, frame)
6fc2811b 12688 {
f79e6790
JR		 12689 struct frame *f = XFRAME (frame);
12690
dc220243 12691 if (FRAME_W32_P (f)
f79e6790 12692 /* Watch out for newly created frames. */
0af913d7 12693 && f->output_data.x->hourglass_window)
f79e6790 12694 {
0af913d7
GM		 12695 XUnmapWindow (FRAME_X_DISPLAY (f),
12696 f->output_data.x->hourglass_window);
12697 /* Sync here because XTread_socket looks at the
12698 hourglass_p flag that is reset to zero below. */
f79e6790 12699 XSync (FRAME_X_DISPLAY (f), False);
0af913d7 12700 f->output_data.x->hourglass_p = 0;
f79e6790 12701 }
6fc2811b 12702 }
6fc2811b 12703
0af913d7 12704 hourglass_shown_p = 0;
f79e6790
JR		 12705 UNBLOCK_INPUT;
12706 }
12707#endif
6fc2811b
JR		 12708}
12709
12710
12711\f
12712/***********************************************************************
12713 Tool tips
12714 ***********************************************************************/
12715
12716static Lisp_Object x_create_tip_frame P_ ((struct w32_display_info *,
3cf3436e
JR		 12717 Lisp_Object, Lisp_Object));
12718static void compute_tip_xy P_ ((struct frame *, Lisp_Object, Lisp_Object,
12719 Lisp_Object, int, int, int *, int *));
6fc2811b 12720
3cf3436e 12721/* The frame of a currently visible tooltip. */
6fc2811b 12722
937e601e 12723Lisp_Object tip_frame;
6fc2811b
JR		 12724
12725/* If non-nil, a timer started that hides the last tooltip when it
12726 fires. */
12727
12728Lisp_Object tip_timer;
12729Window tip_window;
12730
3cf3436e
JR		 12731/* If non-nil, a vector of 3 elements containing the last args
12732 with which x-show-tip was called. See there. */
12733
12734Lisp_Object last_show_tip_args;
12735
12736/* Maximum size for tooltips; a cons (COLUMNS . ROWS). */
12737
12738Lisp_Object Vx_max_tooltip_size;
12739
12740
937e601e
AI		 12741static Lisp_Object
12742unwind_create_tip_frame (frame)
12743 Lisp_Object frame;
12744{
c844a81a
GM		 12745 Lisp_Object deleted;
12746
12747 deleted = unwind_create_frame (frame);
12748 if (EQ (deleted, Qt))
12749 {
12750 tip_window = NULL;
12751 tip_frame = Qnil;
12752 }
12753
12754 return deleted;
937e601e
AI		 12755}
12756
12757
6fc2811b 12758/* Create a frame for a tooltip on the display described by DPYINFO.
3cf3436e
JR		 12759 PARMS is a list of frame parameters. TEXT is the string to
12760 display in the tip frame. Value is the frame.
937e601e
AI		 12761
12762 Note that functions called here, esp. x_default_parameter can
12763 signal errors, for instance when a specified color name is
12764 undefined. We have to make sure that we're in a consistent state
12765 when this happens. */
6fc2811b
JR		 12766
12767static Lisp_Object
3cf3436e 12768x_create_tip_frame (dpyinfo, parms, text)
6fc2811b 12769 struct w32_display_info *dpyinfo;
3cf3436e 12770 Lisp_Object parms, text;
6fc2811b 12771{
767b1ff0 12772#if 0 /* TODO : w32 version */
6fc2811b
JR		 12773 struct frame *f;
12774 Lisp_Object frame, tem;
12775 Lisp_Object name;
12776 long window_prompting = 0;
12777 int width, height;
dc220243 12778 int count = BINDING_STACK_SIZE ();
6fc2811b
JR		 12779 struct gcpro gcpro1, gcpro2, gcpro3;
12780 struct kboard *kb;
3cf3436e
JR		 12781 int face_change_count_before = face_change_count;
12782 Lisp_Object buffer;
12783 struct buffer *old_buffer;
6fc2811b
JR		 12784
12785 check_x ();
12786
12787 /* Use this general default value to start with until we know if
12788 this frame has a specified name. */
12789 Vx_resource_name = Vinvocation_name;
12790
12791#ifdef MULTI_KBOARD
12792 kb = dpyinfo->kboard;
12793#else
12794 kb = &the_only_kboard;
12795#endif
12796
12797 /* Get the name of the frame to use for resource lookup. */
12798 name = w32_get_arg (parms, Qname, "name", "Name", RES_TYPE_STRING);
12799 if (!STRINGP (name)
12800 && !EQ (name, Qunbound)
12801 && !NILP (name))
12802 error ("Invalid frame name--not a string or nil");
12803 Vx_resource_name = name;
12804
12805 frame = Qnil;
12806 GCPRO3 (parms, name, frame);
937e601e 12807 f = make_frame (1);
6fc2811b 12808 XSETFRAME (frame, f);
3cf3436e
JR		 12809
12810 buffer = Fget_buffer_create (build_string (" *tip*"));
12811 Fset_window_buffer (FRAME_ROOT_WINDOW (f), buffer);
12812 old_buffer = current_buffer;
12813 set_buffer_internal_1 (XBUFFER (buffer));
12814 current_buffer->truncate_lines = Qnil;
12815 Ferase_buffer ();
12816 Finsert (1, &text);
12817 set_buffer_internal_1 (old_buffer);
12818
6fc2811b 12819 FRAME_CAN_HAVE_SCROLL_BARS (f) = 0;
937e601e 12820 record_unwind_protect (unwind_create_tip_frame, frame);
6fc2811b 12821
3cf3436e
JR		 12822 /* By setting the output method, we're essentially saying that
12823 the frame is live, as per FRAME_LIVE_P. If we get a signal
12824 from this point on, x_destroy_window might screw up reference
12825 counts etc. */
d88c567c 12826 f->output_method = output_w32;
6fc2811b
JR		 12827 f->output_data.w32 =
12828 (struct w32_output *) xmalloc (sizeof (struct w32_output));
12829 bzero (f->output_data.w32, sizeof (struct w32_output));
12830#if 0
12831 f->output_data.w32->icon_bitmap = -1;
12832#endif
12833 f->output_data.w32->fontset = -1;
12834 f->icon_name = Qnil;
12835
937e601e
AI		 12836#ifdef GLYPH_DEBUG
12837 image_cache_refcount = FRAME_X_IMAGE_CACHE (f)->refcount;
12838 dpyinfo_refcount = dpyinfo->reference_count;
12839#endif /* GLYPH_DEBUG */
6fc2811b
JR		 12840#ifdef MULTI_KBOARD
12841 FRAME_KBOARD (f) = kb;
12842#endif
12843 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
12844 f->output_data.w32->explicit_parent = 0;
12845
12846 /* Set the name; the functions to which we pass f expect the name to
12847 be set. */
12848 if (EQ (name, Qunbound) || NILP (name))
12849 {
12850 f->name = build_string (dpyinfo->x_id_name);
12851 f->explicit_name = 0;
12852 }
12853 else
12854 {
12855 f->name = name;
12856 f->explicit_name = 1;
12857 /* use the frame's title when getting resources for this frame. */
12858 specbind (Qx_resource_name, name);
12859 }
12860
6fc2811b
JR		 12861 /* Extract the window parameters from the supplied values
12862 that are needed to determine window geometry. */
12863 {
12864 Lisp_Object font;
12865
12866 font = w32_get_arg (parms, Qfont, "font", "Font", RES_TYPE_STRING);
12867
12868 BLOCK_INPUT;
12869 /* First, try whatever font the caller has specified. */
12870 if (STRINGP (font))
12871 {
12872 tem = Fquery_fontset (font, Qnil);
12873 if (STRINGP (tem))
12874 font = x_new_fontset (f, XSTRING (tem)->data);
12875 else
12876 font = x_new_font (f, XSTRING (font)->data);
12877 }
12878
12879 /* Try out a font which we hope has bold and italic variations. */
12880 if (!STRINGP (font))
e39649be 12881 font = x_new_font (f, "-*-courier new-normal-r-*-*-*-100-*-*-*-*-iso8859-1");
6fc2811b
JR		 12882 if (!STRINGP (font))
12883 font = x_new_font (f, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
12884 if (! STRINGP (font))
12885 font = x_new_font (f, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
12886 if (! STRINGP (font))
12887 /* This was formerly the first thing tried, but it finds too many fonts
12888 and takes too long. */
12889 font = x_new_font (f, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
12890 /* If those didn't work, look for something which will at least work. */
12891 if (! STRINGP (font))
12892 font = x_new_font (f, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
12893 UNBLOCK_INPUT;
12894 if (! STRINGP (font))
12895 font = build_string ("fixed");
12896
12897 x_default_parameter (f, parms, Qfont, font,
12898 "font", "Font", RES_TYPE_STRING);
12899 }
12900
12901 x_default_parameter (f, parms, Qborder_width, make_number (2),
12902 "borderWidth", "BorderWidth", RES_TYPE_NUMBER);
12903
12904 /* This defaults to 2 in order to match xterm. We recognize either
12905 internalBorderWidth or internalBorder (which is what xterm calls
12906 it). */
12907 if (NILP (Fassq (Qinternal_border_width, parms)))
12908 {
12909 Lisp_Object value;
12910
12911 value = w32_get_arg (parms, Qinternal_border_width,
12912 "internalBorder", "internalBorder", RES_TYPE_NUMBER);
12913 if (! EQ (value, Qunbound))
12914 parms = Fcons (Fcons (Qinternal_border_width, value),
12915 parms);
12916 }
12917
12918 x_default_parameter (f, parms, Qinternal_border_width, make_number (1),
12919 "internalBorderWidth", "internalBorderWidth",
12920 RES_TYPE_NUMBER);
12921
12922 /* Also do the stuff which must be set before the window exists. */
12923 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
12924 "foreground", "Foreground", RES_TYPE_STRING);
12925 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
12926 "background", "Background", RES_TYPE_STRING);
12927 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
12928 "pointerColor", "Foreground", RES_TYPE_STRING);
12929 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
12930 "cursorColor", "Foreground", RES_TYPE_STRING);
12931 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
12932 "borderColor", "BorderColor", RES_TYPE_STRING);
12933
12934 /* Init faces before x_default_parameter is called for scroll-bar
12935 parameters because that function calls x_set_scroll_bar_width,
12936 which calls change_frame_size, which calls Fset_window_buffer,
12937 which runs hooks, which call Fvertical_motion. At the end, we
12938 end up in init_iterator with a null face cache, which should not
12939 happen. */
12940 init_frame_faces (f);
12941
12942 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
12943 window_prompting = x_figure_window_size (f, parms);
12944
12945 if (window_prompting & XNegative)
12946 {
12947 if (window_prompting & YNegative)
12948 f->output_data.w32->win_gravity = SouthEastGravity;
12949 else
12950 f->output_data.w32->win_gravity = NorthEastGravity;
12951 }
12952 else
12953 {
12954 if (window_prompting & YNegative)
12955 f->output_data.w32->win_gravity = SouthWestGravity;
12956 else
12957 f->output_data.w32->win_gravity = NorthWestGravity;
12958 }
12959
12960 f->output_data.w32->size_hint_flags = window_prompting;
12961 {
12962 XSetWindowAttributes attrs;
12963 unsigned long mask;
12964
12965 BLOCK_INPUT;
3cf3436e
JR		 12966 mask = CWBackPixel | CWOverrideRedirect | CWEventMask;
12967 if (DoesSaveUnders (dpyinfo->screen))
12968 mask |= CWSaveUnder;
12969
6fc2811b
JR		 12970 /* Window managers looks at the override-redirect flag to
12971 determine whether or net to give windows a decoration (Xlib
12972 3.2.8). */
12973 attrs.override_redirect = True;
12974 attrs.save_under = True;
12975 attrs.background_pixel = FRAME_BACKGROUND_PIXEL (f);
12976 /* Arrange for getting MapNotify and UnmapNotify events. */
12977 attrs.event_mask = StructureNotifyMask;
12978 tip_window
12979 = FRAME_W32_WINDOW (f)
12980 = XCreateWindow (FRAME_W32_DISPLAY (f),
12981 FRAME_W32_DISPLAY_INFO (f)->root_window,
12982 /* x, y, width, height */
12983 0, 0, 1, 1,
12984 /* Border. */
12985 1,
12986 CopyFromParent, InputOutput, CopyFromParent,
12987 mask, &attrs);
12988 UNBLOCK_INPUT;
12989 }
12990
12991 x_make_gc (f);
12992
12993 x_default_parameter (f, parms, Qauto_raise, Qnil,
12994 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
12995 x_default_parameter (f, parms, Qauto_lower, Qnil,
12996 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
12997 x_default_parameter (f, parms, Qcursor_type, Qbox,
12998 "cursorType", "CursorType", RES_TYPE_SYMBOL);
12999
13000 /* Dimensions, especially f->height, must be done via change_frame_size.
13001 Change will not be effected unless different from the current
13002 f->height. */
13003 width = f->width;
13004 height = f->height;
13005 f->height = 0;
13006 SET_FRAME_WIDTH (f, 0);
13007 change_frame_size (f, height, width, 1, 0, 0);
13008
3cf3436e
JR		 13009 /* Set up faces after all frame parameters are known. This call
13010 also merges in face attributes specified for new frames.
13011
13012 Frame parameters may be changed if .Xdefaults contains
13013 specifications for the default font. For example, if there is an
13014 `Emacs.default.attributeBackground: pink', the `background-color'
13015 attribute of the frame get's set, which let's the internal border
13016 of the tooltip frame appear in pink. Prevent this. */
13017 {
13018 Lisp_Object bg = Fframe_parameter (frame, Qbackground_color);
13019
13020 /* Set tip_frame here, so that */
13021 tip_frame = frame;
13022 call1 (Qface_set_after_frame_default, frame);
13023
13024 if (!EQ (bg, Fframe_parameter (frame, Qbackground_color)))
13025 Fmodify_frame_parameters (frame, Fcons (Fcons (Qbackground_color, bg),
13026 Qnil));
13027 }
13028
6fc2811b
JR		 13029 f->no_split = 1;
13030
13031 UNGCPRO;
13032
13033 /* It is now ok to make the frame official even if we get an error
13034 below. And the frame needs to be on Vframe_list or making it
13035 visible won't work. */
13036 Vframe_list = Fcons (frame, Vframe_list);
13037
13038 /* Now that the frame is official, it counts as a reference to
13039 its display. */
13040 FRAME_W32_DISPLAY_INFO (f)->reference_count++;
ee78dc32 13041
3cf3436e
JR		 13042 /* Setting attributes of faces of the tooltip frame from resources
13043 and similar will increment face_change_count, which leads to the
13044 clearing of all current matrices. Since this isn't necessary
13045 here, avoid it by resetting face_change_count to the value it
13046 had before we created the tip frame. */
13047 face_change_count = face_change_count_before;
13048
13049 /* Discard the unwind_protect. */
6fc2811b 13050 return unbind_to (count, frame);
767b1ff0 13051#endif /* TODO */
6fc2811b 13052 return Qnil;
ee78dc32
GV		 13053}
13054
3cf3436e
JR		 13055
13056/* Compute where to display tip frame F. PARMS is the list of frame
13057 parameters for F. DX and DY are specified offsets from the current
13058 location of the mouse. WIDTH and HEIGHT are the width and height
13059 of the tooltip. Return coordinates relative to the root window of
13060 the display in *ROOT_X, and *ROOT_Y. */
13061
13062static void
13063compute_tip_xy (f, parms, dx, dy, width, height, root_x, root_y)
13064 struct frame *f;
13065 Lisp_Object parms, dx, dy;
13066 int width, height;
13067 int *root_x, *root_y;
13068{
13069#ifdef TODO /* Tool tips not supported. */
13070 Lisp_Object left, top;
13071 int win_x, win_y;
13072 Window root, child;
13073 unsigned pmask;
13074
13075 /* User-specified position? */
13076 left = Fcdr (Fassq (Qleft, parms));
13077 top = Fcdr (Fassq (Qtop, parms));
13078
13079 /* Move the tooltip window where the mouse pointer is. Resize and
13080 show it. */
13081 if (!INTEGERP (left) && !INTEGERP (top))
13082 {
13083 BLOCK_INPUT;
13084 XQueryPointer (FRAME_X_DISPLAY (f), FRAME_X_DISPLAY_INFO (f)->root_window,
13085 &root, &child, root_x, root_y, &win_x, &win_y, &pmask);
13086 UNBLOCK_INPUT;
13087 }
13088
13089 if (INTEGERP (top))
13090 *root_y = XINT (top);
13091 else if (*root_y + XINT (dy) - height < 0)
13092 *root_y -= XINT (dy);
13093 else
13094 {
13095 *root_y -= height;
13096 *root_y += XINT (dy);
13097 }
13098
13099 if (INTEGERP (left))
13100 *root_x = XINT (left);
13101 else if (*root_x + XINT (dx) + width > FRAME_X_DISPLAY_INFO (f)->width)
13102 *root_x -= width + XINT (dx);
13103 else
13104 *root_x += XINT (dx);
13105
13106#endif /* Tooltip support. */
13107}
13108
13109
767b1ff0 13110#ifdef TODO /* Tooltip support not complete. */
71eab8d1 13111DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
6fc2811b 13112 "Show STRING in a \"tooltip\" window on frame FRAME.\n\
dc220243 13113A tooltip window is a small window displaying a string.\n\
71eab8d1 13114\n\
6fc2811b 13115FRAME nil or omitted means use the selected frame.\n\
71eab8d1 13116\n\
6fc2811b
JR		 13117PARMS is an optional list of frame parameters which can be\n\
13118used to change the tooltip's appearance.\n\
71eab8d1 13119\n\
6fc2811b 13120Automatically hide the tooltip after TIMEOUT seconds.\n\
71eab8d1
AI		 13121TIMEOUT nil means use the default timeout of 5 seconds.\n\
13122\n\
13123If the list of frame parameters PARAMS contains a `left' parameters,\n\
13124the tooltip is displayed at that x-position. Otherwise it is\n\
13125displayed at the mouse position, with offset DX added (default is 5 if\n\
13126DX isn't specified). Likewise for the y-position; if a `top' frame\n\
13127parameter is specified, it determines the y-position of the tooltip\n\
13128window, otherwise it is displayed at the mouse position, with offset\n\
3cf3436e
JR		 13129DY added (default is -10).\n\
13130\n\
13131A tooltip's maximum size is specified by `x-max-tooltip-size'.\n\
13132Text larger than the specified size is clipped.")
71eab8d1
AI		 13133 (string, frame, parms, timeout, dx, dy)
13134 Lisp_Object string, frame, parms, timeout, dx, dy;
ee78dc32 13135{
6fc2811b
JR		 13136 struct frame *f;
13137 struct window *w;
3cf3436e
JR		 13138 Lisp_Object buffer, top, left, max_width, max_height;
13139 int root_x, root_y;
6fc2811b
JR		 13140 struct buffer *old_buffer;
13141 struct text_pos pos;
13142 int i, width, height;
6fc2811b
JR		 13143 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
13144 int old_windows_or_buffers_changed = windows_or_buffers_changed;
13145 int count = specpdl_ptr - specpdl;
13146
13147 specbind (Qinhibit_redisplay, Qt);
ee78dc32 13148
dfff8a69 13149 GCPRO4 (string, parms, frame, timeout);
ee78dc32 13150
6fc2811b
JR		 13151 CHECK_STRING (string, 0);
13152 f = check_x_frame (frame);
13153 if (NILP (timeout))
13154 timeout = make_number (5);
13155 else
13156 CHECK_NATNUM (timeout, 2);
ee78dc32 13157
71eab8d1
AI		 13158 if (NILP (dx))
13159 dx = make_number (5);
13160 else
13161 CHECK_NUMBER (dx, 5);
13162
13163 if (NILP (dy))
dc220243 13164 dy = make_number (-10);
71eab8d1
AI		 13165 else
13166 CHECK_NUMBER (dy, 6);
13167
dc220243
JR		 13168 if (NILP (last_show_tip_args))
13169 last_show_tip_args = Fmake_vector (make_number (3), Qnil);
13170
13171 if (!NILP (tip_frame))
13172 {
13173 Lisp_Object last_string = AREF (last_show_tip_args, 0);
13174 Lisp_Object last_frame = AREF (last_show_tip_args, 1);
13175 Lisp_Object last_parms = AREF (last_show_tip_args, 2);
13176
13177 if (EQ (frame, last_frame)
13178 && !NILP (Fequal (last_string, string))
13179 && !NILP (Fequal (last_parms, parms)))
13180 {
13181 struct frame *f = XFRAME (tip_frame);
13182
13183 /* Only DX and DY have changed. */
13184 if (!NILP (tip_timer))
13185 {
13186 Lisp_Object timer = tip_timer;
13187 tip_timer = Qnil;
13188 call1 (Qcancel_timer, timer);
13189 }
13190
13191 BLOCK_INPUT;
13192 compute_tip_xy (f, parms, dx, dy, &root_x, &root_y);
13193 XMoveWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
13194 root_x, root_y - PIXEL_HEIGHT (f));
13195 UNBLOCK_INPUT;
13196 goto start_timer;
13197 }
13198 }
13199
6fc2811b
JR		 13200 /* Hide a previous tip, if any. */
13201 Fx_hide_tip ();
ee78dc32 13202
dc220243
JR		 13203 ASET (last_show_tip_args, 0, string);
13204 ASET (last_show_tip_args, 1, frame);
13205 ASET (last_show_tip_args, 2, parms);
13206
6fc2811b
JR		 13207 /* Add default values to frame parameters. */
13208 if (NILP (Fassq (Qname, parms)))
13209 parms = Fcons (Fcons (Qname, build_string ("tooltip")), parms);
13210 if (NILP (Fassq (Qinternal_border_width, parms)))
13211 parms = Fcons (Fcons (Qinternal_border_width, make_number (3)), parms);
13212 if (NILP (Fassq (Qborder_width, parms)))
13213 parms = Fcons (Fcons (Qborder_width, make_number (1)), parms);
13214 if (NILP (Fassq (Qborder_color, parms)))
13215 parms = Fcons (Fcons (Qborder_color, build_string ("lightyellow")), parms);
13216 if (NILP (Fassq (Qbackground_color, parms)))
13217 parms = Fcons (Fcons (Qbackground_color, build_string ("lightyellow")),
13218 parms);
13219
13220 /* Create a frame for the tooltip, and record it in the global
13221 variable tip_frame. */
13222 frame = x_create_tip_frame (FRAME_W32_DISPLAY_INFO (f), parms);
937e601e 13223 f = XFRAME (frame);
6fc2811b 13224
3cf3436e 13225 /* Set up the frame's root window. */
6fc2811b
JR		 13226 w = XWINDOW (FRAME_ROOT_WINDOW (f));
13227 w->left = w->top = make_number (0);
3cf3436e
JR		 13228
13229 if (CONSP (Vx_max_tooltip_size)
13230 && INTEGERP (XCAR (Vx_max_tooltip_size))
13231 && XINT (XCAR (Vx_max_tooltip_size)) > 0
13232 && INTEGERP (XCDR (Vx_max_tooltip_size))
13233 && XINT (XCDR (Vx_max_tooltip_size)) > 0)
13234 {
13235 w->width = XCAR (Vx_max_tooltip_size);
13236 w->height = XCDR (Vx_max_tooltip_size);
13237 }
13238 else
13239 {
13240 w->width = make_number (80);
13241 w->height = make_number (40);
13242 }
13243
13244 f->window_width = XINT (w->width);
6fc2811b
JR		 13245 adjust_glyphs (f);
13246 w->pseudo_window_p = 1;
13247
13248 /* Display the tooltip text in a temporary buffer. */
6fc2811b 13249 old_buffer = current_buffer;
3cf3436e
JR		 13250 set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f))->buffer));
13251 current_buffer->truncate_lines = Qnil;
6fc2811b
JR		 13252 clear_glyph_matrix (w->desired_matrix);
13253 clear_glyph_matrix (w->current_matrix);
13254 SET_TEXT_POS (pos, BEGV, BEGV_BYTE);
13255 try_window (FRAME_ROOT_WINDOW (f), pos);
13256
13257 /* Compute width and height of the tooltip. */
13258 width = height = 0;
13259 for (i = 0; i < w->desired_matrix->nrows; ++i)
ee78dc32 13260 {
6fc2811b
JR		 13261 struct glyph_row *row = &w->desired_matrix->rows[i];
13262 struct glyph *last;
13263 int row_width;
13264
13265 /* Stop at the first empty row at the end. */
13266 if (!row->enabled_p || !row->displays_text_p)
13267 break;
13268
13269 /* Let the row go over the full width of the frame. */
13270 row->full_width_p = 1;
13271
13272 /* There's a glyph at the end of rows that is use to place
13273 the cursor there. Don't include the width of this glyph. */
13274 if (row->used[TEXT_AREA])
13275 {
13276 last = &row->glyphs[TEXT_AREA][row->used[TEXT_AREA] - 1];
13277 row_width = row->pixel_width - last->pixel_width;
13278 }
13279 else
13280 row_width = row->pixel_width;
13281
13282 height += row->height;
13283 width = max (width, row_width);
ee78dc32
GV		 13284 }
13285
6fc2811b
JR		 13286 /* Add the frame's internal border to the width and height the X
13287 window should have. */
13288 height += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
13289 width += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
ee78dc32 13290
6fc2811b
JR		 13291 /* Move the tooltip window where the mouse pointer is. Resize and
13292 show it. */
3cf3436e 13293 compute_tip_xy (f, parms, dx, dy, width, height, &root_x, &root_y);
71eab8d1 13294
71eab8d1
AI		 13295 BLOCK_INPUT;
13296 XMoveResizeWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
13297 root_x, root_y - height, width, height);
13298 XMapRaised (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f));
6fc2811b 13299 UNBLOCK_INPUT;
ee78dc32 13300
6fc2811b
JR		 13301 /* Draw into the window. */
13302 w->must_be_updated_p = 1;
13303 update_single_window (w, 1);
ee78dc32 13304
6fc2811b
JR		 13305 /* Restore original current buffer. */
13306 set_buffer_internal_1 (old_buffer);
13307 windows_or_buffers_changed = old_windows_or_buffers_changed;
ee78dc32 13308
dc220243 13309 start_timer:
6fc2811b
JR		 13310 /* Let the tip disappear after timeout seconds. */
13311 tip_timer = call3 (intern ("run-at-time"), timeout, Qnil,
13312 intern ("x-hide-tip"));
ee78dc32 13313
dfff8a69 13314 UNGCPRO;
6fc2811b 13315 return unbind_to (count, Qnil);
ee78dc32
GV		 13316}
13317
ee78dc32 13318
6fc2811b
JR		 13319DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0,
13320 "Hide the current tooltip window, if there is any.\n\
3cf3436e 13321Value is t if tooltip was open, nil otherwise.")
6fc2811b
JR		 13322 ()
13323{
937e601e
AI		 13324 int count;
13325 Lisp_Object deleted, frame, timer;
13326 struct gcpro gcpro1, gcpro2;
13327
13328 /* Return quickly if nothing to do. */
13329 if (NILP (tip_timer) && NILP (tip_frame))
13330 return Qnil;
13331
13332 frame = tip_frame;
13333 timer = tip_timer;
13334 GCPRO2 (frame, timer);
13335 tip_frame = tip_timer = deleted = Qnil;
6fc2811b 13336
937e601e 13337 count = BINDING_STACK_SIZE ();
6fc2811b 13338 specbind (Qinhibit_redisplay, Qt);
937e601e 13339 specbind (Qinhibit_quit, Qt);
6fc2811b 13340
937e601e 13341 if (!NILP (timer))
dc220243 13342 call1 (Qcancel_timer, timer);
ee78dc32 13343
937e601e 13344 if (FRAMEP (frame))
6fc2811b 13345 {
937e601e
AI		 13346 Fdelete_frame (frame, Qnil);
13347 deleted = Qt;
6fc2811b 13348 }
1edf84e7 13349
937e601e
AI		 13350 UNGCPRO;
13351 return unbind_to (count, deleted);
6fc2811b 13352}
767b1ff0 13353#endif
5ac45f98 13354
5ac45f98 13355
6fc2811b
JR		 13356\f
13357/***********************************************************************
13358 File selection dialog
13359 ***********************************************************************/
13360
13361extern Lisp_Object Qfile_name_history;
13362
13363DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 4, 0,
13364 "Read file name, prompting with PROMPT in directory DIR.\n\
13365Use a file selection dialog.\n\
13366Select DEFAULT-FILENAME in the dialog's file selection box, if\n\
3cf3436e 13367specified. Ensure that file exists if MUSTMATCH is non-nil.")
6fc2811b
JR		 13368 (prompt, dir, default_filename, mustmatch)
13369 Lisp_Object prompt, dir, default_filename, mustmatch;
13370{
13371 struct frame *f = SELECTED_FRAME ();
13372 Lisp_Object file = Qnil;
13373 int count = specpdl_ptr - specpdl;
13374 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
13375 char filename[MAX_PATH + 1];
13376 char init_dir[MAX_PATH + 1];
13377 int use_dialog_p = 1;
13378
13379 GCPRO5 (prompt, dir, default_filename, mustmatch, file);
13380 CHECK_STRING (prompt, 0);
13381 CHECK_STRING (dir, 1);
13382
13383 /* Create the dialog with PROMPT as title, using DIR as initial
13384 directory and using "*" as pattern. */
13385 dir = Fexpand_file_name (dir, Qnil);
13386 strncpy (init_dir, XSTRING (dir)->data, MAX_PATH);
13387 init_dir[MAX_PATH] = '\0';
13388 unixtodos_filename (init_dir);
13389
13390 if (STRINGP (default_filename))
13391 {
13392 char *file_name_only;
13393 char *full_path_name = XSTRING (default_filename)->data;
5ac45f98 13394
6fc2811b 13395 unixtodos_filename (full_path_name);
5ac45f98 13396
6fc2811b
JR		 13397 file_name_only = strrchr (full_path_name, '\\');
13398 if (!file_name_only)
13399 file_name_only = full_path_name;
13400 else
13401 {
13402 file_name_only++;
5ac45f98 13403
6fc2811b
JR		 13404 /* If default_file_name is a directory, don't use the open
13405 file dialog, as it does not support selecting
13406 directories. */
13407 if (!(*file_name_only))
13408 use_dialog_p = 0;
13409 }
ee78dc32 13410
6fc2811b
JR		 13411 strncpy (filename, file_name_only, MAX_PATH);
13412 filename[MAX_PATH] = '\0';
13413 }
ee78dc32 13414 else
6fc2811b 13415 filename[0] = '\0';
ee78dc32 13416
6fc2811b
JR		 13417 if (use_dialog_p)
13418 {
13419 OPENFILENAME file_details;
5ac45f98 13420
6fc2811b
JR		 13421 /* Prevent redisplay. */
13422 specbind (Qinhibit_redisplay, Qt);
13423 BLOCK_INPUT;
ee78dc32 13424
6fc2811b
JR		 13425 bzero (&file_details, sizeof (file_details));
13426 file_details.lStructSize = sizeof (file_details);
13427 file_details.hwndOwner = FRAME_W32_WINDOW (f);
3cf3436e
JR		 13428 /* Undocumented Bug in Common File Dialog:
13429 If a filter is not specified, shell links are not resolved. */
13430 file_details.lpstrFilter = "ALL Files (*.*)\0*.*\0\0";
6fc2811b
JR		 13431 file_details.lpstrFile = filename;
13432 file_details.nMaxFile = sizeof (filename);
13433 file_details.lpstrInitialDir = init_dir;
13434 file_details.lpstrTitle = XSTRING (prompt)->data;
13435 file_details.Flags = OFN_HIDEREADONLY | OFN_NOCHANGEDIR;
ee78dc32 13436
6fc2811b
JR		 13437 if (!NILP (mustmatch))
13438 file_details.Flags |= OFN_FILEMUSTEXIST | OFN_PATHMUSTEXIST;
ee78dc32 13439
6fc2811b
JR		 13440 if (GetOpenFileName (&file_details))
13441 {
13442 dostounix_filename (filename);
13443 file = build_string (filename);
13444 }
ee78dc32 13445 else
6fc2811b
JR		 13446 file = Qnil;
13447
13448 UNBLOCK_INPUT;
13449 file = unbind_to (count, file);
ee78dc32 13450 }
6fc2811b
JR		 13451 /* Open File dialog will not allow folders to be selected, so resort
13452 to minibuffer completing reads for directories. */
13453 else
13454 file = Fcompleting_read (prompt, intern ("read-file-name-internal"),
13455 dir, mustmatch, dir, Qfile_name_history,
13456 default_filename, Qnil);
ee78dc32 13457
6fc2811b 13458 UNGCPRO;
1edf84e7 13459
6fc2811b
JR		 13460 /* Make "Cancel" equivalent to C-g. */
13461 if (NILP (file))
13462 Fsignal (Qquit, Qnil);
ee78dc32 13463
dfff8a69 13464 return unbind_to (count, file);
6fc2811b 13465}
ee78dc32 13466
ee78dc32 13467
6fc2811b
JR		 13468\f
13469/***********************************************************************
13470 Tests
13471 ***********************************************************************/
ee78dc32 13472
6fc2811b 13473#if GLYPH_DEBUG
ee78dc32 13474
6fc2811b
JR		 13475DEFUN ("imagep", Fimagep, Simagep, 1, 1, 0,
13476 "Value is non-nil if SPEC is a valid image specification.")
13477 (spec)
13478 Lisp_Object spec;
13479{
13480 return valid_image_p (spec) ? Qt : Qnil;
ee78dc32
GV		 13481}
13482
ee78dc32 13483
6fc2811b
JR		 13484DEFUN ("lookup-image", Flookup_image, Slookup_image, 1, 1, 0, "")
13485 (spec)
13486 Lisp_Object spec;
13487{
13488 int id = -1;
13489
13490 if (valid_image_p (spec))
13491 id = lookup_image (SELECTED_FRAME (), spec);
ee78dc32 13492
6fc2811b
JR		 13493 debug_print (spec);
13494 return make_number (id);
ee78dc32
GV		 13495}
13496
6fc2811b 13497#endif /* GLYPH_DEBUG != 0 */
ee78dc32 13498
ee78dc32
GV		 13499
13500\f
6fc2811b
JR		 13501/***********************************************************************
13502 w32 specialized functions
13503 ***********************************************************************/
ee78dc32 13504
fbd6baed
GV		 13505DEFUN ("w32-select-font", Fw32_select_font, Sw32_select_font, 0, 1, 0,
13506 "This will display the W32 font dialog and return an X font string corresponding to the selection.")
ee78dc32
GV		 13507 (frame)
13508 Lisp_Object frame;
13509{
13510 FRAME_PTR f = check_x_frame (frame);
13511 CHOOSEFONT cf;
13512 LOGFONT lf;
f46e6225
GV		 13513 TEXTMETRIC tm;
13514 HDC hdc;
13515 HANDLE oldobj;
ee78dc32
GV		 13516 char buf[100];
13517
13518 bzero (&cf, sizeof (cf));
f46e6225 13519 bzero (&lf, sizeof (lf));
ee78dc32
GV		 13520
13521 cf.lStructSize = sizeof (cf);
fbd6baed 13522 cf.hwndOwner = FRAME_W32_WINDOW (f);
6fc2811b 13523 cf.Flags = CF_FORCEFONTEXIST | CF_SCREENFONTS;
ee78dc32
GV		 13524 cf.lpLogFont = &lf;
13525
f46e6225
GV		 13526 /* Initialize as much of the font details as we can from the current
13527 default font. */
13528 hdc = GetDC (FRAME_W32_WINDOW (f));
13529 oldobj = SelectObject (hdc, FRAME_FONT (f)->hfont);
13530 GetTextFace (hdc, LF_FACESIZE, lf.lfFaceName);
13531 if (GetTextMetrics (hdc, &tm))
13532 {
13533 lf.lfHeight = tm.tmInternalLeading - tm.tmHeight;
13534 lf.lfWeight = tm.tmWeight;
13535 lf.lfItalic = tm.tmItalic;
13536 lf.lfUnderline = tm.tmUnderlined;
13537 lf.lfStrikeOut = tm.tmStruckOut;
f46e6225
GV		 13538 lf.lfCharSet = tm.tmCharSet;
13539 cf.Flags |= CF_INITTOLOGFONTSTRUCT;
13540 }
13541 SelectObject (hdc, oldobj);
6fc2811b 13542 ReleaseDC (FRAME_W32_WINDOW (f), hdc);
f46e6225 13543
767b1ff0 13544 if (!ChooseFont (&cf) || !w32_to_x_font (&lf, buf, 100, NULL))
3c190163 13545 return Qnil;
ee78dc32
GV		 13546
13547 return build_string (buf);
13548}
13549
1edf84e7
GV		 13550DEFUN ("w32-send-sys-command", Fw32_send_sys_command, Sw32_send_sys_command, 1, 2, 0,
13551 "Send frame a Windows WM_SYSCOMMAND message of type COMMAND.\n\
13552Some useful values for command are 0xf030 to maximise frame (0xf020\n\
13553to minimize), 0xf120 to restore frame to original size, and 0xf100\n\
13554to activate the menubar for keyboard access. 0xf140 activates the\n\
13555screen saver if defined.\n\
13556\n\
13557If optional parameter FRAME is not specified, use selected frame.")
13558 (command, frame)
13559 Lisp_Object command, frame;
13560{
1edf84e7
GV		 13561 FRAME_PTR f = check_x_frame (frame);
13562
13563 CHECK_NUMBER (command, 0);
13564
ce6059da 13565 PostMessage (FRAME_W32_WINDOW (f), WM_SYSCOMMAND, XINT (command), 0);
1edf84e7
GV		 13566
13567 return Qnil;
13568}
13569
55dcfc15
AI		 13570DEFUN ("w32-shell-execute", Fw32_shell_execute, Sw32_shell_execute, 2, 4, 0,
13571 "Get Windows to perform OPERATION on DOCUMENT.\n\
13572This is a wrapper around the ShellExecute system function, which\n\
13573invokes the application registered to handle OPERATION for DOCUMENT.\n\
6fc2811b
JR		 13574OPERATION is typically \"open\", \"print\" or \"explore\" (but can be\n\
13575nil for the default action), and DOCUMENT is typically the name of a\n\
13576document file or URL, but can also be a program executable to run or\n\
13577a directory to open in the Windows Explorer.\n\
55dcfc15 13578\n\
6fc2811b
JR		 13579If DOCUMENT is a program executable, PARAMETERS can be a string\n\
13580containing command line parameters, but otherwise should be nil.\n\
55dcfc15
AI		 13581\n\
13582SHOW-FLAG can be used to control whether the invoked application is hidden\n\
6fc2811b 13583or minimized. If SHOW-FLAG is nil, the application is displayed normally,\n\
55dcfc15
AI		 13584otherwise it is an integer representing a ShowWindow flag:\n\
13585\n\
13586 0 - start hidden\n\
13587 1 - start normally\n\
13588 3 - start maximized\n\
13589 6 - start minimized")
13590 (operation, document, parameters, show_flag)
13591 Lisp_Object operation, document, parameters, show_flag;
13592{
13593 Lisp_Object current_dir;
13594
55dcfc15
AI		 13595 CHECK_STRING (document, 0);
13596
13597 /* Encode filename and current directory. */
13598 current_dir = ENCODE_FILE (current_buffer->directory);
13599 document = ENCODE_FILE (document);
13600 if ((int) ShellExecute (NULL,
6fc2811b
JR		 13601 (STRINGP (operation) ?
13602 XSTRING (operation)->data : NULL),
55dcfc15
AI		 13603 XSTRING (document)->data,
13604 (STRINGP (parameters) ?
13605 XSTRING (parameters)->data : NULL),
13606 XSTRING (current_dir)->data,
13607 (INTEGERP (show_flag) ?
13608 XINT (show_flag) : SW_SHOWDEFAULT))
13609 > 32)
13610 return Qt;
90d97e64 13611 error ("ShellExecute failed: %s", w32_strerror (0));
55dcfc15
AI		 13612}
13613
ccc2d29c
GV		 13614/* Lookup virtual keycode from string representing the name of a
13615 non-ascii keystroke into the corresponding virtual key, using
13616 lispy_function_keys. */
13617static int
13618lookup_vk_code (char *key)
13619{
13620 int i;
13621
13622 for (i = 0; i < 256; i++)
13623 if (lispy_function_keys[i] != 0
13624 && strcmp (lispy_function_keys[i], key) == 0)
13625 return i;
13626
13627 return -1;
13628}
13629
13630/* Convert a one-element vector style key sequence to a hot key
13631 definition. */
13632static int
13633w32_parse_hot_key (key)
13634 Lisp_Object key;
13635{
13636 /* Copied from Fdefine_key and store_in_keymap. */
13637 register Lisp_Object c;
13638 int vk_code;
13639 int lisp_modifiers;
13640 int w32_modifiers;
13641 struct gcpro gcpro1;
13642
13643 CHECK_VECTOR (key, 0);
13644
13645 if (XFASTINT (Flength (key)) != 1)
13646 return Qnil;
13647
13648 GCPRO1 (key);
13649
13650 c = Faref (key, make_number (0));
13651
13652 if (CONSP (c) && lucid_event_type_list_p (c))
13653 c = Fevent_convert_list (c);
13654
13655 UNGCPRO;
13656
13657 if (! INTEGERP (c) && ! SYMBOLP (c))
13658 error ("Key definition is invalid");
13659
13660 /* Work out the base key and the modifiers. */
13661 if (SYMBOLP (c))
13662 {
13663 c = parse_modifiers (c);
13664 lisp_modifiers = Fcar (Fcdr (c));
13665 c = Fcar (c);
13666 if (!SYMBOLP (c))
13667 abort ();
13668 vk_code = lookup_vk_code (XSYMBOL (c)->name->data);
13669 }
13670 else if (INTEGERP (c))
13671 {
13672 lisp_modifiers = XINT (c) & ~CHARACTERBITS;
13673 /* Many ascii characters are their own virtual key code. */
13674 vk_code = XINT (c) & CHARACTERBITS;
13675 }
13676
13677 if (vk_code < 0 || vk_code > 255)
13678 return Qnil;
13679
13680 if ((lisp_modifiers & meta_modifier) != 0
13681 && !NILP (Vw32_alt_is_meta))
13682 lisp_modifiers |= alt_modifier;
13683
71eab8d1
AI		 13684 /* Supply defs missing from mingw32. */
13685#ifndef MOD_ALT
13686#define MOD_ALT 0x0001
13687#define MOD_CONTROL 0x0002
13688#define MOD_SHIFT 0x0004
13689#define MOD_WIN 0x0008
13690#endif
13691
ccc2d29c
GV		 13692 /* Convert lisp modifiers to Windows hot-key form. */
13693 w32_modifiers = (lisp_modifiers & hyper_modifier) ? MOD_WIN : 0;
13694 w32_modifiers |= (lisp_modifiers & alt_modifier) ? MOD_ALT : 0;
13695 w32_modifiers |= (lisp_modifiers & ctrl_modifier) ? MOD_CONTROL : 0;
13696 w32_modifiers |= (lisp_modifiers & shift_modifier) ? MOD_SHIFT : 0;
13697
13698 return HOTKEY (vk_code, w32_modifiers);
13699}
13700
13701DEFUN ("w32-register-hot-key", Fw32_register_hot_key, Sw32_register_hot_key, 1, 1, 0,
13702 "Register KEY as a hot-key combination.\n\
13703Certain key combinations like Alt-Tab are reserved for system use on\n\
13704Windows, and therefore are normally intercepted by the system. However,\n\
13705most of these key combinations can be received by registering them as\n\
13706hot-keys, overriding their special meaning.\n\
13707\n\
13708KEY must be a one element key definition in vector form that would be\n\
13709acceptable to `define-key' (e.g. [A-tab] for Alt-Tab). The meta\n\
13710modifier is interpreted as Alt if `w32-alt-is-meta' is t, and hyper\n\
13711is always interpreted as the Windows modifier keys.\n\
13712\n\
13713The return value is the hotkey-id if registered, otherwise nil.")
13714 (key)
13715 Lisp_Object key;
13716{
13717 key = w32_parse_hot_key (key);
13718
13719 if (NILP (Fmemq (key, w32_grabbed_keys)))
13720 {
13721 /* Reuse an empty slot if possible. */
13722 Lisp_Object item = Fmemq (Qnil, w32_grabbed_keys);
13723
13724 /* Safe to add new key to list, even if we have focus. */
13725 if (NILP (item))
13726 w32_grabbed_keys = Fcons (key, w32_grabbed_keys);
13727 else
f3fbd155 13728 XSETCAR (item, key);
ccc2d29c
GV		 13729
13730 /* Notify input thread about new hot-key definition, so that it
13731 takes effect without needing to switch focus. */
13732 PostThreadMessage (dwWindowsThreadId, WM_EMACS_REGISTER_HOT_KEY,
13733 (WPARAM) key, 0);
13734 }
13735
13736 return key;
13737}
13738
13739DEFUN ("w32-unregister-hot-key", Fw32_unregister_hot_key, Sw32_unregister_hot_key, 1, 1, 0,
13740 "Unregister HOTKEY as a hot-key combination.")
13741 (key)
13742 Lisp_Object key;
13743{
13744 Lisp_Object item;
13745
13746 if (!INTEGERP (key))
13747 key = w32_parse_hot_key (key);
13748
13749 item = Fmemq (key, w32_grabbed_keys);
13750
13751 if (!NILP (item))
13752 {
13753 /* Notify input thread about hot-key definition being removed, so
13754 that it takes effect without needing focus switch. */
13755 if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_UNREGISTER_HOT_KEY,
13756 (WPARAM) XINT (XCAR (item)), (LPARAM) item))
13757 {
13758 MSG msg;
13759 GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
13760 }
13761 return Qt;
13762 }
13763 return Qnil;
13764}
13765
13766DEFUN ("w32-registered-hot-keys", Fw32_registered_hot_keys, Sw32_registered_hot_keys, 0, 0, 0,
13767 "Return list of registered hot-key IDs.")
13768 ()
13769{
13770 return Fcopy_sequence (w32_grabbed_keys);
13771}
13772
13773DEFUN ("w32-reconstruct-hot-key", Fw32_reconstruct_hot_key, Sw32_reconstruct_hot_key, 1, 1, 0,
13774 "Convert hot-key ID to a lisp key combination.")
13775 (hotkeyid)
13776 Lisp_Object hotkeyid;
13777{
13778 int vk_code, w32_modifiers;
13779 Lisp_Object key;
13780
13781 CHECK_NUMBER (hotkeyid, 0);
13782
13783 vk_code = HOTKEY_VK_CODE (hotkeyid);
13784 w32_modifiers = HOTKEY_MODIFIERS (hotkeyid);
13785
13786 if (lispy_function_keys[vk_code])
13787 key = intern (lispy_function_keys[vk_code]);
13788 else
13789 key = make_number (vk_code);
13790
13791 key = Fcons (key, Qnil);
13792 if (w32_modifiers & MOD_SHIFT)
3ef68e6b 13793 key = Fcons (Qshift, key);
ccc2d29c 13794 if (w32_modifiers & MOD_CONTROL)
3ef68e6b 13795 key = Fcons (Qctrl, key);
ccc2d29c 13796 if (w32_modifiers & MOD_ALT)
3ef68e6b 13797 key = Fcons (NILP (Vw32_alt_is_meta) ? Qalt : Qmeta, key);
ccc2d29c 13798 if (w32_modifiers & MOD_WIN)
3ef68e6b 13799 key = Fcons (Qhyper, key);
ccc2d29c
GV		 13800
13801 return key;
13802}
adcc3809
GV		 13803
13804DEFUN ("w32-toggle-lock-key", Fw32_toggle_lock_key, Sw32_toggle_lock_key, 1, 2, 0,
13805 "Toggle the state of the lock key KEY.\n\
13806KEY can be `capslock', `kp-numlock', or `scroll'.\n\
13807If the optional parameter NEW-STATE is a number, then the state of KEY\n\
13808is set to off if the low bit of NEW-STATE is zero, otherwise on.")
13809 (key, new_state)
13810 Lisp_Object key, new_state;
13811{
13812 int vk_code;
adcc3809
GV		 13813
13814 if (EQ (key, intern ("capslock")))
13815 vk_code = VK_CAPITAL;
13816 else if (EQ (key, intern ("kp-numlock")))
13817 vk_code = VK_NUMLOCK;
13818 else if (EQ (key, intern ("scroll")))
13819 vk_code = VK_SCROLL;
13820 else
13821 return Qnil;
13822
13823 if (!dwWindowsThreadId)
13824 return make_number (w32_console_toggle_lock_key (vk_code, new_state));
13825
13826 if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_TOGGLE_LOCK_KEY,
13827 (WPARAM) vk_code, (LPARAM) new_state))
13828 {
13829 MSG msg;
13830 GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
13831 return make_number (msg.wParam);
13832 }
13833 return Qnil;
13834}
ee78dc32 13835\f
2254bcde
AI		 13836DEFUN ("file-system-info", Ffile_system_info, Sfile_system_info, 1, 1, 0,
13837 "Return storage information about the file system FILENAME is on.\n\
13838Value is a list of floats (TOTAL FREE AVAIL), where TOTAL is the total\n\
13839storage of the file system, FREE is the free storage, and AVAIL is the\n\
13840storage available to a non-superuser. All 3 numbers are in bytes.\n\
13841If the underlying system call fails, value is nil.")
13842 (filename)
13843 Lisp_Object filename;
13844{
13845 Lisp_Object encoded, value;
13846
13847 CHECK_STRING (filename, 0);
13848 filename = Fexpand_file_name (filename, Qnil);
13849 encoded = ENCODE_FILE (filename);
13850
13851 value = Qnil;
13852
13853 /* Determining the required information on Windows turns out, sadly,
13854 to be more involved than one would hope. The original Win32 api
13855 call for this will return bogus information on some systems, but we
13856 must dynamically probe for the replacement api, since that was
13857 added rather late on. */
13858 {
13859 HMODULE hKernel = GetModuleHandle ("kernel32");
13860 BOOL (*pfn_GetDiskFreeSpaceEx)
13861 (char *, PULARGE_INTEGER, PULARGE_INTEGER, PULARGE_INTEGER)
13862 = (void *) GetProcAddress (hKernel, "GetDiskFreeSpaceEx");
13863
13864 /* On Windows, we may need to specify the root directory of the
13865 volume holding FILENAME. */
13866 char rootname[MAX_PATH];
13867 char *name = XSTRING (encoded)->data;
13868
13869 /* find the root name of the volume if given */
13870 if (isalpha (name[0]) && name[1] == ':')
13871 {
13872 rootname[0] = name[0];
13873 rootname[1] = name[1];
13874 rootname[2] = '\\';
13875 rootname[3] = 0;
13876 }
13877 else if (IS_DIRECTORY_SEP (name[0]) && IS_DIRECTORY_SEP (name[1]))
13878 {
13879 char *str = rootname;
13880 int slashes = 4;
13881 do
13882 {
13883 if (IS_DIRECTORY_SEP (*name) && --slashes == 0)
13884 break;
13885 *str++ = *name++;
13886 }
13887 while ( *name );
13888
13889 *str++ = '\\';
13890 *str = 0;
13891 }
13892
13893 if (pfn_GetDiskFreeSpaceEx)
13894 {
13895 LARGE_INTEGER availbytes;
13896 LARGE_INTEGER freebytes;
13897 LARGE_INTEGER totalbytes;
13898
13899 if (pfn_GetDiskFreeSpaceEx(rootname,
13900 &availbytes,
13901 &totalbytes,
13902 &freebytes))
13903 value = list3 (make_float ((double) totalbytes.QuadPart),
13904 make_float ((double) freebytes.QuadPart),
13905 make_float ((double) availbytes.QuadPart));
13906 }
13907 else
13908 {
13909 DWORD sectors_per_cluster;
13910 DWORD bytes_per_sector;
13911 DWORD free_clusters;
13912 DWORD total_clusters;
13913
13914 if (GetDiskFreeSpace(rootname,
13915 &sectors_per_cluster,
13916 &bytes_per_sector,
13917 &free_clusters,
13918 &total_clusters))
13919 value = list3 (make_float ((double) total_clusters
13920 * sectors_per_cluster * bytes_per_sector),
13921 make_float ((double) free_clusters
13922 * sectors_per_cluster * bytes_per_sector),
13923 make_float ((double) free_clusters
13924 * sectors_per_cluster * bytes_per_sector));
13925 }
13926 }
13927
13928 return value;
13929}
13930\f
fbd6baed 13931syms_of_w32fns ()
ee78dc32 13932{
1edf84e7
GV		 13933 /* This is zero if not using MS-Windows. */
13934 w32_in_use = 0;
13935
ee78dc32
GV		 13936 /* The section below is built by the lisp expression at the top of the file,
13937 just above where these variables are declared. */
13938 /*&&& init symbols here &&&*/
13939 Qauto_raise = intern ("auto-raise");
13940 staticpro (&Qauto_raise);
13941 Qauto_lower = intern ("auto-lower");
13942 staticpro (&Qauto_lower);
ee78dc32
GV		 13943 Qbar = intern ("bar");
13944 staticpro (&Qbar);
13945 Qborder_color = intern ("border-color");
13946 staticpro (&Qborder_color);
13947 Qborder_width = intern ("border-width");
13948 staticpro (&Qborder_width);
13949 Qbox = intern ("box");
13950 staticpro (&Qbox);
13951 Qcursor_color = intern ("cursor-color");
13952 staticpro (&Qcursor_color);
13953 Qcursor_type = intern ("cursor-type");
13954 staticpro (&Qcursor_type);
ee78dc32
GV		 13955 Qgeometry = intern ("geometry");
13956 staticpro (&Qgeometry);
13957 Qicon_left = intern ("icon-left");
13958 staticpro (&Qicon_left);
13959 Qicon_top = intern ("icon-top");
13960 staticpro (&Qicon_top);
13961 Qicon_type = intern ("icon-type");
13962 staticpro (&Qicon_type);
13963 Qicon_name = intern ("icon-name");
13964 staticpro (&Qicon_name);
13965 Qinternal_border_width = intern ("internal-border-width");
13966 staticpro (&Qinternal_border_width);
13967 Qleft = intern ("left");
13968 staticpro (&Qleft);
1026b400
RS		 13969 Qright = intern ("right");
13970 staticpro (&Qright);
ee78dc32
GV		 13971 Qmouse_color = intern ("mouse-color");
13972 staticpro (&Qmouse_color);
13973 Qnone = intern ("none");
13974 staticpro (&Qnone);
13975 Qparent_id = intern ("parent-id");
13976 staticpro (&Qparent_id);
13977 Qscroll_bar_width = intern ("scroll-bar-width");
13978 staticpro (&Qscroll_bar_width);
13979 Qsuppress_icon = intern ("suppress-icon");
13980 staticpro (&Qsuppress_icon);
ee78dc32
GV		 13981 Qundefined_color = intern ("undefined-color");
13982 staticpro (&Qundefined_color);
13983 Qvertical_scroll_bars = intern ("vertical-scroll-bars");
13984 staticpro (&Qvertical_scroll_bars);
13985 Qvisibility = intern ("visibility");
13986 staticpro (&Qvisibility);
13987 Qwindow_id = intern ("window-id");
13988 staticpro (&Qwindow_id);
13989 Qx_frame_parameter = intern ("x-frame-parameter");
13990 staticpro (&Qx_frame_parameter);
13991 Qx_resource_name = intern ("x-resource-name");
13992 staticpro (&Qx_resource_name);
13993 Quser_position = intern ("user-position");
13994 staticpro (&Quser_position);
13995 Quser_size = intern ("user-size");
13996 staticpro (&Quser_size);
6fc2811b
JR		 13997 Qscreen_gamma = intern ("screen-gamma");
13998 staticpro (&Qscreen_gamma);
dfff8a69
JR		 13999 Qline_spacing = intern ("line-spacing");
14000 staticpro (&Qline_spacing);
14001 Qcenter = intern ("center");
14002 staticpro (&Qcenter);
dc220243
JR		 14003 Qcancel_timer = intern ("cancel-timer");
14004 staticpro (&Qcancel_timer);
ee78dc32
GV		 14005 /* This is the end of symbol initialization. */
14006
adcc3809
GV		 14007 Qhyper = intern ("hyper");
14008 staticpro (&Qhyper);
14009 Qsuper = intern ("super");
14010 staticpro (&Qsuper);
14011 Qmeta = intern ("meta");
14012 staticpro (&Qmeta);
14013 Qalt = intern ("alt");
14014 staticpro (&Qalt);
14015 Qctrl = intern ("ctrl");
14016 staticpro (&Qctrl);
14017 Qcontrol = intern ("control");
14018 staticpro (&Qcontrol);
14019 Qshift = intern ("shift");
14020 staticpro (&Qshift);
14021
6fc2811b
JR		 14022 /* Text property `display' should be nonsticky by default. */
14023 Vtext_property_default_nonsticky
14024 = Fcons (Fcons (Qdisplay, Qt), Vtext_property_default_nonsticky);
14025
14026
14027 Qlaplace = intern ("laplace");
14028 staticpro (&Qlaplace);
3cf3436e
JR		 14029 Qemboss = intern ("emboss");
14030 staticpro (&Qemboss);
14031 Qedge_detection = intern ("edge-detection");
14032 staticpro (&Qedge_detection);
14033 Qheuristic = intern ("heuristic");
14034 staticpro (&Qheuristic);
14035 QCmatrix = intern (":matrix");
14036 staticpro (&QCmatrix);
14037 QCcolor_adjustment = intern (":color-adjustment");
14038 staticpro (&QCcolor_adjustment);
14039 QCmask = intern (":mask");
14040 staticpro (&QCmask);
6fc2811b 14041
4b817373
RS		 14042 Qface_set_after_frame_default = intern ("face-set-after-frame-default");
14043 staticpro (&Qface_set_after_frame_default);
14044
ee78dc32
GV		 14045 Fput (Qundefined_color, Qerror_conditions,
14046 Fcons (Qundefined_color, Fcons (Qerror, Qnil)));
14047 Fput (Qundefined_color, Qerror_message,
14048 build_string ("Undefined color"));
14049
ccc2d29c
GV		 14050 staticpro (&w32_grabbed_keys);
14051 w32_grabbed_keys = Qnil;
14052
fbd6baed 14053 DEFVAR_LISP ("w32-color-map", &Vw32_color_map,
ccc2d29c 14054 "An array of color name mappings for windows.");
fbd6baed 14055 Vw32_color_map = Qnil;
ee78dc32 14056
fbd6baed 14057 DEFVAR_LISP ("w32-pass-alt-to-system", &Vw32_pass_alt_to_system,
da36a4d6
GV		 14058 "Non-nil if alt key presses are passed on to Windows.\n\
14059When non-nil, for example, alt pressed and released and then space will\n\
14060open the System menu. When nil, Emacs silently swallows alt key events.");
fbd6baed 14061 Vw32_pass_alt_to_system = Qnil;
da36a4d6 14062
fbd6baed 14063 DEFVAR_LISP ("w32-alt-is-meta", &Vw32_alt_is_meta,
8c205c63
RS		 14064 "Non-nil if the alt key is to be considered the same as the meta key.\n\
14065When nil, Emacs will translate the alt key to the Alt modifier, and not Meta.");
fbd6baed 14066 Vw32_alt_is_meta = Qt;
8c205c63 14067
7d081355
AI		 14068 DEFVAR_INT ("w32-quit-key", &Vw32_quit_key,
14069 "If non-zero, the virtual key code for an alternative quit key.");
14070 XSETINT (Vw32_quit_key, 0);
14071
ccc2d29c
GV		 14072 DEFVAR_LISP ("w32-pass-lwindow-to-system",
14073 &Vw32_pass_lwindow_to_system,
14074 "Non-nil if the left \"Windows\" key is passed on to Windows.\n\
14075When non-nil, the Start menu is opened by tapping the key.");
14076 Vw32_pass_lwindow_to_system = Qt;
14077
14078 DEFVAR_LISP ("w32-pass-rwindow-to-system",
14079 &Vw32_pass_rwindow_to_system,
14080 "Non-nil if the right \"Windows\" key is passed on to Windows.\n\
14081When non-nil, the Start menu is opened by tapping the key.");
14082 Vw32_pass_rwindow_to_system = Qt;
14083
adcc3809
GV		 14084 DEFVAR_INT ("w32-phantom-key-code",
14085 &Vw32_phantom_key_code,
14086 "Virtual key code used to generate \"phantom\" key presses.\n\
14087Value is a number between 0 and 255.\n\
14088\n\
14089Phantom key presses are generated in order to stop the system from\n\
14090acting on \"Windows\" key events when `w32-pass-lwindow-to-system' or\n\
14091`w32-pass-rwindow-to-system' is nil.");
ce6059da
AI		 14092 /* Although 255 is technically not a valid key code, it works and
14093 means that this hack won't interfere with any real key code. */
14094 Vw32_phantom_key_code = 255;
adcc3809 14095
ccc2d29c
GV		 14096 DEFVAR_LISP ("w32-enable-num-lock",
14097 &Vw32_enable_num_lock,
14098 "Non-nil if Num Lock should act normally.\n\
14099Set to nil to see Num Lock as the key `kp-numlock'.");
14100 Vw32_enable_num_lock = Qt;
14101
14102 DEFVAR_LISP ("w32-enable-caps-lock",
14103 &Vw32_enable_caps_lock,
14104 "Non-nil if Caps Lock should act normally.\n\
14105Set to nil to see Caps Lock as the key `capslock'.");
14106 Vw32_enable_caps_lock = Qt;
14107
14108 DEFVAR_LISP ("w32-scroll-lock-modifier",
14109 &Vw32_scroll_lock_modifier,
14110 "Modifier to use for the Scroll Lock on state.\n\
14111The value can be hyper, super, meta, alt, control or shift for the\n\
14112respective modifier, or nil to see Scroll Lock as the key `scroll'.\n\
14113Any other value will cause the key to be ignored.");
14114 Vw32_scroll_lock_modifier = Qt;
14115
14116 DEFVAR_LISP ("w32-lwindow-modifier",
14117 &Vw32_lwindow_modifier,
14118 "Modifier to use for the left \"Windows\" key.\n\
14119The value can be hyper, super, meta, alt, control or shift for the\n\
14120respective modifier, or nil to appear as the key `lwindow'.\n\
14121Any other value will cause the key to be ignored.");
14122 Vw32_lwindow_modifier = Qnil;
14123
14124 DEFVAR_LISP ("w32-rwindow-modifier",
14125 &Vw32_rwindow_modifier,
14126 "Modifier to use for the right \"Windows\" key.\n\
14127The value can be hyper, super, meta, alt, control or shift for the\n\
14128respective modifier, or nil to appear as the key `rwindow'.\n\
14129Any other value will cause the key to be ignored.");
14130 Vw32_rwindow_modifier = Qnil;
14131
14132 DEFVAR_LISP ("w32-apps-modifier",
14133 &Vw32_apps_modifier,
14134 "Modifier to use for the \"Apps\" key.\n\
14135The value can be hyper, super, meta, alt, control or shift for the\n\
14136respective modifier, or nil to appear as the key `apps'.\n\
14137Any other value will cause the key to be ignored.");
14138 Vw32_apps_modifier = Qnil;
da36a4d6 14139
212da13b 14140 DEFVAR_LISP ("w32-enable-synthesized-fonts", &Vw32_enable_synthesized_fonts,
6fc2811b
JR		 14141 "Non-nil enables selection of artificially italicized and bold fonts.");
14142 Vw32_enable_synthesized_fonts = Qnil;
5ac45f98 14143
fbd6baed 14144 DEFVAR_LISP ("w32-enable-palette", &Vw32_enable_palette,
6fc2811b 14145 "Non-nil enables Windows palette management to map colors exactly.");
fbd6baed 14146 Vw32_enable_palette = Qt;
5ac45f98 14147
fbd6baed
GV		 14148 DEFVAR_INT ("w32-mouse-button-tolerance",
14149 &Vw32_mouse_button_tolerance,
6fc2811b 14150 "Analogue of double click interval for faking middle mouse events.\n\
5ac45f98
GV		 14151The value is the minimum time in milliseconds that must elapse between\n\
14152left/right button down events before they are considered distinct events.\n\
14153If both mouse buttons are depressed within this interval, a middle mouse\n\
14154button down event is generated instead.");
fbd6baed 14155 XSETINT (Vw32_mouse_button_tolerance, GetDoubleClickTime () / 2);
5ac45f98 14156
fbd6baed
GV		 14157 DEFVAR_INT ("w32-mouse-move-interval",
14158 &Vw32_mouse_move_interval,
84fb1139
KH		 14159 "Minimum interval between mouse move events.\n\
14160The value is the minimum time in milliseconds that must elapse between\n\
14161successive mouse move (or scroll bar drag) events before they are\n\
14162reported as lisp events.");
247be837 14163 XSETINT (Vw32_mouse_move_interval, 0);
84fb1139 14164
ee78dc32
GV		 14165 init_x_parm_symbols ();
14166
14167 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path,
fbd6baed 14168 "List of directories to search for bitmap files for w32.");
ee78dc32
GV		 14169 Vx_bitmap_file_path = decode_env_path ((char *) 0, "PATH");
14170
14171 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape,
14172 "The shape of the pointer when over text.\n\
14173Changing the value does not affect existing frames\n\
14174unless you set the mouse color.");
14175 Vx_pointer_shape = Qnil;
14176
14177 DEFVAR_LISP ("x-resource-name", &Vx_resource_name,
14178 "The name Emacs uses to look up resources; for internal use only.\n\
14179`x-get-resource' uses this as the first component of the instance name\n\
14180when requesting resource values.\n\
14181Emacs initially sets `x-resource-name' to the name under which Emacs\n\
14182was invoked, or to the value specified with the `-name' or `-rn'\n\
14183switches, if present.");
14184 Vx_resource_name = Qnil;
14185
14186 Vx_nontext_pointer_shape = Qnil;
14187
14188 Vx_mode_pointer_shape = Qnil;
14189
0af913d7 14190 DEFVAR_LISP ("x-hourglass-pointer-shape", &Vx_hourglass_pointer_shape,
6fc2811b
JR		 14191 "The shape of the pointer when Emacs is busy.\n\
14192This variable takes effect when you create a new frame\n\
14193or when you set the mouse color.");
0af913d7 14194 Vx_hourglass_pointer_shape = Qnil;
6fc2811b 14195
0af913d7
GM		 14196 DEFVAR_BOOL ("display-hourglass", &display_hourglass_p,
14197 "Non-zero means Emacs displays an hourglass pointer on window systems.");
14198 display_hourglass_p = 1;
6fc2811b 14199
0af913d7
GM		 14200 DEFVAR_LISP ("hourglass-delay", &Vhourglass_delay,
14201 "*Seconds to wait before displaying an hourglass pointer.\n\
dfff8a69 14202Value must be an integer or float.");
0af913d7 14203 Vhourglass_delay = make_number (DEFAULT_HOURGLASS_DELAY);
f79e6790 14204
6fc2811b 14205 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
ee78dc32
GV		 14206 &Vx_sensitive_text_pointer_shape,
14207 "The shape of the pointer when over mouse-sensitive text.\n\
14208This variable takes effect when you create a new frame\n\
14209or when you set the mouse color.");
14210 Vx_sensitive_text_pointer_shape = Qnil;
14211
4694d762
JR		 14212 DEFVAR_LISP ("x-window-horizontal-drag-cursor",
14213 &Vx_window_horizontal_drag_shape,
14214 "Pointer shape to use for indicating a window can be dragged horizontally.\n\
14215This variable takes effect when you create a new frame\n\
14216or when you set the mouse color.");
14217 Vx_window_horizontal_drag_shape = Qnil;
14218
ee78dc32
GV		 14219 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel,
14220 "A string indicating the foreground color of the cursor box.");
14221 Vx_cursor_fore_pixel = Qnil;
14222
3cf3436e
JR		 14223 DEFVAR_LISP ("x-max-tooltip-size", &Vx_max_tooltip_size,
14224 "Maximum size for tooltips. Value is a pair (COLUMNS . ROWS).\n\
14225Text larger than this is clipped.");
14226 Vx_max_tooltip_size = Fcons (make_number (80), make_number (40));
14227
ee78dc32
GV		 14228 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager,
14229 "Non-nil if no window manager is in use.\n\
14230Emacs doesn't try to figure this out; this is always nil\n\
14231unless you set it to something else.");
14232 /* We don't have any way to find this out, so set it to nil
14233 and maybe the user would like to set it to t. */
14234 Vx_no_window_manager = Qnil;
14235
4587b026
GV		 14236 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
14237 &Vx_pixel_size_width_font_regexp,
14238 "Regexp matching a font name whose width is the same as `PIXEL_SIZE'.\n\
14239\n\
14240Since Emacs gets width of a font matching with this regexp from\n\
14241PIXEL_SIZE field of the name, font finding mechanism gets faster for\n\
14242such a font. This is especially effective for such large fonts as\n\
14243Chinese, Japanese, and Korean.");
14244 Vx_pixel_size_width_font_regexp = Qnil;
14245
6fc2811b
JR		 14246 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay,
14247 "Time after which cached images are removed from the cache.\n\
14248When an image has not been displayed this many seconds, remove it\n\
14249from the image cache. Value must be an integer or nil with nil\n\
14250meaning don't clear the cache.");
14251 Vimage_cache_eviction_delay = make_number (30 * 60);
14252
33d52f9c
GV		 14253 DEFVAR_LISP ("w32-bdf-filename-alist",
14254 &Vw32_bdf_filename_alist,
14255 "List of bdf fonts and their corresponding filenames.");
14256 Vw32_bdf_filename_alist = Qnil;
14257
1075afa9
GV		 14258 DEFVAR_BOOL ("w32-strict-fontnames",
14259 &w32_strict_fontnames,
14260 "Non-nil means only use fonts that are exact matches for those requested.\n\
14261Default is nil, which allows old fontnames that are not XLFD compliant,\n\
14262and allows third-party CJK display to work by specifying false charset\n\
14263fields to trick Emacs into translating to Big5, SJIS etc.\n\
14264Setting this to t will prevent wrong fonts being selected when\n\
14265fontsets are automatically created.");
14266 w32_strict_fontnames = 0;
14267
c0611964
AI		 14268 DEFVAR_BOOL ("w32-strict-painting",
14269 &w32_strict_painting,
14270 "Non-nil means use strict rules for repainting frames.\n\
14271Set this to nil to get the old behaviour for repainting; this should\n\
14272only be necessary if the default setting causes problems.");
14273 w32_strict_painting = 1;
14274
f46e6225
GV		 14275 DEFVAR_LISP ("w32-system-coding-system",
14276 &Vw32_system_coding_system,
14277 "Coding system used by Windows system functions, such as for font names.");
14278 Vw32_system_coding_system = Qnil;
14279
dfff8a69
JR		 14280 DEFVAR_LISP ("w32-charset-info-alist",
14281 &Vw32_charset_info_alist,
14282 "Alist linking Emacs character sets to Windows fonts\n\
14283and codepages. Each entry should be of the form:\n\
14284\n\
14285 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE))\n\
14286\n\
14287where CHARSET_NAME is a string used in font names to identify the charset,\n\
14288WINDOWS_CHARSET is a symbol that can be one of:\n\
14289w32-charset-ansi, w32-charset-default, w32-charset-symbol,\n\
767b1ff0 14290w32-charset-shiftjis, w32-charset-hangeul, w32-charset-gb2312,\n\
dfff8a69
JR		 14291w32-charset-chinesebig5, "
14292#ifdef JOHAB_CHARSET
14293"w32-charset-johab, w32-charset-hebrew,\n\
14294w32-charset-arabic, w32-charset-greek, w32-charset-turkish,\n\
14295w32-charset-vietnamese, w32-charset-thai, w32-charset-easteurope,\n\
14296w32-charset-russian, w32-charset-mac, w32-charset-baltic,\n"
14297#endif
14298#ifdef UNICODE_CHARSET
14299"w32-charset-unicode, "
14300#endif
14301"or w32-charset-oem.\n\
14302CODEPAGE should be an integer specifying the codepage that should be used\n\
14303to display the character set, t to do no translation and output as Unicode,\n\
14304or nil to do no translation and output as 8 bit (or multibyte on far-east\n\
14305versions of Windows) characters.");
14306 Vw32_charset_info_alist = Qnil;
14307
14308 staticpro (&Qw32_charset_ansi);
14309 Qw32_charset_ansi = intern ("w32-charset-ansi");
14310 staticpro (&Qw32_charset_symbol);
14311 Qw32_charset_symbol = intern ("w32-charset-symbol");
14312 staticpro (&Qw32_charset_shiftjis);
14313 Qw32_charset_shiftjis = intern ("w32-charset-shiftjis");
767b1ff0
JR		 14314 staticpro (&Qw32_charset_hangeul);
14315 Qw32_charset_hangeul = intern ("w32-charset-hangeul");
dfff8a69
JR		 14316 staticpro (&Qw32_charset_chinesebig5);
14317 Qw32_charset_chinesebig5 = intern ("w32-charset-chinesebig5");
14318 staticpro (&Qw32_charset_gb2312);
14319 Qw32_charset_gb2312 = intern ("w32-charset-gb2312");
14320 staticpro (&Qw32_charset_oem);
14321 Qw32_charset_oem = intern ("w32-charset-oem");
14322
14323#ifdef JOHAB_CHARSET
14324 {
14325 static int w32_extra_charsets_defined = 1;
767b1ff0 14326 DEFVAR_BOOL ("w32-extra-charsets-defined", &w32_extra_charsets_defined, "");
dfff8a69
JR		 14327
14328 staticpro (&Qw32_charset_johab);
14329 Qw32_charset_johab = intern ("w32-charset-johab");
14330 staticpro (&Qw32_charset_easteurope);
14331 Qw32_charset_easteurope = intern ("w32-charset-easteurope");
14332 staticpro (&Qw32_charset_turkish);
14333 Qw32_charset_turkish = intern ("w32-charset-turkish");
14334 staticpro (&Qw32_charset_baltic);
14335 Qw32_charset_baltic = intern ("w32-charset-baltic");
14336 staticpro (&Qw32_charset_russian);
14337 Qw32_charset_russian = intern ("w32-charset-russian");
14338 staticpro (&Qw32_charset_arabic);
14339 Qw32_charset_arabic = intern ("w32-charset-arabic");
14340 staticpro (&Qw32_charset_greek);
14341 Qw32_charset_greek = intern ("w32-charset-greek");
14342 staticpro (&Qw32_charset_hebrew);
14343 Qw32_charset_hebrew = intern ("w32-charset-hebrew");
767b1ff0
JR		 14344 staticpro (&Qw32_charset_vietnamese);
14345 Qw32_charset_vietnamese = intern ("w32-charset-vietnamese");
dfff8a69
JR		 14346 staticpro (&Qw32_charset_thai);
14347 Qw32_charset_thai = intern ("w32-charset-thai");
14348 staticpro (&Qw32_charset_mac);
14349 Qw32_charset_mac = intern ("w32-charset-mac");
14350 }
14351#endif
14352
14353#ifdef UNICODE_CHARSET
14354 {
14355 static int w32_unicode_charset_defined = 1;
14356 DEFVAR_BOOL ("w32-unicode-charset-defined",
767b1ff0 14357 &w32_unicode_charset_defined, "");
dfff8a69
JR		 14358
14359 staticpro (&Qw32_charset_unicode);
14360 Qw32_charset_unicode = intern ("w32-charset-unicode");
14361#endif
14362
ee78dc32 14363 defsubr (&Sx_get_resource);
767b1ff0 14364#if 0 /* TODO: Port to W32 */
6fc2811b
JR		 14365 defsubr (&Sx_change_window_property);
14366 defsubr (&Sx_delete_window_property);
14367 defsubr (&Sx_window_property);
14368#endif
2d764c78 14369 defsubr (&Sxw_display_color_p);
ee78dc32 14370 defsubr (&Sx_display_grayscale_p);
2d764c78
EZ		 14371 defsubr (&Sxw_color_defined_p);
14372 defsubr (&Sxw_color_values);
ee78dc32
GV		 14373 defsubr (&Sx_server_max_request_size);
14374 defsubr (&Sx_server_vendor);
14375 defsubr (&Sx_server_version);
14376 defsubr (&Sx_display_pixel_width);
14377 defsubr (&Sx_display_pixel_height);
14378 defsubr (&Sx_display_mm_width);
14379 defsubr (&Sx_display_mm_height);
14380 defsubr (&Sx_display_screens);
14381 defsubr (&Sx_display_planes);
14382 defsubr (&Sx_display_color_cells);
14383 defsubr (&Sx_display_visual_class);
14384 defsubr (&Sx_display_backing_store);
14385 defsubr (&Sx_display_save_under);
14386 defsubr (&Sx_parse_geometry);
14387 defsubr (&Sx_create_frame);
ee78dc32
GV		 14388 defsubr (&Sx_open_connection);
14389 defsubr (&Sx_close_connection);
14390 defsubr (&Sx_display_list);
14391 defsubr (&Sx_synchronize);
14392
fbd6baed 14393 /* W32 specific functions */
ee78dc32 14394
1edf84e7 14395 defsubr (&Sw32_focus_frame);
fbd6baed
GV		 14396 defsubr (&Sw32_select_font);
14397 defsubr (&Sw32_define_rgb_color);
14398 defsubr (&Sw32_default_color_map);
14399 defsubr (&Sw32_load_color_file);
1edf84e7 14400 defsubr (&Sw32_send_sys_command);
55dcfc15 14401 defsubr (&Sw32_shell_execute);
ccc2d29c
GV		 14402 defsubr (&Sw32_register_hot_key);
14403 defsubr (&Sw32_unregister_hot_key);
14404 defsubr (&Sw32_registered_hot_keys);
14405 defsubr (&Sw32_reconstruct_hot_key);
adcc3809 14406 defsubr (&Sw32_toggle_lock_key);
33d52f9c 14407 defsubr (&Sw32_find_bdf_fonts);
4587b026 14408
2254bcde
AI		 14409 defsubr (&Sfile_system_info);
14410
4587b026
GV		 14411 /* Setting callback functions for fontset handler. */
14412 get_font_info_func = w32_get_font_info;
6fc2811b
JR		 14413
14414#if 0 /* This function pointer doesn't seem to be used anywhere.
14415 And the pointer assigned has the wrong type, anyway. */
4587b026 14416 list_fonts_func = w32_list_fonts;
6fc2811b
JR		 14417#endif
14418
4587b026
GV		 14419 load_font_func = w32_load_font;
14420 find_ccl_program_func = w32_find_ccl_program;
14421 query_font_func = w32_query_font;
14422 set_frame_fontset_func = x_set_font;
14423 check_window_system_func = check_w32;
6fc2811b 14424
767b1ff0 14425#if 0 /* TODO Image support for W32 */
6fc2811b
JR		 14426 /* Images. */
14427 Qxbm = intern ("xbm");
14428 staticpro (&Qxbm);
14429 QCtype = intern (":type");
14430 staticpro (&QCtype);
a93f4566
GM		 14431 QCconversion = intern (":conversion");
14432 staticpro (&QCconversion);
6fc2811b
JR		 14433 QCheuristic_mask = intern (":heuristic-mask");
14434 staticpro (&QCheuristic_mask);
14435 QCcolor_symbols = intern (":color-symbols");
14436 staticpro (&QCcolor_symbols);
6fc2811b
JR		 14437 QCascent = intern (":ascent");
14438 staticpro (&QCascent);
14439 QCmargin = intern (":margin");
14440 staticpro (&QCmargin);
14441 QCrelief = intern (":relief");
14442 staticpro (&QCrelief);
14443 Qpostscript = intern ("postscript");
14444 staticpro (&Qpostscript);
14445 QCloader = intern (":loader");
14446 staticpro (&QCloader);
14447 QCbounding_box = intern (":bounding-box");
14448 staticpro (&QCbounding_box);
14449 QCpt_width = intern (":pt-width");
14450 staticpro (&QCpt_width);
14451 QCpt_height = intern (":pt-height");
14452 staticpro (&QCpt_height);
14453 QCindex = intern (":index");
14454 staticpro (&QCindex);
14455 Qpbm = intern ("pbm");
14456 staticpro (&Qpbm);
14457
14458#if HAVE_XPM
14459 Qxpm = intern ("xpm");
14460 staticpro (&Qxpm);
14461#endif
14462
14463#if HAVE_JPEG
14464 Qjpeg = intern ("jpeg");
14465 staticpro (&Qjpeg);
14466#endif
14467
14468#if HAVE_TIFF
14469 Qtiff = intern ("tiff");
14470 staticpro (&Qtiff);
14471#endif
14472
14473#if HAVE_GIF
14474 Qgif = intern ("gif");
14475 staticpro (&Qgif);
14476#endif
14477
14478#if HAVE_PNG
14479 Qpng = intern ("png");
14480 staticpro (&Qpng);
14481#endif
14482
14483 defsubr (&Sclear_image_cache);
14484
14485#if GLYPH_DEBUG
14486 defsubr (&Simagep);
14487 defsubr (&Slookup_image);
14488#endif
767b1ff0 14489#endif /* TODO */
6fc2811b 14490
0af913d7
GM		 14491 hourglass_atimer = NULL;
14492 hourglass_shown_p = 0;
767b1ff0 14493#ifdef TODO /* Tooltip support not complete. */
6fc2811b
JR		 14494 defsubr (&Sx_show_tip);
14495 defsubr (&Sx_hide_tip);
767b1ff0 14496#endif
6fc2811b 14497 tip_timer = Qnil;
57fa2774
JR		 14498 staticpro (&tip_timer);
14499 tip_frame = Qnil;
14500 staticpro (&tip_frame);
6fc2811b
JR		 14501
14502 defsubr (&Sx_file_dialog);
14503}
14504
14505
14506void
14507init_xfns ()
14508{
14509 image_types = NULL;
14510 Vimage_types = Qnil;
14511
767b1ff0 14512#if 0 /* TODO : Image support for W32 */
6fc2811b
JR		 14513 define_image_type (&xbm_type);
14514 define_image_type (&gs_type);
14515 define_image_type (&pbm_type);
14516
14517#if HAVE_XPM
14518 define_image_type (&xpm_type);
14519#endif
14520
14521#if HAVE_JPEG
14522 define_image_type (&jpeg_type);
14523#endif
14524
14525#if HAVE_TIFF
14526 define_image_type (&tiff_type);
14527#endif
14528
14529#if HAVE_GIF
14530 define_image_type (&gif_type);
14531#endif
14532
14533#if HAVE_PNG
14534 define_image_type (&png_type);
14535#endif
767b1ff0 14536#endif /* TODO */
ee78dc32
GV		 14537}
14538
14539#undef abort
14540
14541void
fbd6baed 14542w32_abort()
ee78dc32 14543{
5ac45f98
GV		 14544 int button;
14545 button = MessageBox (NULL,
14546 "A fatal error has occurred!\n\n"
14547 "Select Abort to exit, Retry to debug, Ignore to continue",
14548 "Emacs Abort Dialog",
14549 MB_ICONEXCLAMATION | MB_TASKMODAL
14550 | MB_SETFOREGROUND | MB_ABORTRETRYIGNORE);
14551 switch (button)
14552 {
14553 case IDRETRY:
14554 DebugBreak ();
14555 break;
14556 case IDIGNORE:
14557 break;
14558 case IDABORT:
14559 default:
14560 abort ();
14561 break;
14562 }
ee78dc32 14563}
d573caac 14564
83c75055
GV		 14565/* For convenience when debugging. */
14566int
14567w32_last_error()
14568{
14569 return GetLastError ();
14570}
Unnamed repository; edit this file 'description' to name the repository.