HCoop / bpt / emacs.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
*** empty log message ***
[bpt/emacs.git] / src / w32fns.c
CommitLineData
e9e23e23 1/* Graphical user interface functions for the Microsoft W32 API.
a93f4566 2 Copyright (C) 1989, 92, 93, 94, 95, 1996, 1997, 1998, 1999, 2000, 2001
6fc2811b 3 Free Software Foundation, Inc.
ee78dc32
GV		 4
5This file is part of GNU Emacs.
6
7GNU Emacs is free software; you can redistribute it and/or modify
8it under the terms of the GNU General Public License as published by
9the Free Software Foundation; either version 2, or (at your option)
10any later version.
11
12GNU Emacs is distributed in the hope that it will be useful,
13but WITHOUT ANY WARRANTY; without even the implied warranty of
14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15GNU General Public License for more details.
16
17You should have received a copy of the GNU General Public License
18along with GNU Emacs; see the file COPYING. If not, write to
3b7ad313
EN		 19the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20Boston, MA 02111-1307, USA. */
ee78dc32
GV		 21
22/* Added by Kevin Gallo */
23
ee78dc32 24#include <config.h>
1edf84e7
GV		 25
26#include <signal.h>
ee78dc32 27#include <stdio.h>
1edf84e7
GV		 28#include <limits.h>
29#include <errno.h>
ee78dc32
GV		 30
31#include "lisp.h"
4587b026 32#include "charset.h"
71eab8d1 33#include "dispextern.h"
ee78dc32 34#include "w32term.h"
c7501041 35#include "keyboard.h"
ee78dc32
GV		 36#include "frame.h"
37#include "window.h"
38#include "buffer.h"
126f2e35 39#include "fontset.h"
6fc2811b 40#include "intervals.h"
ee78dc32 41#include "blockinput.h"
57bda87a 42#include "epaths.h"
489f9371 43#include "w32heap.h"
ee78dc32 44#include "termhooks.h"
4587b026 45#include "coding.h"
3545439c 46#include "ccl.h"
6fc2811b
JR		 47#include "systime.h"
48
49#include "bitmaps/gray.xbm"
ee78dc32
GV		 50
51#include <commdlg.h>
cb9e33d4 52#include <shellapi.h>
6fc2811b 53#include <ctype.h>
ee78dc32 54
ee78dc32 55extern void free_frame_menubar ();
6fc2811b 56extern double atof ();
adcc3809 57extern int w32_console_toggle_lock_key (int vk_code, Lisp_Object new_state);
5ac45f98 58extern int quit_char;
ee78dc32 59
6fc2811b
JR		 60/* A definition of XColor for non-X frames. */
61#ifndef HAVE_X_WINDOWS
62typedef struct {
63 unsigned long pixel;
64 unsigned short red, green, blue;
65 char flags;
66 char pad;
67} XColor;
68#endif
69
ccc2d29c
GV		 70extern char *lispy_function_keys[];
71
6fc2811b
JR		 72/* The gray bitmap `bitmaps/gray'. This is done because w32term.c uses
73 it, and including `bitmaps/gray' more than once is a problem when
74 config.h defines `static' as an empty replacement string. */
75
76int gray_bitmap_width = gray_width;
77int gray_bitmap_height = gray_height;
78unsigned char *gray_bitmap_bits = gray_bits;
79
ee78dc32 80/* The colormap for converting color names to RGB values */
fbd6baed 81Lisp_Object Vw32_color_map;
ee78dc32 82
da36a4d6 83/* Non nil if alt key presses are passed on to Windows. */
fbd6baed 84Lisp_Object Vw32_pass_alt_to_system;
da36a4d6 85
8c205c63
RS		 86/* Non nil if alt key is translated to meta_modifier, nil if it is translated
87 to alt_modifier. */
fbd6baed 88Lisp_Object Vw32_alt_is_meta;
8c205c63 89
7d081355
AI		 90/* If non-zero, the windows virtual key code for an alternative quit key. */
91Lisp_Object Vw32_quit_key;
92
ccc2d29c
GV		 93/* Non nil if left window key events are passed on to Windows (this only
94 affects whether "tapping" the key opens the Start menu). */
95Lisp_Object Vw32_pass_lwindow_to_system;
96
97/* Non nil if right window key events are passed on to Windows (this
98 only affects whether "tapping" the key opens the Start menu). */
99Lisp_Object Vw32_pass_rwindow_to_system;
100
adcc3809
GV		 101/* Virtual key code used to generate "phantom" key presses in order
102 to stop system from acting on Windows key events. */
103Lisp_Object Vw32_phantom_key_code;
104
ccc2d29c
GV		 105/* Modifier associated with the left "Windows" key, or nil to act as a
106 normal key. */
107Lisp_Object Vw32_lwindow_modifier;
108
109/* Modifier associated with the right "Windows" key, or nil to act as a
110 normal key. */
111Lisp_Object Vw32_rwindow_modifier;
112
113/* Modifier associated with the "Apps" key, or nil to act as a normal
114 key. */
115Lisp_Object Vw32_apps_modifier;
116
117/* Value is nil if Num Lock acts as a function key. */
118Lisp_Object Vw32_enable_num_lock;
119
120/* Value is nil if Caps Lock acts as a function key. */
121Lisp_Object Vw32_enable_caps_lock;
122
123/* Modifier associated with Scroll Lock, or nil to act as a normal key. */
124Lisp_Object Vw32_scroll_lock_modifier;
da36a4d6 125
7ce9aaca 126/* Switch to control whether we inhibit requests for synthesized bold
6fc2811b
JR		 127 and italic versions of fonts. */
128Lisp_Object Vw32_enable_synthesized_fonts;
5ac45f98
GV		 129
130/* Enable palette management. */
fbd6baed 131Lisp_Object Vw32_enable_palette;
5ac45f98
GV		 132
133/* Control how close left/right button down events must be to
134 be converted to a middle button down event. */
fbd6baed 135Lisp_Object Vw32_mouse_button_tolerance;
5ac45f98 136
84fb1139
KH		 137/* Minimum interval between mouse movement (and scroll bar drag)
138 events that are passed on to the event loop. */
fbd6baed 139Lisp_Object Vw32_mouse_move_interval;
84fb1139 140
ee78dc32
GV		 141/* The name we're using in resource queries. */
142Lisp_Object Vx_resource_name;
143
144/* Non nil if no window manager is in use. */
145Lisp_Object Vx_no_window_manager;
146
0af913d7 147/* Non-zero means we're allowed to display a hourglass pointer. */
dfff8a69 148
0af913d7 149int display_hourglass_p;
6fc2811b 150
ee78dc32
GV		 151/* The background and shape of the mouse pointer, and shape when not
152 over text or in the modeline. */
dfff8a69 153
ee78dc32 154Lisp_Object Vx_pointer_shape, Vx_nontext_pointer_shape, Vx_mode_pointer_shape;
0af913d7 155Lisp_Object Vx_hourglass_pointer_shape, Vx_window_horizontal_drag_shape;
6fc2811b 156
ee78dc32 157/* The shape when over mouse-sensitive text. */
dfff8a69 158
ee78dc32
GV		 159Lisp_Object Vx_sensitive_text_pointer_shape;
160
161/* Color of chars displayed in cursor box. */
dfff8a69 162
ee78dc32
GV		 163Lisp_Object Vx_cursor_fore_pixel;
164
1edf84e7 165/* Nonzero if using Windows. */
dfff8a69 166
1edf84e7
GV		 167static int w32_in_use;
168
ee78dc32 169/* Search path for bitmap files. */
dfff8a69 170
ee78dc32
GV		 171Lisp_Object Vx_bitmap_file_path;
172
4587b026 173/* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
dfff8a69 174
4587b026
GV		 175Lisp_Object Vx_pixel_size_width_font_regexp;
176
33d52f9c
GV		 177/* Alist of bdf fonts and the files that define them. */
178Lisp_Object Vw32_bdf_filename_alist;
179
f46e6225
GV		 180Lisp_Object Vw32_system_coding_system;
181
f46e6225 182/* A flag to control whether fonts are matched strictly or not. */
1075afa9
GV		 183int w32_strict_fontnames;
184
c0611964
AI		 185/* A flag to control whether we should only repaint if GetUpdateRect
186 indicates there is an update region. */
187int w32_strict_painting;
188
dfff8a69
JR		 189/* Associative list linking character set strings to Windows codepages. */
190Lisp_Object Vw32_charset_info_alist;
191
192/* VIETNAMESE_CHARSET is not defined in some versions of MSVC. */
193#ifndef VIETNAMESE_CHARSET
194#define VIETNAMESE_CHARSET 163
195#endif
196
ee78dc32
GV		 197Lisp_Object Qauto_raise;
198Lisp_Object Qauto_lower;
ee78dc32
GV		 199Lisp_Object Qbar;
200Lisp_Object Qborder_color;
201Lisp_Object Qborder_width;
202Lisp_Object Qbox;
203Lisp_Object Qcursor_color;
204Lisp_Object Qcursor_type;
ee78dc32
GV		 205Lisp_Object Qgeometry;
206Lisp_Object Qicon_left;
207Lisp_Object Qicon_top;
208Lisp_Object Qicon_type;
209Lisp_Object Qicon_name;
210Lisp_Object Qinternal_border_width;
211Lisp_Object Qleft;
1026b400 212Lisp_Object Qright;
ee78dc32
GV		 213Lisp_Object Qmouse_color;
214Lisp_Object Qnone;
215Lisp_Object Qparent_id;
216Lisp_Object Qscroll_bar_width;
217Lisp_Object Qsuppress_icon;
ee78dc32
GV		 218Lisp_Object Qundefined_color;
219Lisp_Object Qvertical_scroll_bars;
220Lisp_Object Qvisibility;
221Lisp_Object Qwindow_id;
222Lisp_Object Qx_frame_parameter;
223Lisp_Object Qx_resource_name;
224Lisp_Object Quser_position;
225Lisp_Object Quser_size;
6fc2811b 226Lisp_Object Qscreen_gamma;
dfff8a69
JR		 227Lisp_Object Qline_spacing;
228Lisp_Object Qcenter;
dc220243 229Lisp_Object Qcancel_timer;
adcc3809
GV		 230Lisp_Object Qhyper;
231Lisp_Object Qsuper;
232Lisp_Object Qmeta;
233Lisp_Object Qalt;
234Lisp_Object Qctrl;
235Lisp_Object Qcontrol;
236Lisp_Object Qshift;
237
dfff8a69
JR		 238Lisp_Object Qw32_charset_ansi;
239Lisp_Object Qw32_charset_default;
240Lisp_Object Qw32_charset_symbol;
241Lisp_Object Qw32_charset_shiftjis;
767b1ff0 242Lisp_Object Qw32_charset_hangeul;
dfff8a69
JR		 243Lisp_Object Qw32_charset_gb2312;
244Lisp_Object Qw32_charset_chinesebig5;
245Lisp_Object Qw32_charset_oem;
246
71eab8d1
AI		 247#ifndef JOHAB_CHARSET
248#define JOHAB_CHARSET 130
249#endif
dfff8a69
JR		 250#ifdef JOHAB_CHARSET
251Lisp_Object Qw32_charset_easteurope;
252Lisp_Object Qw32_charset_turkish;
253Lisp_Object Qw32_charset_baltic;
254Lisp_Object Qw32_charset_russian;
255Lisp_Object Qw32_charset_arabic;
256Lisp_Object Qw32_charset_greek;
257Lisp_Object Qw32_charset_hebrew;
767b1ff0 258Lisp_Object Qw32_charset_vietnamese;
dfff8a69
JR		 259Lisp_Object Qw32_charset_thai;
260Lisp_Object Qw32_charset_johab;
261Lisp_Object Qw32_charset_mac;
262#endif
263
264#ifdef UNICODE_CHARSET
265Lisp_Object Qw32_charset_unicode;
266#endif
267
6fc2811b
JR		 268extern Lisp_Object Qtop;
269extern Lisp_Object Qdisplay;
270extern Lisp_Object Qtool_bar_lines;
271
5ac45f98
GV		 272/* State variables for emulating a three button mouse. */
273#define LMOUSE 1
274#define MMOUSE 2
275#define RMOUSE 4
276
277static int button_state = 0;
fbd6baed 278static W32Msg saved_mouse_button_msg;
84fb1139 279static unsigned mouse_button_timer; /* non-zero when timer is active */
fbd6baed 280static W32Msg saved_mouse_move_msg;
84fb1139
KH		 281static unsigned mouse_move_timer;
282
93fbe8b7
GV		 283/* W95 mousewheel handler */
284unsigned int msh_mousewheel = 0;
285
84fb1139
KH		 286#define MOUSE_BUTTON_ID 1
287#define MOUSE_MOVE_ID 2
5ac45f98 288
ee78dc32 289/* The below are defined in frame.c. */
dfff8a69 290
ee78dc32 291extern Lisp_Object Qheight, Qminibuffer, Qname, Qonly, Qwidth;
1edf84e7 292extern Lisp_Object Qunsplittable, Qmenu_bar_lines, Qbuffer_predicate, Qtitle;
6fc2811b 293extern Lisp_Object Qtool_bar_lines;
ee78dc32
GV		 294
295extern Lisp_Object Vwindow_system_version;
296
4b817373
RS		 297Lisp_Object Qface_set_after_frame_default;
298
937e601e
AI		 299#ifdef GLYPH_DEBUG
300int image_cache_refcount, dpyinfo_refcount;
301#endif
302
303
fbd6baed
GV		 304/* From w32term.c. */
305extern Lisp_Object Vw32_num_mouse_buttons;
ccc2d29c 306extern Lisp_Object Vw32_recognize_altgr;
5ac45f98 307
65906840
JR		 308extern HWND w32_system_caret_hwnd;
309extern int w32_system_caret_width;
310extern int w32_system_caret_height;
311extern int w32_system_caret_x;
312extern int w32_system_caret_y;
313
ee78dc32 314\f
1edf84e7
GV		 315/* Error if we are not connected to MS-Windows. */
316void
317check_w32 ()
318{
319 if (! w32_in_use)
320 error ("MS-Windows not in use or not initialized");
321}
322
323/* Nonzero if we can use mouse menus.
324 You should not call this unless HAVE_MENUS is defined. */
325
326int
327have_menus_p ()
328{
329 return w32_in_use;
330}
331
ee78dc32 332/* Extract a frame as a FRAME_PTR, defaulting to the selected frame
fbd6baed 333 and checking validity for W32. */
ee78dc32
GV		 334
335FRAME_PTR
336check_x_frame (frame)
337 Lisp_Object frame;
338{
339 FRAME_PTR f;
340
341 if (NILP (frame))
6fc2811b 342 frame = selected_frame;
b7826503 343 CHECK_LIVE_FRAME (frame);
6fc2811b 344 f = XFRAME (frame);
fbd6baed
GV		 345 if (! FRAME_W32_P (f))
346 error ("non-w32 frame used");
ee78dc32
GV		 347 return f;
348}
349
350/* Let the user specify an display with a frame.
fbd6baed 351 nil stands for the selected frame--or, if that is not a w32 frame,
ee78dc32
GV		 352 the first display on the list. */
353
fbd6baed 354static struct w32_display_info *
ee78dc32
GV		 355check_x_display_info (frame)
356 Lisp_Object frame;
357{
358 if (NILP (frame))
359 {
6fc2811b
JR		 360 struct frame *sf = XFRAME (selected_frame);
361
362 if (FRAME_W32_P (sf) && FRAME_LIVE_P (sf))
363 return FRAME_W32_DISPLAY_INFO (sf);
ee78dc32 364 else
fbd6baed 365 return &one_w32_display_info;
ee78dc32
GV		 366 }
367 else if (STRINGP (frame))
368 return x_display_info_for_name (frame);
369 else
370 {
371 FRAME_PTR f;
372
b7826503 373 CHECK_LIVE_FRAME (frame);
ee78dc32 374 f = XFRAME (frame);
fbd6baed
GV		 375 if (! FRAME_W32_P (f))
376 error ("non-w32 frame used");
377 return FRAME_W32_DISPLAY_INFO (f);
ee78dc32
GV		 378 }
379}
380\f
fbd6baed 381/* Return the Emacs frame-object corresponding to an w32 window.
ee78dc32
GV		 382 It could be the frame's main window or an icon window. */
383
384/* This function can be called during GC, so use GC_xxx type test macros. */
385
386struct frame *
387x_window_to_frame (dpyinfo, wdesc)
fbd6baed 388 struct w32_display_info *dpyinfo;
ee78dc32
GV		 389 HWND wdesc;
390{
391 Lisp_Object tail, frame;
392 struct frame *f;
393
8e713be6 394 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
ee78dc32 395 {
8e713be6 396 frame = XCAR (tail);
ee78dc32
GV		 397 if (!GC_FRAMEP (frame))
398 continue;
399 f = XFRAME (frame);
2d764c78 400 if (!FRAME_W32_P (f) || FRAME_W32_DISPLAY_INFO (f) != dpyinfo)
ee78dc32 401 continue;
0af913d7 402 if (f->output_data.w32->hourglass_window == wdesc)
f79e6790
JR		 403 return f;
404
767b1ff0 405 /* TODO: Check tooltips when supported. */
fbd6baed 406 if (FRAME_W32_WINDOW (f) == wdesc)
ee78dc32
GV		 407 return f;
408 }
409 return 0;
410}
411
412\f
413
414/* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
415 id, which is just an int that this section returns. Bitmaps are
416 reference counted so they can be shared among frames.
417
418 Bitmap indices are guaranteed to be > 0, so a negative number can
419 be used to indicate no bitmap.
420
421 If you use x_create_bitmap_from_data, then you must keep track of
422 the bitmaps yourself. That is, creating a bitmap from the same
423 data more than once will not be caught. */
424
425
426/* Functions to access the contents of a bitmap, given an id. */
427
428int
429x_bitmap_height (f, id)
430 FRAME_PTR f;
431 int id;
432{
fbd6baed 433 return FRAME_W32_DISPLAY_INFO (f)->bitmaps[id - 1].height;
ee78dc32
GV		 434}
435
436int
437x_bitmap_width (f, id)
438 FRAME_PTR f;
439 int id;
440{
fbd6baed 441 return FRAME_W32_DISPLAY_INFO (f)->bitmaps[id - 1].width;
ee78dc32
GV		 442}
443
444int
445x_bitmap_pixmap (f, id)
446 FRAME_PTR f;
447 int id;
448{
fbd6baed 449 return (int) FRAME_W32_DISPLAY_INFO (f)->bitmaps[id - 1].pixmap;
ee78dc32
GV		 450}
451
452
453/* Allocate a new bitmap record. Returns index of new record. */
454
455static int
456x_allocate_bitmap_record (f)
457 FRAME_PTR f;
458{
fbd6baed 459 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
ee78dc32
GV		 460 int i;
461
462 if (dpyinfo->bitmaps == NULL)
463 {
464 dpyinfo->bitmaps_size = 10;
465 dpyinfo->bitmaps
fbd6baed 466 = (struct w32_bitmap_record *) xmalloc (dpyinfo->bitmaps_size * sizeof (struct w32_bitmap_record));
ee78dc32
GV		 467 dpyinfo->bitmaps_last = 1;
468 return 1;
469 }
470
471 if (dpyinfo->bitmaps_last < dpyinfo->bitmaps_size)
472 return ++dpyinfo->bitmaps_last;
473
474 for (i = 0; i < dpyinfo->bitmaps_size; ++i)
475 if (dpyinfo->bitmaps[i].refcount == 0)
476 return i + 1;
477
478 dpyinfo->bitmaps_size *= 2;
479 dpyinfo->bitmaps
fbd6baed
GV		 480 = (struct w32_bitmap_record *) xrealloc (dpyinfo->bitmaps,
481 dpyinfo->bitmaps_size * sizeof (struct w32_bitmap_record));
ee78dc32
GV		 482 return ++dpyinfo->bitmaps_last;
483}
484
485/* Add one reference to the reference count of the bitmap with id ID. */
486
487void
488x_reference_bitmap (f, id)
489 FRAME_PTR f;
490 int id;
491{
fbd6baed 492 ++FRAME_W32_DISPLAY_INFO (f)->bitmaps[id - 1].refcount;
ee78dc32
GV		 493}
494
495/* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
496
497int
498x_create_bitmap_from_data (f, bits, width, height)
499 struct frame *f;
500 char *bits;
501 unsigned int width, height;
502{
fbd6baed 503 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
ee78dc32
GV		 504 Pixmap bitmap;
505 int id;
506
507 bitmap = CreateBitmap (width, height,
fbd6baed
GV		 508 FRAME_W32_DISPLAY_INFO (XFRAME (frame))->n_planes,
509 FRAME_W32_DISPLAY_INFO (XFRAME (frame))->n_cbits,
ee78dc32
GV		 510 bits);
511
512 if (! bitmap)
513 return -1;
514
515 id = x_allocate_bitmap_record (f);
516 dpyinfo->bitmaps[id - 1].pixmap = bitmap;
517 dpyinfo->bitmaps[id - 1].file = NULL;
518 dpyinfo->bitmaps[id - 1].hinst = NULL;
519 dpyinfo->bitmaps[id - 1].refcount = 1;
520 dpyinfo->bitmaps[id - 1].depth = 1;
521 dpyinfo->bitmaps[id - 1].height = height;
522 dpyinfo->bitmaps[id - 1].width = width;
523
524 return id;
525}
526
527/* Create bitmap from file FILE for frame F. */
528
529int
530x_create_bitmap_from_file (f, file)
531 struct frame *f;
532 Lisp_Object file;
533{
534 return -1;
767b1ff0 535#if 0 /* TODO : bitmap support */
fbd6baed 536 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
ee78dc32 537 unsigned int width, height;
6fc2811b 538 HBITMAP bitmap;
ee78dc32
GV		 539 int xhot, yhot, result, id;
540 Lisp_Object found;
541 int fd;
542 char *filename;
543 HINSTANCE hinst;
544
545 /* Look for an existing bitmap with the same name. */
546 for (id = 0; id < dpyinfo->bitmaps_last; ++id)
547 {
548 if (dpyinfo->bitmaps[id].refcount
549 && dpyinfo->bitmaps[id].file
550 && !strcmp (dpyinfo->bitmaps[id].file, (char *) XSTRING (file)->data))
551 {
552 ++dpyinfo->bitmaps[id].refcount;
553 return id + 1;
554 }
555 }
556
557 /* Search bitmap-file-path for the file, if appropriate. */
c0ec53ad 558 fd = openp (Vx_bitmap_file_path, file, Qnil, &found, 0);
ee78dc32
GV		 559 if (fd < 0)
560 return -1;
6fc2811b 561 emacs_close (fd);
ee78dc32
GV		 562
563 filename = (char *) XSTRING (found)->data;
564
565 hinst = LoadLibraryEx (filename, NULL, LOAD_LIBRARY_AS_DATAFILE);
566
567 if (hinst == NULL)
568 return -1;
569
570
fbd6baed 571 result = XReadBitmapFile (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
ee78dc32
GV		 572 filename, &width, &height, &bitmap, &xhot, &yhot);
573 if (result != BitmapSuccess)
574 return -1;
575
576 id = x_allocate_bitmap_record (f);
577 dpyinfo->bitmaps[id - 1].pixmap = bitmap;
578 dpyinfo->bitmaps[id - 1].refcount = 1;
579 dpyinfo->bitmaps[id - 1].file = (char *) xmalloc (XSTRING (file)->size + 1);
580 dpyinfo->bitmaps[id - 1].depth = 1;
581 dpyinfo->bitmaps[id - 1].height = height;
582 dpyinfo->bitmaps[id - 1].width = width;
583 strcpy (dpyinfo->bitmaps[id - 1].file, XSTRING (file)->data);
584
585 return id;
767b1ff0 586#endif /* TODO */
ee78dc32
GV		 587}
588
589/* Remove reference to bitmap with id number ID. */
590
33d52f9c 591void
ee78dc32
GV		 592x_destroy_bitmap (f, id)
593 FRAME_PTR f;
594 int id;
595{
fbd6baed 596 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
ee78dc32
GV		 597
598 if (id > 0)
599 {
600 --dpyinfo->bitmaps[id - 1].refcount;
601 if (dpyinfo->bitmaps[id - 1].refcount == 0)
602 {
603 BLOCK_INPUT;
604 DeleteObject (dpyinfo->bitmaps[id - 1].pixmap);
605 if (dpyinfo->bitmaps[id - 1].file)
606 {
6fc2811b 607 xfree (dpyinfo->bitmaps[id - 1].file);
ee78dc32
GV		 608 dpyinfo->bitmaps[id - 1].file = NULL;
609 }
610 UNBLOCK_INPUT;
611 }
612 }
613}
614
615/* Free all the bitmaps for the display specified by DPYINFO. */
616
617static void
618x_destroy_all_bitmaps (dpyinfo)
fbd6baed 619 struct w32_display_info *dpyinfo;
ee78dc32
GV		 620{
621 int i;
622 for (i = 0; i < dpyinfo->bitmaps_last; i++)
623 if (dpyinfo->bitmaps[i].refcount > 0)
624 {
625 DeleteObject (dpyinfo->bitmaps[i].pixmap);
626 if (dpyinfo->bitmaps[i].file)
6fc2811b 627 xfree (dpyinfo->bitmaps[i].file);
ee78dc32
GV		 628 }
629 dpyinfo->bitmaps_last = 0;
630}
631\f
fbd6baed 632/* Connect the frame-parameter names for W32 frames
ee78dc32
GV		 633 to the ways of passing the parameter values to the window system.
634
635 The name of a parameter, as a Lisp symbol,
636 has an `x-frame-parameter' property which is an integer in Lisp
637 but can be interpreted as an `enum x_frame_parm' in C. */
638
639enum x_frame_parm
640{
641 X_PARM_FOREGROUND_COLOR,
642 X_PARM_BACKGROUND_COLOR,
643 X_PARM_MOUSE_COLOR,
644 X_PARM_CURSOR_COLOR,
645 X_PARM_BORDER_COLOR,
646 X_PARM_ICON_TYPE,
647 X_PARM_FONT,
648 X_PARM_BORDER_WIDTH,
649 X_PARM_INTERNAL_BORDER_WIDTH,
650 X_PARM_NAME,
651 X_PARM_AUTORAISE,
652 X_PARM_AUTOLOWER,
653 X_PARM_VERT_SCROLL_BAR,
654 X_PARM_VISIBILITY,
655 X_PARM_MENU_BAR_LINES
656};
657
658
659struct x_frame_parm_table
660{
661 char *name;
6fc2811b 662 void (*setter) P_ ((struct frame *, Lisp_Object, Lisp_Object));
ee78dc32
GV		 663};
664
937e601e
AI		 665static Lisp_Object unwind_create_frame P_ ((Lisp_Object));
666static Lisp_Object unwind_create_tip_frame P_ ((Lisp_Object));
667static void x_change_window_heights P_ ((Lisp_Object, int));
767b1ff0 668/* TODO: Native Input Method support; see x_create_im. */
6fc2811b 669void x_set_foreground_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
dfff8a69 670static void x_set_line_spacing P_ ((struct frame *, Lisp_Object, Lisp_Object));
6fc2811b
JR		 671void x_set_background_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
672void x_set_mouse_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
673void x_set_cursor_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
674void x_set_border_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
675void x_set_cursor_type P_ ((struct frame *, Lisp_Object, Lisp_Object));
676void x_set_icon_type P_ ((struct frame *, Lisp_Object, Lisp_Object));
677void x_set_icon_name P_ ((struct frame *, Lisp_Object, Lisp_Object));
678void x_set_font P_ ((struct frame *, Lisp_Object, Lisp_Object));
679void x_set_border_width P_ ((struct frame *, Lisp_Object, Lisp_Object));
680void x_set_internal_border_width P_ ((struct frame *, Lisp_Object,
681 Lisp_Object));
682void x_explicitly_set_name P_ ((struct frame *, Lisp_Object, Lisp_Object));
683void x_set_autoraise P_ ((struct frame *, Lisp_Object, Lisp_Object));
684void x_set_autolower P_ ((struct frame *, Lisp_Object, Lisp_Object));
685void x_set_vertical_scroll_bars P_ ((struct frame *, Lisp_Object,
686 Lisp_Object));
687void x_set_visibility P_ ((struct frame *, Lisp_Object, Lisp_Object));
688void x_set_menu_bar_lines P_ ((struct frame *, Lisp_Object, Lisp_Object));
689void x_set_scroll_bar_width P_ ((struct frame *, Lisp_Object, Lisp_Object));
690void x_set_title P_ ((struct frame *, Lisp_Object, Lisp_Object));
691void x_set_unsplittable P_ ((struct frame *, Lisp_Object, Lisp_Object));
692void x_set_tool_bar_lines P_ ((struct frame *, Lisp_Object, Lisp_Object));
693static void x_set_screen_gamma P_ ((struct frame *, Lisp_Object, Lisp_Object));
3cf3436e
JR		 694static void x_edge_detection P_ ((struct frame *, struct image *, Lisp_Object,
695 Lisp_Object));
ee78dc32
GV		 696
697static struct x_frame_parm_table x_frame_parms[] =
698{
1edf84e7
GV		 699 "auto-raise", x_set_autoraise,
700 "auto-lower", x_set_autolower,
ee78dc32 701 "background-color", x_set_background_color,
ee78dc32 702 "border-color", x_set_border_color,
1edf84e7
GV		 703 "border-width", x_set_border_width,
704 "cursor-color", x_set_cursor_color,
ee78dc32 705 "cursor-type", x_set_cursor_type,
ee78dc32 706 "font", x_set_font,
1edf84e7
GV		 707 "foreground-color", x_set_foreground_color,
708 "icon-name", x_set_icon_name,
709 "icon-type", x_set_icon_type,
ee78dc32 710 "internal-border-width", x_set_internal_border_width,
ee78dc32 711 "menu-bar-lines", x_set_menu_bar_lines,
1edf84e7
GV		 712 "mouse-color", x_set_mouse_color,
713 "name", x_explicitly_set_name,
ee78dc32 714 "scroll-bar-width", x_set_scroll_bar_width,
1edf84e7 715 "title", x_set_title,
ee78dc32 716 "unsplittable", x_set_unsplittable,
1edf84e7
GV		 717 "vertical-scroll-bars", x_set_vertical_scroll_bars,
718 "visibility", x_set_visibility,
6fc2811b 719 "tool-bar-lines", x_set_tool_bar_lines,
dfff8a69
JR		 720 "screen-gamma", x_set_screen_gamma,
721 "line-spacing", x_set_line_spacing
ee78dc32
GV		 722};
723
724/* Attach the `x-frame-parameter' properties to
fbd6baed 725 the Lisp symbol names of parameters relevant to W32. */
ee78dc32 726
dfff8a69 727void
ee78dc32
GV		 728init_x_parm_symbols ()
729{
730 int i;
731
732 for (i = 0; i < sizeof (x_frame_parms) / sizeof (x_frame_parms[0]); i++)
733 Fput (intern (x_frame_parms[i].name), Qx_frame_parameter,
734 make_number (i));
735}
736\f
dfff8a69 737/* Change the parameters of frame F as specified by ALIST.
ee78dc32
GV		 738 If a parameter is not specially recognized, do nothing;
739 otherwise call the `x_set_...' function for that parameter. */
740
741void
742x_set_frame_parameters (f, alist)
743 FRAME_PTR f;
744 Lisp_Object alist;
745{
746 Lisp_Object tail;
747
748 /* If both of these parameters are present, it's more efficient to
749 set them both at once. So we wait until we've looked at the
750 entire list before we set them. */
b839712d 751 int width, height;
ee78dc32
GV		 752
753 /* Same here. */
754 Lisp_Object left, top;
755
756 /* Same with these. */
757 Lisp_Object icon_left, icon_top;
758
759 /* Record in these vectors all the parms specified. */
760 Lisp_Object *parms;
761 Lisp_Object *values;
a797a73d 762 int i, p;
ee78dc32
GV		 763 int left_no_change = 0, top_no_change = 0;
764 int icon_left_no_change = 0, icon_top_no_change = 0;
765
5878523b
RS		 766 struct gcpro gcpro1, gcpro2;
767
ee78dc32
GV		 768 i = 0;
769 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
770 i++;
771
772 parms = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
773 values = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
774
775 /* Extract parm names and values into those vectors. */
776
777 i = 0;
778 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
779 {
6fc2811b 780 Lisp_Object elt;
ee78dc32
GV		 781
782 elt = Fcar (tail);
783 parms[i] = Fcar (elt);
784 values[i] = Fcdr (elt);
785 i++;
786 }
5878523b
RS		 787 /* TAIL and ALIST are not used again below here. */
788 alist = tail = Qnil;
789
790 GCPRO2 (*parms, *values);
791 gcpro1.nvars = i;
792 gcpro2.nvars = i;
793
794 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
795 because their values appear in VALUES and strings are not valid. */
b839712d 796 top = left = Qunbound;
ee78dc32
GV		 797 icon_left = icon_top = Qunbound;
798
b839712d 799 /* Provide default values for HEIGHT and WIDTH. */
dfff8a69
JR		 800 if (FRAME_NEW_WIDTH (f))
801 width = FRAME_NEW_WIDTH (f);
802 else
803 width = FRAME_WIDTH (f);
804
805 if (FRAME_NEW_HEIGHT (f))
806 height = FRAME_NEW_HEIGHT (f);
807 else
808 height = FRAME_HEIGHT (f);
b839712d 809
a797a73d
GV		 810 /* Process foreground_color and background_color before anything else.
811 They are independent of other properties, but other properties (e.g.,
812 cursor_color) are dependent upon them. */
813 for (p = 0; p < i; p++)
814 {
815 Lisp_Object prop, val;
816
817 prop = parms[p];
818 val = values[p];
819 if (EQ (prop, Qforeground_color) || EQ (prop, Qbackground_color))
820 {
821 register Lisp_Object param_index, old_value;
822
a797a73d 823 old_value = get_frame_param (f, prop);
a05e2bae
JR		 824
825 if (NILP (Fequal (val, old_value)))
826 {
827 store_frame_param (f, prop, val);
828
829 param_index = Fget (prop, Qx_frame_parameter);
830 if (NATNUMP (param_index)
831 && (XFASTINT (param_index)
832 < sizeof (x_frame_parms)/sizeof (x_frame_parms[0])))
833 (*x_frame_parms[XINT (param_index)].setter)(f, val, old_value);
834 }
a797a73d
GV		 835 }
836 }
837
ee78dc32
GV		 838 /* Now process them in reverse of specified order. */
839 for (i--; i >= 0; i--)
840 {
841 Lisp_Object prop, val;
842
843 prop = parms[i];
844 val = values[i];
845
b839712d
RS		 846 if (EQ (prop, Qwidth) && NUMBERP (val))
847 width = XFASTINT (val);
848 else if (EQ (prop, Qheight) && NUMBERP (val))
849 height = XFASTINT (val);
ee78dc32
GV		 850 else if (EQ (prop, Qtop))
851 top = val;
852 else if (EQ (prop, Qleft))
853 left = val;
854 else if (EQ (prop, Qicon_top))
855 icon_top = val;
856 else if (EQ (prop, Qicon_left))
857 icon_left = val;
a797a73d
GV		 858 else if (EQ (prop, Qforeground_color) || EQ (prop, Qbackground_color))
859 /* Processed above. */
860 continue;
ee78dc32
GV		 861 else
862 {
863 register Lisp_Object param_index, old_value;
864
ee78dc32 865 old_value = get_frame_param (f, prop);
a05e2bae 866
ee78dc32 867 store_frame_param (f, prop, val);
a05e2bae
JR		 868
869 param_index = Fget (prop, Qx_frame_parameter);
ee78dc32
GV		 870 if (NATNUMP (param_index)
871 && (XFASTINT (param_index)
872 < sizeof (x_frame_parms)/sizeof (x_frame_parms[0])))
3c190163 873 (*x_frame_parms[XINT (param_index)].setter)(f, val, old_value);
ee78dc32
GV		 874 }
875 }
876
877 /* Don't die if just one of these was set. */
878 if (EQ (left, Qunbound))
879 {
880 left_no_change = 1;
fbd6baed
GV		 881 if (f->output_data.w32->left_pos < 0)
882 left = Fcons (Qplus, Fcons (make_number (f->output_data.w32->left_pos), Qnil));
ee78dc32 883 else
fbd6baed 884 XSETINT (left, f->output_data.w32->left_pos);
ee78dc32
GV		 885 }
886 if (EQ (top, Qunbound))
887 {
888 top_no_change = 1;
fbd6baed
GV		 889 if (f->output_data.w32->top_pos < 0)
890 top = Fcons (Qplus, Fcons (make_number (f->output_data.w32->top_pos), Qnil));
ee78dc32 891 else
fbd6baed 892 XSETINT (top, f->output_data.w32->top_pos);
ee78dc32
GV		 893 }
894
895 /* If one of the icon positions was not set, preserve or default it. */
896 if (EQ (icon_left, Qunbound) || ! INTEGERP (icon_left))
897 {
898 icon_left_no_change = 1;
899 icon_left = Fcdr (Fassq (Qicon_left, f->param_alist));
900 if (NILP (icon_left))
901 XSETINT (icon_left, 0);
902 }
903 if (EQ (icon_top, Qunbound) || ! INTEGERP (icon_top))
904 {
905 icon_top_no_change = 1;
906 icon_top = Fcdr (Fassq (Qicon_top, f->param_alist));
907 if (NILP (icon_top))
908 XSETINT (icon_top, 0);
909 }
910
ee78dc32
GV		 911 /* Don't set these parameters unless they've been explicitly
912 specified. The window might be mapped or resized while we're in
913 this function, and we don't want to override that unless the lisp
914 code has asked for it.
915
916 Don't set these parameters unless they actually differ from the
917 window's current parameters; the window may not actually exist
918 yet. */
919 {
920 Lisp_Object frame;
921
922 check_frame_size (f, &height, &width);
923
924 XSETFRAME (frame, f);
925
dfff8a69
JR		 926 if (width != FRAME_WIDTH (f)
927 || height != FRAME_HEIGHT (f)
928 || FRAME_NEW_HEIGHT (f) || FRAME_NEW_WIDTH (f))
b839712d 929 Fset_frame_size (frame, make_number (width), make_number (height));
ee78dc32
GV		 930
931 if ((!NILP (left) || !NILP (top))
932 && ! (left_no_change && top_no_change)
fbd6baed
GV		 933 && ! (NUMBERP (left) && XINT (left) == f->output_data.w32->left_pos
934 && NUMBERP (top) && XINT (top) == f->output_data.w32->top_pos))
ee78dc32
GV		 935 {
936 int leftpos = 0;
937 int toppos = 0;
938
939 /* Record the signs. */
fbd6baed 940 f->output_data.w32->size_hint_flags &= ~ (XNegative | YNegative);
ee78dc32 941 if (EQ (left, Qminus))
fbd6baed 942 f->output_data.w32->size_hint_flags |= XNegative;
ee78dc32
GV		 943 else if (INTEGERP (left))
944 {
945 leftpos = XINT (left);
946 if (leftpos < 0)
fbd6baed 947 f->output_data.w32->size_hint_flags |= XNegative;
ee78dc32 948 }
8e713be6
KR		 949 else if (CONSP (left) && EQ (XCAR (left), Qminus)
950 && CONSP (XCDR (left))
951 && INTEGERP (XCAR (XCDR (left))))
ee78dc32 952 {
8e713be6 953 leftpos = - XINT (XCAR (XCDR (left)));
fbd6baed 954 f->output_data.w32->size_hint_flags |= XNegative;
ee78dc32 955 }
8e713be6
KR		 956 else if (CONSP (left) && EQ (XCAR (left), Qplus)
957 && CONSP (XCDR (left))
958 && INTEGERP (XCAR (XCDR (left))))
ee78dc32 959 {
8e713be6 960 leftpos = XINT (XCAR (XCDR (left)));
ee78dc32
GV		 961 }
962
963 if (EQ (top, Qminus))
fbd6baed 964 f->output_data.w32->size_hint_flags |= YNegative;
ee78dc32
GV		 965 else if (INTEGERP (top))
966 {
967 toppos = XINT (top);
968 if (toppos < 0)
fbd6baed 969 f->output_data.w32->size_hint_flags |= YNegative;
ee78dc32 970 }
8e713be6
KR		 971 else if (CONSP (top) && EQ (XCAR (top), Qminus)
972 && CONSP (XCDR (top))
973 && INTEGERP (XCAR (XCDR (top))))
ee78dc32 974 {
8e713be6 975 toppos = - XINT (XCAR (XCDR (top)));
fbd6baed 976 f->output_data.w32->size_hint_flags |= YNegative;
ee78dc32 977 }
8e713be6
KR		 978 else if (CONSP (top) && EQ (XCAR (top), Qplus)
979 && CONSP (XCDR (top))
980 && INTEGERP (XCAR (XCDR (top))))
ee78dc32 981 {
8e713be6 982 toppos = XINT (XCAR (XCDR (top)));
ee78dc32
GV		 983 }
984
985
986 /* Store the numeric value of the position. */
fbd6baed
GV		 987 f->output_data.w32->top_pos = toppos;
988 f->output_data.w32->left_pos = leftpos;
ee78dc32 989
fbd6baed 990 f->output_data.w32->win_gravity = NorthWestGravity;
ee78dc32
GV		 991
992 /* Actually set that position, and convert to absolute. */
993 x_set_offset (f, leftpos, toppos, -1);
994 }
995
996 if ((!NILP (icon_left) || !NILP (icon_top))
997 && ! (icon_left_no_change && icon_top_no_change))
998 x_wm_set_icon_position (f, XINT (icon_left), XINT (icon_top));
999 }
5878523b
RS		 1000
1001 UNGCPRO;
ee78dc32
GV		 1002}
1003
1004/* Store the screen positions of frame F into XPTR and YPTR.
1005 These are the positions of the containing window manager window,
1006 not Emacs's own window. */
1007
1008void
1009x_real_positions (f, xptr, yptr)
1010 FRAME_PTR f;
1011 int *xptr, *yptr;
1012{
1013 POINT pt;
3c190163
GV		 1014
1015 {
1016 RECT rect;
ee78dc32 1017
fbd6baed
GV		 1018 GetClientRect(FRAME_W32_WINDOW(f), &rect);
1019 AdjustWindowRect(&rect, f->output_data.w32->dwStyle, FRAME_EXTERNAL_MENU_BAR(f));
ee78dc32 1020
3c190163
GV		 1021 pt.x = rect.left;
1022 pt.y = rect.top;
1023 }
ee78dc32 1024
fbd6baed 1025 ClientToScreen (FRAME_W32_WINDOW(f), &pt);
ee78dc32
GV		 1026
1027 *xptr = pt.x;
1028 *yptr = pt.y;
1029}
1030
1031/* Insert a description of internally-recorded parameters of frame X
1032 into the parameter alist *ALISTPTR that is to be given to the user.
fbd6baed 1033 Only parameters that are specific to W32
ee78dc32
GV		 1034 and whose values are not correctly recorded in the frame's
1035 param_alist need to be considered here. */
1036
dfff8a69 1037void
ee78dc32
GV		 1038x_report_frame_params (f, alistptr)
1039 struct frame *f;
1040 Lisp_Object *alistptr;
1041{
1042 char buf[16];
1043 Lisp_Object tem;
1044
1045 /* Represent negative positions (off the top or left screen edge)
1046 in a way that Fmodify_frame_parameters will understand correctly. */
fbd6baed
GV		 1047 XSETINT (tem, f->output_data.w32->left_pos);
1048 if (f->output_data.w32->left_pos >= 0)
ee78dc32
GV		 1049 store_in_alist (alistptr, Qleft, tem);
1050 else
1051 store_in_alist (alistptr, Qleft, Fcons (Qplus, Fcons (tem, Qnil)));
1052
fbd6baed
GV		 1053 XSETINT (tem, f->output_data.w32->top_pos);
1054 if (f->output_data.w32->top_pos >= 0)
ee78dc32
GV		 1055 store_in_alist (alistptr, Qtop, tem);
1056 else
1057 store_in_alist (alistptr, Qtop, Fcons (Qplus, Fcons (tem, Qnil)));
1058
1059 store_in_alist (alistptr, Qborder_width,
fbd6baed 1060 make_number (f->output_data.w32->border_width));
ee78dc32 1061 store_in_alist (alistptr, Qinternal_border_width,
fbd6baed
GV		 1062 make_number (f->output_data.w32->internal_border_width));
1063 sprintf (buf, "%ld", (long) FRAME_W32_WINDOW (f));
ee78dc32
GV		 1064 store_in_alist (alistptr, Qwindow_id,
1065 build_string (buf));
1066 store_in_alist (alistptr, Qicon_name, f->icon_name);
1067 FRAME_SAMPLE_VISIBILITY (f);
1068 store_in_alist (alistptr, Qvisibility,
1069 (FRAME_VISIBLE_P (f) ? Qt
1070 : FRAME_ICONIFIED_P (f) ? Qicon : Qnil));
1071 store_in_alist (alistptr, Qdisplay,
8e713be6 1072 XCAR (FRAME_W32_DISPLAY_INFO (f)->name_list_element));
ee78dc32
GV		 1073}
1074\f
1075
74e1aeec
JR		 1076DEFUN ("w32-define-rgb-color", Fw32_define_rgb_color,
1077 Sw32_define_rgb_color, 4, 4, 0,
1078 doc: /* Convert RGB numbers to a windows color reference and associate with NAME.
1079This adds or updates a named color to w32-color-map, making it
1080available for use. The original entry's RGB ref is returned, or nil
1081if the entry is new. */)
5ac45f98
GV		 1082 (red, green, blue, name)
1083 Lisp_Object red, green, blue, name;
ee78dc32 1084{
5ac45f98
GV		 1085 Lisp_Object rgb;
1086 Lisp_Object oldrgb = Qnil;
1087 Lisp_Object entry;
1088
b7826503
PJ		 1089 CHECK_NUMBER (red);
1090 CHECK_NUMBER (green);
1091 CHECK_NUMBER (blue);
1092 CHECK_STRING (name);
ee78dc32 1093
5ac45f98 1094 XSET (rgb, Lisp_Int, RGB(XUINT (red), XUINT (green), XUINT (blue)));
ee78dc32 1095
5ac45f98 1096 BLOCK_INPUT;
ee78dc32 1097
fbd6baed
GV		 1098 /* replace existing entry in w32-color-map or add new entry. */
1099 entry = Fassoc (name, Vw32_color_map);
5ac45f98
GV		 1100 if (NILP (entry))
1101 {
1102 entry = Fcons (name, rgb);
fbd6baed 1103 Vw32_color_map = Fcons (entry, Vw32_color_map);
5ac45f98
GV		 1104 }
1105 else
1106 {
1107 oldrgb = Fcdr (entry);
1108 Fsetcdr (entry, rgb);
1109 }
1110
1111 UNBLOCK_INPUT;
1112
1113 return (oldrgb);
ee78dc32
GV		 1114}
1115
74e1aeec
JR		 1116DEFUN ("w32-load-color-file", Fw32_load_color_file,
1117 Sw32_load_color_file, 1, 1, 0,
1118 doc: /* Create an alist of color entries from an external file.
1119Assign this value to w32-color-map to replace the existing color map.
1120
1121The file should define one named RGB color per line like so:
1122 R G B name
1123where R,G,B are numbers between 0 and 255 and name is an arbitrary string. */)
5ac45f98
GV		 1124 (filename)
1125 Lisp_Object filename;
1126{
1127 FILE *fp;
1128 Lisp_Object cmap = Qnil;
1129 Lisp_Object abspath;
1130
b7826503 1131 CHECK_STRING (filename);
5ac45f98
GV		 1132 abspath = Fexpand_file_name (filename, Qnil);
1133
1134 fp = fopen (XSTRING (filename)->data, "rt");
1135 if (fp)
1136 {
1137 char buf[512];
1138 int red, green, blue;
1139 int num;
1140
1141 BLOCK_INPUT;
1142
1143 while (fgets (buf, sizeof (buf), fp) != NULL) {
1144 if (sscanf (buf, "%u %u %u %n", &red, &green, &blue, &num) == 3)
1145 {
1146 char *name = buf + num;
1147 num = strlen (name) - 1;
1148 if (name[num] == '\n')
1149 name[num] = 0;
1150 cmap = Fcons (Fcons (build_string (name),
1151 make_number (RGB (red, green, blue))),
1152 cmap);
1153 }
1154 }
1155 fclose (fp);
1156
1157 UNBLOCK_INPUT;
1158 }
1159
1160 return cmap;
1161}
ee78dc32 1162
fbd6baed 1163/* The default colors for the w32 color map */
ee78dc32
GV		 1164typedef struct colormap_t
1165{
1166 char *name;
1167 COLORREF colorref;
1168} colormap_t;
1169
fbd6baed 1170colormap_t w32_color_map[] =
ee78dc32 1171{
1da8a614
GV		 1172 {"snow" , PALETTERGB (255,250,250)},
1173 {"ghost white" , PALETTERGB (248,248,255)},
1174 {"GhostWhite" , PALETTERGB (248,248,255)},
1175 {"white smoke" , PALETTERGB (245,245,245)},
1176 {"WhiteSmoke" , PALETTERGB (245,245,245)},
1177 {"gainsboro" , PALETTERGB (220,220,220)},
1178 {"floral white" , PALETTERGB (255,250,240)},
1179 {"FloralWhite" , PALETTERGB (255,250,240)},
1180 {"old lace" , PALETTERGB (253,245,230)},
1181 {"OldLace" , PALETTERGB (253,245,230)},
1182 {"linen" , PALETTERGB (250,240,230)},
1183 {"antique white" , PALETTERGB (250,235,215)},
1184 {"AntiqueWhite" , PALETTERGB (250,235,215)},
1185 {"papaya whip" , PALETTERGB (255,239,213)},
1186 {"PapayaWhip" , PALETTERGB (255,239,213)},
1187 {"blanched almond" , PALETTERGB (255,235,205)},
1188 {"BlanchedAlmond" , PALETTERGB (255,235,205)},
1189 {"bisque" , PALETTERGB (255,228,196)},
1190 {"peach puff" , PALETTERGB (255,218,185)},
1191 {"PeachPuff" , PALETTERGB (255,218,185)},
1192 {"navajo white" , PALETTERGB (255,222,173)},
1193 {"NavajoWhite" , PALETTERGB (255,222,173)},
1194 {"moccasin" , PALETTERGB (255,228,181)},
1195 {"cornsilk" , PALETTERGB (255,248,220)},
1196 {"ivory" , PALETTERGB (255,255,240)},
1197 {"lemon chiffon" , PALETTERGB (255,250,205)},
1198 {"LemonChiffon" , PALETTERGB (255,250,205)},
1199 {"seashell" , PALETTERGB (255,245,238)},
1200 {"honeydew" , PALETTERGB (240,255,240)},
1201 {"mint cream" , PALETTERGB (245,255,250)},
1202 {"MintCream" , PALETTERGB (245,255,250)},
1203 {"azure" , PALETTERGB (240,255,255)},
1204 {"alice blue" , PALETTERGB (240,248,255)},
1205 {"AliceBlue" , PALETTERGB (240,248,255)},
1206 {"lavender" , PALETTERGB (230,230,250)},
1207 {"lavender blush" , PALETTERGB (255,240,245)},
1208 {"LavenderBlush" , PALETTERGB (255,240,245)},
1209 {"misty rose" , PALETTERGB (255,228,225)},
1210 {"MistyRose" , PALETTERGB (255,228,225)},
1211 {"white" , PALETTERGB (255,255,255)},
1212 {"black" , PALETTERGB ( 0, 0, 0)},
1213 {"dark slate gray" , PALETTERGB ( 47, 79, 79)},
1214 {"DarkSlateGray" , PALETTERGB ( 47, 79, 79)},
1215 {"dark slate grey" , PALETTERGB ( 47, 79, 79)},
1216 {"DarkSlateGrey" , PALETTERGB ( 47, 79, 79)},
1217 {"dim gray" , PALETTERGB (105,105,105)},
1218 {"DimGray" , PALETTERGB (105,105,105)},
1219 {"dim grey" , PALETTERGB (105,105,105)},
1220 {"DimGrey" , PALETTERGB (105,105,105)},
1221 {"slate gray" , PALETTERGB (112,128,144)},
1222 {"SlateGray" , PALETTERGB (112,128,144)},
1223 {"slate grey" , PALETTERGB (112,128,144)},
1224 {"SlateGrey" , PALETTERGB (112,128,144)},
1225 {"light slate gray" , PALETTERGB (119,136,153)},
1226 {"LightSlateGray" , PALETTERGB (119,136,153)},
1227 {"light slate grey" , PALETTERGB (119,136,153)},
1228 {"LightSlateGrey" , PALETTERGB (119,136,153)},
1229 {"gray" , PALETTERGB (190,190,190)},
1230 {"grey" , PALETTERGB (190,190,190)},
1231 {"light grey" , PALETTERGB (211,211,211)},
1232 {"LightGrey" , PALETTERGB (211,211,211)},
1233 {"light gray" , PALETTERGB (211,211,211)},
1234 {"LightGray" , PALETTERGB (211,211,211)},
1235 {"midnight blue" , PALETTERGB ( 25, 25,112)},
1236 {"MidnightBlue" , PALETTERGB ( 25, 25,112)},
1237 {"navy" , PALETTERGB ( 0, 0,128)},
1238 {"navy blue" , PALETTERGB ( 0, 0,128)},
1239 {"NavyBlue" , PALETTERGB ( 0, 0,128)},
1240 {"cornflower blue" , PALETTERGB (100,149,237)},
1241 {"CornflowerBlue" , PALETTERGB (100,149,237)},
1242 {"dark slate blue" , PALETTERGB ( 72, 61,139)},
1243 {"DarkSlateBlue" , PALETTERGB ( 72, 61,139)},
1244 {"slate blue" , PALETTERGB (106, 90,205)},
1245 {"SlateBlue" , PALETTERGB (106, 90,205)},
1246 {"medium slate blue" , PALETTERGB (123,104,238)},
1247 {"MediumSlateBlue" , PALETTERGB (123,104,238)},
1248 {"light slate blue" , PALETTERGB (132,112,255)},
1249 {"LightSlateBlue" , PALETTERGB (132,112,255)},
1250 {"medium blue" , PALETTERGB ( 0, 0,205)},
1251 {"MediumBlue" , PALETTERGB ( 0, 0,205)},
1252 {"royal blue" , PALETTERGB ( 65,105,225)},
1253 {"RoyalBlue" , PALETTERGB ( 65,105,225)},
1254 {"blue" , PALETTERGB ( 0, 0,255)},
1255 {"dodger blue" , PALETTERGB ( 30,144,255)},
1256 {"DodgerBlue" , PALETTERGB ( 30,144,255)},
1257 {"deep sky blue" , PALETTERGB ( 0,191,255)},
1258 {"DeepSkyBlue" , PALETTERGB ( 0,191,255)},
1259 {"sky blue" , PALETTERGB (135,206,235)},
1260 {"SkyBlue" , PALETTERGB (135,206,235)},
1261 {"light sky blue" , PALETTERGB (135,206,250)},
1262 {"LightSkyBlue" , PALETTERGB (135,206,250)},
1263 {"steel blue" , PALETTERGB ( 70,130,180)},
1264 {"SteelBlue" , PALETTERGB ( 70,130,180)},
1265 {"light steel blue" , PALETTERGB (176,196,222)},
1266 {"LightSteelBlue" , PALETTERGB (176,196,222)},
1267 {"light blue" , PALETTERGB (173,216,230)},
1268 {"LightBlue" , PALETTERGB (173,216,230)},
1269 {"powder blue" , PALETTERGB (176,224,230)},
1270 {"PowderBlue" , PALETTERGB (176,224,230)},
1271 {"pale turquoise" , PALETTERGB (175,238,238)},
1272 {"PaleTurquoise" , PALETTERGB (175,238,238)},
1273 {"dark turquoise" , PALETTERGB ( 0,206,209)},
1274 {"DarkTurquoise" , PALETTERGB ( 0,206,209)},
1275 {"medium turquoise" , PALETTERGB ( 72,209,204)},
1276 {"MediumTurquoise" , PALETTERGB ( 72,209,204)},
1277 {"turquoise" , PALETTERGB ( 64,224,208)},
1278 {"cyan" , PALETTERGB ( 0,255,255)},
1279 {"light cyan" , PALETTERGB (224,255,255)},
1280 {"LightCyan" , PALETTERGB (224,255,255)},
1281 {"cadet blue" , PALETTERGB ( 95,158,160)},
1282 {"CadetBlue" , PALETTERGB ( 95,158,160)},
1283 {"medium aquamarine" , PALETTERGB (102,205,170)},
1284 {"MediumAquamarine" , PALETTERGB (102,205,170)},
1285 {"aquamarine" , PALETTERGB (127,255,212)},
1286 {"dark green" , PALETTERGB ( 0,100, 0)},
1287 {"DarkGreen" , PALETTERGB ( 0,100, 0)},
1288 {"dark olive green" , PALETTERGB ( 85,107, 47)},
1289 {"DarkOliveGreen" , PALETTERGB ( 85,107, 47)},
1290 {"dark sea green" , PALETTERGB (143,188,143)},
1291 {"DarkSeaGreen" , PALETTERGB (143,188,143)},
1292 {"sea green" , PALETTERGB ( 46,139, 87)},
1293 {"SeaGreen" , PALETTERGB ( 46,139, 87)},
1294 {"medium sea green" , PALETTERGB ( 60,179,113)},
1295 {"MediumSeaGreen" , PALETTERGB ( 60,179,113)},
1296 {"light sea green" , PALETTERGB ( 32,178,170)},
1297 {"LightSeaGreen" , PALETTERGB ( 32,178,170)},
1298 {"pale green" , PALETTERGB (152,251,152)},
1299 {"PaleGreen" , PALETTERGB (152,251,152)},
1300 {"spring green" , PALETTERGB ( 0,255,127)},
1301 {"SpringGreen" , PALETTERGB ( 0,255,127)},
1302 {"lawn green" , PALETTERGB (124,252, 0)},
1303 {"LawnGreen" , PALETTERGB (124,252, 0)},
1304 {"green" , PALETTERGB ( 0,255, 0)},
1305 {"chartreuse" , PALETTERGB (127,255, 0)},
1306 {"medium spring green" , PALETTERGB ( 0,250,154)},
1307 {"MediumSpringGreen" , PALETTERGB ( 0,250,154)},
1308 {"green yellow" , PALETTERGB (173,255, 47)},
1309 {"GreenYellow" , PALETTERGB (173,255, 47)},
1310 {"lime green" , PALETTERGB ( 50,205, 50)},
1311 {"LimeGreen" , PALETTERGB ( 50,205, 50)},
1312 {"yellow green" , PALETTERGB (154,205, 50)},
1313 {"YellowGreen" , PALETTERGB (154,205, 50)},
1314 {"forest green" , PALETTERGB ( 34,139, 34)},
1315 {"ForestGreen" , PALETTERGB ( 34,139, 34)},
1316 {"olive drab" , PALETTERGB (107,142, 35)},
1317 {"OliveDrab" , PALETTERGB (107,142, 35)},
1318 {"dark khaki" , PALETTERGB (189,183,107)},
1319 {"DarkKhaki" , PALETTERGB (189,183,107)},
1320 {"khaki" , PALETTERGB (240,230,140)},
1321 {"pale goldenrod" , PALETTERGB (238,232,170)},
1322 {"PaleGoldenrod" , PALETTERGB (238,232,170)},
1323 {"light goldenrod yellow" , PALETTERGB (250,250,210)},
1324 {"LightGoldenrodYellow" , PALETTERGB (250,250,210)},
1325 {"light yellow" , PALETTERGB (255,255,224)},
1326 {"LightYellow" , PALETTERGB (255,255,224)},
1327 {"yellow" , PALETTERGB (255,255, 0)},
1328 {"gold" , PALETTERGB (255,215, 0)},
1329 {"light goldenrod" , PALETTERGB (238,221,130)},
1330 {"LightGoldenrod" , PALETTERGB (238,221,130)},
1331 {"goldenrod" , PALETTERGB (218,165, 32)},
1332 {"dark goldenrod" , PALETTERGB (184,134, 11)},
1333 {"DarkGoldenrod" , PALETTERGB (184,134, 11)},
1334 {"rosy brown" , PALETTERGB (188,143,143)},
1335 {"RosyBrown" , PALETTERGB (188,143,143)},
1336 {"indian red" , PALETTERGB (205, 92, 92)},
1337 {"IndianRed" , PALETTERGB (205, 92, 92)},
1338 {"saddle brown" , PALETTERGB (139, 69, 19)},
1339 {"SaddleBrown" , PALETTERGB (139, 69, 19)},
1340 {"sienna" , PALETTERGB (160, 82, 45)},
1341 {"peru" , PALETTERGB (205,133, 63)},
1342 {"burlywood" , PALETTERGB (222,184,135)},
1343 {"beige" , PALETTERGB (245,245,220)},
1344 {"wheat" , PALETTERGB (245,222,179)},
1345 {"sandy brown" , PALETTERGB (244,164, 96)},
1346 {"SandyBrown" , PALETTERGB (244,164, 96)},
1347 {"tan" , PALETTERGB (210,180,140)},
1348 {"chocolate" , PALETTERGB (210,105, 30)},
1349 {"firebrick" , PALETTERGB (178,34, 34)},
1350 {"brown" , PALETTERGB (165,42, 42)},
1351 {"dark salmon" , PALETTERGB (233,150,122)},
1352 {"DarkSalmon" , PALETTERGB (233,150,122)},
1353 {"salmon" , PALETTERGB (250,128,114)},
1354 {"light salmon" , PALETTERGB (255,160,122)},
1355 {"LightSalmon" , PALETTERGB (255,160,122)},
1356 {"orange" , PALETTERGB (255,165, 0)},
1357 {"dark orange" , PALETTERGB (255,140, 0)},
1358 {"DarkOrange" , PALETTERGB (255,140, 0)},
1359 {"coral" , PALETTERGB (255,127, 80)},
1360 {"light coral" , PALETTERGB (240,128,128)},
1361 {"LightCoral" , PALETTERGB (240,128,128)},
1362 {"tomato" , PALETTERGB (255, 99, 71)},
1363 {"orange red" , PALETTERGB (255, 69, 0)},
1364 {"OrangeRed" , PALETTERGB (255, 69, 0)},
1365 {"red" , PALETTERGB (255, 0, 0)},
1366 {"hot pink" , PALETTERGB (255,105,180)},
1367 {"HotPink" , PALETTERGB (255,105,180)},
1368 {"deep pink" , PALETTERGB (255, 20,147)},
1369 {"DeepPink" , PALETTERGB (255, 20,147)},
1370 {"pink" , PALETTERGB (255,192,203)},
1371 {"light pink" , PALETTERGB (255,182,193)},
1372 {"LightPink" , PALETTERGB (255,182,193)},
1373 {"pale violet red" , PALETTERGB (219,112,147)},
1374 {"PaleVioletRed" , PALETTERGB (219,112,147)},
1375 {"maroon" , PALETTERGB (176, 48, 96)},
1376 {"medium violet red" , PALETTERGB (199, 21,133)},
1377 {"MediumVioletRed" , PALETTERGB (199, 21,133)},
1378 {"violet red" , PALETTERGB (208, 32,144)},
1379 {"VioletRed" , PALETTERGB (208, 32,144)},
1380 {"magenta" , PALETTERGB (255, 0,255)},
1381 {"violet" , PALETTERGB (238,130,238)},
1382 {"plum" , PALETTERGB (221,160,221)},
1383 {"orchid" , PALETTERGB (218,112,214)},
1384 {"medium orchid" , PALETTERGB (186, 85,211)},
1385 {"MediumOrchid" , PALETTERGB (186, 85,211)},
1386 {"dark orchid" , PALETTERGB (153, 50,204)},
1387 {"DarkOrchid" , PALETTERGB (153, 50,204)},
1388 {"dark violet" , PALETTERGB (148, 0,211)},
1389 {"DarkViolet" , PALETTERGB (148, 0,211)},
1390 {"blue violet" , PALETTERGB (138, 43,226)},
1391 {"BlueViolet" , PALETTERGB (138, 43,226)},
1392 {"purple" , PALETTERGB (160, 32,240)},
1393 {"medium purple" , PALETTERGB (147,112,219)},
1394 {"MediumPurple" , PALETTERGB (147,112,219)},
1395 {"thistle" , PALETTERGB (216,191,216)},
1396 {"gray0" , PALETTERGB ( 0, 0, 0)},
1397 {"grey0" , PALETTERGB ( 0, 0, 0)},
1398 {"dark grey" , PALETTERGB (169,169,169)},
1399 {"DarkGrey" , PALETTERGB (169,169,169)},
1400 {"dark gray" , PALETTERGB (169,169,169)},
1401 {"DarkGray" , PALETTERGB (169,169,169)},
1402 {"dark blue" , PALETTERGB ( 0, 0,139)},
1403 {"DarkBlue" , PALETTERGB ( 0, 0,139)},
1404 {"dark cyan" , PALETTERGB ( 0,139,139)},
1405 {"DarkCyan" , PALETTERGB ( 0,139,139)},
1406 {"dark magenta" , PALETTERGB (139, 0,139)},
1407 {"DarkMagenta" , PALETTERGB (139, 0,139)},
1408 {"dark red" , PALETTERGB (139, 0, 0)},
1409 {"DarkRed" , PALETTERGB (139, 0, 0)},
1410 {"light green" , PALETTERGB (144,238,144)},
1411 {"LightGreen" , PALETTERGB (144,238,144)},
ee78dc32
GV		 1412};
1413
fbd6baed 1414DEFUN ("w32-default-color-map", Fw32_default_color_map, Sw32_default_color_map,
74e1aeec 1415 0, 0, 0, doc: /* Return the default color map. */)
ee78dc32
GV		 1416 ()
1417{
1418 int i;
fbd6baed 1419 colormap_t *pc = w32_color_map;
ee78dc32
GV		 1420 Lisp_Object cmap;
1421
1422 BLOCK_INPUT;
1423
1424 cmap = Qnil;
1425
fbd6baed 1426 for (i = 0; i < sizeof (w32_color_map) / sizeof (w32_color_map[0]);
ee78dc32
GV		 1427 pc++, i++)
1428 cmap = Fcons (Fcons (build_string (pc->name),
1429 make_number (pc->colorref)),
1430 cmap);
1431
1432 UNBLOCK_INPUT;
1433
1434 return (cmap);
1435}
ee78dc32
GV		 1436
1437Lisp_Object
fbd6baed 1438w32_to_x_color (rgb)
ee78dc32
GV		 1439 Lisp_Object rgb;
1440{
1441 Lisp_Object color;
1442
b7826503 1443 CHECK_NUMBER (rgb);
ee78dc32
GV		 1444
1445 BLOCK_INPUT;
1446
fbd6baed 1447 color = Frassq (rgb, Vw32_color_map);
ee78dc32
GV		 1448
1449 UNBLOCK_INPUT;
1450
1451 if (!NILP (color))
1452 return (Fcar (color));
1453 else
1454 return Qnil;
1455}
1456
5d7fed93
GV		 1457COLORREF
1458w32_color_map_lookup (colorname)
1459 char *colorname;
1460{
1461 Lisp_Object tail, ret = Qnil;
1462
1463 BLOCK_INPUT;
1464
1465 for (tail = Vw32_color_map; !NILP (tail); tail = Fcdr (tail))
1466 {
1467 register Lisp_Object elt, tem;
1468
1469 elt = Fcar (tail);
1470 if (!CONSP (elt)) continue;
1471
1472 tem = Fcar (elt);
1473
1474 if (lstrcmpi (XSTRING (tem)->data, colorname) == 0)
1475 {
1476 ret = XUINT (Fcdr (elt));
1477 break;
1478 }
1479
1480 QUIT;
1481 }
1482
1483
1484 UNBLOCK_INPUT;
1485
1486 return ret;
1487}
1488
ee78dc32 1489COLORREF
fbd6baed 1490x_to_w32_color (colorname)
ee78dc32
GV		 1491 char * colorname;
1492{
8edb0a6f
JR		 1493 register Lisp_Object ret = Qnil;
1494
ee78dc32 1495 BLOCK_INPUT;
1edf84e7
GV		 1496
1497 if (colorname[0] == '#')
1498 {
1499 /* Could be an old-style RGB Device specification. */
1500 char *color;
1501 int size;
1502 color = colorname + 1;
1503
1504 size = strlen(color);
1505 if (size == 3 || size == 6 || size == 9 || size == 12)
1506 {
1507 UINT colorval;
1508 int i, pos;
1509 pos = 0;
1510 size /= 3;
1511 colorval = 0;
1512
1513 for (i = 0; i < 3; i++)
1514 {
1515 char *end;
1516 char t;
1517 unsigned long value;
1518
1519 /* The check for 'x' in the following conditional takes into
1520 account the fact that strtol allows a "0x" in front of
1521 our numbers, and we don't. */
1522 if (!isxdigit(color[0]) || color[1] == 'x')
1523 break;
1524 t = color[size];
1525 color[size] = '\0';
1526 value = strtoul(color, &end, 16);
1527 color[size] = t;
1528 if (errno == ERANGE || end - color != size)
1529 break;
1530 switch (size)
1531 {
1532 case 1:
1533 value = value * 0x10;
1534 break;
1535 case 2:
1536 break;
1537 case 3:
1538 value /= 0x10;
1539 break;
1540 case 4:
1541 value /= 0x100;
1542 break;
1543 }
1544 colorval |= (value << pos);
1545 pos += 0x8;
1546 if (i == 2)
1547 {
1548 UNBLOCK_INPUT;
1549 return (colorval);
1550 }
1551 color = end;
1552 }
1553 }
1554 }
1555 else if (strnicmp(colorname, "rgb:", 4) == 0)
1556 {
1557 char *color;
1558 UINT colorval;
1559 int i, pos;
1560 pos = 0;
1561
1562 colorval = 0;
1563 color = colorname + 4;
1564 for (i = 0; i < 3; i++)
1565 {
1566 char *end;
1567 unsigned long value;
1568
1569 /* The check for 'x' in the following conditional takes into
1570 account the fact that strtol allows a "0x" in front of
1571 our numbers, and we don't. */
1572 if (!isxdigit(color[0]) || color[1] == 'x')
1573 break;
1574 value = strtoul(color, &end, 16);
1575 if (errno == ERANGE)
1576 break;
1577 switch (end - color)
1578 {
1579 case 1:
1580 value = value * 0x10 + value;
1581 break;
1582 case 2:
1583 break;
1584 case 3:
1585 value /= 0x10;
1586 break;
1587 case 4:
1588 value /= 0x100;
1589 break;
1590 default:
1591 value = ULONG_MAX;
1592 }
1593 if (value == ULONG_MAX)
1594 break;
1595 colorval |= (value << pos);
1596 pos += 0x8;
1597 if (i == 2)
1598 {
1599 if (*end != '\0')
1600 break;
1601 UNBLOCK_INPUT;
1602 return (colorval);
1603 }
1604 if (*end != '/')
1605 break;
1606 color = end + 1;
1607 }
1608 }
1609 else if (strnicmp(colorname, "rgbi:", 5) == 0)
1610 {
1611 /* This is an RGB Intensity specification. */
1612 char *color;
1613 UINT colorval;
1614 int i, pos;
1615 pos = 0;
1616
1617 colorval = 0;
1618 color = colorname + 5;
1619 for (i = 0; i < 3; i++)
1620 {
1621 char *end;
1622 double value;
1623 UINT val;
1624
1625 value = strtod(color, &end);
1626 if (errno == ERANGE)
1627 break;
1628 if (value < 0.0 || value > 1.0)
1629 break;
1630 val = (UINT)(0x100 * value);
1631 /* We used 0x100 instead of 0xFF to give an continuous
1632 range between 0.0 and 1.0 inclusive. The next statement
1633 fixes the 1.0 case. */
1634 if (val == 0x100)
1635 val = 0xFF;
1636 colorval |= (val << pos);
1637 pos += 0x8;
1638 if (i == 2)
1639 {
1640 if (*end != '\0')
1641 break;
1642 UNBLOCK_INPUT;
1643 return (colorval);
1644 }
1645 if (*end != '/')
1646 break;
1647 color = end + 1;
1648 }
1649 }
1650 /* I am not going to attempt to handle any of the CIE color schemes
1651 or TekHVC, since I don't know the algorithms for conversion to
1652 RGB. */
f695b4b1
GV		 1653
1654 /* If we fail to lookup the color name in w32_color_map, then check the
1655 colorname to see if it can be crudely approximated: If the X color
1656 ends in a number (e.g., "darkseagreen2"), strip the number and
1657 return the result of looking up the base color name. */
1658 ret = w32_color_map_lookup (colorname);
1659 if (NILP (ret))
ee78dc32 1660 {
f695b4b1 1661 int len = strlen (colorname);
ee78dc32 1662
f695b4b1
GV		 1663 if (isdigit (colorname[len - 1]))
1664 {
8b77111c 1665 char *ptr, *approx = alloca (len + 1);
ee78dc32 1666
f695b4b1
GV		 1667 strcpy (approx, colorname);
1668 ptr = &approx[len - 1];
1669 while (ptr > approx && isdigit (*ptr))
1670 *ptr-- = '\0';
ee78dc32 1671
f695b4b1 1672 ret = w32_color_map_lookup (approx);
ee78dc32 1673 }
ee78dc32
GV		 1674 }
1675
1676 UNBLOCK_INPUT;
ee78dc32
GV		 1677 return ret;
1678}
1679
5ac45f98
GV		 1680
1681void
fbd6baed 1682w32_regenerate_palette (FRAME_PTR f)
5ac45f98 1683{
fbd6baed 1684 struct w32_palette_entry * list;
5ac45f98
GV		 1685 LOGPALETTE * log_palette;
1686 HPALETTE new_palette;
1687 int i;
1688
1689 /* don't bother trying to create palette if not supported */
fbd6baed 1690 if (! FRAME_W32_DISPLAY_INFO (f)->has_palette)
5ac45f98
GV		 1691 return;
1692
1693 log_palette = (LOGPALETTE *)
1694 alloca (sizeof (LOGPALETTE) +
fbd6baed 1695 FRAME_W32_DISPLAY_INFO (f)->num_colors * sizeof (PALETTEENTRY));
5ac45f98 1696 log_palette->palVersion = 0x300;
fbd6baed 1697 log_palette->palNumEntries = FRAME_W32_DISPLAY_INFO (f)->num_colors;
5ac45f98 1698
fbd6baed 1699 list = FRAME_W32_DISPLAY_INFO (f)->color_list;
5ac45f98 1700 for (i = 0;
fbd6baed 1701 i < FRAME_W32_DISPLAY_INFO (f)->num_colors;
5ac45f98
GV		 1702 i++, list = list->next)
1703 log_palette->palPalEntry[i] = list->entry;
1704
1705 new_palette = CreatePalette (log_palette);
1706
1707 enter_crit ();
1708
fbd6baed
GV		 1709 if (FRAME_W32_DISPLAY_INFO (f)->palette)
1710 DeleteObject (FRAME_W32_DISPLAY_INFO (f)->palette);
1711 FRAME_W32_DISPLAY_INFO (f)->palette = new_palette;
5ac45f98
GV		 1712
1713 /* Realize display palette and garbage all frames. */
1714 release_frame_dc (f, get_frame_dc (f));
1715
1716 leave_crit ();
1717}
1718
fbd6baed
GV		 1719#define W32_COLOR(pe) RGB (pe.peRed, pe.peGreen, pe.peBlue)
1720#define SET_W32_COLOR(pe, color) \
5ac45f98
GV		 1721 do \
1722 { \
1723 pe.peRed = GetRValue (color); \
1724 pe.peGreen = GetGValue (color); \
1725 pe.peBlue = GetBValue (color); \
1726 pe.peFlags = 0; \
1727 } while (0)
1728
1729#if 0
1730/* Keep these around in case we ever want to track color usage. */
1731void
fbd6baed 1732w32_map_color (FRAME_PTR f, COLORREF color)
5ac45f98 1733{
fbd6baed 1734 struct w32_palette_entry * list = FRAME_W32_DISPLAY_INFO (f)->color_list;
5ac45f98 1735
fbd6baed 1736 if (NILP (Vw32_enable_palette))
5ac45f98
GV		 1737 return;
1738
1739 /* check if color is already mapped */
1740 while (list)
1741 {
fbd6baed 1742 if (W32_COLOR (list->entry) == color)
5ac45f98
GV		 1743 {
1744 ++list->refcount;
1745 return;
1746 }
1747 list = list->next;
1748 }
1749
1750 /* not already mapped, so add to list and recreate Windows palette */
fbd6baed
GV		 1751 list = (struct w32_palette_entry *)
1752 xmalloc (sizeof (struct w32_palette_entry));
1753 SET_W32_COLOR (list->entry, color);
5ac45f98 1754 list->refcount = 1;
fbd6baed
GV		 1755 list->next = FRAME_W32_DISPLAY_INFO (f)->color_list;
1756 FRAME_W32_DISPLAY_INFO (f)->color_list = list;
1757 FRAME_W32_DISPLAY_INFO (f)->num_colors++;
5ac45f98
GV		 1758
1759 /* set flag that palette must be regenerated */
fbd6baed 1760 FRAME_W32_DISPLAY_INFO (f)->regen_palette = TRUE;
5ac45f98
GV		 1761}
1762
1763void
fbd6baed 1764w32_unmap_color (FRAME_PTR f, COLORREF color)
5ac45f98 1765{
fbd6baed
GV		 1766 struct w32_palette_entry * list = FRAME_W32_DISPLAY_INFO (f)->color_list;
1767 struct w32_palette_entry **prev = &FRAME_W32_DISPLAY_INFO (f)->color_list;
5ac45f98 1768
fbd6baed 1769 if (NILP (Vw32_enable_palette))
5ac45f98
GV		 1770 return;
1771
1772 /* check if color is already mapped */
1773 while (list)
1774 {
fbd6baed 1775 if (W32_COLOR (list->entry) == color)
5ac45f98
GV		 1776 {
1777 if (--list->refcount == 0)
1778 {
1779 *prev = list->next;
1780 xfree (list);
fbd6baed 1781 FRAME_W32_DISPLAY_INFO (f)->num_colors--;
5ac45f98
GV		 1782 break;
1783 }
1784 else
1785 return;
1786 }
1787 prev = &list->next;
1788 list = list->next;
1789 }
1790
1791 /* set flag that palette must be regenerated */
fbd6baed 1792 FRAME_W32_DISPLAY_INFO (f)->regen_palette = TRUE;
5ac45f98
GV		 1793}
1794#endif
1795
6fc2811b
JR		 1796
1797/* Gamma-correct COLOR on frame F. */
1798
1799void
1800gamma_correct (f, color)
1801 struct frame *f;
1802 COLORREF *color;
1803{
1804 if (f->gamma)
1805 {
1806 *color = PALETTERGB (
1807 pow (GetRValue (*color) / 255.0, f->gamma) * 255.0 + 0.5,
1808 pow (GetGValue (*color) / 255.0, f->gamma) * 255.0 + 0.5,
1809 pow (GetBValue (*color) / 255.0, f->gamma) * 255.0 + 0.5);
1810 }
1811}
1812
1813
ee78dc32
GV		 1814/* Decide if color named COLOR is valid for the display associated with
1815 the selected frame; if so, return the rgb values in COLOR_DEF.
1816 If ALLOC is nonzero, allocate a new colormap cell. */
1817
1818int
6fc2811b 1819w32_defined_color (f, color, color_def, alloc)
ee78dc32
GV		 1820 FRAME_PTR f;
1821 char *color;
6fc2811b 1822 XColor *color_def;
ee78dc32
GV		 1823 int alloc;
1824{
1825 register Lisp_Object tem;
6fc2811b 1826 COLORREF w32_color_ref;
3c190163 1827
fbd6baed 1828 tem = x_to_w32_color (color);
3c190163 1829
ee78dc32
GV		 1830 if (!NILP (tem))
1831 {
d88c567c
JR		 1832 if (f)
1833 {
1834 /* Apply gamma correction. */
1835 w32_color_ref = XUINT (tem);
1836 gamma_correct (f, &w32_color_ref);
1837 XSETINT (tem, w32_color_ref);
1838 }
9badad41
JR		 1839
1840 /* Map this color to the palette if it is enabled. */
fbd6baed 1841 if (!NILP (Vw32_enable_palette))
5ac45f98 1842 {
fbd6baed 1843 struct w32_palette_entry * entry =
d88c567c 1844 one_w32_display_info.color_list;
fbd6baed 1845 struct w32_palette_entry ** prev =
d88c567c 1846 &one_w32_display_info.color_list;
5ac45f98
GV		 1847
1848 /* check if color is already mapped */
1849 while (entry)
1850 {
fbd6baed 1851 if (W32_COLOR (entry->entry) == XUINT (tem))
5ac45f98
GV		 1852 break;
1853 prev = &entry->next;
1854 entry = entry->next;
1855 }
1856
1857 if (entry == NULL && alloc)
1858 {
1859 /* not already mapped, so add to list */
fbd6baed
GV		 1860 entry = (struct w32_palette_entry *)
1861 xmalloc (sizeof (struct w32_palette_entry));
1862 SET_W32_COLOR (entry->entry, XUINT (tem));
5ac45f98
GV		 1863 entry->next = NULL;
1864 *prev = entry;
d88c567c 1865 one_w32_display_info.num_colors++;
5ac45f98
GV		 1866
1867 /* set flag that palette must be regenerated */
d88c567c 1868 one_w32_display_info.regen_palette = TRUE;
5ac45f98
GV		 1869 }
1870 }
1871 /* Ensure COLORREF value is snapped to nearest color in (default)
1872 palette by simulating the PALETTERGB macro. This works whether
1873 or not the display device has a palette. */
6fc2811b
JR		 1874 w32_color_ref = XUINT (tem) | 0x2000000;
1875
6fc2811b
JR		 1876 color_def->pixel = w32_color_ref;
1877 color_def->red = GetRValue (w32_color_ref);
1878 color_def->green = GetGValue (w32_color_ref);
1879 color_def->blue = GetBValue (w32_color_ref);
1880
ee78dc32 1881 return 1;
5ac45f98 1882 }
7fb46567 1883 else
3c190163
GV		 1884 {
1885 return 0;
1886 }
ee78dc32
GV		 1887}
1888
1889/* Given a string ARG naming a color, compute a pixel value from it
1890 suitable for screen F.
1891 If F is not a color screen, return DEF (default) regardless of what
1892 ARG says. */
1893
1894int
1895x_decode_color (f, arg, def)
1896 FRAME_PTR f;
1897 Lisp_Object arg;
1898 int def;
1899{
6fc2811b 1900 XColor cdef;
ee78dc32 1901
b7826503 1902 CHECK_STRING (arg);
ee78dc32
GV		 1903
1904 if (strcmp (XSTRING (arg)->data, "black") == 0)
1905 return BLACK_PIX_DEFAULT (f);
1906 else if (strcmp (XSTRING (arg)->data, "white") == 0)
1907 return WHITE_PIX_DEFAULT (f);
1908
fbd6baed 1909 if ((FRAME_W32_DISPLAY_INFO (f)->n_planes * FRAME_W32_DISPLAY_INFO (f)->n_cbits) == 1)
ee78dc32
GV		 1910 return def;
1911
6fc2811b 1912 /* w32_defined_color is responsible for coping with failures
ee78dc32 1913 by looking for a near-miss. */
6fc2811b
JR		 1914 if (w32_defined_color (f, XSTRING (arg)->data, &cdef, 1))
1915 return cdef.pixel;
ee78dc32
GV		 1916
1917 /* defined_color failed; return an ultimate default. */
1918 return def;
1919}
1920\f
dfff8a69
JR		 1921/* Change the `line-spacing' frame parameter of frame F. OLD_VALUE is
1922 the previous value of that parameter, NEW_VALUE is the new value. */
1923
1924static void
1925x_set_line_spacing (f, new_value, old_value)
1926 struct frame *f;
1927 Lisp_Object new_value, old_value;
1928{
1929 if (NILP (new_value))
1930 f->extra_line_spacing = 0;
1931 else if (NATNUMP (new_value))
1932 f->extra_line_spacing = XFASTINT (new_value);
1933 else
1a948b17 1934 Fsignal (Qerror, Fcons (build_string ("Invalid line-spacing"),
dfff8a69
JR		 1935 Fcons (new_value, Qnil)));
1936 if (FRAME_VISIBLE_P (f))
1937 redraw_frame (f);
1938}
1939
1940
6fc2811b
JR		 1941/* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
1942 the previous value of that parameter, NEW_VALUE is the new value. */
1943
1944static void
1945x_set_screen_gamma (f, new_value, old_value)
1946 struct frame *f;
1947 Lisp_Object new_value, old_value;
1948{
1949 if (NILP (new_value))
1950 f->gamma = 0;
1951 else if (NUMBERP (new_value) && XFLOATINT (new_value) > 0)
1952 /* The value 0.4545 is the normal viewing gamma. */
1953 f->gamma = 1.0 / (0.4545 * XFLOATINT (new_value));
1954 else
1a948b17 1955 Fsignal (Qerror, Fcons (build_string ("Invalid screen-gamma"),
6fc2811b
JR		 1956 Fcons (new_value, Qnil)));
1957
1958 clear_face_cache (0);
1959}
1960
1961
ee78dc32
GV		 1962/* Functions called only from `x_set_frame_param'
1963 to set individual parameters.
1964
fbd6baed 1965 If FRAME_W32_WINDOW (f) is 0,
ee78dc32
GV		 1966 the frame is being created and its window does not exist yet.
1967 In that case, just record the parameter's new value
1968 in the standard place; do not attempt to change the window. */
1969
1970void
1971x_set_foreground_color (f, arg, oldval)
1972 struct frame *f;
1973 Lisp_Object arg, oldval;
1974{
3cf3436e
JR		 1975 struct w32_output *x = f->output_data.w32;
1976 PIX_TYPE fg, old_fg;
1977
1978 fg = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1979 old_fg = FRAME_FOREGROUND_PIXEL (f);
1980 FRAME_FOREGROUND_PIXEL (f) = fg;
5ac45f98 1981
fbd6baed 1982 if (FRAME_W32_WINDOW (f) != 0)
ee78dc32 1983 {
3cf3436e
JR		 1984 if (x->cursor_pixel == old_fg)
1985 x->cursor_pixel = fg;
1986
6fc2811b 1987 update_face_from_frame_parameter (f, Qforeground_color, arg);
ee78dc32
GV		 1988 if (FRAME_VISIBLE_P (f))
1989 redraw_frame (f);
1990 }
1991}
1992
1993void
1994x_set_background_color (f, arg, oldval)
1995 struct frame *f;
1996 Lisp_Object arg, oldval;
1997{
6fc2811b 1998 FRAME_BACKGROUND_PIXEL (f)
ee78dc32
GV		 1999 = x_decode_color (f, arg, WHITE_PIX_DEFAULT (f));
2000
fbd6baed 2001 if (FRAME_W32_WINDOW (f) != 0)
ee78dc32 2002 {
6fc2811b
JR		 2003 SetWindowLong (FRAME_W32_WINDOW (f), WND_BACKGROUND_INDEX,
2004 FRAME_BACKGROUND_PIXEL (f));
ee78dc32 2005
6fc2811b 2006 update_face_from_frame_parameter (f, Qbackground_color, arg);
ee78dc32
GV		 2007
2008 if (FRAME_VISIBLE_P (f))
2009 redraw_frame (f);
2010 }
2011}
2012
2013void
2014x_set_mouse_color (f, arg, oldval)
2015 struct frame *f;
2016 Lisp_Object arg, oldval;
2017{
ee78dc32 2018 Cursor cursor, nontext_cursor, mode_cursor, cross_cursor;
dfc465d3 2019 int count;
ee78dc32
GV		 2020 int mask_color;
2021
2022 if (!EQ (Qnil, arg))
fbd6baed 2023 f->output_data.w32->mouse_pixel
ee78dc32 2024 = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
6fc2811b
JR		 2025 mask_color = FRAME_BACKGROUND_PIXEL (f);
2026
2027 /* Don't let pointers be invisible. */
fbd6baed 2028 if (mask_color == f->output_data.w32->mouse_pixel
6fc2811b
JR		 2029 && mask_color == FRAME_BACKGROUND_PIXEL (f))
2030 f->output_data.w32->mouse_pixel = FRAME_FOREGROUND_PIXEL (f);
ee78dc32 2031
767b1ff0 2032#if 0 /* TODO : cursor changes */
ee78dc32
GV		 2033 BLOCK_INPUT;
2034
2035 /* It's not okay to crash if the user selects a screwy cursor. */
fadca6c6 2036 count = x_catch_errors (FRAME_W32_DISPLAY (f));
ee78dc32
GV		 2037
2038 if (!EQ (Qnil, Vx_pointer_shape))
2039 {
b7826503 2040 CHECK_NUMBER (Vx_pointer_shape);
fbd6baed 2041 cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XINT (Vx_pointer_shape));
ee78dc32
GV		 2042 }
2043 else
fbd6baed
GV		 2044 cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_xterm);
2045 x_check_errors (FRAME_W32_DISPLAY (f), "bad text pointer cursor: %s");
ee78dc32
GV		 2046
2047 if (!EQ (Qnil, Vx_nontext_pointer_shape))
2048 {
b7826503 2049 CHECK_NUMBER (Vx_nontext_pointer_shape);
fbd6baed 2050 nontext_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f),
ee78dc32
GV		 2051 XINT (Vx_nontext_pointer_shape));
2052 }
2053 else
fbd6baed
GV		 2054 nontext_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_left_ptr);
2055 x_check_errors (FRAME_W32_DISPLAY (f), "bad nontext pointer cursor: %s");
ee78dc32 2056
0af913d7 2057 if (!EQ (Qnil, Vx_hourglass_pointer_shape))
6fc2811b 2058 {
b7826503 2059 CHECK_NUMBER (Vx_hourglass_pointer_shape);
0af913d7
GM		 2060 hourglass_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f),
2061 XINT (Vx_hourglass_pointer_shape));
6fc2811b
JR		 2062 }
2063 else
0af913d7 2064 hourglass_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_watch);
6fc2811b
JR		 2065 x_check_errors (FRAME_W32_DISPLAY (f), "bad busy pointer cursor: %s");
2066
2067 x_check_errors (FRAME_W32_DISPLAY (f), "bad nontext pointer cursor: %s");
ee78dc32
GV		 2068 if (!EQ (Qnil, Vx_mode_pointer_shape))
2069 {
b7826503 2070 CHECK_NUMBER (Vx_mode_pointer_shape);
fbd6baed 2071 mode_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f),
ee78dc32
GV		 2072 XINT (Vx_mode_pointer_shape));
2073 }
2074 else
fbd6baed
GV		 2075 mode_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_xterm);
2076 x_check_errors (FRAME_W32_DISPLAY (f), "bad modeline pointer cursor: %s");
ee78dc32
GV		 2077
2078 if (!EQ (Qnil, Vx_sensitive_text_pointer_shape))
2079 {
b7826503 2080 CHECK_NUMBER (Vx_sensitive_text_pointer_shape);
ee78dc32 2081 cross_cursor
fbd6baed 2082 = XCreateFontCursor (FRAME_W32_DISPLAY (f),
ee78dc32
GV		 2083 XINT (Vx_sensitive_text_pointer_shape));
2084 }
2085 else
fbd6baed 2086 cross_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_crosshair);
ee78dc32 2087
4694d762
JR		 2088 if (!NILP (Vx_window_horizontal_drag_shape))
2089 {
b7826503 2090 CHECK_NUMBER (Vx_window_horizontal_drag_shape);
4694d762
JR		 2091 horizontal_drag_cursor
2092 = XCreateFontCursor (FRAME_X_DISPLAY (f),
2093 XINT (Vx_window_horizontal_drag_shape));
2094 }
2095 else
2096 horizontal_drag_cursor
2097 = XCreateFontCursor (FRAME_X_DISPLAY (f), XC_sb_h_double_arrow);
2098
ee78dc32 2099 /* Check and report errors with the above calls. */
fbd6baed 2100 x_check_errors (FRAME_W32_DISPLAY (f), "can't set cursor shape: %s");
fadca6c6 2101 x_uncatch_errors (FRAME_W32_DISPLAY (f), count);
ee78dc32
GV		 2102
2103 {
2104 XColor fore_color, back_color;
2105
fbd6baed 2106 fore_color.pixel = f->output_data.w32->mouse_pixel;
ee78dc32 2107 back_color.pixel = mask_color;
fbd6baed
GV		 2108 XQueryColor (FRAME_W32_DISPLAY (f),
2109 DefaultColormap (FRAME_W32_DISPLAY (f),
2110 DefaultScreen (FRAME_W32_DISPLAY (f))),
ee78dc32 2111 &fore_color);
fbd6baed
GV		 2112 XQueryColor (FRAME_W32_DISPLAY (f),
2113 DefaultColormap (FRAME_W32_DISPLAY (f),
2114 DefaultScreen (FRAME_W32_DISPLAY (f))),
ee78dc32 2115 &back_color);
fbd6baed 2116 XRecolorCursor (FRAME_W32_DISPLAY (f), cursor,
ee78dc32 2117 &fore_color, &back_color);
fbd6baed 2118 XRecolorCursor (FRAME_W32_DISPLAY (f), nontext_cursor,
ee78dc32 2119 &fore_color, &back_color);
fbd6baed 2120 XRecolorCursor (FRAME_W32_DISPLAY (f), mode_cursor,
ee78dc32 2121 &fore_color, &back_color);
fbd6baed 2122 XRecolorCursor (FRAME_W32_DISPLAY (f), cross_cursor,
ee78dc32 2123 &fore_color, &back_color);
0af913d7 2124 XRecolorCursor (FRAME_W32_DISPLAY (f), hourglass_cursor,
6fc2811b 2125 &fore_color, &back_color);
ee78dc32
GV		 2126 }
2127
fbd6baed 2128 if (FRAME_W32_WINDOW (f) != 0)
6fc2811b 2129 XDefineCursor (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f), cursor);
ee78dc32 2130
fbd6baed
GV		 2131 if (cursor != f->output_data.w32->text_cursor && f->output_data.w32->text_cursor != 0)
2132 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->text_cursor);
2133 f->output_data.w32->text_cursor = cursor;
2134
2135 if (nontext_cursor != f->output_data.w32->nontext_cursor
2136 && f->output_data.w32->nontext_cursor != 0)
2137 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->nontext_cursor);
2138 f->output_data.w32->nontext_cursor = nontext_cursor;
2139
0af913d7
GM		 2140 if (hourglass_cursor != f->output_data.w32->hourglass_cursor
2141 && f->output_data.w32->hourglass_cursor != 0)
2142 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->hourglass_cursor);
2143 f->output_data.w32->hourglass_cursor = hourglass_cursor;
6fc2811b 2144
fbd6baed
GV		 2145 if (mode_cursor != f->output_data.w32->modeline_cursor
2146 && f->output_data.w32->modeline_cursor != 0)
2147 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->modeline_cursor);
2148 f->output_data.w32->modeline_cursor = mode_cursor;
6fc2811b 2149
fbd6baed
GV		 2150 if (cross_cursor != f->output_data.w32->cross_cursor
2151 && f->output_data.w32->cross_cursor != 0)
2152 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->cross_cursor);
2153 f->output_data.w32->cross_cursor = cross_cursor;
2154
2155 XFlush (FRAME_W32_DISPLAY (f));
ee78dc32 2156 UNBLOCK_INPUT;
6fc2811b
JR		 2157
2158 update_face_from_frame_parameter (f, Qmouse_color, arg);
767b1ff0 2159#endif /* TODO */
ee78dc32
GV		 2160}
2161
70a0239a
JR		 2162/* Defined in w32term.c. */
2163void x_update_cursor (struct frame *f, int on_p);
2164
ee78dc32
GV		 2165void
2166x_set_cursor_color (f, arg, oldval)
2167 struct frame *f;
2168 Lisp_Object arg, oldval;
2169{
70a0239a 2170 unsigned long fore_pixel, pixel;
ee78dc32 2171
dfff8a69 2172 if (!NILP (Vx_cursor_fore_pixel))
ee78dc32 2173 fore_pixel = x_decode_color (f, Vx_cursor_fore_pixel,
70a0239a 2174 WHITE_PIX_DEFAULT (f));
ee78dc32 2175 else
6fc2811b 2176 fore_pixel = FRAME_BACKGROUND_PIXEL (f);
70a0239a 2177
6759f872 2178 pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
ee78dc32
GV		 2179
2180 /* Make sure that the cursor color differs from the background color. */
70a0239a 2181 if (pixel == FRAME_BACKGROUND_PIXEL (f))
ee78dc32 2182 {
70a0239a
JR		 2183 pixel = f->output_data.w32->mouse_pixel;
2184 if (pixel == fore_pixel)
6fc2811b 2185 fore_pixel = FRAME_BACKGROUND_PIXEL (f);
ee78dc32 2186 }
70a0239a 2187
6fc2811b 2188 FRAME_FOREGROUND_PIXEL (f) = fore_pixel;
70a0239a 2189 f->output_data.w32->cursor_pixel = pixel;
ee78dc32 2190
fbd6baed 2191 if (FRAME_W32_WINDOW (f) != 0)
ee78dc32
GV		 2192 {
2193 if (FRAME_VISIBLE_P (f))
2194 {
70a0239a
JR		 2195 x_update_cursor (f, 0);
2196 x_update_cursor (f, 1);
ee78dc32
GV		 2197 }
2198 }
6fc2811b
JR		 2199
2200 update_face_from_frame_parameter (f, Qcursor_color, arg);
ee78dc32
GV		 2201}
2202
33d52f9c
GV		 2203/* Set the border-color of frame F to pixel value PIX.
2204 Note that this does not fully take effect if done before
2205 F has an window. */
2206void
2207x_set_border_pixel (f, pix)
2208 struct frame *f;
2209 int pix;
2210{
2211 f->output_data.w32->border_pixel = pix;
2212
2213 if (FRAME_W32_WINDOW (f) != 0 && f->output_data.w32->border_width > 0)
2214 {
2215 if (FRAME_VISIBLE_P (f))
2216 redraw_frame (f);
2217 }
2218}
2219
ee78dc32
GV		 2220/* Set the border-color of frame F to value described by ARG.
2221 ARG can be a string naming a color.
2222 The border-color is used for the border that is drawn by the server.
2223 Note that this does not fully take effect if done before
2224 F has a window; it must be redone when the window is created. */
2225
2226void
2227x_set_border_color (f, arg, oldval)
2228 struct frame *f;
2229 Lisp_Object arg, oldval;
2230{
ee78dc32
GV		 2231 int pix;
2232
b7826503 2233 CHECK_STRING (arg);
ee78dc32 2234 pix = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
ee78dc32 2235 x_set_border_pixel (f, pix);
6fc2811b 2236 update_face_from_frame_parameter (f, Qborder_color, arg);
ee78dc32
GV		 2237}
2238
dfff8a69
JR		 2239/* Value is the internal representation of the specified cursor type
2240 ARG. If type is BAR_CURSOR, return in *WIDTH the specified width
2241 of the bar cursor. */
2242
2243enum text_cursor_kinds
2244x_specified_cursor_type (arg, width)
2245 Lisp_Object arg;
2246 int *width;
ee78dc32 2247{
dfff8a69
JR		 2248 enum text_cursor_kinds type;
2249
ee78dc32
GV		 2250 if (EQ (arg, Qbar))
2251 {
dfff8a69
JR		 2252 type = BAR_CURSOR;
2253 *width = 2;
ee78dc32 2254 }
dfff8a69
JR		 2255 else if (CONSP (arg)
2256 && EQ (XCAR (arg), Qbar)
2257 && INTEGERP (XCDR (arg))
2258 && XINT (XCDR (arg)) >= 0)
ee78dc32 2259 {
dfff8a69
JR		 2260 type = BAR_CURSOR;
2261 *width = XINT (XCDR (arg));
ee78dc32 2262 }
dfff8a69
JR		 2263 else if (NILP (arg))
2264 type = NO_CURSOR;
ee78dc32
GV		 2265 else
2266 /* Treat anything unknown as "box cursor".
2267 It was bad to signal an error; people have trouble fixing
2268 .Xdefaults with Emacs, when it has something bad in it. */
dfff8a69
JR		 2269 type = FILLED_BOX_CURSOR;
2270
2271 return type;
2272}
2273
2274void
2275x_set_cursor_type (f, arg, oldval)
2276 FRAME_PTR f;
2277 Lisp_Object arg, oldval;
2278{
2279 int width;
2280
2281 FRAME_DESIRED_CURSOR (f) = x_specified_cursor_type (arg, &width);
2282 f->output_data.w32->cursor_width = width;
ee78dc32
GV		 2283
2284 /* Make sure the cursor gets redrawn. This is overkill, but how
2285 often do people change cursor types? */
2286 update_mode_lines++;
2287}
dfff8a69 2288\f
ee78dc32
GV		 2289void
2290x_set_icon_type (f, arg, oldval)
2291 struct frame *f;
2292 Lisp_Object arg, oldval;
2293{
ee78dc32
GV		 2294 int result;
2295
eb7576ce
GV		 2296 if (NILP (arg) && NILP (oldval))
2297 return;
2298
2299 if (STRINGP (arg) && STRINGP (oldval)
2300 && EQ (Fstring_equal (oldval, arg), Qt))
2301 return;
2302
2303 if (SYMBOLP (arg) && SYMBOLP (oldval) && EQ (arg, oldval))
ee78dc32
GV		 2304 return;
2305
2306 BLOCK_INPUT;
ee78dc32 2307
eb7576ce 2308 result = x_bitmap_icon (f, arg);
ee78dc32
GV		 2309 if (result)
2310 {
2311 UNBLOCK_INPUT;
2312 error ("No icon window available");
2313 }
2314
ee78dc32 2315 UNBLOCK_INPUT;
ee78dc32
GV		 2316}
2317
2318/* Return non-nil if frame F wants a bitmap icon. */
2319
2320Lisp_Object
2321x_icon_type (f)
2322 FRAME_PTR f;
2323{
2324 Lisp_Object tem;
2325
2326 tem = assq_no_quit (Qicon_type, f->param_alist);
2327 if (CONSP (tem))
8e713be6 2328 return XCDR (tem);
ee78dc32
GV		 2329 else
2330 return Qnil;
2331}
2332
2333void
2334x_set_icon_name (f, arg, oldval)
2335 struct frame *f;
2336 Lisp_Object arg, oldval;
2337{
ee78dc32
GV		 2338 if (STRINGP (arg))
2339 {
2340 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
2341 return;
2342 }
2343 else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
2344 return;
2345
2346 f->icon_name = arg;
2347
2348#if 0
fbd6baed 2349 if (f->output_data.w32->icon_bitmap != 0)
ee78dc32
GV		 2350 return;
2351
2352 BLOCK_INPUT;
2353
2354 result = x_text_icon (f,
1edf84e7 2355 (char *) XSTRING ((!NILP (f->icon_name)
ee78dc32 2356 ? f->icon_name
1edf84e7
GV		 2357 : !NILP (f->title)
2358 ? f->title
ee78dc32
GV		 2359 : f->name))->data);
2360
2361 if (result)
2362 {
2363 UNBLOCK_INPUT;
2364 error ("No icon window available");
2365 }
2366
2367 /* If the window was unmapped (and its icon was mapped),
2368 the new icon is not mapped, so map the window in its stead. */
2369 if (FRAME_VISIBLE_P (f))
2370 {
2371#ifdef USE_X_TOOLKIT
fbd6baed 2372 XtPopup (f->output_data.w32->widget, XtGrabNone);
ee78dc32 2373#endif
fbd6baed 2374 XMapWindow (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f));
ee78dc32
GV		 2375 }
2376
fbd6baed 2377 XFlush (FRAME_W32_DISPLAY (f));
ee78dc32
GV		 2378 UNBLOCK_INPUT;
2379#endif
2380}
2381
2382extern Lisp_Object x_new_font ();
4587b026 2383extern Lisp_Object x_new_fontset();
ee78dc32
GV		 2384
2385void
2386x_set_font (f, arg, oldval)
2387 struct frame *f;
2388 Lisp_Object arg, oldval;
2389{
2390 Lisp_Object result;
4587b026 2391 Lisp_Object fontset_name;
4b817373 2392 Lisp_Object frame;
3cf3436e 2393 int old_fontset = FRAME_FONTSET(f);
ee78dc32 2394
b7826503 2395 CHECK_STRING (arg);
ee78dc32 2396
4587b026
GV		 2397 fontset_name = Fquery_fontset (arg, Qnil);
2398
ee78dc32 2399 BLOCK_INPUT;
4587b026
GV		 2400 result = (STRINGP (fontset_name)
2401 ? x_new_fontset (f, XSTRING (fontset_name)->data)
2402 : x_new_font (f, XSTRING (arg)->data));
ee78dc32
GV		 2403 UNBLOCK_INPUT;
2404
2405 if (EQ (result, Qnil))
dfff8a69 2406 error ("Font `%s' is not defined", XSTRING (arg)->data);
ee78dc32 2407 else if (EQ (result, Qt))
dfff8a69 2408 error ("The characters of the given font have varying widths");
ee78dc32
GV		 2409 else if (STRINGP (result))
2410 {
3cf3436e
JR		 2411 if (STRINGP (fontset_name))
2412 {
2413 /* Fontset names are built from ASCII font names, so the
2414 names may be equal despite there was a change. */
2415 if (old_fontset == FRAME_FONTSET (f))
2416 return;
2417 }
2418 else if (!NILP (Fequal (result, oldval)))
dc220243 2419 return;
3cf3436e 2420
ee78dc32 2421 store_frame_param (f, Qfont, result);
6fc2811b 2422 recompute_basic_faces (f);
ee78dc32
GV		 2423 }
2424 else
2425 abort ();
4b817373 2426
6fc2811b
JR		 2427 do_pending_window_change (0);
2428
2429 /* Don't call `face-set-after-frame-default' when faces haven't been
2430 initialized yet. This is the case when called from
2431 Fx_create_frame. In that case, the X widget or window doesn't
2432 exist either, and we can end up in x_report_frame_params with a
2433 null widget which gives a segfault. */
2434 if (FRAME_FACE_CACHE (f))
2435 {
2436 XSETFRAME (frame, f);
2437 call1 (Qface_set_after_frame_default, frame);
2438 }
ee78dc32
GV		 2439}
2440
2441void
2442x_set_border_width (f, arg, oldval)
2443 struct frame *f;
2444 Lisp_Object arg, oldval;
2445{
b7826503 2446 CHECK_NUMBER (arg);
ee78dc32 2447
fbd6baed 2448 if (XINT (arg) == f->output_data.w32->border_width)
ee78dc32
GV		 2449 return;
2450
fbd6baed 2451 if (FRAME_W32_WINDOW (f) != 0)
ee78dc32
GV		 2452 error ("Cannot change the border width of a window");
2453
fbd6baed 2454 f->output_data.w32->border_width = XINT (arg);
ee78dc32
GV		 2455}
2456
2457void
2458x_set_internal_border_width (f, arg, oldval)
2459 struct frame *f;
2460 Lisp_Object arg, oldval;
2461{
fbd6baed 2462 int old = f->output_data.w32->internal_border_width;
ee78dc32 2463
b7826503 2464 CHECK_NUMBER (arg);
fbd6baed
GV		 2465 f->output_data.w32->internal_border_width = XINT (arg);
2466 if (f->output_data.w32->internal_border_width < 0)
2467 f->output_data.w32->internal_border_width = 0;
ee78dc32 2468
fbd6baed 2469 if (f->output_data.w32->internal_border_width == old)
ee78dc32
GV		 2470 return;
2471
fbd6baed 2472 if (FRAME_W32_WINDOW (f) != 0)
ee78dc32 2473 {
ee78dc32 2474 x_set_window_size (f, 0, f->width, f->height);
ee78dc32 2475 SET_FRAME_GARBAGED (f);
6fc2811b 2476 do_pending_window_change (0);
ee78dc32 2477 }
a05e2bae
JR		 2478 else
2479 SET_FRAME_GARBAGED (f);
ee78dc32
GV		 2480}
2481
2482void
2483x_set_visibility (f, value, oldval)
2484 struct frame *f;
2485 Lisp_Object value, oldval;
2486{
2487 Lisp_Object frame;
2488 XSETFRAME (frame, f);
2489
2490 if (NILP (value))
2491 Fmake_frame_invisible (frame, Qt);
2492 else if (EQ (value, Qicon))
2493 Ficonify_frame (frame);
2494 else
2495 Fmake_frame_visible (frame);
2496}
2497
a1258667
JR		 2498\f
2499/* Change window heights in windows rooted in WINDOW by N lines. */
2500
2501static void
2502x_change_window_heights (window, n)
2503 Lisp_Object window;
2504 int n;
2505{
2506 struct window *w = XWINDOW (window);
2507
2508 XSETFASTINT (w->top, XFASTINT (w->top) + n);
2509 XSETFASTINT (w->height, XFASTINT (w->height) - n);
2510
2511 if (INTEGERP (w->orig_top))
2512 XSETFASTINT (w->orig_top, XFASTINT (w->orig_top) + n);
2513 if (INTEGERP (w->orig_height))
2514 XSETFASTINT (w->orig_height, XFASTINT (w->orig_height) - n);
2515
2516 /* Handle just the top child in a vertical split. */
2517 if (!NILP (w->vchild))
2518 x_change_window_heights (w->vchild, n);
2519
2520 /* Adjust all children in a horizontal split. */
2521 for (window = w->hchild; !NILP (window); window = w->next)
2522 {
2523 w = XWINDOW (window);
2524 x_change_window_heights (window, n);
2525 }
2526}
2527
ee78dc32
GV		 2528void
2529x_set_menu_bar_lines (f, value, oldval)
2530 struct frame *f;
2531 Lisp_Object value, oldval;
2532{
2533 int nlines;
2534 int olines = FRAME_MENU_BAR_LINES (f);
2535
2536 /* Right now, menu bars don't work properly in minibuf-only frames;
2537 most of the commands try to apply themselves to the minibuffer
6fc2811b 2538 frame itself, and get an error because you can't switch buffers
ee78dc32
GV		 2539 in or split the minibuffer window. */
2540 if (FRAME_MINIBUF_ONLY_P (f))
2541 return;
2542
2543 if (INTEGERP (value))
2544 nlines = XINT (value);
2545 else
2546 nlines = 0;
2547
2548 FRAME_MENU_BAR_LINES (f) = 0;
2549 if (nlines)
2550 FRAME_EXTERNAL_MENU_BAR (f) = 1;
2551 else
2552 {
2553 if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
2554 free_frame_menubar (f);
2555 FRAME_EXTERNAL_MENU_BAR (f) = 0;
1edf84e7
GV		 2556
2557 /* Adjust the frame size so that the client (text) dimensions
2558 remain the same. This depends on FRAME_EXTERNAL_MENU_BAR being
2559 set correctly. */
2560 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
6fc2811b 2561 do_pending_window_change (0);
ee78dc32 2562 }
6fc2811b
JR		 2563 adjust_glyphs (f);
2564}
2565
2566
2567/* Set the number of lines used for the tool bar of frame F to VALUE.
2568 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
2569 is the old number of tool bar lines. This function changes the
2570 height of all windows on frame F to match the new tool bar height.
2571 The frame's height doesn't change. */
2572
2573void
2574x_set_tool_bar_lines (f, value, oldval)
2575 struct frame *f;
2576 Lisp_Object value, oldval;
2577{
36f8209a
JR		 2578 int delta, nlines, root_height;
2579 Lisp_Object root_window;
6fc2811b 2580
dc220243
JR		 2581 /* Treat tool bars like menu bars. */
2582 if (FRAME_MINIBUF_ONLY_P (f))
2583 return;
2584
6fc2811b
JR		 2585 /* Use VALUE only if an integer >= 0. */
2586 if (INTEGERP (value) && XINT (value) >= 0)
2587 nlines = XFASTINT (value);
2588 else
2589 nlines = 0;
2590
2591 /* Make sure we redisplay all windows in this frame. */
2592 ++windows_or_buffers_changed;
2593
2594 delta = nlines - FRAME_TOOL_BAR_LINES (f);
36f8209a
JR		 2595
2596 /* Don't resize the tool-bar to more than we have room for. */
2597 root_window = FRAME_ROOT_WINDOW (f);
2598 root_height = XINT (XWINDOW (root_window)->height);
2599 if (root_height - delta < 1)
2600 {
2601 delta = root_height - 1;
2602 nlines = FRAME_TOOL_BAR_LINES (f) + delta;
2603 }
2604
6fc2811b 2605 FRAME_TOOL_BAR_LINES (f) = nlines;
36f8209a 2606 x_change_window_heights (root_window, delta);
6fc2811b 2607 adjust_glyphs (f);
36f8209a
JR		 2608
2609 /* We also have to make sure that the internal border at the top of
2610 the frame, below the menu bar or tool bar, is redrawn when the
2611 tool bar disappears. This is so because the internal border is
2612 below the tool bar if one is displayed, but is below the menu bar
2613 if there isn't a tool bar. The tool bar draws into the area
2614 below the menu bar. */
2615 if (FRAME_W32_WINDOW (f) && FRAME_TOOL_BAR_LINES (f) == 0)
2616 {
2617 updating_frame = f;
2618 clear_frame ();
2619 clear_current_matrices (f);
2620 updating_frame = NULL;
2621 }
2622
2623 /* If the tool bar gets smaller, the internal border below it
2624 has to be cleared. It was formerly part of the display
2625 of the larger tool bar, and updating windows won't clear it. */
2626 if (delta < 0)
2627 {
2628 int height = FRAME_INTERNAL_BORDER_WIDTH (f);
2629 int width = PIXEL_WIDTH (f);
2630 int y = nlines * CANON_Y_UNIT (f);
2631
2632 BLOCK_INPUT;
2633 {
2634 HDC hdc = get_frame_dc (f);
2635 w32_clear_area (f, hdc, 0, y, width, height);
2636 release_frame_dc (f, hdc);
2637 }
2638 UNBLOCK_INPUT;
3cf3436e
JR		 2639
2640 if (WINDOWP (f->tool_bar_window))
2641 clear_glyph_matrix (XWINDOW (f->tool_bar_window)->current_matrix);
36f8209a 2642 }
ee78dc32
GV		 2643}
2644
6fc2811b 2645
ee78dc32 2646/* Change the name of frame F to NAME. If NAME is nil, set F's name to
fbd6baed 2647 w32_id_name.
ee78dc32
GV		 2648
2649 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2650 name; if NAME is a string, set F's name to NAME and set
2651 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2652
2653 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2654 suggesting a new name, which lisp code should override; if
2655 F->explicit_name is set, ignore the new name; otherwise, set it. */
2656
2657void
2658x_set_name (f, name, explicit)
2659 struct frame *f;
2660 Lisp_Object name;
2661 int explicit;
2662{
2663 /* Make sure that requests from lisp code override requests from
2664 Emacs redisplay code. */
2665 if (explicit)
2666 {
2667 /* If we're switching from explicit to implicit, we had better
2668 update the mode lines and thereby update the title. */
2669 if (f->explicit_name && NILP (name))
2670 update_mode_lines = 1;
2671
2672 f->explicit_name = ! NILP (name);
2673 }
2674 else if (f->explicit_name)
2675 return;
2676
fbd6baed 2677 /* If NAME is nil, set the name to the w32_id_name. */
ee78dc32
GV		 2678 if (NILP (name))
2679 {
2680 /* Check for no change needed in this very common case
2681 before we do any consing. */
fbd6baed 2682 if (!strcmp (FRAME_W32_DISPLAY_INFO (f)->w32_id_name,
ee78dc32
GV		 2683 XSTRING (f->name)->data))
2684 return;
fbd6baed 2685 name = build_string (FRAME_W32_DISPLAY_INFO (f)->w32_id_name);
ee78dc32
GV		 2686 }
2687 else
b7826503 2688 CHECK_STRING (name);
ee78dc32
GV		 2689
2690 /* Don't change the name if it's already NAME. */
2691 if (! NILP (Fstring_equal (name, f->name)))
2692 return;
2693
1edf84e7
GV		 2694 f->name = name;
2695
2696 /* For setting the frame title, the title parameter should override
2697 the name parameter. */
2698 if (! NILP (f->title))
2699 name = f->title;
2700
fbd6baed 2701 if (FRAME_W32_WINDOW (f))
ee78dc32 2702 {
6fc2811b 2703 if (STRING_MULTIBYTE (name))
dfff8a69 2704 name = ENCODE_SYSTEM (name);
6fc2811b 2705
ee78dc32 2706 BLOCK_INPUT;
fbd6baed 2707 SetWindowText(FRAME_W32_WINDOW (f), XSTRING (name)->data);
ee78dc32
GV		 2708 UNBLOCK_INPUT;
2709 }
ee78dc32
GV		 2710}
2711
2712/* This function should be called when the user's lisp code has
2713 specified a name for the frame; the name will override any set by the
2714 redisplay code. */
2715void
2716x_explicitly_set_name (f, arg, oldval)
2717 FRAME_PTR f;
2718 Lisp_Object arg, oldval;
2719{
2720 x_set_name (f, arg, 1);
2721}
2722
2723/* This function should be called by Emacs redisplay code to set the
2724 name; names set this way will never override names set by the user's
2725 lisp code. */
2726void
2727x_implicitly_set_name (f, arg, oldval)
2728 FRAME_PTR f;
2729 Lisp_Object arg, oldval;
2730{
2731 x_set_name (f, arg, 0);
2732}
1edf84e7
GV		 2733\f
2734/* Change the title of frame F to NAME.
2735 If NAME is nil, use the frame name as the title.
2736
2737 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2738 name; if NAME is a string, set F's name to NAME and set
2739 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2740
2741 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2742 suggesting a new name, which lisp code should override; if
2743 F->explicit_name is set, ignore the new name; otherwise, set it. */
ee78dc32 2744
1edf84e7 2745void
6fc2811b 2746x_set_title (f, name, old_name)
1edf84e7 2747 struct frame *f;
6fc2811b 2748 Lisp_Object name, old_name;
1edf84e7
GV		 2749{
2750 /* Don't change the title if it's already NAME. */
2751 if (EQ (name, f->title))
2752 return;
2753
2754 update_mode_lines = 1;
2755
2756 f->title = name;
2757
2758 if (NILP (name))
2759 name = f->name;
2760
2761 if (FRAME_W32_WINDOW (f))
2762 {
6fc2811b 2763 if (STRING_MULTIBYTE (name))
dfff8a69 2764 name = ENCODE_SYSTEM (name);
6fc2811b 2765
1edf84e7
GV		 2766 BLOCK_INPUT;
2767 SetWindowText(FRAME_W32_WINDOW (f), XSTRING (name)->data);
2768 UNBLOCK_INPUT;
2769 }
2770}
2771\f
ee78dc32
GV		 2772void
2773x_set_autoraise (f, arg, oldval)
2774 struct frame *f;
2775 Lisp_Object arg, oldval;
2776{
2777 f->auto_raise = !EQ (Qnil, arg);
2778}
2779
2780void
2781x_set_autolower (f, arg, oldval)
2782 struct frame *f;
2783 Lisp_Object arg, oldval;
2784{
2785 f->auto_lower = !EQ (Qnil, arg);
2786}
2787
2788void
2789x_set_unsplittable (f, arg, oldval)
2790 struct frame *f;
2791 Lisp_Object arg, oldval;
2792{
2793 f->no_split = !NILP (arg);
2794}
2795
2796void
2797x_set_vertical_scroll_bars (f, arg, oldval)
2798 struct frame *f;
2799 Lisp_Object arg, oldval;
2800{
1026b400
RS		 2801 if ((EQ (arg, Qleft) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f))
2802 || (EQ (arg, Qright) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f))
2803 || (NILP (arg) && FRAME_HAS_VERTICAL_SCROLL_BARS (f))
2804 || (!NILP (arg) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f)))
ee78dc32 2805 {
1026b400
RS		 2806 FRAME_VERTICAL_SCROLL_BAR_TYPE (f) = NILP (arg) ?
2807 vertical_scroll_bar_none :
87996783
GV		 2808 /* Put scroll bars on the right by default, as is conventional
2809 on MS-Windows. */
2810 EQ (Qleft, arg)
2811 ? vertical_scroll_bar_left
2812 : vertical_scroll_bar_right;
ee78dc32
GV		 2813
2814 /* We set this parameter before creating the window for the
2815 frame, so we can get the geometry right from the start.
2816 However, if the window hasn't been created yet, we shouldn't
2817 call x_set_window_size. */
fbd6baed 2818 if (FRAME_W32_WINDOW (f))
ee78dc32 2819 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
6fc2811b 2820 do_pending_window_change (0);
ee78dc32
GV		 2821 }
2822}
2823
2824void
2825x_set_scroll_bar_width (f, arg, oldval)
2826 struct frame *f;
2827 Lisp_Object arg, oldval;
2828{
6fc2811b
JR		 2829 int wid = FONT_WIDTH (f->output_data.w32->font);
2830
ee78dc32
GV		 2831 if (NILP (arg))
2832 {
6fc2811b
JR		 2833 FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = GetSystemMetrics (SM_CXVSCROLL);
2834 FRAME_SCROLL_BAR_COLS (f) = (FRAME_SCROLL_BAR_PIXEL_WIDTH (f) +
2835 wid - 1) / wid;
2836 if (FRAME_W32_WINDOW (f))
2837 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
2838 do_pending_window_change (0);
ee78dc32
GV		 2839 }
2840 else if (INTEGERP (arg) && XINT (arg) > 0
2841 && XFASTINT (arg) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f))
2842 {
ee78dc32 2843 FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = XFASTINT (arg);
6fc2811b
JR		 2844 FRAME_SCROLL_BAR_COLS (f) = (FRAME_SCROLL_BAR_PIXEL_WIDTH (f)
2845 + wid-1) / wid;
fbd6baed 2846 if (FRAME_W32_WINDOW (f))
ee78dc32 2847 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
6fc2811b 2848 do_pending_window_change (0);
ee78dc32 2849 }
6fc2811b
JR		 2850 change_frame_size (f, 0, FRAME_WIDTH (f), 0, 0, 0);
2851 XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.hpos = 0;
2852 XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.x = 0;
ee78dc32
GV		 2853}
2854\f
2855/* Subroutines of creating an frame. */
2856
2857/* Make sure that Vx_resource_name is set to a reasonable value.
2858 Fix it up, or set it to `emacs' if it is too hopeless. */
2859
2860static void
2861validate_x_resource_name ()
2862{
6fc2811b 2863 int len = 0;
ee78dc32
GV		 2864 /* Number of valid characters in the resource name. */
2865 int good_count = 0;
2866 /* Number of invalid characters in the resource name. */
2867 int bad_count = 0;
2868 Lisp_Object new;
2869 int i;
2870
2871 if (STRINGP (Vx_resource_name))
2872 {
2873 unsigned char *p = XSTRING (Vx_resource_name)->data;
2874 int i;
2875
dfff8a69 2876 len = STRING_BYTES (XSTRING (Vx_resource_name));
ee78dc32
GV		 2877
2878 /* Only letters, digits, - and _ are valid in resource names.
2879 Count the valid characters and count the invalid ones. */
2880 for (i = 0; i < len; i++)
2881 {
2882 int c = p[i];
2883 if (! ((c >= 'a' && c <= 'z')
2884 || (c >= 'A' && c <= 'Z')
2885 || (c >= '0' && c <= '9')
2886 || c == '-' || c == '_'))
2887 bad_count++;
2888 else
2889 good_count++;
2890 }
2891 }
2892 else
2893 /* Not a string => completely invalid. */
2894 bad_count = 5, good_count = 0;
2895
2896 /* If name is valid already, return. */
2897 if (bad_count == 0)
2898 return;
2899
2900 /* If name is entirely invalid, or nearly so, use `emacs'. */
2901 if (good_count == 0
2902 || (good_count == 1 && bad_count > 0))
2903 {
2904 Vx_resource_name = build_string ("emacs");
2905 return;
2906 }
2907
2908 /* Name is partly valid. Copy it and replace the invalid characters
2909 with underscores. */
2910
2911 Vx_resource_name = new = Fcopy_sequence (Vx_resource_name);
2912
2913 for (i = 0; i < len; i++)
2914 {
2915 int c = XSTRING (new)->data[i];
2916 if (! ((c >= 'a' && c <= 'z')
2917 || (c >= 'A' && c <= 'Z')
2918 || (c >= '0' && c <= '9')
2919 || c == '-' || c == '_'))
2920 XSTRING (new)->data[i] = '_';
2921 }
2922}
2923
2924
2925extern char *x_get_string_resource ();
2926
2927DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 2, 4, 0,
74e1aeec
JR		 2928 doc: /* Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.
2929This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the
2930class, where INSTANCE is the name under which Emacs was invoked, or
2931the name specified by the `-name' or `-rn' command-line arguments.
2932
2933The optional arguments COMPONENT and SUBCLASS add to the key and the
2934class, respectively. You must specify both of them or neither.
2935If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'
2936and the class is `Emacs.CLASS.SUBCLASS'. */)
ee78dc32
GV		 2937 (attribute, class, component, subclass)
2938 Lisp_Object attribute, class, component, subclass;
2939{
2940 register char *value;
2941 char *name_key;
2942 char *class_key;
2943
b7826503
PJ		 2944 CHECK_STRING (attribute);
2945 CHECK_STRING (class);
ee78dc32
GV		 2946
2947 if (!NILP (component))
b7826503 2948 CHECK_STRING (component);
ee78dc32 2949 if (!NILP (subclass))
b7826503 2950 CHECK_STRING (subclass);
ee78dc32
GV		 2951 if (NILP (component) != NILP (subclass))
2952 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2953
2954 validate_x_resource_name ();
2955
2956 /* Allocate space for the components, the dots which separate them,
2957 and the final '\0'. Make them big enough for the worst case. */
dfff8a69 2958 name_key = (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name))
ee78dc32 2959 + (STRINGP (component)
dfff8a69
JR		 2960 ? STRING_BYTES (XSTRING (component)) : 0)
2961 + STRING_BYTES (XSTRING (attribute))
ee78dc32
GV		 2962 + 3);
2963
2964 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
dfff8a69 2965 + STRING_BYTES (XSTRING (class))
ee78dc32 2966 + (STRINGP (subclass)
dfff8a69 2967 ? STRING_BYTES (XSTRING (subclass)) : 0)
ee78dc32
GV		 2968 + 3);
2969
2970 /* Start with emacs.FRAMENAME for the name (the specific one)
2971 and with `Emacs' for the class key (the general one). */
2972 strcpy (name_key, XSTRING (Vx_resource_name)->data);
2973 strcpy (class_key, EMACS_CLASS);
2974
2975 strcat (class_key, ".");
2976 strcat (class_key, XSTRING (class)->data);
2977
2978 if (!NILP (component))
2979 {
2980 strcat (class_key, ".");
2981 strcat (class_key, XSTRING (subclass)->data);
2982
2983 strcat (name_key, ".");
2984 strcat (name_key, XSTRING (component)->data);
2985 }
2986
2987 strcat (name_key, ".");
2988 strcat (name_key, XSTRING (attribute)->data);
2989
2990 value = x_get_string_resource (Qnil,
2991 name_key, class_key);
2992
2993 if (value != (char *) 0)
2994 return build_string (value);
2995 else
2996 return Qnil;
2997}
2998
2999/* Used when C code wants a resource value. */
3000
3001char *
3002x_get_resource_string (attribute, class)
3003 char *attribute, *class;
3004{
ee78dc32
GV		 3005 char *name_key;
3006 char *class_key;
6fc2811b 3007 struct frame *sf = SELECTED_FRAME ();
ee78dc32
GV		 3008
3009 /* Allocate space for the components, the dots which separate them,
3010 and the final '\0'. */
dfff8a69 3011 name_key = (char *) alloca (STRING_BYTES (XSTRING (Vinvocation_name))
ee78dc32
GV		 3012 + strlen (attribute) + 2);
3013 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
3014 + strlen (class) + 2);
3015
3016 sprintf (name_key, "%s.%s",
3017 XSTRING (Vinvocation_name)->data,
3018 attribute);
3019 sprintf (class_key, "%s.%s", EMACS_CLASS, class);
3020
6fc2811b 3021 return x_get_string_resource (sf, name_key, class_key);
ee78dc32
GV		 3022}
3023
3024/* Types we might convert a resource string into. */
3025enum resource_types
6fc2811b
JR		 3026{
3027 RES_TYPE_NUMBER,
3028 RES_TYPE_FLOAT,
3029 RES_TYPE_BOOLEAN,
3030 RES_TYPE_STRING,
3031 RES_TYPE_SYMBOL
3032};
ee78dc32
GV		 3033
3034/* Return the value of parameter PARAM.
3035
3036 First search ALIST, then Vdefault_frame_alist, then the X defaults
3037 database, using ATTRIBUTE as the attribute name and CLASS as its class.
3038
3039 Convert the resource to the type specified by desired_type.
3040
3041 If no default is specified, return Qunbound. If you call
6fc2811b 3042 w32_get_arg, make sure you deal with Qunbound in a reasonable way,
ee78dc32
GV		 3043 and don't let it get stored in any Lisp-visible variables! */
3044
3045static Lisp_Object
6fc2811b 3046w32_get_arg (alist, param, attribute, class, type)
ee78dc32
GV		 3047 Lisp_Object alist, param;
3048 char *attribute;
3049 char *class;
3050 enum resource_types type;
3051{
3052 register Lisp_Object tem;
3053
3054 tem = Fassq (param, alist);
3055 if (EQ (tem, Qnil))
3056 tem = Fassq (param, Vdefault_frame_alist);
3057 if (EQ (tem, Qnil))
3058 {
3059
3060 if (attribute)
3061 {
3062 tem = Fx_get_resource (build_string (attribute),
3063 build_string (class),
3064 Qnil, Qnil);
3065
3066 if (NILP (tem))
3067 return Qunbound;
3068
3069 switch (type)
3070 {
6fc2811b 3071 case RES_TYPE_NUMBER:
ee78dc32
GV		 3072 return make_number (atoi (XSTRING (tem)->data));
3073
6fc2811b
JR		 3074 case RES_TYPE_FLOAT:
3075 return make_float (atof (XSTRING (tem)->data));
3076
3077 case RES_TYPE_BOOLEAN:
ee78dc32
GV		 3078 tem = Fdowncase (tem);
3079 if (!strcmp (XSTRING (tem)->data, "on")
3080 || !strcmp (XSTRING (tem)->data, "true"))
3081 return Qt;
3082 else
3083 return Qnil;
3084
6fc2811b 3085 case RES_TYPE_STRING:
ee78dc32
GV		 3086 return tem;
3087
6fc2811b 3088 case RES_TYPE_SYMBOL:
ee78dc32
GV		 3089 /* As a special case, we map the values `true' and `on'
3090 to Qt, and `false' and `off' to Qnil. */
3091 {
3092 Lisp_Object lower;
3093 lower = Fdowncase (tem);
3094 if (!strcmp (XSTRING (lower)->data, "on")
3095 || !strcmp (XSTRING (lower)->data, "true"))
3096 return Qt;
3097 else if (!strcmp (XSTRING (lower)->data, "off")
3098 || !strcmp (XSTRING (lower)->data, "false"))
3099 return Qnil;
3100 else
3101 return Fintern (tem, Qnil);
3102 }
3103
3104 default:
3105 abort ();
3106 }
3107 }
3108 else
3109 return Qunbound;
3110 }
3111 return Fcdr (tem);
3112}
3113
3114/* Record in frame F the specified or default value according to ALIST
dfff8a69
JR		 3115 of the parameter named PROP (a Lisp symbol).
3116 If no value is specified for PROP, look for an X default for XPROP
ee78dc32
GV		 3117 on the frame named NAME.
3118 If that is not found either, use the value DEFLT. */
3119
3120static Lisp_Object
3121x_default_parameter (f, alist, prop, deflt, xprop, xclass, type)
3122 struct frame *f;
3123 Lisp_Object alist;
3124 Lisp_Object prop;
3125 Lisp_Object deflt;
3126 char *xprop;
3127 char *xclass;
3128 enum resource_types type;
3129{
3130 Lisp_Object tem;
3131
6fc2811b 3132 tem = w32_get_arg (alist, prop, xprop, xclass, type);
ee78dc32
GV		 3133 if (EQ (tem, Qunbound))
3134 tem = deflt;
3135 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
3136 return tem;
3137}
3138\f
3139DEFUN ("x-parse-geometry", Fx_parse_geometry, Sx_parse_geometry, 1, 1, 0,
74e1aeec
JR		 3140 doc: /* Parse an X-style geometry string STRING.
3141Returns an alist of the form ((top . TOP), (left . LEFT) ... ).
3142The properties returned may include `top', `left', `height', and `width'.
3143The value of `left' or `top' may be an integer,
3144or a list (+ N) meaning N pixels relative to top/left corner,
3145or a list (- N) meaning -N pixels relative to bottom/right corner. */)
ee78dc32
GV		 3146 (string)
3147 Lisp_Object string;
3148{
3149 int geometry, x, y;
3150 unsigned int width, height;
3151 Lisp_Object result;
3152
b7826503 3153 CHECK_STRING (string);
ee78dc32
GV		 3154
3155 geometry = XParseGeometry ((char *) XSTRING (string)->data,
3156 &x, &y, &width, &height);
3157
3158 result = Qnil;
3159 if (geometry & XValue)
3160 {
3161 Lisp_Object element;
3162
3163 if (x >= 0 && (geometry & XNegative))
3164 element = Fcons (Qleft, Fcons (Qminus, Fcons (make_number (-x), Qnil)));
3165 else if (x < 0 && ! (geometry & XNegative))
3166 element = Fcons (Qleft, Fcons (Qplus, Fcons (make_number (x), Qnil)));
3167 else
3168 element = Fcons (Qleft, make_number (x));
3169 result = Fcons (element, result);
3170 }
3171
3172 if (geometry & YValue)
3173 {
3174 Lisp_Object element;
3175
3176 if (y >= 0 && (geometry & YNegative))
3177 element = Fcons (Qtop, Fcons (Qminus, Fcons (make_number (-y), Qnil)));
3178 else if (y < 0 && ! (geometry & YNegative))
3179 element = Fcons (Qtop, Fcons (Qplus, Fcons (make_number (y), Qnil)));
3180 else
3181 element = Fcons (Qtop, make_number (y));
3182 result = Fcons (element, result);
3183 }
3184
3185 if (geometry & WidthValue)
3186 result = Fcons (Fcons (Qwidth, make_number (width)), result);
3187 if (geometry & HeightValue)
3188 result = Fcons (Fcons (Qheight, make_number (height)), result);
3189
3190 return result;
3191}
3192
3193/* Calculate the desired size and position of this window,
3194 and return the flags saying which aspects were specified.
3195
3196 This function does not make the coordinates positive. */
3197
3198#define DEFAULT_ROWS 40
3199#define DEFAULT_COLS 80
3200
3201static int
3202x_figure_window_size (f, parms)
3203 struct frame *f;
3204 Lisp_Object parms;
3205{
3206 register Lisp_Object tem0, tem1, tem2;
ee78dc32
GV		 3207 long window_prompting = 0;
3208
3209 /* Default values if we fall through.
3210 Actually, if that happens we should get
3211 window manager prompting. */
1026b400 3212 SET_FRAME_WIDTH (f, DEFAULT_COLS);
ee78dc32
GV		 3213 f->height = DEFAULT_ROWS;
3214 /* Window managers expect that if program-specified
3215 positions are not (0,0), they're intentional, not defaults. */
fbd6baed
GV		 3216 f->output_data.w32->top_pos = 0;
3217 f->output_data.w32->left_pos = 0;
ee78dc32 3218
35b41202
JR		 3219 /* Ensure that old new_width and new_height will not override the
3220 values set here. */
3221 FRAME_NEW_WIDTH (f) = 0;
3222 FRAME_NEW_HEIGHT (f) = 0;
3223
6fc2811b
JR		 3224 tem0 = w32_get_arg (parms, Qheight, 0, 0, RES_TYPE_NUMBER);
3225 tem1 = w32_get_arg (parms, Qwidth, 0, 0, RES_TYPE_NUMBER);
3226 tem2 = w32_get_arg (parms, Quser_size, 0, 0, RES_TYPE_NUMBER);
ee78dc32
GV		 3227 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
3228 {
3229 if (!EQ (tem0, Qunbound))
3230 {
b7826503 3231 CHECK_NUMBER (tem0);
ee78dc32
GV		 3232 f->height = XINT (tem0);
3233 }
3234 if (!EQ (tem1, Qunbound))
3235 {
b7826503 3236 CHECK_NUMBER (tem1);
1026b400 3237 SET_FRAME_WIDTH (f, XINT (tem1));
ee78dc32
GV		 3238 }
3239 if (!NILP (tem2) && !EQ (tem2, Qunbound))
3240 window_prompting |= USSize;
3241 else
3242 window_prompting |= PSize;
3243 }
3244
fbd6baed 3245 f->output_data.w32->vertical_scroll_bar_extra
ee78dc32
GV		 3246 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f)
3247 ? 0
3248 : FRAME_SCROLL_BAR_PIXEL_WIDTH (f) > 0
3249 ? FRAME_SCROLL_BAR_PIXEL_WIDTH (f)
fbd6baed 3250 : (FRAME_SCROLL_BAR_COLS (f) * FONT_WIDTH (f->output_data.w32->font)));
a0a1947c
KS		 3251 f->output_data.w32->fringes_extra
3252 = FRAME_FRINGE_WIDTH (f);
fbd6baed
GV		 3253 f->output_data.w32->pixel_width = CHAR_TO_PIXEL_WIDTH (f, f->width);
3254 f->output_data.w32->pixel_height = CHAR_TO_PIXEL_HEIGHT (f, f->height);
ee78dc32 3255
6fc2811b
JR		 3256 tem0 = w32_get_arg (parms, Qtop, 0, 0, RES_TYPE_NUMBER);
3257 tem1 = w32_get_arg (parms, Qleft, 0, 0, RES_TYPE_NUMBER);
3258 tem2 = w32_get_arg (parms, Quser_position, 0, 0, RES_TYPE_NUMBER);
ee78dc32
GV		 3259 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
3260 {
3261 if (EQ (tem0, Qminus))
3262 {
fbd6baed 3263 f->output_data.w32->top_pos = 0;
ee78dc32
GV		 3264 window_prompting |= YNegative;
3265 }
8e713be6
KR		 3266 else if (CONSP (tem0) && EQ (XCAR (tem0), Qminus)
3267 && CONSP (XCDR (tem0))
3268 && INTEGERP (XCAR (XCDR (tem0))))
ee78dc32 3269 {
8e713be6 3270 f->output_data.w32->top_pos = - XINT (XCAR (XCDR (tem0)));
ee78dc32
GV		 3271 window_prompting |= YNegative;
3272 }
8e713be6
KR		 3273 else if (CONSP (tem0) && EQ (XCAR (tem0), Qplus)
3274 && CONSP (XCDR (tem0))
3275 && INTEGERP (XCAR (XCDR (tem0))))
ee78dc32 3276 {
8e713be6 3277 f->output_data.w32->top_pos = XINT (XCAR (XCDR (tem0)));
ee78dc32
GV		 3278 }
3279 else if (EQ (tem0, Qunbound))
fbd6baed 3280 f->output_data.w32->top_pos = 0;
ee78dc32
GV		 3281 else
3282 {
b7826503 3283 CHECK_NUMBER (tem0);
fbd6baed
GV		 3284 f->output_data.w32->top_pos = XINT (tem0);
3285 if (f->output_data.w32->top_pos < 0)
ee78dc32
GV		 3286 window_prompting |= YNegative;
3287 }
3288
3289 if (EQ (tem1, Qminus))
3290 {
fbd6baed 3291 f->output_data.w32->left_pos = 0;
ee78dc32
GV		 3292 window_prompting |= XNegative;
3293 }
8e713be6
KR		 3294 else if (CONSP (tem1) && EQ (XCAR (tem1), Qminus)
3295 && CONSP (XCDR (tem1))
3296 && INTEGERP (XCAR (XCDR (tem1))))
ee78dc32 3297 {
8e713be6 3298 f->output_data.w32->left_pos = - XINT (XCAR (XCDR (tem1)));
ee78dc32
GV		 3299 window_prompting |= XNegative;
3300 }
8e713be6
KR		 3301 else if (CONSP (tem1) && EQ (XCAR (tem1), Qplus)
3302 && CONSP (XCDR (tem1))
3303 && INTEGERP (XCAR (XCDR (tem1))))
ee78dc32 3304 {
8e713be6 3305 f->output_data.w32->left_pos = XINT (XCAR (XCDR (tem1)));
ee78dc32
GV		 3306 }
3307 else if (EQ (tem1, Qunbound))
fbd6baed 3308 f->output_data.w32->left_pos = 0;
ee78dc32
GV		 3309 else
3310 {
b7826503 3311 CHECK_NUMBER (tem1);
fbd6baed
GV		 3312 f->output_data.w32->left_pos = XINT (tem1);
3313 if (f->output_data.w32->left_pos < 0)
ee78dc32
GV		 3314 window_prompting |= XNegative;
3315 }
3316
3317 if (!NILP (tem2) && ! EQ (tem2, Qunbound))
3318 window_prompting |= USPosition;
3319 else
3320 window_prompting |= PPosition;
3321 }
3322
3323 return window_prompting;
3324}
3325
3326\f
3327
fbd6baed 3328extern LRESULT CALLBACK w32_wnd_proc ();
ee78dc32
GV		 3329
3330BOOL
fbd6baed 3331w32_init_class (hinst)
ee78dc32
GV		 3332 HINSTANCE hinst;
3333{
3334 WNDCLASS wc;
3335
5ac45f98 3336 wc.style = CS_HREDRAW | CS_VREDRAW;
fbd6baed 3337 wc.lpfnWndProc = (WNDPROC) w32_wnd_proc;
ee78dc32
GV		 3338 wc.cbClsExtra = 0;
3339 wc.cbWndExtra = WND_EXTRA_BYTES;
3340 wc.hInstance = hinst;
3341 wc.hIcon = LoadIcon (hinst, EMACS_CLASS);
3342 wc.hCursor = LoadCursor (NULL, IDC_ARROW);
4587b026 3343 wc.hbrBackground = NULL; /* GetStockObject (WHITE_BRUSH); */
ee78dc32
GV		 3344 wc.lpszMenuName = NULL;
3345 wc.lpszClassName = EMACS_CLASS;
3346
3347 return (RegisterClass (&wc));
3348}
3349
3350HWND
fbd6baed 3351w32_createscrollbar (f, bar)
ee78dc32
GV		 3352 struct frame *f;
3353 struct scroll_bar * bar;
3354{
3355 return (CreateWindow ("SCROLLBAR", "", SBS_VERT | WS_CHILD | WS_VISIBLE,
3356 /* Position and size of scroll bar. */
6fc2811b
JR		 3357 XINT(bar->left) + VERTICAL_SCROLL_BAR_WIDTH_TRIM,
3358 XINT(bar->top),
3359 XINT(bar->width) - VERTICAL_SCROLL_BAR_WIDTH_TRIM * 2,
3360 XINT(bar->height),
fbd6baed 3361 FRAME_W32_WINDOW (f),
ee78dc32
GV		 3362 NULL,
3363 hinst,
3364 NULL));
3365}
3366
3367void
fbd6baed 3368w32_createwindow (f)
ee78dc32
GV		 3369 struct frame *f;
3370{
3371 HWND hwnd;
1edf84e7
GV		 3372 RECT rect;
3373
3374 rect.left = rect.top = 0;
3375 rect.right = PIXEL_WIDTH (f);
3376 rect.bottom = PIXEL_HEIGHT (f);
3377
3378 AdjustWindowRect (&rect, f->output_data.w32->dwStyle,
3379 FRAME_EXTERNAL_MENU_BAR (f));
ee78dc32
GV		 3380
3381 /* Do first time app init */
3382
3383 if (!hprevinst)
3384 {
fbd6baed 3385 w32_init_class (hinst);
ee78dc32
GV		 3386 }
3387
1edf84e7
GV		 3388 FRAME_W32_WINDOW (f) = hwnd
3389 = CreateWindow (EMACS_CLASS,
3390 f->namebuf,
9ead1b60 3391 f->output_data.w32->dwStyle | WS_CLIPCHILDREN,
1edf84e7
GV		 3392 f->output_data.w32->left_pos,
3393 f->output_data.w32->top_pos,
3394 rect.right - rect.left,
3395 rect.bottom - rect.top,
3396 NULL,
3397 NULL,
3398 hinst,
3399 NULL);
3400
ee78dc32
GV		 3401 if (hwnd)
3402 {
1edf84e7
GV		 3403 SetWindowLong (hwnd, WND_FONTWIDTH_INDEX, FONT_WIDTH (f->output_data.w32->font));
3404 SetWindowLong (hwnd, WND_LINEHEIGHT_INDEX, f->output_data.w32->line_height);
3405 SetWindowLong (hwnd, WND_BORDER_INDEX, f->output_data.w32->internal_border_width);
3406 SetWindowLong (hwnd, WND_SCROLLBAR_INDEX, f->output_data.w32->vertical_scroll_bar_extra);
6fc2811b 3407 SetWindowLong (hwnd, WND_BACKGROUND_INDEX, FRAME_BACKGROUND_PIXEL (f));
ee78dc32 3408
cb9e33d4
RS		 3409 /* Enable drag-n-drop. */
3410 DragAcceptFiles (hwnd, TRUE);
3411
5ac45f98
GV		 3412 /* Do this to discard the default setting specified by our parent. */
3413 ShowWindow (hwnd, SW_HIDE);
3c190163 3414 }
3c190163
GV		 3415}
3416
ee78dc32
GV		 3417void
3418my_post_msg (wmsg, hwnd, msg, wParam, lParam)
fbd6baed 3419 W32Msg * wmsg;
ee78dc32
GV		 3420 HWND hwnd;
3421 UINT msg;
3422 WPARAM wParam;
3423 LPARAM lParam;
3424{
3425 wmsg->msg.hwnd = hwnd;
3426 wmsg->msg.message = msg;
3427 wmsg->msg.wParam = wParam;
3428 wmsg->msg.lParam = lParam;
3429 wmsg->msg.time = GetMessageTime ();
3430
3431 post_msg (wmsg);
3432}
3433
e9e23e23 3434/* GetKeyState and MapVirtualKey on Windows 95 do not actually distinguish
a1a80b40
GV		 3435 between left and right keys as advertised. We test for this
3436 support dynamically, and set a flag when the support is absent. If
3437 absent, we keep track of the left and right control and alt keys
3438 ourselves. This is particularly necessary on keyboards that rely
3439 upon the AltGr key, which is represented as having the left control
3440 and right alt keys pressed. For these keyboards, we need to know
3441 when the left alt key has been pressed in addition to the AltGr key
3442 so that we can properly support M-AltGr-key sequences (such as M-@
3443 on Swedish keyboards). */
3444
3445#define EMACS_LCONTROL 0
3446#define EMACS_RCONTROL 1
3447#define EMACS_LMENU 2
3448#define EMACS_RMENU 3
3449
3450static int modifiers[4];
3451static int modifiers_recorded;
3452static int modifier_key_support_tested;
3453
3454static void
3455test_modifier_support (unsigned int wparam)
3456{
3457 unsigned int l, r;
3458
3459 if (wparam != VK_CONTROL && wparam != VK_MENU)
3460 return;
3461 if (wparam == VK_CONTROL)
3462 {
3463 l = VK_LCONTROL;
3464 r = VK_RCONTROL;
3465 }
3466 else
3467 {
3468 l = VK_LMENU;
3469 r = VK_RMENU;
3470 }
3471 if (!(GetKeyState (l) & 0x8000) && !(GetKeyState (r) & 0x8000))
3472 modifiers_recorded = 1;
3473 else
3474 modifiers_recorded = 0;
3475 modifier_key_support_tested = 1;
3476}
3477
3478static void
3479record_keydown (unsigned int wparam, unsigned int lparam)
3480{
3481 int i;
3482
3483 if (!modifier_key_support_tested)
3484 test_modifier_support (wparam);
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] = 1;
3495}
3496
3497static void
3498record_keyup (unsigned int wparam, unsigned int lparam)
3499{
3500 int i;
3501
3502 if ((wparam != VK_CONTROL && wparam != VK_MENU) || !modifiers_recorded)
3503 return;
3504
3505 if (wparam == VK_CONTROL)
3506 i = (lparam & 0x1000000) ? EMACS_RCONTROL : EMACS_LCONTROL;
3507 else
3508 i = (lparam & 0x1000000) ? EMACS_RMENU : EMACS_LMENU;
3509
3510 modifiers[i] = 0;
3511}
3512
da36a4d6
GV		 3513/* Emacs can lose focus while a modifier key has been pressed. When
3514 it regains focus, be conservative and clear all modifiers since
3515 we cannot reconstruct the left and right modifier state. */
3516static void
3517reset_modifiers ()
3518{
8681157a
RS		 3519 SHORT ctrl, alt;
3520
adcc3809
GV		 3521 if (GetFocus () == NULL)
3522 /* Emacs doesn't have keyboard focus. Do nothing. */
da36a4d6 3523 return;
8681157a
RS		 3524
3525 ctrl = GetAsyncKeyState (VK_CONTROL);
3526 alt = GetAsyncKeyState (VK_MENU);
3527
8681157a
RS		 3528 if (!(ctrl & 0x08000))
3529 /* Clear any recorded control modifier state. */
3530 modifiers[EMACS_RCONTROL] = modifiers[EMACS_LCONTROL] = 0;
3531
3532 if (!(alt & 0x08000))
3533 /* Clear any recorded alt modifier state. */
3534 modifiers[EMACS_RMENU] = modifiers[EMACS_LMENU] = 0;
3535
adcc3809
GV		 3536 /* Update the state of all modifier keys, because modifiers used in
3537 hot-key combinations can get stuck on if Emacs loses focus as a
3538 result of a hot-key being pressed. */
3539 {
3540 BYTE keystate[256];
3541
3542#define CURRENT_STATE(key) ((GetAsyncKeyState (key) & 0x8000) >> 8)
3543
3544 GetKeyboardState (keystate);
3545 keystate[VK_SHIFT] = CURRENT_STATE (VK_SHIFT);
3546 keystate[VK_CONTROL] = CURRENT_STATE (VK_CONTROL);
3547 keystate[VK_LCONTROL] = CURRENT_STATE (VK_LCONTROL);
3548 keystate[VK_RCONTROL] = CURRENT_STATE (VK_RCONTROL);
3549 keystate[VK_MENU] = CURRENT_STATE (VK_MENU);
3550 keystate[VK_LMENU] = CURRENT_STATE (VK_LMENU);
3551 keystate[VK_RMENU] = CURRENT_STATE (VK_RMENU);
3552 keystate[VK_LWIN] = CURRENT_STATE (VK_LWIN);
3553 keystate[VK_RWIN] = CURRENT_STATE (VK_RWIN);
3554 keystate[VK_APPS] = CURRENT_STATE (VK_APPS);
3555 SetKeyboardState (keystate);
3556 }
da36a4d6
GV		 3557}
3558
7830e24b
RS		 3559/* Synchronize modifier state with what is reported with the current
3560 keystroke. Even if we cannot distinguish between left and right
3561 modifier keys, we know that, if no modifiers are set, then neither
3562 the left or right modifier should be set. */
3563static void
3564sync_modifiers ()
3565{
3566 if (!modifiers_recorded)
3567 return;
3568
3569 if (!(GetKeyState (VK_CONTROL) & 0x8000))
3570 modifiers[EMACS_RCONTROL] = modifiers[EMACS_LCONTROL] = 0;
3571
3572 if (!(GetKeyState (VK_MENU) & 0x8000))
3573 modifiers[EMACS_RMENU] = modifiers[EMACS_LMENU] = 0;
3574}
3575
a1a80b40
GV		 3576static int
3577modifier_set (int vkey)
3578{
ccc2d29c 3579 if (vkey == VK_CAPITAL || vkey == VK_SCROLL)
891560d6 3580 return (GetKeyState (vkey) & 0x1);
a1a80b40
GV		 3581 if (!modifiers_recorded)
3582 return (GetKeyState (vkey) & 0x8000);
3583
3584 switch (vkey)
3585 {
3586 case VK_LCONTROL:
3587 return modifiers[EMACS_LCONTROL];
3588 case VK_RCONTROL:
3589 return modifiers[EMACS_RCONTROL];
3590 case VK_LMENU:
3591 return modifiers[EMACS_LMENU];
3592 case VK_RMENU:
3593 return modifiers[EMACS_RMENU];
a1a80b40
GV		 3594 }
3595 return (GetKeyState (vkey) & 0x8000);
3596}
3597
ccc2d29c
GV		 3598/* Convert between the modifier bits W32 uses and the modifier bits
3599 Emacs uses. */
3600
3601unsigned int
3602w32_key_to_modifier (int key)
3603{
3604 Lisp_Object key_mapping;
3605
3606 switch (key)
3607 {
3608 case VK_LWIN:
3609 key_mapping = Vw32_lwindow_modifier;
3610 break;
3611 case VK_RWIN:
3612 key_mapping = Vw32_rwindow_modifier;
3613 break;
3614 case VK_APPS:
3615 key_mapping = Vw32_apps_modifier;
3616 break;
3617 case VK_SCROLL:
3618 key_mapping = Vw32_scroll_lock_modifier;
3619 break;
3620 default:
3621 key_mapping = Qnil;
3622 }
3623
adcc3809
GV		 3624 /* NB. This code runs in the input thread, asychronously to the lisp
3625 thread, so we must be careful to ensure access to lisp data is
3626 thread-safe. The following code is safe because the modifier
3627 variable values are updated atomically from lisp and symbols are
3628 not relocated by GC. Also, we don't have to worry about seeing GC
3629 markbits here. */
3630 if (EQ (key_mapping, Qhyper))
ccc2d29c 3631 return hyper_modifier;
adcc3809 3632 if (EQ (key_mapping, Qsuper))
ccc2d29c 3633 return super_modifier;
adcc3809 3634 if (EQ (key_mapping, Qmeta))
ccc2d29c 3635 return meta_modifier;
adcc3809 3636 if (EQ (key_mapping, Qalt))
ccc2d29c 3637 return alt_modifier;
adcc3809 3638 if (EQ (key_mapping, Qctrl))
ccc2d29c 3639 return ctrl_modifier;
adcc3809 3640 if (EQ (key_mapping, Qcontrol)) /* synonym for ctrl */
ccc2d29c 3641 return ctrl_modifier;
adcc3809 3642 if (EQ (key_mapping, Qshift))
ccc2d29c
GV		 3643 return shift_modifier;
3644
3645 /* Don't generate any modifier if not explicitly requested. */
3646 return 0;
3647}
3648
3649unsigned int
3650w32_get_modifiers ()
3651{
3652 return ((modifier_set (VK_SHIFT) ? shift_modifier : 0) |
3653 (modifier_set (VK_CONTROL) ? ctrl_modifier : 0) |
3654 (modifier_set (VK_LWIN) ? w32_key_to_modifier (VK_LWIN) : 0) |
3655 (modifier_set (VK_RWIN) ? w32_key_to_modifier (VK_RWIN) : 0) |
3656 (modifier_set (VK_APPS) ? w32_key_to_modifier (VK_APPS) : 0) |
3657 (modifier_set (VK_SCROLL) ? w32_key_to_modifier (VK_SCROLL) : 0) |
3658 (modifier_set (VK_MENU) ?
3659 ((NILP (Vw32_alt_is_meta)) ? alt_modifier : meta_modifier) : 0));
3660}
3661
a1a80b40
GV		 3662/* We map the VK_* modifiers into console modifier constants
3663 so that we can use the same routines to handle both console
3664 and window input. */
3665
3666static int
ccc2d29c 3667construct_console_modifiers ()
a1a80b40
GV		 3668{
3669 int mods;
3670
a1a80b40
GV		 3671 mods = 0;
3672 mods |= (modifier_set (VK_SHIFT)) ? SHIFT_PRESSED : 0;
3673 mods |= (modifier_set (VK_CAPITAL)) ? CAPSLOCK_ON : 0;
ccc2d29c
GV		 3674 mods |= (modifier_set (VK_SCROLL)) ? SCROLLLOCK_ON : 0;
3675 mods |= (modifier_set (VK_NUMLOCK)) ? NUMLOCK_ON : 0;
a1a80b40
GV		 3676 mods |= (modifier_set (VK_LCONTROL)) ? LEFT_CTRL_PRESSED : 0;
3677 mods |= (modifier_set (VK_RCONTROL)) ? RIGHT_CTRL_PRESSED : 0;
3678 mods |= (modifier_set (VK_LMENU)) ? LEFT_ALT_PRESSED : 0;
3679 mods |= (modifier_set (VK_RMENU)) ? RIGHT_ALT_PRESSED : 0;
ccc2d29c
GV		 3680 mods |= (modifier_set (VK_LWIN)) ? LEFT_WIN_PRESSED : 0;
3681 mods |= (modifier_set (VK_RWIN)) ? RIGHT_WIN_PRESSED : 0;
3682 mods |= (modifier_set (VK_APPS)) ? APPS_PRESSED : 0;
a1a80b40
GV		 3683
3684 return mods;
3685}
3686
ccc2d29c
GV		 3687static int
3688w32_get_key_modifiers (unsigned int wparam, unsigned int lparam)
da36a4d6 3689{
ccc2d29c
GV		 3690 int mods;
3691
3692 /* Convert to emacs modifiers. */
3693 mods = w32_kbd_mods_to_emacs (construct_console_modifiers (), wparam);
3694
3695 return mods;
3696}
da36a4d6 3697
ccc2d29c
GV		 3698unsigned int
3699map_keypad_keys (unsigned int virt_key, unsigned int extended)
3700{
3701 if (virt_key < VK_CLEAR || virt_key > VK_DELETE)
3702 return virt_key;
da36a4d6 3703
ccc2d29c 3704 if (virt_key == VK_RETURN)
da36a4d6
GV		 3705 return (extended ? VK_NUMPAD_ENTER : VK_RETURN);
3706
ccc2d29c
GV		 3707 if (virt_key >= VK_PRIOR && virt_key <= VK_DOWN)
3708 return (!extended ? (VK_NUMPAD_PRIOR + (virt_key - VK_PRIOR)) : virt_key);
3709
3710 if (virt_key == VK_INSERT || virt_key == VK_DELETE)
3711 return (!extended ? (VK_NUMPAD_INSERT + (virt_key - VK_INSERT)) : virt_key);
3712
3713 if (virt_key == VK_CLEAR)
3714 return (!extended ? VK_NUMPAD_CLEAR : virt_key);
3715
3716 return virt_key;
3717}
3718
3719/* List of special key combinations which w32 would normally capture,
3720 but emacs should grab instead. Not directly visible to lisp, to
3721 simplify synchronization. Each item is an integer encoding a virtual
3722 key code and modifier combination to capture. */
3723Lisp_Object w32_grabbed_keys;
3724
3725#define HOTKEY(vk,mods) make_number (((vk) & 255) | ((mods) << 8))
3726#define HOTKEY_ID(k) (XFASTINT (k) & 0xbfff)
3727#define HOTKEY_VK_CODE(k) (XFASTINT (k) & 255)
3728#define HOTKEY_MODIFIERS(k) (XFASTINT (k) >> 8)
3729
3730/* Register hot-keys for reserved key combinations when Emacs has
3731 keyboard focus, since this is the only way Emacs can receive key
3732 combinations like Alt-Tab which are used by the system. */
3733
3734static void
3735register_hot_keys (hwnd)
3736 HWND hwnd;
3737{
3738 Lisp_Object keylist;
3739
3740 /* Use GC_CONSP, since we are called asynchronously. */
3741 for (keylist = w32_grabbed_keys; GC_CONSP (keylist); keylist = XCDR (keylist))
3742 {
3743 Lisp_Object key = XCAR (keylist);
3744
3745 /* Deleted entries get set to nil. */
3746 if (!INTEGERP (key))
3747 continue;
3748
3749 RegisterHotKey (hwnd, HOTKEY_ID (key),
3750 HOTKEY_MODIFIERS (key), HOTKEY_VK_CODE (key));
3751 }
3752}
3753
3754static void
3755unregister_hot_keys (hwnd)
3756 HWND hwnd;
3757{
3758 Lisp_Object keylist;
3759
3760 /* Use GC_CONSP, since we are called asynchronously. */
3761 for (keylist = w32_grabbed_keys; GC_CONSP (keylist); keylist = XCDR (keylist))
3762 {
3763 Lisp_Object key = XCAR (keylist);
3764
3765 if (!INTEGERP (key))
3766 continue;
3767
3768 UnregisterHotKey (hwnd, HOTKEY_ID (key));
3769 }
3770}
3771
5ac45f98
GV		 3772/* Main message dispatch loop. */
3773
1edf84e7
GV		 3774static void
3775w32_msg_pump (deferred_msg * msg_buf)
5ac45f98
GV		 3776{
3777 MSG msg;
ccc2d29c
GV		 3778 int result;
3779 HWND focus_window;
93fbe8b7
GV		 3780
3781 msh_mousewheel = RegisterWindowMessage (MSH_MOUSEWHEEL);
5ac45f98 3782
5ac45f98
GV		 3783 while (GetMessage (&msg, NULL, 0, 0))
3784 {
3785 if (msg.hwnd == NULL)
3786 {
3787 switch (msg.message)
3788 {
3ef68e6b
AI		 3789 case WM_NULL:
3790 /* Produced by complete_deferred_msg; just ignore. */
3791 break;
5ac45f98 3792 case WM_EMACS_CREATEWINDOW:
fbd6baed 3793 w32_createwindow ((struct frame *) msg.wParam);
1edf84e7
GV		 3794 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0))
3795 abort ();
5ac45f98 3796 break;
dfdb4047
GV		 3797 case WM_EMACS_SETLOCALE:
3798 SetThreadLocale (msg.wParam);
3799 /* Reply is not expected. */
3800 break;
ccc2d29c
GV		 3801 case WM_EMACS_SETKEYBOARDLAYOUT:
3802 result = (int) ActivateKeyboardLayout ((HKL) msg.wParam, 0);
3803 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE,
3804 result, 0))
3805 abort ();
3806 break;
3807 case WM_EMACS_REGISTER_HOT_KEY:
3808 focus_window = GetFocus ();
3809 if (focus_window != NULL)
3810 RegisterHotKey (focus_window,
3811 HOTKEY_ID (msg.wParam),
3812 HOTKEY_MODIFIERS (msg.wParam),
3813 HOTKEY_VK_CODE (msg.wParam));
3814 /* Reply is not expected. */
3815 break;
3816 case WM_EMACS_UNREGISTER_HOT_KEY:
3817 focus_window = GetFocus ();
3818 if (focus_window != NULL)
3819 UnregisterHotKey (focus_window, HOTKEY_ID (msg.wParam));
adcc3809
GV		 3820 /* Mark item as erased. NB: this code must be
3821 thread-safe. The next line is okay because the cons
3822 cell is never made into garbage and is not relocated by
3823 GC. */
f3fbd155 3824 XSETCAR ((Lisp_Object) msg.lParam, Qnil);
ccc2d29c
GV		 3825 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0))
3826 abort ();
3827 break;
adcc3809
GV		 3828 case WM_EMACS_TOGGLE_LOCK_KEY:
3829 {
3830 int vk_code = (int) msg.wParam;
3831 int cur_state = (GetKeyState (vk_code) & 1);
3832 Lisp_Object new_state = (Lisp_Object) msg.lParam;
3833
3834 /* NB: This code must be thread-safe. It is safe to
3835 call NILP because symbols are not relocated by GC,
3836 and pointer here is not touched by GC (so the markbit
3837 can't be set). Numbers are safe because they are
3838 immediate values. */
3839 if (NILP (new_state)
3840 || (NUMBERP (new_state)
8edb0a6f 3841 && ((XUINT (new_state)) & 1) != cur_state))
adcc3809
GV		 3842 {
3843 one_w32_display_info.faked_key = vk_code;
3844
3845 keybd_event ((BYTE) vk_code,
3846 (BYTE) MapVirtualKey (vk_code, 0),
3847 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
3848 keybd_event ((BYTE) vk_code,
3849 (BYTE) MapVirtualKey (vk_code, 0),
3850 KEYEVENTF_EXTENDEDKEY | 0, 0);
3851 keybd_event ((BYTE) vk_code,
3852 (BYTE) MapVirtualKey (vk_code, 0),
3853 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
3854 cur_state = !cur_state;
3855 }
3856 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE,
3857 cur_state, 0))
3858 abort ();
3859 }
3860 break;
1edf84e7 3861 default:
1edf84e7 3862 DebPrint (("msg %x not expected by w32_msg_pump\n", msg.message));
5ac45f98
GV		 3863 }
3864 }
3865 else
3866 {
3867 DispatchMessage (&msg);
3868 }
1edf84e7
GV		 3869
3870 /* Exit nested loop when our deferred message has completed. */
3871 if (msg_buf->completed)
3872 break;
5ac45f98 3873 }
1edf84e7
GV		 3874}
3875
3876deferred_msg * deferred_msg_head;
3877
3878static deferred_msg *
3879find_deferred_msg (HWND hwnd, UINT msg)
3880{
3881 deferred_msg * item;
3882
3883 /* Don't actually need synchronization for read access, since
3884 modification of single pointer is always atomic. */
3885 /* enter_crit (); */
3886
3887 for (item = deferred_msg_head; item != NULL; item = item->next)
3888 if (item->w32msg.msg.hwnd == hwnd
3889 && item->w32msg.msg.message == msg)
3890 break;
3891
3892 /* leave_crit (); */
3893
3894 return item;
3895}
3896
3897static LRESULT
3898send_deferred_msg (deferred_msg * msg_buf,
3899 HWND hwnd,
3900 UINT msg,
3901 WPARAM wParam,
3902 LPARAM lParam)
3903{
3904 /* Only input thread can send deferred messages. */
3905 if (GetCurrentThreadId () != dwWindowsThreadId)
3906 abort ();
3907
3908 /* It is an error to send a message that is already deferred. */
3909 if (find_deferred_msg (hwnd, msg) != NULL)
3910 abort ();
3911
3912 /* Enforced synchronization is not needed because this is the only
3913 function that alters deferred_msg_head, and the following critical
3914 section is guaranteed to only be serially reentered (since only the
3915 input thread can call us). */
3916
3917 /* enter_crit (); */
3918
3919 msg_buf->completed = 0;
3920 msg_buf->next = deferred_msg_head;
3921 deferred_msg_head = msg_buf;
3922 my_post_msg (&msg_buf->w32msg, hwnd, msg, wParam, lParam);
3923
3924 /* leave_crit (); */
3925
3926 /* Start a new nested message loop to process other messages until
3927 this one is completed. */
3928 w32_msg_pump (msg_buf);
3929
3930 deferred_msg_head = msg_buf->next;
3931
3932 return msg_buf->result;
3933}
3934
3935void
3936complete_deferred_msg (HWND hwnd, UINT msg, LRESULT result)
3937{
3938 deferred_msg * msg_buf = find_deferred_msg (hwnd, msg);
3939
3940 if (msg_buf == NULL)
3ef68e6b
AI		 3941 /* Message may have been cancelled, so don't abort(). */
3942 return;
1edf84e7
GV		 3943
3944 msg_buf->result = result;
3945 msg_buf->completed = 1;
3946
3947 /* Ensure input thread is woken so it notices the completion. */
3948 PostThreadMessage (dwWindowsThreadId, WM_NULL, 0, 0);
3949}
3950
3ef68e6b
AI		 3951void
3952cancel_all_deferred_msgs ()
3953{
3954 deferred_msg * item;
3955
3956 /* Don't actually need synchronization for read access, since
3957 modification of single pointer is always atomic. */
3958 /* enter_crit (); */
3959
3960 for (item = deferred_msg_head; item != NULL; item = item->next)
3961 {
3962 item->result = 0;
3963 item->completed = 1;
3964 }
3965
3966 /* leave_crit (); */
3967
3968 /* Ensure input thread is woken so it notices the completion. */
3969 PostThreadMessage (dwWindowsThreadId, WM_NULL, 0, 0);
3970}
1edf84e7
GV		 3971
3972DWORD
3973w32_msg_worker (dw)
3974 DWORD dw;
3975{
3976 MSG msg;
3977 deferred_msg dummy_buf;
3978
3979 /* Ensure our message queue is created */
3980
3981 PeekMessage (&msg, NULL, 0, 0, PM_NOREMOVE);
5ac45f98 3982
1edf84e7
GV		 3983 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0))
3984 abort ();
3985
3986 memset (&dummy_buf, 0, sizeof (dummy_buf));
3987 dummy_buf.w32msg.msg.hwnd = NULL;
3988 dummy_buf.w32msg.msg.message = WM_NULL;
3989
3990 /* This is the inital message loop which should only exit when the
3991 application quits. */
3992 w32_msg_pump (&dummy_buf);
3993
3994 return 0;
5ac45f98
GV		 3995}
3996
3ef68e6b
AI		 3997static void
3998post_character_message (hwnd, msg, wParam, lParam, modifiers)
3999 HWND hwnd;
4000 UINT msg;
4001 WPARAM wParam;
4002 LPARAM lParam;
4003 DWORD modifiers;
4004
4005{
4006 W32Msg wmsg;
4007
4008 wmsg.dwModifiers = modifiers;
4009
4010 /* Detect quit_char and set quit-flag directly. Note that we
4011 still need to post a message to ensure the main thread will be
4012 woken up if blocked in sys_select(), but we do NOT want to post
4013 the quit_char message itself (because it will usually be as if
4014 the user had typed quit_char twice). Instead, we post a dummy
4015 message that has no particular effect. */
4016 {
4017 int c = wParam;
4018 if (isalpha (c) && wmsg.dwModifiers == ctrl_modifier)
4019 c = make_ctrl_char (c) & 0377;
7d081355
AI		 4020 if (c == quit_char
4021 || (wmsg.dwModifiers == 0 &&
4022 XFASTINT (Vw32_quit_key) && wParam == XFASTINT (Vw32_quit_key)))
3ef68e6b
AI		 4023 {
4024 Vquit_flag = Qt;
4025
4026 /* The choice of message is somewhat arbitrary, as long as
4027 the main thread handler just ignores it. */
4028 msg = WM_NULL;
4029
4030 /* Interrupt any blocking system calls. */
4031 signal_quit ();
4032
4033 /* As a safety precaution, forcibly complete any deferred
4034 messages. This is a kludge, but I don't see any particularly
4035 clean way to handle the situation where a deferred message is
4036 "dropped" in the lisp thread, and will thus never be
4037 completed, eg. by the user trying to activate the menubar
4038 when the lisp thread is busy, and then typing C-g when the
4039 menubar doesn't open promptly (with the result that the
4040 menubar never responds at all because the deferred
4041 WM_INITMENU message is never completed). Another problem
4042 situation is when the lisp thread calls SendMessage (to send
4043 a window manager command) when a message has been deferred;
4044 the lisp thread gets blocked indefinitely waiting for the
4045 deferred message to be completed, which itself is waiting for
4046 the lisp thread to respond.
4047
4048 Note that we don't want to block the input thread waiting for
4049 a reponse from the lisp thread (although that would at least
4050 solve the deadlock problem above), because we want to be able
4051 to receive C-g to interrupt the lisp thread. */
4052 cancel_all_deferred_msgs ();
4053 }
4054 }
4055
4056 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4057}
4058
ee78dc32
GV		 4059/* Main window procedure */
4060
ee78dc32 4061LRESULT CALLBACK
fbd6baed 4062w32_wnd_proc (hwnd, msg, wParam, lParam)
ee78dc32
GV		 4063 HWND hwnd;
4064 UINT msg;
4065 WPARAM wParam;
4066 LPARAM lParam;
4067{
4068 struct frame *f;
fbd6baed
GV		 4069 struct w32_display_info *dpyinfo = &one_w32_display_info;
4070 W32Msg wmsg;
84fb1139 4071 int windows_translate;
576ba81c 4072 int key;
84fb1139 4073
a6085637
KH		 4074 /* Note that it is okay to call x_window_to_frame, even though we are
4075 not running in the main lisp thread, because frame deletion
4076 requires the lisp thread to synchronize with this thread. Thus, if
4077 a frame struct is returned, it can be used without concern that the
4078 lisp thread might make it disappear while we are using it.
4079
4080 NB. Walking the frame list in this thread is safe (as long as
4081 writes of Lisp_Object slots are atomic, which they are on Windows).
4082 Although delete-frame can destructively modify the frame list while
4083 we are walking it, a garbage collection cannot occur until after
4084 delete-frame has synchronized with this thread.
4085
4086 It is also safe to use functions that make GDI calls, such as
fbd6baed 4087 w32_clear_rect, because these functions must obtain a DC handle
a6085637
KH		 4088 from the frame struct using get_frame_dc which is thread-aware. */
4089
ee78dc32
GV		 4090 switch (msg)
4091 {
4092 case WM_ERASEBKGND:
a6085637
KH		 4093 f = x_window_to_frame (dpyinfo, hwnd);
4094 if (f)
4095 {
9badad41 4096 HDC hdc = get_frame_dc (f);
a6085637 4097 GetUpdateRect (hwnd, &wmsg.rect, FALSE);
9badad41
JR		 4098 w32_clear_rect (f, hdc, &wmsg.rect);
4099 release_frame_dc (f, hdc);
ce6059da
AI		 4100
4101#if defined (W32_DEBUG_DISPLAY)
18f0b342
AI		 4102 DebPrint (("WM_ERASEBKGND (frame %p): erasing %d,%d-%d,%d\n",
4103 f,
4104 wmsg.rect.left, wmsg.rect.top,
4105 wmsg.rect.right, wmsg.rect.bottom));
ce6059da 4106#endif /* W32_DEBUG_DISPLAY */
a6085637 4107 }
5ac45f98
GV		 4108 return 1;
4109 case WM_PALETTECHANGED:
4110 /* ignore our own changes */
4111 if ((HWND)wParam != hwnd)
4112 {
a6085637
KH		 4113 f = x_window_to_frame (dpyinfo, hwnd);
4114 if (f)
4115 /* get_frame_dc will realize our palette and force all
4116 frames to be redrawn if needed. */
4117 release_frame_dc (f, get_frame_dc (f));
5ac45f98
GV		 4118 }
4119 return 0;
ee78dc32 4120 case WM_PAINT:
ce6059da 4121 {
55dcfc15
AI		 4122 PAINTSTRUCT paintStruct;
4123 RECT update_rect;
4124
18f0b342
AI		 4125 f = x_window_to_frame (dpyinfo, hwnd);
4126 if (f == 0)
4127 {
4128 DebPrint (("WM_PAINT received for unknown window %p\n", hwnd));
4129 return 0;
4130 }
4131
55dcfc15
AI		 4132 /* MSDN Docs say not to call BeginPaint if GetUpdateRect
4133 fails. Apparently this can happen under some
4134 circumstances. */
c0611964 4135 if (!w32_strict_painting || GetUpdateRect (hwnd, &update_rect, FALSE))
55dcfc15
AI		 4136 {
4137 enter_crit ();
4138 BeginPaint (hwnd, &paintStruct);
4139
c0611964
AI		 4140 if (w32_strict_painting)
4141 /* The rectangles returned by GetUpdateRect and BeginPaint
4142 do not always match. GetUpdateRect seems to be the
4143 more reliable of the two. */
4144 wmsg.rect = update_rect;
4145 else
4146 wmsg.rect = paintStruct.rcPaint;
55dcfc15
AI		 4147
4148#if defined (W32_DEBUG_DISPLAY)
18f0b342
AI		 4149 DebPrint (("WM_PAINT (frame %p): painting %d,%d-%d,%d\n",
4150 f,
4151 wmsg.rect.left, wmsg.rect.top,
4152 wmsg.rect.right, wmsg.rect.bottom));
4153 DebPrint ((" [update region is %d,%d-%d,%d]\n",
55dcfc15
AI		 4154 update_rect.left, update_rect.top,
4155 update_rect.right, update_rect.bottom));
4156#endif
4157 EndPaint (hwnd, &paintStruct);
4158 leave_crit ();
4159
4160 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4161
4162 return 0;
4163 }
c0611964
AI		 4164
4165 /* If GetUpdateRect returns 0 (meaning there is no update
4166 region), assume the whole window needs to be repainted. */
4167 GetClientRect(hwnd, &wmsg.rect);
4168 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4169 return 0;
ee78dc32 4170 }
a1a80b40 4171
ccc2d29c
GV		 4172 case WM_INPUTLANGCHANGE:
4173 /* Inform lisp thread of keyboard layout changes. */
4174 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4175
4176 /* Clear dead keys in the keyboard state; for simplicity only
4177 preserve modifier key states. */
4178 {
4179 int i;
4180 BYTE keystate[256];
4181
4182 GetKeyboardState (keystate);
4183 for (i = 0; i < 256; i++)
4184 if (1
4185 && i != VK_SHIFT
4186 && i != VK_LSHIFT
4187 && i != VK_RSHIFT
4188 && i != VK_CAPITAL
4189 && i != VK_NUMLOCK
4190 && i != VK_SCROLL
4191 && i != VK_CONTROL
4192 && i != VK_LCONTROL
4193 && i != VK_RCONTROL
4194 && i != VK_MENU
4195 && i != VK_LMENU
4196 && i != VK_RMENU
4197 && i != VK_LWIN
4198 && i != VK_RWIN)
4199 keystate[i] = 0;
4200 SetKeyboardState (keystate);
4201 }
4202 goto dflt;
4203
4204 case WM_HOTKEY:
4205 /* Synchronize hot keys with normal input. */
4206 PostMessage (hwnd, WM_KEYDOWN, HIWORD (lParam), 0);
4207 return (0);
4208
a1a80b40
GV		 4209 case WM_KEYUP:
4210 case WM_SYSKEYUP:
4211 record_keyup (wParam, lParam);
4212 goto dflt;
4213
ee78dc32
GV		 4214 case WM_KEYDOWN:
4215 case WM_SYSKEYDOWN:
ccc2d29c
GV		 4216 /* Ignore keystrokes we fake ourself; see below. */
4217 if (dpyinfo->faked_key == wParam)
4218 {
4219 dpyinfo->faked_key = 0;
576ba81c
AI		 4220 /* Make sure TranslateMessage sees them though (as long as
4221 they don't produce WM_CHAR messages). This ensures that
4222 indicator lights are toggled promptly on Windows 9x, for
4223 example. */
4224 if (lispy_function_keys[wParam] != 0)
4225 {
4226 windows_translate = 1;
4227 goto translate;
4228 }
4229 return 0;
ccc2d29c
GV		 4230 }
4231
7830e24b
RS		 4232 /* Synchronize modifiers with current keystroke. */
4233 sync_modifiers ();
a1a80b40 4234 record_keydown (wParam, lParam);
ccc2d29c 4235 wParam = map_keypad_keys (wParam, (lParam & 0x1000000L) != 0);
84fb1139
KH		 4236
4237 windows_translate = 0;
ccc2d29c
GV		 4238
4239 switch (wParam)
4240 {
4241 case VK_LWIN:
4242 if (NILP (Vw32_pass_lwindow_to_system))
4243 {
4244 /* Prevent system from acting on keyup (which opens the
4245 Start menu if no other key was pressed) by simulating a
4246 press of Space which we will ignore. */
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_lwindow_modifier))
4258 return 0;
4259 break;
4260 case VK_RWIN:
4261 if (NILP (Vw32_pass_rwindow_to_system))
4262 {
4263 if (GetAsyncKeyState (wParam) & 1)
4264 {
adcc3809 4265 if (NUMBERP (Vw32_phantom_key_code))
576ba81c 4266 key = XUINT (Vw32_phantom_key_code) & 255;
adcc3809 4267 else
576ba81c
AI		 4268 key = VK_SPACE;
4269 dpyinfo->faked_key = key;
4270 keybd_event (key, (BYTE) MapVirtualKey (key, 0), 0, 0);
ccc2d29c
GV		 4271 }
4272 }
4273 if (!NILP (Vw32_rwindow_modifier))
4274 return 0;
4275 break;
576ba81c 4276 case VK_APPS:
ccc2d29c
GV		 4277 if (!NILP (Vw32_apps_modifier))
4278 return 0;
4279 break;
4280 case VK_MENU:
4281 if (NILP (Vw32_pass_alt_to_system))
adcc3809
GV		 4282 /* Prevent DefWindowProc from activating the menu bar if an
4283 Alt key is pressed and released by itself. */
ccc2d29c 4284 return 0;
84fb1139 4285 windows_translate = 1;
ccc2d29c
GV		 4286 break;
4287 case VK_CAPITAL:
4288 /* Decide whether to treat as modifier or function key. */
4289 if (NILP (Vw32_enable_caps_lock))
4290 goto disable_lock_key;
adcc3809
GV		 4291 windows_translate = 1;
4292 break;
ccc2d29c
GV		 4293 case VK_NUMLOCK:
4294 /* Decide whether to treat as modifier or function key. */
4295 if (NILP (Vw32_enable_num_lock))
4296 goto disable_lock_key;
adcc3809
GV		 4297 windows_translate = 1;
4298 break;
ccc2d29c
GV		 4299 case VK_SCROLL:
4300 /* Decide whether to treat as modifier or function key. */
4301 if (NILP (Vw32_scroll_lock_modifier))
4302 goto disable_lock_key;
adcc3809
GV		 4303 windows_translate = 1;
4304 break;
ccc2d29c 4305 disable_lock_key:
adcc3809
GV		 4306 /* Ensure the appropriate lock key state (and indicator light)
4307 remains in the same state. We do this by faking another
4308 press of the relevant key. Apparently, this really is the
4309 only way to toggle the state of the indicator lights. */
4310 dpyinfo->faked_key = wParam;
4311 keybd_event ((BYTE) wParam, (BYTE) MapVirtualKey (wParam, 0),
4312 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
4313 keybd_event ((BYTE) wParam, (BYTE) MapVirtualKey (wParam, 0),
4314 KEYEVENTF_EXTENDEDKEY | 0, 0);
4315 keybd_event ((BYTE) wParam, (BYTE) MapVirtualKey (wParam, 0),
4316 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
4317 /* Ensure indicator lights are updated promptly on Windows 9x
4318 (TranslateMessage apparently does this), after forwarding
4319 input event. */
4320 post_character_message (hwnd, msg, wParam, lParam,
4321 w32_get_key_modifiers (wParam, lParam));
4322 windows_translate = 1;
ccc2d29c
GV		 4323 break;
4324 case VK_CONTROL:
4325 case VK_SHIFT:
4326 case VK_PROCESSKEY: /* Generated by IME. */
4327 windows_translate = 1;
4328 break;
adcc3809
GV		 4329 case VK_CANCEL:
4330 /* Windows maps Ctrl-Pause (aka Ctrl-Break) into VK_CANCEL,
4331 which is confusing for purposes of key binding; convert
4332 VK_CANCEL events into VK_PAUSE events. */
4333 wParam = VK_PAUSE;
4334 break;
4335 case VK_PAUSE:
4336 /* Windows maps Ctrl-NumLock into VK_PAUSE, which is confusing
4337 for purposes of key binding; convert these back into
4338 VK_NUMLOCK events, at least when we want to see NumLock key
4339 presses. (Note that there is never any possibility that
4340 VK_PAUSE with Ctrl really is C-Pause as per above.) */
4341 if (NILP (Vw32_enable_num_lock) && modifier_set (VK_CONTROL))
4342 wParam = VK_NUMLOCK;
4343 break;
ccc2d29c
GV		 4344 default:
4345 /* If not defined as a function key, change it to a WM_CHAR message. */
4346 if (lispy_function_keys[wParam] == 0)
4347 {
adcc3809
GV		 4348 DWORD modifiers = construct_console_modifiers ();
4349
ccc2d29c
GV		 4350 if (!NILP (Vw32_recognize_altgr)
4351 && modifier_set (VK_LCONTROL) && modifier_set (VK_RMENU))
4352 {
4353 /* Always let TranslateMessage handle AltGr key chords;
4354 for some reason, ToAscii doesn't always process AltGr
4355 chords correctly. */
4356 windows_translate = 1;
4357 }
adcc3809 4358 else if ((modifiers & (~SHIFT_PRESSED & ~CAPSLOCK_ON)) != 0)
ccc2d29c 4359 {
adcc3809
GV		 4360 /* Handle key chords including any modifiers other
4361 than shift directly, in order to preserve as much
4362 modifier information as possible. */
ccc2d29c
GV		 4363 if ('A' <= wParam && wParam <= 'Z')
4364 {
4365 /* Don't translate modified alphabetic keystrokes,
4366 so the user doesn't need to constantly switch
4367 layout to type control or meta keystrokes when
4368 the normal layout translates alphabetic
4369 characters to non-ascii characters. */
4370 if (!modifier_set (VK_SHIFT))
4371 wParam += ('a' - 'A');
4372 msg = WM_CHAR;
4373 }
4374 else
4375 {
4376 /* Try to handle other keystrokes by determining the
4377 base character (ie. translating the base key plus
4378 shift modifier). */
4379 int add;
4380 int isdead = 0;
4381 KEY_EVENT_RECORD key;
4382
4383 key.bKeyDown = TRUE;
4384 key.wRepeatCount = 1;
4385 key.wVirtualKeyCode = wParam;
4386 key.wVirtualScanCode = (lParam & 0xFF0000) >> 16;
4387 key.uChar.AsciiChar = 0;
adcc3809 4388 key.dwControlKeyState = modifiers;
ccc2d29c
GV		 4389
4390 add = w32_kbd_patch_key (&key);
4391 /* 0 means an unrecognised keycode, negative means
4392 dead key. Ignore both. */
4393 while (--add >= 0)
4394 {
4395 /* Forward asciified character sequence. */
4396 post_character_message
4397 (hwnd, WM_CHAR, key.uChar.AsciiChar, lParam,
4398 w32_get_key_modifiers (wParam, lParam));
4399 w32_kbd_patch_key (&key);
4400 }
4401 return 0;
4402 }
4403 }
4404 else
4405 {
4406 /* Let TranslateMessage handle everything else. */
4407 windows_translate = 1;
4408 }
4409 }
4410 }
a1a80b40 4411
adcc3809 4412 translate:
84fb1139
KH		 4413 if (windows_translate)
4414 {
e9e23e23 4415 MSG windows_msg = { hwnd, msg, wParam, lParam, 0, {0,0} };
84fb1139 4416
e9e23e23
GV		 4417 windows_msg.time = GetMessageTime ();
4418 TranslateMessage (&windows_msg);
84fb1139
KH		 4419 goto dflt;
4420 }
4421
ee78dc32
GV		 4422 /* Fall through */
4423
4424 case WM_SYSCHAR:
4425 case WM_CHAR:
ccc2d29c
GV		 4426 post_character_message (hwnd, msg, wParam, lParam,
4427 w32_get_key_modifiers (wParam, lParam));
ee78dc32 4428 break;
da36a4d6 4429
5ac45f98
GV		 4430 /* Simulate middle mouse button events when left and right buttons
4431 are used together, but only if user has two button mouse. */
ee78dc32 4432 case WM_LBUTTONDOWN:
5ac45f98 4433 case WM_RBUTTONDOWN:
7ce9aaca 4434 if (XINT (Vw32_num_mouse_buttons) > 2)
5ac45f98
GV		 4435 goto handle_plain_button;
4436
4437 {
4438 int this = (msg == WM_LBUTTONDOWN) ? LMOUSE : RMOUSE;
4439 int other = (msg == WM_LBUTTONDOWN) ? RMOUSE : LMOUSE;
4440
3cb20f4a
RS		 4441 if (button_state & this)
4442 return 0;
5ac45f98
GV		 4443
4444 if (button_state == 0)
4445 SetCapture (hwnd);
4446
4447 button_state |= this;
4448
4449 if (button_state & other)
4450 {
84fb1139 4451 if (mouse_button_timer)
5ac45f98 4452 {
84fb1139
KH		 4453 KillTimer (hwnd, mouse_button_timer);
4454 mouse_button_timer = 0;
5ac45f98
GV		 4455
4456 /* Generate middle mouse event instead. */
4457 msg = WM_MBUTTONDOWN;
4458 button_state |= MMOUSE;
4459 }
4460 else if (button_state & MMOUSE)
4461 {
4462 /* Ignore button event if we've already generated a
4463 middle mouse down event. This happens if the
4464 user releases and press one of the two buttons
4465 after we've faked a middle mouse event. */
4466 return 0;
4467 }
4468 else
4469 {
4470 /* Flush out saved message. */
84fb1139 4471 post_msg (&saved_mouse_button_msg);
5ac45f98 4472 }
fbd6baed 4473 wmsg.dwModifiers = w32_get_modifiers ();
5ac45f98
GV		 4474 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4475
4476 /* Clear message buffer. */
84fb1139 4477 saved_mouse_button_msg.msg.hwnd = 0;
5ac45f98
GV		 4478 }
4479 else
4480 {
4481 /* Hold onto message for now. */
84fb1139 4482 mouse_button_timer =
adcc3809
GV		 4483 SetTimer (hwnd, MOUSE_BUTTON_ID,
4484 XINT (Vw32_mouse_button_tolerance), NULL);
84fb1139
KH		 4485 saved_mouse_button_msg.msg.hwnd = hwnd;
4486 saved_mouse_button_msg.msg.message = msg;
4487 saved_mouse_button_msg.msg.wParam = wParam;
4488 saved_mouse_button_msg.msg.lParam = lParam;
4489 saved_mouse_button_msg.msg.time = GetMessageTime ();
fbd6baed 4490 saved_mouse_button_msg.dwModifiers = w32_get_modifiers ();
5ac45f98
GV		 4491 }
4492 }
4493 return 0;
4494
ee78dc32 4495 case WM_LBUTTONUP:
5ac45f98 4496 case WM_RBUTTONUP:
7ce9aaca 4497 if (XINT (Vw32_num_mouse_buttons) > 2)
5ac45f98
GV		 4498 goto handle_plain_button;
4499
4500 {
4501 int this = (msg == WM_LBUTTONUP) ? LMOUSE : RMOUSE;
4502 int other = (msg == WM_LBUTTONUP) ? RMOUSE : LMOUSE;
4503
3cb20f4a
RS		 4504 if ((button_state & this) == 0)
4505 return 0;
5ac45f98
GV		 4506
4507 button_state &= ~this;
4508
4509 if (button_state & MMOUSE)
4510 {
4511 /* Only generate event when second button is released. */
4512 if ((button_state & other) == 0)
4513 {
4514 msg = WM_MBUTTONUP;
4515 button_state &= ~MMOUSE;
4516
4517 if (button_state) abort ();
4518 }
4519 else
4520 return 0;
4521 }
4522 else
4523 {
4524 /* Flush out saved message if necessary. */
84fb1139 4525 if (saved_mouse_button_msg.msg.hwnd)
5ac45f98 4526 {
84fb1139 4527 post_msg (&saved_mouse_button_msg);
5ac45f98
GV		 4528 }
4529 }
fbd6baed 4530 wmsg.dwModifiers = w32_get_modifiers ();
5ac45f98
GV		 4531 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4532
4533 /* Always clear message buffer and cancel timer. */
84fb1139
KH		 4534 saved_mouse_button_msg.msg.hwnd = 0;
4535 KillTimer (hwnd, mouse_button_timer);
4536 mouse_button_timer = 0;
5ac45f98
GV		 4537
4538 if (button_state == 0)
4539 ReleaseCapture ();
4540 }
4541 return 0;
4542
ee78dc32
GV		 4543 case WM_MBUTTONDOWN:
4544 case WM_MBUTTONUP:
5ac45f98 4545 handle_plain_button:
ee78dc32
GV		 4546 {
4547 BOOL up;
1edf84e7 4548 int button;
ee78dc32 4549
1edf84e7 4550 if (parse_button (msg, &button, &up))
ee78dc32
GV		 4551 {
4552 if (up) ReleaseCapture ();
4553 else SetCapture (hwnd);
1edf84e7
GV		 4554 button = (button == 0) ? LMOUSE :
4555 ((button == 1) ? MMOUSE : RMOUSE);
4556 if (up)
4557 button_state &= ~button;
4558 else
4559 button_state |= button;
ee78dc32
GV		 4560 }
4561 }
4562
fbd6baed 4563 wmsg.dwModifiers = w32_get_modifiers ();
ee78dc32 4564 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
5ac45f98
GV		 4565 return 0;
4566
84fb1139 4567 case WM_VSCROLL:
5ac45f98 4568 case WM_MOUSEMOVE:
fbd6baed 4569 if (XINT (Vw32_mouse_move_interval) <= 0
84fb1139
KH		 4570 || (msg == WM_MOUSEMOVE && button_state == 0))
4571 {
fbd6baed 4572 wmsg.dwModifiers = w32_get_modifiers ();
84fb1139
KH		 4573 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4574 return 0;
4575 }
4576
4577 /* Hang onto mouse move and scroll messages for a bit, to avoid
4578 sending such events to Emacs faster than it can process them.
4579 If we get more events before the timer from the first message
4580 expires, we just replace the first message. */
4581
4582 if (saved_mouse_move_msg.msg.hwnd == 0)
4583 mouse_move_timer =
adcc3809
GV		 4584 SetTimer (hwnd, MOUSE_MOVE_ID,
4585 XINT (Vw32_mouse_move_interval), NULL);
84fb1139
KH		 4586
4587 /* Hold onto message for now. */
4588 saved_mouse_move_msg.msg.hwnd = hwnd;
4589 saved_mouse_move_msg.msg.message = msg;
4590 saved_mouse_move_msg.msg.wParam = wParam;
4591 saved_mouse_move_msg.msg.lParam = lParam;
4592 saved_mouse_move_msg.msg.time = GetMessageTime ();
fbd6baed 4593 saved_mouse_move_msg.dwModifiers = w32_get_modifiers ();
84fb1139
KH		 4594
4595 return 0;
4596
1edf84e7
GV		 4597 case WM_MOUSEWHEEL:
4598 wmsg.dwModifiers = w32_get_modifiers ();
4599 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4600 return 0;
4601
cb9e33d4
RS		 4602 case WM_DROPFILES:
4603 wmsg.dwModifiers = w32_get_modifiers ();
4604 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4605 return 0;
4606
84fb1139
KH		 4607 case WM_TIMER:
4608 /* Flush out saved messages if necessary. */
4609 if (wParam == mouse_button_timer)
5ac45f98 4610 {
84fb1139
KH		 4611 if (saved_mouse_button_msg.msg.hwnd)
4612 {
4613 post_msg (&saved_mouse_button_msg);
4614 saved_mouse_button_msg.msg.hwnd = 0;
4615 }
4616 KillTimer (hwnd, mouse_button_timer);
4617 mouse_button_timer = 0;
4618 }
4619 else if (wParam == mouse_move_timer)
4620 {
4621 if (saved_mouse_move_msg.msg.hwnd)
4622 {
4623 post_msg (&saved_mouse_move_msg);
4624 saved_mouse_move_msg.msg.hwnd = 0;
4625 }
4626 KillTimer (hwnd, mouse_move_timer);
4627 mouse_move_timer = 0;
5ac45f98 4628 }
5ac45f98 4629 return 0;
84fb1139
KH		 4630
4631 case WM_NCACTIVATE:
4632 /* Windows doesn't send us focus messages when putting up and
e9e23e23 4633 taking down a system popup dialog as for Ctrl-Alt-Del on Windows 95.
84fb1139
KH		 4634 The only indication we get that something happened is receiving
4635 this message afterwards. So this is a good time to reset our
4636 keyboard modifiers' state. */
4637 reset_modifiers ();
4638 goto dflt;
da36a4d6 4639
1edf84e7 4640 case WM_INITMENU:
487163ac
AI		 4641 button_state = 0;
4642 ReleaseCapture ();
1edf84e7
GV		 4643 /* We must ensure menu bar is fully constructed and up to date
4644 before allowing user interaction with it. To achieve this
4645 we send this message to the lisp thread and wait for a
4646 reply (whose value is not actually needed) to indicate that
4647 the menu bar is now ready for use, so we can now return.
4648
4649 To remain responsive in the meantime, we enter a nested message
4650 loop that can process all other messages.
4651
4652 However, we skip all this if the message results from calling
4653 TrackPopupMenu - in fact, we must NOT attempt to send the lisp
4654 thread a message because it is blocked on us at this point. We
4655 set menubar_active before calling TrackPopupMenu to indicate
4656 this (there is no possibility of confusion with real menubar
4657 being active). */
4658
4659 f = x_window_to_frame (dpyinfo, hwnd);
4660 if (f
4661 && (f->output_data.w32->menubar_active
4662 /* We can receive this message even in the absence of a
4663 menubar (ie. when the system menu is activated) - in this
4664 case we do NOT want to forward the message, otherwise it
4665 will cause the menubar to suddenly appear when the user
4666 had requested it to be turned off! */
4667 || f->output_data.w32->menubar_widget == NULL))
4668 return 0;
4669
4670 {
4671 deferred_msg msg_buf;
4672
4673 /* Detect if message has already been deferred; in this case
4674 we cannot return any sensible value to ignore this. */
4675 if (find_deferred_msg (hwnd, msg) != NULL)
4676 abort ();
4677
4678 return send_deferred_msg (&msg_buf, hwnd, msg, wParam, lParam);
4679 }
4680
4681 case WM_EXITMENULOOP:
4682 f = x_window_to_frame (dpyinfo, hwnd);
4683
4684 /* Indicate that menubar can be modified again. */
4685 if (f)
4686 f->output_data.w32->menubar_active = 0;
4687 goto dflt;
4688
126f2e35
JR		 4689 case WM_MENUSELECT:
4690 wmsg.dwModifiers = w32_get_modifiers ();
4691 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4692 return 0;
4693
87996783
GV		 4694 case WM_MEASUREITEM:
4695 f = x_window_to_frame (dpyinfo, hwnd);
4696 if (f)
4697 {
4698 MEASUREITEMSTRUCT * pMis = (MEASUREITEMSTRUCT *) lParam;
4699
4700 if (pMis->CtlType == ODT_MENU)
4701 {
4702 /* Work out dimensions for popup menu titles. */
4703 char * title = (char *) pMis->itemData;
4704 HDC hdc = GetDC (hwnd);
4705 HFONT menu_font = GetCurrentObject (hdc, OBJ_FONT);
4706 LOGFONT menu_logfont;
4707 HFONT old_font;
4708 SIZE size;
4709
4710 GetObject (menu_font, sizeof (menu_logfont), &menu_logfont);
4711 menu_logfont.lfWeight = FW_BOLD;
4712 menu_font = CreateFontIndirect (&menu_logfont);
4713 old_font = SelectObject (hdc, menu_font);
4714
dfff8a69
JR		 4715 pMis->itemHeight = GetSystemMetrics (SM_CYMENUSIZE);
4716 if (title)
4717 {
4718 GetTextExtentPoint32 (hdc, title, strlen (title), &size);
4719 pMis->itemWidth = size.cx;
4720 if (pMis->itemHeight < size.cy)
4721 pMis->itemHeight = size.cy;
4722 }
4723 else
4724 pMis->itemWidth = 0;
87996783
GV		 4725
4726 SelectObject (hdc, old_font);
4727 DeleteObject (menu_font);
4728 ReleaseDC (hwnd, hdc);
4729 return TRUE;
4730 }
4731 }
4732 return 0;
4733
4734 case WM_DRAWITEM:
4735 f = x_window_to_frame (dpyinfo, hwnd);
4736 if (f)
4737 {
4738 DRAWITEMSTRUCT * pDis = (DRAWITEMSTRUCT *) lParam;
4739
4740 if (pDis->CtlType == ODT_MENU)
4741 {
4742 /* Draw popup menu title. */
4743 char * title = (char *) pDis->itemData;
212da13b
JR		 4744 if (title)
4745 {
4746 HDC hdc = pDis->hDC;
4747 HFONT menu_font = GetCurrentObject (hdc, OBJ_FONT);
4748 LOGFONT menu_logfont;
4749 HFONT old_font;
4750
4751 GetObject (menu_font, sizeof (menu_logfont), &menu_logfont);
4752 menu_logfont.lfWeight = FW_BOLD;
4753 menu_font = CreateFontIndirect (&menu_logfont);
4754 old_font = SelectObject (hdc, menu_font);
4755
4756 /* Always draw title as if not selected. */
4757 ExtTextOut (hdc,
4758 pDis->rcItem.left
4759 + GetSystemMetrics (SM_CXMENUCHECK),
4760 pDis->rcItem.top,
4761 ETO_OPAQUE, &pDis->rcItem,
4762 title, strlen (title), NULL);
4763
4764 SelectObject (hdc, old_font);
4765 DeleteObject (menu_font);
4766 }
87996783
GV		 4767 return TRUE;
4768 }
4769 }
4770 return 0;
4771
1edf84e7
GV		 4772#if 0
4773 /* Still not right - can't distinguish between clicks in the
4774 client area of the frame from clicks forwarded from the scroll
4775 bars - may have to hook WM_NCHITTEST to remember the mouse
4776 position and then check if it is in the client area ourselves. */
4777 case WM_MOUSEACTIVATE:
4778 /* Discard the mouse click that activates a frame, allowing the
4779 user to click anywhere without changing point (or worse!).
4780 Don't eat mouse clicks on scrollbars though!! */
4781 if (LOWORD (lParam) == HTCLIENT )
4782 return MA_ACTIVATEANDEAT;
4783 goto dflt;
4784#endif
4785
1edf84e7 4786 case WM_ACTIVATEAPP:
ccc2d29c 4787 case WM_ACTIVATE:
1edf84e7
GV		 4788 case WM_WINDOWPOSCHANGED:
4789 case WM_SHOWWINDOW:
4790 /* Inform lisp thread that a frame might have just been obscured
4791 or exposed, so should recheck visibility of all frames. */
4792 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4793 goto dflt;
4794
da36a4d6 4795 case WM_SETFOCUS:
adcc3809
GV		 4796 dpyinfo->faked_key = 0;
4797 reset_modifiers ();
ccc2d29c
GV		 4798 register_hot_keys (hwnd);
4799 goto command;
8681157a 4800 case WM_KILLFOCUS:
ccc2d29c 4801 unregister_hot_keys (hwnd);
487163ac
AI		 4802 button_state = 0;
4803 ReleaseCapture ();
65906840
JR		 4804 /* Relinquish the system caret. */
4805 if (w32_system_caret_hwnd)
4806 {
4807 DestroyCaret ();
4808 w32_system_caret_hwnd = NULL;
4809 }
ee78dc32
GV		 4810 case WM_MOVE:
4811 case WM_SIZE:
ee78dc32 4812 case WM_COMMAND:
ccc2d29c 4813 command:
fbd6baed 4814 wmsg.dwModifiers = w32_get_modifiers ();
ee78dc32
GV		 4815 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4816 goto dflt;
8847d890
RS		 4817
4818 case WM_CLOSE:
fbd6baed 4819 wmsg.dwModifiers = w32_get_modifiers ();
8847d890
RS		 4820 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4821 return 0;
4822
ee78dc32
GV		 4823 case WM_WINDOWPOSCHANGING:
4824 {
4825 WINDOWPLACEMENT wp;
4826 LPWINDOWPOS lppos = (WINDOWPOS *) lParam;
1edf84e7
GV		 4827
4828 wp.length = sizeof (WINDOWPLACEMENT);
ee78dc32
GV		 4829 GetWindowPlacement (hwnd, &wp);
4830
1edf84e7 4831 if (wp.showCmd != SW_SHOWMINIMIZED && (lppos->flags & SWP_NOSIZE) == 0)
ee78dc32
GV		 4832 {
4833 RECT rect;
4834 int wdiff;
4835 int hdiff;
1edf84e7
GV		 4836 DWORD font_width;
4837 DWORD line_height;
4838 DWORD internal_border;
4839 DWORD scrollbar_extra;
ee78dc32
GV		 4840 RECT wr;
4841
5ac45f98 4842 wp.length = sizeof(wp);
ee78dc32
GV		 4843 GetWindowRect (hwnd, &wr);
4844
3c190163 4845 enter_crit ();
ee78dc32 4846
1edf84e7
GV		 4847 font_width = GetWindowLong (hwnd, WND_FONTWIDTH_INDEX);
4848 line_height = GetWindowLong (hwnd, WND_LINEHEIGHT_INDEX);
4849 internal_border = GetWindowLong (hwnd, WND_BORDER_INDEX);
4850 scrollbar_extra = GetWindowLong (hwnd, WND_SCROLLBAR_INDEX);
ee78dc32 4851
3c190163 4852 leave_crit ();
ee78dc32
GV		 4853
4854 memset (&rect, 0, sizeof (rect));
4855 AdjustWindowRect (&rect, GetWindowLong (hwnd, GWL_STYLE),
4856 GetMenu (hwnd) != NULL);
4857
1edf84e7
GV		 4858 /* Force width and height of client area to be exact
4859 multiples of the character cell dimensions. */
4860 wdiff = (lppos->cx - (rect.right - rect.left)
4861 - 2 * internal_border - scrollbar_extra)
4862 % font_width;
4863 hdiff = (lppos->cy - (rect.bottom - rect.top)
4864 - 2 * internal_border)
4865 % line_height;
ee78dc32
GV		 4866
4867 if (wdiff || hdiff)
4868 {
4869 /* For right/bottom sizing we can just fix the sizes.
4870 However for top/left sizing we will need to fix the X
4871 and Y positions as well. */
4872
4873 lppos->cx -= wdiff;
4874 lppos->cy -= hdiff;
4875
4876 if (wp.showCmd != SW_SHOWMAXIMIZED
1edf84e7 4877 && (lppos->flags & SWP_NOMOVE) == 0)
ee78dc32
GV		 4878 {
4879 if (lppos->x != wr.left || lppos->y != wr.top)
4880 {
4881 lppos->x += wdiff;
4882 lppos->y += hdiff;
4883 }
4884 else
4885 {
4886 lppos->flags |= SWP_NOMOVE;
4887 }
4888 }
4889
1edf84e7 4890 return 0;
ee78dc32
GV		 4891 }
4892 }
4893 }
ee78dc32
GV		 4894
4895 goto dflt;
1edf84e7 4896
b1f918f8
GV		 4897 case WM_GETMINMAXINFO:
4898 /* Hack to correct bug that allows Emacs frames to be resized
4899 below the Minimum Tracking Size. */
4900 ((LPMINMAXINFO) lParam)->ptMinTrackSize.y++;
bf853fee
AI		 4901 /* Hack to allow resizing the Emacs frame above the screen size.
4902 Note that Windows 9x limits coordinates to 16-bits. */
4903 ((LPMINMAXINFO) lParam)->ptMaxTrackSize.x = 32767;
4904 ((LPMINMAXINFO) lParam)->ptMaxTrackSize.y = 32767;
b1f918f8
GV		 4905 return 0;
4906
1edf84e7
GV		 4907 case WM_EMACS_CREATESCROLLBAR:
4908 return (LRESULT) w32_createscrollbar ((struct frame *) wParam,
4909 (struct scroll_bar *) lParam);
4910
5ac45f98 4911 case WM_EMACS_SHOWWINDOW:
1edf84e7
GV		 4912 return ShowWindow ((HWND) wParam, (WPARAM) lParam);
4913
dfdb4047 4914 case WM_EMACS_SETFOREGROUND:
ce6059da
AI		 4915 {
4916 HWND foreground_window;
4917 DWORD foreground_thread, retval;
4918
4919 /* On NT 5.0, and apparently Windows 98, it is necessary to
4920 attach to the thread that currently has focus in order to
4921 pull the focus away from it. */
4922 foreground_window = GetForegroundWindow ();
4923 foreground_thread = GetWindowThreadProcessId (foreground_window, NULL);
4924 if (!foreground_window
4925 || foreground_thread == GetCurrentThreadId ()
4926 || !AttachThreadInput (GetCurrentThreadId (),
4927 foreground_thread, TRUE))
4928 foreground_thread = 0;
4929
4930 retval = SetForegroundWindow ((HWND) wParam);
4931
4932 /* Detach from the previous foreground thread. */
4933 if (foreground_thread)
4934 AttachThreadInput (GetCurrentThreadId (),
4935 foreground_thread, FALSE);
4936
4937 return retval;
4938 }
dfdb4047 4939
5ac45f98
GV		 4940 case WM_EMACS_SETWINDOWPOS:
4941 {
1edf84e7
GV		 4942 WINDOWPOS * pos = (WINDOWPOS *) wParam;
4943 return SetWindowPos (hwnd, pos->hwndInsertAfter,
5ac45f98
GV		 4944 pos->x, pos->y, pos->cx, pos->cy, pos->flags);
4945 }
1edf84e7 4946
ee78dc32 4947 case WM_EMACS_DESTROYWINDOW:
cb9e33d4 4948 DragAcceptFiles ((HWND) wParam, FALSE);
1edf84e7
GV		 4949 return DestroyWindow ((HWND) wParam);
4950
65906840
JR		 4951 case WM_EMACS_DESTROY_CARET:
4952 w32_system_caret_hwnd = NULL;
4953 return DestroyCaret ();
4954
4955 case WM_EMACS_TRACK_CARET:
4956 /* If there is currently no system caret, create one. */
4957 if (w32_system_caret_hwnd == NULL)
4958 {
4959 w32_system_caret_hwnd = hwnd;
4960 CreateCaret (hwnd, NULL, w32_system_caret_width,
4961 w32_system_caret_height);
4962 }
4963 return SetCaretPos (w32_system_caret_x, w32_system_caret_y);
4964
1edf84e7
GV		 4965 case WM_EMACS_TRACKPOPUPMENU:
4966 {
4967 UINT flags;
4968 POINT *pos;
4969 int retval;
4970 pos = (POINT *)lParam;
4971 flags = TPM_CENTERALIGN;
4972 if (button_state & LMOUSE)
4973 flags |= TPM_LEFTBUTTON;
4974 else if (button_state & RMOUSE)
4975 flags |= TPM_RIGHTBUTTON;
4976
87996783
GV		 4977 /* Remember we did a SetCapture on the initial mouse down event,
4978 so for safety, we make sure the capture is cancelled now. */
4979 ReleaseCapture ();
490822ff 4980 button_state = 0;
87996783 4981
1edf84e7
GV		 4982 /* Use menubar_active to indicate that WM_INITMENU is from
4983 TrackPopupMenu below, and should be ignored. */
4984 f = x_window_to_frame (dpyinfo, hwnd);
4985 if (f)
4986 f->output_data.w32->menubar_active = 1;
4987
4988 if (TrackPopupMenu ((HMENU)wParam, flags, pos->x, pos->y,
4989 0, hwnd, NULL))
4990 {
4991 MSG amsg;
4992 /* Eat any mouse messages during popupmenu */
4993 while (PeekMessage (&amsg, hwnd, WM_MOUSEFIRST, WM_MOUSELAST,
4994 PM_REMOVE));
4995 /* Get the menu selection, if any */
4996 if (PeekMessage (&amsg, hwnd, WM_COMMAND, WM_COMMAND, PM_REMOVE))
4997 {
4998 retval = LOWORD (amsg.wParam);
4999 }
5000 else
5001 {
5002 retval = 0;
5003 }
1edf84e7
GV		 5004 }
5005 else
5006 {
5007 retval = -1;
5008 }
5009
5010 return retval;
5011 }
5012
ee78dc32 5013 default:
93fbe8b7
GV		 5014 /* Check for messages registered at runtime. */
5015 if (msg == msh_mousewheel)
5016 {
5017 wmsg.dwModifiers = w32_get_modifiers ();
5018 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
5019 return 0;
5020 }
5021
ee78dc32
GV		 5022 dflt:
5023 return DefWindowProc (hwnd, msg, wParam, lParam);
5024 }
5025
1edf84e7
GV		 5026
5027 /* The most common default return code for handled messages is 0. */
5028 return 0;
ee78dc32
GV		 5029}
5030
5031void
5032my_create_window (f)
5033 struct frame * f;
5034{
5035 MSG msg;
5036
1edf84e7
GV		 5037 if (!PostThreadMessage (dwWindowsThreadId, WM_EMACS_CREATEWINDOW, (WPARAM)f, 0))
5038 abort ();
ee78dc32
GV		 5039 GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
5040}
5041
fbd6baed 5042/* Create and set up the w32 window for frame F. */
ee78dc32
GV		 5043
5044static void
fbd6baed 5045w32_window (f, window_prompting, minibuffer_only)
ee78dc32
GV		 5046 struct frame *f;
5047 long window_prompting;
5048 int minibuffer_only;
5049{
5050 BLOCK_INPUT;
5051
5052 /* Use the resource name as the top-level window name
5053 for looking up resources. Make a non-Lisp copy
5054 for the window manager, so GC relocation won't bother it.
5055
5056 Elsewhere we specify the window name for the window manager. */
5057
5058 {
5059 char *str = (char *) XSTRING (Vx_resource_name)->data;
5060 f->namebuf = (char *) xmalloc (strlen (str) + 1);
5061 strcpy (f->namebuf, str);
5062 }
5063
5064 my_create_window (f);
5065
5066 validate_x_resource_name ();
5067
5068 /* x_set_name normally ignores requests to set the name if the
5069 requested name is the same as the current name. This is the one
5070 place where that assumption isn't correct; f->name is set, but
5071 the server hasn't been told. */
5072 {
5073 Lisp_Object name;
5074 int explicit = f->explicit_name;
5075
5076 f->explicit_name = 0;
5077 name = f->name;
5078 f->name = Qnil;
5079 x_set_name (f, name, explicit);
5080 }
5081
5082 UNBLOCK_INPUT;
5083
5084 if (!minibuffer_only && FRAME_EXTERNAL_MENU_BAR (f))
5085 initialize_frame_menubar (f);
5086
fbd6baed 5087 if (FRAME_W32_WINDOW (f) == 0)
ee78dc32
GV		 5088 error ("Unable to create window");
5089}
5090
5091/* Handle the icon stuff for this window. Perhaps later we might
5092 want an x_set_icon_position which can be called interactively as
5093 well. */
5094
5095static void
5096x_icon (f, parms)
5097 struct frame *f;
5098 Lisp_Object parms;
5099{
5100 Lisp_Object icon_x, icon_y;
5101
e9e23e23 5102 /* Set the position of the icon. Note that Windows 95 groups all
ee78dc32 5103 icons in the tray. */
6fc2811b
JR		 5104 icon_x = w32_get_arg (parms, Qicon_left, 0, 0, RES_TYPE_NUMBER);
5105 icon_y = w32_get_arg (parms, Qicon_top, 0, 0, RES_TYPE_NUMBER);
ee78dc32
GV		 5106 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
5107 {
b7826503
PJ		 5108 CHECK_NUMBER (icon_x);
5109 CHECK_NUMBER (icon_y);
ee78dc32
GV		 5110 }
5111 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
5112 error ("Both left and top icon corners of icon must be specified");
5113
5114 BLOCK_INPUT;
5115
5116 if (! EQ (icon_x, Qunbound))
5117 x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y));
5118
1edf84e7
GV		 5119#if 0 /* TODO */
5120 /* Start up iconic or window? */
5121 x_wm_set_window_state
6fc2811b 5122 (f, (EQ (w32_get_arg (parms, Qvisibility, 0, 0, RES_TYPE_SYMBOL), Qicon)
1edf84e7
GV		 5123 ? IconicState
5124 : NormalState));
5125
5126 x_text_icon (f, (char *) XSTRING ((!NILP (f->icon_name)
5127 ? f->icon_name
5128 : f->name))->data);
5129#endif
5130
ee78dc32
GV		 5131 UNBLOCK_INPUT;
5132}
5133
6fc2811b
JR		 5134
5135static void
5136x_make_gc (f)
5137 struct frame *f;
5138{
5139 XGCValues gc_values;
5140
5141 BLOCK_INPUT;
5142
5143 /* Create the GC's of this frame.
5144 Note that many default values are used. */
5145
5146 /* Normal video */
5147 gc_values.font = f->output_data.w32->font;
5148
5149 /* Cursor has cursor-color background, background-color foreground. */
5150 gc_values.foreground = FRAME_BACKGROUND_PIXEL (f);
5151 gc_values.background = f->output_data.w32->cursor_pixel;
5152 f->output_data.w32->cursor_gc
5153 = XCreateGC (NULL, FRAME_W32_WINDOW (f),
5154 (GCFont | GCForeground | GCBackground),
5155 &gc_values);
5156
5157 /* Reliefs. */
5158 f->output_data.w32->white_relief.gc = 0;
5159 f->output_data.w32->black_relief.gc = 0;
5160
5161 UNBLOCK_INPUT;
5162}
5163
5164
937e601e
AI		 5165/* Handler for signals raised during x_create_frame and
5166 x_create_top_frame. FRAME is the frame which is partially
5167 constructed. */
5168
5169static Lisp_Object
5170unwind_create_frame (frame)
5171 Lisp_Object frame;
5172{
5173 struct frame *f = XFRAME (frame);
5174
5175 /* If frame is ``official'', nothing to do. */
5176 if (!CONSP (Vframe_list) || !EQ (XCAR (Vframe_list), frame))
5177 {
5178#ifdef GLYPH_DEBUG
5179 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
5180#endif
5181
5182 x_free_frame_resources (f);
5183
5184 /* Check that reference counts are indeed correct. */
5185 xassert (dpyinfo->reference_count == dpyinfo_refcount);
5186 xassert (dpyinfo->image_cache->refcount == image_cache_refcount);
c844a81a
GM		 5187
5188 return Qt;
937e601e
AI		 5189 }
5190
5191 return Qnil;
5192}
5193
5194
ee78dc32
GV		 5195DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
5196 1, 1, 0,
74e1aeec
JR		 5197 doc: /* Make a new window, which is called a \"frame\" in Emacs terms.
5198Returns an Emacs frame object.
5199ALIST is an alist of frame parameters.
5200If the parameters specify that the frame should not have a minibuffer,
5201and do not specify a specific minibuffer window to use,
5202then `default-minibuffer-frame' must be a frame whose minibuffer can
5203be shared by the new frame.
5204
5205This function is an internal primitive--use `make-frame' instead. */)
ee78dc32
GV		 5206 (parms)
5207 Lisp_Object parms;
5208{
5209 struct frame *f;
5210 Lisp_Object frame, tem;
5211 Lisp_Object name;
5212 int minibuffer_only = 0;
5213 long window_prompting = 0;
5214 int width, height;
dc220243 5215 int count = BINDING_STACK_SIZE ();
1edf84e7 5216 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
ee78dc32 5217 Lisp_Object display;
6fc2811b 5218 struct w32_display_info *dpyinfo = NULL;
ee78dc32
GV		 5219 Lisp_Object parent;
5220 struct kboard *kb;
5221
4587b026
GV		 5222 check_w32 ();
5223
ee78dc32
GV		 5224 /* Use this general default value to start with
5225 until we know if this frame has a specified name. */
5226 Vx_resource_name = Vinvocation_name;
5227
6fc2811b 5228 display = w32_get_arg (parms, Qdisplay, 0, 0, RES_TYPE_STRING);
ee78dc32
GV		 5229 if (EQ (display, Qunbound))
5230 display = Qnil;
5231 dpyinfo = check_x_display_info (display);
5232#ifdef MULTI_KBOARD
5233 kb = dpyinfo->kboard;
5234#else
5235 kb = &the_only_kboard;
5236#endif
5237
6fc2811b 5238 name = w32_get_arg (parms, Qname, "name", "Name", RES_TYPE_STRING);
ee78dc32
GV		 5239 if (!STRINGP (name)
5240 && ! EQ (name, Qunbound)
5241 && ! NILP (name))
5242 error ("Invalid frame name--not a string or nil");
5243
5244 if (STRINGP (name))
5245 Vx_resource_name = name;
5246
5247 /* See if parent window is specified. */
6fc2811b 5248 parent = w32_get_arg (parms, Qparent_id, NULL, NULL, RES_TYPE_NUMBER);
ee78dc32
GV		 5249 if (EQ (parent, Qunbound))
5250 parent = Qnil;
5251 if (! NILP (parent))
b7826503 5252 CHECK_NUMBER (parent);
ee78dc32 5253
1edf84e7
GV		 5254 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
5255 /* No need to protect DISPLAY because that's not used after passing
5256 it to make_frame_without_minibuffer. */
5257 frame = Qnil;
5258 GCPRO4 (parms, parent, name, frame);
1660f34a
JR		 5259 tem = w32_get_arg (parms, Qminibuffer, "minibuffer", "Minibuffer",
5260 RES_TYPE_SYMBOL);
ee78dc32
GV		 5261 if (EQ (tem, Qnone) || NILP (tem))
5262 f = make_frame_without_minibuffer (Qnil, kb, display);
5263 else if (EQ (tem, Qonly))
5264 {
5265 f = make_minibuffer_frame ();
5266 minibuffer_only = 1;
5267 }
5268 else if (WINDOWP (tem))
5269 f = make_frame_without_minibuffer (tem, kb, display);
5270 else
5271 f = make_frame (1);
5272
1edf84e7
GV		 5273 XSETFRAME (frame, f);
5274
ee78dc32
GV		 5275 /* Note that Windows does support scroll bars. */
5276 FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
5ac45f98
GV		 5277 /* By default, make scrollbars the system standard width. */
5278 f->scroll_bar_pixel_width = GetSystemMetrics (SM_CXVSCROLL);
ee78dc32 5279
fbd6baed 5280 f->output_method = output_w32;
6fc2811b
JR		 5281 f->output_data.w32 =
5282 (struct w32_output *) xmalloc (sizeof (struct w32_output));
fbd6baed 5283 bzero (f->output_data.w32, sizeof (struct w32_output));
4587b026 5284 FRAME_FONTSET (f) = -1;
937e601e 5285 record_unwind_protect (unwind_create_frame, frame);
4587b026 5286
1edf84e7 5287 f->icon_name
6fc2811b 5288 = w32_get_arg (parms, Qicon_name, "iconName", "Title", RES_TYPE_STRING);
1edf84e7
GV		 5289 if (! STRINGP (f->icon_name))
5290 f->icon_name = Qnil;
5291
fbd6baed 5292/* FRAME_W32_DISPLAY_INFO (f) = dpyinfo; */
ee78dc32
GV		 5293#ifdef MULTI_KBOARD
5294 FRAME_KBOARD (f) = kb;
5295#endif
5296
5297 /* Specify the parent under which to make this window. */
5298
5299 if (!NILP (parent))
5300 {
1660f34a 5301 f->output_data.w32->parent_desc = (Window) XFASTINT (parent);
fbd6baed 5302 f->output_data.w32->explicit_parent = 1;
ee78dc32
GV		 5303 }
5304 else
5305 {
fbd6baed
GV		 5306 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
5307 f->output_data.w32->explicit_parent = 0;
ee78dc32
GV		 5308 }
5309
ee78dc32
GV		 5310 /* Set the name; the functions to which we pass f expect the name to
5311 be set. */
5312 if (EQ (name, Qunbound) || NILP (name))
5313 {
fbd6baed 5314 f->name = build_string (dpyinfo->w32_id_name);
ee78dc32
GV		 5315 f->explicit_name = 0;
5316 }
5317 else
5318 {
5319 f->name = name;
5320 f->explicit_name = 1;
5321 /* use the frame's title when getting resources for this frame. */
5322 specbind (Qx_resource_name, name);
5323 }
5324
5325 /* Extract the window parameters from the supplied values
5326 that are needed to determine window geometry. */
5327 {
5328 Lisp_Object font;
5329
6fc2811b
JR		 5330 font = w32_get_arg (parms, Qfont, "font", "Font", RES_TYPE_STRING);
5331
ee78dc32
GV		 5332 BLOCK_INPUT;
5333 /* First, try whatever font the caller has specified. */
5334 if (STRINGP (font))
4587b026
GV		 5335 {
5336 tem = Fquery_fontset (font, Qnil);
5337 if (STRINGP (tem))
5338 font = x_new_fontset (f, XSTRING (tem)->data);
5339 else
1075afa9 5340 font = x_new_font (f, XSTRING (font)->data);
4587b026 5341 }
ee78dc32
GV		 5342 /* Try out a font which we hope has bold and italic variations. */
5343 if (!STRINGP (font))
e39649be 5344 font = x_new_font (f, "-*-Courier New-normal-r-*-*-*-100-*-*-c-*-iso8859-1");
ee78dc32 5345 if (! STRINGP (font))
6fc2811b 5346 font = x_new_font (f, "-*-Courier-normal-r-*-*-13-*-*-*-c-*-iso8859-1");
ee78dc32
GV		 5347 /* If those didn't work, look for something which will at least work. */
5348 if (! STRINGP (font))
6fc2811b 5349 font = x_new_font (f, "-*-Fixedsys-normal-r-*-*-12-*-*-*-c-*-iso8859-1");
ee78dc32
GV		 5350 UNBLOCK_INPUT;
5351 if (! STRINGP (font))
1edf84e7 5352 font = build_string ("Fixedsys");
ee78dc32
GV		 5353
5354 x_default_parameter (f, parms, Qfont, font,
6fc2811b 5355 "font", "Font", RES_TYPE_STRING);
ee78dc32
GV		 5356 }
5357
5358 x_default_parameter (f, parms, Qborder_width, make_number (2),
1660f34a 5359 "borderWidth", "BorderWidth", RES_TYPE_NUMBER);
ee78dc32
GV		 5360 /* This defaults to 2 in order to match xterm. We recognize either
5361 internalBorderWidth or internalBorder (which is what xterm calls
5362 it). */
5363 if (NILP (Fassq (Qinternal_border_width, parms)))
5364 {
5365 Lisp_Object value;
5366
6fc2811b 5367 value = w32_get_arg (parms, Qinternal_border_width,
1660f34a 5368 "internalBorder", "InternalBorder", RES_TYPE_NUMBER);
ee78dc32
GV		 5369 if (! EQ (value, Qunbound))
5370 parms = Fcons (Fcons (Qinternal_border_width, value),
5371 parms);
5372 }
1edf84e7 5373 /* Default internalBorderWidth to 0 on Windows to match other programs. */
ee78dc32 5374 x_default_parameter (f, parms, Qinternal_border_width, make_number (0),
1660f34a
JR		 5375 "internalBorderWidth", "InternalBorder", RES_TYPE_NUMBER);
5376 x_default_parameter (f, parms, Qvertical_scroll_bars, Qright,
5377 "verticalScrollBars", "ScrollBars", RES_TYPE_SYMBOL);
ee78dc32
GV		 5378
5379 /* Also do the stuff which must be set before the window exists. */
5380 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
6fc2811b 5381 "foreground", "Foreground", RES_TYPE_STRING);
ee78dc32 5382 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
6fc2811b 5383 "background", "Background", RES_TYPE_STRING);
ee78dc32 5384 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
6fc2811b 5385 "pointerColor", "Foreground", RES_TYPE_STRING);
ee78dc32 5386 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
6fc2811b 5387 "cursorColor", "Foreground", RES_TYPE_STRING);
ee78dc32 5388 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
6fc2811b
JR		 5389 "borderColor", "BorderColor", RES_TYPE_STRING);
5390 x_default_parameter (f, parms, Qscreen_gamma, Qnil,
5391 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT);
dfff8a69
JR		 5392 x_default_parameter (f, parms, Qline_spacing, Qnil,
5393 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER);
6fc2811b 5394
ee78dc32 5395
6fc2811b
JR		 5396 /* Init faces before x_default_parameter is called for scroll-bar
5397 parameters because that function calls x_set_scroll_bar_width,
5398 which calls change_frame_size, which calls Fset_window_buffer,
5399 which runs hooks, which call Fvertical_motion. At the end, we
5400 end up in init_iterator with a null face cache, which should not
5401 happen. */
5402 init_frame_faces (f);
5403
ee78dc32 5404 x_default_parameter (f, parms, Qmenu_bar_lines, make_number (1),
6fc2811b
JR		 5405 "menuBar", "MenuBar", RES_TYPE_NUMBER);
5406 x_default_parameter (f, parms, Qtool_bar_lines, make_number (0),
5407 "toolBar", "ToolBar", RES_TYPE_NUMBER);
1edf84e7 5408 x_default_parameter (f, parms, Qbuffer_predicate, Qnil,
6fc2811b 5409 "bufferPredicate", "BufferPredicate", RES_TYPE_SYMBOL);
1edf84e7 5410 x_default_parameter (f, parms, Qtitle, Qnil,
6fc2811b 5411 "title", "Title", RES_TYPE_STRING);
ee78dc32 5412
fbd6baed
GV		 5413 f->output_data.w32->dwStyle = WS_OVERLAPPEDWINDOW;
5414 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
3cf3436e
JR		 5415
5416 /* Add the tool-bar height to the initial frame height so that the
5417 user gets a text display area of the size he specified with -g or
5418 via .Xdefaults. Later changes of the tool-bar height don't
5419 change the frame size. This is done so that users can create
5420 tall Emacs frames without having to guess how tall the tool-bar
5421 will get. */
5422 if (FRAME_TOOL_BAR_LINES (f))
5423 {
5424 int margin, relief, bar_height;
5425
a05e2bae 5426 relief = (tool_bar_button_relief >= 0
3cf3436e
JR		 5427 ? tool_bar_button_relief
5428 : DEFAULT_TOOL_BAR_BUTTON_RELIEF);
5429
5430 if (INTEGERP (Vtool_bar_button_margin)
5431 && XINT (Vtool_bar_button_margin) > 0)
5432 margin = XFASTINT (Vtool_bar_button_margin);
5433 else if (CONSP (Vtool_bar_button_margin)
5434 && INTEGERP (XCDR (Vtool_bar_button_margin))
5435 && XINT (XCDR (Vtool_bar_button_margin)) > 0)
5436 margin = XFASTINT (XCDR (Vtool_bar_button_margin));
5437 else
5438 margin = 0;
5439
5440 bar_height = DEFAULT_TOOL_BAR_IMAGE_HEIGHT + 2 * margin + 2 * relief;
5441 f->height += (bar_height + CANON_Y_UNIT (f) - 1) / CANON_Y_UNIT (f);
5442 }
5443
ee78dc32
GV		 5444 window_prompting = x_figure_window_size (f, parms);
5445
5446 if (window_prompting & XNegative)
5447 {
5448 if (window_prompting & YNegative)
fbd6baed 5449 f->output_data.w32->win_gravity = SouthEastGravity;
ee78dc32 5450 else
fbd6baed 5451 f->output_data.w32->win_gravity = NorthEastGravity;
ee78dc32
GV		 5452 }
5453 else
5454 {
5455 if (window_prompting & YNegative)
fbd6baed 5456 f->output_data.w32->win_gravity = SouthWestGravity;
ee78dc32 5457 else
fbd6baed 5458 f->output_data.w32->win_gravity = NorthWestGravity;
ee78dc32
GV		 5459 }
5460
fbd6baed 5461 f->output_data.w32->size_hint_flags = window_prompting;
ee78dc32 5462
6fc2811b
JR		 5463 tem = w32_get_arg (parms, Qunsplittable, 0, 0, RES_TYPE_BOOLEAN);
5464 f->no_split = minibuffer_only || EQ (tem, Qt);
5465
fbd6baed 5466 w32_window (f, window_prompting, minibuffer_only);
ee78dc32 5467 x_icon (f, parms);
6fc2811b
JR		 5468
5469 x_make_gc (f);
5470
5471 /* Now consider the frame official. */
5472 FRAME_W32_DISPLAY_INFO (f)->reference_count++;
5473 Vframe_list = Fcons (frame, Vframe_list);
ee78dc32
GV		 5474
5475 /* We need to do this after creating the window, so that the
5476 icon-creation functions can say whose icon they're describing. */
5477 x_default_parameter (f, parms, Qicon_type, Qnil,
6fc2811b 5478 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL);
ee78dc32
GV		 5479
5480 x_default_parameter (f, parms, Qauto_raise, Qnil,
6fc2811b 5481 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
ee78dc32 5482 x_default_parameter (f, parms, Qauto_lower, Qnil,
6fc2811b 5483 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
ee78dc32 5484 x_default_parameter (f, parms, Qcursor_type, Qbox,
6fc2811b
JR		 5485 "cursorType", "CursorType", RES_TYPE_SYMBOL);
5486 x_default_parameter (f, parms, Qscroll_bar_width, Qnil,
5487 "scrollBarWidth", "ScrollBarWidth", RES_TYPE_NUMBER);
ee78dc32
GV		 5488
5489 /* Dimensions, especially f->height, must be done via change_frame_size.
5490 Change will not be effected unless different from the current
5491 f->height. */
5492 width = f->width;
5493 height = f->height;
dc220243 5494
1026b400
RS		 5495 f->height = 0;
5496 SET_FRAME_WIDTH (f, 0);
6fc2811b
JR		 5497 change_frame_size (f, height, width, 1, 0, 0);
5498
6fc2811b
JR		 5499 /* Tell the server what size and position, etc, we want, and how
5500 badly we want them. This should be done after we have the menu
5501 bar so that its size can be taken into account. */
ee78dc32
GV		 5502 BLOCK_INPUT;
5503 x_wm_set_size_hint (f, window_prompting, 0);
5504 UNBLOCK_INPUT;
5505
4694d762
JR		 5506 /* Set up faces after all frame parameters are known. This call
5507 also merges in face attributes specified for new frames. If we
5508 don't do this, the `menu' face for instance won't have the right
5509 colors, and the menu bar won't appear in the specified colors for
5510 new frames. */
5511 call1 (Qface_set_after_frame_default, frame);
5512
6fc2811b
JR		 5513 /* Make the window appear on the frame and enable display, unless
5514 the caller says not to. However, with explicit parent, Emacs
5515 cannot control visibility, so don't try. */
fbd6baed 5516 if (! f->output_data.w32->explicit_parent)
ee78dc32
GV		 5517 {
5518 Lisp_Object visibility;
5519
6fc2811b 5520 visibility = w32_get_arg (parms, Qvisibility, 0, 0, RES_TYPE_SYMBOL);
ee78dc32
GV		 5521 if (EQ (visibility, Qunbound))
5522 visibility = Qt;
5523
5524 if (EQ (visibility, Qicon))
5525 x_iconify_frame (f);
5526 else if (! NILP (visibility))
5527 x_make_frame_visible (f);
5528 else
5529 /* Must have been Qnil. */
5530 ;
5531 }
6fc2811b 5532 UNGCPRO;
9e57df62
GM		 5533
5534 /* Make sure windows on this frame appear in calls to next-window
5535 and similar functions. */
5536 Vwindow_list = Qnil;
5537
ee78dc32
GV		 5538 return unbind_to (count, frame);
5539}
5540
5541/* FRAME is used only to get a handle on the X display. We don't pass the
5542 display info directly because we're called from frame.c, which doesn't
5543 know about that structure. */
5544Lisp_Object
5545x_get_focus_frame (frame)
5546 struct frame *frame;
5547{
fbd6baed 5548 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (frame);
ee78dc32 5549 Lisp_Object xfocus;
fbd6baed 5550 if (! dpyinfo->w32_focus_frame)
ee78dc32
GV		 5551 return Qnil;
5552
fbd6baed 5553 XSETFRAME (xfocus, dpyinfo->w32_focus_frame);
ee78dc32
GV		 5554 return xfocus;
5555}
1edf84e7
GV		 5556
5557DEFUN ("w32-focus-frame", Fw32_focus_frame, Sw32_focus_frame, 1, 1, 0,
74e1aeec 5558 doc: /* Give FRAME input focus, raising to foreground if necessary. */)
1edf84e7
GV		 5559 (frame)
5560 Lisp_Object frame;
5561{
5562 x_focus_on_frame (check_x_frame (frame));
5563 return Qnil;
5564}
5565
ee78dc32 5566\f
767b1ff0
JR		 5567/* Return the charset portion of a font name. */
5568char * xlfd_charset_of_font (char * fontname)
5569{
5570 char *charset, *encoding;
5571
5572 encoding = strrchr(fontname, '-');
ceb12877 5573 if (!encoding || encoding == fontname)
767b1ff0
JR		 5574 return NULL;
5575
478ea067
AI		 5576 for (charset = encoding - 1; charset >= fontname; charset--)
5577 if (*charset == '-')
5578 break;
767b1ff0 5579
478ea067 5580 if (charset == fontname || strcmp(charset, "-*-*") == 0)
767b1ff0
JR		 5581 return NULL;
5582
5583 return charset + 1;
5584}
5585
33d52f9c
GV		 5586struct font_info *w32_load_bdf_font (struct frame *f, char *fontname,
5587 int size, char* filename);
8edb0a6f 5588static Lisp_Object w32_list_bdf_fonts (Lisp_Object pattern, int max_names);
c7501041
EZ		 5589static BOOL w32_to_x_font (LOGFONT * lplf, char * lpxstr, int len,
5590 char * charset);
5591static BOOL x_to_w32_font (char *lpxstr, LOGFONT *lplogfont);
33d52f9c 5592
8edb0a6f 5593static struct font_info *
33d52f9c 5594w32_load_system_font (f,fontname,size)
55dcfc15
AI		 5595 struct frame *f;
5596 char * fontname;
5597 int size;
ee78dc32 5598{
4587b026
GV		 5599 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
5600 Lisp_Object font_names;
5601
4587b026
GV		 5602 /* Get a list of all the fonts that match this name. Once we
5603 have a list of matching fonts, we compare them against the fonts
5604 we already have loaded by comparing names. */
5605 font_names = w32_list_fonts (f, build_string (fontname), size, 100);
5606
5607 if (!NILP (font_names))
3c190163 5608 {
4587b026
GV		 5609 Lisp_Object tail;
5610 int i;
4587b026
GV		 5611
5612 /* First check if any are already loaded, as that is cheaper
5613 than loading another one. */
5614 for (i = 0; i < dpyinfo->n_fonts; i++)
8e713be6 5615 for (tail = font_names; CONSP (tail); tail = XCDR (tail))
6fc2811b
JR		 5616 if (dpyinfo->font_table[i].name
5617 && (!strcmp (dpyinfo->font_table[i].name,
5618 XSTRING (XCAR (tail))->data)
5619 || !strcmp (dpyinfo->font_table[i].full_name,
5620 XSTRING (XCAR (tail))->data)))
4587b026 5621 return (dpyinfo->font_table + i);
6fc2811b 5622
8e713be6 5623 fontname = (char *) XSTRING (XCAR (font_names))->data;
4587b026 5624 }
1075afa9 5625 else if (w32_strict_fontnames)
5ca0cd71
GV		 5626 {
5627 /* If EnumFontFamiliesEx was available, we got a full list of
5628 fonts back so stop now to avoid the possibility of loading a
5629 random font. If we had to fall back to EnumFontFamilies, the
5630 list is incomplete, so continue whether the font we want was
5631 listed or not. */
5632 HMODULE gdi32 = GetModuleHandle ("gdi32.dll");
5633 FARPROC enum_font_families_ex
1075afa9 5634 = GetProcAddress (gdi32, "EnumFontFamiliesExA");
5ca0cd71
GV		 5635 if (enum_font_families_ex)
5636 return NULL;
5637 }
4587b026
GV		 5638
5639 /* Load the font and add it to the table. */
5640 {
767b1ff0 5641 char *full_name, *encoding, *charset;
4587b026
GV		 5642 XFontStruct *font;
5643 struct font_info *fontp;
3c190163 5644 LOGFONT lf;
4587b026 5645 BOOL ok;
19c291d3 5646 int codepage;
6fc2811b 5647 int i;
5ac45f98 5648
4587b026 5649 if (!fontname || !x_to_w32_font (fontname, &lf))
3c190163 5650 return (NULL);
5ac45f98 5651
4587b026
GV		 5652 if (!*lf.lfFaceName)
5653 /* If no name was specified for the font, we get a random font
5654 from CreateFontIndirect - this is not particularly
5655 desirable, especially since CreateFontIndirect does not
5656 fill out the missing name in lf, so we never know what we
5657 ended up with. */
5658 return NULL;
5659
3c190163 5660 font = (XFontStruct *) xmalloc (sizeof (XFontStruct));
c6be3860 5661 bzero (font, sizeof (*font));
5ac45f98 5662
33d52f9c
GV		 5663 /* Set bdf to NULL to indicate that this is a Windows font. */
5664 font->bdf = NULL;
5ac45f98 5665
3c190163 5666 BLOCK_INPUT;
5ac45f98
GV		 5667
5668 font->hfont = CreateFontIndirect (&lf);
ee78dc32 5669
1a292d24
AI		 5670 if (font->hfont == NULL)
5671 {
5672 ok = FALSE;
5673 }
5674 else
5675 {
5676 HDC hdc;
5677 HANDLE oldobj;
19c291d3
AI		 5678
5679 codepage = w32_codepage_for_font (fontname);
1a292d24
AI		 5680
5681 hdc = GetDC (dpyinfo->root_window);
5682 oldobj = SelectObject (hdc, font->hfont);
5c6682be 5683
1a292d24 5684 ok = GetTextMetrics (hdc, &font->tm);
5c6682be
JR		 5685 if (codepage == CP_UNICODE)
5686 font->double_byte_p = 1;
5687 else
8b77111c
AI		 5688 {
5689 /* Unfortunately, some fonts (eg. MingLiU, a big5 ttf font)
5690 don't report themselves as double byte fonts, when
5691 patently they are. So instead of trusting
5692 GetFontLanguageInfo, we check the properties of the
5693 codepage directly, since that is ultimately what we are
5694 working from anyway. */
5695 /* font->double_byte_p = GetFontLanguageInfo(hdc) & GCP_DBCS; */
5696 CPINFO cpi = {0};
5697 GetCPInfo (codepage, &cpi);
5698 font->double_byte_p = cpi.MaxCharSize > 1;
5699 }
5c6682be 5700
1a292d24
AI		 5701 SelectObject (hdc, oldobj);
5702 ReleaseDC (dpyinfo->root_window, hdc);
6fc2811b
JR		 5703 /* Fill out details in lf according to the font that was
5704 actually loaded. */
5705 lf.lfHeight = font->tm.tmInternalLeading - font->tm.tmHeight;
5706 lf.lfWidth = font->tm.tmAveCharWidth;
5707 lf.lfWeight = font->tm.tmWeight;
5708 lf.lfItalic = font->tm.tmItalic;
5709 lf.lfCharSet = font->tm.tmCharSet;
5710 lf.lfPitchAndFamily = ((font->tm.tmPitchAndFamily & TMPF_FIXED_PITCH)
d88c567c 5711 ? VARIABLE_PITCH : FIXED_PITCH);
6fc2811b
JR		 5712 lf.lfOutPrecision = ((font->tm.tmPitchAndFamily & TMPF_VECTOR)
5713 ? OUT_STROKE_PRECIS : OUT_STRING_PRECIS);
c6be3860
AI		 5714
5715 w32_cache_char_metrics (font);
1a292d24 5716 }
5ac45f98 5717
1a292d24 5718 UNBLOCK_INPUT;
5ac45f98 5719
4587b026
GV		 5720 if (!ok)
5721 {
1a292d24
AI		 5722 w32_unload_font (dpyinfo, font);
5723 return (NULL);
5724 }
ee78dc32 5725
6fc2811b
JR		 5726 /* Find a free slot in the font table. */
5727 for (i = 0; i < dpyinfo->n_fonts; ++i)
5728 if (dpyinfo->font_table[i].name == NULL)
5729 break;
5730
5731 /* If no free slot found, maybe enlarge the font table. */
5732 if (i == dpyinfo->n_fonts
5733 && dpyinfo->n_fonts == dpyinfo->font_table_size)
4587b026 5734 {
6fc2811b
JR		 5735 int sz;
5736 dpyinfo->font_table_size = max (16, 2 * dpyinfo->font_table_size);
5737 sz = dpyinfo->font_table_size * sizeof *dpyinfo->font_table;
4587b026 5738 dpyinfo->font_table
6fc2811b 5739 = (struct font_info *) xrealloc (dpyinfo->font_table, sz);
4587b026
GV		 5740 }
5741
6fc2811b
JR		 5742 fontp = dpyinfo->font_table + i;
5743 if (i == dpyinfo->n_fonts)
5744 ++dpyinfo->n_fonts;
4587b026
GV		 5745
5746 /* Now fill in the slots of *FONTP. */
5747 BLOCK_INPUT;
5748 fontp->font = font;
6fc2811b 5749 fontp->font_idx = i;
4587b026
GV		 5750 fontp->name = (char *) xmalloc (strlen (fontname) + 1);
5751 bcopy (fontname, fontp->name, strlen (fontname) + 1);
5752
767b1ff0
JR		 5753 charset = xlfd_charset_of_font (fontname);
5754
19c291d3
AI		 5755 /* Cache the W32 codepage for a font. This makes w32_encode_char
5756 (called for every glyph during redisplay) much faster. */
5757 fontp->codepage = codepage;
5758
4587b026
GV		 5759 /* Work out the font's full name. */
5760 full_name = (char *)xmalloc (100);
767b1ff0 5761 if (full_name && w32_to_x_font (&lf, full_name, 100, charset))
4587b026
GV		 5762 fontp->full_name = full_name;
5763 else
5764 {
5765 /* If all else fails - just use the name we used to load it. */
5766 xfree (full_name);
5767 fontp->full_name = fontp->name;
5768 }
5769
5770 fontp->size = FONT_WIDTH (font);
5771 fontp->height = FONT_HEIGHT (font);
5772
5773 /* The slot `encoding' specifies how to map a character
5774 code-points (0x20..0x7F or 0x2020..0x7F7F) of each charset to
126f2e35
JR		 5775 the font code-points (0:0x20..0x7F, 1:0xA0..0xFF), or
5776 (0:0x20..0x7F, 1:0xA0..0xFF,
5777 (0:0x2020..0x7F7F, 1:0xA0A0..0xFFFF, 3:0x20A0..0x7FFF,
4587b026 5778 2:0xA020..0xFF7F). For the moment, we don't know which charset
6fc2811b 5779 uses this font. So, we set information in fontp->encoding[1]
4587b026
GV		 5780 which is never used by any charset. If mapping can't be
5781 decided, set FONT_ENCODING_NOT_DECIDED. */
33d52f9c
GV		 5782
5783 /* SJIS fonts need to be set to type 4, all others seem to work as
5784 type FONT_ENCODING_NOT_DECIDED. */
5785 encoding = strrchr (fontp->name, '-');
5786 if (encoding && stricmp (encoding+1, "sjis") == 0)
1c885fe1 5787 fontp->encoding[1] = 4;
33d52f9c 5788 else
1c885fe1 5789 fontp->encoding[1] = FONT_ENCODING_NOT_DECIDED;
4587b026
GV		 5790
5791 /* The following three values are set to 0 under W32, which is
5792 what they get set to if XGetFontProperty fails under X. */
5793 fontp->baseline_offset = 0;
5794 fontp->relative_compose = 0;
33d52f9c 5795 fontp->default_ascent = 0;
4587b026 5796
6fc2811b
JR		 5797 /* Set global flag fonts_changed_p to non-zero if the font loaded
5798 has a character with a smaller width than any other character
5799 before, or if the font loaded has a smalle>r height than any
5800 other font loaded before. If this happens, it will make a
5801 glyph matrix reallocation necessary. */
5802 fonts_changed_p = x_compute_min_glyph_bounds (f);
4587b026 5803 UNBLOCK_INPUT;
4587b026
GV		 5804 return fontp;
5805 }
5806}
5807
33d52f9c
GV		 5808/* Load font named FONTNAME of size SIZE for frame F, and return a
5809 pointer to the structure font_info while allocating it dynamically.
5810 If loading fails, return NULL. */
5811struct font_info *
5812w32_load_font (f,fontname,size)
5813struct frame *f;
5814char * fontname;
5815int size;
5816{
5817 Lisp_Object bdf_fonts;
5818 struct font_info *retval = NULL;
5819
8edb0a6f 5820 bdf_fonts = w32_list_bdf_fonts (build_string (fontname), 1);
33d52f9c
GV		 5821
5822 while (!retval && CONSP (bdf_fonts))
5823 {
5824 char *bdf_name, *bdf_file;
5825 Lisp_Object bdf_pair;
5826
8e713be6
KR		 5827 bdf_name = XSTRING (XCAR (bdf_fonts))->data;
5828 bdf_pair = Fassoc (XCAR (bdf_fonts), Vw32_bdf_filename_alist);
5829 bdf_file = XSTRING (XCDR (bdf_pair))->data;
33d52f9c
GV		 5830
5831 retval = w32_load_bdf_font (f, bdf_name, size, bdf_file);
5832
8e713be6 5833 bdf_fonts = XCDR (bdf_fonts);
33d52f9c
GV		 5834 }
5835
5836 if (retval)
5837 return retval;
5838
5839 return w32_load_system_font(f, fontname, size);
5840}
5841
5842
ee78dc32 5843void
fbd6baed
GV		 5844w32_unload_font (dpyinfo, font)
5845 struct w32_display_info *dpyinfo;
ee78dc32
GV		 5846 XFontStruct * font;
5847{
5848 if (font)
5849 {
c6be3860 5850 if (font->per_char) xfree (font->per_char);
33d52f9c
GV		 5851 if (font->bdf) w32_free_bdf_font (font->bdf);
5852
3c190163 5853 if (font->hfont) DeleteObject(font->hfont);
ee78dc32
GV		 5854 xfree (font);
5855 }
5856}
5857
fbd6baed 5858/* The font conversion stuff between x and w32 */
ee78dc32
GV		 5859
5860/* X font string is as follows (from faces.el)
5861 * (let ((- "[-?]")
5862 * (foundry "[^-]+")
5863 * (family "[^-]+")
5864 * (weight "\\(bold\\|demibold\\|medium\\)") ; 1
5865 * (weight\? "\\([^-]*\\)") ; 1
5866 * (slant "\\([ior]\\)") ; 2
5867 * (slant\? "\\([^-]?\\)") ; 2
5868 * (swidth "\\([^-]*\\)") ; 3
5869 * (adstyle "[^-]*") ; 4
5870 * (pixelsize "[0-9]+")
5871 * (pointsize "[0-9][0-9]+")
5872 * (resx "[0-9][0-9]+")
5873 * (resy "[0-9][0-9]+")
5874 * (spacing "[cmp?*]")
5875 * (avgwidth "[0-9]+")
5876 * (registry "[^-]+")
5877 * (encoding "[^-]+")
5878 * )
ee78dc32 5879 */
ee78dc32 5880
8edb0a6f 5881static LONG
fbd6baed 5882x_to_w32_weight (lpw)
ee78dc32
GV		 5883 char * lpw;
5884{
5885 if (!lpw) return (FW_DONTCARE);
5ac45f98
GV		 5886
5887 if (stricmp (lpw,"heavy") == 0) return FW_HEAVY;
5888 else if (stricmp (lpw,"extrabold") == 0) return FW_EXTRABOLD;
5889 else if (stricmp (lpw,"bold") == 0) return FW_BOLD;
5890 else if (stricmp (lpw,"demibold") == 0) return FW_SEMIBOLD;
1edf84e7 5891 else if (stricmp (lpw,"semibold") == 0) return FW_SEMIBOLD;
5ac45f98
GV		 5892 else if (stricmp (lpw,"medium") == 0) return FW_MEDIUM;
5893 else if (stricmp (lpw,"normal") == 0) return FW_NORMAL;
5894 else if (stricmp (lpw,"light") == 0) return FW_LIGHT;
5895 else if (stricmp (lpw,"extralight") == 0) return FW_EXTRALIGHT;
5896 else if (stricmp (lpw,"thin") == 0) return FW_THIN;
ee78dc32 5897 else
5ac45f98 5898 return FW_DONTCARE;
ee78dc32
GV		 5899}
5900
5ac45f98 5901
8edb0a6f 5902static char *
fbd6baed 5903w32_to_x_weight (fnweight)
ee78dc32
GV		 5904 int fnweight;
5905{
5ac45f98
GV		 5906 if (fnweight >= FW_HEAVY) return "heavy";
5907 if (fnweight >= FW_EXTRABOLD) return "extrabold";
5908 if (fnweight >= FW_BOLD) return "bold";
03f8fb34 5909 if (fnweight >= FW_SEMIBOLD) return "demibold";
5ac45f98
GV		 5910 if (fnweight >= FW_MEDIUM) return "medium";
5911 if (fnweight >= FW_NORMAL) return "normal";
5912 if (fnweight >= FW_LIGHT) return "light";
5913 if (fnweight >= FW_EXTRALIGHT) return "extralight";
5914 if (fnweight >= FW_THIN) return "thin";
5915 else
5916 return "*";
5917}
5918
8edb0a6f 5919static LONG
fbd6baed 5920x_to_w32_charset (lpcs)
5ac45f98
GV		 5921 char * lpcs;
5922{
767b1ff0 5923 Lisp_Object this_entry, w32_charset;
8b77111c
AI		 5924 char *charset;
5925 int len = strlen (lpcs);
5926
5927 /* Support "*-#nnn" format for unknown charsets. */
5928 if (strncmp (lpcs, "*-#", 3) == 0)
5929 return atoi (lpcs + 3);
5930
5931 /* Handle wildcards by ignoring them; eg. treat "big5*-*" as "big5". */
5932 charset = alloca (len + 1);
5933 strcpy (charset, lpcs);
5934 lpcs = strchr (charset, '*');
5935 if (lpcs)
5936 *lpcs = 0;
4587b026 5937
dfff8a69
JR		 5938 /* Look through w32-charset-info-alist for the character set.
5939 Format of each entry is
5940 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
5941 */
8b77111c 5942 this_entry = Fassoc (build_string(charset), Vw32_charset_info_alist);
4587b026 5943
767b1ff0
JR		 5944 if (NILP(this_entry))
5945 {
5946 /* At startup, we want iso8859-1 fonts to come up properly. */
8b77111c 5947 if (stricmp(charset, "iso8859-1") == 0)
767b1ff0
JR		 5948 return ANSI_CHARSET;
5949 else
5950 return DEFAULT_CHARSET;
5951 }
5952
5953 w32_charset = Fcar (Fcdr (this_entry));
5954
5955 // Translate Lisp symbol to number.
5956 if (w32_charset == Qw32_charset_ansi)
5957 return ANSI_CHARSET;
5958 if (w32_charset == Qw32_charset_symbol)
5959 return SYMBOL_CHARSET;
5960 if (w32_charset == Qw32_charset_shiftjis)
5961 return SHIFTJIS_CHARSET;
5962 if (w32_charset == Qw32_charset_hangeul)
5963 return HANGEUL_CHARSET;
5964 if (w32_charset == Qw32_charset_chinesebig5)
5965 return CHINESEBIG5_CHARSET;
5966 if (w32_charset == Qw32_charset_gb2312)
5967 return GB2312_CHARSET;
5968 if (w32_charset == Qw32_charset_oem)
5969 return OEM_CHARSET;
dfff8a69 5970#ifdef JOHAB_CHARSET
767b1ff0
JR		 5971 if (w32_charset == Qw32_charset_johab)
5972 return JOHAB_CHARSET;
5973 if (w32_charset == Qw32_charset_easteurope)
5974 return EASTEUROPE_CHARSET;
5975 if (w32_charset == Qw32_charset_turkish)
5976 return TURKISH_CHARSET;
5977 if (w32_charset == Qw32_charset_baltic)
5978 return BALTIC_CHARSET;
5979 if (w32_charset == Qw32_charset_russian)
5980 return RUSSIAN_CHARSET;
5981 if (w32_charset == Qw32_charset_arabic)
5982 return ARABIC_CHARSET;
5983 if (w32_charset == Qw32_charset_greek)
5984 return GREEK_CHARSET;
5985 if (w32_charset == Qw32_charset_hebrew)
5986 return HEBREW_CHARSET;
5987 if (w32_charset == Qw32_charset_vietnamese)
5988 return VIETNAMESE_CHARSET;
5989 if (w32_charset == Qw32_charset_thai)
5990 return THAI_CHARSET;
5991 if (w32_charset == Qw32_charset_mac)
5992 return MAC_CHARSET;
dfff8a69 5993#endif /* JOHAB_CHARSET */
5ac45f98 5994#ifdef UNICODE_CHARSET
767b1ff0
JR		 5995 if (w32_charset == Qw32_charset_unicode)
5996 return UNICODE_CHARSET;
5ac45f98 5997#endif
dfff8a69
JR		 5998
5999 return DEFAULT_CHARSET;
5ac45f98
GV		 6000}
6001
dfff8a69 6002
8edb0a6f 6003static char *
fbd6baed 6004w32_to_x_charset (fncharset)
5ac45f98
GV		 6005 int fncharset;
6006{
5e905a57 6007 static char buf[32];
767b1ff0 6008 Lisp_Object charset_type;
1edf84e7 6009
5ac45f98
GV		 6010 switch (fncharset)
6011 {
767b1ff0
JR		 6012 case ANSI_CHARSET:
6013 /* Handle startup case of w32-charset-info-alist not
6014 being set up yet. */
6015 if (NILP(Vw32_charset_info_alist))
6016 return "iso8859-1";
6017 charset_type = Qw32_charset_ansi;
6018 break;
6019 case DEFAULT_CHARSET:
6020 charset_type = Qw32_charset_default;
6021 break;
6022 case SYMBOL_CHARSET:
6023 charset_type = Qw32_charset_symbol;
6024 break;
6025 case SHIFTJIS_CHARSET:
6026 charset_type = Qw32_charset_shiftjis;
6027 break;
6028 case HANGEUL_CHARSET:
6029 charset_type = Qw32_charset_hangeul;
6030 break;
6031 case GB2312_CHARSET:
6032 charset_type = Qw32_charset_gb2312;
6033 break;
6034 case CHINESEBIG5_CHARSET:
6035 charset_type = Qw32_charset_chinesebig5;
6036 break;
6037 case OEM_CHARSET:
6038 charset_type = Qw32_charset_oem;
6039 break;
4587b026
GV		 6040
6041 /* More recent versions of Windows (95 and NT4.0) define more
6042 character sets. */
6043#ifdef EASTEUROPE_CHARSET
767b1ff0
JR		 6044 case EASTEUROPE_CHARSET:
6045 charset_type = Qw32_charset_easteurope;
6046 break;
6047 case TURKISH_CHARSET:
6048 charset_type = Qw32_charset_turkish;
6049 break;
6050 case BALTIC_CHARSET:
6051 charset_type = Qw32_charset_baltic;
6052 break;
33d52f9c 6053 case RUSSIAN_CHARSET:
767b1ff0
JR		 6054 charset_type = Qw32_charset_russian;
6055 break;
6056 case ARABIC_CHARSET:
6057 charset_type = Qw32_charset_arabic;
6058 break;
6059 case GREEK_CHARSET:
6060 charset_type = Qw32_charset_greek;
6061 break;
6062 case HEBREW_CHARSET:
6063 charset_type = Qw32_charset_hebrew;
6064 break;
6065 case VIETNAMESE_CHARSET:
6066 charset_type = Qw32_charset_vietnamese;
6067 break;
6068 case THAI_CHARSET:
6069 charset_type = Qw32_charset_thai;
6070 break;
6071 case MAC_CHARSET:
6072 charset_type = Qw32_charset_mac;
6073 break;
6074 case JOHAB_CHARSET:
6075 charset_type = Qw32_charset_johab;
6076 break;
4587b026
GV		 6077#endif
6078
5ac45f98 6079#ifdef UNICODE_CHARSET
767b1ff0
JR		 6080 case UNICODE_CHARSET:
6081 charset_type = Qw32_charset_unicode;
6082 break;
5ac45f98 6083#endif
767b1ff0
JR		 6084 default:
6085 /* Encode numerical value of unknown charset. */
6086 sprintf (buf, "*-#%u", fncharset);
6087 return buf;
5ac45f98 6088 }
767b1ff0
JR		 6089
6090 {
6091 Lisp_Object rest;
6092 char * best_match = NULL;
6093
6094 /* Look through w32-charset-info-alist for the character set.
6095 Prefer ISO codepages, and prefer lower numbers in the ISO
6096 range. Only return charsets for codepages which are installed.
6097
6098 Format of each entry is
6099 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
6100 */
6101 for (rest = Vw32_charset_info_alist; CONSP (rest); rest = XCDR (rest))
6102 {
6103 char * x_charset;
6104 Lisp_Object w32_charset;
6105 Lisp_Object codepage;
6106
6107 Lisp_Object this_entry = XCAR (rest);
6108
6109 /* Skip invalid entries in alist. */
6110 if (!CONSP (this_entry) || !STRINGP (XCAR (this_entry))
6111 || !CONSP (XCDR (this_entry))
6112 || !SYMBOLP (XCAR (XCDR (this_entry))))
6113 continue;
6114
6115 x_charset = XSTRING (XCAR (this_entry))->data;
6116 w32_charset = XCAR (XCDR (this_entry));
6117 codepage = XCDR (XCDR (this_entry));
6118
6119 /* Look for Same charset and a valid codepage (or non-int
6120 which means ignore). */
6121 if (w32_charset == charset_type
6122 && (!INTEGERP (codepage) || codepage == CP_DEFAULT
6123 || IsValidCodePage (XINT (codepage))))
6124 {
6125 /* If we don't have a match already, then this is the
6126 best. */
6127 if (!best_match)
6128 best_match = x_charset;
6129 /* If this is an ISO codepage, and the best so far isn't,
6130 then this is better. */
6131 else if (stricmp (best_match, "iso") != 0
6132 && stricmp (x_charset, "iso") == 0)
6133 best_match = x_charset;
6134 /* If both are ISO8859 codepages, choose the one with the
6135 lowest number in the encoding field. */
6136 else if (stricmp (best_match, "iso8859-") == 0
6137 && stricmp (x_charset, "iso8859-") == 0)
6138 {
6139 int best_enc = atoi (best_match + 8);
6140 int this_enc = atoi (x_charset + 8);
6141 if (this_enc > 0 && this_enc < best_enc)
6142 best_match = x_charset;
6143 }
6144 }
6145 }
6146
6147 /* If no match, encode the numeric value. */
6148 if (!best_match)
6149 {
6150 sprintf (buf, "*-#%u", fncharset);
6151 return buf;
6152 }
6153
5e905a57
JR		 6154 strncpy(buf, best_match, 31);
6155 buf[31] = '\0';
767b1ff0
JR		 6156 return buf;
6157 }
ee78dc32
GV		 6158}
6159
dfff8a69
JR		 6160
6161/* Get the Windows codepage corresponding to the specified font. The
6162 charset info in the font name is used to look up
6163 w32-charset-to-codepage-alist. */
6164int
6165w32_codepage_for_font (char *fontname)
6166{
767b1ff0
JR		 6167 Lisp_Object codepage, entry;
6168 char *charset_str, *charset, *end;
dfff8a69 6169
767b1ff0 6170 if (NILP (Vw32_charset_info_alist))
dfff8a69
JR		 6171 return CP_DEFAULT;
6172
767b1ff0
JR		 6173 /* Extract charset part of font string. */
6174 charset = xlfd_charset_of_font (fontname);
6175
6176 if (!charset)
ceb12877 6177 return CP_UNKNOWN;
767b1ff0 6178
8b77111c 6179 charset_str = (char *) alloca (strlen (charset) + 1);
767b1ff0
JR		 6180 strcpy (charset_str, charset);
6181
8b77111c 6182#if 0
dfff8a69
JR		 6183 /* Remove leading "*-". */
6184 if (strncmp ("*-", charset_str, 2) == 0)
6185 charset = charset_str + 2;
6186 else
8b77111c 6187#endif
dfff8a69
JR		 6188 charset = charset_str;
6189
6190 /* Stop match at wildcard (including preceding '-'). */
6191 if (end = strchr (charset, '*'))
6192 {
6193 if (end > charset && *(end-1) == '-')
6194 end--;
6195 *end = '\0';
6196 }
6197
767b1ff0
JR		 6198 entry = Fassoc (build_string(charset), Vw32_charset_info_alist);
6199 if (NILP (entry))
ceb12877 6200 return CP_UNKNOWN;
767b1ff0
JR		 6201
6202 codepage = Fcdr (Fcdr (entry));
6203
6204 if (NILP (codepage))
6205 return CP_8BIT;
6206 else if (XFASTINT (codepage) == XFASTINT (Qt))
6207 return CP_UNICODE;
6208 else if (INTEGERP (codepage))
dfff8a69
JR		 6209 return XINT (codepage);
6210 else
ceb12877 6211 return CP_UNKNOWN;
dfff8a69
JR		 6212}
6213
6214
8edb0a6f 6215static BOOL
767b1ff0 6216w32_to_x_font (lplogfont, lpxstr, len, specific_charset)
ee78dc32
GV		 6217 LOGFONT * lplogfont;
6218 char * lpxstr;
6219 int len;
767b1ff0 6220 char * specific_charset;
ee78dc32 6221{
6fc2811b 6222 char* fonttype;
f46e6225 6223 char *fontname;
3cb20f4a
RS		 6224 char height_pixels[8];
6225 char height_dpi[8];
6226 char width_pixels[8];
4587b026 6227 char *fontname_dash;
d88c567c
JR		 6228 int display_resy = one_w32_display_info.resy;
6229 int display_resx = one_w32_display_info.resx;
f46e6225
GV		 6230 int bufsz;
6231 struct coding_system coding;
3cb20f4a
RS		 6232
6233 if (!lpxstr) abort ();
ee78dc32 6234
3cb20f4a
RS		 6235 if (!lplogfont)
6236 return FALSE;
6237
6fc2811b
JR		 6238 if (lplogfont->lfOutPrecision == OUT_STRING_PRECIS)
6239 fonttype = "raster";
6240 else if (lplogfont->lfOutPrecision == OUT_STROKE_PRECIS)
6241 fonttype = "outline";
6242 else
6243 fonttype = "unknown";
6244
f46e6225
GV		 6245 setup_coding_system (Fcheck_coding_system (Vw32_system_coding_system),
6246 &coding);
aab5ac44
KH		 6247 coding.src_multibyte = 0;
6248 coding.dst_multibyte = 1;
f46e6225
GV		 6249 coding.mode |= CODING_MODE_LAST_BLOCK;
6250 bufsz = decoding_buffer_size (&coding, LF_FACESIZE);
6251
6252 fontname = alloca(sizeof(*fontname) * bufsz);
6253 decode_coding (&coding, lplogfont->lfFaceName, fontname,
6254 strlen(lplogfont->lfFaceName), bufsz - 1);
6255 *(fontname + coding.produced) = '\0';
4587b026
GV		 6256
6257 /* Replace dashes with underscores so the dashes are not
f46e6225 6258 misinterpreted. */
4587b026
GV		 6259 fontname_dash = fontname;
6260 while (fontname_dash = strchr (fontname_dash, '-'))
6261 *fontname_dash = '_';
6262
3cb20f4a 6263 if (lplogfont->lfHeight)
ee78dc32 6264 {
3cb20f4a
RS		 6265 sprintf (height_pixels, "%u", abs (lplogfont->lfHeight));
6266 sprintf (height_dpi, "%u",
33d52f9c 6267 abs (lplogfont->lfHeight) * 720 / display_resy);
5ac45f98
GV		 6268 }
6269 else
ee78dc32 6270 {
3cb20f4a
RS		 6271 strcpy (height_pixels, "*");
6272 strcpy (height_dpi, "*");
ee78dc32 6273 }
3cb20f4a
RS		 6274 if (lplogfont->lfWidth)
6275 sprintf (width_pixels, "%u", lplogfont->lfWidth * 10);
6276 else
6277 strcpy (width_pixels, "*");
6278
6279 _snprintf (lpxstr, len - 1,
6fc2811b
JR		 6280 "-%s-%s-%s-%c-normal-normal-%s-%s-%d-%d-%c-%s-%s",
6281 fonttype, /* foundry */
4587b026
GV		 6282 fontname, /* family */
6283 w32_to_x_weight (lplogfont->lfWeight), /* weight */
6284 lplogfont->lfItalic?'i':'r', /* slant */
6285 /* setwidth name */
6286 /* add style name */
6287 height_pixels, /* pixel size */
6288 height_dpi, /* point size */
33d52f9c
GV		 6289 display_resx, /* resx */
6290 display_resy, /* resy */
4587b026
GV		 6291 ((lplogfont->lfPitchAndFamily & 0x3) == VARIABLE_PITCH)
6292 ? 'p' : 'c', /* spacing */
6293 width_pixels, /* avg width */
767b1ff0
JR		 6294 specific_charset ? specific_charset
6295 : w32_to_x_charset (lplogfont->lfCharSet)
6296 /* charset registry and encoding */
3cb20f4a
RS		 6297 );
6298
ee78dc32
GV		 6299 lpxstr[len - 1] = 0; /* just to be sure */
6300 return (TRUE);
6301}
6302
8edb0a6f 6303static BOOL
fbd6baed 6304x_to_w32_font (lpxstr, lplogfont)
ee78dc32
GV		 6305 char * lpxstr;
6306 LOGFONT * lplogfont;
6307{
f46e6225
GV		 6308 struct coding_system coding;
6309
ee78dc32 6310 if (!lplogfont) return (FALSE);
f46e6225 6311
ee78dc32 6312 memset (lplogfont, 0, sizeof (*lplogfont));
5ac45f98 6313
1a292d24 6314 /* Set default value for each field. */
771c47d5 6315#if 1
ee78dc32
GV		 6316 lplogfont->lfOutPrecision = OUT_DEFAULT_PRECIS;
6317 lplogfont->lfClipPrecision = CLIP_DEFAULT_PRECIS;
6318 lplogfont->lfQuality = DEFAULT_QUALITY;
5ac45f98
GV		 6319#else
6320 /* go for maximum quality */
6321 lplogfont->lfOutPrecision = OUT_STROKE_PRECIS;
6322 lplogfont->lfClipPrecision = CLIP_STROKE_PRECIS;
6323 lplogfont->lfQuality = PROOF_QUALITY;
6324#endif
6325
1a292d24
AI		 6326 lplogfont->lfCharSet = DEFAULT_CHARSET;
6327 lplogfont->lfWeight = FW_DONTCARE;
6328 lplogfont->lfPitchAndFamily = DEFAULT_PITCH | FF_DONTCARE;
6329
5ac45f98
GV		 6330 if (!lpxstr)
6331 return FALSE;
6332
6333 /* Provide a simple escape mechanism for specifying Windows font names
6334 * directly -- if font spec does not beginning with '-', assume this
6335 * format:
6336 * "<font name>[:height in pixels[:width in pixels[:weight]]]"
6337 */
ee78dc32 6338
5ac45f98
GV		 6339 if (*lpxstr == '-')
6340 {
33d52f9c
GV		 6341 int fields, tem;
6342 char name[50], weight[20], slant, pitch, pixels[10], height[10],
8b77111c 6343 width[10], resy[10], remainder[50];
5ac45f98 6344 char * encoding;
d98c0337 6345 int dpi = one_w32_display_info.resy;
5ac45f98
GV		 6346
6347 fields = sscanf (lpxstr,
8b77111c 6348 "-%*[^-]-%49[^-]-%19[^-]-%c-%*[^-]-%*[^-]-%9[^-]-%9[^-]-%*[^-]-%9[^-]-%c-%9[^-]-%49s",
33d52f9c 6349 name, weight, &slant, pixels, height, resy, &pitch, width, remainder);
8b77111c
AI		 6350 if (fields == EOF)
6351 return (FALSE);
6352
6353 /* In the general case when wildcards cover more than one field,
6354 we don't know which field is which, so don't fill any in.
6355 However, we need to cope with this particular form, which is
6356 generated by font_list_1 (invoked by try_font_list):
6357 "-raster-6x10-*-gb2312*-*"
6358 and make sure to correctly parse the charset field. */
6359 if (fields == 3)
6360 {
6361 fields = sscanf (lpxstr,
6362 "-%*[^-]-%49[^-]-*-%49s",
6363 name, remainder);
6364 }
6365 else if (fields < 9)
6366 {
6367 fields = 0;
6368 remainder[0] = 0;
6369 }
6fc2811b 6370
5ac45f98
GV		 6371 if (fields > 0 && name[0] != '*')
6372 {
8ea3e054
RS		 6373 int bufsize;
6374 unsigned char *buf;
6375
f46e6225
GV		 6376 setup_coding_system
6377 (Fcheck_coding_system (Vw32_system_coding_system), &coding);
aab5ac44
KH		 6378 coding.src_multibyte = 1;
6379 coding.dst_multibyte = 1;
8ea3e054
RS		 6380 bufsize = encoding_buffer_size (&coding, strlen (name));
6381 buf = (unsigned char *) alloca (bufsize);
f46e6225 6382 coding.mode |= CODING_MODE_LAST_BLOCK;
8ea3e054
RS		 6383 encode_coding (&coding, name, buf, strlen (name), bufsize);
6384 if (coding.produced >= LF_FACESIZE)
6385 coding.produced = LF_FACESIZE - 1;
6386 buf[coding.produced] = 0;
6387 strcpy (lplogfont->lfFaceName, buf);
5ac45f98
GV		 6388 }
6389 else
6390 {
6fc2811b 6391 lplogfont->lfFaceName[0] = '\0';
5ac45f98
GV		 6392 }
6393
6394 fields--;
6395
fbd6baed 6396 lplogfont->lfWeight = x_to_w32_weight ((fields > 0 ? weight : ""));
5ac45f98
GV		 6397
6398 fields--;
6399
c8874f14 6400 lplogfont->lfItalic = (fields > 0 && slant == 'i');
5ac45f98
GV		 6401
6402 fields--;
6403
6404 if (fields > 0 && pixels[0] != '*')
6405 lplogfont->lfHeight = atoi (pixels);
6406
6407 fields--;
5ac45f98 6408 fields--;
33d52f9c
GV		 6409 if (fields > 0 && resy[0] != '*')
6410 {
6fc2811b 6411 tem = atoi (resy);
33d52f9c
GV		 6412 if (tem > 0) dpi = tem;
6413 }
5ac45f98 6414
33d52f9c
GV		 6415 if (fields > -1 && lplogfont->lfHeight == 0 && height[0] != '*')
6416 lplogfont->lfHeight = atoi (height) * dpi / 720;
6417
6418 if (fields > 0)
5ac45f98
GV		 6419 lplogfont->lfPitchAndFamily =
6420 (fields > 0 && pitch == 'p') ? VARIABLE_PITCH : FIXED_PITCH;
6421
6422 fields--;
6423
6424 if (fields > 0 && width[0] != '*')
6425 lplogfont->lfWidth = atoi (width) / 10;
6426
6427 fields--;
6428
4587b026 6429 /* Strip the trailing '-' if present. (it shouldn't be, as it
d88c567c 6430 fails the test against xlfd-tight-regexp in fontset.el). */
3c190163 6431 {
5ac45f98
GV		 6432 int len = strlen (remainder);
6433 if (len > 0 && remainder[len-1] == '-')
6434 remainder[len-1] = 0;
ee78dc32 6435 }
5ac45f98 6436 encoding = remainder;
8b77111c 6437#if 0
5ac45f98
GV		 6438 if (strncmp (encoding, "*-", 2) == 0)
6439 encoding += 2;
8b77111c
AI		 6440#endif
6441 lplogfont->lfCharSet = x_to_w32_charset (encoding);
5ac45f98
GV		 6442 }
6443 else
6444 {
6445 int fields;
6446 char name[100], height[10], width[10], weight[20];
a1a80b40 6447
5ac45f98
GV		 6448 fields = sscanf (lpxstr,
6449 "%99[^:]:%9[^:]:%9[^:]:%19s",
6450 name, height, width, weight);
6451
6452 if (fields == EOF) return (FALSE);
6453
6454 if (fields > 0)
6455 {
6456 strncpy (lplogfont->lfFaceName,name, LF_FACESIZE);
6457 lplogfont->lfFaceName[LF_FACESIZE-1] = 0;
6458 }
6459 else
6460 {
6461 lplogfont->lfFaceName[0] = 0;
6462 }
6463
6464 fields--;
6465
6466 if (fields > 0)
6467 lplogfont->lfHeight = atoi (height);
6468
6469 fields--;
6470
6471 if (fields > 0)
6472 lplogfont->lfWidth = atoi (width);
6473
6474 fields--;
6475
fbd6baed 6476 lplogfont->lfWeight = x_to_w32_weight ((fields > 0 ? weight : ""));
5ac45f98
GV		 6477 }
6478
6479 /* This makes TrueType fonts work better. */
6480 lplogfont->lfHeight = - abs (lplogfont->lfHeight);
6fc2811b 6481
ee78dc32
GV		 6482 return (TRUE);
6483}
6484
d88c567c
JR		 6485/* Strip the pixel height and point height from the given xlfd, and
6486 return the pixel height. If no pixel height is specified, calculate
6487 one from the point height, or if that isn't defined either, return
6488 0 (which usually signifies a scalable font).
6489*/
8edb0a6f
JR		 6490static int
6491xlfd_strip_height (char *fontname)
d88c567c 6492{
8edb0a6f 6493 int pixel_height, field_number;
d88c567c
JR		 6494 char *read_from, *write_to;
6495
6496 xassert (fontname);
6497
6498 pixel_height = field_number = 0;
6499 write_to = NULL;
6500
6501 /* Look for height fields. */
6502 for (read_from = fontname; *read_from; read_from++)
6503 {
6504 if (*read_from == '-')
6505 {
6506 field_number++;
6507 if (field_number == 7) /* Pixel height. */
6508 {
6509 read_from++;
6510 write_to = read_from;
6511
6512 /* Find end of field. */
6513 for (;*read_from && *read_from != '-'; read_from++)
6514 ;
6515
6516 /* Split the fontname at end of field. */
6517 if (*read_from)
6518 {
6519 *read_from = '\0';
6520 read_from++;
6521 }
6522 pixel_height = atoi (write_to);
6523 /* Blank out field. */
6524 if (read_from > write_to)
6525 {
6526 *write_to = '-';
6527 write_to++;
6528 }
767b1ff0 6529 /* If the pixel height field is at the end (partial xlfd),
d88c567c
JR		 6530 return now. */
6531 else
6532 return pixel_height;
6533
6534 /* If we got a pixel height, the point height can be
6535 ignored. Just blank it out and break now. */
6536 if (pixel_height)
6537 {
6538 /* Find end of point size field. */
6539 for (; *read_from && *read_from != '-'; read_from++)
6540 ;
6541
6542 if (*read_from)
6543 read_from++;
6544
6545 /* Blank out the point size field. */
6546 if (read_from > write_to)
6547 {
6548 *write_to = '-';
6549 write_to++;
6550 }
6551 else
6552 return pixel_height;
6553
6554 break;
6555 }
6556 /* If the point height is already blank, break now. */
6557 if (*read_from == '-')
6558 {
6559 read_from++;
6560 break;
6561 }
6562 }
6563 else if (field_number == 8)
6564 {
6565 /* If we didn't get a pixel height, try to get the point
6566 height and convert that. */
6567 int point_size;
6568 char *point_size_start = read_from++;
6569
6570 /* Find end of field. */
6571 for (; *read_from && *read_from != '-'; read_from++)
6572 ;
6573
6574 if (*read_from)
6575 {
6576 *read_from = '\0';
6577 read_from++;
6578 }
6579
6580 point_size = atoi (point_size_start);
6581
6582 /* Convert to pixel height. */
6583 pixel_height = point_size
6584 * one_w32_display_info.height_in / 720;
6585
6586 /* Blank out this field and break. */
6587 *write_to = '-';
6588 write_to++;
6589 break;
6590 }
6591 }
6592 }
6593
6594 /* Shift the rest of the font spec into place. */
6595 if (write_to && read_from > write_to)
6596 {
6597 for (; *read_from; read_from++, write_to++)
6598 *write_to = *read_from;
6599 *write_to = '\0';
6600 }
6601
6602 return pixel_height;
6603}
6604
6fc2811b 6605/* Assume parameter 1 is fully qualified, no wildcards. */
8edb0a6f 6606static BOOL
6fc2811b
JR		 6607w32_font_match (fontname, pattern)
6608 char * fontname;
6609 char * pattern;
ee78dc32 6610{
e7c72122 6611 char *regex = alloca (strlen (pattern) * 2 + 3);
d88c567c 6612 char *font_name_copy = alloca (strlen (fontname) + 1);
6fc2811b 6613 char *ptr;
ee78dc32 6614
d88c567c
JR		 6615 /* Copy fontname so we can modify it during comparison. */
6616 strcpy (font_name_copy, fontname);
6617
6fc2811b
JR		 6618 ptr = regex;
6619 *ptr++ = '^';
ee78dc32 6620
6fc2811b
JR		 6621 /* Turn pattern into a regexp and do a regexp match. */
6622 for (; *pattern; pattern++)
6623 {
6624 if (*pattern == '?')
6625 *ptr++ = '.';
6626 else if (*pattern == '*')
6627 {
6628 *ptr++ = '.';
6629 *ptr++ = '*';
6630 }
33d52f9c 6631 else
6fc2811b 6632 *ptr++ = *pattern;
ee78dc32 6633 }
6fc2811b
JR		 6634 *ptr = '$';
6635 *(ptr + 1) = '\0';
6636
d88c567c
JR		 6637 /* Strip out font heights and compare them seperately, since
6638 rounding error can cause mismatches. This also allows a
6639 comparison between a font that declares only a pixel height and a
6640 pattern that declares the point height.
6641 */
6642 {
6643 int font_height, pattern_height;
6644
6645 font_height = xlfd_strip_height (font_name_copy);
6646 pattern_height = xlfd_strip_height (regex);
6647
6648 /* Compare now, and don't bother doing expensive regexp matching
6649 if the heights differ. */
6650 if (font_height && pattern_height && (font_height != pattern_height))
6651 return FALSE;
6652 }
6653
6fc2811b 6654 return (fast_c_string_match_ignore_case (build_string (regex),
d88c567c 6655 font_name_copy) >= 0);
ee78dc32
GV		 6656}
6657
5ca0cd71
GV		 6658/* Callback functions, and a structure holding info they need, for
6659 listing system fonts on W32. We need one set of functions to do the
6660 job properly, but these don't work on NT 3.51 and earlier, so we
6661 have a second set which don't handle character sets properly to
6662 fall back on.
6663
6664 In both cases, there are two passes made. The first pass gets one
6665 font from each family, the second pass lists all the fonts from
6666 each family. */
6667
ee78dc32
GV		 6668typedef struct enumfont_t
6669{
6670 HDC hdc;
6671 int numFonts;
3cb20f4a 6672 LOGFONT logfont;
ee78dc32
GV		 6673 XFontStruct *size_ref;
6674 Lisp_Object *pattern;
ee78dc32
GV		 6675 Lisp_Object *tail;
6676} enumfont_t;
6677
8edb0a6f 6678static int CALLBACK
ee78dc32
GV		 6679enum_font_cb2 (lplf, lptm, FontType, lpef)
6680 ENUMLOGFONT * lplf;
6681 NEWTEXTMETRIC * lptm;
6682 int FontType;
6683 enumfont_t * lpef;
6684{
66895301
JR		 6685 /* Ignore struck out and underlined versions of fonts. */
6686 if (lplf->elfLogFont.lfStrikeOut || lplf->elfLogFont.lfUnderline)
6687 return 1;
6688
6689 /* Only return fonts with names starting with @ if they were
6690 explicitly specified, since Microsoft uses an initial @ to
6691 denote fonts for vertical writing, without providing a more
6692 convenient way of identifying them. */
6693 if (lplf->elfLogFont.lfFaceName[0] == '@'
6694 && lpef->logfont.lfFaceName[0] != '@')
5e905a57
JR		 6695 return 1;
6696
4587b026
GV		 6697 /* Check that the character set matches if it was specified */
6698 if (lpef->logfont.lfCharSet != DEFAULT_CHARSET &&
6699 lplf->elfLogFont.lfCharSet != lpef->logfont.lfCharSet)
5e905a57 6700 return 1;
4587b026 6701
ee78dc32
GV		 6702 {
6703 char buf[100];
4587b026 6704 Lisp_Object width = Qnil;
767b1ff0 6705 char *charset = NULL;
ee78dc32 6706
6fc2811b
JR		 6707 /* Truetype fonts do not report their true metrics until loaded */
6708 if (FontType != RASTER_FONTTYPE)
3cb20f4a 6709 {
6fc2811b
JR		 6710 if (!NILP (*(lpef->pattern)))
6711 {
6712 /* Scalable fonts are as big as you want them to be. */
6713 lplf->elfLogFont.lfHeight = lpef->logfont.lfHeight;
6714 lplf->elfLogFont.lfWidth = lpef->logfont.lfWidth;
6715 width = make_number (lpef->logfont.lfWidth);
6716 }
6717 else
6718 {
6719 lplf->elfLogFont.lfHeight = 0;
6720 lplf->elfLogFont.lfWidth = 0;
6721 }
3cb20f4a 6722 }
6fc2811b 6723
f46e6225
GV		 6724 /* Make sure the height used here is the same as everywhere
6725 else (ie character height, not cell height). */
6fc2811b
JR		 6726 if (lplf->elfLogFont.lfHeight > 0)
6727 {
6728 /* lptm can be trusted for RASTER fonts, but not scalable ones. */
6729 if (FontType == RASTER_FONTTYPE)
6730 lplf->elfLogFont.lfHeight = lptm->tmInternalLeading - lptm->tmHeight;
6731 else
6732 lplf->elfLogFont.lfHeight = -lplf->elfLogFont.lfHeight;
6733 }
4587b026 6734
767b1ff0
JR		 6735 if (!NILP (*(lpef->pattern)))
6736 {
6737 charset = xlfd_charset_of_font (XSTRING(*(lpef->pattern))->data);
6738
6739 /* Ensure that charset is valid for this font. */
6740 if (charset
6741 && (x_to_w32_charset (charset) != lplf->elfLogFont.lfCharSet))
6742 charset = NULL;
6743 }
6744
6745 /* TODO: List all relevant charsets if charset not specified. */
6746 if (!w32_to_x_font (&(lplf->elfLogFont), buf, 100, charset))
66895301 6747 return 1;
ee78dc32 6748
5ca0cd71
GV		 6749 if (NILP (*(lpef->pattern))
6750 || w32_font_match (buf, XSTRING (*(lpef->pattern))->data))
ee78dc32 6751 {
4587b026 6752 *lpef->tail = Fcons (Fcons (build_string (buf), width), Qnil);
8e713be6 6753 lpef->tail = &(XCDR (*lpef->tail));
ee78dc32
GV		 6754 lpef->numFonts++;
6755 }
6756 }
6fc2811b 6757
5e905a57 6758 return 1;
ee78dc32
GV		 6759}
6760
8edb0a6f 6761static int CALLBACK
ee78dc32
GV		 6762enum_font_cb1 (lplf, lptm, FontType, lpef)
6763 ENUMLOGFONT * lplf;
6764 NEWTEXTMETRIC * lptm;
6765 int FontType;
6766 enumfont_t * lpef;
6767{
6768 return EnumFontFamilies (lpef->hdc,
6769 lplf->elfLogFont.lfFaceName,
6770 (FONTENUMPROC) enum_font_cb2,
6771 (LPARAM) lpef);
6772}
6773
6774
8edb0a6f 6775static int CALLBACK
5ca0cd71
GV		 6776enum_fontex_cb2 (lplf, lptm, font_type, lpef)
6777 ENUMLOGFONTEX * lplf;
6778 NEWTEXTMETRICEX * lptm;
6779 int font_type;
6780 enumfont_t * lpef;
6781{
6782 /* We are not interested in the extra info we get back from the 'Ex
6783 version - only the fact that we get character set variations
6784 enumerated seperately. */
6785 return enum_font_cb2 ((ENUMLOGFONT *) lplf, (NEWTEXTMETRIC *) lptm,
6786 font_type, lpef);
6787}
6788
8edb0a6f 6789static int CALLBACK
5ca0cd71
GV		 6790enum_fontex_cb1 (lplf, lptm, font_type, lpef)
6791 ENUMLOGFONTEX * lplf;
6792 NEWTEXTMETRICEX * lptm;
6793 int font_type;
6794 enumfont_t * lpef;
6795{
6796 HMODULE gdi32 = GetModuleHandle ("gdi32.dll");
6797 FARPROC enum_font_families_ex
6798 = GetProcAddress ( gdi32, "EnumFontFamiliesExA");
6799 /* We don't really expect EnumFontFamiliesEx to disappear once we
6800 get here, so don't bother handling it gracefully. */
6801 if (enum_font_families_ex == NULL)
6802 error ("gdi32.dll has disappeared!");
6803 return enum_font_families_ex (lpef->hdc,
6804 &lplf->elfLogFont,
6805 (FONTENUMPROC) enum_fontex_cb2,
6806 (LPARAM) lpef, 0);
6807}
6808
4587b026
GV		 6809/* Interface to fontset handler. (adapted from mw32font.c in Meadow
6810 and xterm.c in Emacs 20.3) */
6811
8edb0a6f 6812static Lisp_Object w32_list_bdf_fonts (Lisp_Object pattern, int max_names)
33d52f9c
GV		 6813{
6814 char *fontname, *ptnstr;
6815 Lisp_Object list, tem, newlist = Qnil;
55dcfc15 6816 int n_fonts = 0;
33d52f9c
GV		 6817
6818 list = Vw32_bdf_filename_alist;
6819 ptnstr = XSTRING (pattern)->data;
6820
8e713be6 6821 for ( ; CONSP (list); list = XCDR (list))
33d52f9c 6822 {
8e713be6 6823 tem = XCAR (list);
33d52f9c 6824 if (CONSP (tem))
8e713be6 6825 fontname = XSTRING (XCAR (tem))->data;
33d52f9c
GV		 6826 else if (STRINGP (tem))
6827 fontname = XSTRING (tem)->data;
6828 else
6829 continue;
6830
6831 if (w32_font_match (fontname, ptnstr))
5ca0cd71 6832 {
8e713be6 6833 newlist = Fcons (XCAR (tem), newlist);
5ca0cd71
GV		 6834 n_fonts++;
6835 if (n_fonts >= max_names)
6836 break;
6837 }
33d52f9c
GV		 6838 }
6839
6840 return newlist;
6841}
6842
8edb0a6f
JR		 6843static Lisp_Object w32_list_synthesized_fonts (FRAME_PTR f,
6844 Lisp_Object pattern,
6845 int size, int max_names);
5ca0cd71 6846
4587b026
GV		 6847/* Return a list of names of available fonts matching PATTERN on frame
6848 F. If SIZE is not 0, it is the size (maximum bound width) of fonts
6849 to be listed. Frame F NULL means we have not yet created any
6850 frame, which means we can't get proper size info, as we don't have
6851 a device context to use for GetTextMetrics.
6852 MAXNAMES sets a limit on how many fonts to match. */
6853
6854Lisp_Object
dc220243
JR		 6855w32_list_fonts (f, pattern, size, maxnames)
6856 struct frame *f;
6857 Lisp_Object pattern;
6858 int size;
6859 int maxnames;
4587b026 6860{
6fc2811b 6861 Lisp_Object patterns, key = Qnil, tem, tpat;
4587b026 6862 Lisp_Object list = Qnil, newlist = Qnil, second_best = Qnil;
33d52f9c 6863 struct w32_display_info *dpyinfo = &one_w32_display_info;
5ca0cd71 6864 int n_fonts = 0;
396594fe 6865
4587b026
GV		 6866 patterns = Fassoc (pattern, Valternate_fontname_alist);
6867 if (NILP (patterns))
6868 patterns = Fcons (pattern, Qnil);
6869
8e713be6 6870 for (; CONSP (patterns); patterns = XCDR (patterns))
4587b026
GV		 6871 {
6872 enumfont_t ef;
767b1ff0 6873 int codepage;
4587b026 6874
8e713be6 6875 tpat = XCAR (patterns);
4587b026 6876
767b1ff0
JR		 6877 if (!STRINGP (tpat))
6878 continue;
6879
6880 /* Avoid expensive EnumFontFamilies functions if we are not
6881 going to be able to output one of these anyway. */
6882 codepage = w32_codepage_for_font (XSTRING (tpat)->data);
6883 if (codepage != CP_8BIT && codepage != CP_UNICODE
ceb12877
AI		 6884 && codepage != CP_DEFAULT && codepage != CP_UNKNOWN
6885 && !IsValidCodePage(codepage))
767b1ff0
JR		 6886 continue;
6887
4587b026
GV		 6888 /* See if we cached the result for this particular query.
6889 The cache is an alist of the form:
6890 ((PATTERN (FONTNAME . WIDTH) ...) ...)
6891 */
8e713be6 6892 if (tem = XCDR (dpyinfo->name_list_element),
33d52f9c 6893 !NILP (list = Fassoc (tpat, tem)))
4587b026
GV		 6894 {
6895 list = Fcdr_safe (list);
6896 /* We have a cached list. Don't have to get the list again. */
6897 goto label_cached;
6898 }
6899
6900 BLOCK_INPUT;
6901 /* At first, put PATTERN in the cache. */
6902 list = Qnil;
33d52f9c
GV		 6903 ef.pattern = &tpat;
6904 ef.tail = &list;
4587b026 6905 ef.numFonts = 0;
33d52f9c 6906
5ca0cd71
GV		 6907 /* Use EnumFontFamiliesEx where it is available, as it knows
6908 about character sets. Fall back to EnumFontFamilies for
6909 older versions of NT that don't support the 'Ex function. */
767b1ff0 6910 x_to_w32_font (XSTRING (tpat)->data, &ef.logfont);
4587b026 6911 {
5ca0cd71
GV		 6912 LOGFONT font_match_pattern;
6913 HMODULE gdi32 = GetModuleHandle ("gdi32.dll");
6914 FARPROC enum_font_families_ex
6915 = GetProcAddress ( gdi32, "EnumFontFamiliesExA");
6916
6917 /* We do our own pattern matching so we can handle wildcards. */
6918 font_match_pattern.lfFaceName[0] = 0;
6919 font_match_pattern.lfPitchAndFamily = 0;
6920 /* We can use the charset, because if it is a wildcard it will
6921 be DEFAULT_CHARSET anyway. */
6922 font_match_pattern.lfCharSet = ef.logfont.lfCharSet;
6923
33d52f9c 6924 ef.hdc = GetDC (dpyinfo->root_window);
4587b026 6925
5ca0cd71
GV		 6926 if (enum_font_families_ex)
6927 enum_font_families_ex (ef.hdc,
6928 &font_match_pattern,
6929 (FONTENUMPROC) enum_fontex_cb1,
6930 (LPARAM) &ef, 0);
6931 else
6932 EnumFontFamilies (ef.hdc, NULL, (FONTENUMPROC) enum_font_cb1,
6933 (LPARAM)&ef);
4587b026 6934
33d52f9c 6935 ReleaseDC (dpyinfo->root_window, ef.hdc);
4587b026
GV		 6936 }
6937
6938 UNBLOCK_INPUT;
6939
6940 /* Make a list of the fonts we got back.
6941 Store that in the font cache for the display. */
f3fbd155
KR		 6942 XSETCDR (dpyinfo->name_list_element,
6943 Fcons (Fcons (tpat, list),
6944 XCDR (dpyinfo->name_list_element)));
4587b026
GV		 6945
6946 label_cached:
6947 if (NILP (list)) continue; /* Try the remaining alternatives. */
6948
6949 newlist = second_best = Qnil;
6950
6951 /* Make a list of the fonts that have the right width. */
8e713be6 6952 for (; CONSP (list); list = XCDR (list))
4587b026
GV		 6953 {
6954 int found_size;
8e713be6 6955 tem = XCAR (list);
4587b026
GV		 6956
6957 if (!CONSP (tem))
6958 continue;
8e713be6 6959 if (NILP (XCAR (tem)))
4587b026
GV		 6960 continue;
6961 if (!size)
6962 {
8e713be6 6963 newlist = Fcons (XCAR (tem), newlist);
5ca0cd71
GV		 6964 n_fonts++;
6965 if (n_fonts >= maxnames)
6966 break;
6967 else
6968 continue;
4587b026 6969 }
8e713be6 6970 if (!INTEGERP (XCDR (tem)))
4587b026
GV		 6971 {
6972 /* Since we don't yet know the size of the font, we must
6973 load it and try GetTextMetrics. */
4587b026
GV		 6974 W32FontStruct thisinfo;
6975 LOGFONT lf;
6976 HDC hdc;
6977 HANDLE oldobj;
6978
8e713be6 6979 if (!x_to_w32_font (XSTRING (XCAR (tem))->data, &lf))
4587b026
GV		 6980 continue;
6981
6982 BLOCK_INPUT;
33d52f9c 6983 thisinfo.bdf = NULL;
4587b026
GV		 6984 thisinfo.hfont = CreateFontIndirect (&lf);
6985 if (thisinfo.hfont == NULL)
6986 continue;
6987
6988 hdc = GetDC (dpyinfo->root_window);
6989 oldobj = SelectObject (hdc, thisinfo.hfont);
6990 if (GetTextMetrics (hdc, &thisinfo.tm))
f3fbd155 6991 XSETCDR (tem, make_number (FONT_WIDTH (&thisinfo)));
4587b026 6992 else
f3fbd155 6993 XSETCDR (tem, make_number (0));
4587b026
GV		 6994 SelectObject (hdc, oldobj);
6995 ReleaseDC (dpyinfo->root_window, hdc);
6996 DeleteObject(thisinfo.hfont);
6997 UNBLOCK_INPUT;
6998 }
8e713be6 6999 found_size = XINT (XCDR (tem));
4587b026 7000 if (found_size == size)
5ca0cd71 7001 {
8e713be6 7002 newlist = Fcons (XCAR (tem), newlist);
5ca0cd71
GV		 7003 n_fonts++;
7004 if (n_fonts >= maxnames)
7005 break;
7006 }
4587b026
GV		 7007 /* keep track of the closest matching size in case
7008 no exact match is found. */
7009 else if (found_size > 0)
7010 {
7011 if (NILP (second_best))
7012 second_best = tem;
5ca0cd71 7013
4587b026
GV		 7014 else if (found_size < size)
7015 {
8e713be6
KR		 7016 if (XINT (XCDR (second_best)) > size
7017 || XINT (XCDR (second_best)) < found_size)
4587b026
GV		 7018 second_best = tem;
7019 }
7020 else
7021 {
8e713be6
KR		 7022 if (XINT (XCDR (second_best)) > size
7023 && XINT (XCDR (second_best)) >
4587b026
GV		 7024 found_size)
7025 second_best = tem;
7026 }
7027 }
7028 }
7029
7030 if (!NILP (newlist))
7031 break;
7032 else if (!NILP (second_best))
7033 {
8e713be6 7034 newlist = Fcons (XCAR (second_best), Qnil);
4587b026
GV		 7035 break;
7036 }
7037 }
7038
33d52f9c 7039 /* Include any bdf fonts. */
5ca0cd71 7040 if (n_fonts < maxnames)
33d52f9c
GV		 7041 {
7042 Lisp_Object combined[2];
5ca0cd71 7043 combined[0] = w32_list_bdf_fonts (pattern, maxnames - n_fonts);
33d52f9c
GV		 7044 combined[1] = newlist;
7045 newlist = Fnconc(2, combined);
7046 }
7047
5ca0cd71
GV		 7048 /* If we can't find a font that matches, check if Windows would be
7049 able to synthesize it from a different style. */
6fc2811b 7050 if (NILP (newlist) && !NILP (Vw32_enable_synthesized_fonts))
5ca0cd71
GV		 7051 newlist = w32_list_synthesized_fonts (f, pattern, size, maxnames);
7052
4587b026
GV		 7053 return newlist;
7054}
7055
8edb0a6f 7056static Lisp_Object
5ca0cd71
GV		 7057w32_list_synthesized_fonts (f, pattern, size, max_names)
7058 FRAME_PTR f;
7059 Lisp_Object pattern;
7060 int size;
7061 int max_names;
7062{
7063 int fields;
7064 char *full_pattn, *new_pattn, foundary[50], family[50], *pattn_part2;
7065 char style[20], slant;
8edb0a6f 7066 Lisp_Object matches, tem, synthed_matches = Qnil;
5ca0cd71
GV		 7067
7068 full_pattn = XSTRING (pattern)->data;
7069
8b77111c 7070 pattn_part2 = alloca (XSTRING (pattern)->size + 1);
5ca0cd71
GV		 7071 /* Allow some space for wildcard expansion. */
7072 new_pattn = alloca (XSTRING (pattern)->size + 100);
7073
7074 fields = sscanf (full_pattn, "-%49[^-]-%49[^-]-%19[^-]-%c-%s",
7075 foundary, family, style, &slant, pattn_part2);
7076 if (fields == EOF || fields < 5)
7077 return Qnil;
7078
7079 /* If the style and slant are wildcards already there is no point
7080 checking again (and we don't want to keep recursing). */
7081 if (*style == '*' && slant == '*')
7082 return Qnil;
7083
7084 sprintf (new_pattn, "-%s-%s-*-*-%s", foundary, family, pattn_part2);
7085
7086 matches = w32_list_fonts (f, build_string (new_pattn), size, max_names);
7087
8e713be6 7088 for ( ; CONSP (matches); matches = XCDR (matches))
5ca0cd71 7089 {
8e713be6 7090 tem = XCAR (matches);
5ca0cd71
GV		 7091 if (!STRINGP (tem))
7092 continue;
7093
7094 full_pattn = XSTRING (tem)->data;
7095 fields = sscanf (full_pattn, "-%49[^-]-%49[^-]-%*[^-]-%*c-%s",
7096 foundary, family, pattn_part2);
7097 if (fields == EOF || fields < 3)
7098 continue;
7099
7100 sprintf (new_pattn, "-%s-%s-%s-%c-%s", foundary, family, style,
7101 slant, pattn_part2);
7102
7103 synthed_matches = Fcons (build_string (new_pattn),
7104 synthed_matches);
7105 }
7106
7107 return synthed_matches;
7108}
7109
7110
4587b026
GV		 7111/* Return a pointer to struct font_info of font FONT_IDX of frame F. */
7112struct font_info *
7113w32_get_font_info (f, font_idx)
7114 FRAME_PTR f;
7115 int font_idx;
7116{
7117 return (FRAME_W32_FONT_TABLE (f) + font_idx);
7118}
7119
7120
7121struct font_info*
7122w32_query_font (struct frame *f, char *fontname)
7123{
7124 int i;
7125 struct font_info *pfi;
7126
7127 pfi = FRAME_W32_FONT_TABLE (f);
7128
7129 for (i = 0; i < one_w32_display_info.n_fonts ;i++, pfi++)
7130 {
7131 if (strcmp(pfi->name, fontname) == 0) return pfi;
7132 }
7133
7134 return NULL;
7135}
7136
7137/* Find a CCL program for a font specified by FONTP, and set the member
7138 `encoder' of the structure. */
7139
7140void
7141w32_find_ccl_program (fontp)
7142 struct font_info *fontp;
7143{
3545439c 7144 Lisp_Object list, elt;
4587b026 7145
8e713be6 7146 for (list = Vfont_ccl_encoder_alist; CONSP (list); list = XCDR (list))
4587b026 7147 {
8e713be6 7148 elt = XCAR (list);
4587b026 7149 if (CONSP (elt)
8e713be6
KR		 7150 && STRINGP (XCAR (elt))
7151 && (fast_c_string_match_ignore_case (XCAR (elt), fontp->name)
4587b026 7152 >= 0))
3545439c
KH		 7153 break;
7154 }
7155 if (! NILP (list))
7156 {
17eedd00
KH		 7157 struct ccl_program *ccl
7158 = (struct ccl_program *) xmalloc (sizeof (struct ccl_program));
3545439c 7159
8e713be6 7160 if (setup_ccl_program (ccl, XCDR (elt)) < 0)
3545439c
KH		 7161 xfree (ccl);
7162 else
7163 fontp->font_encoder = ccl;
4587b026
GV		 7164 }
7165}
7166
7167\f
8edb0a6f
JR		 7168/* Find BDF files in a specified directory. (use GCPRO when calling,
7169 as this calls lisp to get a directory listing). */
7170static Lisp_Object
7171w32_find_bdf_fonts_in_dir (Lisp_Object directory)
7172{
7173 Lisp_Object filelist, list = Qnil;
7174 char fontname[100];
7175
7176 if (!STRINGP(directory))
7177 return Qnil;
7178
7179 filelist = Fdirectory_files (directory, Qt,
7180 build_string (".*\\.[bB][dD][fF]"), Qt);
7181
7182 for ( ; CONSP(filelist); filelist = XCDR (filelist))
7183 {
7184 Lisp_Object filename = XCAR (filelist);
7185 if (w32_BDF_to_x_font (XSTRING (filename)->data, fontname, 100))
7186 store_in_alist (&list, build_string (fontname), filename);
7187 }
7188 return list;
7189}
7190
6fc2811b
JR		 7191DEFUN ("w32-find-bdf-fonts", Fw32_find_bdf_fonts, Sw32_find_bdf_fonts,
7192 1, 1, 0,
b3700ae7
JR		 7193 doc: /* Return a list of BDF fonts in DIR.
7194The list is suitable for appending to w32-bdf-filename-alist. Fonts
7195which do not contain an xlfd description will not be included in the
7196list. DIR may be a list of directories. */)
6fc2811b
JR		 7197 (directory)
7198 Lisp_Object directory;
7199{
7200 Lisp_Object list = Qnil;
7201 struct gcpro gcpro1, gcpro2;
ee78dc32 7202
6fc2811b
JR		 7203 if (!CONSP (directory))
7204 return w32_find_bdf_fonts_in_dir (directory);
ee78dc32 7205
6fc2811b 7206 for ( ; CONSP (directory); directory = XCDR (directory))
ee78dc32 7207 {
6fc2811b
JR		 7208 Lisp_Object pair[2];
7209 pair[0] = list;
7210 pair[1] = Qnil;
7211 GCPRO2 (directory, list);
7212 pair[1] = w32_find_bdf_fonts_in_dir( XCAR (directory) );
7213 list = Fnconc( 2, pair );
7214 UNGCPRO;
7215 }
7216 return list;
7217}
ee78dc32 7218
6fc2811b
JR		 7219\f
7220DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0,
74e1aeec 7221 doc: /* Internal function called by `color-defined-p', which see. */)
6fc2811b
JR		 7222 (color, frame)
7223 Lisp_Object color, frame;
7224{
7225 XColor foo;
7226 FRAME_PTR f = check_x_frame (frame);
ee78dc32 7227
b7826503 7228 CHECK_STRING (color);
ee78dc32 7229
6fc2811b
JR		 7230 if (w32_defined_color (f, XSTRING (color)->data, &foo, 0))
7231 return Qt;
7232 else
7233 return Qnil;
7234}
ee78dc32 7235
2d764c78 7236DEFUN ("xw-color-values", Fxw_color_values, Sxw_color_values, 1, 2, 0,
74e1aeec 7237 doc: /* Internal function called by `color-values', which see. */)
ee78dc32
GV		 7238 (color, frame)
7239 Lisp_Object color, frame;
7240{
6fc2811b 7241 XColor foo;
ee78dc32
GV		 7242 FRAME_PTR f = check_x_frame (frame);
7243
b7826503 7244 CHECK_STRING (color);
ee78dc32 7245
6fc2811b 7246 if (w32_defined_color (f, XSTRING (color)->data, &foo, 0))
ee78dc32
GV		 7247 {
7248 Lisp_Object rgb[3];
7249
6fc2811b
JR		 7250 rgb[0] = make_number ((GetRValue (foo.pixel) << 8)
7251 | GetRValue (foo.pixel));
7252 rgb[1] = make_number ((GetGValue (foo.pixel) << 8)
7253 | GetGValue (foo.pixel));
7254 rgb[2] = make_number ((GetBValue (foo.pixel) << 8)
7255 | GetBValue (foo.pixel));
ee78dc32
GV		 7256 return Flist (3, rgb);
7257 }
7258 else
7259 return Qnil;
7260}
7261
2d764c78 7262DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0,
74e1aeec 7263 doc: /* Internal function called by `display-color-p', which see. */)
ee78dc32
GV		 7264 (display)
7265 Lisp_Object display;
7266{
fbd6baed 7267 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV		 7268
7269 if ((dpyinfo->n_planes * dpyinfo->n_cbits) <= 2)
7270 return Qnil;
7271
7272 return Qt;
7273}
7274
74e1aeec
JR		 7275DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p,
7276 Sx_display_grayscale_p, 0, 1, 0,
7277 doc: /* Return t if the X display supports shades of gray.
7278Note that color displays do support shades of gray.
7279The optional argument DISPLAY specifies which display to ask about.
7280DISPLAY should be either a frame or a display name (a string).
7281If omitted or nil, that stands for the selected frame's display. */)
ee78dc32
GV		 7282 (display)
7283 Lisp_Object display;
7284{
fbd6baed 7285 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV		 7286
7287 if ((dpyinfo->n_planes * dpyinfo->n_cbits) <= 1)
7288 return Qnil;
7289
7290 return Qt;
7291}
7292
74e1aeec
JR		 7293DEFUN ("x-display-pixel-width", Fx_display_pixel_width,
7294 Sx_display_pixel_width, 0, 1, 0,
7295 doc: /* Returns the width in pixels of DISPLAY.
7296The optional argument DISPLAY specifies which display to ask about.
7297DISPLAY should be either a frame or a display name (a string).
7298If omitted or nil, that stands for the selected frame's display. */)
ee78dc32
GV		 7299 (display)
7300 Lisp_Object display;
7301{
fbd6baed 7302 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV		 7303
7304 return make_number (dpyinfo->width);
7305}
7306
7307DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
74e1aeec
JR		 7308 Sx_display_pixel_height, 0, 1, 0,
7309 doc: /* Returns the height in pixels of DISPLAY.
7310The optional argument DISPLAY specifies which display to ask about.
7311DISPLAY should be either a frame or a display name (a string).
7312If omitted or nil, that stands for the selected frame's display. */)
ee78dc32
GV		 7313 (display)
7314 Lisp_Object display;
7315{
fbd6baed 7316 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV		 7317
7318 return make_number (dpyinfo->height);
7319}
7320
7321DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
74e1aeec
JR		 7322 0, 1, 0,
7323 doc: /* Returns the number of bitplanes of DISPLAY.
7324The optional argument DISPLAY specifies which display to ask about.
7325DISPLAY should be either a frame or a display name (a string).
7326If omitted or nil, that stands for the selected frame's display. */)
ee78dc32
GV		 7327 (display)
7328 Lisp_Object display;
7329{
fbd6baed 7330 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV		 7331
7332 return make_number (dpyinfo->n_planes * dpyinfo->n_cbits);
7333}
7334
7335DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
74e1aeec
JR		 7336 0, 1, 0,
7337 doc: /* Returns the number of color cells of DISPLAY.
7338The optional argument DISPLAY specifies which display to ask about.
7339DISPLAY should be either a frame or a display name (a string).
7340If omitted or nil, that stands for the selected frame's display. */)
ee78dc32
GV		 7341 (display)
7342 Lisp_Object display;
7343{
fbd6baed 7344 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV		 7345 HDC hdc;
7346 int cap;
7347
5ac45f98
GV		 7348 hdc = GetDC (dpyinfo->root_window);
7349 if (dpyinfo->has_palette)
7350 cap = GetDeviceCaps (hdc,SIZEPALETTE);
7351 else
7352 cap = GetDeviceCaps (hdc,NUMCOLORS);
abf8c61b
AI		 7353
7354 if (cap < 0)
7355 cap = 1 << (dpyinfo->n_planes * dpyinfo->n_cbits);
ee78dc32
GV		 7356
7357 ReleaseDC (dpyinfo->root_window, hdc);
7358
7359 return make_number (cap);
7360}
7361
7362DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
7363 Sx_server_max_request_size,
74e1aeec
JR		 7364 0, 1, 0,
7365 doc: /* Returns the maximum request size of the server of DISPLAY.
7366The optional argument DISPLAY specifies which display to ask about.
7367DISPLAY should be either a frame or a display name (a string).
7368If omitted or nil, that stands for the selected frame's display. */)
ee78dc32
GV		 7369 (display)
7370 Lisp_Object display;
7371{
fbd6baed 7372 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV		 7373
7374 return make_number (1);
7375}
7376
7377DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
74e1aeec
JR		 7378 doc: /* Returns the vendor ID string of the W32 system (Microsoft).
7379The optional argument DISPLAY specifies which display to ask about.
7380DISPLAY should be either a frame or a display name (a string).
7381If omitted or nil, that stands for the selected frame's display. */)
ee78dc32
GV		 7382 (display)
7383 Lisp_Object display;
7384{
dfff8a69 7385 return build_string ("Microsoft Corp.");
ee78dc32
GV		 7386}
7387
7388DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
74e1aeec
JR		 7389 doc: /* Returns the version numbers of the server of DISPLAY.
7390The value is a list of three integers: the major and minor
7391version numbers, and the vendor-specific release
7392number. See also the function `x-server-vendor'.
7393
7394The optional argument DISPLAY specifies which display to ask about.
7395DISPLAY should be either a frame or a display name (a string).
7396If omitted or nil, that stands for the selected frame's display. */)
ee78dc32
GV		 7397 (display)
7398 Lisp_Object display;
7399{
fbd6baed 7400 return Fcons (make_number (w32_major_version),
58e0f0e4
AI		 7401 Fcons (make_number (w32_minor_version),
7402 Fcons (make_number (w32_build_number), Qnil)));
ee78dc32
GV		 7403}
7404
7405DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
74e1aeec
JR		 7406 doc: /* Returns the number of screens on the server of DISPLAY.
7407The optional argument DISPLAY specifies which display to ask about.
7408DISPLAY should be either a frame or a display name (a string).
7409If omitted or nil, that stands for the selected frame's display. */)
ee78dc32
GV		 7410 (display)
7411 Lisp_Object display;
7412{
ee78dc32
GV		 7413 return make_number (1);
7414}
7415
74e1aeec
JR		 7416DEFUN ("x-display-mm-height", Fx_display_mm_height,
7417 Sx_display_mm_height, 0, 1, 0,
7418 doc: /* Returns the height in millimeters of DISPLAY.
7419The optional argument DISPLAY specifies which display to ask about.
7420DISPLAY should be either a frame or a display name (a string).
7421If omitted or nil, that stands for the selected frame's display. */)
ee78dc32
GV		 7422 (display)
7423 Lisp_Object display;
7424{
fbd6baed 7425 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV		 7426 HDC hdc;
7427 int cap;
7428
5ac45f98 7429 hdc = GetDC (dpyinfo->root_window);
3c190163 7430
ee78dc32 7431 cap = GetDeviceCaps (hdc, VERTSIZE);
3c190163 7432
ee78dc32
GV		 7433 ReleaseDC (dpyinfo->root_window, hdc);
7434
7435 return make_number (cap);
7436}
7437
7438DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
74e1aeec
JR		 7439 doc: /* Returns the width in millimeters of DISPLAY.
7440The optional argument DISPLAY specifies which display to ask about.
7441DISPLAY should be either a frame or a display name (a string).
7442If omitted or nil, that stands for the selected frame's display. */)
ee78dc32
GV		 7443 (display)
7444 Lisp_Object display;
7445{
fbd6baed 7446 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV		 7447
7448 HDC hdc;
7449 int cap;
7450
5ac45f98 7451 hdc = GetDC (dpyinfo->root_window);
3c190163 7452
ee78dc32 7453 cap = GetDeviceCaps (hdc, HORZSIZE);
3c190163 7454
ee78dc32
GV		 7455 ReleaseDC (dpyinfo->root_window, hdc);
7456
7457 return make_number (cap);
7458}
7459
7460DEFUN ("x-display-backing-store", Fx_display_backing_store,
74e1aeec
JR		 7461 Sx_display_backing_store, 0, 1, 0,
7462 doc: /* Returns an indication of whether DISPLAY does backing store.
7463The value may be `always', `when-mapped', or `not-useful'.
7464The optional argument DISPLAY specifies which display to ask about.
7465DISPLAY should be either a frame or a display name (a string).
7466If omitted or nil, that stands for the selected frame's display. */)
ee78dc32
GV		 7467 (display)
7468 Lisp_Object display;
7469{
7470 return intern ("not-useful");
7471}
7472
7473DEFUN ("x-display-visual-class", Fx_display_visual_class,
74e1aeec
JR		 7474 Sx_display_visual_class, 0, 1, 0,
7475 doc: /* Returns the visual class of DISPLAY.
7476The value is one of the symbols `static-gray', `gray-scale',
7477`static-color', `pseudo-color', `true-color', or `direct-color'.
7478
7479The optional argument DISPLAY specifies which display to ask about.
7480DISPLAY should be either a frame or a display name (a string).
7481If omitted or nil, that stands for the selected frame's display. */)
ee78dc32
GV		 7482 (display)
7483 Lisp_Object display;
7484{
fbd6baed 7485 struct w32_display_info *dpyinfo = check_x_display_info (display);
abf8c61b 7486 Lisp_Object result = Qnil;
ee78dc32 7487
abf8c61b
AI		 7488 if (dpyinfo->has_palette)
7489 result = intern ("pseudo-color");
7490 else if (dpyinfo->n_planes * dpyinfo->n_cbits == 1)
7491 result = intern ("static-grey");
7492 else if (dpyinfo->n_planes * dpyinfo->n_cbits == 4)
7493 result = intern ("static-color");
7494 else if (dpyinfo->n_planes * dpyinfo->n_cbits > 8)
7495 result = intern ("true-color");
ee78dc32 7496
abf8c61b 7497 return result;
ee78dc32
GV		 7498}
7499
7500DEFUN ("x-display-save-under", Fx_display_save_under,
74e1aeec
JR		 7501 Sx_display_save_under, 0, 1, 0,
7502 doc: /* Returns t if DISPLAY supports the save-under feature.
7503The optional argument DISPLAY specifies which display to ask about.
7504DISPLAY should be either a frame or a display name (a string).
7505If omitted or nil, that stands for the selected frame's display. */)
ee78dc32
GV		 7506 (display)
7507 Lisp_Object display;
7508{
6fc2811b
JR		 7509 return Qnil;
7510}
7511\f
7512int
7513x_pixel_width (f)
7514 register struct frame *f;
7515{
7516 return PIXEL_WIDTH (f);
7517}
7518
7519int
7520x_pixel_height (f)
7521 register struct frame *f;
7522{
7523 return PIXEL_HEIGHT (f);
7524}
7525
7526int
7527x_char_width (f)
7528 register struct frame *f;
7529{
7530 return FONT_WIDTH (f->output_data.w32->font);
7531}
7532
7533int
7534x_char_height (f)
7535 register struct frame *f;
7536{
7537 return f->output_data.w32->line_height;
7538}
7539
7540int
7541x_screen_planes (f)
7542 register struct frame *f;
7543{
7544 return FRAME_W32_DISPLAY_INFO (f)->n_planes;
7545}
7546\f
7547/* Return the display structure for the display named NAME.
7548 Open a new connection if necessary. */
7549
7550struct w32_display_info *
7551x_display_info_for_name (name)
7552 Lisp_Object name;
7553{
7554 Lisp_Object names;
7555 struct w32_display_info *dpyinfo;
7556
b7826503 7557 CHECK_STRING (name);
6fc2811b
JR		 7558
7559 for (dpyinfo = &one_w32_display_info, names = w32_display_name_list;
7560 dpyinfo;
7561 dpyinfo = dpyinfo->next, names = XCDR (names))
7562 {
7563 Lisp_Object tem;
7564 tem = Fstring_equal (XCAR (XCAR (names)), name);
7565 if (!NILP (tem))
7566 return dpyinfo;
7567 }
7568
7569 /* Use this general default value to start with. */
7570 Vx_resource_name = Vinvocation_name;
7571
7572 validate_x_resource_name ();
7573
7574 dpyinfo = w32_term_init (name, (unsigned char *)0,
7575 (char *) XSTRING (Vx_resource_name)->data);
7576
7577 if (dpyinfo == 0)
7578 error ("Cannot connect to server %s", XSTRING (name)->data);
7579
7580 w32_in_use = 1;
7581 XSETFASTINT (Vwindow_system_version, 3);
7582
7583 return dpyinfo;
7584}
7585
7586DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
74e1aeec
JR		 7587 1, 3, 0, doc: /* Open a connection to a server.
7588DISPLAY is the name of the display to connect to.
7589Optional second arg XRM-STRING is a string of resources in xrdb format.
7590If the optional third arg MUST-SUCCEED is non-nil,
7591terminate Emacs if we can't open the connection. */)
6fc2811b
JR		 7592 (display, xrm_string, must_succeed)
7593 Lisp_Object display, xrm_string, must_succeed;
7594{
7595 unsigned char *xrm_option;
7596 struct w32_display_info *dpyinfo;
7597
74e1aeec
JR		 7598 /* If initialization has already been done, return now to avoid
7599 overwriting critical parts of one_w32_display_info. */
7600 if (w32_in_use)
7601 return Qnil;
7602
b7826503 7603 CHECK_STRING (display);
6fc2811b 7604 if (! NILP (xrm_string))
b7826503 7605 CHECK_STRING (xrm_string);
6fc2811b
JR		 7606
7607 if (! EQ (Vwindow_system, intern ("w32")))
7608 error ("Not using Microsoft Windows");
7609
7610 /* Allow color mapping to be defined externally; first look in user's
7611 HOME directory, then in Emacs etc dir for a file called rgb.txt. */
7612 {
7613 Lisp_Object color_file;
7614 struct gcpro gcpro1;
7615
7616 color_file = build_string("~/rgb.txt");
7617
7618 GCPRO1 (color_file);
7619
7620 if (NILP (Ffile_readable_p (color_file)))
7621 color_file =
7622 Fexpand_file_name (build_string ("rgb.txt"),
7623 Fsymbol_value (intern ("data-directory")));
7624
7625 Vw32_color_map = Fw32_load_color_file (color_file);
7626
7627 UNGCPRO;
7628 }
7629 if (NILP (Vw32_color_map))
7630 Vw32_color_map = Fw32_default_color_map ();
7631
7632 if (! NILP (xrm_string))
7633 xrm_option = (unsigned char *) XSTRING (xrm_string)->data;
7634 else
7635 xrm_option = (unsigned char *) 0;
7636
7637 /* Use this general default value to start with. */
7638 /* First remove .exe suffix from invocation-name - it looks ugly. */
7639 {
7640 char basename[ MAX_PATH ], *str;
7641
7642 strcpy (basename, XSTRING (Vinvocation_name)->data);
7643 str = strrchr (basename, '.');
7644 if (str) *str = 0;
7645 Vinvocation_name = build_string (basename);
7646 }
7647 Vx_resource_name = Vinvocation_name;
7648
7649 validate_x_resource_name ();
7650
7651 /* This is what opens the connection and sets x_current_display.
7652 This also initializes many symbols, such as those used for input. */
7653 dpyinfo = w32_term_init (display, xrm_option,
7654 (char *) XSTRING (Vx_resource_name)->data);
7655
7656 if (dpyinfo == 0)
7657 {
7658 if (!NILP (must_succeed))
7659 fatal ("Cannot connect to server %s.\n",
7660 XSTRING (display)->data);
7661 else
7662 error ("Cannot connect to server %s", XSTRING (display)->data);
7663 }
7664
7665 w32_in_use = 1;
7666
7667 XSETFASTINT (Vwindow_system_version, 3);
7668 return Qnil;
7669}
7670
7671DEFUN ("x-close-connection", Fx_close_connection,
7672 Sx_close_connection, 1, 1, 0,
74e1aeec
JR		 7673 doc: /* Close the connection to DISPLAY's server.
7674For DISPLAY, specify either a frame or a display name (a string).
7675If DISPLAY is nil, that stands for the selected frame's display. */)
6fc2811b
JR		 7676 (display)
7677 Lisp_Object display;
7678{
7679 struct w32_display_info *dpyinfo = check_x_display_info (display);
7680 int i;
7681
7682 if (dpyinfo->reference_count > 0)
7683 error ("Display still has frames on it");
7684
7685 BLOCK_INPUT;
7686 /* Free the fonts in the font table. */
7687 for (i = 0; i < dpyinfo->n_fonts; i++)
7688 if (dpyinfo->font_table[i].name)
7689 {
126f2e35
JR		 7690 if (dpyinfo->font_table[i].name != dpyinfo->font_table[i].full_name)
7691 xfree (dpyinfo->font_table[i].full_name);
6fc2811b 7692 xfree (dpyinfo->font_table[i].name);
6fc2811b
JR		 7693 w32_unload_font (dpyinfo, dpyinfo->font_table[i].font);
7694 }
7695 x_destroy_all_bitmaps (dpyinfo);
7696
7697 x_delete_display (dpyinfo);
7698 UNBLOCK_INPUT;
7699
7700 return Qnil;
7701}
7702
7703DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0,
74e1aeec 7704 doc: /* Return the list of display names that Emacs has connections to. */)
6fc2811b
JR		 7705 ()
7706{
7707 Lisp_Object tail, result;
7708
7709 result = Qnil;
7710 for (tail = w32_display_name_list; ! NILP (tail); tail = XCDR (tail))
7711 result = Fcons (XCAR (XCAR (tail)), result);
7712
7713 return result;
7714}
7715
7716DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize, 1, 2, 0,
0a332240
PJ		 7717 doc: /* This is a noop on W32 systems. */)
7718 (on, display)
7719 Lisp_Object display, on;
6fc2811b 7720{
6fc2811b
JR		 7721 return Qnil;
7722}
7723
7724\f
7725\f
7726/***********************************************************************
7727 Image types
7728 ***********************************************************************/
7729
7730/* Value is the number of elements of vector VECTOR. */
7731
7732#define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
7733
7734/* List of supported image types. Use define_image_type to add new
7735 types. Use lookup_image_type to find a type for a given symbol. */
7736
7737static struct image_type *image_types;
7738
6fc2811b
JR		 7739/* The symbol `image' which is the car of the lists used to represent
7740 images in Lisp. */
7741
7742extern Lisp_Object Qimage;
7743
7744/* The symbol `xbm' which is used as the type symbol for XBM images. */
7745
7746Lisp_Object Qxbm;
7747
7748/* Keywords. */
7749
6fc2811b 7750extern Lisp_Object QCwidth, QCheight, QCforeground, QCbackground, QCfile;
dfff8a69
JR		 7751extern Lisp_Object QCdata;
7752Lisp_Object QCtype, QCascent, QCmargin, QCrelief;
a93f4566 7753Lisp_Object QCconversion, QCcolor_symbols, QCheuristic_mask;
3cf3436e 7754Lisp_Object QCindex, QCmatrix, QCcolor_adjustment, QCmask;
6fc2811b
JR		 7755
7756/* Other symbols. */
7757
3cf3436e 7758Lisp_Object Qlaplace, Qemboss, Qedge_detection, Qheuristic;
6fc2811b
JR		 7759
7760/* Time in seconds after which images should be removed from the cache
7761 if not displayed. */
7762
7763Lisp_Object Vimage_cache_eviction_delay;
7764
7765/* Function prototypes. */
7766
7767static void define_image_type P_ ((struct image_type *type));
7768static struct image_type *lookup_image_type P_ ((Lisp_Object symbol));
7769static void image_error P_ ((char *format, Lisp_Object, Lisp_Object));
7770static void x_laplace P_ ((struct frame *, struct image *));
3cf3436e 7771static void x_emboss P_ ((struct frame *, struct image *));
6fc2811b
JR		 7772static int x_build_heuristic_mask P_ ((struct frame *, struct image *,
7773 Lisp_Object));
7774
dfff8a69 7775
6fc2811b
JR		 7776/* Define a new image type from TYPE. This adds a copy of TYPE to
7777 image_types and adds the symbol *TYPE->type to Vimage_types. */
7778
7779static void
7780define_image_type (type)
7781 struct image_type *type;
7782{
7783 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
7784 The initialized data segment is read-only. */
7785 struct image_type *p = (struct image_type *) xmalloc (sizeof *p);
7786 bcopy (type, p, sizeof *p);
7787 p->next = image_types;
7788 image_types = p;
7789 Vimage_types = Fcons (*p->type, Vimage_types);
7790}
7791
7792
7793/* Look up image type SYMBOL, and return a pointer to its image_type
7794 structure. Value is null if SYMBOL is not a known image type. */
7795
7796static INLINE struct image_type *
7797lookup_image_type (symbol)
7798 Lisp_Object symbol;
7799{
7800 struct image_type *type;
7801
7802 for (type = image_types; type; type = type->next)
7803 if (EQ (symbol, *type->type))
7804 break;
7805
7806 return type;
7807}
7808
7809
7810/* Value is non-zero if OBJECT is a valid Lisp image specification. A
7811 valid image specification is a list whose car is the symbol
7812 `image', and whose rest is a property list. The property list must
7813 contain a value for key `:type'. That value must be the name of a
7814 supported image type. The rest of the property list depends on the
7815 image type. */
7816
7817int
7818valid_image_p (object)
7819 Lisp_Object object;
7820{
7821 int valid_p = 0;
7822
7823 if (CONSP (object) && EQ (XCAR (object), Qimage))
7824 {
3cf3436e
JR		 7825 Lisp_Object tem;
7826
7827 for (tem = XCDR (object); CONSP (tem); tem = XCDR (tem))
7828 if (EQ (XCAR (tem), QCtype))
7829 {
7830 tem = XCDR (tem);
7831 if (CONSP (tem) && SYMBOLP (XCAR (tem)))
7832 {
7833 struct image_type *type;
7834 type = lookup_image_type (XCAR (tem));
7835 if (type)
7836 valid_p = type->valid_p (object);
7837 }
7838
7839 break;
7840 }
6fc2811b
JR		 7841 }
7842
7843 return valid_p;
7844}
7845
7846
7847/* Log error message with format string FORMAT and argument ARG.
7848 Signaling an error, e.g. when an image cannot be loaded, is not a
7849 good idea because this would interrupt redisplay, and the error
7850 message display would lead to another redisplay. This function
7851 therefore simply displays a message. */
7852
7853static void
7854image_error (format, arg1, arg2)
7855 char *format;
7856 Lisp_Object arg1, arg2;
7857{
7858 add_to_log (format, arg1, arg2);
7859}
7860
7861
7862\f
7863/***********************************************************************
7864 Image specifications
7865 ***********************************************************************/
7866
7867enum image_value_type
7868{
7869 IMAGE_DONT_CHECK_VALUE_TYPE,
7870 IMAGE_STRING_VALUE,
3cf3436e 7871 IMAGE_STRING_OR_NIL_VALUE,
6fc2811b
JR		 7872 IMAGE_SYMBOL_VALUE,
7873 IMAGE_POSITIVE_INTEGER_VALUE,
8edb0a6f 7874 IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR,
6fc2811b 7875 IMAGE_NON_NEGATIVE_INTEGER_VALUE,
dfff8a69 7876 IMAGE_ASCENT_VALUE,
6fc2811b
JR		 7877 IMAGE_INTEGER_VALUE,
7878 IMAGE_FUNCTION_VALUE,
7879 IMAGE_NUMBER_VALUE,
7880 IMAGE_BOOL_VALUE
7881};
7882
7883/* Structure used when parsing image specifications. */
7884
7885struct image_keyword
7886{
7887 /* Name of keyword. */
7888 char *name;
7889
7890 /* The type of value allowed. */
7891 enum image_value_type type;
7892
7893 /* Non-zero means key must be present. */
7894 int mandatory_p;
7895
7896 /* Used to recognize duplicate keywords in a property list. */
7897 int count;
7898
7899 /* The value that was found. */
7900 Lisp_Object value;
7901};
7902
7903
7904static int parse_image_spec P_ ((Lisp_Object, struct image_keyword *,
7905 int, Lisp_Object));
7906static Lisp_Object image_spec_value P_ ((Lisp_Object, Lisp_Object, int *));
7907
7908
7909/* Parse image spec SPEC according to KEYWORDS. A valid image spec
7910 has the format (image KEYWORD VALUE ...). One of the keyword/
7911 value pairs must be `:type TYPE'. KEYWORDS is a vector of
7912 image_keywords structures of size NKEYWORDS describing other
7913 allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
7914
7915static int
7916parse_image_spec (spec, keywords, nkeywords, type)
7917 Lisp_Object spec;
7918 struct image_keyword *keywords;
7919 int nkeywords;
7920 Lisp_Object type;
7921{
7922 int i;
7923 Lisp_Object plist;
7924
7925 if (!CONSP (spec) || !EQ (XCAR (spec), Qimage))
7926 return 0;
7927
7928 plist = XCDR (spec);
7929 while (CONSP (plist))
7930 {
7931 Lisp_Object key, value;
7932
7933 /* First element of a pair must be a symbol. */
7934 key = XCAR (plist);
7935 plist = XCDR (plist);
7936 if (!SYMBOLP (key))
7937 return 0;
7938
7939 /* There must follow a value. */
7940 if (!CONSP (plist))
7941 return 0;
7942 value = XCAR (plist);
7943 plist = XCDR (plist);
7944
7945 /* Find key in KEYWORDS. Error if not found. */
7946 for (i = 0; i < nkeywords; ++i)
7947 if (strcmp (keywords[i].name, XSYMBOL (key)->name->data) == 0)
7948 break;
7949
7950 if (i == nkeywords)
7951 continue;
7952
7953 /* Record that we recognized the keyword. If a keywords
7954 was found more than once, it's an error. */
7955 keywords[i].value = value;
7956 ++keywords[i].count;
7957
7958 if (keywords[i].count > 1)
7959 return 0;
7960
7961 /* Check type of value against allowed type. */
7962 switch (keywords[i].type)
7963 {
7964 case IMAGE_STRING_VALUE:
7965 if (!STRINGP (value))
7966 return 0;
7967 break;
7968
3cf3436e
JR		 7969 case IMAGE_STRING_OR_NIL_VALUE:
7970 if (!STRINGP (value) && !NILP (value))
7971 return 0;
7972 break;
7973
6fc2811b
JR		 7974 case IMAGE_SYMBOL_VALUE:
7975 if (!SYMBOLP (value))
7976 return 0;
7977 break;
7978
7979 case IMAGE_POSITIVE_INTEGER_VALUE:
7980 if (!INTEGERP (value) || XINT (value) <= 0)
7981 return 0;
7982 break;
7983
8edb0a6f
JR		 7984 case IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR:
7985 if (INTEGERP (value) && XINT (value) >= 0)
7986 break;
7987 if (CONSP (value)
7988 && INTEGERP (XCAR (value)) && INTEGERP (XCDR (value))
7989 && XINT (XCAR (value)) >= 0 && XINT (XCDR (value)) >= 0)
7990 break;
7991 return 0;
7992
dfff8a69
JR		 7993 case IMAGE_ASCENT_VALUE:
7994 if (SYMBOLP (value) && EQ (value, Qcenter))
7995 break;
7996 else if (INTEGERP (value)
7997 && XINT (value) >= 0
7998 && XINT (value) <= 100)
7999 break;
8000 return 0;
8001
6fc2811b
JR		 8002 case IMAGE_NON_NEGATIVE_INTEGER_VALUE:
8003 if (!INTEGERP (value) || XINT (value) < 0)
8004 return 0;
8005 break;
8006
8007 case IMAGE_DONT_CHECK_VALUE_TYPE:
8008 break;
8009
8010 case IMAGE_FUNCTION_VALUE:
8011 value = indirect_function (value);
8012 if (SUBRP (value)
8013 || COMPILEDP (value)
8014 || (CONSP (value) && EQ (XCAR (value), Qlambda)))
8015 break;
8016 return 0;
8017
8018 case IMAGE_NUMBER_VALUE:
8019 if (!INTEGERP (value) && !FLOATP (value))
8020 return 0;
8021 break;
8022
8023 case IMAGE_INTEGER_VALUE:
8024 if (!INTEGERP (value))
8025 return 0;
8026 break;
8027
8028 case IMAGE_BOOL_VALUE:
8029 if (!NILP (value) && !EQ (value, Qt))
8030 return 0;
8031 break;
8032
8033 default:
8034 abort ();
8035 break;
8036 }
8037
8038 if (EQ (key, QCtype) && !EQ (type, value))
8039 return 0;
8040 }
8041
8042 /* Check that all mandatory fields are present. */
8043 for (i = 0; i < nkeywords; ++i)
8044 if (keywords[i].mandatory_p && keywords[i].count == 0)
8045 return 0;
8046
8047 return NILP (plist);
8048}
8049
8050
8051/* Return the value of KEY in image specification SPEC. Value is nil
8052 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
8053 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
8054
8055static Lisp_Object
8056image_spec_value (spec, key, found)
8057 Lisp_Object spec, key;
8058 int *found;
8059{
8060 Lisp_Object tail;
8061
8062 xassert (valid_image_p (spec));
8063
8064 for (tail = XCDR (spec);
8065 CONSP (tail) && CONSP (XCDR (tail));
8066 tail = XCDR (XCDR (tail)))
8067 {
8068 if (EQ (XCAR (tail), key))
8069 {
8070 if (found)
8071 *found = 1;
8072 return XCAR (XCDR (tail));
8073 }
8074 }
8075
8076 if (found)
8077 *found = 0;
8078 return Qnil;
8079}
8080
8081
8082
8083\f
8084/***********************************************************************
8085 Image type independent image structures
8086 ***********************************************************************/
8087
8088static struct image *make_image P_ ((Lisp_Object spec, unsigned hash));
8089static void free_image P_ ((struct frame *f, struct image *img));
8090
8091
8092/* Allocate and return a new image structure for image specification
8093 SPEC. SPEC has a hash value of HASH. */
8094
8095static struct image *
8096make_image (spec, hash)
8097 Lisp_Object spec;
8098 unsigned hash;
8099{
8100 struct image *img = (struct image *) xmalloc (sizeof *img);
8101
8102 xassert (valid_image_p (spec));
8103 bzero (img, sizeof *img);
8104 img->type = lookup_image_type (image_spec_value (spec, QCtype, NULL));
8105 xassert (img->type != NULL);
8106 img->spec = spec;
8107 img->data.lisp_val = Qnil;
8108 img->ascent = DEFAULT_IMAGE_ASCENT;
8109 img->hash = hash;
8110 return img;
8111}
8112
8113
8114/* Free image IMG which was used on frame F, including its resources. */
8115
8116static void
8117free_image (f, img)
8118 struct frame *f;
8119 struct image *img;
8120{
8121 if (img)
8122 {
8123 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
8124
8125 /* Remove IMG from the hash table of its cache. */
8126 if (img->prev)
8127 img->prev->next = img->next;
8128 else
8129 c->buckets[img->hash % IMAGE_CACHE_BUCKETS_SIZE] = img->next;
8130
8131 if (img->next)
8132 img->next->prev = img->prev;
8133
8134 c->images[img->id] = NULL;
8135
8136 /* Free resources, then free IMG. */
8137 img->type->free (f, img);
8138 xfree (img);
8139 }
8140}
8141
8142
8143/* Prepare image IMG for display on frame F. Must be called before
8144 drawing an image. */
8145
8146void
8147prepare_image_for_display (f, img)
8148 struct frame *f;
8149 struct image *img;
8150{
8151 EMACS_TIME t;
8152
8153 /* We're about to display IMG, so set its timestamp to `now'. */
8154 EMACS_GET_TIME (t);
8155 img->timestamp = EMACS_SECS (t);
8156
8157 /* If IMG doesn't have a pixmap yet, load it now, using the image
8158 type dependent loader function. */
8159 if (img->pixmap == 0 && !img->load_failed_p)
8160 img->load_failed_p = img->type->load (f, img) == 0;
8161}
8162
8163
dfff8a69
JR		 8164/* Value is the number of pixels for the ascent of image IMG when
8165 drawn in face FACE. */
8166
8167int
8168image_ascent (img, face)
8169 struct image *img;
8170 struct face *face;
8171{
8edb0a6f 8172 int height = img->height + img->vmargin;
dfff8a69
JR		 8173 int ascent;
8174
8175 if (img->ascent == CENTERED_IMAGE_ASCENT)
8176 {
8177 if (face->font)
8178 ascent = height / 2 - (FONT_DESCENT(face->font)
8179 - FONT_BASE(face->font)) / 2;
8180 else
8181 ascent = height / 2;
8182 }
8183 else
8184 ascent = height * img->ascent / 100.0;
8185
8186 return ascent;
8187}
8188
8189
6fc2811b 8190\f
a05e2bae
JR		 8191/* Image background colors. */
8192
8193static unsigned long
8194four_corners_best (ximg, width, height)
8195 XImage *ximg;
8196 unsigned long width, height;
8197{
8198#if 0 /* TODO: Image support. */
8199 unsigned long corners[4], best;
8200 int i, best_count;
8201
8202 /* Get the colors at the corners of ximg. */
8203 corners[0] = XGetPixel (ximg, 0, 0);
8204 corners[1] = XGetPixel (ximg, width - 1, 0);
8205 corners[2] = XGetPixel (ximg, width - 1, height - 1);
8206 corners[3] = XGetPixel (ximg, 0, height - 1);
8207
8208 /* Choose the most frequently found color as background. */
8209 for (i = best_count = 0; i < 4; ++i)
8210 {
8211 int j, n;
8212
8213 for (j = n = 0; j < 4; ++j)
8214 if (corners[i] == corners[j])
8215 ++n;
8216
8217 if (n > best_count)
8218 best = corners[i], best_count = n;
8219 }
8220
8221 return best;
8222#else
8223 return 0;
8224#endif
8225}
8226
8227/* Return the `background' field of IMG. If IMG doesn't have one yet,
8228 it is guessed heuristically. If non-zero, XIMG is an existing XImage
8229 object to use for the heuristic. */
8230
8231unsigned long
8232image_background (img, f, ximg)
8233 struct image *img;
8234 struct frame *f;
8235 XImage *ximg;
8236{
8237 if (! img->background_valid)
8238 /* IMG doesn't have a background yet, try to guess a reasonable value. */
8239 {
8240#if 0 /* TODO: Image support. */
8241 int free_ximg = !ximg;
8242
8243 if (! ximg)
8244 ximg = XGetImage (FRAME_X_DISPLAY (f), img->pixmap,
8245 0, 0, img->width, img->height, ~0, ZPixmap);
8246
8247 img->background = four_corners_best (ximg, img->width, img->height);
8248
8249 if (free_ximg)
8250 XDestroyImage (ximg);
8251
8252 img->background_valid = 1;
8253#endif
8254 }
8255
8256 return img->background;
8257}
8258
8259/* Return the `background_transparent' field of IMG. If IMG doesn't
8260 have one yet, it is guessed heuristically. If non-zero, MASK is an
8261 existing XImage object to use for the heuristic. */
8262
8263int
8264image_background_transparent (img, f, mask)
8265 struct image *img;
8266 struct frame *f;
8267 XImage *mask;
8268{
8269 if (! img->background_transparent_valid)
8270 /* IMG doesn't have a background yet, try to guess a reasonable value. */
8271 {
8272#if 0 /* TODO: Image support. */
8273 if (img->mask)
8274 {
8275 int free_mask = !mask;
8276
8277 if (! mask)
8278 mask = XGetImage (FRAME_X_DISPLAY (f), img->mask,
8279 0, 0, img->width, img->height, ~0, ZPixmap);
8280
8281 img->background_transparent
8282 = !four_corners_best (mask, img->width, img->height);
8283
8284 if (free_mask)
8285 XDestroyImage (mask);
8286 }
8287 else
8288#endif
8289 img->background_transparent = 0;
8290
8291 img->background_transparent_valid = 1;
8292 }
8293
8294 return img->background_transparent;
8295}
8296
8297\f
6fc2811b
JR		 8298/***********************************************************************
8299 Helper functions for X image types
8300 ***********************************************************************/
8301
a05e2bae
JR		 8302static void x_clear_image_1 P_ ((struct frame *, struct image *, int,
8303 int, int));
6fc2811b
JR		 8304static void x_clear_image P_ ((struct frame *f, struct image *img));
8305static unsigned long x_alloc_image_color P_ ((struct frame *f,
8306 struct image *img,
8307 Lisp_Object color_name,
8308 unsigned long dflt));
8309
a05e2bae
JR		 8310
8311/* Clear X resources of image IMG on frame F. PIXMAP_P non-zero means
8312 free the pixmap if any. MASK_P non-zero means clear the mask
8313 pixmap if any. COLORS_P non-zero means free colors allocated for
8314 the image, if any. */
8315
8316static void
8317x_clear_image_1 (f, img, pixmap_p, mask_p, colors_p)
8318 struct frame *f;
8319 struct image *img;
8320 int pixmap_p, mask_p, colors_p;
8321{
8322#if 0
8323 if (pixmap_p && img->pixmap)
8324 {
8325 XFreePixmap (FRAME_X_DISPLAY (f), img->pixmap);
8326 img->pixmap = None;
8327 img->background_valid = 0;
8328 }
8329
8330 if (mask_p && img->mask)
8331 {
8332 XFreePixmap (FRAME_X_DISPLAY (f), img->mask);
8333 img->mask = None;
8334 img->background_transparent_valid = 0;
8335 }
8336
8337 if (colors_p && img->ncolors)
8338 {
8339 x_free_colors (f, img->colors, img->ncolors);
8340 xfree (img->colors);
8341 img->colors = NULL;
8342 img->ncolors = 0;
8343 }
8344#endif
8345}
8346
6fc2811b
JR		 8347/* Free X resources of image IMG which is used on frame F. */
8348
8349static void
8350x_clear_image (f, img)
8351 struct frame *f;
8352 struct image *img;
8353{
767b1ff0 8354#if 0 /* TODO: W32 image support */
6fc2811b
JR		 8355
8356 if (img->pixmap)
8357 {
8358 BLOCK_INPUT;
8359 XFreePixmap (NULL, img->pixmap);
8360 img->pixmap = 0;
8361 UNBLOCK_INPUT;
8362 }
8363
8364 if (img->ncolors)
8365 {
8366 int class = FRAME_W32_DISPLAY_INFO (f)->visual->class;
8367
8368 /* If display has an immutable color map, freeing colors is not
8369 necessary and some servers don't allow it. So don't do it. */
8370 if (class != StaticColor
8371 && class != StaticGray
8372 && class != TrueColor)
8373 {
8374 Colormap cmap;
8375 BLOCK_INPUT;
8376 cmap = DefaultColormapOfScreen (FRAME_W32_DISPLAY_INFO (f)->screen);
8377 XFreeColors (FRAME_W32_DISPLAY (f), cmap, img->colors,
8378 img->ncolors, 0);
8379 UNBLOCK_INPUT;
8380 }
8381
8382 xfree (img->colors);
8383 img->colors = NULL;
8384 img->ncolors = 0;
8385 }
8386#endif
8387}
8388
8389
8390/* Allocate color COLOR_NAME for image IMG on frame F. If color
8391 cannot be allocated, use DFLT. Add a newly allocated color to
8392 IMG->colors, so that it can be freed again. Value is the pixel
8393 color. */
8394
8395static unsigned long
8396x_alloc_image_color (f, img, color_name, dflt)
8397 struct frame *f;
8398 struct image *img;
8399 Lisp_Object color_name;
8400 unsigned long dflt;
8401{
767b1ff0 8402#if 0 /* TODO: allocing colors. */
6fc2811b
JR		 8403 XColor color;
8404 unsigned long result;
8405
8406 xassert (STRINGP (color_name));
8407
8408 if (w32_defined_color (f, XSTRING (color_name)->data, &color, 1))
8409 {
8410 /* This isn't called frequently so we get away with simply
8411 reallocating the color vector to the needed size, here. */
8412 ++img->ncolors;
8413 img->colors =
8414 (unsigned long *) xrealloc (img->colors,
8415 img->ncolors * sizeof *img->colors);
8416 img->colors[img->ncolors - 1] = color.pixel;
8417 result = color.pixel;
8418 }
8419 else
8420 result = dflt;
8421 return result;
8422#endif
8423 return 0;
8424}
8425
8426
8427\f
8428/***********************************************************************
8429 Image Cache
8430 ***********************************************************************/
8431
8432static void cache_image P_ ((struct frame *f, struct image *img));
3cf3436e 8433static void postprocess_image P_ ((struct frame *, struct image *));
6fc2811b
JR		 8434
8435
8436/* Return a new, initialized image cache that is allocated from the
8437 heap. Call free_image_cache to free an image cache. */
8438
8439struct image_cache *
8440make_image_cache ()
8441{
8442 struct image_cache *c = (struct image_cache *) xmalloc (sizeof *c);
8443 int size;
8444
8445 bzero (c, sizeof *c);
8446 c->size = 50;
8447 c->images = (struct image **) xmalloc (c->size * sizeof *c->images);
8448 size = IMAGE_CACHE_BUCKETS_SIZE * sizeof *c->buckets;
8449 c->buckets = (struct image **) xmalloc (size);
8450 bzero (c->buckets, size);
8451 return c;
8452}
8453
8454
8455/* Free image cache of frame F. Be aware that X frames share images
8456 caches. */
8457
8458void
8459free_image_cache (f)
8460 struct frame *f;
8461{
8462 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
8463 if (c)
8464 {
8465 int i;
8466
8467 /* Cache should not be referenced by any frame when freed. */
8468 xassert (c->refcount == 0);
8469
8470 for (i = 0; i < c->used; ++i)
8471 free_image (f, c->images[i]);
8472 xfree (c->images);
8473 xfree (c);
8474 xfree (c->buckets);
8475 FRAME_X_IMAGE_CACHE (f) = NULL;
8476 }
8477}
8478
8479
8480/* Clear image cache of frame F. FORCE_P non-zero means free all
8481 images. FORCE_P zero means clear only images that haven't been
8482 displayed for some time. Should be called from time to time to
dfff8a69
JR		 8483 reduce the number of loaded images. If image-eviction-seconds is
8484 non-nil, this frees images in the cache which weren't displayed for
6fc2811b
JR		 8485 at least that many seconds. */
8486
8487void
8488clear_image_cache (f, force_p)
8489 struct frame *f;
8490 int force_p;
8491{
8492 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
8493
8494 if (c && INTEGERP (Vimage_cache_eviction_delay))
8495 {
8496 EMACS_TIME t;
8497 unsigned long old;
8498 int i, any_freed_p = 0;
8499
8500 EMACS_GET_TIME (t);
8501 old = EMACS_SECS (t) - XFASTINT (Vimage_cache_eviction_delay);
8502
8503 for (i = 0; i < c->used; ++i)
8504 {
8505 struct image *img = c->images[i];
8506 if (img != NULL
8507 && (force_p
8508 || (img->timestamp > old)))
8509 {
8510 free_image (f, img);
8511 any_freed_p = 1;
8512 }
8513 }
8514
8515 /* We may be clearing the image cache because, for example,
8516 Emacs was iconified for a longer period of time. In that
8517 case, current matrices may still contain references to
8518 images freed above. So, clear these matrices. */
8519 if (any_freed_p)
8520 {
8521 clear_current_matrices (f);
8522 ++windows_or_buffers_changed;
8523 }
8524 }
8525}
8526
8527
8528DEFUN ("clear-image-cache", Fclear_image_cache, Sclear_image_cache,
8529 0, 1, 0,
74e1aeec
JR		 8530 doc: /* Clear the image cache of FRAME.
8531FRAME nil or omitted means use the selected frame.
8532FRAME t means clear the image caches of all frames. */)
6fc2811b
JR		 8533 (frame)
8534 Lisp_Object frame;
8535{
8536 if (EQ (frame, Qt))
8537 {
8538 Lisp_Object tail;
8539
8540 FOR_EACH_FRAME (tail, frame)
8541 if (FRAME_W32_P (XFRAME (frame)))
8542 clear_image_cache (XFRAME (frame), 1);
8543 }
8544 else
8545 clear_image_cache (check_x_frame (frame), 1);
8546
8547 return Qnil;
8548}
8549
8550
3cf3436e
JR		 8551/* Compute masks and transform image IMG on frame F, as specified
8552 by the image's specification, */
8553
8554static void
8555postprocess_image (f, img)
8556 struct frame *f;
8557 struct image *img;
8558{
8559#if 0 /* TODO: image support. */
8560 /* Manipulation of the image's mask. */
8561 if (img->pixmap)
8562 {
8563 Lisp_Object conversion, spec;
8564 Lisp_Object mask;
8565
8566 spec = img->spec;
8567
8568 /* `:heuristic-mask t'
8569 `:mask heuristic'
8570 means build a mask heuristically.
8571 `:heuristic-mask (R G B)'
8572 `:mask (heuristic (R G B))'
8573 means build a mask from color (R G B) in the
8574 image.
8575 `:mask nil'
8576 means remove a mask, if any. */
8577
8578 mask = image_spec_value (spec, QCheuristic_mask, NULL);
8579 if (!NILP (mask))
8580 x_build_heuristic_mask (f, img, mask);
8581 else
8582 {
8583 int found_p;
8584
8585 mask = image_spec_value (spec, QCmask, &found_p);
8586
8587 if (EQ (mask, Qheuristic))
8588 x_build_heuristic_mask (f, img, Qt);
8589 else if (CONSP (mask)
8590 && EQ (XCAR (mask), Qheuristic))
8591 {
8592 if (CONSP (XCDR (mask)))
8593 x_build_heuristic_mask (f, img, XCAR (XCDR (mask)));
8594 else
8595 x_build_heuristic_mask (f, img, XCDR (mask));
8596 }
8597 else if (NILP (mask) && found_p && img->mask)
8598 {
8599 XFreePixmap (FRAME_X_DISPLAY (f), img->mask);
8600 img->mask = NULL;
8601 }
8602 }
8603
8604
8605 /* Should we apply an image transformation algorithm? */
8606 conversion = image_spec_value (spec, QCconversion, NULL);
8607 if (EQ (conversion, Qdisabled))
8608 x_disable_image (f, img);
8609 else if (EQ (conversion, Qlaplace))
8610 x_laplace (f, img);
8611 else if (EQ (conversion, Qemboss))
8612 x_emboss (f, img);
8613 else if (CONSP (conversion)
8614 && EQ (XCAR (conversion), Qedge_detection))
8615 {
8616 Lisp_Object tem;
8617 tem = XCDR (conversion);
8618 if (CONSP (tem))
8619 x_edge_detection (f, img,
8620 Fplist_get (tem, QCmatrix),
8621 Fplist_get (tem, QCcolor_adjustment));
8622 }
8623 }
8624#endif
8625}
8626
8627
6fc2811b
JR		 8628/* Return the id of image with Lisp specification SPEC on frame F.
8629 SPEC must be a valid Lisp image specification (see valid_image_p). */
8630
8631int
8632lookup_image (f, spec)
8633 struct frame *f;
8634 Lisp_Object spec;
8635{
8636 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
8637 struct image *img;
8638 int i;
8639 unsigned hash;
8640 struct gcpro gcpro1;
8641 EMACS_TIME now;
8642
8643 /* F must be a window-system frame, and SPEC must be a valid image
8644 specification. */
8645 xassert (FRAME_WINDOW_P (f));
8646 xassert (valid_image_p (spec));
8647
8648 GCPRO1 (spec);
8649
8650 /* Look up SPEC in the hash table of the image cache. */
8651 hash = sxhash (spec, 0);
8652 i = hash % IMAGE_CACHE_BUCKETS_SIZE;
8653
8654 for (img = c->buckets[i]; img; img = img->next)
8655 if (img->hash == hash && !NILP (Fequal (img->spec, spec)))
8656 break;
8657
8658 /* If not found, create a new image and cache it. */
8659 if (img == NULL)
8660 {
3cf3436e
JR		 8661 extern Lisp_Object Qpostscript;
8662
8edb0a6f 8663 BLOCK_INPUT;
6fc2811b
JR		 8664 img = make_image (spec, hash);
8665 cache_image (f, img);
8666 img->load_failed_p = img->type->load (f, img) == 0;
6fc2811b
JR		 8667
8668 /* If we can't load the image, and we don't have a width and
8669 height, use some arbitrary width and height so that we can
8670 draw a rectangle for it. */
8671 if (img->load_failed_p)
8672 {
8673 Lisp_Object value;
8674
8675 value = image_spec_value (spec, QCwidth, NULL);
8676 img->width = (INTEGERP (value)
8677 ? XFASTINT (value) : DEFAULT_IMAGE_WIDTH);
8678 value = image_spec_value (spec, QCheight, NULL);
8679 img->height = (INTEGERP (value)
8680 ? XFASTINT (value) : DEFAULT_IMAGE_HEIGHT);
8681 }
8682 else
8683 {
8684 /* Handle image type independent image attributes
a05e2bae
JR		 8685 `:ascent PERCENT', `:margin MARGIN', `:relief RELIEF',
8686 `:background COLOR'. */
8687 Lisp_Object ascent, margin, relief, bg;
6fc2811b
JR		 8688
8689 ascent = image_spec_value (spec, QCascent, NULL);
8690 if (INTEGERP (ascent))
8691 img->ascent = XFASTINT (ascent);
dfff8a69
JR		 8692 else if (EQ (ascent, Qcenter))
8693 img->ascent = CENTERED_IMAGE_ASCENT;
8694
6fc2811b
JR		 8695 margin = image_spec_value (spec, QCmargin, NULL);
8696 if (INTEGERP (margin) && XINT (margin) >= 0)
8edb0a6f
JR		 8697 img->vmargin = img->hmargin = XFASTINT (margin);
8698 else if (CONSP (margin) && INTEGERP (XCAR (margin))
8699 && INTEGERP (XCDR (margin)))
8700 {
8701 if (XINT (XCAR (margin)) > 0)
8702 img->hmargin = XFASTINT (XCAR (margin));
8703 if (XINT (XCDR (margin)) > 0)
8704 img->vmargin = XFASTINT (XCDR (margin));
8705 }
6fc2811b
JR		 8706
8707 relief = image_spec_value (spec, QCrelief, NULL);
8708 if (INTEGERP (relief))
8709 {
8710 img->relief = XINT (relief);
8edb0a6f
JR		 8711 img->hmargin += abs (img->relief);
8712 img->vmargin += abs (img->relief);
6fc2811b
JR		 8713 }
8714
a05e2bae
JR		 8715 if (! img->background_valid)
8716 {
8717 bg = image_spec_value (img->spec, QCbackground, NULL);
8718 if (!NILP (bg))
8719 {
8720 img->background
8721 = x_alloc_image_color (f, img, bg,
8722 FRAME_BACKGROUND_PIXEL (f));
8723 img->background_valid = 1;
8724 }
8725 }
8726
3cf3436e
JR		 8727 /* Do image transformations and compute masks, unless we
8728 don't have the image yet. */
8729 if (!EQ (*img->type->type, Qpostscript))
8730 postprocess_image (f, img);
6fc2811b 8731 }
3cf3436e 8732
8edb0a6f
JR		 8733 UNBLOCK_INPUT;
8734 xassert (!interrupt_input_blocked);
6fc2811b
JR		 8735 }
8736
8737 /* We're using IMG, so set its timestamp to `now'. */
8738 EMACS_GET_TIME (now);
8739 img->timestamp = EMACS_SECS (now);
8740
8741 UNGCPRO;
8742
8743 /* Value is the image id. */
8744 return img->id;
8745}
8746
8747
8748/* Cache image IMG in the image cache of frame F. */
8749
8750static void
8751cache_image (f, img)
8752 struct frame *f;
8753 struct image *img;
8754{
8755 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
8756 int i;
8757
8758 /* Find a free slot in c->images. */
8759 for (i = 0; i < c->used; ++i)
8760 if (c->images[i] == NULL)
8761 break;
8762
8763 /* If no free slot found, maybe enlarge c->images. */
8764 if (i == c->used && c->used == c->size)
8765 {
8766 c->size *= 2;
8767 c->images = (struct image **) xrealloc (c->images,
8768 c->size * sizeof *c->images);
8769 }
8770
8771 /* Add IMG to c->images, and assign IMG an id. */
8772 c->images[i] = img;
8773 img->id = i;
8774 if (i == c->used)
8775 ++c->used;
8776
8777 /* Add IMG to the cache's hash table. */
8778 i = img->hash % IMAGE_CACHE_BUCKETS_SIZE;
8779 img->next = c->buckets[i];
8780 if (img->next)
8781 img->next->prev = img;
8782 img->prev = NULL;
8783 c->buckets[i] = img;
8784}
8785
8786
8787/* Call FN on every image in the image cache of frame F. Used to mark
8788 Lisp Objects in the image cache. */
8789
8790void
8791forall_images_in_image_cache (f, fn)
8792 struct frame *f;
8793 void (*fn) P_ ((struct image *img));
8794{
8795 if (FRAME_LIVE_P (f) && FRAME_W32_P (f))
8796 {
8797 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
8798 if (c)
8799 {
8800 int i;
8801 for (i = 0; i < c->used; ++i)
8802 if (c->images[i])
8803 fn (c->images[i]);
8804 }
8805 }
8806}
8807
8808
8809\f
8810/***********************************************************************
8811 W32 support code
8812 ***********************************************************************/
8813
767b1ff0 8814#if 0 /* TODO: W32 specific image code. */
6fc2811b
JR		 8815
8816static int x_create_x_image_and_pixmap P_ ((struct frame *, int, int, int,
8817 XImage **, Pixmap *));
8818static void x_destroy_x_image P_ ((XImage *));
8819static void x_put_x_image P_ ((struct frame *, XImage *, Pixmap, int, int));
8820
8821
8822/* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
8823 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
8824 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
8825 via xmalloc. Print error messages via image_error if an error
8826 occurs. Value is non-zero if successful. */
8827
8828static int
8829x_create_x_image_and_pixmap (f, width, height, depth, ximg, pixmap)
8830 struct frame *f;
8831 int width, height, depth;
8832 XImage **ximg;
8833 Pixmap *pixmap;
8834{
767b1ff0 8835#if 0 /* TODO: Image support for W32 */
6fc2811b
JR		 8836 Display *display = FRAME_W32_DISPLAY (f);
8837 Screen *screen = FRAME_X_SCREEN (f);
8838 Window window = FRAME_W32_WINDOW (f);
8839
8840 xassert (interrupt_input_blocked);
8841
8842 if (depth <= 0)
a05e2bae 8843 depth = one_w32_display_info.n_cbits;
6fc2811b
JR		 8844 *ximg = XCreateImage (display, DefaultVisualOfScreen (screen),
8845 depth, ZPixmap, 0, NULL, width, height,
8846 depth > 16 ? 32 : depth > 8 ? 16 : 8, 0);
8847 if (*ximg == NULL)
8848 {
8849 image_error ("Unable to allocate X image", Qnil, Qnil);
8850 return 0;
8851 }
8852
8853 /* Allocate image raster. */
8854 (*ximg)->data = (char *) xmalloc ((*ximg)->bytes_per_line * height);
8855
8856 /* Allocate a pixmap of the same size. */
8857 *pixmap = XCreatePixmap (display, window, width, height, depth);
8858 if (*pixmap == 0)
8859 {
8860 x_destroy_x_image (*ximg);
8861 *ximg = NULL;
8862 image_error ("Unable to create X pixmap", Qnil, Qnil);
8863 return 0;
8864 }
8865#endif
8866 return 1;
8867}
8868
8869
8870/* Destroy XImage XIMG. Free XIMG->data. */
8871
8872static void
8873x_destroy_x_image (ximg)
8874 XImage *ximg;
8875{
8876 xassert (interrupt_input_blocked);
8877 if (ximg)
8878 {
8879 xfree (ximg->data);
8880 ximg->data = NULL;
8881 XDestroyImage (ximg);
8882 }
8883}
8884
8885
8886/* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
8887 are width and height of both the image and pixmap. */
8888
8889static void
8890x_put_x_image (f, ximg, pixmap, width, height)
8891 struct frame *f;
8892 XImage *ximg;
8893 Pixmap pixmap;
8894{
8895 GC gc;
8896
8897 xassert (interrupt_input_blocked);
8898 gc = XCreateGC (NULL, pixmap, 0, NULL);
8899 XPutImage (NULL, pixmap, gc, ximg, 0, 0, 0, 0, width, height);
8900 XFreeGC (NULL, gc);
8901}
8902
8903#endif
8904
8905\f
8906/***********************************************************************
3cf3436e 8907 File Handling
6fc2811b
JR		 8908 ***********************************************************************/
8909
8910static Lisp_Object x_find_image_file P_ ((Lisp_Object));
3cf3436e
JR		 8911static char *slurp_file P_ ((char *, int *));
8912
6fc2811b
JR		 8913
8914/* Find image file FILE. Look in data-directory, then
8915 x-bitmap-file-path. Value is the full name of the file found, or
8916 nil if not found. */
8917
8918static Lisp_Object
8919x_find_image_file (file)
8920 Lisp_Object file;
8921{
8922 Lisp_Object file_found, search_path;
8923 struct gcpro gcpro1, gcpro2;
8924 int fd;
8925
8926 file_found = Qnil;
8927 search_path = Fcons (Vdata_directory, Vx_bitmap_file_path);
8928 GCPRO2 (file_found, search_path);
8929
8930 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
c0ec53ad 8931 fd = openp (search_path, file, Qnil, &file_found, 0);
6fc2811b 8932
939d6465 8933 if (fd == -1)
6fc2811b
JR		 8934 file_found = Qnil;
8935 else
8936 close (fd);
8937
8938 UNGCPRO;
8939 return file_found;
8940}
8941
8942
3cf3436e
JR		 8943/* Read FILE into memory. Value is a pointer to a buffer allocated
8944 with xmalloc holding FILE's contents. Value is null if an error
8945 occurred. *SIZE is set to the size of the file. */
8946
8947static char *
8948slurp_file (file, size)
8949 char *file;
8950 int *size;
8951{
8952 FILE *fp = NULL;
8953 char *buf = NULL;
8954 struct stat st;
8955
8956 if (stat (file, &st) == 0
8957 && (fp = fopen (file, "r")) != NULL
8958 && (buf = (char *) xmalloc (st.st_size),
8959 fread (buf, 1, st.st_size, fp) == st.st_size))
8960 {
8961 *size = st.st_size;
8962 fclose (fp);
8963 }
8964 else
8965 {
8966 if (fp)
8967 fclose (fp);
8968 if (buf)
8969 {
8970 xfree (buf);
8971 buf = NULL;
8972 }
8973 }
8974
8975 return buf;
8976}
8977
8978
6fc2811b
JR		 8979\f
8980/***********************************************************************
8981 XBM images
8982 ***********************************************************************/
8983
8984static int xbm_load P_ ((struct frame *f, struct image *img));
8985static int xbm_load_image_from_file P_ ((struct frame *f, struct image *img,
8986 Lisp_Object file));
8987static int xbm_image_p P_ ((Lisp_Object object));
8988static int xbm_read_bitmap_file_data P_ ((char *, int *, int *,
8989 unsigned char **));
8990
8991
8992/* Indices of image specification fields in xbm_format, below. */
8993
8994enum xbm_keyword_index
8995{
8996 XBM_TYPE,
8997 XBM_FILE,
8998 XBM_WIDTH,
8999 XBM_HEIGHT,
9000 XBM_DATA,
9001 XBM_FOREGROUND,
9002 XBM_BACKGROUND,
9003 XBM_ASCENT,
9004 XBM_MARGIN,
9005 XBM_RELIEF,
9006 XBM_ALGORITHM,
9007 XBM_HEURISTIC_MASK,
a05e2bae 9008 XBM_MASK,
6fc2811b
JR		 9009 XBM_LAST
9010};
9011
9012/* Vector of image_keyword structures describing the format
9013 of valid XBM image specifications. */
9014
9015static struct image_keyword xbm_format[XBM_LAST] =
9016{
9017 {":type", IMAGE_SYMBOL_VALUE, 1},
9018 {":file", IMAGE_STRING_VALUE, 0},
9019 {":width", IMAGE_POSITIVE_INTEGER_VALUE, 0},
9020 {":height", IMAGE_POSITIVE_INTEGER_VALUE, 0},
9021 {":data", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
3cf3436e
JR		 9022 {":foreground", IMAGE_STRING_OR_NIL_VALUE, 0},
9023 {":background", IMAGE_STRING_OR_NIL_VALUE, 0},
6fc2811b 9024 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
8edb0a6f 9025 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
6fc2811b 9026 {":relief", IMAGE_INTEGER_VALUE, 0},
a93f4566 9027 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6fc2811b
JR		 9028 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
9029};
9030
9031/* Structure describing the image type XBM. */
9032
9033static struct image_type xbm_type =
9034{
9035 &Qxbm,
9036 xbm_image_p,
9037 xbm_load,
9038 x_clear_image,
9039 NULL
9040};
9041
9042/* Tokens returned from xbm_scan. */
9043
9044enum xbm_token
9045{
9046 XBM_TK_IDENT = 256,
9047 XBM_TK_NUMBER
9048};
9049
9050
9051/* Return non-zero if OBJECT is a valid XBM-type image specification.
9052 A valid specification is a list starting with the symbol `image'
9053 The rest of the list is a property list which must contain an
9054 entry `:type xbm..
9055
9056 If the specification specifies a file to load, it must contain
9057 an entry `:file FILENAME' where FILENAME is a string.
9058
9059 If the specification is for a bitmap loaded from memory it must
9060 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
9061 WIDTH and HEIGHT are integers > 0. DATA may be:
9062
9063 1. a string large enough to hold the bitmap data, i.e. it must
9064 have a size >= (WIDTH + 7) / 8 * HEIGHT
9065
9066 2. a bool-vector of size >= WIDTH * HEIGHT
9067
9068 3. a vector of strings or bool-vectors, one for each line of the
9069 bitmap.
9070
9071 Both the file and data forms may contain the additional entries
9072 `:background COLOR' and `:foreground COLOR'. If not present,
9073 foreground and background of the frame on which the image is
9074 displayed, is used. */
9075
9076static int
9077xbm_image_p (object)
9078 Lisp_Object object;
9079{
9080 struct image_keyword kw[XBM_LAST];
9081
9082 bcopy (xbm_format, kw, sizeof kw);
9083 if (!parse_image_spec (object, kw, XBM_LAST, Qxbm))
9084 return 0;
9085
9086 xassert (EQ (kw[XBM_TYPE].value, Qxbm));
9087
9088 if (kw[XBM_FILE].count)
9089 {
9090 if (kw[XBM_WIDTH].count || kw[XBM_HEIGHT].count || kw[XBM_DATA].count)
9091 return 0;
9092 }
9093 else
9094 {
9095 Lisp_Object data;
9096 int width, height;
9097
9098 /* Entries for `:width', `:height' and `:data' must be present. */
9099 if (!kw[XBM_WIDTH].count
9100 || !kw[XBM_HEIGHT].count
9101 || !kw[XBM_DATA].count)
9102 return 0;
9103
9104 data = kw[XBM_DATA].value;
9105 width = XFASTINT (kw[XBM_WIDTH].value);
9106 height = XFASTINT (kw[XBM_HEIGHT].value);
9107
9108 /* Check type of data, and width and height against contents of
9109 data. */
9110 if (VECTORP (data))
9111 {
9112 int i;
9113
9114 /* Number of elements of the vector must be >= height. */
9115 if (XVECTOR (data)->size < height)
9116 return 0;
9117
9118 /* Each string or bool-vector in data must be large enough
9119 for one line of the image. */
9120 for (i = 0; i < height; ++i)
9121 {
9122 Lisp_Object elt = XVECTOR (data)->contents[i];
9123
9124 if (STRINGP (elt))
9125 {
9126 if (XSTRING (elt)->size
9127 < (width + BITS_PER_CHAR - 1) / BITS_PER_CHAR)
9128 return 0;
9129 }
9130 else if (BOOL_VECTOR_P (elt))
9131 {
9132 if (XBOOL_VECTOR (elt)->size < width)
9133 return 0;
9134 }
9135 else
9136 return 0;
9137 }
9138 }
9139 else if (STRINGP (data))
9140 {
9141 if (XSTRING (data)->size
9142 < (width + BITS_PER_CHAR - 1) / BITS_PER_CHAR * height)
9143 return 0;
9144 }
9145 else if (BOOL_VECTOR_P (data))
9146 {
9147 if (XBOOL_VECTOR (data)->size < width * height)
9148 return 0;
9149 }
9150 else
9151 return 0;
9152 }
9153
9154 /* Baseline must be a value between 0 and 100 (a percentage). */
9155 if (kw[XBM_ASCENT].count
9156 && XFASTINT (kw[XBM_ASCENT].value) > 100)
9157 return 0;
9158
9159 return 1;
9160}
9161
9162
9163/* Scan a bitmap file. FP is the stream to read from. Value is
9164 either an enumerator from enum xbm_token, or a character for a
9165 single-character token, or 0 at end of file. If scanning an
9166 identifier, store the lexeme of the identifier in SVAL. If
9167 scanning a number, store its value in *IVAL. */
9168
9169static int
3cf3436e
JR		 9170xbm_scan (s, end, sval, ival)
9171 char **s, *end;
6fc2811b
JR		 9172 char *sval;
9173 int *ival;
9174{
9175 int c;
3cf3436e
JR		 9176
9177 loop:
9178
6fc2811b 9179 /* Skip white space. */
3cf3436e 9180 while (*s < end &&(c = *(*s)++, isspace (c)))
6fc2811b
JR		 9181 ;
9182
3cf3436e 9183 if (*s >= end)
6fc2811b
JR		 9184 c = 0;
9185 else if (isdigit (c))
9186 {
9187 int value = 0, digit;
9188
3cf3436e 9189 if (c == '0' && *s < end)
6fc2811b 9190 {
3cf3436e 9191 c = *(*s)++;
6fc2811b
JR		 9192 if (c == 'x' || c == 'X')
9193 {
3cf3436e 9194 while (*s < end)
6fc2811b 9195 {
3cf3436e 9196 c = *(*s)++;
6fc2811b
JR		 9197 if (isdigit (c))
9198 digit = c - '0';
9199 else if (c >= 'a' && c <= 'f')
9200 digit = c - 'a' + 10;
9201 else if (c >= 'A' && c <= 'F')
9202 digit = c - 'A' + 10;
9203 else
9204 break;
9205 value = 16 * value + digit;
9206 }
9207 }
9208 else if (isdigit (c))
9209 {
9210 value = c - '0';
3cf3436e
JR		 9211 while (*s < end
9212 && (c = *(*s)++, isdigit (c)))
6fc2811b
JR		 9213 value = 8 * value + c - '0';
9214 }
9215 }
9216 else
9217 {
9218 value = c - '0';
3cf3436e
JR		 9219 while (*s < end
9220 && (c = *(*s)++, isdigit (c)))
6fc2811b
JR		 9221 value = 10 * value + c - '0';
9222 }
9223
3cf3436e
JR		 9224 if (*s < end)
9225 *s = *s - 1;
6fc2811b
JR		 9226 *ival = value;
9227 c = XBM_TK_NUMBER;
9228 }
9229 else if (isalpha (c) || c == '_')
9230 {
9231 *sval++ = c;
3cf3436e
JR		 9232 while (*s < end
9233 && (c = *(*s)++, (isalnum (c) || c == '_')))
6fc2811b
JR		 9234 *sval++ = c;
9235 *sval = 0;
3cf3436e
JR		 9236 if (*s < end)
9237 *s = *s - 1;
6fc2811b
JR		 9238 c = XBM_TK_IDENT;
9239 }
3cf3436e
JR		 9240 else if (c == '/' && **s == '*')
9241 {
9242 /* C-style comment. */
9243 ++*s;
9244 while (**s && (**s != '*' || *(*s + 1) != '/'))
9245 ++*s;
9246 if (**s)
9247 {
9248 *s += 2;
9249 goto loop;
9250 }
9251 }
6fc2811b
JR		 9252
9253 return c;
9254}
9255
9256
9257/* Replacement for XReadBitmapFileData which isn't available under old
3cf3436e
JR		 9258 X versions. CONTENTS is a pointer to a buffer to parse; END is the
9259 buffer's end. Set *WIDTH and *HEIGHT to the width and height of
9260 the image. Return in *DATA the bitmap data allocated with xmalloc.
9261 Value is non-zero if successful. DATA null means just test if
9262 CONTENTS looks like an in-memory XBM file. */
6fc2811b
JR		 9263
9264static int
3cf3436e
JR		 9265xbm_read_bitmap_data (contents, end, width, height, data)
9266 char *contents, *end;
6fc2811b
JR		 9267 int *width, *height;
9268 unsigned char **data;
9269{
3cf3436e 9270 char *s = contents;
6fc2811b
JR		 9271 char buffer[BUFSIZ];
9272 int padding_p = 0;
9273 int v10 = 0;
9274 int bytes_per_line, i, nbytes;
9275 unsigned char *p;
9276 int value;
9277 int LA1;
9278
9279#define match() \
3cf3436e 9280 LA1 = xbm_scan (contents, end, buffer, &value)
6fc2811b
JR		 9281
9282#define expect(TOKEN) \
9283 if (LA1 != (TOKEN)) \
9284 goto failure; \
9285 else \
9286 match ()
9287
9288#define expect_ident(IDENT) \
9289 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
9290 match (); \
9291 else \
9292 goto failure
9293
6fc2811b 9294 *width = *height = -1;
3cf3436e
JR		 9295 if (data)
9296 *data = NULL;
9297 LA1 = xbm_scan (&s, end, buffer, &value);
6fc2811b
JR		 9298
9299 /* Parse defines for width, height and hot-spots. */
9300 while (LA1 == '#')
9301 {
9302 match ();
9303 expect_ident ("define");
9304 expect (XBM_TK_IDENT);
9305
9306 if (LA1 == XBM_TK_NUMBER);
9307 {
9308 char *p = strrchr (buffer, '_');
9309 p = p ? p + 1 : buffer;
9310 if (strcmp (p, "width") == 0)
9311 *width = value;
9312 else if (strcmp (p, "height") == 0)
9313 *height = value;
9314 }
9315 expect (XBM_TK_NUMBER);
9316 }
9317
9318 if (*width < 0 || *height < 0)
9319 goto failure;
3cf3436e
JR		 9320 else if (data == NULL)
9321 goto success;
6fc2811b
JR		 9322
9323 /* Parse bits. Must start with `static'. */
9324 expect_ident ("static");
9325 if (LA1 == XBM_TK_IDENT)
9326 {
9327 if (strcmp (buffer, "unsigned") == 0)
9328 {
9329 match ();
9330 expect_ident ("char");
9331 }
9332 else if (strcmp (buffer, "short") == 0)
9333 {
9334 match ();
9335 v10 = 1;
9336 if (*width % 16 && *width % 16 < 9)
9337 padding_p = 1;
9338 }
9339 else if (strcmp (buffer, "char") == 0)
9340 match ();
9341 else
9342 goto failure;
9343 }
9344 else
9345 goto failure;
9346
9347 expect (XBM_TK_IDENT);
9348 expect ('[');
9349 expect (']');
9350 expect ('=');
9351 expect ('{');
9352
9353 bytes_per_line = (*width + 7) / 8 + padding_p;
9354 nbytes = bytes_per_line * *height;
9355 p = *data = (char *) xmalloc (nbytes);
9356
9357 if (v10)
9358 {
9359
9360 for (i = 0; i < nbytes; i += 2)
9361 {
9362 int val = value;
9363 expect (XBM_TK_NUMBER);
9364
9365 *p++ = val;
9366 if (!padding_p || ((i + 2) % bytes_per_line))
9367 *p++ = value >> 8;
9368
9369 if (LA1 == ',' || LA1 == '}')
9370 match ();
9371 else
9372 goto failure;
9373 }
9374 }
9375 else
9376 {
9377 for (i = 0; i < nbytes; ++i)
9378 {
9379 int val = value;
9380 expect (XBM_TK_NUMBER);
9381
9382 *p++ = val;
9383
9384 if (LA1 == ',' || LA1 == '}')
9385 match ();
9386 else
9387 goto failure;
9388 }
9389 }
9390
3cf3436e 9391 success:
6fc2811b
JR		 9392 return 1;
9393
9394 failure:
3cf3436e
JR		 9395
9396 if (data && *data)
6fc2811b
JR		 9397 {
9398 xfree (*data);
9399 *data = NULL;
9400 }
9401 return 0;
9402
9403#undef match
9404#undef expect
9405#undef expect_ident
9406}
9407
9408
3cf3436e
JR		 9409/* Load XBM image IMG which will be displayed on frame F from buffer
9410 CONTENTS. END is the end of the buffer. Value is non-zero if
9411 successful. */
6fc2811b
JR		 9412
9413static int
3cf3436e 9414xbm_load_image (f, img, contents, end)
6fc2811b
JR		 9415 struct frame *f;
9416 struct image *img;
3cf3436e 9417 char *contents, *end;
6fc2811b
JR		 9418{
9419 int rc;
9420 unsigned char *data;
9421 int success_p = 0;
6fc2811b 9422
3cf3436e 9423 rc = xbm_read_bitmap_data (contents, end, &img->width, &img->height, &data);
6fc2811b
JR		 9424 if (rc)
9425 {
9426 int depth = one_w32_display_info.n_cbits;
9427 unsigned long foreground = FRAME_FOREGROUND_PIXEL (f);
9428 unsigned long background = FRAME_BACKGROUND_PIXEL (f);
9429 Lisp_Object value;
9430
9431 xassert (img->width > 0 && img->height > 0);
9432
9433 /* Get foreground and background colors, maybe allocate colors. */
9434 value = image_spec_value (img->spec, QCforeground, NULL);
9435 if (!NILP (value))
9436 foreground = x_alloc_image_color (f, img, value, foreground);
6fc2811b
JR		 9437 value = image_spec_value (img->spec, QCbackground, NULL);
9438 if (!NILP (value))
a05e2bae
JR		 9439 {
9440 background = x_alloc_image_color (f, img, value, background);
9441 img->background = background;
9442 img->background_valid = 1;
9443 }
9444
767b1ff0 9445#if 0 /* TODO : Port image display to W32 */
6fc2811b
JR		 9446 img->pixmap
9447 = XCreatePixmapFromBitmapData (FRAME_W32_DISPLAY (f),
9448 FRAME_W32_WINDOW (f),
9449 data,
9450 img->width, img->height,
9451 foreground, background,
9452 depth);
a05e2bae 9453#endif
6fc2811b
JR		 9454 xfree (data);
9455
9456 if (img->pixmap == 0)
9457 {
9458 x_clear_image (f, img);
3cf3436e 9459 image_error ("Unable to create X pixmap for `%s'", img->spec, Qnil);
6fc2811b
JR		 9460 }
9461 else
9462 success_p = 1;
6fc2811b
JR		 9463 }
9464 else
9465 image_error ("Error loading XBM image `%s'", img->spec, Qnil);
9466
6fc2811b
JR		 9467 return success_p;
9468}
9469
9470
3cf3436e
JR		 9471/* Value is non-zero if DATA looks like an in-memory XBM file. */
9472
9473static int
9474xbm_file_p (data)
9475 Lisp_Object data;
9476{
9477 int w, h;
9478 return (STRINGP (data)
9479 && xbm_read_bitmap_data (XSTRING (data)->data,
9480 (XSTRING (data)->data
9481 + STRING_BYTES (XSTRING (data))),
9482 &w, &h, NULL));
9483}
9484
9485
6fc2811b
JR		 9486/* Fill image IMG which is used on frame F with pixmap data. Value is
9487 non-zero if successful. */
9488
9489static int
9490xbm_load (f, img)
9491 struct frame *f;
9492 struct image *img;
9493{
9494 int success_p = 0;
9495 Lisp_Object file_name;
9496
9497 xassert (xbm_image_p (img->spec));
9498
9499 /* If IMG->spec specifies a file name, create a non-file spec from it. */
9500 file_name = image_spec_value (img->spec, QCfile, NULL);
9501 if (STRINGP (file_name))
3cf3436e
JR		 9502 {
9503 Lisp_Object file;
9504 char *contents;
9505 int size;
9506 struct gcpro gcpro1;
9507
9508 file = x_find_image_file (file_name);
9509 GCPRO1 (file);
9510 if (!STRINGP (file))
9511 {
9512 image_error ("Cannot find image file `%s'", file_name, Qnil);
9513 UNGCPRO;
9514 return 0;
9515 }
9516
9517 contents = slurp_file (XSTRING (file)->data, &size);
9518 if (contents == NULL)
9519 {
9520 image_error ("Error loading XBM image `%s'", img->spec, Qnil);
9521 UNGCPRO;
9522 return 0;
9523 }
9524
9525 success_p = xbm_load_image (f, img, contents, contents + size);
9526 UNGCPRO;
9527 }
6fc2811b
JR		 9528 else
9529 {
9530 struct image_keyword fmt[XBM_LAST];
9531 Lisp_Object data;
9532 int depth;
9533 unsigned long foreground = FRAME_FOREGROUND_PIXEL (f);
9534 unsigned long background = FRAME_BACKGROUND_PIXEL (f);
9535 char *bits;
9536 int parsed_p;
3cf3436e
JR		 9537 int in_memory_file_p = 0;
9538
9539 /* See if data looks like an in-memory XBM file. */
9540 data = image_spec_value (img->spec, QCdata, NULL);
9541 in_memory_file_p = xbm_file_p (data);
6fc2811b
JR		 9542
9543 /* Parse the list specification. */
9544 bcopy (xbm_format, fmt, sizeof fmt);
9545 parsed_p = parse_image_spec (img->spec, fmt, XBM_LAST, Qxbm);
9546 xassert (parsed_p);
9547
9548 /* Get specified width, and height. */
3cf3436e
JR		 9549 if (!in_memory_file_p)
9550 {
9551 img->width = XFASTINT (fmt[XBM_WIDTH].value);
9552 img->height = XFASTINT (fmt[XBM_HEIGHT].value);
9553 xassert (img->width > 0 && img->height > 0);
9554 }
6fc2811b 9555 /* Get foreground and background colors, maybe allocate colors. */
3cf3436e
JR		 9556 if (fmt[XBM_FOREGROUND].count
9557 && STRINGP (fmt[XBM_FOREGROUND].value))
6fc2811b
JR		 9558 foreground = x_alloc_image_color (f, img, fmt[XBM_FOREGROUND].value,
9559 foreground);
3cf3436e
JR		 9560 if (fmt[XBM_BACKGROUND].count
9561 && STRINGP (fmt[XBM_BACKGROUND].value))
6fc2811b
JR		 9562 background = x_alloc_image_color (f, img, fmt[XBM_BACKGROUND].value,
9563 background);
9564
3cf3436e
JR		 9565 if (in_memory_file_p)
9566 success_p = xbm_load_image (f, img, XSTRING (data)->data,
9567 (XSTRING (data)->data
9568 + STRING_BYTES (XSTRING (data))));
9569 else
6fc2811b 9570 {
3cf3436e
JR		 9571 if (VECTORP (data))
9572 {
9573 int i;
9574 char *p;
9575 int nbytes = (img->width + BITS_PER_CHAR - 1) / BITS_PER_CHAR;
6fc2811b 9576
3cf3436e
JR		 9577 p = bits = (char *) alloca (nbytes * img->height);
9578 for (i = 0; i < img->height; ++i, p += nbytes)
9579 {
9580 Lisp_Object line = XVECTOR (data)->contents[i];
9581 if (STRINGP (line))
9582 bcopy (XSTRING (line)->data, p, nbytes);
9583 else
9584 bcopy (XBOOL_VECTOR (line)->data, p, nbytes);
9585 }
9586 }
9587 else if (STRINGP (data))
9588 bits = XSTRING (data)->data;
9589 else
9590 bits = XBOOL_VECTOR (data)->data;
9591#ifdef TODO /* image support. */
9592 /* Create the pixmap. */
a05e2bae 9593 depth = one_w32_display_info.n_cbits;
3cf3436e
JR		 9594 img->pixmap
9595 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f),
9596 FRAME_X_WINDOW (f),
9597 bits,
9598 img->width, img->height,
9599 foreground, background,
9600 depth);
9601#endif
9602 if (img->pixmap)
9603 success_p = 1;
9604 else
6fc2811b 9605 {
3cf3436e
JR		 9606 image_error ("Unable to create pixmap for XBM image `%s'",
9607 img->spec, Qnil);
9608 x_clear_image (f, img);
6fc2811b
JR		 9609 }
9610 }
6fc2811b
JR		 9611 }
9612
9613 return success_p;
9614}
9615
9616
9617\f
9618/***********************************************************************
9619 XPM images
9620 ***********************************************************************/
9621
9622#if HAVE_XPM
9623
9624static int xpm_image_p P_ ((Lisp_Object object));
9625static int xpm_load P_ ((struct frame *f, struct image *img));
9626static int xpm_valid_color_symbols_p P_ ((Lisp_Object));
9627
9628#include "X11/xpm.h"
9629
9630/* The symbol `xpm' identifying XPM-format images. */
9631
9632Lisp_Object Qxpm;
9633
9634/* Indices of image specification fields in xpm_format, below. */
9635
9636enum xpm_keyword_index
9637{
9638 XPM_TYPE,
9639 XPM_FILE,
9640 XPM_DATA,
9641 XPM_ASCENT,
9642 XPM_MARGIN,
9643 XPM_RELIEF,
9644 XPM_ALGORITHM,
9645 XPM_HEURISTIC_MASK,
a05e2bae 9646 XPM_MASK,
6fc2811b 9647 XPM_COLOR_SYMBOLS,
a05e2bae 9648 XPM_BACKGROUND,
6fc2811b
JR		 9649 XPM_LAST
9650};
9651
9652/* Vector of image_keyword structures describing the format
9653 of valid XPM image specifications. */
9654
9655static struct image_keyword xpm_format[XPM_LAST] =
9656{
9657 {":type", IMAGE_SYMBOL_VALUE, 1},
9658 {":file", IMAGE_STRING_VALUE, 0},
9659 {":data", IMAGE_STRING_VALUE, 0},
9660 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
8edb0a6f 9661 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
6fc2811b 9662 {":relief", IMAGE_INTEGER_VALUE, 0},
a93f4566 9663 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6fc2811b 9664 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
a05e2bae
JR		 9665 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
9666 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
9667 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
6fc2811b
JR		 9668};
9669
9670/* Structure describing the image type XBM. */
9671
9672static struct image_type xpm_type =
9673{
9674 &Qxpm,
9675 xpm_image_p,
9676 xpm_load,
9677 x_clear_image,
9678 NULL
9679};
9680
9681
9682/* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
9683 for XPM images. Such a list must consist of conses whose car and
9684 cdr are strings. */
9685
9686static int
9687xpm_valid_color_symbols_p (color_symbols)
9688 Lisp_Object color_symbols;
9689{
9690 while (CONSP (color_symbols))
9691 {
9692 Lisp_Object sym = XCAR (color_symbols);
9693 if (!CONSP (sym)
9694 || !STRINGP (XCAR (sym))
9695 || !STRINGP (XCDR (sym)))
9696 break;
9697 color_symbols = XCDR (color_symbols);
9698 }
9699
9700 return NILP (color_symbols);
9701}
9702
9703
9704/* Value is non-zero if OBJECT is a valid XPM image specification. */
9705
9706static int
9707xpm_image_p (object)
9708 Lisp_Object object;
9709{
9710 struct image_keyword fmt[XPM_LAST];
9711 bcopy (xpm_format, fmt, sizeof fmt);
9712 return (parse_image_spec (object, fmt, XPM_LAST, Qxpm)
9713 /* Either `:file' or `:data' must be present. */
9714 && fmt[XPM_FILE].count + fmt[XPM_DATA].count == 1
9715 /* Either no `:color-symbols' or it's a list of conses
9716 whose car and cdr are strings. */
9717 && (fmt[XPM_COLOR_SYMBOLS].count == 0
9718 || xpm_valid_color_symbols_p (fmt[XPM_COLOR_SYMBOLS].value))
9719 && (fmt[XPM_ASCENT].count == 0
9720 || XFASTINT (fmt[XPM_ASCENT].value) < 100));
9721}
9722
9723
9724/* Load image IMG which will be displayed on frame F. Value is
9725 non-zero if successful. */
9726
9727static int
9728xpm_load (f, img)
9729 struct frame *f;
9730 struct image *img;
9731{
9732 int rc, i;
9733 XpmAttributes attrs;
9734 Lisp_Object specified_file, color_symbols;
9735
9736 /* Configure the XPM lib. Use the visual of frame F. Allocate
9737 close colors. Return colors allocated. */
9738 bzero (&attrs, sizeof attrs);
dfff8a69
JR		 9739 attrs.visual = FRAME_X_VISUAL (f);
9740 attrs.colormap = FRAME_X_COLORMAP (f);
6fc2811b 9741 attrs.valuemask |= XpmVisual;
dfff8a69 9742 attrs.valuemask |= XpmColormap;
6fc2811b 9743 attrs.valuemask |= XpmReturnAllocPixels;
dfff8a69 9744#ifdef XpmAllocCloseColors
6fc2811b
JR		 9745 attrs.alloc_close_colors = 1;
9746 attrs.valuemask |= XpmAllocCloseColors;
dfff8a69
JR		 9747#else
9748 attrs.closeness = 600;
9749 attrs.valuemask |= XpmCloseness;
9750#endif
6fc2811b
JR		 9751
9752 /* If image specification contains symbolic color definitions, add
9753 these to `attrs'. */
9754 color_symbols = image_spec_value (img->spec, QCcolor_symbols, NULL);
9755 if (CONSP (color_symbols))
9756 {
9757 Lisp_Object tail;
9758 XpmColorSymbol *xpm_syms;
9759 int i, size;
9760
9761 attrs.valuemask |= XpmColorSymbols;
9762
9763 /* Count number of symbols. */
9764 attrs.numsymbols = 0;
9765 for (tail = color_symbols; CONSP (tail); tail = XCDR (tail))
9766 ++attrs.numsymbols;
9767
9768 /* Allocate an XpmColorSymbol array. */
9769 size = attrs.numsymbols * sizeof *xpm_syms;
9770 xpm_syms = (XpmColorSymbol *) alloca (size);
9771 bzero (xpm_syms, size);
9772 attrs.colorsymbols = xpm_syms;
9773
9774 /* Fill the color symbol array. */
9775 for (tail = color_symbols, i = 0;
9776 CONSP (tail);
9777 ++i, tail = XCDR (tail))
9778 {
9779 Lisp_Object name = XCAR (XCAR (tail));
9780 Lisp_Object color = XCDR (XCAR (tail));
9781 xpm_syms[i].name = (char *) alloca (XSTRING (name)->size + 1);
9782 strcpy (xpm_syms[i].name, XSTRING (name)->data);
9783 xpm_syms[i].value = (char *) alloca (XSTRING (color)->size + 1);
9784 strcpy (xpm_syms[i].value, XSTRING (color)->data);
9785 }
9786 }
9787
9788 /* Create a pixmap for the image, either from a file, or from a
9789 string buffer containing data in the same format as an XPM file. */
9790 BLOCK_INPUT;
9791 specified_file = image_spec_value (img->spec, QCfile, NULL);
9792 if (STRINGP (specified_file))
9793 {
9794 Lisp_Object file = x_find_image_file (specified_file);
9795 if (!STRINGP (file))
9796 {
9797 image_error ("Cannot find image file `%s'", specified_file, Qnil);
9798 UNBLOCK_INPUT;
9799 return 0;
9800 }
9801
9802 rc = XpmReadFileToPixmap (NULL, FRAME_W32_WINDOW (f),
9803 XSTRING (file)->data, &img->pixmap, &img->mask,
9804 &attrs);
9805 }
9806 else
9807 {
9808 Lisp_Object buffer = image_spec_value (img->spec, QCdata, NULL);
9809 rc = XpmCreatePixmapFromBuffer (NULL, FRAME_W32_WINDOW (f),
9810 XSTRING (buffer)->data,
9811 &img->pixmap, &img->mask,
9812 &attrs);
9813 }
9814 UNBLOCK_INPUT;
9815
9816 if (rc == XpmSuccess)
9817 {
9818 /* Remember allocated colors. */
9819 img->ncolors = attrs.nalloc_pixels;
9820 img->colors = (unsigned long *) xmalloc (img->ncolors
9821 * sizeof *img->colors);
9822 for (i = 0; i < attrs.nalloc_pixels; ++i)
9823 img->colors[i] = attrs.alloc_pixels[i];
9824
9825 img->width = attrs.width;
9826 img->height = attrs.height;
9827 xassert (img->width > 0 && img->height > 0);
9828
9829 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
9830 BLOCK_INPUT;
9831 XpmFreeAttributes (&attrs);
9832 UNBLOCK_INPUT;
9833 }
9834 else
9835 {
9836 switch (rc)
9837 {
9838 case XpmOpenFailed:
9839 image_error ("Error opening XPM file (%s)", img->spec, Qnil);
9840 break;
9841
9842 case XpmFileInvalid:
9843 image_error ("Invalid XPM file (%s)", img->spec, Qnil);
9844 break;
9845
9846 case XpmNoMemory:
9847 image_error ("Out of memory (%s)", img->spec, Qnil);
9848 break;
9849
9850 case XpmColorFailed:
9851 image_error ("Color allocation error (%s)", img->spec, Qnil);
9852 break;
9853
9854 default:
9855 image_error ("Unknown error (%s)", img->spec, Qnil);
9856 break;
9857 }
9858 }
9859
9860 return rc == XpmSuccess;
9861}
9862
9863#endif /* HAVE_XPM != 0 */
9864
9865\f
767b1ff0 9866#if 0 /* TODO : Color tables on W32. */
6fc2811b
JR		 9867/***********************************************************************
9868 Color table
9869 ***********************************************************************/
9870
9871/* An entry in the color table mapping an RGB color to a pixel color. */
9872
9873struct ct_color
9874{
9875 int r, g, b;
9876 unsigned long pixel;
9877
9878 /* Next in color table collision list. */
9879 struct ct_color *next;
9880};
9881
9882/* The bucket vector size to use. Must be prime. */
9883
9884#define CT_SIZE 101
9885
9886/* Value is a hash of the RGB color given by R, G, and B. */
9887
9888#define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
9889
9890/* The color hash table. */
9891
9892struct ct_color **ct_table;
9893
9894/* Number of entries in the color table. */
9895
9896int ct_colors_allocated;
9897
9898/* Function prototypes. */
9899
9900static void init_color_table P_ ((void));
9901static void free_color_table P_ ((void));
9902static unsigned long *colors_in_color_table P_ ((int *n));
9903static unsigned long lookup_rgb_color P_ ((struct frame *f, int r, int g, int b));
9904static unsigned long lookup_pixel_color P_ ((struct frame *f, unsigned long p));
9905
9906
9907/* Initialize the color table. */
9908
9909static void
9910init_color_table ()
9911{
9912 int size = CT_SIZE * sizeof (*ct_table);
9913 ct_table = (struct ct_color **) xmalloc (size);
9914 bzero (ct_table, size);
9915 ct_colors_allocated = 0;
9916}
9917
9918
9919/* Free memory associated with the color table. */
9920
9921static void
9922free_color_table ()
9923{
9924 int i;
9925 struct ct_color *p, *next;
9926
9927 for (i = 0; i < CT_SIZE; ++i)
9928 for (p = ct_table[i]; p; p = next)
9929 {
9930 next = p->next;
9931 xfree (p);
9932 }
9933
9934 xfree (ct_table);
9935 ct_table = NULL;
9936}
9937
9938
9939/* Value is a pixel color for RGB color R, G, B on frame F. If an
9940 entry for that color already is in the color table, return the
9941 pixel color of that entry. Otherwise, allocate a new color for R,
9942 G, B, and make an entry in the color table. */
9943
9944static unsigned long
9945lookup_rgb_color (f, r, g, b)
9946 struct frame *f;
9947 int r, g, b;
9948{
9949 unsigned hash = CT_HASH_RGB (r, g, b);
9950 int i = hash % CT_SIZE;
9951 struct ct_color *p;
9952
9953 for (p = ct_table[i]; p; p = p->next)
9954 if (p->r == r && p->g == g && p->b == b)
9955 break;
9956
9957 if (p == NULL)
9958 {
9959 COLORREF color;
9960 Colormap cmap;
9961 int rc;
9962
9963 color = PALETTERGB (r, g, b);
9964
9965 ++ct_colors_allocated;
9966
9967 p = (struct ct_color *) xmalloc (sizeof *p);
9968 p->r = r;
9969 p->g = g;
9970 p->b = b;
9971 p->pixel = color;
9972 p->next = ct_table[i];
9973 ct_table[i] = p;
9974 }
9975
9976 return p->pixel;
9977}
9978
9979
9980/* Look up pixel color PIXEL which is used on frame F in the color
9981 table. If not already present, allocate it. Value is PIXEL. */
9982
9983static unsigned long
9984lookup_pixel_color (f, pixel)
9985 struct frame *f;
9986 unsigned long pixel;
9987{
9988 int i = pixel % CT_SIZE;
9989 struct ct_color *p;
9990
9991 for (p = ct_table[i]; p; p = p->next)
9992 if (p->pixel == pixel)
9993 break;
9994
9995 if (p == NULL)
9996 {
9997 XColor color;
9998 Colormap cmap;
9999 int rc;
10000
10001 BLOCK_INPUT;
10002
10003 cmap = DefaultColormapOfScreen (FRAME_X_SCREEN (f));
10004 color.pixel = pixel;
10005 XQueryColor (NULL, cmap, &color);
10006 rc = x_alloc_nearest_color (f, cmap, &color);
10007 UNBLOCK_INPUT;
10008
10009 if (rc)
10010 {
10011 ++ct_colors_allocated;
10012
10013 p = (struct ct_color *) xmalloc (sizeof *p);
10014 p->r = color.red;
10015 p->g = color.green;
10016 p->b = color.blue;
10017 p->pixel = pixel;
10018 p->next = ct_table[i];
10019 ct_table[i] = p;
10020 }
10021 else
10022 return FRAME_FOREGROUND_PIXEL (f);
10023 }
10024 return p->pixel;
10025}
10026
10027
10028/* Value is a vector of all pixel colors contained in the color table,
10029 allocated via xmalloc. Set *N to the number of colors. */
10030
10031static unsigned long *
10032colors_in_color_table (n)
10033 int *n;
10034{
10035 int i, j;
10036 struct ct_color *p;
10037 unsigned long *colors;
10038
10039 if (ct_colors_allocated == 0)
10040 {
10041 *n = 0;
10042 colors = NULL;
10043 }
10044 else
10045 {
10046 colors = (unsigned long *) xmalloc (ct_colors_allocated
10047 * sizeof *colors);
10048 *n = ct_colors_allocated;
10049
10050 for (i = j = 0; i < CT_SIZE; ++i)
10051 for (p = ct_table[i]; p; p = p->next)
10052 colors[j++] = p->pixel;
10053 }
10054
10055 return colors;
10056}
10057
767b1ff0 10058#endif /* TODO */
6fc2811b
JR		 10059
10060\f
10061/***********************************************************************
10062 Algorithms
10063 ***********************************************************************/
3cf3436e
JR		 10064#if 0 /* TODO: image support. */
10065static XColor *x_to_xcolors P_ ((struct frame *, struct image *, int));
10066static void x_from_xcolors P_ ((struct frame *, struct image *, XColor *));
10067static void x_detect_edges P_ ((struct frame *, struct image *, int[9], int));
10068
10069/* Non-zero means draw a cross on images having `:conversion
10070 disabled'. */
6fc2811b 10071
3cf3436e 10072int cross_disabled_images;
6fc2811b 10073
3cf3436e
JR		 10074/* Edge detection matrices for different edge-detection
10075 strategies. */
6fc2811b 10076
3cf3436e
JR		 10077static int emboss_matrix[9] = {
10078 /* x - 1 x x + 1 */
10079 2, -1, 0, /* y - 1 */
10080 -1, 0, 1, /* y */
10081 0, 1, -2 /* y + 1 */
10082};
10083
10084static int laplace_matrix[9] = {
10085 /* x - 1 x x + 1 */
10086 1, 0, 0, /* y - 1 */
10087 0, 0, 0, /* y */
10088 0, 0, -1 /* y + 1 */
10089};
10090
10091/* Value is the intensity of the color whose red/green/blue values
10092 are R, G, and B. */
10093
10094#define COLOR_INTENSITY(R, G, B) ((2 * (R) + 3 * (G) + (B)) / 6)
10095
10096
10097/* On frame F, return an array of XColor structures describing image
10098 IMG->pixmap. Each XColor structure has its pixel color set. RGB_P
10099 non-zero means also fill the red/green/blue members of the XColor
10100 structures. Value is a pointer to the array of XColors structures,
10101 allocated with xmalloc; it must be freed by the caller. */
10102
10103static XColor *
10104x_to_xcolors (f, img, rgb_p)
10105 struct frame *f;
10106 struct image *img;
10107 int rgb_p;
10108{
10109 int x, y;
10110 XColor *colors, *p;
10111 XImage *ximg;
10112
10113 colors = (XColor *) xmalloc (img->width * img->height * sizeof *colors);
10114
10115 /* Get the X image IMG->pixmap. */
10116 ximg = XGetImage (FRAME_X_DISPLAY (f), img->pixmap,
10117 0, 0, img->width, img->height, ~0, ZPixmap);
10118
10119 /* Fill the `pixel' members of the XColor array. I wished there
10120 were an easy and portable way to circumvent XGetPixel. */
10121 p = colors;
10122 for (y = 0; y < img->height; ++y)
10123 {
10124 XColor *row = p;
10125
10126 for (x = 0; x < img->width; ++x, ++p)
10127 p->pixel = XGetPixel (ximg, x, y);
10128
10129 if (rgb_p)
10130 x_query_colors (f, row, img->width);
10131 }
10132
10133 XDestroyImage (ximg);
10134 return colors;
10135}
10136
10137
10138/* Create IMG->pixmap from an array COLORS of XColor structures, whose
10139 RGB members are set. F is the frame on which this all happens.
10140 COLORS will be freed; an existing IMG->pixmap will be freed, too. */
6fc2811b
JR		 10141
10142static void
3cf3436e 10143x_from_xcolors (f, img, colors)
6fc2811b 10144 struct frame *f;
3cf3436e 10145 struct image *img;
6fc2811b 10146 XColor *colors;
6fc2811b 10147{
3cf3436e
JR		 10148 int x, y;
10149 XImage *oimg;
10150 Pixmap pixmap;
10151 XColor *p;
10152
10153 init_color_table ();
10154
10155 x_create_x_image_and_pixmap (f, img->width, img->height, 0,
10156 &oimg, &pixmap);
10157 p = colors;
10158 for (y = 0; y < img->height; ++y)
10159 for (x = 0; x < img->width; ++x, ++p)
10160 {
10161 unsigned long pixel;
10162 pixel = lookup_rgb_color (f, p->red, p->green, p->blue);
10163 XPutPixel (oimg, x, y, pixel);
10164 }
6fc2811b 10165
3cf3436e
JR		 10166 xfree (colors);
10167 x_clear_image_1 (f, img, 1, 0, 1);
6fc2811b 10168
3cf3436e
JR		 10169 x_put_x_image (f, oimg, pixmap, img->width, img->height);
10170 x_destroy_x_image (oimg);
10171 img->pixmap = pixmap;
10172 img->colors = colors_in_color_table (&img->ncolors);
10173 free_color_table ();
6fc2811b
JR		 10174}
10175
10176
3cf3436e
JR		 10177/* On frame F, perform edge-detection on image IMG.
10178
10179 MATRIX is a nine-element array specifying the transformation
10180 matrix. See emboss_matrix for an example.
10181
10182 COLOR_ADJUST is a color adjustment added to each pixel of the
10183 outgoing image. */
6fc2811b
JR		 10184
10185static void
3cf3436e 10186x_detect_edges (f, img, matrix, color_adjust)
6fc2811b 10187 struct frame *f;
3cf3436e
JR		 10188 struct image *img;
10189 int matrix[9], color_adjust;
6fc2811b 10190{
3cf3436e
JR		 10191 XColor *colors = x_to_xcolors (f, img, 1);
10192 XColor *new, *p;
10193 int x, y, i, sum;
10194
10195 for (i = sum = 0; i < 9; ++i)
10196 sum += abs (matrix[i]);
10197
10198#define COLOR(A, X, Y) ((A) + (Y) * img->width + (X))
10199
10200 new = (XColor *) xmalloc (img->width * img->height * sizeof *new);
10201
10202 for (y = 0; y < img->height; ++y)
10203 {
10204 p = COLOR (new, 0, y);
10205 p->red = p->green = p->blue = 0xffff/2;
10206 p = COLOR (new, img->width - 1, y);
10207 p->red = p->green = p->blue = 0xffff/2;
10208 }
6fc2811b 10209
3cf3436e
JR		 10210 for (x = 1; x < img->width - 1; ++x)
10211 {
10212 p = COLOR (new, x, 0);
10213 p->red = p->green = p->blue = 0xffff/2;
10214 p = COLOR (new, x, img->height - 1);
10215 p->red = p->green = p->blue = 0xffff/2;
10216 }
10217
10218 for (y = 1; y < img->height - 1; ++y)
10219 {
10220 p = COLOR (new, 1, y);
10221
10222 for (x = 1; x < img->width - 1; ++x, ++p)
10223 {
10224 int r, g, b, y1, x1;
10225
10226 r = g = b = i = 0;
10227 for (y1 = y - 1; y1 < y + 2; ++y1)
10228 for (x1 = x - 1; x1 < x + 2; ++x1, ++i)
10229 if (matrix[i])
10230 {
10231 XColor *t = COLOR (colors, x1, y1);
10232 r += matrix[i] * t->red;
10233 g += matrix[i] * t->green;
10234 b += matrix[i] * t->blue;
10235 }
10236
10237 r = (r / sum + color_adjust) & 0xffff;
10238 g = (g / sum + color_adjust) & 0xffff;
10239 b = (b / sum + color_adjust) & 0xffff;
10240 p->red = p->green = p->blue = COLOR_INTENSITY (r, g, b);
10241 }
10242 }
10243
10244 xfree (colors);
10245 x_from_xcolors (f, img, new);
10246
10247#undef COLOR
10248}
10249
10250
10251/* Perform the pre-defined `emboss' edge-detection on image IMG
10252 on frame F. */
10253
10254static void
10255x_emboss (f, img)
10256 struct frame *f;
10257 struct image *img;
10258{
10259 x_detect_edges (f, img, emboss_matrix, 0xffff / 2);
6fc2811b 10260}
3cf3436e 10261
6fc2811b
JR		 10262
10263/* Transform image IMG which is used on frame F with a Laplace
10264 edge-detection algorithm. The result is an image that can be used
10265 to draw disabled buttons, for example. */
10266
10267static void
10268x_laplace (f, img)
10269 struct frame *f;
10270 struct image *img;
10271{
3cf3436e
JR		 10272 x_detect_edges (f, img, laplace_matrix, 45000);
10273}
6fc2811b 10274
6fc2811b 10275
3cf3436e
JR		 10276/* Perform edge-detection on image IMG on frame F, with specified
10277 transformation matrix MATRIX and color-adjustment COLOR_ADJUST.
6fc2811b 10278
3cf3436e 10279 MATRIX must be either
6fc2811b 10280
3cf3436e
JR		 10281 - a list of at least 9 numbers in row-major form
10282 - a vector of at least 9 numbers
6fc2811b 10283
3cf3436e
JR		 10284 COLOR_ADJUST nil means use a default; otherwise it must be a
10285 number. */
6fc2811b 10286
3cf3436e
JR		 10287static void
10288x_edge_detection (f, img, matrix, color_adjust)
10289 struct frame *f;
10290 struct image *img;
10291 Lisp_Object matrix, color_adjust;
10292{
10293 int i = 0;
10294 int trans[9];
10295
10296 if (CONSP (matrix))
6fc2811b 10297 {
3cf3436e
JR		 10298 for (i = 0;
10299 i < 9 && CONSP (matrix) && NUMBERP (XCAR (matrix));
10300 ++i, matrix = XCDR (matrix))
10301 trans[i] = XFLOATINT (XCAR (matrix));
10302 }
10303 else if (VECTORP (matrix) && ASIZE (matrix) >= 9)
10304 {
10305 for (i = 0; i < 9 && NUMBERP (AREF (matrix, i)); ++i)
10306 trans[i] = XFLOATINT (AREF (matrix, i));
10307 }
10308
10309 if (NILP (color_adjust))
10310 color_adjust = make_number (0xffff / 2);
10311
10312 if (i == 9 && NUMBERP (color_adjust))
10313 x_detect_edges (f, img, trans, (int) XFLOATINT (color_adjust));
10314}
10315
6fc2811b 10316
3cf3436e 10317/* Transform image IMG on frame F so that it looks disabled. */
6fc2811b 10318
3cf3436e
JR		 10319static void
10320x_disable_image (f, img)
10321 struct frame *f;
10322 struct image *img;
10323{
10324 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
10325
10326 if (dpyinfo->n_planes >= 2)
10327 {
10328 /* Color (or grayscale). Convert to gray, and equalize. Just
10329 drawing such images with a stipple can look very odd, so
10330 we're using this method instead. */
10331 XColor *colors = x_to_xcolors (f, img, 1);
10332 XColor *p, *end;
10333 const int h = 15000;
10334 const int l = 30000;
10335
10336 for (p = colors, end = colors + img->width * img->height;
10337 p < end;
10338 ++p)
6fc2811b 10339 {
3cf3436e
JR		 10340 int i = COLOR_INTENSITY (p->red, p->green, p->blue);
10341 int i2 = (0xffff - h - l) * i / 0xffff + l;
10342 p->red = p->green = p->blue = i2;
6fc2811b
JR		 10343 }
10344
3cf3436e 10345 x_from_xcolors (f, img, colors);
6fc2811b
JR		 10346 }
10347
3cf3436e
JR		 10348 /* Draw a cross over the disabled image, if we must or if we
10349 should. */
10350 if (dpyinfo->n_planes < 2 || cross_disabled_images)
10351 {
10352 Display *dpy = FRAME_X_DISPLAY (f);
10353 GC gc;
6fc2811b 10354
3cf3436e
JR		 10355 gc = XCreateGC (dpy, img->pixmap, 0, NULL);
10356 XSetForeground (dpy, gc, BLACK_PIX_DEFAULT (f));
10357 XDrawLine (dpy, img->pixmap, gc, 0, 0,
10358 img->width - 1, img->height - 1);
10359 XDrawLine (dpy, img->pixmap, gc, 0, img->height - 1,
10360 img->width - 1, 0);
10361 XFreeGC (dpy, gc);
6fc2811b 10362
3cf3436e
JR		 10363 if (img->mask)
10364 {
10365 gc = XCreateGC (dpy, img->mask, 0, NULL);
10366 XSetForeground (dpy, gc, WHITE_PIX_DEFAULT (f));
10367 XDrawLine (dpy, img->mask, gc, 0, 0,
10368 img->width - 1, img->height - 1);
10369 XDrawLine (dpy, img->mask, gc, 0, img->height - 1,
10370 img->width - 1, 0);
10371 XFreeGC (dpy, gc);
10372 }
10373 }
6fc2811b
JR		 10374}
10375
10376
10377/* Build a mask for image IMG which is used on frame F. FILE is the
10378 name of an image file, for error messages. HOW determines how to
10379 determine the background color of IMG. If it is a list '(R G B)',
10380 with R, G, and B being integers >= 0, take that as the color of the
10381 background. Otherwise, determine the background color of IMG
10382 heuristically. Value is non-zero if successful. */
10383
10384static int
10385x_build_heuristic_mask (f, img, how)
10386 struct frame *f;
10387 struct image *img;
10388 Lisp_Object how;
10389{
6fc2811b
JR		 10390 Display *dpy = FRAME_W32_DISPLAY (f);
10391 XImage *ximg, *mask_img;
a05e2bae
JR		 10392 int x, y, rc, use_img_background;
10393 unsigned long bg = 0;
10394
10395 if (img->mask)
10396 {
10397 XFreePixmap (FRAME_X_DISPLAY (f), img->mask);
10398 img->mask = None;
10399 img->background_transparent_valid = 0;
10400 }
6fc2811b 10401
6fc2811b
JR		 10402 /* Create an image and pixmap serving as mask. */
10403 rc = x_create_x_image_and_pixmap (f, img->width, img->height, 1,
10404 &mask_img, &img->mask);
10405 if (!rc)
a05e2bae 10406 return 0;
6fc2811b
JR		 10407
10408 /* Get the X image of IMG->pixmap. */
10409 ximg = XGetImage (dpy, img->pixmap, 0, 0, img->width, img->height,
10410 ~0, ZPixmap);
10411
10412 /* Determine the background color of ximg. If HOW is `(R G B)'
a05e2bae
JR		 10413 take that as color. Otherwise, use the image's background color. */
10414 use_img_background = 1;
6fc2811b
JR		 10415
10416 if (CONSP (how))
10417 {
a05e2bae 10418 int rgb[3], i;
6fc2811b 10419
a05e2bae 10420 for (i = 0; i < 3 && CONSP (how) && NATNUMP (XCAR (how)); ++i)
6fc2811b
JR		 10421 {
10422 rgb[i] = XFASTINT (XCAR (how)) & 0xffff;
10423 how = XCDR (how);
10424 }
10425
10426 if (i == 3 && NILP (how))
10427 {
10428 char color_name[30];
6fc2811b 10429 sprintf (color_name, "#%04x%04x%04x", rgb[0], rgb[1], rgb[2]);
a05e2bae
JR		 10430 bg = x_alloc_image_color (f, img, build_string (color_name), 0);
10431 use_img_background = 0;
6fc2811b
JR		 10432 }
10433 }
10434
a05e2bae
JR		 10435 if (use_img_background)
10436 bg = four_corners_best (ximg, img->width, img->height);
6fc2811b
JR		 10437
10438 /* Set all bits in mask_img to 1 whose color in ximg is different
10439 from the background color bg. */
10440 for (y = 0; y < img->height; ++y)
10441 for (x = 0; x < img->width; ++x)
10442 XPutPixel (mask_img, x, y, XGetPixel (ximg, x, y) != bg);
10443
a05e2bae
JR		 10444 /* Fill in the background_transparent field while we have the mask handy. */
10445 image_background_transparent (img, f, mask_img);
10446
6fc2811b
JR		 10447 /* Put mask_img into img->mask. */
10448 x_put_x_image (f, mask_img, img->mask, img->width, img->height);
10449 x_destroy_x_image (mask_img);
10450 XDestroyImage (ximg);
6fc2811b
JR		 10451
10452 return 1;
10453}
3cf3436e 10454#endif /* TODO */
6fc2811b
JR		 10455
10456\f
10457/***********************************************************************
10458 PBM (mono, gray, color)
10459 ***********************************************************************/
10460#ifdef HAVE_PBM
10461
10462static int pbm_image_p P_ ((Lisp_Object object));
10463static int pbm_load P_ ((struct frame *f, struct image *img));
10464static int pbm_scan_number P_ ((unsigned char **, unsigned char *));
10465
10466/* The symbol `pbm' identifying images of this type. */
10467
10468Lisp_Object Qpbm;
10469
10470/* Indices of image specification fields in gs_format, below. */
10471
10472enum pbm_keyword_index
10473{
10474 PBM_TYPE,
10475 PBM_FILE,
10476 PBM_DATA,
10477 PBM_ASCENT,
10478 PBM_MARGIN,
10479 PBM_RELIEF,
10480 PBM_ALGORITHM,
10481 PBM_HEURISTIC_MASK,
a05e2bae
JR		 10482 PBM_MASK,
10483 PBM_FOREGROUND,
10484 PBM_BACKGROUND,
6fc2811b
JR		 10485 PBM_LAST
10486};
10487
10488/* Vector of image_keyword structures describing the format
10489 of valid user-defined image specifications. */
10490
10491static struct image_keyword pbm_format[PBM_LAST] =
10492{
10493 {":type", IMAGE_SYMBOL_VALUE, 1},
10494 {":file", IMAGE_STRING_VALUE, 0},
10495 {":data", IMAGE_STRING_VALUE, 0},
10496 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
8edb0a6f 10497 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
6fc2811b 10498 {":relief", IMAGE_INTEGER_VALUE, 0},
a93f4566 10499 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
3cf3436e
JR		 10500 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
10501 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
10502 {":foreground", IMAGE_STRING_OR_NIL_VALUE, 0},
10503 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
6fc2811b
JR		 10504};
10505
10506/* Structure describing the image type `pbm'. */
10507
10508static struct image_type pbm_type =
10509{
10510 &Qpbm,
10511 pbm_image_p,
10512 pbm_load,
10513 x_clear_image,
10514 NULL
10515};
10516
10517
10518/* Return non-zero if OBJECT is a valid PBM image specification. */
10519
10520static int
10521pbm_image_p (object)
10522 Lisp_Object object;
10523{
10524 struct image_keyword fmt[PBM_LAST];
10525
10526 bcopy (pbm_format, fmt, sizeof fmt);
10527
10528 if (!parse_image_spec (object, fmt, PBM_LAST, Qpbm)
10529 || (fmt[PBM_ASCENT].count
10530 && XFASTINT (fmt[PBM_ASCENT].value) > 100))
10531 return 0;
10532
10533 /* Must specify either :data or :file. */
10534 return fmt[PBM_DATA].count + fmt[PBM_FILE].count == 1;
10535}
10536
10537
10538/* Scan a decimal number from *S and return it. Advance *S while
10539 reading the number. END is the end of the string. Value is -1 at
10540 end of input. */
10541
10542static int
10543pbm_scan_number (s, end)
10544 unsigned char **s, *end;
10545{
10546 int c, val = -1;
10547
10548 while (*s < end)
10549 {
10550 /* Skip white-space. */
10551 while (*s < end && (c = *(*s)++, isspace (c)))
10552 ;
10553
10554 if (c == '#')
10555 {
10556 /* Skip comment to end of line. */
10557 while (*s < end && (c = *(*s)++, c != '\n'))
10558 ;
10559 }
10560 else if (isdigit (c))
10561 {
10562 /* Read decimal number. */
10563 val = c - '0';
10564 while (*s < end && (c = *(*s)++, isdigit (c)))
10565 val = 10 * val + c - '0';
10566 break;
10567 }
10568 else
10569 break;
10570 }
10571
10572 return val;
10573}
10574
10575
10576/* Read FILE into memory. Value is a pointer to a buffer allocated
10577 with xmalloc holding FILE's contents. Value is null if an error
10578 occured. *SIZE is set to the size of the file. */
10579
10580static char *
10581pbm_read_file (file, size)
10582 Lisp_Object file;
10583 int *size;
10584{
10585 FILE *fp = NULL;
10586 char *buf = NULL;
10587 struct stat st;
10588
10589 if (stat (XSTRING (file)->data, &st) == 0
10590 && (fp = fopen (XSTRING (file)->data, "r")) != NULL
10591 && (buf = (char *) xmalloc (st.st_size),
10592 fread (buf, 1, st.st_size, fp) == st.st_size))
10593 {
10594 *size = st.st_size;
10595 fclose (fp);
10596 }
10597 else
10598 {
10599 if (fp)
10600 fclose (fp);
10601 if (buf)
10602 {
10603 xfree (buf);
10604 buf = NULL;
10605 }
10606 }
10607
10608 return buf;
10609}
10610
10611
10612/* Load PBM image IMG for use on frame F. */
10613
10614static int
10615pbm_load (f, img)
10616 struct frame *f;
10617 struct image *img;
10618{
10619 int raw_p, x, y;
10620 int width, height, max_color_idx = 0;
10621 XImage *ximg;
10622 Lisp_Object file, specified_file;
10623 enum {PBM_MONO, PBM_GRAY, PBM_COLOR} type;
10624 struct gcpro gcpro1;
10625 unsigned char *contents = NULL;
10626 unsigned char *end, *p;
10627 int size;
10628
10629 specified_file = image_spec_value (img->spec, QCfile, NULL);
10630 file = Qnil;
10631 GCPRO1 (file);
10632
10633 if (STRINGP (specified_file))
10634 {
10635 file = x_find_image_file (specified_file);
10636 if (!STRINGP (file))
10637 {
10638 image_error ("Cannot find image file `%s'", specified_file, Qnil);
10639 UNGCPRO;
10640 return 0;
10641 }
10642
3cf3436e 10643 contents = slurp_file (XSTRING (file)->data, &size);
6fc2811b
JR		 10644 if (contents == NULL)
10645 {
10646 image_error ("Error reading `%s'", file, Qnil);
10647 UNGCPRO;
10648 return 0;
10649 }
10650
10651 p = contents;
10652 end = contents + size;
10653 }
10654 else
10655 {
10656 Lisp_Object data;
10657 data = image_spec_value (img->spec, QCdata, NULL);
10658 p = XSTRING (data)->data;
10659 end = p + STRING_BYTES (XSTRING (data));
10660 }
10661
10662 /* Check magic number. */
10663 if (end - p < 2 || *p++ != 'P')
10664 {
10665 image_error ("Not a PBM image: `%s'", img->spec, Qnil);
10666 error:
10667 xfree (contents);
10668 UNGCPRO;
10669 return 0;
10670 }
10671
6fc2811b
JR		 10672 switch (*p++)
10673 {
10674 case '1':
10675 raw_p = 0, type = PBM_MONO;
10676 break;
10677
10678 case '2':
10679 raw_p = 0, type = PBM_GRAY;
10680 break;
10681
10682 case '3':
10683 raw_p = 0, type = PBM_COLOR;
10684 break;
10685
10686 case '4':
10687 raw_p = 1, type = PBM_MONO;
10688 break;
10689
10690 case '5':
10691 raw_p = 1, type = PBM_GRAY;
10692 break;
10693
10694 case '6':
10695 raw_p = 1, type = PBM_COLOR;
10696 break;
10697
10698 default:
10699 image_error ("Not a PBM image: `%s'", img->spec, Qnil);
10700 goto error;
10701 }
10702
10703 /* Read width, height, maximum color-component. Characters
10704 starting with `#' up to the end of a line are ignored. */
10705 width = pbm_scan_number (&p, end);
10706 height = pbm_scan_number (&p, end);
10707
10708 if (type != PBM_MONO)
10709 {
10710 max_color_idx = pbm_scan_number (&p, end);
10711 if (raw_p && max_color_idx > 255)
10712 max_color_idx = 255;
10713 }
10714
10715 if (width < 0
10716 || height < 0
10717 || (type != PBM_MONO && max_color_idx < 0))
10718 goto error;
10719
6fc2811b
JR		 10720 if (!x_create_x_image_and_pixmap (f, width, height, 0,
10721 &ximg, &img->pixmap))
3cf3436e
JR		 10722 goto error;
10723
6fc2811b
JR		 10724 /* Initialize the color hash table. */
10725 init_color_table ();
10726
10727 if (type == PBM_MONO)
10728 {
10729 int c = 0, g;
3cf3436e
JR		 10730 struct image_keyword fmt[PBM_LAST];
10731 unsigned long fg = FRAME_FOREGROUND_PIXEL (f);
10732 unsigned long bg = FRAME_BACKGROUND_PIXEL (f);
10733
10734 /* Parse the image specification. */
10735 bcopy (pbm_format, fmt, sizeof fmt);
10736 parse_image_spec (img->spec, fmt, PBM_LAST, Qpbm);
10737
10738 /* Get foreground and background colors, maybe allocate colors. */
10739 if (fmt[PBM_FOREGROUND].count
10740 && STRINGP (fmt[PBM_FOREGROUND].value))
10741 fg = x_alloc_image_color (f, img, fmt[PBM_FOREGROUND].value, fg);
10742 if (fmt[PBM_BACKGROUND].count
10743 && STRINGP (fmt[PBM_BACKGROUND].value))
a05e2bae
JR		 10744 {
10745 bg = x_alloc_image_color (f, img, fmt[PBM_BACKGROUND].value, bg);
10746 img->background = bg;
10747 img->background_valid = 1;
10748 }
10749
6fc2811b
JR		 10750 for (y = 0; y < height; ++y)
10751 for (x = 0; x < width; ++x)
10752 {
10753 if (raw_p)
10754 {
10755 if ((x & 7) == 0)
10756 c = *p++;
10757 g = c & 0x80;
10758 c <<= 1;
10759 }
10760 else
10761 g = pbm_scan_number (&p, end);
10762
3cf3436e 10763 XPutPixel (ximg, x, y, g ? fg : bg);
6fc2811b
JR		 10764 }
10765 }
10766 else
10767 {
10768 for (y = 0; y < height; ++y)
10769 for (x = 0; x < width; ++x)
10770 {
10771 int r, g, b;
10772
10773 if (type == PBM_GRAY)
10774 r = g = b = raw_p ? *p++ : pbm_scan_number (&p, end);
10775 else if (raw_p)
10776 {
10777 r = *p++;
10778 g = *p++;
10779 b = *p++;
10780 }
10781 else
10782 {
10783 r = pbm_scan_number (&p, end);
10784 g = pbm_scan_number (&p, end);
10785 b = pbm_scan_number (&p, end);
10786 }
10787
10788 if (r < 0 || g < 0 || b < 0)
10789 {
dfff8a69 10790 xfree (ximg->data);
6fc2811b
JR		 10791 ximg->data = NULL;
10792 XDestroyImage (ximg);
6fc2811b
JR		 10793 image_error ("Invalid pixel value in image `%s'",
10794 img->spec, Qnil);
10795 goto error;
10796 }
10797
10798 /* RGB values are now in the range 0..max_color_idx.
10799 Scale this to the range 0..0xffff supported by X. */
10800 r = (double) r * 65535 / max_color_idx;
10801 g = (double) g * 65535 / max_color_idx;
10802 b = (double) b * 65535 / max_color_idx;
10803 XPutPixel (ximg, x, y, lookup_rgb_color (f, r, g, b));
10804 }
10805 }
10806
10807 /* Store in IMG->colors the colors allocated for the image, and
10808 free the color table. */
10809 img->colors = colors_in_color_table (&img->ncolors);
10810 free_color_table ();
10811
a05e2bae
JR		 10812 /* Maybe fill in the background field while we have ximg handy. */
10813 if (NILP (image_spec_value (img->spec, QCbackground, NULL)))
10814 IMAGE_BACKGROUND (img, f, ximg);
10815
6fc2811b
JR		 10816 /* Put the image into a pixmap. */
10817 x_put_x_image (f, ximg, img->pixmap, width, height);
10818 x_destroy_x_image (ximg);
6fc2811b
JR		 10819
10820 img->width = width;
10821 img->height = height;
10822
10823 UNGCPRO;
10824 xfree (contents);
10825 return 1;
10826}
10827#endif /* HAVE_PBM */
10828
10829\f
10830/***********************************************************************
10831 PNG
10832 ***********************************************************************/
10833
10834#if HAVE_PNG
10835
10836#include <png.h>
10837
10838/* Function prototypes. */
10839
10840static int png_image_p P_ ((Lisp_Object object));
10841static int png_load P_ ((struct frame *f, struct image *img));
10842
10843/* The symbol `png' identifying images of this type. */
10844
10845Lisp_Object Qpng;
10846
10847/* Indices of image specification fields in png_format, below. */
10848
10849enum png_keyword_index
10850{
10851 PNG_TYPE,
10852 PNG_DATA,
10853 PNG_FILE,
10854 PNG_ASCENT,
10855 PNG_MARGIN,
10856 PNG_RELIEF,
10857 PNG_ALGORITHM,
10858 PNG_HEURISTIC_MASK,
a05e2bae
JR		 10859 PNG_MASK,
10860 PNG_BACKGROUND,
6fc2811b
JR		 10861 PNG_LAST
10862};
10863
10864/* Vector of image_keyword structures describing the format
10865 of valid user-defined image specifications. */
10866
10867static struct image_keyword png_format[PNG_LAST] =
10868{
10869 {":type", IMAGE_SYMBOL_VALUE, 1},
10870 {":data", IMAGE_STRING_VALUE, 0},
10871 {":file", IMAGE_STRING_VALUE, 0},
10872 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
8edb0a6f 10873 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
6fc2811b 10874 {":relief", IMAGE_INTEGER_VALUE, 0},
a93f4566 10875 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
a05e2bae
JR		 10876 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
10877 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
10878 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
6fc2811b
JR		 10879};
10880
10881/* Structure describing the image type `png'. */
10882
10883static struct image_type png_type =
10884{
10885 &Qpng,
10886 png_image_p,
10887 png_load,
10888 x_clear_image,
10889 NULL
10890};
10891
10892
10893/* Return non-zero if OBJECT is a valid PNG image specification. */
10894
10895static int
10896png_image_p (object)
10897 Lisp_Object object;
10898{
10899 struct image_keyword fmt[PNG_LAST];
10900 bcopy (png_format, fmt, sizeof fmt);
10901
10902 if (!parse_image_spec (object, fmt, PNG_LAST, Qpng)
10903 || (fmt[PNG_ASCENT].count
10904 && XFASTINT (fmt[PNG_ASCENT].value) > 100))
10905 return 0;
10906
10907 /* Must specify either the :data or :file keyword. */
10908 return fmt[PNG_FILE].count + fmt[PNG_DATA].count == 1;
10909}
10910
10911
10912/* Error and warning handlers installed when the PNG library
10913 is initialized. */
10914
10915static void
10916my_png_error (png_ptr, msg)
10917 png_struct *png_ptr;
10918 char *msg;
10919{
10920 xassert (png_ptr != NULL);
10921 image_error ("PNG error: %s", build_string (msg), Qnil);
10922 longjmp (png_ptr->jmpbuf, 1);
10923}
10924
10925
10926static void
10927my_png_warning (png_ptr, msg)
10928 png_struct *png_ptr;
10929 char *msg;
10930{
10931 xassert (png_ptr != NULL);
10932 image_error ("PNG warning: %s", build_string (msg), Qnil);
10933}
10934
6fc2811b
JR		 10935/* Memory source for PNG decoding. */
10936
10937struct png_memory_storage
10938{
10939 unsigned char *bytes; /* The data */
10940 size_t len; /* How big is it? */
10941 int index; /* Where are we? */
10942};
10943
10944
10945/* Function set as reader function when reading PNG image from memory.
10946 PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
10947 bytes from the input to DATA. */
10948
10949static void
10950png_read_from_memory (png_ptr, data, length)
10951 png_structp png_ptr;
10952 png_bytep data;
10953 png_size_t length;
10954{
10955 struct png_memory_storage *tbr
10956 = (struct png_memory_storage *) png_get_io_ptr (png_ptr);
10957
10958 if (length > tbr->len - tbr->index)
10959 png_error (png_ptr, "Read error");
10960
10961 bcopy (tbr->bytes + tbr->index, data, length);
10962 tbr->index = tbr->index + length;
10963}
10964
6fc2811b
JR		 10965/* Load PNG image IMG for use on frame F. Value is non-zero if
10966 successful. */
10967
10968static int
10969png_load (f, img)
10970 struct frame *f;
10971 struct image *img;
10972{
10973 Lisp_Object file, specified_file;
10974 Lisp_Object specified_data;
10975 int x, y, i;
10976 XImage *ximg, *mask_img = NULL;
10977 struct gcpro gcpro1;
10978 png_struct *png_ptr = NULL;
10979 png_info *info_ptr = NULL, *end_info = NULL;
a05e2bae 10980 FILE *volatile fp = NULL;
6fc2811b 10981 png_byte sig[8];
a05e2bae
JR		 10982 png_byte *volatile pixels = NULL;
10983 png_byte **volatile rows = NULL;
6fc2811b
JR		 10984 png_uint_32 width, height;
10985 int bit_depth, color_type, interlace_type;
10986 png_byte channels;
10987 png_uint_32 row_bytes;
10988 int transparent_p;
10989 char *gamma_str;
10990 double screen_gamma, image_gamma;
10991 int intent;
10992 struct png_memory_storage tbr; /* Data to be read */
10993
10994 /* Find out what file to load. */
10995 specified_file = image_spec_value (img->spec, QCfile, NULL);
10996 specified_data = image_spec_value (img->spec, QCdata, NULL);
10997 file = Qnil;
10998 GCPRO1 (file);
10999
11000 if (NILP (specified_data))
11001 {
11002 file = x_find_image_file (specified_file);
11003 if (!STRINGP (file))
11004 {
11005 image_error ("Cannot find image file `%s'", specified_file, Qnil);
11006 UNGCPRO;
11007 return 0;
11008 }
11009
11010 /* Open the image file. */
11011 fp = fopen (XSTRING (file)->data, "rb");
11012 if (!fp)
11013 {
11014 image_error ("Cannot open image file `%s'", file, Qnil);
11015 UNGCPRO;
11016 fclose (fp);
11017 return 0;
11018 }
11019
11020 /* Check PNG signature. */
11021 if (fread (sig, 1, sizeof sig, fp) != sizeof sig
11022 || !png_check_sig (sig, sizeof sig))
11023 {
11024 image_error ("Not a PNG file:` %s'", file, Qnil);
11025 UNGCPRO;
11026 fclose (fp);
11027 return 0;
11028 }
11029 }
11030 else
11031 {
11032 /* Read from memory. */
11033 tbr.bytes = XSTRING (specified_data)->data;
11034 tbr.len = STRING_BYTES (XSTRING (specified_data));
11035 tbr.index = 0;
11036
11037 /* Check PNG signature. */
11038 if (tbr.len < sizeof sig
11039 || !png_check_sig (tbr.bytes, sizeof sig))
11040 {
11041 image_error ("Not a PNG image: `%s'", img->spec, Qnil);
11042 UNGCPRO;
11043 return 0;
11044 }
11045
11046 /* Need to skip past the signature. */
11047 tbr.bytes += sizeof (sig);
11048 }
11049
6fc2811b
JR		 11050 /* Initialize read and info structs for PNG lib. */
11051 png_ptr = png_create_read_struct (PNG_LIBPNG_VER_STRING, NULL,
11052 my_png_error, my_png_warning);
11053 if (!png_ptr)
11054 {
11055 if (fp) fclose (fp);
11056 UNGCPRO;
11057 return 0;
11058 }
11059
11060 info_ptr = png_create_info_struct (png_ptr);
11061 if (!info_ptr)
11062 {
11063 png_destroy_read_struct (&png_ptr, NULL, NULL);
11064 if (fp) fclose (fp);
11065 UNGCPRO;
11066 return 0;
11067 }
11068
11069 end_info = png_create_info_struct (png_ptr);
11070 if (!end_info)
11071 {
11072 png_destroy_read_struct (&png_ptr, &info_ptr, NULL);
11073 if (fp) fclose (fp);
11074 UNGCPRO;
11075 return 0;
11076 }
11077
11078 /* Set error jump-back. We come back here when the PNG library
11079 detects an error. */
11080 if (setjmp (png_ptr->jmpbuf))
11081 {
11082 error:
11083 if (png_ptr)
11084 png_destroy_read_struct (&png_ptr, &info_ptr, &end_info);
11085 xfree (pixels);
11086 xfree (rows);
11087 if (fp) fclose (fp);
11088 UNGCPRO;
11089 return 0;
11090 }
11091
11092 /* Read image info. */
11093 if (!NILP (specified_data))
11094 png_set_read_fn (png_ptr, (void *) &tbr, png_read_from_memory);
11095 else
11096 png_init_io (png_ptr, fp);
11097
11098 png_set_sig_bytes (png_ptr, sizeof sig);
11099 png_read_info (png_ptr, info_ptr);
11100 png_get_IHDR (png_ptr, info_ptr, &width, &height, &bit_depth, &color_type,
11101 &interlace_type, NULL, NULL);
11102
11103 /* If image contains simply transparency data, we prefer to
11104 construct a clipping mask. */
11105 if (png_get_valid (png_ptr, info_ptr, PNG_INFO_tRNS))
11106 transparent_p = 1;
11107 else
11108 transparent_p = 0;
11109
11110 /* This function is easier to write if we only have to handle
11111 one data format: RGB or RGBA with 8 bits per channel. Let's
11112 transform other formats into that format. */
11113
11114 /* Strip more than 8 bits per channel. */
11115 if (bit_depth == 16)
11116 png_set_strip_16 (png_ptr);
11117
11118 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
11119 if available. */
11120 png_set_expand (png_ptr);
11121
11122 /* Convert grayscale images to RGB. */
11123 if (color_type == PNG_COLOR_TYPE_GRAY
11124 || color_type == PNG_COLOR_TYPE_GRAY_ALPHA)
11125 png_set_gray_to_rgb (png_ptr);
11126
11127 /* The value 2.2 is a guess for PC monitors from PNG example.c. */
11128 gamma_str = getenv ("SCREEN_GAMMA");
11129 screen_gamma = gamma_str ? atof (gamma_str) : 2.2;
11130
11131 /* Tell the PNG lib to handle gamma correction for us. */
11132
11133#if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
11134 if (png_get_sRGB (png_ptr, info_ptr, &intent))
11135 /* There is a special chunk in the image specifying the gamma. */
11136 png_set_sRGB (png_ptr, info_ptr, intent);
11137 else
11138#endif
11139 if (png_get_gAMA (png_ptr, info_ptr, &image_gamma))
11140 /* Image contains gamma information. */
11141 png_set_gamma (png_ptr, screen_gamma, image_gamma);
11142 else
11143 /* Use a default of 0.5 for the image gamma. */
11144 png_set_gamma (png_ptr, screen_gamma, 0.5);
11145
11146 /* Handle alpha channel by combining the image with a background
11147 color. Do this only if a real alpha channel is supplied. For
11148 simple transparency, we prefer a clipping mask. */
11149 if (!transparent_p)
11150 {
11151 png_color_16 *image_background;
a05e2bae
JR		 11152 Lisp_Object specified_bg
11153 = image_spec_value (img->spec, QCbackground, NULL);
11154
11155
11156 if (STRINGP (specified_bg))
11157 /* The user specified `:background', use that. */
11158 {
11159 COLORREF color;
11160 if (w32_defined_color (f, XSTRING (specified_bg)->data, &color, 0))
11161 {
11162 png_color_16 user_bg;
11163
11164 bzero (&user_bg, sizeof user_bg);
11165 user_bg.red = color.red;
11166 user_bg.green = color.green;
11167 user_bg.blue = color.blue;
6fc2811b 11168
a05e2bae
JR		 11169 png_set_background (png_ptr, &user_bg,
11170 PNG_BACKGROUND_GAMMA_SCREEN, 0, 1.0);
11171 }
11172 }
11173 else if (png_get_bKGD (png_ptr, info_ptr, &image_background))
6fc2811b
JR		 11174 /* Image contains a background color with which to
11175 combine the image. */
11176 png_set_background (png_ptr, image_background,
11177 PNG_BACKGROUND_GAMMA_FILE, 1, 1.0);
11178 else
11179 {
11180 /* Image does not contain a background color with which
11181 to combine the image data via an alpha channel. Use
11182 the frame's background instead. */
11183 XColor color;
11184 Colormap cmap;
11185 png_color_16 frame_background;
11186
a05e2bae 11187 cmap = FRAME_X_COLORMAP (f);
6fc2811b 11188 color.pixel = FRAME_BACKGROUND_PIXEL (f);
a05e2bae 11189 x_query_color (f, &color);
6fc2811b
JR		 11190
11191 bzero (&frame_background, sizeof frame_background);
11192 frame_background.red = color.red;
11193 frame_background.green = color.green;
11194 frame_background.blue = color.blue;
11195
11196 png_set_background (png_ptr, &frame_background,
11197 PNG_BACKGROUND_GAMMA_SCREEN, 0, 1.0);
11198 }
11199 }
11200
11201 /* Update info structure. */
11202 png_read_update_info (png_ptr, info_ptr);
11203
11204 /* Get number of channels. Valid values are 1 for grayscale images
11205 and images with a palette, 2 for grayscale images with transparency
11206 information (alpha channel), 3 for RGB images, and 4 for RGB
11207 images with alpha channel, i.e. RGBA. If conversions above were
11208 sufficient we should only have 3 or 4 channels here. */
11209 channels = png_get_channels (png_ptr, info_ptr);
11210 xassert (channels == 3 || channels == 4);
11211
11212 /* Number of bytes needed for one row of the image. */
11213 row_bytes = png_get_rowbytes (png_ptr, info_ptr);
11214
11215 /* Allocate memory for the image. */
11216 pixels = (png_byte *) xmalloc (row_bytes * height * sizeof *pixels);
11217 rows = (png_byte **) xmalloc (height * sizeof *rows);
11218 for (i = 0; i < height; ++i)
11219 rows[i] = pixels + i * row_bytes;
11220
11221 /* Read the entire image. */
11222 png_read_image (png_ptr, rows);
11223 png_read_end (png_ptr, info_ptr);
11224 if (fp)
11225 {
11226 fclose (fp);
11227 fp = NULL;
11228 }
11229
6fc2811b
JR		 11230 /* Create the X image and pixmap. */
11231 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg,
11232 &img->pixmap))
a05e2bae 11233 goto error;
6fc2811b
JR		 11234
11235 /* Create an image and pixmap serving as mask if the PNG image
11236 contains an alpha channel. */
11237 if (channels == 4
11238 && !transparent_p
11239 && !x_create_x_image_and_pixmap (f, width, height, 1,
11240 &mask_img, &img->mask))
11241 {
11242 x_destroy_x_image (ximg);
11243 XFreePixmap (FRAME_W32_DISPLAY (f), img->pixmap);
11244 img->pixmap = 0;
6fc2811b
JR		 11245 goto error;
11246 }
11247
11248 /* Fill the X image and mask from PNG data. */
11249 init_color_table ();
11250
11251 for (y = 0; y < height; ++y)
11252 {
11253 png_byte *p = rows[y];
11254
11255 for (x = 0; x < width; ++x)
11256 {
11257 unsigned r, g, b;
11258
11259 r = *p++ << 8;
11260 g = *p++ << 8;
11261 b = *p++ << 8;
11262 XPutPixel (ximg, x, y, lookup_rgb_color (f, r, g, b));
11263
11264 /* An alpha channel, aka mask channel, associates variable
11265 transparency with an image. Where other image formats
11266 support binary transparency---fully transparent or fully
11267 opaque---PNG allows up to 254 levels of partial transparency.
11268 The PNG library implements partial transparency by combining
11269 the image with a specified background color.
11270
11271 I'm not sure how to handle this here nicely: because the
11272 background on which the image is displayed may change, for
11273 real alpha channel support, it would be necessary to create
11274 a new image for each possible background.
11275
11276 What I'm doing now is that a mask is created if we have
11277 boolean transparency information. Otherwise I'm using
11278 the frame's background color to combine the image with. */
11279
11280 if (channels == 4)
11281 {
11282 if (mask_img)
11283 XPutPixel (mask_img, x, y, *p > 0);
11284 ++p;
11285 }
11286 }
11287 }
11288
a05e2bae
JR		 11289 if (NILP (image_spec_value (img->spec, QCbackground, NULL)))
11290 /* Set IMG's background color from the PNG image, unless the user
11291 overrode it. */
11292 {
11293 png_color_16 *bg;
11294 if (png_get_bKGD (png_ptr, info_ptr, &bg))
11295 {
11296 img->background = lookup_rgb_color (f, bg->red, bg->green, bg->blue);
11297 img->background_valid = 1;
11298 }
11299 }
11300
6fc2811b
JR		 11301 /* Remember colors allocated for this image. */
11302 img->colors = colors_in_color_table (&img->ncolors);
11303 free_color_table ();
11304
11305 /* Clean up. */
11306 png_destroy_read_struct (&png_ptr, &info_ptr, &end_info);
11307 xfree (rows);
11308 xfree (pixels);
11309
11310 img->width = width;
11311 img->height = height;
11312
a05e2bae
JR		 11313 /* Maybe fill in the background field while we have ximg handy. */
11314 IMAGE_BACKGROUND (img, f, ximg);
11315
6fc2811b
JR		 11316 /* Put the image into the pixmap, then free the X image and its buffer. */
11317 x_put_x_image (f, ximg, img->pixmap, width, height);
11318 x_destroy_x_image (ximg);
11319
11320 /* Same for the mask. */
11321 if (mask_img)
11322 {
a05e2bae
JR		 11323 /* Fill in the background_transparent field while we have the mask
11324 handy. */
11325 image_background_transparent (img, f, mask_img);
11326
6fc2811b
JR		 11327 x_put_x_image (f, mask_img, img->mask, img->width, img->height);
11328 x_destroy_x_image (mask_img);
11329 }
11330
6fc2811b
JR		 11331 UNGCPRO;
11332 return 1;
11333}
11334
11335#endif /* HAVE_PNG != 0 */
11336
11337
11338\f
11339/***********************************************************************
11340 JPEG
11341 ***********************************************************************/
11342
11343#if HAVE_JPEG
11344
11345/* Work around a warning about HAVE_STDLIB_H being redefined in
11346 jconfig.h. */
11347#ifdef HAVE_STDLIB_H
11348#define HAVE_STDLIB_H_1
11349#undef HAVE_STDLIB_H
11350#endif /* HAVE_STLIB_H */
11351
11352#include <jpeglib.h>
11353#include <jerror.h>
11354#include <setjmp.h>
11355
11356#ifdef HAVE_STLIB_H_1
11357#define HAVE_STDLIB_H 1
11358#endif
11359
11360static int jpeg_image_p P_ ((Lisp_Object object));
11361static int jpeg_load P_ ((struct frame *f, struct image *img));
11362
11363/* The symbol `jpeg' identifying images of this type. */
11364
11365Lisp_Object Qjpeg;
11366
11367/* Indices of image specification fields in gs_format, below. */
11368
11369enum jpeg_keyword_index
11370{
11371 JPEG_TYPE,
11372 JPEG_DATA,
11373 JPEG_FILE,
11374 JPEG_ASCENT,
11375 JPEG_MARGIN,
11376 JPEG_RELIEF,
11377 JPEG_ALGORITHM,
11378 JPEG_HEURISTIC_MASK,
a05e2bae
JR		 11379 JPEG_MASK,
11380 JPEG_BACKGROUND,
6fc2811b
JR		 11381 JPEG_LAST
11382};
11383
11384/* Vector of image_keyword structures describing the format
11385 of valid user-defined image specifications. */
11386
11387static struct image_keyword jpeg_format[JPEG_LAST] =
11388{
11389 {":type", IMAGE_SYMBOL_VALUE, 1},
11390 {":data", IMAGE_STRING_VALUE, 0},
11391 {":file", IMAGE_STRING_VALUE, 0},
11392 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
8edb0a6f 11393 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
6fc2811b 11394 {":relief", IMAGE_INTEGER_VALUE, 0},
a05e2bae
JR		 11395 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
11396 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
11397 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
11398 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
6fc2811b
JR		 11399};
11400
11401/* Structure describing the image type `jpeg'. */
11402
11403static struct image_type jpeg_type =
11404{
11405 &Qjpeg,
11406 jpeg_image_p,
11407 jpeg_load,
11408 x_clear_image,
11409 NULL
11410};
11411
11412
11413/* Return non-zero if OBJECT is a valid JPEG image specification. */
11414
11415static int
11416jpeg_image_p (object)
11417 Lisp_Object object;
11418{
11419 struct image_keyword fmt[JPEG_LAST];
11420
11421 bcopy (jpeg_format, fmt, sizeof fmt);
11422
11423 if (!parse_image_spec (object, fmt, JPEG_LAST, Qjpeg)
11424 || (fmt[JPEG_ASCENT].count
11425 && XFASTINT (fmt[JPEG_ASCENT].value) > 100))
11426 return 0;
11427
11428 /* Must specify either the :data or :file keyword. */
11429 return fmt[JPEG_FILE].count + fmt[JPEG_DATA].count == 1;
11430}
11431
11432
11433struct my_jpeg_error_mgr
11434{
11435 struct jpeg_error_mgr pub;
11436 jmp_buf setjmp_buffer;
11437};
11438
11439static void
11440my_error_exit (cinfo)
11441 j_common_ptr cinfo;
11442{
11443 struct my_jpeg_error_mgr *mgr = (struct my_jpeg_error_mgr *) cinfo->err;
11444 longjmp (mgr->setjmp_buffer, 1);
11445}
11446
6fc2811b
JR		 11447/* Init source method for JPEG data source manager. Called by
11448 jpeg_read_header() before any data is actually read. See
11449 libjpeg.doc from the JPEG lib distribution. */
11450
11451static void
11452our_init_source (cinfo)
11453 j_decompress_ptr cinfo;
11454{
11455}
11456
11457
11458/* Fill input buffer method for JPEG data source manager. Called
11459 whenever more data is needed. We read the whole image in one step,
11460 so this only adds a fake end of input marker at the end. */
11461
11462static boolean
11463our_fill_input_buffer (cinfo)
11464 j_decompress_ptr cinfo;
11465{
11466 /* Insert a fake EOI marker. */
11467 struct jpeg_source_mgr *src = cinfo->src;
11468 static JOCTET buffer[2];
11469
11470 buffer[0] = (JOCTET) 0xFF;
11471 buffer[1] = (JOCTET) JPEG_EOI;
11472
11473 src->next_input_byte = buffer;
11474 src->bytes_in_buffer = 2;
11475 return TRUE;
11476}
11477
11478
11479/* Method to skip over NUM_BYTES bytes in the image data. CINFO->src
11480 is the JPEG data source manager. */
11481
11482static void
11483our_skip_input_data (cinfo, num_bytes)
11484 j_decompress_ptr cinfo;
11485 long num_bytes;
11486{
11487 struct jpeg_source_mgr *src = (struct jpeg_source_mgr *) cinfo->src;
11488
11489 if (src)
11490 {
11491 if (num_bytes > src->bytes_in_buffer)
11492 ERREXIT (cinfo, JERR_INPUT_EOF);
11493
11494 src->bytes_in_buffer -= num_bytes;
11495 src->next_input_byte += num_bytes;
11496 }
11497}
11498
11499
11500/* Method to terminate data source. Called by
11501 jpeg_finish_decompress() after all data has been processed. */
11502
11503static void
11504our_term_source (cinfo)
11505 j_decompress_ptr cinfo;
11506{
11507}
11508
11509
11510/* Set up the JPEG lib for reading an image from DATA which contains
11511 LEN bytes. CINFO is the decompression info structure created for
11512 reading the image. */
11513
11514static void
11515jpeg_memory_src (cinfo, data, len)
11516 j_decompress_ptr cinfo;
11517 JOCTET *data;
11518 unsigned int len;
11519{
11520 struct jpeg_source_mgr *src;
11521
11522 if (cinfo->src == NULL)
11523 {
11524 /* First time for this JPEG object? */
11525 cinfo->src = (struct jpeg_source_mgr *)
11526 (*cinfo->mem->alloc_small) ((j_common_ptr) cinfo, JPOOL_PERMANENT,
11527 sizeof (struct jpeg_source_mgr));
11528 src = (struct jpeg_source_mgr *) cinfo->src;
11529 src->next_input_byte = data;
11530 }
11531
11532 src = (struct jpeg_source_mgr *) cinfo->src;
11533 src->init_source = our_init_source;
11534 src->fill_input_buffer = our_fill_input_buffer;
11535 src->skip_input_data = our_skip_input_data;
11536 src->resync_to_restart = jpeg_resync_to_restart; /* Use default method. */
11537 src->term_source = our_term_source;
11538 src->bytes_in_buffer = len;
11539 src->next_input_byte = data;
11540}
11541
11542
11543/* Load image IMG for use on frame F. Patterned after example.c
11544 from the JPEG lib. */
11545
11546static int
11547jpeg_load (f, img)
11548 struct frame *f;
11549 struct image *img;
11550{
11551 struct jpeg_decompress_struct cinfo;
11552 struct my_jpeg_error_mgr mgr;
11553 Lisp_Object file, specified_file;
11554 Lisp_Object specified_data;
a05e2bae 11555 FILE * volatile fp = NULL;
6fc2811b
JR		 11556 JSAMPARRAY buffer;
11557 int row_stride, x, y;
11558 XImage *ximg = NULL;
11559 int rc;
11560 unsigned long *colors;
11561 int width, height;
11562 struct gcpro gcpro1;
11563
11564 /* Open the JPEG file. */
11565 specified_file = image_spec_value (img->spec, QCfile, NULL);
11566 specified_data = image_spec_value (img->spec, QCdata, NULL);
11567 file = Qnil;
11568 GCPRO1 (file);
11569
6fc2811b
JR		 11570 if (NILP (specified_data))
11571 {
11572 file = x_find_image_file (specified_file);
11573 if (!STRINGP (file))
11574 {
11575 image_error ("Cannot find image file `%s'", specified_file, Qnil);
11576 UNGCPRO;
11577 return 0;
11578 }
11579
11580 fp = fopen (XSTRING (file)->data, "r");
11581 if (fp == NULL)
11582 {
11583 image_error ("Cannot open `%s'", file, Qnil);
11584 UNGCPRO;
11585 return 0;
11586 }
11587 }
11588
11589 /* Customize libjpeg's error handling to call my_error_exit when an
11590 error is detected. This function will perform a longjmp. */
6fc2811b 11591 cinfo.err = jpeg_std_error (&mgr.pub);
a05e2bae 11592 mgr.pub.error_exit = my_error_exit;
6fc2811b
JR		 11593
11594 if ((rc = setjmp (mgr.setjmp_buffer)) != 0)
11595 {
11596 if (rc == 1)
11597 {
11598 /* Called from my_error_exit. Display a JPEG error. */
11599 char buffer[JMSG_LENGTH_MAX];
11600 cinfo.err->format_message ((j_common_ptr) &cinfo, buffer);
11601 image_error ("Error reading JPEG image `%s': %s", img->spec,
11602 build_string (buffer));
11603 }
11604
11605 /* Close the input file and destroy the JPEG object. */
11606 if (fp)
11607 fclose (fp);
11608 jpeg_destroy_decompress (&cinfo);
6fc2811b
JR		 11609
11610 /* If we already have an XImage, free that. */
11611 x_destroy_x_image (ximg);
11612
11613 /* Free pixmap and colors. */
11614 x_clear_image (f, img);
11615
6fc2811b
JR		 11616 UNGCPRO;
11617 return 0;
11618 }
11619
11620 /* Create the JPEG decompression object. Let it read from fp.
11621 Read the JPEG image header. */
11622 jpeg_create_decompress (&cinfo);
11623
11624 if (NILP (specified_data))
11625 jpeg_stdio_src (&cinfo, fp);
11626 else
11627 jpeg_memory_src (&cinfo, XSTRING (specified_data)->data,
11628 STRING_BYTES (XSTRING (specified_data)));
11629
11630 jpeg_read_header (&cinfo, TRUE);
11631
11632 /* Customize decompression so that color quantization will be used.
11633 Start decompression. */
11634 cinfo.quantize_colors = TRUE;
11635 jpeg_start_decompress (&cinfo);
11636 width = img->width = cinfo.output_width;
11637 height = img->height = cinfo.output_height;
11638
6fc2811b
JR		 11639 /* Create X image and pixmap. */
11640 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg,
11641 &img->pixmap))
a05e2bae 11642 longjmp (mgr.setjmp_buffer, 2);
6fc2811b
JR		 11643
11644 /* Allocate colors. When color quantization is used,
11645 cinfo.actual_number_of_colors has been set with the number of
11646 colors generated, and cinfo.colormap is a two-dimensional array
11647 of color indices in the range 0..cinfo.actual_number_of_colors.
11648 No more than 255 colors will be generated. */
11649 {
11650 int i, ir, ig, ib;
11651
11652 if (cinfo.out_color_components > 2)
11653 ir = 0, ig = 1, ib = 2;
11654 else if (cinfo.out_color_components > 1)
11655 ir = 0, ig = 1, ib = 0;
11656 else
11657 ir = 0, ig = 0, ib = 0;
11658
11659 /* Use the color table mechanism because it handles colors that
11660 cannot be allocated nicely. Such colors will be replaced with
11661 a default color, and we don't have to care about which colors
11662 can be freed safely, and which can't. */
11663 init_color_table ();
11664 colors = (unsigned long *) alloca (cinfo.actual_number_of_colors
11665 * sizeof *colors);
11666
11667 for (i = 0; i < cinfo.actual_number_of_colors; ++i)
11668 {
11669 /* Multiply RGB values with 255 because X expects RGB values
11670 in the range 0..0xffff. */
11671 int r = cinfo.colormap[ir][i] << 8;
11672 int g = cinfo.colormap[ig][i] << 8;
11673 int b = cinfo.colormap[ib][i] << 8;
11674 colors[i] = lookup_rgb_color (f, r, g, b);
11675 }
11676
11677 /* Remember those colors actually allocated. */
11678 img->colors = colors_in_color_table (&img->ncolors);
11679 free_color_table ();
11680 }
11681
11682 /* Read pixels. */
11683 row_stride = width * cinfo.output_components;
11684 buffer = cinfo.mem->alloc_sarray ((j_common_ptr) &cinfo, JPOOL_IMAGE,
11685 row_stride, 1);
11686 for (y = 0; y < height; ++y)
11687 {
11688 jpeg_read_scanlines (&cinfo, buffer, 1);
11689 for (x = 0; x < cinfo.output_width; ++x)
11690 XPutPixel (ximg, x, y, colors[buffer[0][x]]);
11691 }
11692
11693 /* Clean up. */
11694 jpeg_finish_decompress (&cinfo);
11695 jpeg_destroy_decompress (&cinfo);
11696 if (fp)
11697 fclose (fp);
11698
a05e2bae
JR		 11699 /* Maybe fill in the background field while we have ximg handy. */
11700 if (NILP (image_spec_value (img->spec, QCbackground, NULL)))
11701 IMAGE_BACKGROUND (img, f, ximg);
11702
6fc2811b
JR		 11703 /* Put the image into the pixmap. */
11704 x_put_x_image (f, ximg, img->pixmap, width, height);
11705 x_destroy_x_image (ximg);
11706 UNBLOCK_INPUT;
11707 UNGCPRO;
11708 return 1;
11709}
11710
11711#endif /* HAVE_JPEG */
11712
11713
11714\f
11715/***********************************************************************
11716 TIFF
11717 ***********************************************************************/
11718
11719#if HAVE_TIFF
11720
11721#include <tiffio.h>
11722
11723static int tiff_image_p P_ ((Lisp_Object object));
11724static int tiff_load P_ ((struct frame *f, struct image *img));
11725
11726/* The symbol `tiff' identifying images of this type. */
11727
11728Lisp_Object Qtiff;
11729
11730/* Indices of image specification fields in tiff_format, below. */
11731
11732enum tiff_keyword_index
11733{
11734 TIFF_TYPE,
11735 TIFF_DATA,
11736 TIFF_FILE,
11737 TIFF_ASCENT,
11738 TIFF_MARGIN,
11739 TIFF_RELIEF,
11740 TIFF_ALGORITHM,
11741 TIFF_HEURISTIC_MASK,
a05e2bae
JR		 11742 TIFF_MASK,
11743 TIFF_BACKGROUND,
6fc2811b
JR		 11744 TIFF_LAST
11745};
11746
11747/* Vector of image_keyword structures describing the format
11748 of valid user-defined image specifications. */
11749
11750static struct image_keyword tiff_format[TIFF_LAST] =
11751{
11752 {":type", IMAGE_SYMBOL_VALUE, 1},
11753 {":data", IMAGE_STRING_VALUE, 0},
11754 {":file", IMAGE_STRING_VALUE, 0},
11755 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
8edb0a6f 11756 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
6fc2811b 11757 {":relief", IMAGE_INTEGER_VALUE, 0},
a05e2bae
JR		 11758 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
11759 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
11760 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
11761 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
6fc2811b
JR		 11762};
11763
11764/* Structure describing the image type `tiff'. */
11765
11766static struct image_type tiff_type =
11767{
11768 &Qtiff,
11769 tiff_image_p,
11770 tiff_load,
11771 x_clear_image,
11772 NULL
11773};
11774
11775
11776/* Return non-zero if OBJECT is a valid TIFF image specification. */
11777
11778static int
11779tiff_image_p (object)
11780 Lisp_Object object;
11781{
11782 struct image_keyword fmt[TIFF_LAST];
11783 bcopy (tiff_format, fmt, sizeof fmt);
11784
11785 if (!parse_image_spec (object, fmt, TIFF_LAST, Qtiff)
11786 || (fmt[TIFF_ASCENT].count
11787 && XFASTINT (fmt[TIFF_ASCENT].value) > 100))
11788 return 0;
11789
11790 /* Must specify either the :data or :file keyword. */
11791 return fmt[TIFF_FILE].count + fmt[TIFF_DATA].count == 1;
11792}
11793
11794
11795/* Reading from a memory buffer for TIFF images Based on the PNG
11796 memory source, but we have to provide a lot of extra functions.
11797 Blah.
11798
11799 We really only need to implement read and seek, but I am not
11800 convinced that the TIFF library is smart enough not to destroy
11801 itself if we only hand it the function pointers we need to
11802 override. */
11803
11804typedef struct
11805{
11806 unsigned char *bytes;
11807 size_t len;
11808 int index;
11809}
11810tiff_memory_source;
11811
11812static size_t
11813tiff_read_from_memory (data, buf, size)
11814 thandle_t data;
11815 tdata_t buf;
11816 tsize_t size;
11817{
11818 tiff_memory_source *src = (tiff_memory_source *) data;
11819
11820 if (size > src->len - src->index)
11821 return (size_t) -1;
11822 bcopy (src->bytes + src->index, buf, size);
11823 src->index += size;
11824 return size;
11825}
11826
11827static size_t
11828tiff_write_from_memory (data, buf, size)
11829 thandle_t data;
11830 tdata_t buf;
11831 tsize_t size;
11832{
11833 return (size_t) -1;
11834}
11835
11836static toff_t
11837tiff_seek_in_memory (data, off, whence)
11838 thandle_t data;
11839 toff_t off;
11840 int whence;
11841{
11842 tiff_memory_source *src = (tiff_memory_source *) data;
11843 int idx;
11844
11845 switch (whence)
11846 {
11847 case SEEK_SET: /* Go from beginning of source. */
11848 idx = off;
11849 break;
11850
11851 case SEEK_END: /* Go from end of source. */
11852 idx = src->len + off;
11853 break;
11854
11855 case SEEK_CUR: /* Go from current position. */
11856 idx = src->index + off;
11857 break;
11858
11859 default: /* Invalid `whence'. */
11860 return -1;
11861 }
11862
11863 if (idx > src->len || idx < 0)
11864 return -1;
11865
11866 src->index = idx;
11867 return src->index;
11868}
11869
11870static int
11871tiff_close_memory (data)
11872 thandle_t data;
11873{
11874 /* NOOP */
11875 return 0;
11876}
11877
11878static int
11879tiff_mmap_memory (data, pbase, psize)
11880 thandle_t data;
11881 tdata_t *pbase;
11882 toff_t *psize;
11883{
11884 /* It is already _IN_ memory. */
11885 return 0;
11886}
11887
11888static void
11889tiff_unmap_memory (data, base, size)
11890 thandle_t data;
11891 tdata_t base;
11892 toff_t size;
11893{
11894 /* We don't need to do this. */
11895}
11896
11897static toff_t
11898tiff_size_of_memory (data)
11899 thandle_t data;
11900{
11901 return ((tiff_memory_source *) data)->len;
11902}
11903
3cf3436e
JR		 11904
11905static void
11906tiff_error_handler (title, format, ap)
11907 const char *title, *format;
11908 va_list ap;
11909{
11910 char buf[512];
11911 int len;
11912
11913 len = sprintf (buf, "TIFF error: %s ", title);
11914 vsprintf (buf + len, format, ap);
11915 add_to_log (buf, Qnil, Qnil);
11916}
11917
11918
11919static void
11920tiff_warning_handler (title, format, ap)
11921 const char *title, *format;
11922 va_list ap;
11923{
11924 char buf[512];
11925 int len;
11926
11927 len = sprintf (buf, "TIFF warning: %s ", title);
11928 vsprintf (buf + len, format, ap);
11929 add_to_log (buf, Qnil, Qnil);
11930}
11931
11932
6fc2811b
JR		 11933/* Load TIFF image IMG for use on frame F. Value is non-zero if
11934 successful. */
11935
11936static int
11937tiff_load (f, img)
11938 struct frame *f;
11939 struct image *img;
11940{
11941 Lisp_Object file, specified_file;
11942 Lisp_Object specified_data;
11943 TIFF *tiff;
11944 int width, height, x, y;
11945 uint32 *buf;
11946 int rc;
11947 XImage *ximg;
11948 struct gcpro gcpro1;
11949 tiff_memory_source memsrc;
11950
11951 specified_file = image_spec_value (img->spec, QCfile, NULL);
11952 specified_data = image_spec_value (img->spec, QCdata, NULL);
11953 file = Qnil;
11954 GCPRO1 (file);
11955
3cf3436e
JR		 11956 TIFFSetErrorHandler (tiff_error_handler);
11957 TIFFSetWarningHandler (tiff_warning_handler);
11958
6fc2811b
JR		 11959 if (NILP (specified_data))
11960 {
11961 /* Read from a file */
11962 file = x_find_image_file (specified_file);
11963 if (!STRINGP (file))
3cf3436e
JR		 11964 {
11965 image_error ("Cannot find image file `%s'", file, Qnil);
11966 UNGCPRO;
11967 return 0;
11968 }
11969
6fc2811b
JR		 11970 /* Try to open the image file. */
11971 tiff = TIFFOpen (XSTRING (file)->data, "r");
11972 if (tiff == NULL)
3cf3436e
JR		 11973 {
11974 image_error ("Cannot open `%s'", file, Qnil);
11975 UNGCPRO;
11976 return 0;
11977 }
6fc2811b
JR		 11978 }
11979 else
11980 {
11981 /* Memory source! */
11982 memsrc.bytes = XSTRING (specified_data)->data;
11983 memsrc.len = STRING_BYTES (XSTRING (specified_data));
11984 memsrc.index = 0;
11985
11986 tiff = TIFFClientOpen ("memory_source", "r", &memsrc,
11987 (TIFFReadWriteProc) tiff_read_from_memory,
11988 (TIFFReadWriteProc) tiff_write_from_memory,
11989 tiff_seek_in_memory,
11990 tiff_close_memory,
11991 tiff_size_of_memory,
11992 tiff_mmap_memory,
11993 tiff_unmap_memory);
11994
11995 if (!tiff)
11996 {
11997 image_error ("Cannot open memory source for `%s'", img->spec, Qnil);
11998 UNGCPRO;
11999 return 0;
12000 }
12001 }
12002
12003 /* Get width and height of the image, and allocate a raster buffer
12004 of width x height 32-bit values. */
12005 TIFFGetField (tiff, TIFFTAG_IMAGEWIDTH, &width);
12006 TIFFGetField (tiff, TIFFTAG_IMAGELENGTH, &height);
12007 buf = (uint32 *) xmalloc (width * height * sizeof *buf);
12008
12009 rc = TIFFReadRGBAImage (tiff, width, height, buf, 0);
12010 TIFFClose (tiff);
12011 if (!rc)
12012 {
12013 image_error ("Error reading TIFF image `%s'", img->spec, Qnil);
12014 xfree (buf);
12015 UNGCPRO;
12016 return 0;
12017 }
12018
6fc2811b
JR		 12019 /* Create the X image and pixmap. */
12020 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg, &img->pixmap))
12021 {
6fc2811b
JR		 12022 xfree (buf);
12023 UNGCPRO;
12024 return 0;
12025 }
12026
12027 /* Initialize the color table. */
12028 init_color_table ();
12029
12030 /* Process the pixel raster. Origin is in the lower-left corner. */
12031 for (y = 0; y < height; ++y)
12032 {
12033 uint32 *row = buf + y * width;
12034
12035 for (x = 0; x < width; ++x)
12036 {
12037 uint32 abgr = row[x];
12038 int r = TIFFGetR (abgr) << 8;
12039 int g = TIFFGetG (abgr) << 8;
12040 int b = TIFFGetB (abgr) << 8;
12041 XPutPixel (ximg, x, height - 1 - y, lookup_rgb_color (f, r, g, b));
12042 }
12043 }
12044
12045 /* Remember the colors allocated for the image. Free the color table. */
12046 img->colors = colors_in_color_table (&img->ncolors);
12047 free_color_table ();
12048
a05e2bae
JR		 12049 img->width = width;
12050 img->height = height;
12051
12052 /* Maybe fill in the background field while we have ximg handy. */
12053 if (NILP (image_spec_value (img->spec, QCbackground, NULL)))
12054 IMAGE_BACKGROUND (img, f, ximg);
12055
6fc2811b
JR		 12056 /* Put the image into the pixmap, then free the X image and its buffer. */
12057 x_put_x_image (f, ximg, img->pixmap, width, height);
12058 x_destroy_x_image (ximg);
12059 xfree (buf);
6fc2811b
JR		 12060
12061 UNGCPRO;
12062 return 1;
12063}
12064
12065#endif /* HAVE_TIFF != 0 */
12066
12067
12068\f
12069/***********************************************************************
12070 GIF
12071 ***********************************************************************/
12072
12073#if HAVE_GIF
12074
12075#include <gif_lib.h>
12076
12077static int gif_image_p P_ ((Lisp_Object object));
12078static int gif_load P_ ((struct frame *f, struct image *img));
12079
12080/* The symbol `gif' identifying images of this type. */
12081
12082Lisp_Object Qgif;
12083
12084/* Indices of image specification fields in gif_format, below. */
12085
12086enum gif_keyword_index
12087{
12088 GIF_TYPE,
12089 GIF_DATA,
12090 GIF_FILE,
12091 GIF_ASCENT,
12092 GIF_MARGIN,
12093 GIF_RELIEF,
12094 GIF_ALGORITHM,
12095 GIF_HEURISTIC_MASK,
a05e2bae 12096 GIF_MASK,
6fc2811b 12097 GIF_IMAGE,
a05e2bae 12098 GIF_BACKGROUND,
6fc2811b
JR		 12099 GIF_LAST
12100};
12101
12102/* Vector of image_keyword structures describing the format
12103 of valid user-defined image specifications. */
12104
12105static struct image_keyword gif_format[GIF_LAST] =
12106{
12107 {":type", IMAGE_SYMBOL_VALUE, 1},
12108 {":data", IMAGE_STRING_VALUE, 0},
12109 {":file", IMAGE_STRING_VALUE, 0},
12110 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
8edb0a6f 12111 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
6fc2811b 12112 {":relief", IMAGE_INTEGER_VALUE, 0},
a93f4566 12113 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6fc2811b 12114 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
a05e2bae
JR		 12115 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
12116 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
12117 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
6fc2811b
JR		 12118};
12119
12120/* Structure describing the image type `gif'. */
12121
12122static struct image_type gif_type =
12123{
12124 &Qgif,
12125 gif_image_p,
12126 gif_load,
12127 x_clear_image,
12128 NULL
12129};
12130
12131/* Return non-zero if OBJECT is a valid GIF image specification. */
12132
12133static int
12134gif_image_p (object)
12135 Lisp_Object object;
12136{
12137 struct image_keyword fmt[GIF_LAST];
12138 bcopy (gif_format, fmt, sizeof fmt);
12139
12140 if (!parse_image_spec (object, fmt, GIF_LAST, Qgif)
12141 || (fmt[GIF_ASCENT].count
12142 && XFASTINT (fmt[GIF_ASCENT].value) > 100))
12143 return 0;
12144
12145 /* Must specify either the :data or :file keyword. */
12146 return fmt[GIF_FILE].count + fmt[GIF_DATA].count == 1;
12147}
12148
12149/* Reading a GIF image from memory
12150 Based on the PNG memory stuff to a certain extent. */
12151
12152typedef struct
12153{
12154 unsigned char *bytes;
12155 size_t len;
12156 int index;
12157}
12158gif_memory_source;
12159
12160/* Make the current memory source available to gif_read_from_memory.
12161 It's done this way because not all versions of libungif support
12162 a UserData field in the GifFileType structure. */
12163static gif_memory_source *current_gif_memory_src;
12164
12165static int
12166gif_read_from_memory (file, buf, len)
12167 GifFileType *file;
12168 GifByteType *buf;
12169 int len;
12170{
12171 gif_memory_source *src = current_gif_memory_src;
12172
12173 if (len > src->len - src->index)
12174 return -1;
12175
12176 bcopy (src->bytes + src->index, buf, len);
12177 src->index += len;
12178 return len;
12179}
12180
12181
12182/* Load GIF image IMG for use on frame F. Value is non-zero if
12183 successful. */
12184
12185static int
12186gif_load (f, img)
12187 struct frame *f;
12188 struct image *img;
12189{
12190 Lisp_Object file, specified_file;
12191 Lisp_Object specified_data;
12192 int rc, width, height, x, y, i;
12193 XImage *ximg;
12194 ColorMapObject *gif_color_map;
12195 unsigned long pixel_colors[256];
12196 GifFileType *gif;
12197 struct gcpro gcpro1;
12198 Lisp_Object image;
12199 int ino, image_left, image_top, image_width, image_height;
12200 gif_memory_source memsrc;
12201 unsigned char *raster;
12202
12203 specified_file = image_spec_value (img->spec, QCfile, NULL);
12204 specified_data = image_spec_value (img->spec, QCdata, NULL);
12205 file = Qnil;
dfff8a69 12206 GCPRO1 (file);
6fc2811b
JR		 12207
12208 if (NILP (specified_data))
12209 {
12210 file = x_find_image_file (specified_file);
6fc2811b
JR		 12211 if (!STRINGP (file))
12212 {
12213 image_error ("Cannot find image file `%s'", specified_file, Qnil);
12214 UNGCPRO;
12215 return 0;
12216 }
12217
12218 /* Open the GIF file. */
12219 gif = DGifOpenFileName (XSTRING (file)->data);
12220 if (gif == NULL)
12221 {
12222 image_error ("Cannot open `%s'", file, Qnil);
12223 UNGCPRO;
12224 return 0;
12225 }
12226 }
12227 else
12228 {
12229 /* Read from memory! */
12230 current_gif_memory_src = &memsrc;
12231 memsrc.bytes = XSTRING (specified_data)->data;
12232 memsrc.len = STRING_BYTES (XSTRING (specified_data));
12233 memsrc.index = 0;
12234
12235 gif = DGifOpen(&memsrc, gif_read_from_memory);
12236 if (!gif)
12237 {
12238 image_error ("Cannot open memory source `%s'", img->spec, Qnil);
12239 UNGCPRO;
12240 return 0;
12241 }
12242 }
12243
12244 /* Read entire contents. */
12245 rc = DGifSlurp (gif);
12246 if (rc == GIF_ERROR)
12247 {
12248 image_error ("Error reading `%s'", img->spec, Qnil);
12249 DGifCloseFile (gif);
12250 UNGCPRO;
12251 return 0;
12252 }
12253
12254 image = image_spec_value (img->spec, QCindex, NULL);
12255 ino = INTEGERP (image) ? XFASTINT (image) : 0;
12256 if (ino >= gif->ImageCount)
12257 {
12258 image_error ("Invalid image number `%s' in image `%s'",
12259 image, img->spec);
12260 DGifCloseFile (gif);
12261 UNGCPRO;
12262 return 0;
12263 }
12264
12265 width = img->width = gif->SWidth;
12266 height = img->height = gif->SHeight;
12267
6fc2811b
JR		 12268 /* Create the X image and pixmap. */
12269 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg, &img->pixmap))
12270 {
6fc2811b
JR		 12271 DGifCloseFile (gif);
12272 UNGCPRO;
12273 return 0;
12274 }
12275
12276 /* Allocate colors. */
12277 gif_color_map = gif->SavedImages[ino].ImageDesc.ColorMap;
12278 if (!gif_color_map)
12279 gif_color_map = gif->SColorMap;
12280 init_color_table ();
12281 bzero (pixel_colors, sizeof pixel_colors);
12282
12283 for (i = 0; i < gif_color_map->ColorCount; ++i)
12284 {
12285 int r = gif_color_map->Colors[i].Red << 8;
12286 int g = gif_color_map->Colors[i].Green << 8;
12287 int b = gif_color_map->Colors[i].Blue << 8;
12288 pixel_colors[i] = lookup_rgb_color (f, r, g, b);
12289 }
12290
12291 img->colors = colors_in_color_table (&img->ncolors);
12292 free_color_table ();
12293
12294 /* Clear the part of the screen image that are not covered by
12295 the image from the GIF file. Full animated GIF support
12296 requires more than can be done here (see the gif89 spec,
12297 disposal methods). Let's simply assume that the part
12298 not covered by a sub-image is in the frame's background color. */
12299 image_top = gif->SavedImages[ino].ImageDesc.Top;
12300 image_left = gif->SavedImages[ino].ImageDesc.Left;
12301 image_width = gif->SavedImages[ino].ImageDesc.Width;
12302 image_height = gif->SavedImages[ino].ImageDesc.Height;
12303
12304 for (y = 0; y < image_top; ++y)
12305 for (x = 0; x < width; ++x)
12306 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
12307
12308 for (y = image_top + image_height; y < height; ++y)
12309 for (x = 0; x < width; ++x)
12310 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
12311
12312 for (y = image_top; y < image_top + image_height; ++y)
12313 {
12314 for (x = 0; x < image_left; ++x)
12315 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
12316 for (x = image_left + image_width; x < width; ++x)
12317 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
12318 }
12319
12320 /* Read the GIF image into the X image. We use a local variable
12321 `raster' here because RasterBits below is a char *, and invites
12322 problems with bytes >= 0x80. */
12323 raster = (unsigned char *) gif->SavedImages[ino].RasterBits;
12324
12325 if (gif->SavedImages[ino].ImageDesc.Interlace)
12326 {
12327 static int interlace_start[] = {0, 4, 2, 1};
12328 static int interlace_increment[] = {8, 8, 4, 2};
a05e2bae 12329 int pass;
6fc2811b
JR		 12330 int row = interlace_start[0];
12331
12332 pass = 0;
12333
12334 for (y = 0; y < image_height; y++)
12335 {
12336 if (row >= image_height)
12337 {
12338 row = interlace_start[++pass];
12339 while (row >= image_height)
12340 row = interlace_start[++pass];
12341 }
12342
12343 for (x = 0; x < image_width; x++)
12344 {
12345 int i = raster[(y * image_width) + x];
12346 XPutPixel (ximg, x + image_left, row + image_top,
12347 pixel_colors[i]);
12348 }
12349
12350 row += interlace_increment[pass];
12351 }
12352 }
12353 else
12354 {
12355 for (y = 0; y < image_height; ++y)
12356 for (x = 0; x < image_width; ++x)
12357 {
12358 int i = raster[y* image_width + x];
12359 XPutPixel (ximg, x + image_left, y + image_top, pixel_colors[i]);
12360 }
12361 }
12362
12363 DGifCloseFile (gif);
a05e2bae
JR		 12364
12365 /* Maybe fill in the background field while we have ximg handy. */
12366 if (NILP (image_spec_value (img->spec, QCbackground, NULL)))
12367 IMAGE_BACKGROUND (img, f, ximg);
12368
6fc2811b
JR		 12369 /* Put the image into the pixmap, then free the X image and its buffer. */
12370 x_put_x_image (f, ximg, img->pixmap, width, height);
12371 x_destroy_x_image (ximg);
6fc2811b
JR		 12372
12373 UNGCPRO;
12374 return 1;
12375}
12376
12377#endif /* HAVE_GIF != 0 */
12378
12379
12380\f
12381/***********************************************************************
12382 Ghostscript
12383 ***********************************************************************/
12384
3cf3436e
JR		 12385Lisp_Object Qpostscript;
12386
6fc2811b
JR		 12387#ifdef HAVE_GHOSTSCRIPT
12388static int gs_image_p P_ ((Lisp_Object object));
12389static int gs_load P_ ((struct frame *f, struct image *img));
12390static void gs_clear_image P_ ((struct frame *f, struct image *img));
12391
12392/* The symbol `postscript' identifying images of this type. */
12393
6fc2811b
JR		 12394/* Keyword symbols. */
12395
12396Lisp_Object QCloader, QCbounding_box, QCpt_width, QCpt_height;
12397
12398/* Indices of image specification fields in gs_format, below. */
12399
12400enum gs_keyword_index
12401{
12402 GS_TYPE,
12403 GS_PT_WIDTH,
12404 GS_PT_HEIGHT,
12405 GS_FILE,
12406 GS_LOADER,
12407 GS_BOUNDING_BOX,
12408 GS_ASCENT,
12409 GS_MARGIN,
12410 GS_RELIEF,
12411 GS_ALGORITHM,
12412 GS_HEURISTIC_MASK,
a05e2bae
JR		 12413 GS_MASK,
12414 GS_BACKGROUND,
6fc2811b
JR		 12415 GS_LAST
12416};
12417
12418/* Vector of image_keyword structures describing the format
12419 of valid user-defined image specifications. */
12420
12421static struct image_keyword gs_format[GS_LAST] =
12422{
12423 {":type", IMAGE_SYMBOL_VALUE, 1},
12424 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE, 1},
12425 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE, 1},
12426 {":file", IMAGE_STRING_VALUE, 1},
12427 {":loader", IMAGE_FUNCTION_VALUE, 0},
12428 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE, 1},
12429 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
8edb0a6f 12430 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
6fc2811b 12431 {":relief", IMAGE_INTEGER_VALUE, 0},
a93f4566 12432 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
a05e2bae
JR		 12433 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
12434 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
12435 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
6fc2811b
JR		 12436};
12437
12438/* Structure describing the image type `ghostscript'. */
12439
12440static struct image_type gs_type =
12441{
12442 &Qpostscript,
12443 gs_image_p,
12444 gs_load,
12445 gs_clear_image,
12446 NULL
12447};
12448
12449
12450/* Free X resources of Ghostscript image IMG which is used on frame F. */
12451
12452static void
12453gs_clear_image (f, img)
12454 struct frame *f;
12455 struct image *img;
12456{
12457 /* IMG->data.ptr_val may contain a recorded colormap. */
12458 xfree (img->data.ptr_val);
12459 x_clear_image (f, img);
12460}
12461
12462
12463/* Return non-zero if OBJECT is a valid Ghostscript image
12464 specification. */
12465
12466static int
12467gs_image_p (object)
12468 Lisp_Object object;
12469{
12470 struct image_keyword fmt[GS_LAST];
12471 Lisp_Object tem;
12472 int i;
12473
12474 bcopy (gs_format, fmt, sizeof fmt);
12475
12476 if (!parse_image_spec (object, fmt, GS_LAST, Qpostscript)
12477 || (fmt[GS_ASCENT].count
12478 && XFASTINT (fmt[GS_ASCENT].value) > 100))
12479 return 0;
12480
12481 /* Bounding box must be a list or vector containing 4 integers. */
12482 tem = fmt[GS_BOUNDING_BOX].value;
12483 if (CONSP (tem))
12484 {
12485 for (i = 0; i < 4; ++i, tem = XCDR (tem))
12486 if (!CONSP (tem) || !INTEGERP (XCAR (tem)))
12487 return 0;
12488 if (!NILP (tem))
12489 return 0;
12490 }
12491 else if (VECTORP (tem))
12492 {
12493 if (XVECTOR (tem)->size != 4)
12494 return 0;
12495 for (i = 0; i < 4; ++i)
12496 if (!INTEGERP (XVECTOR (tem)->contents[i]))
12497 return 0;
12498 }
12499 else
12500 return 0;
12501
12502 return 1;
12503}
12504
12505
12506/* Load Ghostscript image IMG for use on frame F. Value is non-zero
12507 if successful. */
12508
12509static int
12510gs_load (f, img)
12511 struct frame *f;
12512 struct image *img;
12513{
12514 char buffer[100];
12515 Lisp_Object window_and_pixmap_id = Qnil, loader, pt_height, pt_width;
12516 struct gcpro gcpro1, gcpro2;
12517 Lisp_Object frame;
12518 double in_width, in_height;
12519 Lisp_Object pixel_colors = Qnil;
12520
12521 /* Compute pixel size of pixmap needed from the given size in the
12522 image specification. Sizes in the specification are in pt. 1 pt
12523 = 1/72 in, xdpi and ydpi are stored in the frame's X display
12524 info. */
12525 pt_width = image_spec_value (img->spec, QCpt_width, NULL);
12526 in_width = XFASTINT (pt_width) / 72.0;
12527 img->width = in_width * FRAME_W32_DISPLAY_INFO (f)->resx;
12528 pt_height = image_spec_value (img->spec, QCpt_height, NULL);
12529 in_height = XFASTINT (pt_height) / 72.0;
12530 img->height = in_height * FRAME_W32_DISPLAY_INFO (f)->resy;
12531
12532 /* Create the pixmap. */
12533 BLOCK_INPUT;
12534 xassert (img->pixmap == 0);
12535 img->pixmap = XCreatePixmap (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
12536 img->width, img->height,
a05e2bae 12537 one_w32_display_info.n_cbits);
6fc2811b
JR		 12538 UNBLOCK_INPUT;
12539
12540 if (!img->pixmap)
12541 {
12542 image_error ("Unable to create pixmap for `%s'", img->spec, Qnil);
12543 return 0;
12544 }
12545
12546 /* Call the loader to fill the pixmap. It returns a process object
12547 if successful. We do not record_unwind_protect here because
12548 other places in redisplay like calling window scroll functions
12549 don't either. Let the Lisp loader use `unwind-protect' instead. */
12550 GCPRO2 (window_and_pixmap_id, pixel_colors);
12551
12552 sprintf (buffer, "%lu %lu",
12553 (unsigned long) FRAME_W32_WINDOW (f),
12554 (unsigned long) img->pixmap);
12555 window_and_pixmap_id = build_string (buffer);
12556
12557 sprintf (buffer, "%lu %lu",
12558 FRAME_FOREGROUND_PIXEL (f),
12559 FRAME_BACKGROUND_PIXEL (f));
12560 pixel_colors = build_string (buffer);
12561
12562 XSETFRAME (frame, f);
12563 loader = image_spec_value (img->spec, QCloader, NULL);
12564 if (NILP (loader))
12565 loader = intern ("gs-load-image");
12566
12567 img->data.lisp_val = call6 (loader, frame, img->spec,
12568 make_number (img->width),
12569 make_number (img->height),
12570 window_and_pixmap_id,
12571 pixel_colors);
12572 UNGCPRO;
12573 return PROCESSP (img->data.lisp_val);
12574}
12575
12576
12577/* Kill the Ghostscript process that was started to fill PIXMAP on
12578 frame F. Called from XTread_socket when receiving an event
12579 telling Emacs that Ghostscript has finished drawing. */
12580
12581void
12582x_kill_gs_process (pixmap, f)
12583 Pixmap pixmap;
12584 struct frame *f;
12585{
12586 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
12587 int class, i;
12588 struct image *img;
12589
12590 /* Find the image containing PIXMAP. */
12591 for (i = 0; i < c->used; ++i)
12592 if (c->images[i]->pixmap == pixmap)
12593 break;
12594
3cf3436e
JR		 12595 /* Should someone in between have cleared the image cache, for
12596 instance, give up. */
12597 if (i == c->used)
12598 return;
12599
6fc2811b
JR		 12600 /* Kill the GS process. We should have found PIXMAP in the image
12601 cache and its image should contain a process object. */
6fc2811b
JR		 12602 img = c->images[i];
12603 xassert (PROCESSP (img->data.lisp_val));
12604 Fkill_process (img->data.lisp_val, Qnil);
12605 img->data.lisp_val = Qnil;
12606
12607 /* On displays with a mutable colormap, figure out the colors
12608 allocated for the image by looking at the pixels of an XImage for
12609 img->pixmap. */
12610 class = FRAME_W32_DISPLAY_INFO (f)->visual->class;
12611 if (class != StaticColor && class != StaticGray && class != TrueColor)
12612 {
12613 XImage *ximg;
12614
12615 BLOCK_INPUT;
12616
12617 /* Try to get an XImage for img->pixmep. */
12618 ximg = XGetImage (FRAME_W32_DISPLAY (f), img->pixmap,
12619 0, 0, img->width, img->height, ~0, ZPixmap);
12620 if (ximg)
12621 {
12622 int x, y;
12623
12624 /* Initialize the color table. */
12625 init_color_table ();
12626
12627 /* For each pixel of the image, look its color up in the
12628 color table. After having done so, the color table will
12629 contain an entry for each color used by the image. */
12630 for (y = 0; y < img->height; ++y)
12631 for (x = 0; x < img->width; ++x)
12632 {
12633 unsigned long pixel = XGetPixel (ximg, x, y);
12634 lookup_pixel_color (f, pixel);
12635 }
12636
12637 /* Record colors in the image. Free color table and XImage. */
12638 img->colors = colors_in_color_table (&img->ncolors);
12639 free_color_table ();
12640 XDestroyImage (ximg);
12641
12642#if 0 /* This doesn't seem to be the case. If we free the colors
12643 here, we get a BadAccess later in x_clear_image when
12644 freeing the colors. */
12645 /* We have allocated colors once, but Ghostscript has also
12646 allocated colors on behalf of us. So, to get the
12647 reference counts right, free them once. */
12648 if (img->ncolors)
3cf3436e 12649 x_free_colors (FRAME_W32_DISPLAY (f), cmap,
6fc2811b 12650 img->colors, img->ncolors, 0);
6fc2811b
JR		 12651#endif
12652 }
12653 else
12654 image_error ("Cannot get X image of `%s'; colors will not be freed",
12655 img->spec, Qnil);
12656
12657 UNBLOCK_INPUT;
12658 }
3cf3436e
JR		 12659
12660 /* Now that we have the pixmap, compute mask and transform the
12661 image if requested. */
12662 BLOCK_INPUT;
12663 postprocess_image (f, img);
12664 UNBLOCK_INPUT;
6fc2811b
JR		 12665}
12666
12667#endif /* HAVE_GHOSTSCRIPT */
12668
12669\f
12670/***********************************************************************
12671 Window properties
12672 ***********************************************************************/
12673
12674DEFUN ("x-change-window-property", Fx_change_window_property,
12675 Sx_change_window_property, 2, 3, 0,
74e1aeec
JR		 12676 doc: /* Change window property PROP to VALUE on the X window of FRAME.
12677PROP and VALUE must be strings. FRAME nil or omitted means use the
12678selected frame. Value is VALUE. */)
6fc2811b
JR		 12679 (prop, value, frame)
12680 Lisp_Object frame, prop, value;
12681{
767b1ff0 12682#if 0 /* TODO : port window properties to W32 */
6fc2811b
JR		 12683 struct frame *f = check_x_frame (frame);
12684 Atom prop_atom;
12685
b7826503
PJ		 12686 CHECK_STRING (prop);
12687 CHECK_STRING (value);
6fc2811b
JR		 12688
12689 BLOCK_INPUT;
12690 prop_atom = XInternAtom (FRAME_W32_DISPLAY (f), XSTRING (prop)->data, False);
12691 XChangeProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
12692 prop_atom, XA_STRING, 8, PropModeReplace,
12693 XSTRING (value)->data, XSTRING (value)->size);
12694
12695 /* Make sure the property is set when we return. */
12696 XFlush (FRAME_W32_DISPLAY (f));
12697 UNBLOCK_INPUT;
12698
767b1ff0 12699#endif /* TODO */
6fc2811b
JR		 12700
12701 return value;
12702}
12703
12704
12705DEFUN ("x-delete-window-property", Fx_delete_window_property,
12706 Sx_delete_window_property, 1, 2, 0,
74e1aeec
JR		 12707 doc: /* Remove window property PROP from X window of FRAME.
12708FRAME nil or omitted means use the selected frame. Value is PROP. */)
6fc2811b
JR		 12709 (prop, frame)
12710 Lisp_Object prop, frame;
12711{
767b1ff0 12712#if 0 /* TODO : port window properties to W32 */
6fc2811b
JR		 12713
12714 struct frame *f = check_x_frame (frame);
12715 Atom prop_atom;
12716
b7826503 12717 CHECK_STRING (prop);
6fc2811b
JR		 12718 BLOCK_INPUT;
12719 prop_atom = XInternAtom (FRAME_W32_DISPLAY (f), XSTRING (prop)->data, False);
12720 XDeleteProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f), prop_atom);
12721
12722 /* Make sure the property is removed when we return. */
12723 XFlush (FRAME_W32_DISPLAY (f));
12724 UNBLOCK_INPUT;
767b1ff0 12725#endif /* TODO */
6fc2811b
JR		 12726
12727 return prop;
12728}
12729
12730
12731DEFUN ("x-window-property", Fx_window_property, Sx_window_property,
12732 1, 2, 0,
74e1aeec
JR		 12733 doc: /* Value is the value of window property PROP on FRAME.
12734If FRAME is nil or omitted, use the selected frame. Value is nil
12735if FRAME hasn't a property with name PROP or if PROP has no string
12736value. */)
6fc2811b
JR		 12737 (prop, frame)
12738 Lisp_Object prop, frame;
12739{
767b1ff0 12740#if 0 /* TODO : port window properties to W32 */
6fc2811b
JR		 12741
12742 struct frame *f = check_x_frame (frame);
12743 Atom prop_atom;
12744 int rc;
12745 Lisp_Object prop_value = Qnil;
12746 char *tmp_data = NULL;
12747 Atom actual_type;
12748 int actual_format;
12749 unsigned long actual_size, bytes_remaining;
12750
b7826503 12751 CHECK_STRING (prop);
6fc2811b
JR		 12752 BLOCK_INPUT;
12753 prop_atom = XInternAtom (FRAME_W32_DISPLAY (f), XSTRING (prop)->data, False);
12754 rc = XGetWindowProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
12755 prop_atom, 0, 0, False, XA_STRING,
12756 &actual_type, &actual_format, &actual_size,
12757 &bytes_remaining, (unsigned char **) &tmp_data);
12758 if (rc == Success)
12759 {
12760 int size = bytes_remaining;
12761
12762 XFree (tmp_data);
12763 tmp_data = NULL;
12764
12765 rc = XGetWindowProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
12766 prop_atom, 0, bytes_remaining,
12767 False, XA_STRING,
12768 &actual_type, &actual_format,
12769 &actual_size, &bytes_remaining,
12770 (unsigned char **) &tmp_data);
12771 if (rc == Success)
12772 prop_value = make_string (tmp_data, size);
12773
12774 XFree (tmp_data);
12775 }
12776
12777 UNBLOCK_INPUT;
12778
12779 return prop_value;
12780
767b1ff0 12781#endif /* TODO */
6fc2811b
JR		 12782 return Qnil;
12783}
12784
12785
12786\f
12787/***********************************************************************
12788 Busy cursor
12789 ***********************************************************************/
12790
f79e6790 12791/* If non-null, an asynchronous timer that, when it expires, displays
0af913d7 12792 an hourglass cursor on all frames. */
6fc2811b 12793
0af913d7 12794static struct atimer *hourglass_atimer;
6fc2811b 12795
0af913d7 12796/* Non-zero means an hourglass cursor is currently shown. */
6fc2811b 12797
0af913d7 12798static int hourglass_shown_p;
6fc2811b 12799
0af913d7 12800/* Number of seconds to wait before displaying an hourglass cursor. */
6fc2811b 12801
0af913d7 12802static Lisp_Object Vhourglass_delay;
6fc2811b 12803
0af913d7 12804/* Default number of seconds to wait before displaying an hourglass
f79e6790
JR		 12805 cursor. */
12806
0af913d7 12807#define DEFAULT_HOURGLASS_DELAY 1
f79e6790
JR		 12808
12809/* Function prototypes. */
12810
0af913d7
GM		 12811static void show_hourglass P_ ((struct atimer *));
12812static void hide_hourglass P_ ((void));
f79e6790
JR		 12813
12814
0af913d7 12815/* Cancel a currently active hourglass timer, and start a new one. */
f79e6790
JR		 12816
12817void
0af913d7 12818start_hourglass ()
f79e6790 12819{
767b1ff0 12820#if 0 /* TODO: cursor shape changes. */
f79e6790 12821 EMACS_TIME delay;
dfff8a69 12822 int secs, usecs = 0;
f79e6790 12823
0af913d7 12824 cancel_hourglass ();
f79e6790 12825
0af913d7
GM		 12826 if (INTEGERP (Vhourglass_delay)
12827 && XINT (Vhourglass_delay) > 0)
12828 secs = XFASTINT (Vhourglass_delay);
12829 else if (FLOATP (Vhourglass_delay)
12830 && XFLOAT_DATA (Vhourglass_delay) > 0)
dfff8a69
JR		 12831 {
12832 Lisp_Object tem;
0af913d7 12833 tem = Ftruncate (Vhourglass_delay, Qnil);
dfff8a69 12834 secs = XFASTINT (tem);
0af913d7 12835 usecs = (XFLOAT_DATA (Vhourglass_delay) - secs) * 1000000;
dfff8a69 12836 }
f79e6790 12837 else
0af913d7 12838 secs = DEFAULT_HOURGLASS_DELAY;
f79e6790 12839
dfff8a69 12840 EMACS_SET_SECS_USECS (delay, secs, usecs);
0af913d7
GM		 12841 hourglass_atimer = start_atimer (ATIMER_RELATIVE, delay,
12842 show_hourglass, NULL);
f79e6790
JR		 12843#endif
12844}
12845
12846
0af913d7
GM		 12847/* Cancel the hourglass cursor timer if active, hide an hourglass
12848 cursor if shown. */
f79e6790
JR		 12849
12850void
0af913d7 12851cancel_hourglass ()
f79e6790 12852{
0af913d7 12853 if (hourglass_atimer)
dfff8a69 12854 {
0af913d7
GM		 12855 cancel_atimer (hourglass_atimer);
12856 hourglass_atimer = NULL;
dfff8a69
JR		 12857 }
12858
0af913d7
GM		 12859 if (hourglass_shown_p)
12860 hide_hourglass ();
f79e6790
JR		 12861}
12862
12863
0af913d7
GM		 12864/* Timer function of hourglass_atimer. TIMER is equal to
12865 hourglass_atimer.
f79e6790 12866
0af913d7
GM		 12867 Display an hourglass cursor on all frames by mapping the frames'
12868 hourglass_window. Set the hourglass_p flag in the frames'
12869 output_data.x structure to indicate that an hourglass cursor is
12870 shown on the frames. */
f79e6790
JR		 12871
12872static void
0af913d7 12873show_hourglass (timer)
f79e6790 12874 struct atimer *timer;
6fc2811b 12875{
767b1ff0 12876#if 0 /* TODO: cursor shape changes. */
f79e6790 12877 /* The timer implementation will cancel this timer automatically
0af913d7 12878 after this function has run. Set hourglass_atimer to null
f79e6790 12879 so that we know the timer doesn't have to be canceled. */
0af913d7 12880 hourglass_atimer = NULL;
f79e6790 12881
0af913d7 12882 if (!hourglass_shown_p)
6fc2811b
JR		 12883 {
12884 Lisp_Object rest, frame;
f79e6790
JR		 12885
12886 BLOCK_INPUT;
12887
6fc2811b 12888 FOR_EACH_FRAME (rest, frame)
dc220243 12889 if (FRAME_W32_P (XFRAME (frame)))
6fc2811b
JR		 12890 {
12891 struct frame *f = XFRAME (frame);
f79e6790 12892
0af913d7 12893 f->output_data.w32->hourglass_p = 1;
f79e6790 12894
0af913d7 12895 if (!f->output_data.w32->hourglass_window)
6fc2811b
JR		 12896 {
12897 unsigned long mask = CWCursor;
12898 XSetWindowAttributes attrs;
f79e6790 12899
0af913d7 12900 attrs.cursor = f->output_data.w32->hourglass_cursor;
f79e6790 12901
0af913d7 12902 f->output_data.w32->hourglass_window
f79e6790 12903 = XCreateWindow (FRAME_X_DISPLAY (f),
6fc2811b
JR		 12904 FRAME_OUTER_WINDOW (f),
12905 0, 0, 32000, 32000, 0, 0,
f79e6790
JR		 12906 InputOnly,
12907 CopyFromParent,
6fc2811b
JR		 12908 mask, &attrs);
12909 }
f79e6790 12910
0af913d7
GM		 12911 XMapRaised (FRAME_X_DISPLAY (f),
12912 f->output_data.w32->hourglass_window);
f79e6790 12913 XFlush (FRAME_X_DISPLAY (f));
6fc2811b 12914 }
6fc2811b 12915
0af913d7 12916 hourglass_shown_p = 1;
f79e6790
JR		 12917 UNBLOCK_INPUT;
12918 }
12919#endif
6fc2811b
JR		 12920}
12921
12922
0af913d7 12923/* Hide the hourglass cursor on all frames, if it is currently shown. */
6fc2811b 12924
f79e6790 12925static void
0af913d7 12926hide_hourglass ()
f79e6790 12927{
767b1ff0 12928#if 0 /* TODO: cursor shape changes. */
0af913d7 12929 if (hourglass_shown_p)
6fc2811b 12930 {
f79e6790
JR		 12931 Lisp_Object rest, frame;
12932
12933 BLOCK_INPUT;
12934 FOR_EACH_FRAME (rest, frame)
6fc2811b 12935 {
f79e6790
JR		 12936 struct frame *f = XFRAME (frame);
12937
dc220243 12938 if (FRAME_W32_P (f)
f79e6790 12939 /* Watch out for newly created frames. */
0af913d7 12940 && f->output_data.x->hourglass_window)
f79e6790 12941 {
0af913d7
GM		 12942 XUnmapWindow (FRAME_X_DISPLAY (f),
12943 f->output_data.x->hourglass_window);
12944 /* Sync here because XTread_socket looks at the
12945 hourglass_p flag that is reset to zero below. */
f79e6790 12946 XSync (FRAME_X_DISPLAY (f), False);
0af913d7 12947 f->output_data.x->hourglass_p = 0;
f79e6790 12948 }
6fc2811b 12949 }
6fc2811b 12950
0af913d7 12951 hourglass_shown_p = 0;
f79e6790
JR		 12952 UNBLOCK_INPUT;
12953 }
12954#endif
6fc2811b
JR		 12955}
12956
12957
12958\f
12959/***********************************************************************
12960 Tool tips
12961 ***********************************************************************/
12962
12963static Lisp_Object x_create_tip_frame P_ ((struct w32_display_info *,
3cf3436e
JR		 12964 Lisp_Object, Lisp_Object));
12965static void compute_tip_xy P_ ((struct frame *, Lisp_Object, Lisp_Object,
12966 Lisp_Object, int, int, int *, int *));
6fc2811b 12967
3cf3436e 12968/* The frame of a currently visible tooltip. */
6fc2811b 12969
937e601e 12970Lisp_Object tip_frame;
6fc2811b
JR		 12971
12972/* If non-nil, a timer started that hides the last tooltip when it
12973 fires. */
12974
12975Lisp_Object tip_timer;
12976Window tip_window;
12977
3cf3436e
JR		 12978/* If non-nil, a vector of 3 elements containing the last args
12979 with which x-show-tip was called. See there. */
12980
12981Lisp_Object last_show_tip_args;
12982
12983/* Maximum size for tooltips; a cons (COLUMNS . ROWS). */
12984
12985Lisp_Object Vx_max_tooltip_size;
12986
12987
937e601e
AI		 12988static Lisp_Object
12989unwind_create_tip_frame (frame)
12990 Lisp_Object frame;
12991{
c844a81a
GM		 12992 Lisp_Object deleted;
12993
12994 deleted = unwind_create_frame (frame);
12995 if (EQ (deleted, Qt))
12996 {
12997 tip_window = NULL;
12998 tip_frame = Qnil;
12999 }
13000
13001 return deleted;
937e601e
AI		 13002}
13003
13004
6fc2811b 13005/* Create a frame for a tooltip on the display described by DPYINFO.
3cf3436e
JR		 13006 PARMS is a list of frame parameters. TEXT is the string to
13007 display in the tip frame. Value is the frame.
937e601e
AI		 13008
13009 Note that functions called here, esp. x_default_parameter can
13010 signal errors, for instance when a specified color name is
13011 undefined. We have to make sure that we're in a consistent state
13012 when this happens. */
6fc2811b
JR		 13013
13014static Lisp_Object
3cf3436e 13015x_create_tip_frame (dpyinfo, parms, text)
6fc2811b 13016 struct w32_display_info *dpyinfo;
3cf3436e 13017 Lisp_Object parms, text;
6fc2811b 13018{
767b1ff0 13019#if 0 /* TODO : w32 version */
6fc2811b
JR		 13020 struct frame *f;
13021 Lisp_Object frame, tem;
13022 Lisp_Object name;
13023 long window_prompting = 0;
13024 int width, height;
dc220243 13025 int count = BINDING_STACK_SIZE ();
6fc2811b
JR		 13026 struct gcpro gcpro1, gcpro2, gcpro3;
13027 struct kboard *kb;
3cf3436e
JR		 13028 int face_change_count_before = face_change_count;
13029 Lisp_Object buffer;
13030 struct buffer *old_buffer;
6fc2811b
JR		 13031
13032 check_x ();
13033
13034 /* Use this general default value to start with until we know if
13035 this frame has a specified name. */
13036 Vx_resource_name = Vinvocation_name;
13037
13038#ifdef MULTI_KBOARD
13039 kb = dpyinfo->kboard;
13040#else
13041 kb = &the_only_kboard;
13042#endif
13043
13044 /* Get the name of the frame to use for resource lookup. */
13045 name = w32_get_arg (parms, Qname, "name", "Name", RES_TYPE_STRING);
13046 if (!STRINGP (name)
13047 && !EQ (name, Qunbound)
13048 && !NILP (name))
13049 error ("Invalid frame name--not a string or nil");
13050 Vx_resource_name = name;
13051
13052 frame = Qnil;
13053 GCPRO3 (parms, name, frame);
937e601e 13054 f = make_frame (1);
6fc2811b 13055 XSETFRAME (frame, f);
3cf3436e
JR		 13056
13057 buffer = Fget_buffer_create (build_string (" *tip*"));
13058 Fset_window_buffer (FRAME_ROOT_WINDOW (f), buffer);
13059 old_buffer = current_buffer;
13060 set_buffer_internal_1 (XBUFFER (buffer));
13061 current_buffer->truncate_lines = Qnil;
13062 Ferase_buffer ();
13063 Finsert (1, &text);
13064 set_buffer_internal_1 (old_buffer);
13065
6fc2811b 13066 FRAME_CAN_HAVE_SCROLL_BARS (f) = 0;
937e601e 13067 record_unwind_protect (unwind_create_tip_frame, frame);
6fc2811b 13068
3cf3436e
JR		 13069 /* By setting the output method, we're essentially saying that
13070 the frame is live, as per FRAME_LIVE_P. If we get a signal
13071 from this point on, x_destroy_window might screw up reference
13072 counts etc. */
d88c567c 13073 f->output_method = output_w32;
6fc2811b
JR		 13074 f->output_data.w32 =
13075 (struct w32_output *) xmalloc (sizeof (struct w32_output));
13076 bzero (f->output_data.w32, sizeof (struct w32_output));
13077#if 0
13078 f->output_data.w32->icon_bitmap = -1;
13079#endif
13080 f->output_data.w32->fontset = -1;
13081 f->icon_name = Qnil;
13082
937e601e
AI		 13083#ifdef GLYPH_DEBUG
13084 image_cache_refcount = FRAME_X_IMAGE_CACHE (f)->refcount;
13085 dpyinfo_refcount = dpyinfo->reference_count;
13086#endif /* GLYPH_DEBUG */
6fc2811b
JR		 13087#ifdef MULTI_KBOARD
13088 FRAME_KBOARD (f) = kb;
13089#endif
13090 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
13091 f->output_data.w32->explicit_parent = 0;
13092
13093 /* Set the name; the functions to which we pass f expect the name to
13094 be set. */
13095 if (EQ (name, Qunbound) || NILP (name))
13096 {
13097 f->name = build_string (dpyinfo->x_id_name);
13098 f->explicit_name = 0;
13099 }
13100 else
13101 {
13102 f->name = name;
13103 f->explicit_name = 1;
13104 /* use the frame's title when getting resources for this frame. */
13105 specbind (Qx_resource_name, name);
13106 }
13107
6fc2811b
JR		 13108 /* Extract the window parameters from the supplied values
13109 that are needed to determine window geometry. */
13110 {
13111 Lisp_Object font;
13112
13113 font = w32_get_arg (parms, Qfont, "font", "Font", RES_TYPE_STRING);
13114
13115 BLOCK_INPUT;
13116 /* First, try whatever font the caller has specified. */
13117 if (STRINGP (font))
13118 {
13119 tem = Fquery_fontset (font, Qnil);
13120 if (STRINGP (tem))
13121 font = x_new_fontset (f, XSTRING (tem)->data);
13122 else
13123 font = x_new_font (f, XSTRING (font)->data);
13124 }
13125
13126 /* Try out a font which we hope has bold and italic variations. */
13127 if (!STRINGP (font))
e39649be 13128 font = x_new_font (f, "-*-courier new-normal-r-*-*-*-100-*-*-*-*-iso8859-1");
6fc2811b
JR		 13129 if (!STRINGP (font))
13130 font = x_new_font (f, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
13131 if (! STRINGP (font))
13132 font = x_new_font (f, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
13133 if (! STRINGP (font))
13134 /* This was formerly the first thing tried, but it finds too many fonts
13135 and takes too long. */
13136 font = x_new_font (f, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
13137 /* If those didn't work, look for something which will at least work. */
13138 if (! STRINGP (font))
13139 font = x_new_font (f, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
13140 UNBLOCK_INPUT;
13141 if (! STRINGP (font))
13142 font = build_string ("fixed");
13143
13144 x_default_parameter (f, parms, Qfont, font,
13145 "font", "Font", RES_TYPE_STRING);
13146 }
13147
13148 x_default_parameter (f, parms, Qborder_width, make_number (2),
13149 "borderWidth", "BorderWidth", RES_TYPE_NUMBER);
13150
13151 /* This defaults to 2 in order to match xterm. We recognize either
13152 internalBorderWidth or internalBorder (which is what xterm calls
13153 it). */
13154 if (NILP (Fassq (Qinternal_border_width, parms)))
13155 {
13156 Lisp_Object value;
13157
13158 value = w32_get_arg (parms, Qinternal_border_width,
13159 "internalBorder", "internalBorder", RES_TYPE_NUMBER);
13160 if (! EQ (value, Qunbound))
13161 parms = Fcons (Fcons (Qinternal_border_width, value),
13162 parms);
13163 }
13164
13165 x_default_parameter (f, parms, Qinternal_border_width, make_number (1),
13166 "internalBorderWidth", "internalBorderWidth",
13167 RES_TYPE_NUMBER);
13168
13169 /* Also do the stuff which must be set before the window exists. */
13170 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
13171 "foreground", "Foreground", RES_TYPE_STRING);
13172 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
13173 "background", "Background", RES_TYPE_STRING);
13174 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
13175 "pointerColor", "Foreground", RES_TYPE_STRING);
13176 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
13177 "cursorColor", "Foreground", RES_TYPE_STRING);
13178 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
13179 "borderColor", "BorderColor", RES_TYPE_STRING);
13180
13181 /* Init faces before x_default_parameter is called for scroll-bar
13182 parameters because that function calls x_set_scroll_bar_width,
13183 which calls change_frame_size, which calls Fset_window_buffer,
13184 which runs hooks, which call Fvertical_motion. At the end, we
13185 end up in init_iterator with a null face cache, which should not
13186 happen. */
13187 init_frame_faces (f);
13188
13189 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
13190 window_prompting = x_figure_window_size (f, parms);
13191
13192 if (window_prompting & XNegative)
13193 {
13194 if (window_prompting & YNegative)
13195 f->output_data.w32->win_gravity = SouthEastGravity;
13196 else
13197 f->output_data.w32->win_gravity = NorthEastGravity;
13198 }
13199 else
13200 {
13201 if (window_prompting & YNegative)
13202 f->output_data.w32->win_gravity = SouthWestGravity;
13203 else
13204 f->output_data.w32->win_gravity = NorthWestGravity;
13205 }
13206
13207 f->output_data.w32->size_hint_flags = window_prompting;
13208 {
13209 XSetWindowAttributes attrs;
13210 unsigned long mask;
13211
13212 BLOCK_INPUT;
3cf3436e
JR		 13213 mask = CWBackPixel | CWOverrideRedirect | CWEventMask;
13214 if (DoesSaveUnders (dpyinfo->screen))
13215 mask |= CWSaveUnder;
13216
6fc2811b
JR		 13217 /* Window managers looks at the override-redirect flag to
13218 determine whether or net to give windows a decoration (Xlib
13219 3.2.8). */
13220 attrs.override_redirect = True;
13221 attrs.save_under = True;
13222 attrs.background_pixel = FRAME_BACKGROUND_PIXEL (f);
13223 /* Arrange for getting MapNotify and UnmapNotify events. */
13224 attrs.event_mask = StructureNotifyMask;
13225 tip_window
13226 = FRAME_W32_WINDOW (f)
13227 = XCreateWindow (FRAME_W32_DISPLAY (f),
13228 FRAME_W32_DISPLAY_INFO (f)->root_window,
13229 /* x, y, width, height */
13230 0, 0, 1, 1,
13231 /* Border. */
13232 1,
13233 CopyFromParent, InputOutput, CopyFromParent,
13234 mask, &attrs);
13235 UNBLOCK_INPUT;
13236 }
13237
13238 x_make_gc (f);
13239
13240 x_default_parameter (f, parms, Qauto_raise, Qnil,
13241 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
13242 x_default_parameter (f, parms, Qauto_lower, Qnil,
13243 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
13244 x_default_parameter (f, parms, Qcursor_type, Qbox,
13245 "cursorType", "CursorType", RES_TYPE_SYMBOL);
13246
13247 /* Dimensions, especially f->height, must be done via change_frame_size.
13248 Change will not be effected unless different from the current
13249 f->height. */
13250 width = f->width;
13251 height = f->height;
13252 f->height = 0;
13253 SET_FRAME_WIDTH (f, 0);
13254 change_frame_size (f, height, width, 1, 0, 0);
13255
3cf3436e
JR		 13256 /* Set up faces after all frame parameters are known. This call
13257 also merges in face attributes specified for new frames.
13258
13259 Frame parameters may be changed if .Xdefaults contains
13260 specifications for the default font. For example, if there is an
13261 `Emacs.default.attributeBackground: pink', the `background-color'
13262 attribute of the frame get's set, which let's the internal border
13263 of the tooltip frame appear in pink. Prevent this. */
13264 {
13265 Lisp_Object bg = Fframe_parameter (frame, Qbackground_color);
13266
13267 /* Set tip_frame here, so that */
13268 tip_frame = frame;
13269 call1 (Qface_set_after_frame_default, frame);
13270
13271 if (!EQ (bg, Fframe_parameter (frame, Qbackground_color)))
13272 Fmodify_frame_parameters (frame, Fcons (Fcons (Qbackground_color, bg),
13273 Qnil));
13274 }
13275
6fc2811b
JR		 13276 f->no_split = 1;
13277
13278 UNGCPRO;
13279
13280 /* It is now ok to make the frame official even if we get an error
13281 below. And the frame needs to be on Vframe_list or making it
13282 visible won't work. */
13283 Vframe_list = Fcons (frame, Vframe_list);
13284
13285 /* Now that the frame is official, it counts as a reference to
13286 its display. */
13287 FRAME_W32_DISPLAY_INFO (f)->reference_count++;
ee78dc32 13288
3cf3436e
JR		 13289 /* Setting attributes of faces of the tooltip frame from resources
13290 and similar will increment face_change_count, which leads to the
13291 clearing of all current matrices. Since this isn't necessary
13292 here, avoid it by resetting face_change_count to the value it
13293 had before we created the tip frame. */
13294 face_change_count = face_change_count_before;
13295
13296 /* Discard the unwind_protect. */
6fc2811b 13297 return unbind_to (count, frame);
767b1ff0 13298#endif /* TODO */
6fc2811b 13299 return Qnil;
ee78dc32
GV		 13300}
13301
3cf3436e
JR		 13302
13303/* Compute where to display tip frame F. PARMS is the list of frame
13304 parameters for F. DX and DY are specified offsets from the current
13305 location of the mouse. WIDTH and HEIGHT are the width and height
13306 of the tooltip. Return coordinates relative to the root window of
13307 the display in *ROOT_X, and *ROOT_Y. */
13308
13309static void
13310compute_tip_xy (f, parms, dx, dy, width, height, root_x, root_y)
13311 struct frame *f;
13312 Lisp_Object parms, dx, dy;
13313 int width, height;
13314 int *root_x, *root_y;
13315{
13316#ifdef TODO /* Tool tips not supported. */
13317 Lisp_Object left, top;
13318 int win_x, win_y;
13319 Window root, child;
13320 unsigned pmask;
13321
13322 /* User-specified position? */
13323 left = Fcdr (Fassq (Qleft, parms));
13324 top = Fcdr (Fassq (Qtop, parms));
13325
13326 /* Move the tooltip window where the mouse pointer is. Resize and
13327 show it. */
13328 if (!INTEGERP (left) && !INTEGERP (top))
13329 {
13330 BLOCK_INPUT;
13331 XQueryPointer (FRAME_X_DISPLAY (f), FRAME_X_DISPLAY_INFO (f)->root_window,
13332 &root, &child, root_x, root_y, &win_x, &win_y, &pmask);
13333 UNBLOCK_INPUT;
13334 }
13335
13336 if (INTEGERP (top))
13337 *root_y = XINT (top);
13338 else if (*root_y + XINT (dy) - height < 0)
13339 *root_y -= XINT (dy);
13340 else
13341 {
13342 *root_y -= height;
13343 *root_y += XINT (dy);
13344 }
13345
13346 if (INTEGERP (left))
13347 *root_x = XINT (left);
13348 else if (*root_x + XINT (dx) + width > FRAME_X_DISPLAY_INFO (f)->width)
13349 *root_x -= width + XINT (dx);
13350 else
13351 *root_x += XINT (dx);
13352
13353#endif /* Tooltip support. */
13354}
13355
13356
767b1ff0 13357#ifdef TODO /* Tooltip support not complete. */
71eab8d1 13358DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
74e1aeec
JR		 13359 doc: /* Show STRING in a \"tooltip\" window on frame FRAME.
13360A tooltip window is a small window displaying a string.
13361
13362FRAME nil or omitted means use the selected frame.
13363
13364PARMS is an optional list of frame parameters which can be
13365used to change the tooltip's appearance.
13366
13367Automatically hide the tooltip after TIMEOUT seconds.
13368TIMEOUT nil means use the default timeout of 5 seconds.
13369
13370If the list of frame parameters PARAMS contains a `left' parameters,
13371the tooltip is displayed at that x-position. Otherwise it is
13372displayed at the mouse position, with offset DX added (default is 5 if
13373DX isn't specified). Likewise for the y-position; if a `top' frame
13374parameter is specified, it determines the y-position of the tooltip
13375window, otherwise it is displayed at the mouse position, with offset
13376DY added (default is -10).
13377
13378A tooltip's maximum size is specified by `x-max-tooltip-size'.
13379Text larger than the specified size is clipped. */)
71eab8d1
AI		 13380 (string, frame, parms, timeout, dx, dy)
13381 Lisp_Object string, frame, parms, timeout, dx, dy;
ee78dc32 13382{
6fc2811b
JR		 13383 struct frame *f;
13384 struct window *w;
3cf3436e 13385 int root_x, root_y;
6fc2811b
JR		 13386 struct buffer *old_buffer;
13387 struct text_pos pos;
13388 int i, width, height;
6fc2811b
JR		 13389 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
13390 int old_windows_or_buffers_changed = windows_or_buffers_changed;
13391 int count = specpdl_ptr - specpdl;
13392
13393 specbind (Qinhibit_redisplay, Qt);
ee78dc32 13394
dfff8a69 13395 GCPRO4 (string, parms, frame, timeout);
ee78dc32 13396
b7826503 13397 CHECK_STRING (string);
6fc2811b
JR		 13398 f = check_x_frame (frame);
13399 if (NILP (timeout))
13400 timeout = make_number (5);
13401 else
b7826503 13402 CHECK_NATNUM (timeout);
ee78dc32 13403
71eab8d1
AI		 13404 if (NILP (dx))
13405 dx = make_number (5);
13406 else
b7826503 13407 CHECK_NUMBER (dx);
71eab8d1
AI		 13408
13409 if (NILP (dy))
dc220243 13410 dy = make_number (-10);
71eab8d1 13411 else
b7826503 13412 CHECK_NUMBER (dy);
71eab8d1 13413
dc220243
JR		 13414 if (NILP (last_show_tip_args))
13415 last_show_tip_args = Fmake_vector (make_number (3), Qnil);
13416
13417 if (!NILP (tip_frame))
13418 {
13419 Lisp_Object last_string = AREF (last_show_tip_args, 0);
13420 Lisp_Object last_frame = AREF (last_show_tip_args, 1);
13421 Lisp_Object last_parms = AREF (last_show_tip_args, 2);
13422
13423 if (EQ (frame, last_frame)
13424 && !NILP (Fequal (last_string, string))
13425 && !NILP (Fequal (last_parms, parms)))
13426 {
13427 struct frame *f = XFRAME (tip_frame);
13428
13429 /* Only DX and DY have changed. */
13430 if (!NILP (tip_timer))
13431 {
13432 Lisp_Object timer = tip_timer;
13433 tip_timer = Qnil;
13434 call1 (Qcancel_timer, timer);
13435 }
13436
13437 BLOCK_INPUT;
13438 compute_tip_xy (f, parms, dx, dy, &root_x, &root_y);
13439 XMoveWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
13440 root_x, root_y - PIXEL_HEIGHT (f));
13441 UNBLOCK_INPUT;
13442 goto start_timer;
13443 }
13444 }
13445
6fc2811b
JR		 13446 /* Hide a previous tip, if any. */
13447 Fx_hide_tip ();
ee78dc32 13448
dc220243
JR		 13449 ASET (last_show_tip_args, 0, string);
13450 ASET (last_show_tip_args, 1, frame);
13451 ASET (last_show_tip_args, 2, parms);
13452
6fc2811b
JR		 13453 /* Add default values to frame parameters. */
13454 if (NILP (Fassq (Qname, parms)))
13455 parms = Fcons (Fcons (Qname, build_string ("tooltip")), parms);
13456 if (NILP (Fassq (Qinternal_border_width, parms)))
13457 parms = Fcons (Fcons (Qinternal_border_width, make_number (3)), parms);
13458 if (NILP (Fassq (Qborder_width, parms)))
13459 parms = Fcons (Fcons (Qborder_width, make_number (1)), parms);
13460 if (NILP (Fassq (Qborder_color, parms)))
13461 parms = Fcons (Fcons (Qborder_color, build_string ("lightyellow")), parms);
13462 if (NILP (Fassq (Qbackground_color, parms)))
13463 parms = Fcons (Fcons (Qbackground_color, build_string ("lightyellow")),
13464 parms);
13465
13466 /* Create a frame for the tooltip, and record it in the global
13467 variable tip_frame. */
13468 frame = x_create_tip_frame (FRAME_W32_DISPLAY_INFO (f), parms);
937e601e 13469 f = XFRAME (frame);
6fc2811b 13470
3cf3436e 13471 /* Set up the frame's root window. */
6fc2811b
JR		 13472 w = XWINDOW (FRAME_ROOT_WINDOW (f));
13473 w->left = w->top = make_number (0);
3cf3436e
JR		 13474
13475 if (CONSP (Vx_max_tooltip_size)
13476 && INTEGERP (XCAR (Vx_max_tooltip_size))
13477 && XINT (XCAR (Vx_max_tooltip_size)) > 0
13478 && INTEGERP (XCDR (Vx_max_tooltip_size))
13479 && XINT (XCDR (Vx_max_tooltip_size)) > 0)
13480 {
13481 w->width = XCAR (Vx_max_tooltip_size);
13482 w->height = XCDR (Vx_max_tooltip_size);
13483 }
13484 else
13485 {
13486 w->width = make_number (80);
13487 w->height = make_number (40);
13488 }
13489
13490 f->window_width = XINT (w->width);
6fc2811b
JR		 13491 adjust_glyphs (f);
13492 w->pseudo_window_p = 1;
13493
13494 /* Display the tooltip text in a temporary buffer. */
6fc2811b 13495 old_buffer = current_buffer;
3cf3436e
JR		 13496 set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f))->buffer));
13497 current_buffer->truncate_lines = Qnil;
6fc2811b
JR		 13498 clear_glyph_matrix (w->desired_matrix);
13499 clear_glyph_matrix (w->current_matrix);
13500 SET_TEXT_POS (pos, BEGV, BEGV_BYTE);
13501 try_window (FRAME_ROOT_WINDOW (f), pos);
13502
13503 /* Compute width and height of the tooltip. */
13504 width = height = 0;
13505 for (i = 0; i < w->desired_matrix->nrows; ++i)
ee78dc32 13506 {
6fc2811b
JR		 13507 struct glyph_row *row = &w->desired_matrix->rows[i];
13508 struct glyph *last;
13509 int row_width;
13510
13511 /* Stop at the first empty row at the end. */
13512 if (!row->enabled_p || !row->displays_text_p)
13513 break;
13514
13515 /* Let the row go over the full width of the frame. */
13516 row->full_width_p = 1;
13517
13518 /* There's a glyph at the end of rows that is use to place
13519 the cursor there. Don't include the width of this glyph. */
13520 if (row->used[TEXT_AREA])
13521 {
13522 last = &row->glyphs[TEXT_AREA][row->used[TEXT_AREA] - 1];
13523 row_width = row->pixel_width - last->pixel_width;
13524 }
13525 else
13526 row_width = row->pixel_width;
13527
13528 height += row->height;
13529 width = max (width, row_width);
ee78dc32
GV		 13530 }
13531
6fc2811b
JR		 13532 /* Add the frame's internal border to the width and height the X
13533 window should have. */
13534 height += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
13535 width += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
ee78dc32 13536
6fc2811b
JR		 13537 /* Move the tooltip window where the mouse pointer is. Resize and
13538 show it. */
3cf3436e 13539 compute_tip_xy (f, parms, dx, dy, width, height, &root_x, &root_y);
71eab8d1 13540
71eab8d1
AI		 13541 BLOCK_INPUT;
13542 XMoveResizeWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
13543 root_x, root_y - height, width, height);
13544 XMapRaised (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f));
6fc2811b 13545 UNBLOCK_INPUT;
ee78dc32 13546
6fc2811b
JR		 13547 /* Draw into the window. */
13548 w->must_be_updated_p = 1;
13549 update_single_window (w, 1);
ee78dc32 13550
6fc2811b
JR		 13551 /* Restore original current buffer. */
13552 set_buffer_internal_1 (old_buffer);
13553 windows_or_buffers_changed = old_windows_or_buffers_changed;
ee78dc32 13554
dc220243 13555 start_timer:
6fc2811b
JR		 13556 /* Let the tip disappear after timeout seconds. */
13557 tip_timer = call3 (intern ("run-at-time"), timeout, Qnil,
13558 intern ("x-hide-tip"));
ee78dc32 13559
dfff8a69 13560 UNGCPRO;
6fc2811b 13561 return unbind_to (count, Qnil);
ee78dc32
GV		 13562}
13563
ee78dc32 13564
6fc2811b 13565DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0,
74e1aeec
JR		 13566 doc: /* Hide the current tooltip window, if there is any.
13567Value is t if tooltip was open, nil otherwise. */)
6fc2811b
JR		 13568 ()
13569{
937e601e
AI		 13570 int count;
13571 Lisp_Object deleted, frame, timer;
13572 struct gcpro gcpro1, gcpro2;
13573
13574 /* Return quickly if nothing to do. */
13575 if (NILP (tip_timer) && NILP (tip_frame))
13576 return Qnil;
13577
13578 frame = tip_frame;
13579 timer = tip_timer;
13580 GCPRO2 (frame, timer);
13581 tip_frame = tip_timer = deleted = Qnil;
6fc2811b 13582
937e601e 13583 count = BINDING_STACK_SIZE ();
6fc2811b 13584 specbind (Qinhibit_redisplay, Qt);
937e601e 13585 specbind (Qinhibit_quit, Qt);
6fc2811b 13586
937e601e 13587 if (!NILP (timer))
dc220243 13588 call1 (Qcancel_timer, timer);
ee78dc32 13589
937e601e 13590 if (FRAMEP (frame))
6fc2811b 13591 {
937e601e
AI		 13592 Fdelete_frame (frame, Qnil);
13593 deleted = Qt;
6fc2811b 13594 }
1edf84e7 13595
937e601e
AI		 13596 UNGCPRO;
13597 return unbind_to (count, deleted);
6fc2811b 13598}
767b1ff0 13599#endif
5ac45f98 13600
5ac45f98 13601
6fc2811b
JR		 13602\f
13603/***********************************************************************
13604 File selection dialog
13605 ***********************************************************************/
13606
13607extern Lisp_Object Qfile_name_history;
13608
13609DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 4, 0,
74e1aeec
JR		 13610 doc: /* Read file name, prompting with PROMPT in directory DIR.
13611Use a file selection dialog.
13612Select DEFAULT-FILENAME in the dialog's file selection box, if
13613specified. Ensure that file exists if MUSTMATCH is non-nil. */)
6fc2811b
JR		 13614 (prompt, dir, default_filename, mustmatch)
13615 Lisp_Object prompt, dir, default_filename, mustmatch;
13616{
13617 struct frame *f = SELECTED_FRAME ();
13618 Lisp_Object file = Qnil;
13619 int count = specpdl_ptr - specpdl;
13620 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
13621 char filename[MAX_PATH + 1];
13622 char init_dir[MAX_PATH + 1];
13623 int use_dialog_p = 1;
13624
13625 GCPRO5 (prompt, dir, default_filename, mustmatch, file);
b7826503
PJ		 13626 CHECK_STRING (prompt);
13627 CHECK_STRING (dir);
6fc2811b
JR		 13628
13629 /* Create the dialog with PROMPT as title, using DIR as initial
13630 directory and using "*" as pattern. */
13631 dir = Fexpand_file_name (dir, Qnil);
13632 strncpy (init_dir, XSTRING (dir)->data, MAX_PATH);
13633 init_dir[MAX_PATH] = '\0';
13634 unixtodos_filename (init_dir);
13635
13636 if (STRINGP (default_filename))
13637 {
13638 char *file_name_only;
13639 char *full_path_name = XSTRING (default_filename)->data;
5ac45f98 13640
6fc2811b 13641 unixtodos_filename (full_path_name);
5ac45f98 13642
6fc2811b
JR		 13643 file_name_only = strrchr (full_path_name, '\\');
13644 if (!file_name_only)
13645 file_name_only = full_path_name;
13646 else
13647 {
13648 file_name_only++;
5ac45f98 13649
6fc2811b
JR		 13650 /* If default_file_name is a directory, don't use the open
13651 file dialog, as it does not support selecting
13652 directories. */
13653 if (!(*file_name_only))
13654 use_dialog_p = 0;
13655 }
ee78dc32 13656
6fc2811b
JR		 13657 strncpy (filename, file_name_only, MAX_PATH);
13658 filename[MAX_PATH] = '\0';
13659 }
ee78dc32 13660 else
6fc2811b 13661 filename[0] = '\0';
ee78dc32 13662
6fc2811b
JR		 13663 if (use_dialog_p)
13664 {
13665 OPENFILENAME file_details;
5ac45f98 13666
6fc2811b
JR		 13667 /* Prevent redisplay. */
13668 specbind (Qinhibit_redisplay, Qt);
13669 BLOCK_INPUT;
ee78dc32 13670
6fc2811b
JR		 13671 bzero (&file_details, sizeof (file_details));
13672 file_details.lStructSize = sizeof (file_details);
13673 file_details.hwndOwner = FRAME_W32_WINDOW (f);
3cf3436e
JR		 13674 /* Undocumented Bug in Common File Dialog:
13675 If a filter is not specified, shell links are not resolved. */
13676 file_details.lpstrFilter = "ALL Files (*.*)\0*.*\0\0";
6fc2811b
JR		 13677 file_details.lpstrFile = filename;
13678 file_details.nMaxFile = sizeof (filename);
13679 file_details.lpstrInitialDir = init_dir;
13680 file_details.lpstrTitle = XSTRING (prompt)->data;
13681 file_details.Flags = OFN_HIDEREADONLY | OFN_NOCHANGEDIR;
ee78dc32 13682
6fc2811b
JR		 13683 if (!NILP (mustmatch))
13684 file_details.Flags |= OFN_FILEMUSTEXIST | OFN_PATHMUSTEXIST;
ee78dc32 13685
6fc2811b
JR		 13686 if (GetOpenFileName (&file_details))
13687 {
13688 dostounix_filename (filename);
13689 file = build_string (filename);
13690 }
ee78dc32 13691 else
6fc2811b
JR		 13692 file = Qnil;
13693
13694 UNBLOCK_INPUT;
13695 file = unbind_to (count, file);
ee78dc32 13696 }
6fc2811b
JR		 13697 /* Open File dialog will not allow folders to be selected, so resort
13698 to minibuffer completing reads for directories. */
13699 else
13700 file = Fcompleting_read (prompt, intern ("read-file-name-internal"),
13701 dir, mustmatch, dir, Qfile_name_history,
13702 default_filename, Qnil);
ee78dc32 13703
6fc2811b 13704 UNGCPRO;
1edf84e7 13705
6fc2811b
JR		 13706 /* Make "Cancel" equivalent to C-g. */
13707 if (NILP (file))
13708 Fsignal (Qquit, Qnil);
ee78dc32 13709
dfff8a69 13710 return unbind_to (count, file);
6fc2811b 13711}
ee78dc32 13712
ee78dc32 13713
6fc2811b 13714\f
6fc2811b
JR		 13715/***********************************************************************
13716 w32 specialized functions
13717 ***********************************************************************/
ee78dc32 13718
fbd6baed 13719DEFUN ("w32-select-font", Fw32_select_font, Sw32_select_font, 0, 1, 0,
74e1aeec
JR		 13720 doc: /* Select a font using the W32 font dialog.
13721Returns an X font string corresponding to the selection. */)
ee78dc32
GV		 13722 (frame)
13723 Lisp_Object frame;
13724{
13725 FRAME_PTR f = check_x_frame (frame);
13726 CHOOSEFONT cf;
13727 LOGFONT lf;
f46e6225
GV		 13728 TEXTMETRIC tm;
13729 HDC hdc;
13730 HANDLE oldobj;
ee78dc32
GV		 13731 char buf[100];
13732
13733 bzero (&cf, sizeof (cf));
f46e6225 13734 bzero (&lf, sizeof (lf));
ee78dc32
GV		 13735
13736 cf.lStructSize = sizeof (cf);
fbd6baed 13737 cf.hwndOwner = FRAME_W32_WINDOW (f);
6fc2811b 13738 cf.Flags = CF_FORCEFONTEXIST | CF_SCREENFONTS;
ee78dc32
GV		 13739 cf.lpLogFont = &lf;
13740
f46e6225
GV		 13741 /* Initialize as much of the font details as we can from the current
13742 default font. */
13743 hdc = GetDC (FRAME_W32_WINDOW (f));
13744 oldobj = SelectObject (hdc, FRAME_FONT (f)->hfont);
13745 GetTextFace (hdc, LF_FACESIZE, lf.lfFaceName);
13746 if (GetTextMetrics (hdc, &tm))
13747 {
13748 lf.lfHeight = tm.tmInternalLeading - tm.tmHeight;
13749 lf.lfWeight = tm.tmWeight;
13750 lf.lfItalic = tm.tmItalic;
13751 lf.lfUnderline = tm.tmUnderlined;
13752 lf.lfStrikeOut = tm.tmStruckOut;
f46e6225
GV		 13753 lf.lfCharSet = tm.tmCharSet;
13754 cf.Flags |= CF_INITTOLOGFONTSTRUCT;
13755 }
13756 SelectObject (hdc, oldobj);
6fc2811b 13757 ReleaseDC (FRAME_W32_WINDOW (f), hdc);
f46e6225 13758
767b1ff0 13759 if (!ChooseFont (&cf) || !w32_to_x_font (&lf, buf, 100, NULL))
3c190163 13760 return Qnil;
ee78dc32
GV		 13761
13762 return build_string (buf);
13763}
13764
74e1aeec
JR		 13765DEFUN ("w32-send-sys-command", Fw32_send_sys_command,
13766 Sw32_send_sys_command, 1, 2, 0,
13767 doc: /* Send frame a Windows WM_SYSCOMMAND message of type COMMAND.
13768Some useful values for command are 0xf030 to maximise frame (0xf020
13769to minimize), 0xf120 to restore frame to original size, and 0xf100
13770to activate the menubar for keyboard access. 0xf140 activates the
13771screen saver if defined.
13772
13773If optional parameter FRAME is not specified, use selected frame. */)
1edf84e7
GV		 13774 (command, frame)
13775 Lisp_Object command, frame;
13776{
1edf84e7
GV		 13777 FRAME_PTR f = check_x_frame (frame);
13778
b7826503 13779 CHECK_NUMBER (command);
1edf84e7 13780
ce6059da 13781 PostMessage (FRAME_W32_WINDOW (f), WM_SYSCOMMAND, XINT (command), 0);
1edf84e7
GV		 13782
13783 return Qnil;
13784}
13785
55dcfc15 13786DEFUN ("w32-shell-execute", Fw32_shell_execute, Sw32_shell_execute, 2, 4, 0,
74e1aeec
JR		 13787 doc: /* Get Windows to perform OPERATION on DOCUMENT.
13788This is a wrapper around the ShellExecute system function, which
13789invokes the application registered to handle OPERATION for DOCUMENT.
13790OPERATION is typically \"open\", \"print\" or \"explore\" (but can be
13791nil for the default action), and DOCUMENT is typically the name of a
13792document file or URL, but can also be a program executable to run or
13793a directory to open in the Windows Explorer.
13794
13795If DOCUMENT is a program executable, PARAMETERS can be a string
13796containing command line parameters, but otherwise should be nil.
13797
13798SHOW-FLAG can be used to control whether the invoked application is hidden
13799or minimized. If SHOW-FLAG is nil, the application is displayed normally,
13800otherwise it is an integer representing a ShowWindow flag:
13801
13802 0 - start hidden
13803 1 - start normally
13804 3 - start maximized
13805 6 - start minimized */)
55dcfc15
AI		 13806 (operation, document, parameters, show_flag)
13807 Lisp_Object operation, document, parameters, show_flag;
13808{
13809 Lisp_Object current_dir;
13810
b7826503 13811 CHECK_STRING (document);
55dcfc15
AI		 13812
13813 /* Encode filename and current directory. */
13814 current_dir = ENCODE_FILE (current_buffer->directory);
13815 document = ENCODE_FILE (document);
13816 if ((int) ShellExecute (NULL,
6fc2811b
JR		 13817 (STRINGP (operation) ?
13818 XSTRING (operation)->data : NULL),
55dcfc15
AI		 13819 XSTRING (document)->data,
13820 (STRINGP (parameters) ?
13821 XSTRING (parameters)->data : NULL),
13822 XSTRING (current_dir)->data,
13823 (INTEGERP (show_flag) ?
13824 XINT (show_flag) : SW_SHOWDEFAULT))
13825 > 32)
13826 return Qt;
90d97e64 13827 error ("ShellExecute failed: %s", w32_strerror (0));
55dcfc15
AI		 13828}
13829
ccc2d29c
GV		 13830/* Lookup virtual keycode from string representing the name of a
13831 non-ascii keystroke into the corresponding virtual key, using
13832 lispy_function_keys. */
13833static int
13834lookup_vk_code (char *key)
13835{
13836 int i;
13837
13838 for (i = 0; i < 256; i++)
13839 if (lispy_function_keys[i] != 0
13840 && strcmp (lispy_function_keys[i], key) == 0)
13841 return i;
13842
13843 return -1;
13844}
13845
13846/* Convert a one-element vector style key sequence to a hot key
13847 definition. */
13848static int
13849w32_parse_hot_key (key)
13850 Lisp_Object key;
13851{
13852 /* Copied from Fdefine_key and store_in_keymap. */
13853 register Lisp_Object c;
13854 int vk_code;
13855 int lisp_modifiers;
13856 int w32_modifiers;
13857 struct gcpro gcpro1;
13858
b7826503 13859 CHECK_VECTOR (key);
ccc2d29c
GV		 13860
13861 if (XFASTINT (Flength (key)) != 1)
13862 return Qnil;
13863
13864 GCPRO1 (key);
13865
13866 c = Faref (key, make_number (0));
13867
13868 if (CONSP (c) && lucid_event_type_list_p (c))
13869 c = Fevent_convert_list (c);
13870
13871 UNGCPRO;
13872
13873 if (! INTEGERP (c) && ! SYMBOLP (c))
13874 error ("Key definition is invalid");
13875
13876 /* Work out the base key and the modifiers. */
13877 if (SYMBOLP (c))
13878 {
13879 c = parse_modifiers (c);
13880 lisp_modifiers = Fcar (Fcdr (c));
13881 c = Fcar (c);
13882 if (!SYMBOLP (c))
13883 abort ();
13884 vk_code = lookup_vk_code (XSYMBOL (c)->name->data);
13885 }
13886 else if (INTEGERP (c))
13887 {
13888 lisp_modifiers = XINT (c) & ~CHARACTERBITS;
13889 /* Many ascii characters are their own virtual key code. */
13890 vk_code = XINT (c) & CHARACTERBITS;
13891 }
13892
13893 if (vk_code < 0 || vk_code > 255)
13894 return Qnil;
13895
13896 if ((lisp_modifiers & meta_modifier) != 0
13897 && !NILP (Vw32_alt_is_meta))
13898 lisp_modifiers |= alt_modifier;
13899
71eab8d1
AI		 13900 /* Supply defs missing from mingw32. */
13901#ifndef MOD_ALT
13902#define MOD_ALT 0x0001
13903#define MOD_CONTROL 0x0002
13904#define MOD_SHIFT 0x0004
13905#define MOD_WIN 0x0008
13906#endif
13907
ccc2d29c
GV		 13908 /* Convert lisp modifiers to Windows hot-key form. */
13909 w32_modifiers = (lisp_modifiers & hyper_modifier) ? MOD_WIN : 0;
13910 w32_modifiers |= (lisp_modifiers & alt_modifier) ? MOD_ALT : 0;
13911 w32_modifiers |= (lisp_modifiers & ctrl_modifier) ? MOD_CONTROL : 0;
13912 w32_modifiers |= (lisp_modifiers & shift_modifier) ? MOD_SHIFT : 0;
13913
13914 return HOTKEY (vk_code, w32_modifiers);
13915}
13916
74e1aeec
JR		 13917DEFUN ("w32-register-hot-key", Fw32_register_hot_key,
13918 Sw32_register_hot_key, 1, 1, 0,
13919 doc: /* Register KEY as a hot-key combination.
13920Certain key combinations like Alt-Tab are reserved for system use on
13921Windows, and therefore are normally intercepted by the system. However,
13922most of these key combinations can be received by registering them as
13923hot-keys, overriding their special meaning.
13924
13925KEY must be a one element key definition in vector form that would be
13926acceptable to `define-key' (e.g. [A-tab] for Alt-Tab). The meta
13927modifier is interpreted as Alt if `w32-alt-is-meta' is t, and hyper
13928is always interpreted as the Windows modifier keys.
13929
13930The return value is the hotkey-id if registered, otherwise nil. */)
ccc2d29c
GV		 13931 (key)
13932 Lisp_Object key;
13933{
13934 key = w32_parse_hot_key (key);
13935
13936 if (NILP (Fmemq (key, w32_grabbed_keys)))
13937 {
13938 /* Reuse an empty slot if possible. */
13939 Lisp_Object item = Fmemq (Qnil, w32_grabbed_keys);
13940
13941 /* Safe to add new key to list, even if we have focus. */
13942 if (NILP (item))
13943 w32_grabbed_keys = Fcons (key, w32_grabbed_keys);
13944 else
f3fbd155 13945 XSETCAR (item, key);
ccc2d29c
GV		 13946
13947 /* Notify input thread about new hot-key definition, so that it
13948 takes effect without needing to switch focus. */
13949 PostThreadMessage (dwWindowsThreadId, WM_EMACS_REGISTER_HOT_KEY,
13950 (WPARAM) key, 0);
13951 }
13952
13953 return key;
13954}
13955
74e1aeec
JR		 13956DEFUN ("w32-unregister-hot-key", Fw32_unregister_hot_key,
13957 Sw32_unregister_hot_key, 1, 1, 0,
13958 doc: /* Unregister HOTKEY as a hot-key combination. */)
ccc2d29c
GV		 13959 (key)
13960 Lisp_Object key;
13961{
13962 Lisp_Object item;
13963
13964 if (!INTEGERP (key))
13965 key = w32_parse_hot_key (key);
13966
13967 item = Fmemq (key, w32_grabbed_keys);
13968
13969 if (!NILP (item))
13970 {
13971 /* Notify input thread about hot-key definition being removed, so
13972 that it takes effect without needing focus switch. */
13973 if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_UNREGISTER_HOT_KEY,
13974 (WPARAM) XINT (XCAR (item)), (LPARAM) item))
13975 {
13976 MSG msg;
13977 GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
13978 }
13979 return Qt;
13980 }
13981 return Qnil;
13982}
13983
74e1aeec
JR		 13984DEFUN ("w32-registered-hot-keys", Fw32_registered_hot_keys,
13985 Sw32_registered_hot_keys, 0, 0, 0,
13986 doc: /* Return list of registered hot-key IDs. */)
ccc2d29c
GV		 13987 ()
13988{
13989 return Fcopy_sequence (w32_grabbed_keys);
13990}
13991
74e1aeec
JR		 13992DEFUN ("w32-reconstruct-hot-key", Fw32_reconstruct_hot_key,
13993 Sw32_reconstruct_hot_key, 1, 1, 0,
13994 doc: /* Convert hot-key ID to a lisp key combination. */)
ccc2d29c
GV		 13995 (hotkeyid)
13996 Lisp_Object hotkeyid;
13997{
13998 int vk_code, w32_modifiers;
13999 Lisp_Object key;
14000
b7826503 14001 CHECK_NUMBER (hotkeyid);
ccc2d29c
GV		 14002
14003 vk_code = HOTKEY_VK_CODE (hotkeyid);
14004 w32_modifiers = HOTKEY_MODIFIERS (hotkeyid);
14005
14006 if (lispy_function_keys[vk_code])
14007 key = intern (lispy_function_keys[vk_code]);
14008 else
14009 key = make_number (vk_code);
14010
14011 key = Fcons (key, Qnil);
14012 if (w32_modifiers & MOD_SHIFT)
3ef68e6b 14013 key = Fcons (Qshift, key);
ccc2d29c 14014 if (w32_modifiers & MOD_CONTROL)
3ef68e6b 14015 key = Fcons (Qctrl, key);
ccc2d29c 14016 if (w32_modifiers & MOD_ALT)
3ef68e6b 14017 key = Fcons (NILP (Vw32_alt_is_meta) ? Qalt : Qmeta, key);
ccc2d29c 14018 if (w32_modifiers & MOD_WIN)
3ef68e6b 14019 key = Fcons (Qhyper, key);
ccc2d29c
GV		 14020
14021 return key;
14022}
adcc3809 14023
74e1aeec
JR		 14024DEFUN ("w32-toggle-lock-key", Fw32_toggle_lock_key,
14025 Sw32_toggle_lock_key, 1, 2, 0,
14026 doc: /* Toggle the state of the lock key KEY.
14027KEY can be `capslock', `kp-numlock', or `scroll'.
14028If the optional parameter NEW-STATE is a number, then the state of KEY
14029is set to off if the low bit of NEW-STATE is zero, otherwise on. */)
adcc3809
GV		 14030 (key, new_state)
14031 Lisp_Object key, new_state;
14032{
14033 int vk_code;
adcc3809
GV		 14034
14035 if (EQ (key, intern ("capslock")))
14036 vk_code = VK_CAPITAL;
14037 else if (EQ (key, intern ("kp-numlock")))
14038 vk_code = VK_NUMLOCK;
14039 else if (EQ (key, intern ("scroll")))
14040 vk_code = VK_SCROLL;
14041 else
14042 return Qnil;
14043
14044 if (!dwWindowsThreadId)
14045 return make_number (w32_console_toggle_lock_key (vk_code, new_state));
14046
14047 if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_TOGGLE_LOCK_KEY,
14048 (WPARAM) vk_code, (LPARAM) new_state))
14049 {
14050 MSG msg;
14051 GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
14052 return make_number (msg.wParam);
14053 }
14054 return Qnil;
14055}
ee78dc32 14056\f
2254bcde 14057DEFUN ("file-system-info", Ffile_system_info, Sfile_system_info, 1, 1, 0,
74e1aeec
JR		 14058 doc: /* Return storage information about the file system FILENAME is on.
14059Value is a list of floats (TOTAL FREE AVAIL), where TOTAL is the total
14060storage of the file system, FREE is the free storage, and AVAIL is the
14061storage available to a non-superuser. All 3 numbers are in bytes.
14062If the underlying system call fails, value is nil. */)
2254bcde
AI		 14063 (filename)
14064 Lisp_Object filename;
14065{
14066 Lisp_Object encoded, value;
14067
b7826503 14068 CHECK_STRING (filename);
2254bcde
AI		 14069 filename = Fexpand_file_name (filename, Qnil);
14070 encoded = ENCODE_FILE (filename);
14071
14072 value = Qnil;
14073
14074 /* Determining the required information on Windows turns out, sadly,
14075 to be more involved than one would hope. The original Win32 api
14076 call for this will return bogus information on some systems, but we
14077 must dynamically probe for the replacement api, since that was
14078 added rather late on. */
14079 {
14080 HMODULE hKernel = GetModuleHandle ("kernel32");
14081 BOOL (*pfn_GetDiskFreeSpaceEx)
14082 (char *, PULARGE_INTEGER, PULARGE_INTEGER, PULARGE_INTEGER)
14083 = (void *) GetProcAddress (hKernel, "GetDiskFreeSpaceEx");
14084
14085 /* On Windows, we may need to specify the root directory of the
14086 volume holding FILENAME. */
14087 char rootname[MAX_PATH];
14088 char *name = XSTRING (encoded)->data;
14089
14090 /* find the root name of the volume if given */
14091 if (isalpha (name[0]) && name[1] == ':')
14092 {
14093 rootname[0] = name[0];
14094 rootname[1] = name[1];
14095 rootname[2] = '\\';
14096 rootname[3] = 0;
14097 }
14098 else if (IS_DIRECTORY_SEP (name[0]) && IS_DIRECTORY_SEP (name[1]))
14099 {
14100 char *str = rootname;
14101 int slashes = 4;
14102 do
14103 {
14104 if (IS_DIRECTORY_SEP (*name) && --slashes == 0)
14105 break;
14106 *str++ = *name++;
14107 }
14108 while ( *name );
14109
14110 *str++ = '\\';
14111 *str = 0;
14112 }
14113
14114 if (pfn_GetDiskFreeSpaceEx)
14115 {
14116 LARGE_INTEGER availbytes;
14117 LARGE_INTEGER freebytes;
14118 LARGE_INTEGER totalbytes;
14119
14120 if (pfn_GetDiskFreeSpaceEx(rootname,
14121 &availbytes,
14122 &totalbytes,
14123 &freebytes))
14124 value = list3 (make_float ((double) totalbytes.QuadPart),
14125 make_float ((double) freebytes.QuadPart),
14126 make_float ((double) availbytes.QuadPart));
14127 }
14128 else
14129 {
14130 DWORD sectors_per_cluster;
14131 DWORD bytes_per_sector;
14132 DWORD free_clusters;
14133 DWORD total_clusters;
14134
14135 if (GetDiskFreeSpace(rootname,
14136 &sectors_per_cluster,
14137 &bytes_per_sector,
14138 &free_clusters,
14139 &total_clusters))
14140 value = list3 (make_float ((double) total_clusters
14141 * sectors_per_cluster * bytes_per_sector),
14142 make_float ((double) free_clusters
14143 * sectors_per_cluster * bytes_per_sector),
14144 make_float ((double) free_clusters
14145 * sectors_per_cluster * bytes_per_sector));
14146 }
14147 }
14148
14149 return value;
14150}
14151\f
fbd6baed 14152syms_of_w32fns ()
ee78dc32 14153{
1edf84e7
GV		 14154 /* This is zero if not using MS-Windows. */
14155 w32_in_use = 0;
14156
ee78dc32
GV		 14157 /* The section below is built by the lisp expression at the top of the file,
14158 just above where these variables are declared. */
14159 /*&&& init symbols here &&&*/
14160 Qauto_raise = intern ("auto-raise");
14161 staticpro (&Qauto_raise);
14162 Qauto_lower = intern ("auto-lower");
14163 staticpro (&Qauto_lower);
ee78dc32
GV		 14164 Qbar = intern ("bar");
14165 staticpro (&Qbar);
14166 Qborder_color = intern ("border-color");
14167 staticpro (&Qborder_color);
14168 Qborder_width = intern ("border-width");
14169 staticpro (&Qborder_width);
14170 Qbox = intern ("box");
14171 staticpro (&Qbox);
14172 Qcursor_color = intern ("cursor-color");
14173 staticpro (&Qcursor_color);
14174 Qcursor_type = intern ("cursor-type");
14175 staticpro (&Qcursor_type);
ee78dc32
GV		 14176 Qgeometry = intern ("geometry");
14177 staticpro (&Qgeometry);
14178 Qicon_left = intern ("icon-left");
14179 staticpro (&Qicon_left);
14180 Qicon_top = intern ("icon-top");
14181 staticpro (&Qicon_top);
14182 Qicon_type = intern ("icon-type");
14183 staticpro (&Qicon_type);
14184 Qicon_name = intern ("icon-name");
14185 staticpro (&Qicon_name);
14186 Qinternal_border_width = intern ("internal-border-width");
14187 staticpro (&Qinternal_border_width);
14188 Qleft = intern ("left");
14189 staticpro (&Qleft);
1026b400
RS		 14190 Qright = intern ("right");
14191 staticpro (&Qright);
ee78dc32
GV		 14192 Qmouse_color = intern ("mouse-color");
14193 staticpro (&Qmouse_color);
14194 Qnone = intern ("none");
14195 staticpro (&Qnone);
14196 Qparent_id = intern ("parent-id");
14197 staticpro (&Qparent_id);
14198 Qscroll_bar_width = intern ("scroll-bar-width");
14199 staticpro (&Qscroll_bar_width);
14200 Qsuppress_icon = intern ("suppress-icon");
14201 staticpro (&Qsuppress_icon);
ee78dc32
GV		 14202 Qundefined_color = intern ("undefined-color");
14203 staticpro (&Qundefined_color);
14204 Qvertical_scroll_bars = intern ("vertical-scroll-bars");
14205 staticpro (&Qvertical_scroll_bars);
14206 Qvisibility = intern ("visibility");
14207 staticpro (&Qvisibility);
14208 Qwindow_id = intern ("window-id");
14209 staticpro (&Qwindow_id);
14210 Qx_frame_parameter = intern ("x-frame-parameter");
14211 staticpro (&Qx_frame_parameter);
14212 Qx_resource_name = intern ("x-resource-name");
14213 staticpro (&Qx_resource_name);
14214 Quser_position = intern ("user-position");
14215 staticpro (&Quser_position);
14216 Quser_size = intern ("user-size");
14217 staticpro (&Quser_size);
6fc2811b
JR		 14218 Qscreen_gamma = intern ("screen-gamma");
14219 staticpro (&Qscreen_gamma);
dfff8a69
JR		 14220 Qline_spacing = intern ("line-spacing");
14221 staticpro (&Qline_spacing);
14222 Qcenter = intern ("center");
14223 staticpro (&Qcenter);
dc220243
JR		 14224 Qcancel_timer = intern ("cancel-timer");
14225 staticpro (&Qcancel_timer);
ee78dc32
GV		 14226 /* This is the end of symbol initialization. */
14227
adcc3809
GV		 14228 Qhyper = intern ("hyper");
14229 staticpro (&Qhyper);
14230 Qsuper = intern ("super");
14231 staticpro (&Qsuper);
14232 Qmeta = intern ("meta");
14233 staticpro (&Qmeta);
14234 Qalt = intern ("alt");
14235 staticpro (&Qalt);
14236 Qctrl = intern ("ctrl");
14237 staticpro (&Qctrl);
14238 Qcontrol = intern ("control");
14239 staticpro (&Qcontrol);
14240 Qshift = intern ("shift");
14241 staticpro (&Qshift);
14242
6fc2811b
JR		 14243 /* Text property `display' should be nonsticky by default. */
14244 Vtext_property_default_nonsticky
14245 = Fcons (Fcons (Qdisplay, Qt), Vtext_property_default_nonsticky);
14246
14247
14248 Qlaplace = intern ("laplace");
14249 staticpro (&Qlaplace);
3cf3436e
JR		 14250 Qemboss = intern ("emboss");
14251 staticpro (&Qemboss);
14252 Qedge_detection = intern ("edge-detection");
14253 staticpro (&Qedge_detection);
14254 Qheuristic = intern ("heuristic");
14255 staticpro (&Qheuristic);
14256 QCmatrix = intern (":matrix");
14257 staticpro (&QCmatrix);
14258 QCcolor_adjustment = intern (":color-adjustment");
14259 staticpro (&QCcolor_adjustment);
14260 QCmask = intern (":mask");
14261 staticpro (&QCmask);
6fc2811b 14262
4b817373
RS		 14263 Qface_set_after_frame_default = intern ("face-set-after-frame-default");
14264 staticpro (&Qface_set_after_frame_default);
14265
ee78dc32
GV		 14266 Fput (Qundefined_color, Qerror_conditions,
14267 Fcons (Qundefined_color, Fcons (Qerror, Qnil)));
14268 Fput (Qundefined_color, Qerror_message,
14269 build_string ("Undefined color"));
14270
ccc2d29c
GV		 14271 staticpro (&w32_grabbed_keys);
14272 w32_grabbed_keys = Qnil;
14273
fbd6baed 14274 DEFVAR_LISP ("w32-color-map", &Vw32_color_map,
74e1aeec 14275 doc: /* An array of color name mappings for windows. */);
fbd6baed 14276 Vw32_color_map = Qnil;
ee78dc32 14277
fbd6baed 14278 DEFVAR_LISP ("w32-pass-alt-to-system", &Vw32_pass_alt_to_system,
74e1aeec
JR		 14279 doc: /* Non-nil if alt key presses are passed on to Windows.
14280When non-nil, for example, alt pressed and released and then space will
14281open the System menu. When nil, Emacs silently swallows alt key events. */);
fbd6baed 14282 Vw32_pass_alt_to_system = Qnil;
da36a4d6 14283
fbd6baed 14284 DEFVAR_LISP ("w32-alt-is-meta", &Vw32_alt_is_meta,
74e1aeec
JR		 14285 doc: /* Non-nil if the alt key is to be considered the same as the meta key.
14286When nil, Emacs will translate the alt key to the Alt modifier, and not Meta. */);
fbd6baed 14287 Vw32_alt_is_meta = Qt;
8c205c63 14288
7d081355 14289 DEFVAR_INT ("w32-quit-key", &Vw32_quit_key,
74e1aeec 14290 doc: /* If non-zero, the virtual key code for an alternative quit key. */);
7d081355
AI		 14291 XSETINT (Vw32_quit_key, 0);
14292
ccc2d29c
GV		 14293 DEFVAR_LISP ("w32-pass-lwindow-to-system",
14294 &Vw32_pass_lwindow_to_system,
74e1aeec
JR		 14295 doc: /* Non-nil if the left \"Windows\" key is passed on to Windows.
14296When non-nil, the Start menu is opened by tapping the key. */);
ccc2d29c
GV		 14297 Vw32_pass_lwindow_to_system = Qt;
14298
14299 DEFVAR_LISP ("w32-pass-rwindow-to-system",
14300 &Vw32_pass_rwindow_to_system,
74e1aeec
JR		 14301 doc: /* Non-nil if the right \"Windows\" key is passed on to Windows.
14302When non-nil, the Start menu is opened by tapping the key. */);
ccc2d29c
GV		 14303 Vw32_pass_rwindow_to_system = Qt;
14304
adcc3809
GV		 14305 DEFVAR_INT ("w32-phantom-key-code",
14306 &Vw32_phantom_key_code,
74e1aeec
JR		 14307 doc: /* Virtual key code used to generate \"phantom\" key presses.
14308Value is a number between 0 and 255.
14309
14310Phantom key presses are generated in order to stop the system from
14311acting on \"Windows\" key events when `w32-pass-lwindow-to-system' or
14312`w32-pass-rwindow-to-system' is nil. */);
ce6059da
AI		 14313 /* Although 255 is technically not a valid key code, it works and
14314 means that this hack won't interfere with any real key code. */
14315 Vw32_phantom_key_code = 255;
adcc3809 14316
ccc2d29c
GV		 14317 DEFVAR_LISP ("w32-enable-num-lock",
14318 &Vw32_enable_num_lock,
74e1aeec
JR		 14319 doc: /* Non-nil if Num Lock should act normally.
14320Set to nil to see Num Lock as the key `kp-numlock'. */);
ccc2d29c
GV		 14321 Vw32_enable_num_lock = Qt;
14322
14323 DEFVAR_LISP ("w32-enable-caps-lock",
14324 &Vw32_enable_caps_lock,
74e1aeec
JR		 14325 doc: /* Non-nil if Caps Lock should act normally.
14326Set to nil to see Caps Lock as the key `capslock'. */);
ccc2d29c
GV		 14327 Vw32_enable_caps_lock = Qt;
14328
14329 DEFVAR_LISP ("w32-scroll-lock-modifier",
14330 &Vw32_scroll_lock_modifier,
74e1aeec
JR		 14331 doc: /* Modifier to use for the Scroll Lock on state.
14332The value can be hyper, super, meta, alt, control or shift for the
14333respective modifier, or nil to see Scroll Lock as the key `scroll'.
14334Any other value will cause the key to be ignored. */);
ccc2d29c
GV		 14335 Vw32_scroll_lock_modifier = Qt;
14336
14337 DEFVAR_LISP ("w32-lwindow-modifier",
14338 &Vw32_lwindow_modifier,
74e1aeec
JR		 14339 doc: /* Modifier to use for the left \"Windows\" key.
14340The value can be hyper, super, meta, alt, control or shift for the
14341respective modifier, or nil to appear as the key `lwindow'.
14342Any other value will cause the key to be ignored. */);
ccc2d29c
GV		 14343 Vw32_lwindow_modifier = Qnil;
14344
14345 DEFVAR_LISP ("w32-rwindow-modifier",
14346 &Vw32_rwindow_modifier,
74e1aeec
JR		 14347 doc: /* Modifier to use for the right \"Windows\" key.
14348The value can be hyper, super, meta, alt, control or shift for the
14349respective modifier, or nil to appear as the key `rwindow'.
14350Any other value will cause the key to be ignored. */);
ccc2d29c
GV		 14351 Vw32_rwindow_modifier = Qnil;
14352
14353 DEFVAR_LISP ("w32-apps-modifier",
14354 &Vw32_apps_modifier,
74e1aeec
JR		 14355 doc: /* Modifier to use for the \"Apps\" key.
14356The value can be hyper, super, meta, alt, control or shift for the
14357respective modifier, or nil to appear as the key `apps'.
14358Any other value will cause the key to be ignored. */);
ccc2d29c 14359 Vw32_apps_modifier = Qnil;
da36a4d6 14360
212da13b 14361 DEFVAR_LISP ("w32-enable-synthesized-fonts", &Vw32_enable_synthesized_fonts,
74e1aeec 14362 doc: /* Non-nil enables selection of artificially italicized and bold fonts. */);
6fc2811b 14363 Vw32_enable_synthesized_fonts = Qnil;
5ac45f98 14364
fbd6baed 14365 DEFVAR_LISP ("w32-enable-palette", &Vw32_enable_palette,
74e1aeec 14366 doc: /* Non-nil enables Windows palette management to map colors exactly. */);
fbd6baed 14367 Vw32_enable_palette = Qt;
5ac45f98 14368
fbd6baed
GV		 14369 DEFVAR_INT ("w32-mouse-button-tolerance",
14370 &Vw32_mouse_button_tolerance,
74e1aeec
JR		 14371 doc: /* Analogue of double click interval for faking middle mouse events.
14372The value is the minimum time in milliseconds that must elapse between
14373left/right button down events before they are considered distinct events.
14374If both mouse buttons are depressed within this interval, a middle mouse
14375button down event is generated instead. */);
fbd6baed 14376 XSETINT (Vw32_mouse_button_tolerance, GetDoubleClickTime () / 2);
5ac45f98 14377
fbd6baed
GV		 14378 DEFVAR_INT ("w32-mouse-move-interval",
14379 &Vw32_mouse_move_interval,
74e1aeec
JR		 14380 doc: /* Minimum interval between mouse move events.
14381The value is the minimum time in milliseconds that must elapse between
14382successive mouse move (or scroll bar drag) events before they are
14383reported as lisp events. */);
247be837 14384 XSETINT (Vw32_mouse_move_interval, 0);
84fb1139 14385
ee78dc32
GV		 14386 init_x_parm_symbols ();
14387
14388 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path,
74e1aeec 14389 doc: /* List of directories to search for bitmap files for w32. */);
ee78dc32
GV		 14390 Vx_bitmap_file_path = decode_env_path ((char *) 0, "PATH");
14391
14392 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape,
74e1aeec
JR		 14393 doc: /* The shape of the pointer when over text.
14394Changing the value does not affect existing frames
14395unless you set the mouse color. */);
ee78dc32
GV		 14396 Vx_pointer_shape = Qnil;
14397
14398 DEFVAR_LISP ("x-resource-name", &Vx_resource_name,
74e1aeec
JR		 14399 doc: /* The name Emacs uses to look up resources; for internal use only.
14400`x-get-resource' uses this as the first component of the instance name
14401when requesting resource values.
14402Emacs initially sets `x-resource-name' to the name under which Emacs
14403was invoked, or to the value specified with the `-name' or `-rn'
14404switches, if present. */);
ee78dc32
GV		 14405 Vx_resource_name = Qnil;
14406
14407 Vx_nontext_pointer_shape = Qnil;
14408
14409 Vx_mode_pointer_shape = Qnil;
14410
0af913d7 14411 DEFVAR_LISP ("x-hourglass-pointer-shape", &Vx_hourglass_pointer_shape,
74e1aeec
JR		 14412 doc: /* The shape of the pointer when Emacs is busy.
14413This variable takes effect when you create a new frame
14414or when you set the mouse color. */);
0af913d7 14415 Vx_hourglass_pointer_shape = Qnil;
6fc2811b 14416
0af913d7 14417 DEFVAR_BOOL ("display-hourglass", &display_hourglass_p,
74e1aeec 14418 doc: /* Non-zero means Emacs displays an hourglass pointer on window systems. */);
0af913d7 14419 display_hourglass_p = 1;
6fc2811b 14420
0af913d7 14421 DEFVAR_LISP ("hourglass-delay", &Vhourglass_delay,
74e1aeec
JR		 14422 doc: /* *Seconds to wait before displaying an hourglass pointer.
14423Value must be an integer or float. */);
0af913d7 14424 Vhourglass_delay = make_number (DEFAULT_HOURGLASS_DELAY);
f79e6790 14425
6fc2811b 14426 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
ee78dc32 14427 &Vx_sensitive_text_pointer_shape,
74e1aeec
JR		 14428 doc: /* The shape of the pointer when over mouse-sensitive text.
14429This variable takes effect when you create a new frame
14430or when you set the mouse color. */);
ee78dc32
GV		 14431 Vx_sensitive_text_pointer_shape = Qnil;
14432
4694d762
JR		 14433 DEFVAR_LISP ("x-window-horizontal-drag-cursor",
14434 &Vx_window_horizontal_drag_shape,
74e1aeec
JR		 14435 doc: /* Pointer shape to use for indicating a window can be dragged horizontally.
14436This variable takes effect when you create a new frame
14437or when you set the mouse color. */);
4694d762
JR		 14438 Vx_window_horizontal_drag_shape = Qnil;
14439
ee78dc32 14440 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel,
74e1aeec 14441 doc: /* A string indicating the foreground color of the cursor box. */);
ee78dc32
GV		 14442 Vx_cursor_fore_pixel = Qnil;
14443
3cf3436e 14444 DEFVAR_LISP ("x-max-tooltip-size", &Vx_max_tooltip_size,
b3700ae7
JR		 14445 doc: /* Maximum size for tooltips.
14446Value is a pair (COLUMNS . ROWS). Text larger than this is clipped. */);
3cf3436e
JR		 14447 Vx_max_tooltip_size = Fcons (make_number (80), make_number (40));
14448
ee78dc32 14449 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager,
74e1aeec
JR		 14450 doc: /* Non-nil if no window manager is in use.
14451Emacs doesn't try to figure this out; this is always nil
14452unless you set it to something else. */);
ee78dc32
GV		 14453 /* We don't have any way to find this out, so set it to nil
14454 and maybe the user would like to set it to t. */
14455 Vx_no_window_manager = Qnil;
14456
4587b026
GV		 14457 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
14458 &Vx_pixel_size_width_font_regexp,
74e1aeec
JR		 14459 doc: /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'.
14460
14461Since Emacs gets width of a font matching with this regexp from
14462PIXEL_SIZE field of the name, font finding mechanism gets faster for
14463such a font. This is especially effective for such large fonts as
14464Chinese, Japanese, and Korean. */);
4587b026
GV		 14465 Vx_pixel_size_width_font_regexp = Qnil;
14466
6fc2811b 14467 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay,
74e1aeec
JR		 14468 doc: /* Time after which cached images are removed from the cache.
14469When an image has not been displayed this many seconds, remove it
14470from the image cache. Value must be an integer or nil with nil
14471meaning don't clear the cache. */);
6fc2811b
JR		 14472 Vimage_cache_eviction_delay = make_number (30 * 60);
14473
33d52f9c
GV		 14474 DEFVAR_LISP ("w32-bdf-filename-alist",
14475 &Vw32_bdf_filename_alist,
74e1aeec 14476 doc: /* List of bdf fonts and their corresponding filenames. */);
33d52f9c
GV		 14477 Vw32_bdf_filename_alist = Qnil;
14478
1075afa9
GV		 14479 DEFVAR_BOOL ("w32-strict-fontnames",
14480 &w32_strict_fontnames,
74e1aeec
JR		 14481 doc: /* Non-nil means only use fonts that are exact matches for those requested.
14482Default is nil, which allows old fontnames that are not XLFD compliant,
14483and allows third-party CJK display to work by specifying false charset
14484fields to trick Emacs into translating to Big5, SJIS etc.
14485Setting this to t will prevent wrong fonts being selected when
14486fontsets are automatically created. */);
1075afa9
GV		 14487 w32_strict_fontnames = 0;
14488
c0611964
AI		 14489 DEFVAR_BOOL ("w32-strict-painting",
14490 &w32_strict_painting,
74e1aeec
JR		 14491 doc: /* Non-nil means use strict rules for repainting frames.
14492Set this to nil to get the old behaviour for repainting; this should
14493only be necessary if the default setting causes problems. */);
c0611964
AI		 14494 w32_strict_painting = 1;
14495
f46e6225
GV		 14496 DEFVAR_LISP ("w32-system-coding-system",
14497 &Vw32_system_coding_system,
74e1aeec 14498 doc: /* Coding system used by Windows system functions, such as for font names. */);
f46e6225
GV		 14499 Vw32_system_coding_system = Qnil;
14500
dfff8a69
JR		 14501 DEFVAR_LISP ("w32-charset-info-alist",
14502 &Vw32_charset_info_alist,
b3700ae7
JR		 14503 doc: /* Alist linking Emacs character sets to Windows fonts and codepages.
14504Each entry should be of the form:
74e1aeec
JR		 14505
14506 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE))
14507
14508where CHARSET_NAME is a string used in font names to identify the charset,
14509WINDOWS_CHARSET is a symbol that can be one of:
14510w32-charset-ansi, w32-charset-default, w32-charset-symbol,
14511w32-charset-shiftjis, w32-charset-hangeul, w32-charset-gb2312,
14512w32-charset-chinesebig5,
dfff8a69 14513#ifdef JOHAB_CHARSET
74e1aeec
JR		 14514w32-charset-johab, w32-charset-hebrew,
14515w32-charset-arabic, w32-charset-greek, w32-charset-turkish,
14516w32-charset-vietnamese, w32-charset-thai, w32-charset-easteurope,
14517w32-charset-russian, w32-charset-mac, w32-charset-baltic,
dfff8a69
JR		 14518#endif
14519#ifdef UNICODE_CHARSET
74e1aeec 14520w32-charset-unicode,
dfff8a69 14521#endif
74e1aeec
JR		 14522or w32-charset-oem.
14523CODEPAGE should be an integer specifying the codepage that should be used
14524to display the character set, t to do no translation and output as Unicode,
14525or nil to do no translation and output as 8 bit (or multibyte on far-east
14526versions of Windows) characters. */);
dfff8a69
JR		 14527 Vw32_charset_info_alist = Qnil;
14528
14529 staticpro (&Qw32_charset_ansi);
14530 Qw32_charset_ansi = intern ("w32-charset-ansi");
14531 staticpro (&Qw32_charset_symbol);
14532 Qw32_charset_symbol = intern ("w32-charset-symbol");
14533 staticpro (&Qw32_charset_shiftjis);
14534 Qw32_charset_shiftjis = intern ("w32-charset-shiftjis");
767b1ff0
JR		 14535 staticpro (&Qw32_charset_hangeul);
14536 Qw32_charset_hangeul = intern ("w32-charset-hangeul");
dfff8a69
JR		 14537 staticpro (&Qw32_charset_chinesebig5);
14538 Qw32_charset_chinesebig5 = intern ("w32-charset-chinesebig5");
14539 staticpro (&Qw32_charset_gb2312);
14540 Qw32_charset_gb2312 = intern ("w32-charset-gb2312");
14541 staticpro (&Qw32_charset_oem);
14542 Qw32_charset_oem = intern ("w32-charset-oem");
14543
14544#ifdef JOHAB_CHARSET
14545 {
14546 static int w32_extra_charsets_defined = 1;
74e1aeec
JR		 14547 DEFVAR_BOOL ("w32-extra-charsets-defined", &w32_extra_charsets_defined,
14548 doc: /* Internal variable. */);
dfff8a69
JR		 14549
14550 staticpro (&Qw32_charset_johab);
14551 Qw32_charset_johab = intern ("w32-charset-johab");
14552 staticpro (&Qw32_charset_easteurope);
14553 Qw32_charset_easteurope = intern ("w32-charset-easteurope");
14554 staticpro (&Qw32_charset_turkish);
14555 Qw32_charset_turkish = intern ("w32-charset-turkish");
14556 staticpro (&Qw32_charset_baltic);
14557 Qw32_charset_baltic = intern ("w32-charset-baltic");
14558 staticpro (&Qw32_charset_russian);
14559 Qw32_charset_russian = intern ("w32-charset-russian");
14560 staticpro (&Qw32_charset_arabic);
14561 Qw32_charset_arabic = intern ("w32-charset-arabic");
14562 staticpro (&Qw32_charset_greek);
14563 Qw32_charset_greek = intern ("w32-charset-greek");
14564 staticpro (&Qw32_charset_hebrew);
14565 Qw32_charset_hebrew = intern ("w32-charset-hebrew");
767b1ff0
JR		 14566 staticpro (&Qw32_charset_vietnamese);
14567 Qw32_charset_vietnamese = intern ("w32-charset-vietnamese");
dfff8a69
JR		 14568 staticpro (&Qw32_charset_thai);
14569 Qw32_charset_thai = intern ("w32-charset-thai");
14570 staticpro (&Qw32_charset_mac);
14571 Qw32_charset_mac = intern ("w32-charset-mac");
14572 }
14573#endif
14574
14575#ifdef UNICODE_CHARSET
14576 {
14577 static int w32_unicode_charset_defined = 1;
14578 DEFVAR_BOOL ("w32-unicode-charset-defined",
74e1aeec
JR		 14579 &w32_unicode_charset_defined,
14580 doc: /* Internal variable. */);
dfff8a69
JR		 14581
14582 staticpro (&Qw32_charset_unicode);
14583 Qw32_charset_unicode = intern ("w32-charset-unicode");
14584#endif
14585
ee78dc32 14586 defsubr (&Sx_get_resource);
767b1ff0 14587#if 0 /* TODO: Port to W32 */
6fc2811b
JR		 14588 defsubr (&Sx_change_window_property);
14589 defsubr (&Sx_delete_window_property);
14590 defsubr (&Sx_window_property);
14591#endif
2d764c78 14592 defsubr (&Sxw_display_color_p);
ee78dc32 14593 defsubr (&Sx_display_grayscale_p);
2d764c78
EZ		 14594 defsubr (&Sxw_color_defined_p);
14595 defsubr (&Sxw_color_values);
ee78dc32
GV		 14596 defsubr (&Sx_server_max_request_size);
14597 defsubr (&Sx_server_vendor);
14598 defsubr (&Sx_server_version);
14599 defsubr (&Sx_display_pixel_width);
14600 defsubr (&Sx_display_pixel_height);
14601 defsubr (&Sx_display_mm_width);
14602 defsubr (&Sx_display_mm_height);
14603 defsubr (&Sx_display_screens);
14604 defsubr (&Sx_display_planes);
14605 defsubr (&Sx_display_color_cells);
14606 defsubr (&Sx_display_visual_class);
14607 defsubr (&Sx_display_backing_store);
14608 defsubr (&Sx_display_save_under);
14609 defsubr (&Sx_parse_geometry);
14610 defsubr (&Sx_create_frame);
ee78dc32
GV		 14611 defsubr (&Sx_open_connection);
14612 defsubr (&Sx_close_connection);
14613 defsubr (&Sx_display_list);
14614 defsubr (&Sx_synchronize);
14615
fbd6baed 14616 /* W32 specific functions */
ee78dc32 14617
1edf84e7 14618 defsubr (&Sw32_focus_frame);
fbd6baed
GV		 14619 defsubr (&Sw32_select_font);
14620 defsubr (&Sw32_define_rgb_color);
14621 defsubr (&Sw32_default_color_map);
14622 defsubr (&Sw32_load_color_file);
1edf84e7 14623 defsubr (&Sw32_send_sys_command);
55dcfc15 14624 defsubr (&Sw32_shell_execute);
ccc2d29c
GV		 14625 defsubr (&Sw32_register_hot_key);
14626 defsubr (&Sw32_unregister_hot_key);
14627 defsubr (&Sw32_registered_hot_keys);
14628 defsubr (&Sw32_reconstruct_hot_key);
adcc3809 14629 defsubr (&Sw32_toggle_lock_key);
33d52f9c 14630 defsubr (&Sw32_find_bdf_fonts);
4587b026 14631
2254bcde
AI		 14632 defsubr (&Sfile_system_info);
14633
4587b026
GV		 14634 /* Setting callback functions for fontset handler. */
14635 get_font_info_func = w32_get_font_info;
6fc2811b
JR		 14636
14637#if 0 /* This function pointer doesn't seem to be used anywhere.
14638 And the pointer assigned has the wrong type, anyway. */
4587b026 14639 list_fonts_func = w32_list_fonts;
6fc2811b
JR		 14640#endif
14641
4587b026
GV		 14642 load_font_func = w32_load_font;
14643 find_ccl_program_func = w32_find_ccl_program;
14644 query_font_func = w32_query_font;
14645 set_frame_fontset_func = x_set_font;
14646 check_window_system_func = check_w32;
6fc2811b 14647
767b1ff0 14648#if 0 /* TODO Image support for W32 */
6fc2811b
JR		 14649 /* Images. */
14650 Qxbm = intern ("xbm");
14651 staticpro (&Qxbm);
14652 QCtype = intern (":type");
14653 staticpro (&QCtype);
a93f4566
GM		 14654 QCconversion = intern (":conversion");
14655 staticpro (&QCconversion);
6fc2811b
JR		 14656 QCheuristic_mask = intern (":heuristic-mask");
14657 staticpro (&QCheuristic_mask);
14658 QCcolor_symbols = intern (":color-symbols");
14659 staticpro (&QCcolor_symbols);
6fc2811b
JR		 14660 QCascent = intern (":ascent");
14661 staticpro (&QCascent);
14662 QCmargin = intern (":margin");
14663 staticpro (&QCmargin);
14664 QCrelief = intern (":relief");
14665 staticpro (&QCrelief);
14666 Qpostscript = intern ("postscript");
14667 staticpro (&Qpostscript);
14668 QCloader = intern (":loader");
14669 staticpro (&QCloader);
14670 QCbounding_box = intern (":bounding-box");
14671 staticpro (&QCbounding_box);
14672 QCpt_width = intern (":pt-width");
14673 staticpro (&QCpt_width);
14674 QCpt_height = intern (":pt-height");
14675 staticpro (&QCpt_height);
14676 QCindex = intern (":index");
14677 staticpro (&QCindex);
14678 Qpbm = intern ("pbm");
14679 staticpro (&Qpbm);
14680
14681#if HAVE_XPM
14682 Qxpm = intern ("xpm");
14683 staticpro (&Qxpm);
14684#endif
14685
14686#if HAVE_JPEG
14687 Qjpeg = intern ("jpeg");
14688 staticpro (&Qjpeg);
14689#endif
14690
14691#if HAVE_TIFF
14692 Qtiff = intern ("tiff");
14693 staticpro (&Qtiff);
14694#endif
14695
14696#if HAVE_GIF
14697 Qgif = intern ("gif");
14698 staticpro (&Qgif);
14699#endif
14700
14701#if HAVE_PNG
14702 Qpng = intern ("png");
14703 staticpro (&Qpng);
14704#endif
14705
14706 defsubr (&Sclear_image_cache);
14707
14708#if GLYPH_DEBUG
14709 defsubr (&Simagep);
14710 defsubr (&Slookup_image);
14711#endif
767b1ff0 14712#endif /* TODO */
6fc2811b 14713
0af913d7
GM		 14714 hourglass_atimer = NULL;
14715 hourglass_shown_p = 0;
767b1ff0 14716#ifdef TODO /* Tooltip support not complete. */
6fc2811b
JR		 14717 defsubr (&Sx_show_tip);
14718 defsubr (&Sx_hide_tip);
767b1ff0 14719#endif
6fc2811b 14720 tip_timer = Qnil;
57fa2774
JR		 14721 staticpro (&tip_timer);
14722 tip_frame = Qnil;
14723 staticpro (&tip_frame);
6fc2811b
JR		 14724
14725 defsubr (&Sx_file_dialog);
14726}
14727
14728
14729void
14730init_xfns ()
14731{
14732 image_types = NULL;
14733 Vimage_types = Qnil;
14734
767b1ff0 14735#if 0 /* TODO : Image support for W32 */
6fc2811b
JR		 14736 define_image_type (&xbm_type);
14737 define_image_type (&gs_type);
14738 define_image_type (&pbm_type);
14739
14740#if HAVE_XPM
14741 define_image_type (&xpm_type);
14742#endif
14743
14744#if HAVE_JPEG
14745 define_image_type (&jpeg_type);
14746#endif
14747
14748#if HAVE_TIFF
14749 define_image_type (&tiff_type);
14750#endif
14751
14752#if HAVE_GIF
14753 define_image_type (&gif_type);
14754#endif
14755
14756#if HAVE_PNG
14757 define_image_type (&png_type);
14758#endif
767b1ff0 14759#endif /* TODO */
ee78dc32
GV		 14760}
14761
14762#undef abort
14763
14764void
fbd6baed 14765w32_abort()
ee78dc32 14766{
5ac45f98
GV		 14767 int button;
14768 button = MessageBox (NULL,
14769 "A fatal error has occurred!\n\n"
14770 "Select Abort to exit, Retry to debug, Ignore to continue",
14771 "Emacs Abort Dialog",
14772 MB_ICONEXCLAMATION | MB_TASKMODAL
14773 | MB_SETFOREGROUND | MB_ABORTRETRYIGNORE);
14774 switch (button)
14775 {
14776 case IDRETRY:
14777 DebugBreak ();
14778 break;
14779 case IDIGNORE:
14780 break;
14781 case IDABORT:
14782 default:
14783 abort ();
14784 break;
14785 }
ee78dc32 14786}
d573caac 14787
83c75055
GV		 14788/* For convenience when debugging. */
14789int
14790w32_last_error()
14791{
14792 return GetLastError ();
14793}
Unnamed repository; edit this file 'description' to name the repository.