Upgraded to mh-e version 6.1.1.
[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
1030b26b
JR
55#include <dlgs.h>
56#define FILE_NAME_TEXT_FIELD edt1
57
ee78dc32 58extern void free_frame_menubar ();
9eb16b62 59extern void x_compute_fringe_widths P_ ((struct frame *, int));
6fc2811b 60extern double atof ();
9eb16b62
JR
61extern int w32_console_toggle_lock_key P_ ((int, Lisp_Object));
62extern void w32_menu_display_help P_ ((HWND, HMENU, UINT, UINT));
63extern void w32_free_menu_strings P_ ((HWND));
64
5ac45f98 65extern int quit_char;
ee78dc32 66
6fc2811b
JR
67/* A definition of XColor for non-X frames. */
68#ifndef HAVE_X_WINDOWS
69typedef struct {
70 unsigned long pixel;
71 unsigned short red, green, blue;
72 char flags;
73 char pad;
74} XColor;
75#endif
76
ccc2d29c
GV
77extern char *lispy_function_keys[];
78
6fc2811b
JR
79/* The gray bitmap `bitmaps/gray'. This is done because w32term.c uses
80 it, and including `bitmaps/gray' more than once is a problem when
81 config.h defines `static' as an empty replacement string. */
82
83int gray_bitmap_width = gray_width;
84int gray_bitmap_height = gray_height;
85unsigned char *gray_bitmap_bits = gray_bits;
86
ee78dc32 87/* The colormap for converting color names to RGB values */
fbd6baed 88Lisp_Object Vw32_color_map;
ee78dc32 89
da36a4d6 90/* Non nil if alt key presses are passed on to Windows. */
fbd6baed 91Lisp_Object Vw32_pass_alt_to_system;
da36a4d6 92
8c205c63
RS
93/* Non nil if alt key is translated to meta_modifier, nil if it is translated
94 to alt_modifier. */
fbd6baed 95Lisp_Object Vw32_alt_is_meta;
8c205c63 96
7d081355
AI
97/* If non-zero, the windows virtual key code for an alternative quit key. */
98Lisp_Object Vw32_quit_key;
99
ccc2d29c
GV
100/* Non nil if left window key events are passed on to Windows (this only
101 affects whether "tapping" the key opens the Start menu). */
102Lisp_Object Vw32_pass_lwindow_to_system;
103
104/* Non nil if right window key events are passed on to Windows (this
105 only affects whether "tapping" the key opens the Start menu). */
106Lisp_Object Vw32_pass_rwindow_to_system;
107
adcc3809
GV
108/* Virtual key code used to generate "phantom" key presses in order
109 to stop system from acting on Windows key events. */
110Lisp_Object Vw32_phantom_key_code;
111
ccc2d29c
GV
112/* Modifier associated with the left "Windows" key, or nil to act as a
113 normal key. */
114Lisp_Object Vw32_lwindow_modifier;
115
116/* Modifier associated with the right "Windows" key, or nil to act as a
117 normal key. */
118Lisp_Object Vw32_rwindow_modifier;
119
120/* Modifier associated with the "Apps" key, or nil to act as a normal
121 key. */
122Lisp_Object Vw32_apps_modifier;
123
124/* Value is nil if Num Lock acts as a function key. */
125Lisp_Object Vw32_enable_num_lock;
126
127/* Value is nil if Caps Lock acts as a function key. */
128Lisp_Object Vw32_enable_caps_lock;
129
130/* Modifier associated with Scroll Lock, or nil to act as a normal key. */
131Lisp_Object Vw32_scroll_lock_modifier;
da36a4d6 132
7ce9aaca 133/* Switch to control whether we inhibit requests for synthesized bold
6fc2811b 134 and italic versions of fonts. */
d84b082d 135int w32_enable_synthesized_fonts;
5ac45f98
GV
136
137/* Enable palette management. */
fbd6baed 138Lisp_Object Vw32_enable_palette;
5ac45f98
GV
139
140/* Control how close left/right button down events must be to
141 be converted to a middle button down event. */
fbd6baed 142Lisp_Object Vw32_mouse_button_tolerance;
5ac45f98 143
84fb1139
KH
144/* Minimum interval between mouse movement (and scroll bar drag)
145 events that are passed on to the event loop. */
fbd6baed 146Lisp_Object Vw32_mouse_move_interval;
84fb1139 147
74214547
JR
148/* Flag to indicate if XBUTTON events should be passed on to Windows. */
149int w32_pass_extra_mouse_buttons_to_system;
150
ee78dc32
GV
151/* The name we're using in resource queries. */
152Lisp_Object Vx_resource_name;
153
154/* Non nil if no window manager is in use. */
155Lisp_Object Vx_no_window_manager;
156
0af913d7 157/* Non-zero means we're allowed to display a hourglass pointer. */
dfff8a69 158
0af913d7 159int display_hourglass_p;
6fc2811b 160
ee78dc32
GV
161/* The background and shape of the mouse pointer, and shape when not
162 over text or in the modeline. */
dfff8a69 163
ee78dc32 164Lisp_Object Vx_pointer_shape, Vx_nontext_pointer_shape, Vx_mode_pointer_shape;
0af913d7 165Lisp_Object Vx_hourglass_pointer_shape, Vx_window_horizontal_drag_shape;
6fc2811b 166
ee78dc32 167/* The shape when over mouse-sensitive text. */
dfff8a69 168
ee78dc32
GV
169Lisp_Object Vx_sensitive_text_pointer_shape;
170
171/* Color of chars displayed in cursor box. */
dfff8a69 172
ee78dc32
GV
173Lisp_Object Vx_cursor_fore_pixel;
174
1edf84e7 175/* Nonzero if using Windows. */
dfff8a69 176
1edf84e7
GV
177static int w32_in_use;
178
ee78dc32 179/* Search path for bitmap files. */
dfff8a69 180
ee78dc32
GV
181Lisp_Object Vx_bitmap_file_path;
182
4587b026 183/* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
dfff8a69 184
4587b026
GV
185Lisp_Object Vx_pixel_size_width_font_regexp;
186
33d52f9c
GV
187/* Alist of bdf fonts and the files that define them. */
188Lisp_Object Vw32_bdf_filename_alist;
189
f46e6225 190/* A flag to control whether fonts are matched strictly or not. */
1075afa9
GV
191int w32_strict_fontnames;
192
c0611964
AI
193/* A flag to control whether we should only repaint if GetUpdateRect
194 indicates there is an update region. */
195int w32_strict_painting;
196
dfff8a69
JR
197/* Associative list linking character set strings to Windows codepages. */
198Lisp_Object Vw32_charset_info_alist;
199
200/* VIETNAMESE_CHARSET is not defined in some versions of MSVC. */
201#ifndef VIETNAMESE_CHARSET
202#define VIETNAMESE_CHARSET 163
203#endif
204
ee78dc32
GV
205Lisp_Object Qauto_raise;
206Lisp_Object Qauto_lower;
ee78dc32
GV
207Lisp_Object Qborder_color;
208Lisp_Object Qborder_width;
ab0bb234 209extern Lisp_Object Qbox;
ee78dc32
GV
210Lisp_Object Qcursor_color;
211Lisp_Object Qcursor_type;
ee78dc32
GV
212Lisp_Object Qgeometry;
213Lisp_Object Qicon_left;
214Lisp_Object Qicon_top;
215Lisp_Object Qicon_type;
216Lisp_Object Qicon_name;
217Lisp_Object Qinternal_border_width;
218Lisp_Object Qleft;
1026b400 219Lisp_Object Qright;
ee78dc32
GV
220Lisp_Object Qmouse_color;
221Lisp_Object Qnone;
222Lisp_Object Qparent_id;
223Lisp_Object Qscroll_bar_width;
224Lisp_Object Qsuppress_icon;
ee78dc32
GV
225Lisp_Object Qundefined_color;
226Lisp_Object Qvertical_scroll_bars;
227Lisp_Object Qvisibility;
228Lisp_Object Qwindow_id;
229Lisp_Object Qx_frame_parameter;
230Lisp_Object Qx_resource_name;
231Lisp_Object Quser_position;
232Lisp_Object Quser_size;
6fc2811b 233Lisp_Object Qscreen_gamma;
dfff8a69
JR
234Lisp_Object Qline_spacing;
235Lisp_Object Qcenter;
dc220243 236Lisp_Object Qcancel_timer;
adcc3809
GV
237Lisp_Object Qhyper;
238Lisp_Object Qsuper;
239Lisp_Object Qmeta;
240Lisp_Object Qalt;
241Lisp_Object Qctrl;
242Lisp_Object Qcontrol;
243Lisp_Object Qshift;
244
dfff8a69
JR
245Lisp_Object Qw32_charset_ansi;
246Lisp_Object Qw32_charset_default;
247Lisp_Object Qw32_charset_symbol;
248Lisp_Object Qw32_charset_shiftjis;
767b1ff0 249Lisp_Object Qw32_charset_hangeul;
dfff8a69
JR
250Lisp_Object Qw32_charset_gb2312;
251Lisp_Object Qw32_charset_chinesebig5;
252Lisp_Object Qw32_charset_oem;
253
71eab8d1
AI
254#ifndef JOHAB_CHARSET
255#define JOHAB_CHARSET 130
256#endif
dfff8a69
JR
257#ifdef JOHAB_CHARSET
258Lisp_Object Qw32_charset_easteurope;
259Lisp_Object Qw32_charset_turkish;
260Lisp_Object Qw32_charset_baltic;
261Lisp_Object Qw32_charset_russian;
262Lisp_Object Qw32_charset_arabic;
263Lisp_Object Qw32_charset_greek;
264Lisp_Object Qw32_charset_hebrew;
767b1ff0 265Lisp_Object Qw32_charset_vietnamese;
dfff8a69
JR
266Lisp_Object Qw32_charset_thai;
267Lisp_Object Qw32_charset_johab;
268Lisp_Object Qw32_charset_mac;
269#endif
270
271#ifdef UNICODE_CHARSET
272Lisp_Object Qw32_charset_unicode;
273#endif
274
f7b9d4d1
JR
275Lisp_Object Qfullscreen;
276Lisp_Object Qfullwidth;
277Lisp_Object Qfullheight;
278Lisp_Object Qfullboth;
279
6fc2811b
JR
280extern Lisp_Object Qtop;
281extern Lisp_Object Qdisplay;
6fc2811b 282
5ac45f98
GV
283/* State variables for emulating a three button mouse. */
284#define LMOUSE 1
285#define MMOUSE 2
286#define RMOUSE 4
287
288static int button_state = 0;
fbd6baed 289static W32Msg saved_mouse_button_msg;
48094ace 290static unsigned mouse_button_timer = 0; /* non-zero when timer is active */
fbd6baed 291static W32Msg saved_mouse_move_msg;
48094ace 292static unsigned mouse_move_timer = 0;
84fb1139 293
9eb16b62
JR
294/* Window that is tracking the mouse. */
295static HWND track_mouse_window;
296FARPROC track_mouse_event_fn;
297
93fbe8b7
GV
298/* W95 mousewheel handler */
299unsigned int msh_mousewheel = 0;
300
48094ace 301/* Timers */
84fb1139
KH
302#define MOUSE_BUTTON_ID 1
303#define MOUSE_MOVE_ID 2
48094ace
JR
304#define MENU_FREE_ID 3
305/* The delay (milliseconds) before a menu is freed after WM_EXITMENULOOP
306 is received. */
307#define MENU_FREE_DELAY 1000
308static unsigned menu_free_timer = 0;
5ac45f98 309
ee78dc32 310/* The below are defined in frame.c. */
dfff8a69 311
ee78dc32 312extern Lisp_Object Qheight, Qminibuffer, Qname, Qonly, Qwidth;
1edf84e7 313extern Lisp_Object Qunsplittable, Qmenu_bar_lines, Qbuffer_predicate, Qtitle;
6fc2811b 314extern Lisp_Object Qtool_bar_lines;
ee78dc32
GV
315
316extern Lisp_Object Vwindow_system_version;
317
4b817373
RS
318Lisp_Object Qface_set_after_frame_default;
319
937e601e
AI
320#ifdef GLYPH_DEBUG
321int image_cache_refcount, dpyinfo_refcount;
322#endif
323
324
fbd6baed
GV
325/* From w32term.c. */
326extern Lisp_Object Vw32_num_mouse_buttons;
ccc2d29c 327extern Lisp_Object Vw32_recognize_altgr;
5ac45f98 328
65906840 329extern HWND w32_system_caret_hwnd;
93f2ca61 330
65906840
JR
331extern int w32_system_caret_height;
332extern int w32_system_caret_x;
333extern int w32_system_caret_y;
93f2ca61
JR
334extern int w32_use_visible_system_caret;
335
d285988b 336static HWND w32_visible_system_caret_hwnd;
65906840 337
ee78dc32 338\f
1edf84e7
GV
339/* Error if we are not connected to MS-Windows. */
340void
341check_w32 ()
342{
343 if (! w32_in_use)
344 error ("MS-Windows not in use or not initialized");
345}
346
347/* Nonzero if we can use mouse menus.
348 You should not call this unless HAVE_MENUS is defined. */
349
350int
351have_menus_p ()
352{
353 return w32_in_use;
354}
355
ee78dc32 356/* Extract a frame as a FRAME_PTR, defaulting to the selected frame
fbd6baed 357 and checking validity for W32. */
ee78dc32
GV
358
359FRAME_PTR
360check_x_frame (frame)
361 Lisp_Object frame;
362{
363 FRAME_PTR f;
364
365 if (NILP (frame))
6fc2811b 366 frame = selected_frame;
b7826503 367 CHECK_LIVE_FRAME (frame);
6fc2811b 368 f = XFRAME (frame);
fbd6baed
GV
369 if (! FRAME_W32_P (f))
370 error ("non-w32 frame used");
ee78dc32
GV
371 return f;
372}
373
374/* Let the user specify an display with a frame.
fbd6baed 375 nil stands for the selected frame--or, if that is not a w32 frame,
ee78dc32
GV
376 the first display on the list. */
377
fbd6baed 378static struct w32_display_info *
ee78dc32
GV
379check_x_display_info (frame)
380 Lisp_Object frame;
381{
382 if (NILP (frame))
383 {
6fc2811b
JR
384 struct frame *sf = XFRAME (selected_frame);
385
386 if (FRAME_W32_P (sf) && FRAME_LIVE_P (sf))
387 return FRAME_W32_DISPLAY_INFO (sf);
ee78dc32 388 else
fbd6baed 389 return &one_w32_display_info;
ee78dc32
GV
390 }
391 else if (STRINGP (frame))
392 return x_display_info_for_name (frame);
393 else
394 {
395 FRAME_PTR f;
396
b7826503 397 CHECK_LIVE_FRAME (frame);
ee78dc32 398 f = XFRAME (frame);
fbd6baed
GV
399 if (! FRAME_W32_P (f))
400 error ("non-w32 frame used");
401 return FRAME_W32_DISPLAY_INFO (f);
ee78dc32
GV
402 }
403}
404\f
fbd6baed 405/* Return the Emacs frame-object corresponding to an w32 window.
ee78dc32
GV
406 It could be the frame's main window or an icon window. */
407
408/* This function can be called during GC, so use GC_xxx type test macros. */
409
410struct frame *
411x_window_to_frame (dpyinfo, wdesc)
fbd6baed 412 struct w32_display_info *dpyinfo;
ee78dc32
GV
413 HWND wdesc;
414{
415 Lisp_Object tail, frame;
416 struct frame *f;
417
8e713be6 418 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
ee78dc32 419 {
8e713be6 420 frame = XCAR (tail);
ee78dc32
GV
421 if (!GC_FRAMEP (frame))
422 continue;
423 f = XFRAME (frame);
2d764c78 424 if (!FRAME_W32_P (f) || FRAME_W32_DISPLAY_INFO (f) != dpyinfo)
ee78dc32 425 continue;
0af913d7 426 if (f->output_data.w32->hourglass_window == wdesc)
f79e6790
JR
427 return f;
428
fbd6baed 429 if (FRAME_W32_WINDOW (f) == wdesc)
ee78dc32
GV
430 return f;
431 }
432 return 0;
433}
434
435\f
436
437/* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
438 id, which is just an int that this section returns. Bitmaps are
439 reference counted so they can be shared among frames.
440
441 Bitmap indices are guaranteed to be > 0, so a negative number can
442 be used to indicate no bitmap.
443
444 If you use x_create_bitmap_from_data, then you must keep track of
445 the bitmaps yourself. That is, creating a bitmap from the same
446 data more than once will not be caught. */
447
448
449/* Functions to access the contents of a bitmap, given an id. */
450
451int
452x_bitmap_height (f, id)
453 FRAME_PTR f;
454 int id;
455{
fbd6baed 456 return FRAME_W32_DISPLAY_INFO (f)->bitmaps[id - 1].height;
ee78dc32
GV
457}
458
459int
460x_bitmap_width (f, id)
461 FRAME_PTR f;
462 int id;
463{
fbd6baed 464 return FRAME_W32_DISPLAY_INFO (f)->bitmaps[id - 1].width;
ee78dc32
GV
465}
466
467int
468x_bitmap_pixmap (f, id)
469 FRAME_PTR f;
470 int id;
471{
fbd6baed 472 return (int) FRAME_W32_DISPLAY_INFO (f)->bitmaps[id - 1].pixmap;
ee78dc32
GV
473}
474
475
476/* Allocate a new bitmap record. Returns index of new record. */
477
478static int
479x_allocate_bitmap_record (f)
480 FRAME_PTR f;
481{
fbd6baed 482 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
ee78dc32
GV
483 int i;
484
485 if (dpyinfo->bitmaps == NULL)
486 {
487 dpyinfo->bitmaps_size = 10;
488 dpyinfo->bitmaps
fbd6baed 489 = (struct w32_bitmap_record *) xmalloc (dpyinfo->bitmaps_size * sizeof (struct w32_bitmap_record));
ee78dc32
GV
490 dpyinfo->bitmaps_last = 1;
491 return 1;
492 }
493
494 if (dpyinfo->bitmaps_last < dpyinfo->bitmaps_size)
495 return ++dpyinfo->bitmaps_last;
496
497 for (i = 0; i < dpyinfo->bitmaps_size; ++i)
498 if (dpyinfo->bitmaps[i].refcount == 0)
499 return i + 1;
500
501 dpyinfo->bitmaps_size *= 2;
502 dpyinfo->bitmaps
fbd6baed
GV
503 = (struct w32_bitmap_record *) xrealloc (dpyinfo->bitmaps,
504 dpyinfo->bitmaps_size * sizeof (struct w32_bitmap_record));
ee78dc32
GV
505 return ++dpyinfo->bitmaps_last;
506}
507
508/* Add one reference to the reference count of the bitmap with id ID. */
509
510void
511x_reference_bitmap (f, id)
512 FRAME_PTR f;
513 int id;
514{
fbd6baed 515 ++FRAME_W32_DISPLAY_INFO (f)->bitmaps[id - 1].refcount;
ee78dc32
GV
516}
517
518/* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
519
520int
521x_create_bitmap_from_data (f, bits, width, height)
522 struct frame *f;
523 char *bits;
524 unsigned int width, height;
525{
fbd6baed 526 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
ee78dc32
GV
527 Pixmap bitmap;
528 int id;
529
530 bitmap = CreateBitmap (width, height,
fbd6baed
GV
531 FRAME_W32_DISPLAY_INFO (XFRAME (frame))->n_planes,
532 FRAME_W32_DISPLAY_INFO (XFRAME (frame))->n_cbits,
ee78dc32
GV
533 bits);
534
535 if (! bitmap)
536 return -1;
537
538 id = x_allocate_bitmap_record (f);
539 dpyinfo->bitmaps[id - 1].pixmap = bitmap;
540 dpyinfo->bitmaps[id - 1].file = NULL;
541 dpyinfo->bitmaps[id - 1].hinst = NULL;
542 dpyinfo->bitmaps[id - 1].refcount = 1;
543 dpyinfo->bitmaps[id - 1].depth = 1;
544 dpyinfo->bitmaps[id - 1].height = height;
545 dpyinfo->bitmaps[id - 1].width = width;
546
547 return id;
548}
549
550/* Create bitmap from file FILE for frame F. */
551
552int
553x_create_bitmap_from_file (f, file)
554 struct frame *f;
555 Lisp_Object file;
556{
557 return -1;
767b1ff0 558#if 0 /* TODO : bitmap support */
fbd6baed 559 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
ee78dc32 560 unsigned int width, height;
6fc2811b 561 HBITMAP bitmap;
ee78dc32
GV
562 int xhot, yhot, result, id;
563 Lisp_Object found;
564 int fd;
565 char *filename;
566 HINSTANCE hinst;
567
568 /* Look for an existing bitmap with the same name. */
569 for (id = 0; id < dpyinfo->bitmaps_last; ++id)
570 {
571 if (dpyinfo->bitmaps[id].refcount
572 && dpyinfo->bitmaps[id].file
d5db4077 573 && !strcmp (dpyinfo->bitmaps[id].file, (char *) SDATA (file)))
ee78dc32
GV
574 {
575 ++dpyinfo->bitmaps[id].refcount;
576 return id + 1;
577 }
578 }
579
580 /* Search bitmap-file-path for the file, if appropriate. */
de2413e9 581 fd = openp (Vx_bitmap_file_path, file, Qnil, &found, Qnil);
ee78dc32
GV
582 if (fd < 0)
583 return -1;
6fc2811b 584 emacs_close (fd);
ee78dc32 585
d5db4077 586 filename = (char *) SDATA (found);
ee78dc32
GV
587
588 hinst = LoadLibraryEx (filename, NULL, LOAD_LIBRARY_AS_DATAFILE);
589
590 if (hinst == NULL)
591 return -1;
592
593
fbd6baed 594 result = XReadBitmapFile (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
ee78dc32
GV
595 filename, &width, &height, &bitmap, &xhot, &yhot);
596 if (result != BitmapSuccess)
597 return -1;
598
599 id = x_allocate_bitmap_record (f);
600 dpyinfo->bitmaps[id - 1].pixmap = bitmap;
601 dpyinfo->bitmaps[id - 1].refcount = 1;
d5db4077 602 dpyinfo->bitmaps[id - 1].file = (char *) xmalloc (SCHARS (file) + 1);
ee78dc32
GV
603 dpyinfo->bitmaps[id - 1].depth = 1;
604 dpyinfo->bitmaps[id - 1].height = height;
605 dpyinfo->bitmaps[id - 1].width = width;
d5db4077 606 strcpy (dpyinfo->bitmaps[id - 1].file, SDATA (file));
ee78dc32
GV
607
608 return id;
767b1ff0 609#endif /* TODO */
ee78dc32
GV
610}
611
612/* Remove reference to bitmap with id number ID. */
613
33d52f9c 614void
ee78dc32
GV
615x_destroy_bitmap (f, id)
616 FRAME_PTR f;
617 int id;
618{
fbd6baed 619 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
ee78dc32
GV
620
621 if (id > 0)
622 {
623 --dpyinfo->bitmaps[id - 1].refcount;
624 if (dpyinfo->bitmaps[id - 1].refcount == 0)
625 {
626 BLOCK_INPUT;
627 DeleteObject (dpyinfo->bitmaps[id - 1].pixmap);
628 if (dpyinfo->bitmaps[id - 1].file)
629 {
6fc2811b 630 xfree (dpyinfo->bitmaps[id - 1].file);
ee78dc32
GV
631 dpyinfo->bitmaps[id - 1].file = NULL;
632 }
633 UNBLOCK_INPUT;
634 }
635 }
636}
637
638/* Free all the bitmaps for the display specified by DPYINFO. */
639
640static void
641x_destroy_all_bitmaps (dpyinfo)
fbd6baed 642 struct w32_display_info *dpyinfo;
ee78dc32
GV
643{
644 int i;
645 for (i = 0; i < dpyinfo->bitmaps_last; i++)
646 if (dpyinfo->bitmaps[i].refcount > 0)
647 {
648 DeleteObject (dpyinfo->bitmaps[i].pixmap);
649 if (dpyinfo->bitmaps[i].file)
6fc2811b 650 xfree (dpyinfo->bitmaps[i].file);
ee78dc32
GV
651 }
652 dpyinfo->bitmaps_last = 0;
653}
654\f
fbd6baed 655/* Connect the frame-parameter names for W32 frames
ee78dc32
GV
656 to the ways of passing the parameter values to the window system.
657
658 The name of a parameter, as a Lisp symbol,
659 has an `x-frame-parameter' property which is an integer in Lisp
660 but can be interpreted as an `enum x_frame_parm' in C. */
661
662enum x_frame_parm
663{
664 X_PARM_FOREGROUND_COLOR,
665 X_PARM_BACKGROUND_COLOR,
666 X_PARM_MOUSE_COLOR,
667 X_PARM_CURSOR_COLOR,
668 X_PARM_BORDER_COLOR,
669 X_PARM_ICON_TYPE,
670 X_PARM_FONT,
671 X_PARM_BORDER_WIDTH,
672 X_PARM_INTERNAL_BORDER_WIDTH,
673 X_PARM_NAME,
674 X_PARM_AUTORAISE,
675 X_PARM_AUTOLOWER,
676 X_PARM_VERT_SCROLL_BAR,
677 X_PARM_VISIBILITY,
678 X_PARM_MENU_BAR_LINES
679};
680
681
682struct x_frame_parm_table
683{
684 char *name;
6fc2811b 685 void (*setter) P_ ((struct frame *, Lisp_Object, Lisp_Object));
ee78dc32
GV
686};
687
ca56d953
JR
688BOOL my_show_window P_ ((struct frame *, HWND, int));
689void my_set_window_pos P_ ((HWND, HWND, int, int, int, int, UINT));
937e601e
AI
690static Lisp_Object unwind_create_frame P_ ((Lisp_Object));
691static Lisp_Object unwind_create_tip_frame P_ ((Lisp_Object));
692static void x_change_window_heights P_ ((Lisp_Object, int));
767b1ff0 693/* TODO: Native Input Method support; see x_create_im. */
6fc2811b 694void x_set_foreground_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
dfff8a69 695static void x_set_line_spacing P_ ((struct frame *, Lisp_Object, Lisp_Object));
f7b9d4d1 696static void x_set_fullscreen P_ ((struct frame *, Lisp_Object, Lisp_Object));
6fc2811b
JR
697void x_set_background_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
698void x_set_mouse_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
699void x_set_cursor_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
700void x_set_border_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
701void x_set_cursor_type P_ ((struct frame *, Lisp_Object, Lisp_Object));
702void x_set_icon_type P_ ((struct frame *, Lisp_Object, Lisp_Object));
703void x_set_icon_name P_ ((struct frame *, Lisp_Object, Lisp_Object));
704void x_set_font P_ ((struct frame *, Lisp_Object, Lisp_Object));
41c1bdd9 705static void x_set_fringe_width P_ ((struct frame *, Lisp_Object, Lisp_Object));
6fc2811b
JR
706void x_set_border_width P_ ((struct frame *, Lisp_Object, Lisp_Object));
707void x_set_internal_border_width P_ ((struct frame *, Lisp_Object,
708 Lisp_Object));
709void x_explicitly_set_name P_ ((struct frame *, Lisp_Object, Lisp_Object));
710void x_set_autoraise P_ ((struct frame *, Lisp_Object, Lisp_Object));
711void x_set_autolower P_ ((struct frame *, Lisp_Object, Lisp_Object));
712void x_set_vertical_scroll_bars P_ ((struct frame *, Lisp_Object,
713 Lisp_Object));
714void x_set_visibility P_ ((struct frame *, Lisp_Object, Lisp_Object));
715void x_set_menu_bar_lines P_ ((struct frame *, Lisp_Object, Lisp_Object));
716void x_set_scroll_bar_width P_ ((struct frame *, Lisp_Object, Lisp_Object));
717void x_set_title P_ ((struct frame *, Lisp_Object, Lisp_Object));
718void x_set_unsplittable P_ ((struct frame *, Lisp_Object, Lisp_Object));
719void x_set_tool_bar_lines P_ ((struct frame *, Lisp_Object, Lisp_Object));
720static void x_set_screen_gamma P_ ((struct frame *, Lisp_Object, Lisp_Object));
3cf3436e
JR
721static void x_edge_detection P_ ((struct frame *, struct image *, Lisp_Object,
722 Lisp_Object));
ee78dc32
GV
723
724static struct x_frame_parm_table x_frame_parms[] =
725{
72e4adef
JR
726 {"auto-raise", x_set_autoraise},
727 {"auto-lower", x_set_autolower},
728 {"background-color", x_set_background_color},
729 {"border-color", x_set_border_color},
730 {"border-width", x_set_border_width},
731 {"cursor-color", x_set_cursor_color},
732 {"cursor-type", x_set_cursor_type},
733 {"font", x_set_font},
734 {"foreground-color", x_set_foreground_color},
735 {"icon-name", x_set_icon_name},
736 {"icon-type", x_set_icon_type},
737 {"internal-border-width", x_set_internal_border_width},
738 {"menu-bar-lines", x_set_menu_bar_lines},
739 {"mouse-color", x_set_mouse_color},
740 {"name", x_explicitly_set_name},
741 {"scroll-bar-width", x_set_scroll_bar_width},
742 {"title", x_set_title},
743 {"unsplittable", x_set_unsplittable},
744 {"vertical-scroll-bars", x_set_vertical_scroll_bars},
745 {"visibility", x_set_visibility},
746 {"tool-bar-lines", x_set_tool_bar_lines},
747 {"screen-gamma", x_set_screen_gamma},
748 {"line-spacing", x_set_line_spacing},
749 {"left-fringe", x_set_fringe_width},
f7b9d4d1
JR
750 {"right-fringe", x_set_fringe_width},
751 {"fullscreen", x_set_fullscreen},
ee78dc32
GV
752};
753
754/* Attach the `x-frame-parameter' properties to
fbd6baed 755 the Lisp symbol names of parameters relevant to W32. */
ee78dc32 756
dfff8a69 757void
ee78dc32
GV
758init_x_parm_symbols ()
759{
760 int i;
761
762 for (i = 0; i < sizeof (x_frame_parms) / sizeof (x_frame_parms[0]); i++)
763 Fput (intern (x_frame_parms[i].name), Qx_frame_parameter,
764 make_number (i));
765}
766\f
f7b9d4d1
JR
767/* Really try to move where we want to be in case of fullscreen. Some WMs
768 moves the window where we tell them. Some (mwm, twm) moves the outer
769 window manager window there instead.
770 Try to compensate for those WM here. */
771static void
772x_fullscreen_move (f, new_top, new_left)
773 struct frame *f;
774 int new_top;
775 int new_left;
776{
777 if (new_top != f->output_data.w32->top_pos
778 || new_left != f->output_data.w32->left_pos)
779 {
780 int move_x = new_left;
781 int move_y = new_top;
782
783 f->output_data.w32->want_fullscreen |= FULLSCREEN_MOVE_WAIT;
784 x_set_offset (f, move_x, move_y, 1);
785 }
786}
787
dfff8a69 788/* Change the parameters of frame F as specified by ALIST.
ee78dc32
GV
789 If a parameter is not specially recognized, do nothing;
790 otherwise call the `x_set_...' function for that parameter. */
791
792void
793x_set_frame_parameters (f, alist)
794 FRAME_PTR f;
795 Lisp_Object alist;
796{
797 Lisp_Object tail;
798
799 /* If both of these parameters are present, it's more efficient to
800 set them both at once. So we wait until we've looked at the
801 entire list before we set them. */
b839712d 802 int width, height;
ee78dc32
GV
803
804 /* Same here. */
805 Lisp_Object left, top;
806
807 /* Same with these. */
808 Lisp_Object icon_left, icon_top;
809
810 /* Record in these vectors all the parms specified. */
811 Lisp_Object *parms;
812 Lisp_Object *values;
a797a73d 813 int i, p;
ee78dc32
GV
814 int left_no_change = 0, top_no_change = 0;
815 int icon_left_no_change = 0, icon_top_no_change = 0;
f7b9d4d1 816 int fullscreen_is_being_set = 0;
ee78dc32 817
5878523b
RS
818 struct gcpro gcpro1, gcpro2;
819
ee78dc32
GV
820 i = 0;
821 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
822 i++;
823
824 parms = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
825 values = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
826
827 /* Extract parm names and values into those vectors. */
828
829 i = 0;
830 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
831 {
6fc2811b 832 Lisp_Object elt;
ee78dc32
GV
833
834 elt = Fcar (tail);
835 parms[i] = Fcar (elt);
836 values[i] = Fcdr (elt);
837 i++;
838 }
5878523b
RS
839 /* TAIL and ALIST are not used again below here. */
840 alist = tail = Qnil;
841
842 GCPRO2 (*parms, *values);
843 gcpro1.nvars = i;
844 gcpro2.nvars = i;
845
846 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
847 because their values appear in VALUES and strings are not valid. */
b839712d 848 top = left = Qunbound;
ee78dc32
GV
849 icon_left = icon_top = Qunbound;
850
b839712d 851 /* Provide default values for HEIGHT and WIDTH. */
dfff8a69
JR
852 if (FRAME_NEW_WIDTH (f))
853 width = FRAME_NEW_WIDTH (f);
854 else
855 width = FRAME_WIDTH (f);
856
857 if (FRAME_NEW_HEIGHT (f))
858 height = FRAME_NEW_HEIGHT (f);
859 else
860 height = FRAME_HEIGHT (f);
b839712d 861
a797a73d
GV
862 /* Process foreground_color and background_color before anything else.
863 They are independent of other properties, but other properties (e.g.,
864 cursor_color) are dependent upon them. */
41c1bdd9 865 /* Process default font as well, since fringe widths depends on it. */
a797a73d
GV
866 for (p = 0; p < i; p++)
867 {
868 Lisp_Object prop, val;
869
870 prop = parms[p];
871 val = values[p];
41c1bdd9
KS
872 if (EQ (prop, Qforeground_color)
873 || EQ (prop, Qbackground_color)
f7b9d4d1
JR
874 || EQ (prop, Qfont)
875 || EQ (prop, Qfullscreen))
a797a73d
GV
876 {
877 register Lisp_Object param_index, old_value;
878
a797a73d 879 old_value = get_frame_param (f, prop);
f7b9d4d1 880 fullscreen_is_being_set |= EQ (prop, Qfullscreen);
a05e2bae
JR
881
882 if (NILP (Fequal (val, old_value)))
883 {
884 store_frame_param (f, prop, val);
885
886 param_index = Fget (prop, Qx_frame_parameter);
887 if (NATNUMP (param_index)
888 && (XFASTINT (param_index)
889 < sizeof (x_frame_parms)/sizeof (x_frame_parms[0])))
890 (*x_frame_parms[XINT (param_index)].setter)(f, val, old_value);
891 }
a797a73d
GV
892 }
893 }
894
ee78dc32
GV
895 /* Now process them in reverse of specified order. */
896 for (i--; i >= 0; i--)
897 {
898 Lisp_Object prop, val;
899
900 prop = parms[i];
901 val = values[i];
902
b839712d
RS
903 if (EQ (prop, Qwidth) && NUMBERP (val))
904 width = XFASTINT (val);
905 else if (EQ (prop, Qheight) && NUMBERP (val))
906 height = XFASTINT (val);
ee78dc32
GV
907 else if (EQ (prop, Qtop))
908 top = val;
909 else if (EQ (prop, Qleft))
910 left = val;
911 else if (EQ (prop, Qicon_top))
912 icon_top = val;
913 else if (EQ (prop, Qicon_left))
914 icon_left = val;
41c1bdd9
KS
915 else if (EQ (prop, Qforeground_color)
916 || EQ (prop, Qbackground_color)
f7b9d4d1
JR
917 || EQ (prop, Qfont)
918 || EQ (prop, Qfullscreen))
a797a73d
GV
919 /* Processed above. */
920 continue;
ee78dc32
GV
921 else
922 {
923 register Lisp_Object param_index, old_value;
924
ee78dc32 925 old_value = get_frame_param (f, prop);
a05e2bae 926
ee78dc32 927 store_frame_param (f, prop, val);
a05e2bae
JR
928
929 param_index = Fget (prop, Qx_frame_parameter);
ee78dc32
GV
930 if (NATNUMP (param_index)
931 && (XFASTINT (param_index)
932 < sizeof (x_frame_parms)/sizeof (x_frame_parms[0])))
3c190163 933 (*x_frame_parms[XINT (param_index)].setter)(f, val, old_value);
ee78dc32
GV
934 }
935 }
936
937 /* Don't die if just one of these was set. */
938 if (EQ (left, Qunbound))
939 {
940 left_no_change = 1;
fbd6baed
GV
941 if (f->output_data.w32->left_pos < 0)
942 left = Fcons (Qplus, Fcons (make_number (f->output_data.w32->left_pos), Qnil));
ee78dc32 943 else
fbd6baed 944 XSETINT (left, f->output_data.w32->left_pos);
ee78dc32
GV
945 }
946 if (EQ (top, Qunbound))
947 {
948 top_no_change = 1;
fbd6baed
GV
949 if (f->output_data.w32->top_pos < 0)
950 top = Fcons (Qplus, Fcons (make_number (f->output_data.w32->top_pos), Qnil));
ee78dc32 951 else
fbd6baed 952 XSETINT (top, f->output_data.w32->top_pos);
ee78dc32
GV
953 }
954
955 /* If one of the icon positions was not set, preserve or default it. */
956 if (EQ (icon_left, Qunbound) || ! INTEGERP (icon_left))
957 {
958 icon_left_no_change = 1;
959 icon_left = Fcdr (Fassq (Qicon_left, f->param_alist));
960 if (NILP (icon_left))
961 XSETINT (icon_left, 0);
962 }
963 if (EQ (icon_top, Qunbound) || ! INTEGERP (icon_top))
964 {
965 icon_top_no_change = 1;
966 icon_top = Fcdr (Fassq (Qicon_top, f->param_alist));
967 if (NILP (icon_top))
968 XSETINT (icon_top, 0);
969 }
970
f7b9d4d1
JR
971 if (FRAME_VISIBLE_P (f) && fullscreen_is_being_set)
972 {
973 /* If the frame is visible already and the fullscreen parameter is
974 being set, it is too late to set WM manager hints to specify
975 size and position.
976 Here we first get the width, height and position that applies to
977 fullscreen. We then move the frame to the appropriate
978 position. Resize of the frame is taken care of in the code after
979 this if-statement. */
980 int new_left, new_top;
981
982 x_fullscreen_adjust (f, &width, &height, &new_top, &new_left);
983 x_fullscreen_move (f, new_top, new_left);
984 }
985
ee78dc32
GV
986 /* Don't set these parameters unless they've been explicitly
987 specified. The window might be mapped or resized while we're in
988 this function, and we don't want to override that unless the lisp
989 code has asked for it.
990
991 Don't set these parameters unless they actually differ from the
992 window's current parameters; the window may not actually exist
993 yet. */
994 {
995 Lisp_Object frame;
996
997 check_frame_size (f, &height, &width);
998
999 XSETFRAME (frame, f);
1000
dfff8a69
JR
1001 if (width != FRAME_WIDTH (f)
1002 || height != FRAME_HEIGHT (f)
1003 || FRAME_NEW_HEIGHT (f) || FRAME_NEW_WIDTH (f))
b839712d 1004 Fset_frame_size (frame, make_number (width), make_number (height));
ee78dc32
GV
1005
1006 if ((!NILP (left) || !NILP (top))
1007 && ! (left_no_change && top_no_change)
fbd6baed
GV
1008 && ! (NUMBERP (left) && XINT (left) == f->output_data.w32->left_pos
1009 && NUMBERP (top) && XINT (top) == f->output_data.w32->top_pos))
ee78dc32
GV
1010 {
1011 int leftpos = 0;
1012 int toppos = 0;
1013
1014 /* Record the signs. */
fbd6baed 1015 f->output_data.w32->size_hint_flags &= ~ (XNegative | YNegative);
ee78dc32 1016 if (EQ (left, Qminus))
fbd6baed 1017 f->output_data.w32->size_hint_flags |= XNegative;
ee78dc32
GV
1018 else if (INTEGERP (left))
1019 {
1020 leftpos = XINT (left);
1021 if (leftpos < 0)
fbd6baed 1022 f->output_data.w32->size_hint_flags |= XNegative;
ee78dc32 1023 }
8e713be6
KR
1024 else if (CONSP (left) && EQ (XCAR (left), Qminus)
1025 && CONSP (XCDR (left))
1026 && INTEGERP (XCAR (XCDR (left))))
ee78dc32 1027 {
8e713be6 1028 leftpos = - XINT (XCAR (XCDR (left)));
fbd6baed 1029 f->output_data.w32->size_hint_flags |= XNegative;
ee78dc32 1030 }
8e713be6
KR
1031 else if (CONSP (left) && EQ (XCAR (left), Qplus)
1032 && CONSP (XCDR (left))
1033 && INTEGERP (XCAR (XCDR (left))))
ee78dc32 1034 {
8e713be6 1035 leftpos = XINT (XCAR (XCDR (left)));
ee78dc32
GV
1036 }
1037
1038 if (EQ (top, Qminus))
fbd6baed 1039 f->output_data.w32->size_hint_flags |= YNegative;
ee78dc32
GV
1040 else if (INTEGERP (top))
1041 {
1042 toppos = XINT (top);
1043 if (toppos < 0)
fbd6baed 1044 f->output_data.w32->size_hint_flags |= YNegative;
ee78dc32 1045 }
8e713be6
KR
1046 else if (CONSP (top) && EQ (XCAR (top), Qminus)
1047 && CONSP (XCDR (top))
1048 && INTEGERP (XCAR (XCDR (top))))
ee78dc32 1049 {
8e713be6 1050 toppos = - XINT (XCAR (XCDR (top)));
fbd6baed 1051 f->output_data.w32->size_hint_flags |= YNegative;
ee78dc32 1052 }
8e713be6
KR
1053 else if (CONSP (top) && EQ (XCAR (top), Qplus)
1054 && CONSP (XCDR (top))
1055 && INTEGERP (XCAR (XCDR (top))))
ee78dc32 1056 {
8e713be6 1057 toppos = XINT (XCAR (XCDR (top)));
ee78dc32
GV
1058 }
1059
1060
1061 /* Store the numeric value of the position. */
fbd6baed
GV
1062 f->output_data.w32->top_pos = toppos;
1063 f->output_data.w32->left_pos = leftpos;
ee78dc32 1064
fbd6baed 1065 f->output_data.w32->win_gravity = NorthWestGravity;
ee78dc32
GV
1066
1067 /* Actually set that position, and convert to absolute. */
1068 x_set_offset (f, leftpos, toppos, -1);
1069 }
1070
1071 if ((!NILP (icon_left) || !NILP (icon_top))
1072 && ! (icon_left_no_change && icon_top_no_change))
1073 x_wm_set_icon_position (f, XINT (icon_left), XINT (icon_top));
1074 }
5878523b
RS
1075
1076 UNGCPRO;
ee78dc32
GV
1077}
1078
1079/* Store the screen positions of frame F into XPTR and YPTR.
1080 These are the positions of the containing window manager window,
1081 not Emacs's own window. */
1082
1083void
1084x_real_positions (f, xptr, yptr)
1085 FRAME_PTR f;
1086 int *xptr, *yptr;
1087{
1088 POINT pt;
f7b9d4d1 1089 RECT rect;
3c190163 1090
f7b9d4d1
JR
1091 GetClientRect(FRAME_W32_WINDOW(f), &rect);
1092 AdjustWindowRect(&rect, f->output_data.w32->dwStyle, FRAME_EXTERNAL_MENU_BAR(f));
1093
1094 pt.x = rect.left;
1095 pt.y = rect.top;
ee78dc32 1096
fbd6baed 1097 ClientToScreen (FRAME_W32_WINDOW(f), &pt);
ee78dc32 1098
f7b9d4d1
JR
1099 /* Remember x_pixels_diff and y_pixels_diff. */
1100 f->output_data.w32->x_pixels_diff = pt.x - rect.left;
1101 f->output_data.w32->y_pixels_diff = pt.y - rect.top;
1102
ee78dc32
GV
1103 *xptr = pt.x;
1104 *yptr = pt.y;
1105}
1106
1107/* Insert a description of internally-recorded parameters of frame X
1108 into the parameter alist *ALISTPTR that is to be given to the user.
fbd6baed 1109 Only parameters that are specific to W32
ee78dc32
GV
1110 and whose values are not correctly recorded in the frame's
1111 param_alist need to be considered here. */
1112
dfff8a69 1113void
ee78dc32
GV
1114x_report_frame_params (f, alistptr)
1115 struct frame *f;
1116 Lisp_Object *alistptr;
1117{
1118 char buf[16];
1119 Lisp_Object tem;
1120
1121 /* Represent negative positions (off the top or left screen edge)
1122 in a way that Fmodify_frame_parameters will understand correctly. */
fbd6baed
GV
1123 XSETINT (tem, f->output_data.w32->left_pos);
1124 if (f->output_data.w32->left_pos >= 0)
ee78dc32
GV
1125 store_in_alist (alistptr, Qleft, tem);
1126 else
1127 store_in_alist (alistptr, Qleft, Fcons (Qplus, Fcons (tem, Qnil)));
1128
fbd6baed
GV
1129 XSETINT (tem, f->output_data.w32->top_pos);
1130 if (f->output_data.w32->top_pos >= 0)
ee78dc32
GV
1131 store_in_alist (alistptr, Qtop, tem);
1132 else
1133 store_in_alist (alistptr, Qtop, Fcons (Qplus, Fcons (tem, Qnil)));
1134
1135 store_in_alist (alistptr, Qborder_width,
fbd6baed 1136 make_number (f->output_data.w32->border_width));
ee78dc32 1137 store_in_alist (alistptr, Qinternal_border_width,
fbd6baed 1138 make_number (f->output_data.w32->internal_border_width));
e90c3f90
KS
1139 store_in_alist (alistptr, Qleft_fringe,
1140 make_number (f->output_data.w32->left_fringe_width));
1141 store_in_alist (alistptr, Qright_fringe,
1142 make_number (f->output_data.w32->right_fringe_width));
aa17b858
EZ
1143 store_in_alist (alistptr, Qscroll_bar_width,
1144 make_number (FRAME_HAS_VERTICAL_SCROLL_BARS (f)
1145 ? FRAME_SCROLL_BAR_PIXEL_WIDTH(f)
1146 : 0));
fbd6baed 1147 sprintf (buf, "%ld", (long) FRAME_W32_WINDOW (f));
ee78dc32
GV
1148 store_in_alist (alistptr, Qwindow_id,
1149 build_string (buf));
1150 store_in_alist (alistptr, Qicon_name, f->icon_name);
1151 FRAME_SAMPLE_VISIBILITY (f);
1152 store_in_alist (alistptr, Qvisibility,
1153 (FRAME_VISIBLE_P (f) ? Qt
1154 : FRAME_ICONIFIED_P (f) ? Qicon : Qnil));
1155 store_in_alist (alistptr, Qdisplay,
8e713be6 1156 XCAR (FRAME_W32_DISPLAY_INFO (f)->name_list_element));
ee78dc32
GV
1157}
1158\f
1159
74e1aeec
JR
1160DEFUN ("w32-define-rgb-color", Fw32_define_rgb_color,
1161 Sw32_define_rgb_color, 4, 4, 0,
1162 doc: /* Convert RGB numbers to a windows color reference and associate with NAME.
1163This adds or updates a named color to w32-color-map, making it
1164available for use. The original entry's RGB ref is returned, or nil
1165if the entry is new. */)
5ac45f98
GV
1166 (red, green, blue, name)
1167 Lisp_Object red, green, blue, name;
ee78dc32 1168{
5ac45f98
GV
1169 Lisp_Object rgb;
1170 Lisp_Object oldrgb = Qnil;
1171 Lisp_Object entry;
1172
b7826503
PJ
1173 CHECK_NUMBER (red);
1174 CHECK_NUMBER (green);
1175 CHECK_NUMBER (blue);
1176 CHECK_STRING (name);
ee78dc32 1177
5ac45f98 1178 XSET (rgb, Lisp_Int, RGB(XUINT (red), XUINT (green), XUINT (blue)));
ee78dc32 1179
5ac45f98 1180 BLOCK_INPUT;
ee78dc32 1181
fbd6baed
GV
1182 /* replace existing entry in w32-color-map or add new entry. */
1183 entry = Fassoc (name, Vw32_color_map);
5ac45f98
GV
1184 if (NILP (entry))
1185 {
1186 entry = Fcons (name, rgb);
fbd6baed 1187 Vw32_color_map = Fcons (entry, Vw32_color_map);
5ac45f98
GV
1188 }
1189 else
1190 {
1191 oldrgb = Fcdr (entry);
1192 Fsetcdr (entry, rgb);
1193 }
1194
1195 UNBLOCK_INPUT;
1196
1197 return (oldrgb);
ee78dc32
GV
1198}
1199
74e1aeec
JR
1200DEFUN ("w32-load-color-file", Fw32_load_color_file,
1201 Sw32_load_color_file, 1, 1, 0,
1202 doc: /* Create an alist of color entries from an external file.
1203Assign this value to w32-color-map to replace the existing color map.
1204
1205The file should define one named RGB color per line like so:
1206 R G B name
1207where R,G,B are numbers between 0 and 255 and name is an arbitrary string. */)
5ac45f98
GV
1208 (filename)
1209 Lisp_Object filename;
1210{
1211 FILE *fp;
1212 Lisp_Object cmap = Qnil;
1213 Lisp_Object abspath;
1214
b7826503 1215 CHECK_STRING (filename);
5ac45f98
GV
1216 abspath = Fexpand_file_name (filename, Qnil);
1217
d5db4077 1218 fp = fopen (SDATA (filename), "rt");
5ac45f98
GV
1219 if (fp)
1220 {
1221 char buf[512];
1222 int red, green, blue;
1223 int num;
1224
1225 BLOCK_INPUT;
1226
1227 while (fgets (buf, sizeof (buf), fp) != NULL) {
1228 if (sscanf (buf, "%u %u %u %n", &red, &green, &blue, &num) == 3)
1229 {
1230 char *name = buf + num;
1231 num = strlen (name) - 1;
1232 if (name[num] == '\n')
1233 name[num] = 0;
1234 cmap = Fcons (Fcons (build_string (name),
1235 make_number (RGB (red, green, blue))),
1236 cmap);
1237 }
1238 }
1239 fclose (fp);
1240
1241 UNBLOCK_INPUT;
1242 }
1243
1244 return cmap;
1245}
ee78dc32 1246
fbd6baed 1247/* The default colors for the w32 color map */
ee78dc32
GV
1248typedef struct colormap_t
1249{
1250 char *name;
1251 COLORREF colorref;
1252} colormap_t;
1253
fbd6baed 1254colormap_t w32_color_map[] =
ee78dc32 1255{
1da8a614
GV
1256 {"snow" , PALETTERGB (255,250,250)},
1257 {"ghost white" , PALETTERGB (248,248,255)},
1258 {"GhostWhite" , PALETTERGB (248,248,255)},
1259 {"white smoke" , PALETTERGB (245,245,245)},
1260 {"WhiteSmoke" , PALETTERGB (245,245,245)},
1261 {"gainsboro" , PALETTERGB (220,220,220)},
1262 {"floral white" , PALETTERGB (255,250,240)},
1263 {"FloralWhite" , PALETTERGB (255,250,240)},
1264 {"old lace" , PALETTERGB (253,245,230)},
1265 {"OldLace" , PALETTERGB (253,245,230)},
1266 {"linen" , PALETTERGB (250,240,230)},
1267 {"antique white" , PALETTERGB (250,235,215)},
1268 {"AntiqueWhite" , PALETTERGB (250,235,215)},
1269 {"papaya whip" , PALETTERGB (255,239,213)},
1270 {"PapayaWhip" , PALETTERGB (255,239,213)},
1271 {"blanched almond" , PALETTERGB (255,235,205)},
1272 {"BlanchedAlmond" , PALETTERGB (255,235,205)},
1273 {"bisque" , PALETTERGB (255,228,196)},
1274 {"peach puff" , PALETTERGB (255,218,185)},
1275 {"PeachPuff" , PALETTERGB (255,218,185)},
1276 {"navajo white" , PALETTERGB (255,222,173)},
1277 {"NavajoWhite" , PALETTERGB (255,222,173)},
1278 {"moccasin" , PALETTERGB (255,228,181)},
1279 {"cornsilk" , PALETTERGB (255,248,220)},
1280 {"ivory" , PALETTERGB (255,255,240)},
1281 {"lemon chiffon" , PALETTERGB (255,250,205)},
1282 {"LemonChiffon" , PALETTERGB (255,250,205)},
1283 {"seashell" , PALETTERGB (255,245,238)},
1284 {"honeydew" , PALETTERGB (240,255,240)},
1285 {"mint cream" , PALETTERGB (245,255,250)},
1286 {"MintCream" , PALETTERGB (245,255,250)},
1287 {"azure" , PALETTERGB (240,255,255)},
1288 {"alice blue" , PALETTERGB (240,248,255)},
1289 {"AliceBlue" , PALETTERGB (240,248,255)},
1290 {"lavender" , PALETTERGB (230,230,250)},
1291 {"lavender blush" , PALETTERGB (255,240,245)},
1292 {"LavenderBlush" , PALETTERGB (255,240,245)},
1293 {"misty rose" , PALETTERGB (255,228,225)},
1294 {"MistyRose" , PALETTERGB (255,228,225)},
1295 {"white" , PALETTERGB (255,255,255)},
1296 {"black" , PALETTERGB ( 0, 0, 0)},
1297 {"dark slate gray" , PALETTERGB ( 47, 79, 79)},
1298 {"DarkSlateGray" , PALETTERGB ( 47, 79, 79)},
1299 {"dark slate grey" , PALETTERGB ( 47, 79, 79)},
1300 {"DarkSlateGrey" , PALETTERGB ( 47, 79, 79)},
1301 {"dim gray" , PALETTERGB (105,105,105)},
1302 {"DimGray" , PALETTERGB (105,105,105)},
1303 {"dim grey" , PALETTERGB (105,105,105)},
1304 {"DimGrey" , PALETTERGB (105,105,105)},
1305 {"slate gray" , PALETTERGB (112,128,144)},
1306 {"SlateGray" , PALETTERGB (112,128,144)},
1307 {"slate grey" , PALETTERGB (112,128,144)},
1308 {"SlateGrey" , PALETTERGB (112,128,144)},
1309 {"light slate gray" , PALETTERGB (119,136,153)},
1310 {"LightSlateGray" , PALETTERGB (119,136,153)},
1311 {"light slate grey" , PALETTERGB (119,136,153)},
1312 {"LightSlateGrey" , PALETTERGB (119,136,153)},
1313 {"gray" , PALETTERGB (190,190,190)},
1314 {"grey" , PALETTERGB (190,190,190)},
1315 {"light grey" , PALETTERGB (211,211,211)},
1316 {"LightGrey" , PALETTERGB (211,211,211)},
1317 {"light gray" , PALETTERGB (211,211,211)},
1318 {"LightGray" , PALETTERGB (211,211,211)},
1319 {"midnight blue" , PALETTERGB ( 25, 25,112)},
1320 {"MidnightBlue" , PALETTERGB ( 25, 25,112)},
1321 {"navy" , PALETTERGB ( 0, 0,128)},
1322 {"navy blue" , PALETTERGB ( 0, 0,128)},
1323 {"NavyBlue" , PALETTERGB ( 0, 0,128)},
1324 {"cornflower blue" , PALETTERGB (100,149,237)},
1325 {"CornflowerBlue" , PALETTERGB (100,149,237)},
1326 {"dark slate blue" , PALETTERGB ( 72, 61,139)},
1327 {"DarkSlateBlue" , PALETTERGB ( 72, 61,139)},
1328 {"slate blue" , PALETTERGB (106, 90,205)},
1329 {"SlateBlue" , PALETTERGB (106, 90,205)},
1330 {"medium slate blue" , PALETTERGB (123,104,238)},
1331 {"MediumSlateBlue" , PALETTERGB (123,104,238)},
1332 {"light slate blue" , PALETTERGB (132,112,255)},
1333 {"LightSlateBlue" , PALETTERGB (132,112,255)},
1334 {"medium blue" , PALETTERGB ( 0, 0,205)},
1335 {"MediumBlue" , PALETTERGB ( 0, 0,205)},
1336 {"royal blue" , PALETTERGB ( 65,105,225)},
1337 {"RoyalBlue" , PALETTERGB ( 65,105,225)},
1338 {"blue" , PALETTERGB ( 0, 0,255)},
1339 {"dodger blue" , PALETTERGB ( 30,144,255)},
1340 {"DodgerBlue" , PALETTERGB ( 30,144,255)},
1341 {"deep sky blue" , PALETTERGB ( 0,191,255)},
1342 {"DeepSkyBlue" , PALETTERGB ( 0,191,255)},
1343 {"sky blue" , PALETTERGB (135,206,235)},
1344 {"SkyBlue" , PALETTERGB (135,206,235)},
1345 {"light sky blue" , PALETTERGB (135,206,250)},
1346 {"LightSkyBlue" , PALETTERGB (135,206,250)},
1347 {"steel blue" , PALETTERGB ( 70,130,180)},
1348 {"SteelBlue" , PALETTERGB ( 70,130,180)},
1349 {"light steel blue" , PALETTERGB (176,196,222)},
1350 {"LightSteelBlue" , PALETTERGB (176,196,222)},
1351 {"light blue" , PALETTERGB (173,216,230)},
1352 {"LightBlue" , PALETTERGB (173,216,230)},
1353 {"powder blue" , PALETTERGB (176,224,230)},
1354 {"PowderBlue" , PALETTERGB (176,224,230)},
1355 {"pale turquoise" , PALETTERGB (175,238,238)},
1356 {"PaleTurquoise" , PALETTERGB (175,238,238)},
1357 {"dark turquoise" , PALETTERGB ( 0,206,209)},
1358 {"DarkTurquoise" , PALETTERGB ( 0,206,209)},
1359 {"medium turquoise" , PALETTERGB ( 72,209,204)},
1360 {"MediumTurquoise" , PALETTERGB ( 72,209,204)},
1361 {"turquoise" , PALETTERGB ( 64,224,208)},
1362 {"cyan" , PALETTERGB ( 0,255,255)},
1363 {"light cyan" , PALETTERGB (224,255,255)},
1364 {"LightCyan" , PALETTERGB (224,255,255)},
1365 {"cadet blue" , PALETTERGB ( 95,158,160)},
1366 {"CadetBlue" , PALETTERGB ( 95,158,160)},
1367 {"medium aquamarine" , PALETTERGB (102,205,170)},
1368 {"MediumAquamarine" , PALETTERGB (102,205,170)},
1369 {"aquamarine" , PALETTERGB (127,255,212)},
1370 {"dark green" , PALETTERGB ( 0,100, 0)},
1371 {"DarkGreen" , PALETTERGB ( 0,100, 0)},
1372 {"dark olive green" , PALETTERGB ( 85,107, 47)},
1373 {"DarkOliveGreen" , PALETTERGB ( 85,107, 47)},
1374 {"dark sea green" , PALETTERGB (143,188,143)},
1375 {"DarkSeaGreen" , PALETTERGB (143,188,143)},
1376 {"sea green" , PALETTERGB ( 46,139, 87)},
1377 {"SeaGreen" , PALETTERGB ( 46,139, 87)},
1378 {"medium sea green" , PALETTERGB ( 60,179,113)},
1379 {"MediumSeaGreen" , PALETTERGB ( 60,179,113)},
1380 {"light sea green" , PALETTERGB ( 32,178,170)},
1381 {"LightSeaGreen" , PALETTERGB ( 32,178,170)},
1382 {"pale green" , PALETTERGB (152,251,152)},
1383 {"PaleGreen" , PALETTERGB (152,251,152)},
1384 {"spring green" , PALETTERGB ( 0,255,127)},
1385 {"SpringGreen" , PALETTERGB ( 0,255,127)},
1386 {"lawn green" , PALETTERGB (124,252, 0)},
1387 {"LawnGreen" , PALETTERGB (124,252, 0)},
1388 {"green" , PALETTERGB ( 0,255, 0)},
1389 {"chartreuse" , PALETTERGB (127,255, 0)},
1390 {"medium spring green" , PALETTERGB ( 0,250,154)},
1391 {"MediumSpringGreen" , PALETTERGB ( 0,250,154)},
1392 {"green yellow" , PALETTERGB (173,255, 47)},
1393 {"GreenYellow" , PALETTERGB (173,255, 47)},
1394 {"lime green" , PALETTERGB ( 50,205, 50)},
1395 {"LimeGreen" , PALETTERGB ( 50,205, 50)},
1396 {"yellow green" , PALETTERGB (154,205, 50)},
1397 {"YellowGreen" , PALETTERGB (154,205, 50)},
1398 {"forest green" , PALETTERGB ( 34,139, 34)},
1399 {"ForestGreen" , PALETTERGB ( 34,139, 34)},
1400 {"olive drab" , PALETTERGB (107,142, 35)},
1401 {"OliveDrab" , PALETTERGB (107,142, 35)},
1402 {"dark khaki" , PALETTERGB (189,183,107)},
1403 {"DarkKhaki" , PALETTERGB (189,183,107)},
1404 {"khaki" , PALETTERGB (240,230,140)},
1405 {"pale goldenrod" , PALETTERGB (238,232,170)},
1406 {"PaleGoldenrod" , PALETTERGB (238,232,170)},
1407 {"light goldenrod yellow" , PALETTERGB (250,250,210)},
1408 {"LightGoldenrodYellow" , PALETTERGB (250,250,210)},
1409 {"light yellow" , PALETTERGB (255,255,224)},
1410 {"LightYellow" , PALETTERGB (255,255,224)},
1411 {"yellow" , PALETTERGB (255,255, 0)},
1412 {"gold" , PALETTERGB (255,215, 0)},
1413 {"light goldenrod" , PALETTERGB (238,221,130)},
1414 {"LightGoldenrod" , PALETTERGB (238,221,130)},
1415 {"goldenrod" , PALETTERGB (218,165, 32)},
1416 {"dark goldenrod" , PALETTERGB (184,134, 11)},
1417 {"DarkGoldenrod" , PALETTERGB (184,134, 11)},
1418 {"rosy brown" , PALETTERGB (188,143,143)},
1419 {"RosyBrown" , PALETTERGB (188,143,143)},
1420 {"indian red" , PALETTERGB (205, 92, 92)},
1421 {"IndianRed" , PALETTERGB (205, 92, 92)},
1422 {"saddle brown" , PALETTERGB (139, 69, 19)},
1423 {"SaddleBrown" , PALETTERGB (139, 69, 19)},
1424 {"sienna" , PALETTERGB (160, 82, 45)},
1425 {"peru" , PALETTERGB (205,133, 63)},
1426 {"burlywood" , PALETTERGB (222,184,135)},
1427 {"beige" , PALETTERGB (245,245,220)},
1428 {"wheat" , PALETTERGB (245,222,179)},
1429 {"sandy brown" , PALETTERGB (244,164, 96)},
1430 {"SandyBrown" , PALETTERGB (244,164, 96)},
1431 {"tan" , PALETTERGB (210,180,140)},
1432 {"chocolate" , PALETTERGB (210,105, 30)},
1433 {"firebrick" , PALETTERGB (178,34, 34)},
1434 {"brown" , PALETTERGB (165,42, 42)},
1435 {"dark salmon" , PALETTERGB (233,150,122)},
1436 {"DarkSalmon" , PALETTERGB (233,150,122)},
1437 {"salmon" , PALETTERGB (250,128,114)},
1438 {"light salmon" , PALETTERGB (255,160,122)},
1439 {"LightSalmon" , PALETTERGB (255,160,122)},
1440 {"orange" , PALETTERGB (255,165, 0)},
1441 {"dark orange" , PALETTERGB (255,140, 0)},
1442 {"DarkOrange" , PALETTERGB (255,140, 0)},
1443 {"coral" , PALETTERGB (255,127, 80)},
1444 {"light coral" , PALETTERGB (240,128,128)},
1445 {"LightCoral" , PALETTERGB (240,128,128)},
1446 {"tomato" , PALETTERGB (255, 99, 71)},
1447 {"orange red" , PALETTERGB (255, 69, 0)},
1448 {"OrangeRed" , PALETTERGB (255, 69, 0)},
1449 {"red" , PALETTERGB (255, 0, 0)},
1450 {"hot pink" , PALETTERGB (255,105,180)},
1451 {"HotPink" , PALETTERGB (255,105,180)},
1452 {"deep pink" , PALETTERGB (255, 20,147)},
1453 {"DeepPink" , PALETTERGB (255, 20,147)},
1454 {"pink" , PALETTERGB (255,192,203)},
1455 {"light pink" , PALETTERGB (255,182,193)},
1456 {"LightPink" , PALETTERGB (255,182,193)},
1457 {"pale violet red" , PALETTERGB (219,112,147)},
1458 {"PaleVioletRed" , PALETTERGB (219,112,147)},
1459 {"maroon" , PALETTERGB (176, 48, 96)},
1460 {"medium violet red" , PALETTERGB (199, 21,133)},
1461 {"MediumVioletRed" , PALETTERGB (199, 21,133)},
1462 {"violet red" , PALETTERGB (208, 32,144)},
1463 {"VioletRed" , PALETTERGB (208, 32,144)},
1464 {"magenta" , PALETTERGB (255, 0,255)},
1465 {"violet" , PALETTERGB (238,130,238)},
1466 {"plum" , PALETTERGB (221,160,221)},
1467 {"orchid" , PALETTERGB (218,112,214)},
1468 {"medium orchid" , PALETTERGB (186, 85,211)},
1469 {"MediumOrchid" , PALETTERGB (186, 85,211)},
1470 {"dark orchid" , PALETTERGB (153, 50,204)},
1471 {"DarkOrchid" , PALETTERGB (153, 50,204)},
1472 {"dark violet" , PALETTERGB (148, 0,211)},
1473 {"DarkViolet" , PALETTERGB (148, 0,211)},
1474 {"blue violet" , PALETTERGB (138, 43,226)},
1475 {"BlueViolet" , PALETTERGB (138, 43,226)},
1476 {"purple" , PALETTERGB (160, 32,240)},
1477 {"medium purple" , PALETTERGB (147,112,219)},
1478 {"MediumPurple" , PALETTERGB (147,112,219)},
1479 {"thistle" , PALETTERGB (216,191,216)},
1480 {"gray0" , PALETTERGB ( 0, 0, 0)},
1481 {"grey0" , PALETTERGB ( 0, 0, 0)},
1482 {"dark grey" , PALETTERGB (169,169,169)},
1483 {"DarkGrey" , PALETTERGB (169,169,169)},
1484 {"dark gray" , PALETTERGB (169,169,169)},
1485 {"DarkGray" , PALETTERGB (169,169,169)},
1486 {"dark blue" , PALETTERGB ( 0, 0,139)},
1487 {"DarkBlue" , PALETTERGB ( 0, 0,139)},
1488 {"dark cyan" , PALETTERGB ( 0,139,139)},
1489 {"DarkCyan" , PALETTERGB ( 0,139,139)},
1490 {"dark magenta" , PALETTERGB (139, 0,139)},
1491 {"DarkMagenta" , PALETTERGB (139, 0,139)},
1492 {"dark red" , PALETTERGB (139, 0, 0)},
1493 {"DarkRed" , PALETTERGB (139, 0, 0)},
1494 {"light green" , PALETTERGB (144,238,144)},
1495 {"LightGreen" , PALETTERGB (144,238,144)},
ee78dc32
GV
1496};
1497
fbd6baed 1498DEFUN ("w32-default-color-map", Fw32_default_color_map, Sw32_default_color_map,
74e1aeec 1499 0, 0, 0, doc: /* Return the default color map. */)
ee78dc32
GV
1500 ()
1501{
1502 int i;
fbd6baed 1503 colormap_t *pc = w32_color_map;
ee78dc32
GV
1504 Lisp_Object cmap;
1505
1506 BLOCK_INPUT;
1507
1508 cmap = Qnil;
1509
fbd6baed 1510 for (i = 0; i < sizeof (w32_color_map) / sizeof (w32_color_map[0]);
ee78dc32
GV
1511 pc++, i++)
1512 cmap = Fcons (Fcons (build_string (pc->name),
1513 make_number (pc->colorref)),
1514 cmap);
1515
1516 UNBLOCK_INPUT;
1517
1518 return (cmap);
1519}
ee78dc32
GV
1520
1521Lisp_Object
fbd6baed 1522w32_to_x_color (rgb)
ee78dc32
GV
1523 Lisp_Object rgb;
1524{
1525 Lisp_Object color;
1526
b7826503 1527 CHECK_NUMBER (rgb);
ee78dc32
GV
1528
1529 BLOCK_INPUT;
1530
fbd6baed 1531 color = Frassq (rgb, Vw32_color_map);
ee78dc32
GV
1532
1533 UNBLOCK_INPUT;
1534
1535 if (!NILP (color))
1536 return (Fcar (color));
1537 else
1538 return Qnil;
1539}
1540
5d7fed93
GV
1541COLORREF
1542w32_color_map_lookup (colorname)
1543 char *colorname;
1544{
1545 Lisp_Object tail, ret = Qnil;
1546
1547 BLOCK_INPUT;
1548
1549 for (tail = Vw32_color_map; !NILP (tail); tail = Fcdr (tail))
1550 {
1551 register Lisp_Object elt, tem;
1552
1553 elt = Fcar (tail);
1554 if (!CONSP (elt)) continue;
1555
1556 tem = Fcar (elt);
1557
d5db4077 1558 if (lstrcmpi (SDATA (tem), colorname) == 0)
5d7fed93
GV
1559 {
1560 ret = XUINT (Fcdr (elt));
1561 break;
1562 }
1563
1564 QUIT;
1565 }
1566
1567
1568 UNBLOCK_INPUT;
1569
1570 return ret;
1571}
1572
ee78dc32 1573COLORREF
fbd6baed 1574x_to_w32_color (colorname)
ee78dc32
GV
1575 char * colorname;
1576{
8edb0a6f
JR
1577 register Lisp_Object ret = Qnil;
1578
ee78dc32 1579 BLOCK_INPUT;
1edf84e7
GV
1580
1581 if (colorname[0] == '#')
1582 {
1583 /* Could be an old-style RGB Device specification. */
1584 char *color;
1585 int size;
1586 color = colorname + 1;
1587
1588 size = strlen(color);
1589 if (size == 3 || size == 6 || size == 9 || size == 12)
1590 {
1591 UINT colorval;
1592 int i, pos;
1593 pos = 0;
1594 size /= 3;
1595 colorval = 0;
1596
1597 for (i = 0; i < 3; i++)
1598 {
1599 char *end;
1600 char t;
1601 unsigned long value;
1602
1603 /* The check for 'x' in the following conditional takes into
1604 account the fact that strtol allows a "0x" in front of
1605 our numbers, and we don't. */
1606 if (!isxdigit(color[0]) || color[1] == 'x')
1607 break;
1608 t = color[size];
1609 color[size] = '\0';
1610 value = strtoul(color, &end, 16);
1611 color[size] = t;
1612 if (errno == ERANGE || end - color != size)
1613 break;
1614 switch (size)
1615 {
1616 case 1:
1617 value = value * 0x10;
1618 break;
1619 case 2:
1620 break;
1621 case 3:
1622 value /= 0x10;
1623 break;
1624 case 4:
1625 value /= 0x100;
1626 break;
1627 }
1628 colorval |= (value << pos);
1629 pos += 0x8;
1630 if (i == 2)
1631 {
1632 UNBLOCK_INPUT;
1633 return (colorval);
1634 }
1635 color = end;
1636 }
1637 }
1638 }
1639 else if (strnicmp(colorname, "rgb:", 4) == 0)
1640 {
1641 char *color;
1642 UINT colorval;
1643 int i, pos;
1644 pos = 0;
1645
1646 colorval = 0;
1647 color = colorname + 4;
1648 for (i = 0; i < 3; i++)
1649 {
1650 char *end;
1651 unsigned long value;
1652
1653 /* The check for 'x' in the following conditional takes into
1654 account the fact that strtol allows a "0x" in front of
1655 our numbers, and we don't. */
1656 if (!isxdigit(color[0]) || color[1] == 'x')
1657 break;
1658 value = strtoul(color, &end, 16);
1659 if (errno == ERANGE)
1660 break;
1661 switch (end - color)
1662 {
1663 case 1:
1664 value = value * 0x10 + value;
1665 break;
1666 case 2:
1667 break;
1668 case 3:
1669 value /= 0x10;
1670 break;
1671 case 4:
1672 value /= 0x100;
1673 break;
1674 default:
1675 value = ULONG_MAX;
1676 }
1677 if (value == ULONG_MAX)
1678 break;
1679 colorval |= (value << pos);
1680 pos += 0x8;
1681 if (i == 2)
1682 {
1683 if (*end != '\0')
1684 break;
1685 UNBLOCK_INPUT;
1686 return (colorval);
1687 }
1688 if (*end != '/')
1689 break;
1690 color = end + 1;
1691 }
1692 }
1693 else if (strnicmp(colorname, "rgbi:", 5) == 0)
1694 {
1695 /* This is an RGB Intensity specification. */
1696 char *color;
1697 UINT colorval;
1698 int i, pos;
1699 pos = 0;
1700
1701 colorval = 0;
1702 color = colorname + 5;
1703 for (i = 0; i < 3; i++)
1704 {
1705 char *end;
1706 double value;
1707 UINT val;
1708
1709 value = strtod(color, &end);
1710 if (errno == ERANGE)
1711 break;
1712 if (value < 0.0 || value > 1.0)
1713 break;
1714 val = (UINT)(0x100 * value);
1715 /* We used 0x100 instead of 0xFF to give an continuous
1716 range between 0.0 and 1.0 inclusive. The next statement
1717 fixes the 1.0 case. */
1718 if (val == 0x100)
1719 val = 0xFF;
1720 colorval |= (val << pos);
1721 pos += 0x8;
1722 if (i == 2)
1723 {
1724 if (*end != '\0')
1725 break;
1726 UNBLOCK_INPUT;
1727 return (colorval);
1728 }
1729 if (*end != '/')
1730 break;
1731 color = end + 1;
1732 }
1733 }
1734 /* I am not going to attempt to handle any of the CIE color schemes
1735 or TekHVC, since I don't know the algorithms for conversion to
1736 RGB. */
f695b4b1
GV
1737
1738 /* If we fail to lookup the color name in w32_color_map, then check the
1739 colorname to see if it can be crudely approximated: If the X color
1740 ends in a number (e.g., "darkseagreen2"), strip the number and
1741 return the result of looking up the base color name. */
1742 ret = w32_color_map_lookup (colorname);
1743 if (NILP (ret))
ee78dc32 1744 {
f695b4b1 1745 int len = strlen (colorname);
ee78dc32 1746
f695b4b1
GV
1747 if (isdigit (colorname[len - 1]))
1748 {
8b77111c 1749 char *ptr, *approx = alloca (len + 1);
ee78dc32 1750
f695b4b1
GV
1751 strcpy (approx, colorname);
1752 ptr = &approx[len - 1];
1753 while (ptr > approx && isdigit (*ptr))
1754 *ptr-- = '\0';
ee78dc32 1755
f695b4b1 1756 ret = w32_color_map_lookup (approx);
ee78dc32 1757 }
ee78dc32
GV
1758 }
1759
1760 UNBLOCK_INPUT;
ee78dc32
GV
1761 return ret;
1762}
1763
5ac45f98
GV
1764
1765void
fbd6baed 1766w32_regenerate_palette (FRAME_PTR f)
5ac45f98 1767{
fbd6baed 1768 struct w32_palette_entry * list;
5ac45f98
GV
1769 LOGPALETTE * log_palette;
1770 HPALETTE new_palette;
1771 int i;
1772
1773 /* don't bother trying to create palette if not supported */
fbd6baed 1774 if (! FRAME_W32_DISPLAY_INFO (f)->has_palette)
5ac45f98
GV
1775 return;
1776
1777 log_palette = (LOGPALETTE *)
1778 alloca (sizeof (LOGPALETTE) +
fbd6baed 1779 FRAME_W32_DISPLAY_INFO (f)->num_colors * sizeof (PALETTEENTRY));
5ac45f98 1780 log_palette->palVersion = 0x300;
fbd6baed 1781 log_palette->palNumEntries = FRAME_W32_DISPLAY_INFO (f)->num_colors;
5ac45f98 1782
fbd6baed 1783 list = FRAME_W32_DISPLAY_INFO (f)->color_list;
5ac45f98 1784 for (i = 0;
fbd6baed 1785 i < FRAME_W32_DISPLAY_INFO (f)->num_colors;
5ac45f98
GV
1786 i++, list = list->next)
1787 log_palette->palPalEntry[i] = list->entry;
1788
1789 new_palette = CreatePalette (log_palette);
1790
1791 enter_crit ();
1792
fbd6baed
GV
1793 if (FRAME_W32_DISPLAY_INFO (f)->palette)
1794 DeleteObject (FRAME_W32_DISPLAY_INFO (f)->palette);
1795 FRAME_W32_DISPLAY_INFO (f)->palette = new_palette;
5ac45f98
GV
1796
1797 /* Realize display palette and garbage all frames. */
1798 release_frame_dc (f, get_frame_dc (f));
1799
1800 leave_crit ();
1801}
1802
fbd6baed
GV
1803#define W32_COLOR(pe) RGB (pe.peRed, pe.peGreen, pe.peBlue)
1804#define SET_W32_COLOR(pe, color) \
5ac45f98
GV
1805 do \
1806 { \
1807 pe.peRed = GetRValue (color); \
1808 pe.peGreen = GetGValue (color); \
1809 pe.peBlue = GetBValue (color); \
1810 pe.peFlags = 0; \
1811 } while (0)
1812
1813#if 0
1814/* Keep these around in case we ever want to track color usage. */
1815void
fbd6baed 1816w32_map_color (FRAME_PTR f, COLORREF color)
5ac45f98 1817{
fbd6baed 1818 struct w32_palette_entry * list = FRAME_W32_DISPLAY_INFO (f)->color_list;
5ac45f98 1819
fbd6baed 1820 if (NILP (Vw32_enable_palette))
5ac45f98
GV
1821 return;
1822
1823 /* check if color is already mapped */
1824 while (list)
1825 {
fbd6baed 1826 if (W32_COLOR (list->entry) == color)
5ac45f98
GV
1827 {
1828 ++list->refcount;
1829 return;
1830 }
1831 list = list->next;
1832 }
1833
1834 /* not already mapped, so add to list and recreate Windows palette */
fbd6baed
GV
1835 list = (struct w32_palette_entry *)
1836 xmalloc (sizeof (struct w32_palette_entry));
1837 SET_W32_COLOR (list->entry, color);
5ac45f98 1838 list->refcount = 1;
fbd6baed
GV
1839 list->next = FRAME_W32_DISPLAY_INFO (f)->color_list;
1840 FRAME_W32_DISPLAY_INFO (f)->color_list = list;
1841 FRAME_W32_DISPLAY_INFO (f)->num_colors++;
5ac45f98
GV
1842
1843 /* set flag that palette must be regenerated */
fbd6baed 1844 FRAME_W32_DISPLAY_INFO (f)->regen_palette = TRUE;
5ac45f98
GV
1845}
1846
1847void
fbd6baed 1848w32_unmap_color (FRAME_PTR f, COLORREF color)
5ac45f98 1849{
fbd6baed
GV
1850 struct w32_palette_entry * list = FRAME_W32_DISPLAY_INFO (f)->color_list;
1851 struct w32_palette_entry **prev = &FRAME_W32_DISPLAY_INFO (f)->color_list;
5ac45f98 1852
fbd6baed 1853 if (NILP (Vw32_enable_palette))
5ac45f98
GV
1854 return;
1855
1856 /* check if color is already mapped */
1857 while (list)
1858 {
fbd6baed 1859 if (W32_COLOR (list->entry) == color)
5ac45f98
GV
1860 {
1861 if (--list->refcount == 0)
1862 {
1863 *prev = list->next;
1864 xfree (list);
fbd6baed 1865 FRAME_W32_DISPLAY_INFO (f)->num_colors--;
5ac45f98
GV
1866 break;
1867 }
1868 else
1869 return;
1870 }
1871 prev = &list->next;
1872 list = list->next;
1873 }
1874
1875 /* set flag that palette must be regenerated */
fbd6baed 1876 FRAME_W32_DISPLAY_INFO (f)->regen_palette = TRUE;
5ac45f98
GV
1877}
1878#endif
1879
6fc2811b
JR
1880
1881/* Gamma-correct COLOR on frame F. */
1882
1883void
1884gamma_correct (f, color)
1885 struct frame *f;
1886 COLORREF *color;
1887{
1888 if (f->gamma)
1889 {
1890 *color = PALETTERGB (
1891 pow (GetRValue (*color) / 255.0, f->gamma) * 255.0 + 0.5,
1892 pow (GetGValue (*color) / 255.0, f->gamma) * 255.0 + 0.5,
1893 pow (GetBValue (*color) / 255.0, f->gamma) * 255.0 + 0.5);
1894 }
1895}
1896
1897
ee78dc32
GV
1898/* Decide if color named COLOR is valid for the display associated with
1899 the selected frame; if so, return the rgb values in COLOR_DEF.
1900 If ALLOC is nonzero, allocate a new colormap cell. */
1901
1902int
6fc2811b 1903w32_defined_color (f, color, color_def, alloc)
ee78dc32
GV
1904 FRAME_PTR f;
1905 char *color;
6fc2811b 1906 XColor *color_def;
ee78dc32
GV
1907 int alloc;
1908{
1909 register Lisp_Object tem;
6fc2811b 1910 COLORREF w32_color_ref;
3c190163 1911
fbd6baed 1912 tem = x_to_w32_color (color);
3c190163 1913
ee78dc32
GV
1914 if (!NILP (tem))
1915 {
d88c567c
JR
1916 if (f)
1917 {
1918 /* Apply gamma correction. */
1919 w32_color_ref = XUINT (tem);
1920 gamma_correct (f, &w32_color_ref);
1921 XSETINT (tem, w32_color_ref);
1922 }
9badad41
JR
1923
1924 /* Map this color to the palette if it is enabled. */
fbd6baed 1925 if (!NILP (Vw32_enable_palette))
5ac45f98 1926 {
fbd6baed 1927 struct w32_palette_entry * entry =
d88c567c 1928 one_w32_display_info.color_list;
fbd6baed 1929 struct w32_palette_entry ** prev =
d88c567c 1930 &one_w32_display_info.color_list;
5ac45f98
GV
1931
1932 /* check if color is already mapped */
1933 while (entry)
1934 {
fbd6baed 1935 if (W32_COLOR (entry->entry) == XUINT (tem))
5ac45f98
GV
1936 break;
1937 prev = &entry->next;
1938 entry = entry->next;
1939 }
1940
1941 if (entry == NULL && alloc)
1942 {
1943 /* not already mapped, so add to list */
fbd6baed
GV
1944 entry = (struct w32_palette_entry *)
1945 xmalloc (sizeof (struct w32_palette_entry));
1946 SET_W32_COLOR (entry->entry, XUINT (tem));
5ac45f98
GV
1947 entry->next = NULL;
1948 *prev = entry;
d88c567c 1949 one_w32_display_info.num_colors++;
5ac45f98
GV
1950
1951 /* set flag that palette must be regenerated */
d88c567c 1952 one_w32_display_info.regen_palette = TRUE;
5ac45f98
GV
1953 }
1954 }
1955 /* Ensure COLORREF value is snapped to nearest color in (default)
1956 palette by simulating the PALETTERGB macro. This works whether
1957 or not the display device has a palette. */
6fc2811b
JR
1958 w32_color_ref = XUINT (tem) | 0x2000000;
1959
6fc2811b
JR
1960 color_def->pixel = w32_color_ref;
1961 color_def->red = GetRValue (w32_color_ref);
1962 color_def->green = GetGValue (w32_color_ref);
1963 color_def->blue = GetBValue (w32_color_ref);
1964
ee78dc32 1965 return 1;
5ac45f98 1966 }
7fb46567 1967 else
3c190163
GV
1968 {
1969 return 0;
1970 }
ee78dc32
GV
1971}
1972
1973/* Given a string ARG naming a color, compute a pixel value from it
1974 suitable for screen F.
1975 If F is not a color screen, return DEF (default) regardless of what
1976 ARG says. */
1977
1978int
1979x_decode_color (f, arg, def)
1980 FRAME_PTR f;
1981 Lisp_Object arg;
1982 int def;
1983{
6fc2811b 1984 XColor cdef;
ee78dc32 1985
b7826503 1986 CHECK_STRING (arg);
ee78dc32 1987
d5db4077 1988 if (strcmp (SDATA (arg), "black") == 0)
ee78dc32 1989 return BLACK_PIX_DEFAULT (f);
d5db4077 1990 else if (strcmp (SDATA (arg), "white") == 0)
ee78dc32
GV
1991 return WHITE_PIX_DEFAULT (f);
1992
fbd6baed 1993 if ((FRAME_W32_DISPLAY_INFO (f)->n_planes * FRAME_W32_DISPLAY_INFO (f)->n_cbits) == 1)
ee78dc32
GV
1994 return def;
1995
6fc2811b 1996 /* w32_defined_color is responsible for coping with failures
ee78dc32 1997 by looking for a near-miss. */
d5db4077 1998 if (w32_defined_color (f, SDATA (arg), &cdef, 1))
6fc2811b 1999 return cdef.pixel;
ee78dc32
GV
2000
2001 /* defined_color failed; return an ultimate default. */
2002 return def;
2003}
2004\f
dfff8a69
JR
2005/* Change the `line-spacing' frame parameter of frame F. OLD_VALUE is
2006 the previous value of that parameter, NEW_VALUE is the new value. */
2007
2008static void
2009x_set_line_spacing (f, new_value, old_value)
2010 struct frame *f;
2011 Lisp_Object new_value, old_value;
2012{
2013 if (NILP (new_value))
2014 f->extra_line_spacing = 0;
2015 else if (NATNUMP (new_value))
2016 f->extra_line_spacing = XFASTINT (new_value);
2017 else
1a948b17 2018 Fsignal (Qerror, Fcons (build_string ("Invalid line-spacing"),
dfff8a69
JR
2019 Fcons (new_value, Qnil)));
2020 if (FRAME_VISIBLE_P (f))
2021 redraw_frame (f);
2022}
2023
2024
f7b9d4d1
JR
2025/* Change the `fullscreen' frame parameter of frame F. OLD_VALUE is
2026 the previous value of that parameter, NEW_VALUE is the new value. */
2027
2028static void
2029x_set_fullscreen (f, new_value, old_value)
2030 struct frame *f;
2031 Lisp_Object new_value, old_value;
2032{
2033 if (NILP (new_value))
2034 f->output_data.w32->want_fullscreen = FULLSCREEN_NONE;
2035 else if (EQ (new_value, Qfullboth))
2036 f->output_data.w32->want_fullscreen = FULLSCREEN_BOTH;
2037 else if (EQ (new_value, Qfullwidth))
2038 f->output_data.w32->want_fullscreen = FULLSCREEN_WIDTH;
2039 else if (EQ (new_value, Qfullheight))
2040 f->output_data.w32->want_fullscreen = FULLSCREEN_HEIGHT;
2041}
2042
2043
6fc2811b
JR
2044/* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
2045 the previous value of that parameter, NEW_VALUE is the new value. */
2046
2047static void
2048x_set_screen_gamma (f, new_value, old_value)
2049 struct frame *f;
2050 Lisp_Object new_value, old_value;
2051{
2052 if (NILP (new_value))
2053 f->gamma = 0;
2054 else if (NUMBERP (new_value) && XFLOATINT (new_value) > 0)
2055 /* The value 0.4545 is the normal viewing gamma. */
2056 f->gamma = 1.0 / (0.4545 * XFLOATINT (new_value));
2057 else
1a948b17 2058 Fsignal (Qerror, Fcons (build_string ("Invalid screen-gamma"),
6fc2811b
JR
2059 Fcons (new_value, Qnil)));
2060
2061 clear_face_cache (0);
2062}
2063
2064
ee78dc32
GV
2065/* Functions called only from `x_set_frame_param'
2066 to set individual parameters.
2067
fbd6baed 2068 If FRAME_W32_WINDOW (f) is 0,
ee78dc32
GV
2069 the frame is being created and its window does not exist yet.
2070 In that case, just record the parameter's new value
2071 in the standard place; do not attempt to change the window. */
2072
2073void
2074x_set_foreground_color (f, arg, oldval)
2075 struct frame *f;
2076 Lisp_Object arg, oldval;
2077{
3cf3436e
JR
2078 struct w32_output *x = f->output_data.w32;
2079 PIX_TYPE fg, old_fg;
2080
2081 fg = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
2082 old_fg = FRAME_FOREGROUND_PIXEL (f);
2083 FRAME_FOREGROUND_PIXEL (f) = fg;
5ac45f98 2084
fbd6baed 2085 if (FRAME_W32_WINDOW (f) != 0)
ee78dc32 2086 {
3cf3436e
JR
2087 if (x->cursor_pixel == old_fg)
2088 x->cursor_pixel = fg;
2089
6fc2811b 2090 update_face_from_frame_parameter (f, Qforeground_color, arg);
ee78dc32
GV
2091 if (FRAME_VISIBLE_P (f))
2092 redraw_frame (f);
2093 }
2094}
2095
2096void
2097x_set_background_color (f, arg, oldval)
2098 struct frame *f;
2099 Lisp_Object arg, oldval;
2100{
6fc2811b 2101 FRAME_BACKGROUND_PIXEL (f)
ee78dc32
GV
2102 = x_decode_color (f, arg, WHITE_PIX_DEFAULT (f));
2103
fbd6baed 2104 if (FRAME_W32_WINDOW (f) != 0)
ee78dc32 2105 {
6fc2811b
JR
2106 SetWindowLong (FRAME_W32_WINDOW (f), WND_BACKGROUND_INDEX,
2107 FRAME_BACKGROUND_PIXEL (f));
ee78dc32 2108
6fc2811b 2109 update_face_from_frame_parameter (f, Qbackground_color, arg);
ee78dc32
GV
2110
2111 if (FRAME_VISIBLE_P (f))
2112 redraw_frame (f);
2113 }
2114}
2115
2116void
2117x_set_mouse_color (f, arg, oldval)
2118 struct frame *f;
2119 Lisp_Object arg, oldval;
2120{
ee78dc32 2121 Cursor cursor, nontext_cursor, mode_cursor, cross_cursor;
dfc465d3 2122 int count;
ee78dc32
GV
2123 int mask_color;
2124
2125 if (!EQ (Qnil, arg))
fbd6baed 2126 f->output_data.w32->mouse_pixel
ee78dc32 2127 = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
6fc2811b
JR
2128 mask_color = FRAME_BACKGROUND_PIXEL (f);
2129
2130 /* Don't let pointers be invisible. */
fbd6baed 2131 if (mask_color == f->output_data.w32->mouse_pixel
6fc2811b
JR
2132 && mask_color == FRAME_BACKGROUND_PIXEL (f))
2133 f->output_data.w32->mouse_pixel = FRAME_FOREGROUND_PIXEL (f);
ee78dc32 2134
767b1ff0 2135#if 0 /* TODO : cursor changes */
ee78dc32
GV
2136 BLOCK_INPUT;
2137
2138 /* It's not okay to crash if the user selects a screwy cursor. */
fadca6c6 2139 count = x_catch_errors (FRAME_W32_DISPLAY (f));
ee78dc32
GV
2140
2141 if (!EQ (Qnil, Vx_pointer_shape))
2142 {
b7826503 2143 CHECK_NUMBER (Vx_pointer_shape);
fbd6baed 2144 cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XINT (Vx_pointer_shape));
ee78dc32
GV
2145 }
2146 else
fbd6baed
GV
2147 cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_xterm);
2148 x_check_errors (FRAME_W32_DISPLAY (f), "bad text pointer cursor: %s");
ee78dc32
GV
2149
2150 if (!EQ (Qnil, Vx_nontext_pointer_shape))
2151 {
b7826503 2152 CHECK_NUMBER (Vx_nontext_pointer_shape);
fbd6baed 2153 nontext_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f),
ee78dc32
GV
2154 XINT (Vx_nontext_pointer_shape));
2155 }
2156 else
fbd6baed
GV
2157 nontext_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_left_ptr);
2158 x_check_errors (FRAME_W32_DISPLAY (f), "bad nontext pointer cursor: %s");
ee78dc32 2159
0af913d7 2160 if (!EQ (Qnil, Vx_hourglass_pointer_shape))
6fc2811b 2161 {
b7826503 2162 CHECK_NUMBER (Vx_hourglass_pointer_shape);
0af913d7
GM
2163 hourglass_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f),
2164 XINT (Vx_hourglass_pointer_shape));
6fc2811b
JR
2165 }
2166 else
0af913d7 2167 hourglass_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_watch);
6fc2811b
JR
2168 x_check_errors (FRAME_W32_DISPLAY (f), "bad busy pointer cursor: %s");
2169
2170 x_check_errors (FRAME_W32_DISPLAY (f), "bad nontext pointer cursor: %s");
ee78dc32
GV
2171 if (!EQ (Qnil, Vx_mode_pointer_shape))
2172 {
b7826503 2173 CHECK_NUMBER (Vx_mode_pointer_shape);
fbd6baed 2174 mode_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f),
ee78dc32
GV
2175 XINT (Vx_mode_pointer_shape));
2176 }
2177 else
fbd6baed
GV
2178 mode_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_xterm);
2179 x_check_errors (FRAME_W32_DISPLAY (f), "bad modeline pointer cursor: %s");
ee78dc32
GV
2180
2181 if (!EQ (Qnil, Vx_sensitive_text_pointer_shape))
2182 {
b7826503 2183 CHECK_NUMBER (Vx_sensitive_text_pointer_shape);
ee78dc32 2184 cross_cursor
fbd6baed 2185 = XCreateFontCursor (FRAME_W32_DISPLAY (f),
ee78dc32
GV
2186 XINT (Vx_sensitive_text_pointer_shape));
2187 }
2188 else
fbd6baed 2189 cross_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_crosshair);
ee78dc32 2190
4694d762
JR
2191 if (!NILP (Vx_window_horizontal_drag_shape))
2192 {
b7826503 2193 CHECK_NUMBER (Vx_window_horizontal_drag_shape);
4694d762
JR
2194 horizontal_drag_cursor
2195 = XCreateFontCursor (FRAME_X_DISPLAY (f),
2196 XINT (Vx_window_horizontal_drag_shape));
2197 }
2198 else
2199 horizontal_drag_cursor
2200 = XCreateFontCursor (FRAME_X_DISPLAY (f), XC_sb_h_double_arrow);
2201
ee78dc32 2202 /* Check and report errors with the above calls. */
fbd6baed 2203 x_check_errors (FRAME_W32_DISPLAY (f), "can't set cursor shape: %s");
fadca6c6 2204 x_uncatch_errors (FRAME_W32_DISPLAY (f), count);
ee78dc32
GV
2205
2206 {
2207 XColor fore_color, back_color;
2208
fbd6baed 2209 fore_color.pixel = f->output_data.w32->mouse_pixel;
ee78dc32 2210 back_color.pixel = mask_color;
fbd6baed
GV
2211 XQueryColor (FRAME_W32_DISPLAY (f),
2212 DefaultColormap (FRAME_W32_DISPLAY (f),
2213 DefaultScreen (FRAME_W32_DISPLAY (f))),
ee78dc32 2214 &fore_color);
fbd6baed
GV
2215 XQueryColor (FRAME_W32_DISPLAY (f),
2216 DefaultColormap (FRAME_W32_DISPLAY (f),
2217 DefaultScreen (FRAME_W32_DISPLAY (f))),
ee78dc32 2218 &back_color);
fbd6baed 2219 XRecolorCursor (FRAME_W32_DISPLAY (f), cursor,
ee78dc32 2220 &fore_color, &back_color);
fbd6baed 2221 XRecolorCursor (FRAME_W32_DISPLAY (f), nontext_cursor,
ee78dc32 2222 &fore_color, &back_color);
fbd6baed 2223 XRecolorCursor (FRAME_W32_DISPLAY (f), mode_cursor,
ee78dc32 2224 &fore_color, &back_color);
fbd6baed 2225 XRecolorCursor (FRAME_W32_DISPLAY (f), cross_cursor,
ee78dc32 2226 &fore_color, &back_color);
0af913d7 2227 XRecolorCursor (FRAME_W32_DISPLAY (f), hourglass_cursor,
6fc2811b 2228 &fore_color, &back_color);
ee78dc32
GV
2229 }
2230
fbd6baed 2231 if (FRAME_W32_WINDOW (f) != 0)
6fc2811b 2232 XDefineCursor (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f), cursor);
ee78dc32 2233
fbd6baed
GV
2234 if (cursor != f->output_data.w32->text_cursor && f->output_data.w32->text_cursor != 0)
2235 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->text_cursor);
2236 f->output_data.w32->text_cursor = cursor;
2237
2238 if (nontext_cursor != f->output_data.w32->nontext_cursor
2239 && f->output_data.w32->nontext_cursor != 0)
2240 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->nontext_cursor);
2241 f->output_data.w32->nontext_cursor = nontext_cursor;
2242
0af913d7
GM
2243 if (hourglass_cursor != f->output_data.w32->hourglass_cursor
2244 && f->output_data.w32->hourglass_cursor != 0)
2245 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->hourglass_cursor);
2246 f->output_data.w32->hourglass_cursor = hourglass_cursor;
6fc2811b 2247
fbd6baed
GV
2248 if (mode_cursor != f->output_data.w32->modeline_cursor
2249 && f->output_data.w32->modeline_cursor != 0)
2250 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->modeline_cursor);
2251 f->output_data.w32->modeline_cursor = mode_cursor;
6fc2811b 2252
fbd6baed
GV
2253 if (cross_cursor != f->output_data.w32->cross_cursor
2254 && f->output_data.w32->cross_cursor != 0)
2255 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->cross_cursor);
2256 f->output_data.w32->cross_cursor = cross_cursor;
2257
2258 XFlush (FRAME_W32_DISPLAY (f));
ee78dc32 2259 UNBLOCK_INPUT;
6fc2811b
JR
2260
2261 update_face_from_frame_parameter (f, Qmouse_color, arg);
767b1ff0 2262#endif /* TODO */
ee78dc32
GV
2263}
2264
70a0239a
JR
2265/* Defined in w32term.c. */
2266void x_update_cursor (struct frame *f, int on_p);
2267
ee78dc32
GV
2268void
2269x_set_cursor_color (f, arg, oldval)
2270 struct frame *f;
2271 Lisp_Object arg, oldval;
2272{
70a0239a 2273 unsigned long fore_pixel, pixel;
ee78dc32 2274
dfff8a69 2275 if (!NILP (Vx_cursor_fore_pixel))
ee78dc32 2276 fore_pixel = x_decode_color (f, Vx_cursor_fore_pixel,
70a0239a 2277 WHITE_PIX_DEFAULT (f));
ee78dc32 2278 else
6fc2811b 2279 fore_pixel = FRAME_BACKGROUND_PIXEL (f);
70a0239a 2280
6759f872 2281 pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
ee78dc32
GV
2282
2283 /* Make sure that the cursor color differs from the background color. */
70a0239a 2284 if (pixel == FRAME_BACKGROUND_PIXEL (f))
ee78dc32 2285 {
70a0239a
JR
2286 pixel = f->output_data.w32->mouse_pixel;
2287 if (pixel == fore_pixel)
6fc2811b 2288 fore_pixel = FRAME_BACKGROUND_PIXEL (f);
ee78dc32 2289 }
70a0239a 2290
ac849ba4 2291 f->output_data.w32->cursor_foreground_pixel = fore_pixel;
70a0239a 2292 f->output_data.w32->cursor_pixel = pixel;
ee78dc32 2293
fbd6baed 2294 if (FRAME_W32_WINDOW (f) != 0)
ee78dc32 2295 {
0327b4cc
JR
2296 BLOCK_INPUT;
2297 /* Update frame's cursor_gc. */
2298 f->output_data.w32->cursor_gc->foreground = fore_pixel;
2299 f->output_data.w32->cursor_gc->background = pixel;
2300
2301 UNBLOCK_INPUT;
2302
ee78dc32
GV
2303 if (FRAME_VISIBLE_P (f))
2304 {
70a0239a
JR
2305 x_update_cursor (f, 0);
2306 x_update_cursor (f, 1);
ee78dc32
GV
2307 }
2308 }
6fc2811b
JR
2309
2310 update_face_from_frame_parameter (f, Qcursor_color, arg);
ee78dc32
GV
2311}
2312
33d52f9c
GV
2313/* Set the border-color of frame F to pixel value PIX.
2314 Note that this does not fully take effect if done before
2315 F has an window. */
2316void
2317x_set_border_pixel (f, pix)
2318 struct frame *f;
2319 int pix;
2320{
2321 f->output_data.w32->border_pixel = pix;
2322
2323 if (FRAME_W32_WINDOW (f) != 0 && f->output_data.w32->border_width > 0)
2324 {
2325 if (FRAME_VISIBLE_P (f))
2326 redraw_frame (f);
2327 }
2328}
2329
ee78dc32
GV
2330/* Set the border-color of frame F to value described by ARG.
2331 ARG can be a string naming a color.
2332 The border-color is used for the border that is drawn by the server.
2333 Note that this does not fully take effect if done before
2334 F has a window; it must be redone when the window is created. */
2335
2336void
2337x_set_border_color (f, arg, oldval)
2338 struct frame *f;
2339 Lisp_Object arg, oldval;
2340{
ee78dc32
GV
2341 int pix;
2342
b7826503 2343 CHECK_STRING (arg);
ee78dc32 2344 pix = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
ee78dc32 2345 x_set_border_pixel (f, pix);
6fc2811b 2346 update_face_from_frame_parameter (f, Qborder_color, arg);
ee78dc32
GV
2347}
2348
dfff8a69
JR
2349
2350void
2351x_set_cursor_type (f, arg, oldval)
2352 FRAME_PTR f;
2353 Lisp_Object arg, oldval;
2354{
50e363e6 2355 set_frame_cursor_types (f, arg);
ee78dc32
GV
2356
2357 /* Make sure the cursor gets redrawn. This is overkill, but how
2358 often do people change cursor types? */
2359 update_mode_lines++;
2360}
dfff8a69 2361\f
ee78dc32
GV
2362void
2363x_set_icon_type (f, arg, oldval)
2364 struct frame *f;
2365 Lisp_Object arg, oldval;
2366{
ee78dc32
GV
2367 int result;
2368
eb7576ce
GV
2369 if (NILP (arg) && NILP (oldval))
2370 return;
2371
2372 if (STRINGP (arg) && STRINGP (oldval)
2373 && EQ (Fstring_equal (oldval, arg), Qt))
2374 return;
2375
2376 if (SYMBOLP (arg) && SYMBOLP (oldval) && EQ (arg, oldval))
ee78dc32
GV
2377 return;
2378
2379 BLOCK_INPUT;
ee78dc32 2380
eb7576ce 2381 result = x_bitmap_icon (f, arg);
ee78dc32
GV
2382 if (result)
2383 {
2384 UNBLOCK_INPUT;
2385 error ("No icon window available");
2386 }
2387
ee78dc32 2388 UNBLOCK_INPUT;
ee78dc32
GV
2389}
2390
2391/* Return non-nil if frame F wants a bitmap icon. */
2392
2393Lisp_Object
2394x_icon_type (f)
2395 FRAME_PTR f;
2396{
2397 Lisp_Object tem;
2398
2399 tem = assq_no_quit (Qicon_type, f->param_alist);
2400 if (CONSP (tem))
8e713be6 2401 return XCDR (tem);
ee78dc32
GV
2402 else
2403 return Qnil;
2404}
2405
2406void
2407x_set_icon_name (f, arg, oldval)
2408 struct frame *f;
2409 Lisp_Object arg, oldval;
2410{
ee78dc32
GV
2411 if (STRINGP (arg))
2412 {
2413 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
2414 return;
2415 }
2416 else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
2417 return;
2418
2419 f->icon_name = arg;
2420
2421#if 0
fbd6baed 2422 if (f->output_data.w32->icon_bitmap != 0)
ee78dc32
GV
2423 return;
2424
2425 BLOCK_INPUT;
2426
2427 result = x_text_icon (f,
d5db4077
KR
2428 (char *) SDATA ((!NILP (f->icon_name)
2429 ? f->icon_name
2430 : !NILP (f->title)
2431 ? f->title
2432 : f->name)));
ee78dc32
GV
2433
2434 if (result)
2435 {
2436 UNBLOCK_INPUT;
2437 error ("No icon window available");
2438 }
2439
2440 /* If the window was unmapped (and its icon was mapped),
2441 the new icon is not mapped, so map the window in its stead. */
2442 if (FRAME_VISIBLE_P (f))
2443 {
2444#ifdef USE_X_TOOLKIT
fbd6baed 2445 XtPopup (f->output_data.w32->widget, XtGrabNone);
ee78dc32 2446#endif
fbd6baed 2447 XMapWindow (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f));
ee78dc32
GV
2448 }
2449
fbd6baed 2450 XFlush (FRAME_W32_DISPLAY (f));
ee78dc32
GV
2451 UNBLOCK_INPUT;
2452#endif
2453}
2454
2455extern Lisp_Object x_new_font ();
4587b026 2456extern Lisp_Object x_new_fontset();
ee78dc32
GV
2457
2458void
2459x_set_font (f, arg, oldval)
2460 struct frame *f;
2461 Lisp_Object arg, oldval;
2462{
2463 Lisp_Object result;
4587b026 2464 Lisp_Object fontset_name;
4b817373 2465 Lisp_Object frame;
3cf3436e 2466 int old_fontset = FRAME_FONTSET(f);
ee78dc32 2467
b7826503 2468 CHECK_STRING (arg);
ee78dc32 2469
4587b026
GV
2470 fontset_name = Fquery_fontset (arg, Qnil);
2471
ee78dc32 2472 BLOCK_INPUT;
4587b026 2473 result = (STRINGP (fontset_name)
d5db4077
KR
2474 ? x_new_fontset (f, SDATA (fontset_name))
2475 : x_new_font (f, SDATA (arg)));
ee78dc32
GV
2476 UNBLOCK_INPUT;
2477
2478 if (EQ (result, Qnil))
d5db4077 2479 error ("Font `%s' is not defined", SDATA (arg));
ee78dc32 2480 else if (EQ (result, Qt))
dfff8a69 2481 error ("The characters of the given font have varying widths");
ee78dc32
GV
2482 else if (STRINGP (result))
2483 {
3cf3436e
JR
2484 if (STRINGP (fontset_name))
2485 {
2486 /* Fontset names are built from ASCII font names, so the
2487 names may be equal despite there was a change. */
2488 if (old_fontset == FRAME_FONTSET (f))
2489 return;
2490 }
2491 else if (!NILP (Fequal (result, oldval)))
dc220243 2492 return;
3cf3436e 2493
ee78dc32 2494 store_frame_param (f, Qfont, result);
6fc2811b 2495 recompute_basic_faces (f);
ee78dc32
GV
2496 }
2497 else
2498 abort ();
4b817373 2499
6fc2811b
JR
2500 do_pending_window_change (0);
2501
2502 /* Don't call `face-set-after-frame-default' when faces haven't been
2503 initialized yet. This is the case when called from
2504 Fx_create_frame. In that case, the X widget or window doesn't
2505 exist either, and we can end up in x_report_frame_params with a
2506 null widget which gives a segfault. */
2507 if (FRAME_FACE_CACHE (f))
2508 {
2509 XSETFRAME (frame, f);
2510 call1 (Qface_set_after_frame_default, frame);
2511 }
ee78dc32
GV
2512}
2513
41c1bdd9
KS
2514static void
2515x_set_fringe_width (f, new_value, old_value)
2516 struct frame *f;
2517 Lisp_Object new_value, old_value;
2518{
2519 x_compute_fringe_widths (f, 1);
2520}
2521
ee78dc32
GV
2522void
2523x_set_border_width (f, arg, oldval)
2524 struct frame *f;
2525 Lisp_Object arg, oldval;
2526{
b7826503 2527 CHECK_NUMBER (arg);
ee78dc32 2528
fbd6baed 2529 if (XINT (arg) == f->output_data.w32->border_width)
ee78dc32
GV
2530 return;
2531
fbd6baed 2532 if (FRAME_W32_WINDOW (f) != 0)
ee78dc32
GV
2533 error ("Cannot change the border width of a window");
2534
fbd6baed 2535 f->output_data.w32->border_width = XINT (arg);
ee78dc32
GV
2536}
2537
2538void
2539x_set_internal_border_width (f, arg, oldval)
2540 struct frame *f;
2541 Lisp_Object arg, oldval;
2542{
fbd6baed 2543 int old = f->output_data.w32->internal_border_width;
ee78dc32 2544
b7826503 2545 CHECK_NUMBER (arg);
fbd6baed
GV
2546 f->output_data.w32->internal_border_width = XINT (arg);
2547 if (f->output_data.w32->internal_border_width < 0)
2548 f->output_data.w32->internal_border_width = 0;
ee78dc32 2549
fbd6baed 2550 if (f->output_data.w32->internal_border_width == old)
ee78dc32
GV
2551 return;
2552
fbd6baed 2553 if (FRAME_W32_WINDOW (f) != 0)
ee78dc32 2554 {
ee78dc32 2555 x_set_window_size (f, 0, f->width, f->height);
ee78dc32 2556 SET_FRAME_GARBAGED (f);
6fc2811b 2557 do_pending_window_change (0);
ee78dc32 2558 }
a05e2bae
JR
2559 else
2560 SET_FRAME_GARBAGED (f);
ee78dc32
GV
2561}
2562
2563void
2564x_set_visibility (f, value, oldval)
2565 struct frame *f;
2566 Lisp_Object value, oldval;
2567{
2568 Lisp_Object frame;
2569 XSETFRAME (frame, f);
2570
2571 if (NILP (value))
2572 Fmake_frame_invisible (frame, Qt);
2573 else if (EQ (value, Qicon))
2574 Ficonify_frame (frame);
2575 else
2576 Fmake_frame_visible (frame);
2577}
2578
a1258667
JR
2579\f
2580/* Change window heights in windows rooted in WINDOW by N lines. */
2581
2582static void
2583x_change_window_heights (window, n)
2584 Lisp_Object window;
2585 int n;
2586{
2587 struct window *w = XWINDOW (window);
2588
2589 XSETFASTINT (w->top, XFASTINT (w->top) + n);
2590 XSETFASTINT (w->height, XFASTINT (w->height) - n);
2591
2592 if (INTEGERP (w->orig_top))
2593 XSETFASTINT (w->orig_top, XFASTINT (w->orig_top) + n);
2594 if (INTEGERP (w->orig_height))
2595 XSETFASTINT (w->orig_height, XFASTINT (w->orig_height) - n);
2596
2597 /* Handle just the top child in a vertical split. */
2598 if (!NILP (w->vchild))
2599 x_change_window_heights (w->vchild, n);
2600
2601 /* Adjust all children in a horizontal split. */
2602 for (window = w->hchild; !NILP (window); window = w->next)
2603 {
2604 w = XWINDOW (window);
2605 x_change_window_heights (window, n);
2606 }
2607}
2608
ee78dc32
GV
2609void
2610x_set_menu_bar_lines (f, value, oldval)
2611 struct frame *f;
2612 Lisp_Object value, oldval;
2613{
2614 int nlines;
2615 int olines = FRAME_MENU_BAR_LINES (f);
2616
2617 /* Right now, menu bars don't work properly in minibuf-only frames;
2618 most of the commands try to apply themselves to the minibuffer
6fc2811b 2619 frame itself, and get an error because you can't switch buffers
ee78dc32
GV
2620 in or split the minibuffer window. */
2621 if (FRAME_MINIBUF_ONLY_P (f))
2622 return;
2623
2624 if (INTEGERP (value))
2625 nlines = XINT (value);
2626 else
2627 nlines = 0;
2628
2629 FRAME_MENU_BAR_LINES (f) = 0;
2630 if (nlines)
2631 FRAME_EXTERNAL_MENU_BAR (f) = 1;
2632 else
2633 {
2634 if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
2635 free_frame_menubar (f);
2636 FRAME_EXTERNAL_MENU_BAR (f) = 0;
1edf84e7
GV
2637
2638 /* Adjust the frame size so that the client (text) dimensions
2639 remain the same. This depends on FRAME_EXTERNAL_MENU_BAR being
2640 set correctly. */
2641 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
6fc2811b 2642 do_pending_window_change (0);
ee78dc32 2643 }
6fc2811b
JR
2644 adjust_glyphs (f);
2645}
2646
2647
2648/* Set the number of lines used for the tool bar of frame F to VALUE.
2649 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
2650 is the old number of tool bar lines. This function changes the
2651 height of all windows on frame F to match the new tool bar height.
2652 The frame's height doesn't change. */
2653
2654void
2655x_set_tool_bar_lines (f, value, oldval)
2656 struct frame *f;
2657 Lisp_Object value, oldval;
2658{
36f8209a
JR
2659 int delta, nlines, root_height;
2660 Lisp_Object root_window;
6fc2811b 2661
dc220243
JR
2662 /* Treat tool bars like menu bars. */
2663 if (FRAME_MINIBUF_ONLY_P (f))
2664 return;
2665
6fc2811b
JR
2666 /* Use VALUE only if an integer >= 0. */
2667 if (INTEGERP (value) && XINT (value) >= 0)
2668 nlines = XFASTINT (value);
2669 else
2670 nlines = 0;
2671
2672 /* Make sure we redisplay all windows in this frame. */
2673 ++windows_or_buffers_changed;
2674
2675 delta = nlines - FRAME_TOOL_BAR_LINES (f);
36f8209a
JR
2676
2677 /* Don't resize the tool-bar to more than we have room for. */
2678 root_window = FRAME_ROOT_WINDOW (f);
2679 root_height = XINT (XWINDOW (root_window)->height);
2680 if (root_height - delta < 1)
2681 {
2682 delta = root_height - 1;
2683 nlines = FRAME_TOOL_BAR_LINES (f) + delta;
2684 }
2685
6fc2811b 2686 FRAME_TOOL_BAR_LINES (f) = nlines;
36f8209a 2687 x_change_window_heights (root_window, delta);
6fc2811b 2688 adjust_glyphs (f);
36f8209a
JR
2689
2690 /* We also have to make sure that the internal border at the top of
2691 the frame, below the menu bar or tool bar, is redrawn when the
2692 tool bar disappears. This is so because the internal border is
2693 below the tool bar if one is displayed, but is below the menu bar
2694 if there isn't a tool bar. The tool bar draws into the area
2695 below the menu bar. */
2696 if (FRAME_W32_WINDOW (f) && FRAME_TOOL_BAR_LINES (f) == 0)
2697 {
2698 updating_frame = f;
2699 clear_frame ();
2700 clear_current_matrices (f);
2701 updating_frame = NULL;
2702 }
2703
2704 /* If the tool bar gets smaller, the internal border below it
2705 has to be cleared. It was formerly part of the display
2706 of the larger tool bar, and updating windows won't clear it. */
2707 if (delta < 0)
2708 {
2709 int height = FRAME_INTERNAL_BORDER_WIDTH (f);
2710 int width = PIXEL_WIDTH (f);
2711 int y = nlines * CANON_Y_UNIT (f);
2712
2713 BLOCK_INPUT;
2714 {
2715 HDC hdc = get_frame_dc (f);
2716 w32_clear_area (f, hdc, 0, y, width, height);
2717 release_frame_dc (f, hdc);
2718 }
2719 UNBLOCK_INPUT;
3cf3436e
JR
2720
2721 if (WINDOWP (f->tool_bar_window))
2722 clear_glyph_matrix (XWINDOW (f->tool_bar_window)->current_matrix);
36f8209a 2723 }
ee78dc32
GV
2724}
2725
6fc2811b 2726
ee78dc32 2727/* Change the name of frame F to NAME. If NAME is nil, set F's name to
fbd6baed 2728 w32_id_name.
ee78dc32
GV
2729
2730 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2731 name; if NAME is a string, set F's name to NAME and set
2732 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2733
2734 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2735 suggesting a new name, which lisp code should override; if
2736 F->explicit_name is set, ignore the new name; otherwise, set it. */
2737
2738void
2739x_set_name (f, name, explicit)
2740 struct frame *f;
2741 Lisp_Object name;
2742 int explicit;
2743{
2744 /* Make sure that requests from lisp code override requests from
2745 Emacs redisplay code. */
2746 if (explicit)
2747 {
2748 /* If we're switching from explicit to implicit, we had better
2749 update the mode lines and thereby update the title. */
2750 if (f->explicit_name && NILP (name))
2751 update_mode_lines = 1;
2752
2753 f->explicit_name = ! NILP (name);
2754 }
2755 else if (f->explicit_name)
2756 return;
2757
fbd6baed 2758 /* If NAME is nil, set the name to the w32_id_name. */
ee78dc32
GV
2759 if (NILP (name))
2760 {
2761 /* Check for no change needed in this very common case
2762 before we do any consing. */
fbd6baed 2763 if (!strcmp (FRAME_W32_DISPLAY_INFO (f)->w32_id_name,
d5db4077 2764 SDATA (f->name)))
ee78dc32 2765 return;
fbd6baed 2766 name = build_string (FRAME_W32_DISPLAY_INFO (f)->w32_id_name);
ee78dc32
GV
2767 }
2768 else
b7826503 2769 CHECK_STRING (name);
ee78dc32
GV
2770
2771 /* Don't change the name if it's already NAME. */
2772 if (! NILP (Fstring_equal (name, f->name)))
2773 return;
2774
1edf84e7
GV
2775 f->name = name;
2776
2777 /* For setting the frame title, the title parameter should override
2778 the name parameter. */
2779 if (! NILP (f->title))
2780 name = f->title;
2781
fbd6baed 2782 if (FRAME_W32_WINDOW (f))
ee78dc32 2783 {
6fc2811b 2784 if (STRING_MULTIBYTE (name))
dfff8a69 2785 name = ENCODE_SYSTEM (name);
6fc2811b 2786
ee78dc32 2787 BLOCK_INPUT;
d5db4077 2788 SetWindowText(FRAME_W32_WINDOW (f), SDATA (name));
ee78dc32
GV
2789 UNBLOCK_INPUT;
2790 }
ee78dc32
GV
2791}
2792
2793/* This function should be called when the user's lisp code has
2794 specified a name for the frame; the name will override any set by the
2795 redisplay code. */
2796void
2797x_explicitly_set_name (f, arg, oldval)
2798 FRAME_PTR f;
2799 Lisp_Object arg, oldval;
2800{
2801 x_set_name (f, arg, 1);
2802}
2803
2804/* This function should be called by Emacs redisplay code to set the
2805 name; names set this way will never override names set by the user's
2806 lisp code. */
2807void
2808x_implicitly_set_name (f, arg, oldval)
2809 FRAME_PTR f;
2810 Lisp_Object arg, oldval;
2811{
2812 x_set_name (f, arg, 0);
2813}
1edf84e7
GV
2814\f
2815/* Change the title of frame F to NAME.
2816 If NAME is nil, use the frame name as the title.
2817
2818 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2819 name; if NAME is a string, set F's name to NAME and set
2820 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2821
2822 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2823 suggesting a new name, which lisp code should override; if
2824 F->explicit_name is set, ignore the new name; otherwise, set it. */
ee78dc32 2825
1edf84e7 2826void
6fc2811b 2827x_set_title (f, name, old_name)
1edf84e7 2828 struct frame *f;
6fc2811b 2829 Lisp_Object name, old_name;
1edf84e7
GV
2830{
2831 /* Don't change the title if it's already NAME. */
2832 if (EQ (name, f->title))
2833 return;
2834
2835 update_mode_lines = 1;
2836
2837 f->title = name;
2838
2839 if (NILP (name))
2840 name = f->name;
2841
2842 if (FRAME_W32_WINDOW (f))
2843 {
6fc2811b 2844 if (STRING_MULTIBYTE (name))
dfff8a69 2845 name = ENCODE_SYSTEM (name);
6fc2811b 2846
1edf84e7 2847 BLOCK_INPUT;
d5db4077 2848 SetWindowText(FRAME_W32_WINDOW (f), SDATA (name));
1edf84e7
GV
2849 UNBLOCK_INPUT;
2850 }
2851}
2852\f
ee78dc32
GV
2853void
2854x_set_autoraise (f, arg, oldval)
2855 struct frame *f;
2856 Lisp_Object arg, oldval;
2857{
2858 f->auto_raise = !EQ (Qnil, arg);
2859}
2860
2861void
2862x_set_autolower (f, arg, oldval)
2863 struct frame *f;
2864 Lisp_Object arg, oldval;
2865{
2866 f->auto_lower = !EQ (Qnil, arg);
2867}
2868
2869void
2870x_set_unsplittable (f, arg, oldval)
2871 struct frame *f;
2872 Lisp_Object arg, oldval;
2873{
2874 f->no_split = !NILP (arg);
2875}
2876
2877void
2878x_set_vertical_scroll_bars (f, arg, oldval)
2879 struct frame *f;
2880 Lisp_Object arg, oldval;
2881{
1026b400
RS
2882 if ((EQ (arg, Qleft) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f))
2883 || (EQ (arg, Qright) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f))
2884 || (NILP (arg) && FRAME_HAS_VERTICAL_SCROLL_BARS (f))
2885 || (!NILP (arg) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f)))
ee78dc32 2886 {
1026b400
RS
2887 FRAME_VERTICAL_SCROLL_BAR_TYPE (f) = NILP (arg) ?
2888 vertical_scroll_bar_none :
87996783
GV
2889 /* Put scroll bars on the right by default, as is conventional
2890 on MS-Windows. */
2891 EQ (Qleft, arg)
2892 ? vertical_scroll_bar_left
2893 : vertical_scroll_bar_right;
ee78dc32
GV
2894
2895 /* We set this parameter before creating the window for the
2896 frame, so we can get the geometry right from the start.
2897 However, if the window hasn't been created yet, we shouldn't
2898 call x_set_window_size. */
fbd6baed 2899 if (FRAME_W32_WINDOW (f))
ee78dc32 2900 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
6fc2811b 2901 do_pending_window_change (0);
ee78dc32
GV
2902 }
2903}
2904
2905void
2906x_set_scroll_bar_width (f, arg, oldval)
2907 struct frame *f;
2908 Lisp_Object arg, oldval;
2909{
6fc2811b
JR
2910 int wid = FONT_WIDTH (f->output_data.w32->font);
2911
ee78dc32
GV
2912 if (NILP (arg))
2913 {
6fc2811b
JR
2914 FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = GetSystemMetrics (SM_CXVSCROLL);
2915 FRAME_SCROLL_BAR_COLS (f) = (FRAME_SCROLL_BAR_PIXEL_WIDTH (f) +
2916 wid - 1) / wid;
2917 if (FRAME_W32_WINDOW (f))
2918 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
2919 do_pending_window_change (0);
ee78dc32
GV
2920 }
2921 else if (INTEGERP (arg) && XINT (arg) > 0
2922 && XFASTINT (arg) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f))
2923 {
ee78dc32 2924 FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = XFASTINT (arg);
6fc2811b
JR
2925 FRAME_SCROLL_BAR_COLS (f) = (FRAME_SCROLL_BAR_PIXEL_WIDTH (f)
2926 + wid-1) / wid;
fbd6baed 2927 if (FRAME_W32_WINDOW (f))
ee78dc32 2928 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
6fc2811b 2929 do_pending_window_change (0);
ee78dc32 2930 }
6fc2811b
JR
2931 change_frame_size (f, 0, FRAME_WIDTH (f), 0, 0, 0);
2932 XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.hpos = 0;
2933 XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.x = 0;
ee78dc32
GV
2934}
2935\f
2936/* Subroutines of creating an frame. */
2937
2938/* Make sure that Vx_resource_name is set to a reasonable value.
2939 Fix it up, or set it to `emacs' if it is too hopeless. */
2940
2941static void
2942validate_x_resource_name ()
2943{
6fc2811b 2944 int len = 0;
ee78dc32
GV
2945 /* Number of valid characters in the resource name. */
2946 int good_count = 0;
2947 /* Number of invalid characters in the resource name. */
2948 int bad_count = 0;
2949 Lisp_Object new;
2950 int i;
2951
2952 if (STRINGP (Vx_resource_name))
2953 {
d5db4077 2954 unsigned char *p = SDATA (Vx_resource_name);
ee78dc32
GV
2955 int i;
2956
d5db4077 2957 len = SBYTES (Vx_resource_name);
ee78dc32
GV
2958
2959 /* Only letters, digits, - and _ are valid in resource names.
2960 Count the valid characters and count the invalid ones. */
2961 for (i = 0; i < len; i++)
2962 {
2963 int c = p[i];
2964 if (! ((c >= 'a' && c <= 'z')
2965 || (c >= 'A' && c <= 'Z')
2966 || (c >= '0' && c <= '9')
2967 || c == '-' || c == '_'))
2968 bad_count++;
2969 else
2970 good_count++;
2971 }
2972 }
2973 else
2974 /* Not a string => completely invalid. */
2975 bad_count = 5, good_count = 0;
2976
2977 /* If name is valid already, return. */
2978 if (bad_count == 0)
2979 return;
2980
2981 /* If name is entirely invalid, or nearly so, use `emacs'. */
2982 if (good_count == 0
2983 || (good_count == 1 && bad_count > 0))
2984 {
2985 Vx_resource_name = build_string ("emacs");
2986 return;
2987 }
2988
2989 /* Name is partly valid. Copy it and replace the invalid characters
2990 with underscores. */
2991
2992 Vx_resource_name = new = Fcopy_sequence (Vx_resource_name);
2993
2994 for (i = 0; i < len; i++)
2995 {
d5db4077 2996 int c = SREF (new, i);
ee78dc32
GV
2997 if (! ((c >= 'a' && c <= 'z')
2998 || (c >= 'A' && c <= 'Z')
2999 || (c >= '0' && c <= '9')
3000 || c == '-' || c == '_'))
7960d5ab 3001 SSET (new, i, '_');
ee78dc32
GV
3002 }
3003}
3004
3005
3006extern char *x_get_string_resource ();
3007
3008DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 2, 4, 0,
74e1aeec
JR
3009 doc: /* Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.
3010This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the
3011class, where INSTANCE is the name under which Emacs was invoked, or
3012the name specified by the `-name' or `-rn' command-line arguments.
3013
3014The optional arguments COMPONENT and SUBCLASS add to the key and the
3015class, respectively. You must specify both of them or neither.
3016If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'
3017and the class is `Emacs.CLASS.SUBCLASS'. */)
ee78dc32
GV
3018 (attribute, class, component, subclass)
3019 Lisp_Object attribute, class, component, subclass;
3020{
3021 register char *value;
3022 char *name_key;
3023 char *class_key;
3024
b7826503
PJ
3025 CHECK_STRING (attribute);
3026 CHECK_STRING (class);
ee78dc32
GV
3027
3028 if (!NILP (component))
b7826503 3029 CHECK_STRING (component);
ee78dc32 3030 if (!NILP (subclass))
b7826503 3031 CHECK_STRING (subclass);
ee78dc32
GV
3032 if (NILP (component) != NILP (subclass))
3033 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
3034
3035 validate_x_resource_name ();
3036
3037 /* Allocate space for the components, the dots which separate them,
3038 and the final '\0'. Make them big enough for the worst case. */
d5db4077 3039 name_key = (char *) alloca (SBYTES (Vx_resource_name)
ee78dc32 3040 + (STRINGP (component)
d5db4077
KR
3041 ? SBYTES (component) : 0)
3042 + SBYTES (attribute)
ee78dc32
GV
3043 + 3);
3044
3045 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
d5db4077 3046 + SBYTES (class)
ee78dc32 3047 + (STRINGP (subclass)
d5db4077 3048 ? SBYTES (subclass) : 0)
ee78dc32
GV
3049 + 3);
3050
3051 /* Start with emacs.FRAMENAME for the name (the specific one)
3052 and with `Emacs' for the class key (the general one). */
d5db4077 3053 strcpy (name_key, SDATA (Vx_resource_name));
ee78dc32
GV
3054 strcpy (class_key, EMACS_CLASS);
3055
3056 strcat (class_key, ".");
d5db4077 3057 strcat (class_key, SDATA (class));
ee78dc32
GV
3058
3059 if (!NILP (component))
3060 {
3061 strcat (class_key, ".");
d5db4077 3062 strcat (class_key, SDATA (subclass));
ee78dc32
GV
3063
3064 strcat (name_key, ".");
d5db4077 3065 strcat (name_key, SDATA (component));
ee78dc32
GV
3066 }
3067
3068 strcat (name_key, ".");
d5db4077 3069 strcat (name_key, SDATA (attribute));
ee78dc32
GV
3070
3071 value = x_get_string_resource (Qnil,
3072 name_key, class_key);
3073
3074 if (value != (char *) 0)
3075 return build_string (value);
3076 else
3077 return Qnil;
3078}
3079
3080/* Used when C code wants a resource value. */
3081
3082char *
3083x_get_resource_string (attribute, class)
3084 char *attribute, *class;
3085{
ee78dc32
GV
3086 char *name_key;
3087 char *class_key;
6fc2811b 3088 struct frame *sf = SELECTED_FRAME ();
ee78dc32
GV
3089
3090 /* Allocate space for the components, the dots which separate them,
3091 and the final '\0'. */
d5db4077 3092 name_key = (char *) alloca (SBYTES (Vinvocation_name)
ee78dc32
GV
3093 + strlen (attribute) + 2);
3094 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
3095 + strlen (class) + 2);
3096
3097 sprintf (name_key, "%s.%s",
d5db4077 3098 SDATA (Vinvocation_name),
ee78dc32
GV
3099 attribute);
3100 sprintf (class_key, "%s.%s", EMACS_CLASS, class);
3101
6fc2811b 3102 return x_get_string_resource (sf, name_key, class_key);
ee78dc32
GV
3103}
3104
3105/* Types we might convert a resource string into. */
3106enum resource_types
6fc2811b
JR
3107{
3108 RES_TYPE_NUMBER,
3109 RES_TYPE_FLOAT,
3110 RES_TYPE_BOOLEAN,
3111 RES_TYPE_STRING,
3112 RES_TYPE_SYMBOL
3113};
ee78dc32
GV
3114
3115/* Return the value of parameter PARAM.
3116
3117 First search ALIST, then Vdefault_frame_alist, then the X defaults
3118 database, using ATTRIBUTE as the attribute name and CLASS as its class.
3119
3120 Convert the resource to the type specified by desired_type.
3121
3122 If no default is specified, return Qunbound. If you call
6fc2811b 3123 w32_get_arg, make sure you deal with Qunbound in a reasonable way,
ee78dc32
GV
3124 and don't let it get stored in any Lisp-visible variables! */
3125
3126static Lisp_Object
6fc2811b 3127w32_get_arg (alist, param, attribute, class, type)
ee78dc32
GV
3128 Lisp_Object alist, param;
3129 char *attribute;
3130 char *class;
3131 enum resource_types type;
3132{
3133 register Lisp_Object tem;
3134
3135 tem = Fassq (param, alist);
3136 if (EQ (tem, Qnil))
3137 tem = Fassq (param, Vdefault_frame_alist);
3138 if (EQ (tem, Qnil))
3139 {
3140
3141 if (attribute)
3142 {
3143 tem = Fx_get_resource (build_string (attribute),
3144 build_string (class),
3145 Qnil, Qnil);
3146
3147 if (NILP (tem))
3148 return Qunbound;
3149
3150 switch (type)
3151 {
6fc2811b 3152 case RES_TYPE_NUMBER:
d5db4077 3153 return make_number (atoi (SDATA (tem)));
ee78dc32 3154
6fc2811b 3155 case RES_TYPE_FLOAT:
d5db4077 3156 return make_float (atof (SDATA (tem)));
6fc2811b
JR
3157
3158 case RES_TYPE_BOOLEAN:
ee78dc32 3159 tem = Fdowncase (tem);
d5db4077
KR
3160 if (!strcmp (SDATA (tem), "on")
3161 || !strcmp (SDATA (tem), "true"))
ee78dc32
GV
3162 return Qt;
3163 else
3164 return Qnil;
3165
6fc2811b 3166 case RES_TYPE_STRING:
ee78dc32
GV
3167 return tem;
3168
6fc2811b 3169 case RES_TYPE_SYMBOL:
ee78dc32
GV
3170 /* As a special case, we map the values `true' and `on'
3171 to Qt, and `false' and `off' to Qnil. */
3172 {
3173 Lisp_Object lower;
3174 lower = Fdowncase (tem);
d5db4077
KR
3175 if (!strcmp (SDATA (lower), "on")
3176 || !strcmp (SDATA (lower), "true"))
ee78dc32 3177 return Qt;
d5db4077
KR
3178 else if (!strcmp (SDATA (lower), "off")
3179 || !strcmp (SDATA (lower), "false"))
ee78dc32
GV
3180 return Qnil;
3181 else
3182 return Fintern (tem, Qnil);
3183 }
3184
3185 default:
3186 abort ();
3187 }
3188 }
3189 else
3190 return Qunbound;
3191 }
3192 return Fcdr (tem);
3193}
3194
3195/* Record in frame F the specified or default value according to ALIST
dfff8a69
JR
3196 of the parameter named PROP (a Lisp symbol).
3197 If no value is specified for PROP, look for an X default for XPROP
ee78dc32
GV
3198 on the frame named NAME.
3199 If that is not found either, use the value DEFLT. */
3200
3201static Lisp_Object
3202x_default_parameter (f, alist, prop, deflt, xprop, xclass, type)
3203 struct frame *f;
3204 Lisp_Object alist;
3205 Lisp_Object prop;
3206 Lisp_Object deflt;
3207 char *xprop;
3208 char *xclass;
3209 enum resource_types type;
3210{
3211 Lisp_Object tem;
3212
6fc2811b 3213 tem = w32_get_arg (alist, prop, xprop, xclass, type);
ee78dc32
GV
3214 if (EQ (tem, Qunbound))
3215 tem = deflt;
3216 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
3217 return tem;
3218}
3219\f
3220DEFUN ("x-parse-geometry", Fx_parse_geometry, Sx_parse_geometry, 1, 1, 0,
74e1aeec
JR
3221 doc: /* Parse an X-style geometry string STRING.
3222Returns an alist of the form ((top . TOP), (left . LEFT) ... ).
3223The properties returned may include `top', `left', `height', and `width'.
3224The value of `left' or `top' may be an integer,
3225or a list (+ N) meaning N pixels relative to top/left corner,
3226or a list (- N) meaning -N pixels relative to bottom/right corner. */)
ee78dc32
GV
3227 (string)
3228 Lisp_Object string;
3229{
3230 int geometry, x, y;
3231 unsigned int width, height;
3232 Lisp_Object result;
3233
b7826503 3234 CHECK_STRING (string);
ee78dc32 3235
d5db4077 3236 geometry = XParseGeometry ((char *) SDATA (string),
ee78dc32
GV
3237 &x, &y, &width, &height);
3238
3239 result = Qnil;
3240 if (geometry & XValue)
3241 {
3242 Lisp_Object element;
3243
3244 if (x >= 0 && (geometry & XNegative))
3245 element = Fcons (Qleft, Fcons (Qminus, Fcons (make_number (-x), Qnil)));
3246 else if (x < 0 && ! (geometry & XNegative))
3247 element = Fcons (Qleft, Fcons (Qplus, Fcons (make_number (x), Qnil)));
3248 else
3249 element = Fcons (Qleft, make_number (x));
3250 result = Fcons (element, result);
3251 }
3252
3253 if (geometry & YValue)
3254 {
3255 Lisp_Object element;
3256
3257 if (y >= 0 && (geometry & YNegative))
3258 element = Fcons (Qtop, Fcons (Qminus, Fcons (make_number (-y), Qnil)));
3259 else if (y < 0 && ! (geometry & YNegative))
3260 element = Fcons (Qtop, Fcons (Qplus, Fcons (make_number (y), Qnil)));
3261 else
3262 element = Fcons (Qtop, make_number (y));
3263 result = Fcons (element, result);
3264 }
3265
3266 if (geometry & WidthValue)
3267 result = Fcons (Fcons (Qwidth, make_number (width)), result);
3268 if (geometry & HeightValue)
3269 result = Fcons (Fcons (Qheight, make_number (height)), result);
3270
3271 return result;
3272}
3273
3274/* Calculate the desired size and position of this window,
3275 and return the flags saying which aspects were specified.
3276
3277 This function does not make the coordinates positive. */
3278
3279#define DEFAULT_ROWS 40
3280#define DEFAULT_COLS 80
3281
3282static int
3283x_figure_window_size (f, parms)
3284 struct frame *f;
3285 Lisp_Object parms;
3286{
3287 register Lisp_Object tem0, tem1, tem2;
ee78dc32
GV
3288 long window_prompting = 0;
3289
3290 /* Default values if we fall through.
3291 Actually, if that happens we should get
3292 window manager prompting. */
1026b400 3293 SET_FRAME_WIDTH (f, DEFAULT_COLS);
ee78dc32
GV
3294 f->height = DEFAULT_ROWS;
3295 /* Window managers expect that if program-specified
3296 positions are not (0,0), they're intentional, not defaults. */
fbd6baed
GV
3297 f->output_data.w32->top_pos = 0;
3298 f->output_data.w32->left_pos = 0;
ee78dc32 3299
35b41202
JR
3300 /* Ensure that old new_width and new_height will not override the
3301 values set here. */
3302 FRAME_NEW_WIDTH (f) = 0;
3303 FRAME_NEW_HEIGHT (f) = 0;
3304
6fc2811b
JR
3305 tem0 = w32_get_arg (parms, Qheight, 0, 0, RES_TYPE_NUMBER);
3306 tem1 = w32_get_arg (parms, Qwidth, 0, 0, RES_TYPE_NUMBER);
3307 tem2 = w32_get_arg (parms, Quser_size, 0, 0, RES_TYPE_NUMBER);
ee78dc32
GV
3308 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
3309 {
3310 if (!EQ (tem0, Qunbound))
3311 {
b7826503 3312 CHECK_NUMBER (tem0);
ee78dc32
GV
3313 f->height = XINT (tem0);
3314 }
3315 if (!EQ (tem1, Qunbound))
3316 {
b7826503 3317 CHECK_NUMBER (tem1);
1026b400 3318 SET_FRAME_WIDTH (f, XINT (tem1));
ee78dc32
GV
3319 }
3320 if (!NILP (tem2) && !EQ (tem2, Qunbound))
3321 window_prompting |= USSize;
3322 else
3323 window_prompting |= PSize;
3324 }
3325
fbd6baed 3326 f->output_data.w32->vertical_scroll_bar_extra
ee78dc32
GV
3327 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f)
3328 ? 0
3329 : FRAME_SCROLL_BAR_PIXEL_WIDTH (f) > 0
3330 ? FRAME_SCROLL_BAR_PIXEL_WIDTH (f)
fbd6baed 3331 : (FRAME_SCROLL_BAR_COLS (f) * FONT_WIDTH (f->output_data.w32->font)));
f7b9d4d1 3332
41c1bdd9 3333 x_compute_fringe_widths (f, 0);
f7b9d4d1 3334
fbd6baed
GV
3335 f->output_data.w32->pixel_width = CHAR_TO_PIXEL_WIDTH (f, f->width);
3336 f->output_data.w32->pixel_height = CHAR_TO_PIXEL_HEIGHT (f, f->height);
ee78dc32 3337
6fc2811b
JR
3338 tem0 = w32_get_arg (parms, Qtop, 0, 0, RES_TYPE_NUMBER);
3339 tem1 = w32_get_arg (parms, Qleft, 0, 0, RES_TYPE_NUMBER);
3340 tem2 = w32_get_arg (parms, Quser_position, 0, 0, RES_TYPE_NUMBER);
ee78dc32
GV
3341 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
3342 {
3343 if (EQ (tem0, Qminus))
3344 {
fbd6baed 3345 f->output_data.w32->top_pos = 0;
ee78dc32
GV
3346 window_prompting |= YNegative;
3347 }
8e713be6
KR
3348 else if (CONSP (tem0) && EQ (XCAR (tem0), Qminus)
3349 && CONSP (XCDR (tem0))
3350 && INTEGERP (XCAR (XCDR (tem0))))
ee78dc32 3351 {
8e713be6 3352 f->output_data.w32->top_pos = - XINT (XCAR (XCDR (tem0)));
ee78dc32
GV
3353 window_prompting |= YNegative;
3354 }
8e713be6
KR
3355 else if (CONSP (tem0) && EQ (XCAR (tem0), Qplus)
3356 && CONSP (XCDR (tem0))
3357 && INTEGERP (XCAR (XCDR (tem0))))
ee78dc32 3358 {
8e713be6 3359 f->output_data.w32->top_pos = XINT (XCAR (XCDR (tem0)));
ee78dc32
GV
3360 }
3361 else if (EQ (tem0, Qunbound))
fbd6baed 3362 f->output_data.w32->top_pos = 0;
ee78dc32
GV
3363 else
3364 {
b7826503 3365 CHECK_NUMBER (tem0);
fbd6baed
GV
3366 f->output_data.w32->top_pos = XINT (tem0);
3367 if (f->output_data.w32->top_pos < 0)
ee78dc32
GV
3368 window_prompting |= YNegative;
3369 }
3370
3371 if (EQ (tem1, Qminus))
3372 {
fbd6baed 3373 f->output_data.w32->left_pos = 0;
ee78dc32
GV
3374 window_prompting |= XNegative;
3375 }
8e713be6
KR
3376 else if (CONSP (tem1) && EQ (XCAR (tem1), Qminus)
3377 && CONSP (XCDR (tem1))
3378 && INTEGERP (XCAR (XCDR (tem1))))
ee78dc32 3379 {
8e713be6 3380 f->output_data.w32->left_pos = - XINT (XCAR (XCDR (tem1)));
ee78dc32
GV
3381 window_prompting |= XNegative;
3382 }
8e713be6
KR
3383 else if (CONSP (tem1) && EQ (XCAR (tem1), Qplus)
3384 && CONSP (XCDR (tem1))
3385 && INTEGERP (XCAR (XCDR (tem1))))
ee78dc32 3386 {
8e713be6 3387 f->output_data.w32->left_pos = XINT (XCAR (XCDR (tem1)));
ee78dc32
GV
3388 }
3389 else if (EQ (tem1, Qunbound))
fbd6baed 3390 f->output_data.w32->left_pos = 0;
ee78dc32
GV
3391 else
3392 {
b7826503 3393 CHECK_NUMBER (tem1);
fbd6baed
GV
3394 f->output_data.w32->left_pos = XINT (tem1);
3395 if (f->output_data.w32->left_pos < 0)
ee78dc32
GV
3396 window_prompting |= XNegative;
3397 }
3398
3399 if (!NILP (tem2) && ! EQ (tem2, Qunbound))
3400 window_prompting |= USPosition;
3401 else
3402 window_prompting |= PPosition;
3403 }
3404
f7b9d4d1
JR
3405 if (f->output_data.w32->want_fullscreen != FULLSCREEN_NONE)
3406 {
3407 int left, top;
3408 int width, height;
3409
3410 /* It takes both for some WM:s to place it where we want */
3411 window_prompting = USPosition | PPosition;
3412 x_fullscreen_adjust (f, &width, &height, &top, &left);
3413 f->width = width;
3414 f->height = height;
3415 f->output_data.w32->pixel_width = CHAR_TO_PIXEL_WIDTH (f, f->width);
3416 f->output_data.w32->pixel_height = CHAR_TO_PIXEL_HEIGHT (f, f->height);
3417 f->output_data.w32->left_pos = left;
3418 f->output_data.w32->top_pos = top;
3419 }
3420
ee78dc32
GV
3421 return window_prompting;
3422}
3423
3424\f
3425
fbd6baed 3426extern LRESULT CALLBACK w32_wnd_proc ();
ee78dc32
GV
3427
3428BOOL
fbd6baed 3429w32_init_class (hinst)
ee78dc32
GV
3430 HINSTANCE hinst;
3431{
3432 WNDCLASS wc;
3433
5ac45f98 3434 wc.style = CS_HREDRAW | CS_VREDRAW;
fbd6baed 3435 wc.lpfnWndProc = (WNDPROC) w32_wnd_proc;
ee78dc32
GV
3436 wc.cbClsExtra = 0;
3437 wc.cbWndExtra = WND_EXTRA_BYTES;
3438 wc.hInstance = hinst;
3439 wc.hIcon = LoadIcon (hinst, EMACS_CLASS);
3440 wc.hCursor = LoadCursor (NULL, IDC_ARROW);
4587b026 3441 wc.hbrBackground = NULL; /* GetStockObject (WHITE_BRUSH); */
ee78dc32
GV
3442 wc.lpszMenuName = NULL;
3443 wc.lpszClassName = EMACS_CLASS;
3444
3445 return (RegisterClass (&wc));
3446}
3447
3448HWND
fbd6baed 3449w32_createscrollbar (f, bar)
ee78dc32
GV
3450 struct frame *f;
3451 struct scroll_bar * bar;
3452{
3453 return (CreateWindow ("SCROLLBAR", "", SBS_VERT | WS_CHILD | WS_VISIBLE,
3454 /* Position and size of scroll bar. */
6fc2811b
JR
3455 XINT(bar->left) + VERTICAL_SCROLL_BAR_WIDTH_TRIM,
3456 XINT(bar->top),
3457 XINT(bar->width) - VERTICAL_SCROLL_BAR_WIDTH_TRIM * 2,
3458 XINT(bar->height),
fbd6baed 3459 FRAME_W32_WINDOW (f),
ee78dc32
GV
3460 NULL,
3461 hinst,
3462 NULL));
3463}
3464
3465void
fbd6baed 3466w32_createwindow (f)
ee78dc32
GV
3467 struct frame *f;
3468{
3469 HWND hwnd;
1edf84e7
GV
3470 RECT rect;
3471
3472 rect.left = rect.top = 0;
3473 rect.right = PIXEL_WIDTH (f);
3474 rect.bottom = PIXEL_HEIGHT (f);
3475
3476 AdjustWindowRect (&rect, f->output_data.w32->dwStyle,
3477 FRAME_EXTERNAL_MENU_BAR (f));
ee78dc32
GV
3478
3479 /* Do first time app init */
3480
3481 if (!hprevinst)
3482 {
fbd6baed 3483 w32_init_class (hinst);
ee78dc32
GV
3484 }
3485
1edf84e7
GV
3486 FRAME_W32_WINDOW (f) = hwnd
3487 = CreateWindow (EMACS_CLASS,
3488 f->namebuf,
9ead1b60 3489 f->output_data.w32->dwStyle | WS_CLIPCHILDREN,
1edf84e7
GV
3490 f->output_data.w32->left_pos,
3491 f->output_data.w32->top_pos,
3492 rect.right - rect.left,
3493 rect.bottom - rect.top,
3494 NULL,
3495 NULL,
3496 hinst,
3497 NULL);
3498
ee78dc32
GV
3499 if (hwnd)
3500 {
1edf84e7
GV
3501 SetWindowLong (hwnd, WND_FONTWIDTH_INDEX, FONT_WIDTH (f->output_data.w32->font));
3502 SetWindowLong (hwnd, WND_LINEHEIGHT_INDEX, f->output_data.w32->line_height);
3503 SetWindowLong (hwnd, WND_BORDER_INDEX, f->output_data.w32->internal_border_width);
3504 SetWindowLong (hwnd, WND_SCROLLBAR_INDEX, f->output_data.w32->vertical_scroll_bar_extra);
6fc2811b 3505 SetWindowLong (hwnd, WND_BACKGROUND_INDEX, FRAME_BACKGROUND_PIXEL (f));
ee78dc32 3506
cb9e33d4
RS
3507 /* Enable drag-n-drop. */
3508 DragAcceptFiles (hwnd, TRUE);
3509
5ac45f98
GV
3510 /* Do this to discard the default setting specified by our parent. */
3511 ShowWindow (hwnd, SW_HIDE);
3c190163 3512 }
3c190163
GV
3513}
3514
ee78dc32
GV
3515void
3516my_post_msg (wmsg, hwnd, msg, wParam, lParam)
fbd6baed 3517 W32Msg * wmsg;
ee78dc32
GV
3518 HWND hwnd;
3519 UINT msg;
3520 WPARAM wParam;
3521 LPARAM lParam;
3522{
3523 wmsg->msg.hwnd = hwnd;
3524 wmsg->msg.message = msg;
3525 wmsg->msg.wParam = wParam;
3526 wmsg->msg.lParam = lParam;
3527 wmsg->msg.time = GetMessageTime ();
3528
3529 post_msg (wmsg);
3530}
3531
e9e23e23 3532/* GetKeyState and MapVirtualKey on Windows 95 do not actually distinguish
a1a80b40
GV
3533 between left and right keys as advertised. We test for this
3534 support dynamically, and set a flag when the support is absent. If
3535 absent, we keep track of the left and right control and alt keys
3536 ourselves. This is particularly necessary on keyboards that rely
3537 upon the AltGr key, which is represented as having the left control
3538 and right alt keys pressed. For these keyboards, we need to know
3539 when the left alt key has been pressed in addition to the AltGr key
3540 so that we can properly support M-AltGr-key sequences (such as M-@
3541 on Swedish keyboards). */
3542
3543#define EMACS_LCONTROL 0
3544#define EMACS_RCONTROL 1
3545#define EMACS_LMENU 2
3546#define EMACS_RMENU 3
3547
3548static int modifiers[4];
3549static int modifiers_recorded;
3550static int modifier_key_support_tested;
3551
3552static void
3553test_modifier_support (unsigned int wparam)
3554{
3555 unsigned int l, r;
3556
3557 if (wparam != VK_CONTROL && wparam != VK_MENU)
3558 return;
3559 if (wparam == VK_CONTROL)
3560 {
3561 l = VK_LCONTROL;
3562 r = VK_RCONTROL;
3563 }
3564 else
3565 {
3566 l = VK_LMENU;
3567 r = VK_RMENU;
3568 }
3569 if (!(GetKeyState (l) & 0x8000) && !(GetKeyState (r) & 0x8000))
3570 modifiers_recorded = 1;
3571 else
3572 modifiers_recorded = 0;
3573 modifier_key_support_tested = 1;
3574}
3575
3576static void
3577record_keydown (unsigned int wparam, unsigned int lparam)
3578{
3579 int i;
3580
3581 if (!modifier_key_support_tested)
3582 test_modifier_support (wparam);
3583
3584 if ((wparam != VK_CONTROL && wparam != VK_MENU) || !modifiers_recorded)
3585 return;
3586
3587 if (wparam == VK_CONTROL)
3588 i = (lparam & 0x1000000) ? EMACS_RCONTROL : EMACS_LCONTROL;
3589 else
3590 i = (lparam & 0x1000000) ? EMACS_RMENU : EMACS_LMENU;
3591
3592 modifiers[i] = 1;
3593}
3594
3595static void
3596record_keyup (unsigned int wparam, unsigned int lparam)
3597{
3598 int i;
3599
3600 if ((wparam != VK_CONTROL && wparam != VK_MENU) || !modifiers_recorded)
3601 return;
3602
3603 if (wparam == VK_CONTROL)
3604 i = (lparam & 0x1000000) ? EMACS_RCONTROL : EMACS_LCONTROL;
3605 else
3606 i = (lparam & 0x1000000) ? EMACS_RMENU : EMACS_LMENU;
3607
3608 modifiers[i] = 0;
3609}
3610
da36a4d6
GV
3611/* Emacs can lose focus while a modifier key has been pressed. When
3612 it regains focus, be conservative and clear all modifiers since
3613 we cannot reconstruct the left and right modifier state. */
3614static void
3615reset_modifiers ()
3616{
8681157a
RS
3617 SHORT ctrl, alt;
3618
adcc3809
GV
3619 if (GetFocus () == NULL)
3620 /* Emacs doesn't have keyboard focus. Do nothing. */
da36a4d6 3621 return;
8681157a
RS
3622
3623 ctrl = GetAsyncKeyState (VK_CONTROL);
3624 alt = GetAsyncKeyState (VK_MENU);
3625
8681157a
RS
3626 if (!(ctrl & 0x08000))
3627 /* Clear any recorded control modifier state. */
3628 modifiers[EMACS_RCONTROL] = modifiers[EMACS_LCONTROL] = 0;
3629
3630 if (!(alt & 0x08000))
3631 /* Clear any recorded alt modifier state. */
3632 modifiers[EMACS_RMENU] = modifiers[EMACS_LMENU] = 0;
3633
adcc3809
GV
3634 /* Update the state of all modifier keys, because modifiers used in
3635 hot-key combinations can get stuck on if Emacs loses focus as a
3636 result of a hot-key being pressed. */
3637 {
3638 BYTE keystate[256];
3639
3640#define CURRENT_STATE(key) ((GetAsyncKeyState (key) & 0x8000) >> 8)
3641
3642 GetKeyboardState (keystate);
3643 keystate[VK_SHIFT] = CURRENT_STATE (VK_SHIFT);
3644 keystate[VK_CONTROL] = CURRENT_STATE (VK_CONTROL);
3645 keystate[VK_LCONTROL] = CURRENT_STATE (VK_LCONTROL);
3646 keystate[VK_RCONTROL] = CURRENT_STATE (VK_RCONTROL);
3647 keystate[VK_MENU] = CURRENT_STATE (VK_MENU);
3648 keystate[VK_LMENU] = CURRENT_STATE (VK_LMENU);
3649 keystate[VK_RMENU] = CURRENT_STATE (VK_RMENU);
3650 keystate[VK_LWIN] = CURRENT_STATE (VK_LWIN);
3651 keystate[VK_RWIN] = CURRENT_STATE (VK_RWIN);
3652 keystate[VK_APPS] = CURRENT_STATE (VK_APPS);
3653 SetKeyboardState (keystate);
3654 }
da36a4d6
GV
3655}
3656
7830e24b
RS
3657/* Synchronize modifier state with what is reported with the current
3658 keystroke. Even if we cannot distinguish between left and right
3659 modifier keys, we know that, if no modifiers are set, then neither
3660 the left or right modifier should be set. */
3661static void
3662sync_modifiers ()
3663{
3664 if (!modifiers_recorded)
3665 return;
3666
3667 if (!(GetKeyState (VK_CONTROL) & 0x8000))
3668 modifiers[EMACS_RCONTROL] = modifiers[EMACS_LCONTROL] = 0;
3669
3670 if (!(GetKeyState (VK_MENU) & 0x8000))
3671 modifiers[EMACS_RMENU] = modifiers[EMACS_LMENU] = 0;
3672}
3673
a1a80b40
GV
3674static int
3675modifier_set (int vkey)
3676{
ccc2d29c 3677 if (vkey == VK_CAPITAL || vkey == VK_SCROLL)
891560d6 3678 return (GetKeyState (vkey) & 0x1);
a1a80b40
GV
3679 if (!modifiers_recorded)
3680 return (GetKeyState (vkey) & 0x8000);
3681
3682 switch (vkey)
3683 {
3684 case VK_LCONTROL:
3685 return modifiers[EMACS_LCONTROL];
3686 case VK_RCONTROL:
3687 return modifiers[EMACS_RCONTROL];
3688 case VK_LMENU:
3689 return modifiers[EMACS_LMENU];
3690 case VK_RMENU:
3691 return modifiers[EMACS_RMENU];
a1a80b40
GV
3692 }
3693 return (GetKeyState (vkey) & 0x8000);
3694}
3695
ccc2d29c
GV
3696/* Convert between the modifier bits W32 uses and the modifier bits
3697 Emacs uses. */
3698
3699unsigned int
3700w32_key_to_modifier (int key)
3701{
3702 Lisp_Object key_mapping;
3703
3704 switch (key)
3705 {
3706 case VK_LWIN:
3707 key_mapping = Vw32_lwindow_modifier;
3708 break;
3709 case VK_RWIN:
3710 key_mapping = Vw32_rwindow_modifier;
3711 break;
3712 case VK_APPS:
3713 key_mapping = Vw32_apps_modifier;
3714 break;
3715 case VK_SCROLL:
3716 key_mapping = Vw32_scroll_lock_modifier;
3717 break;
3718 default:
3719 key_mapping = Qnil;
3720 }
3721
adcc3809
GV
3722 /* NB. This code runs in the input thread, asychronously to the lisp
3723 thread, so we must be careful to ensure access to lisp data is
3724 thread-safe. The following code is safe because the modifier
3725 variable values are updated atomically from lisp and symbols are
3726 not relocated by GC. Also, we don't have to worry about seeing GC
3727 markbits here. */
3728 if (EQ (key_mapping, Qhyper))
ccc2d29c 3729 return hyper_modifier;
adcc3809 3730 if (EQ (key_mapping, Qsuper))
ccc2d29c 3731 return super_modifier;
adcc3809 3732 if (EQ (key_mapping, Qmeta))
ccc2d29c 3733 return meta_modifier;
adcc3809 3734 if (EQ (key_mapping, Qalt))
ccc2d29c 3735 return alt_modifier;
adcc3809 3736 if (EQ (key_mapping, Qctrl))
ccc2d29c 3737 return ctrl_modifier;
adcc3809 3738 if (EQ (key_mapping, Qcontrol)) /* synonym for ctrl */
ccc2d29c 3739 return ctrl_modifier;
adcc3809 3740 if (EQ (key_mapping, Qshift))
ccc2d29c
GV
3741 return shift_modifier;
3742
3743 /* Don't generate any modifier if not explicitly requested. */
3744 return 0;
3745}
3746
3747unsigned int
3748w32_get_modifiers ()
3749{
3750 return ((modifier_set (VK_SHIFT) ? shift_modifier : 0) |
3751 (modifier_set (VK_CONTROL) ? ctrl_modifier : 0) |
3752 (modifier_set (VK_LWIN) ? w32_key_to_modifier (VK_LWIN) : 0) |
3753 (modifier_set (VK_RWIN) ? w32_key_to_modifier (VK_RWIN) : 0) |
3754 (modifier_set (VK_APPS) ? w32_key_to_modifier (VK_APPS) : 0) |
3755 (modifier_set (VK_SCROLL) ? w32_key_to_modifier (VK_SCROLL) : 0) |
3756 (modifier_set (VK_MENU) ?
3757 ((NILP (Vw32_alt_is_meta)) ? alt_modifier : meta_modifier) : 0));
3758}
3759
a1a80b40
GV
3760/* We map the VK_* modifiers into console modifier constants
3761 so that we can use the same routines to handle both console
3762 and window input. */
3763
3764static int
ccc2d29c 3765construct_console_modifiers ()
a1a80b40
GV
3766{
3767 int mods;
3768
a1a80b40
GV
3769 mods = 0;
3770 mods |= (modifier_set (VK_SHIFT)) ? SHIFT_PRESSED : 0;
3771 mods |= (modifier_set (VK_CAPITAL)) ? CAPSLOCK_ON : 0;
ccc2d29c
GV
3772 mods |= (modifier_set (VK_SCROLL)) ? SCROLLLOCK_ON : 0;
3773 mods |= (modifier_set (VK_NUMLOCK)) ? NUMLOCK_ON : 0;
a1a80b40
GV
3774 mods |= (modifier_set (VK_LCONTROL)) ? LEFT_CTRL_PRESSED : 0;
3775 mods |= (modifier_set (VK_RCONTROL)) ? RIGHT_CTRL_PRESSED : 0;
3776 mods |= (modifier_set (VK_LMENU)) ? LEFT_ALT_PRESSED : 0;
3777 mods |= (modifier_set (VK_RMENU)) ? RIGHT_ALT_PRESSED : 0;
ccc2d29c
GV
3778 mods |= (modifier_set (VK_LWIN)) ? LEFT_WIN_PRESSED : 0;
3779 mods |= (modifier_set (VK_RWIN)) ? RIGHT_WIN_PRESSED : 0;
3780 mods |= (modifier_set (VK_APPS)) ? APPS_PRESSED : 0;
a1a80b40
GV
3781
3782 return mods;
3783}
3784
ccc2d29c
GV
3785static int
3786w32_get_key_modifiers (unsigned int wparam, unsigned int lparam)
da36a4d6 3787{
ccc2d29c
GV
3788 int mods;
3789
3790 /* Convert to emacs modifiers. */
3791 mods = w32_kbd_mods_to_emacs (construct_console_modifiers (), wparam);
3792
3793 return mods;
3794}
da36a4d6 3795
ccc2d29c
GV
3796unsigned int
3797map_keypad_keys (unsigned int virt_key, unsigned int extended)
3798{
3799 if (virt_key < VK_CLEAR || virt_key > VK_DELETE)
3800 return virt_key;
da36a4d6 3801
ccc2d29c 3802 if (virt_key == VK_RETURN)
da36a4d6
GV
3803 return (extended ? VK_NUMPAD_ENTER : VK_RETURN);
3804
ccc2d29c
GV
3805 if (virt_key >= VK_PRIOR && virt_key <= VK_DOWN)
3806 return (!extended ? (VK_NUMPAD_PRIOR + (virt_key - VK_PRIOR)) : virt_key);
3807
3808 if (virt_key == VK_INSERT || virt_key == VK_DELETE)
3809 return (!extended ? (VK_NUMPAD_INSERT + (virt_key - VK_INSERT)) : virt_key);
3810
3811 if (virt_key == VK_CLEAR)
3812 return (!extended ? VK_NUMPAD_CLEAR : virt_key);
3813
3814 return virt_key;
3815}
3816
3817/* List of special key combinations which w32 would normally capture,
3818 but emacs should grab instead. Not directly visible to lisp, to
3819 simplify synchronization. Each item is an integer encoding a virtual
3820 key code and modifier combination to capture. */
3821Lisp_Object w32_grabbed_keys;
3822
3823#define HOTKEY(vk,mods) make_number (((vk) & 255) | ((mods) << 8))
3824#define HOTKEY_ID(k) (XFASTINT (k) & 0xbfff)
3825#define HOTKEY_VK_CODE(k) (XFASTINT (k) & 255)
3826#define HOTKEY_MODIFIERS(k) (XFASTINT (k) >> 8)
3827
3828/* Register hot-keys for reserved key combinations when Emacs has
3829 keyboard focus, since this is the only way Emacs can receive key
3830 combinations like Alt-Tab which are used by the system. */
3831
3832static void
3833register_hot_keys (hwnd)
3834 HWND hwnd;
3835{
3836 Lisp_Object keylist;
3837
3838 /* Use GC_CONSP, since we are called asynchronously. */
3839 for (keylist = w32_grabbed_keys; GC_CONSP (keylist); keylist = XCDR (keylist))
3840 {
3841 Lisp_Object key = XCAR (keylist);
3842
3843 /* Deleted entries get set to nil. */
3844 if (!INTEGERP (key))
3845 continue;
3846
3847 RegisterHotKey (hwnd, HOTKEY_ID (key),
3848 HOTKEY_MODIFIERS (key), HOTKEY_VK_CODE (key));
3849 }
3850}
3851
3852static void
3853unregister_hot_keys (hwnd)
3854 HWND hwnd;
3855{
3856 Lisp_Object keylist;
3857
3858 /* Use GC_CONSP, since we are called asynchronously. */
3859 for (keylist = w32_grabbed_keys; GC_CONSP (keylist); keylist = XCDR (keylist))
3860 {
3861 Lisp_Object key = XCAR (keylist);
3862
3863 if (!INTEGERP (key))
3864 continue;
3865
3866 UnregisterHotKey (hwnd, HOTKEY_ID (key));
3867 }
3868}
3869
5ac45f98
GV
3870/* Main message dispatch loop. */
3871
1edf84e7
GV
3872static void
3873w32_msg_pump (deferred_msg * msg_buf)
5ac45f98
GV
3874{
3875 MSG msg;
ccc2d29c
GV
3876 int result;
3877 HWND focus_window;
93fbe8b7
GV
3878
3879 msh_mousewheel = RegisterWindowMessage (MSH_MOUSEWHEEL);
5ac45f98 3880
5ac45f98
GV
3881 while (GetMessage (&msg, NULL, 0, 0))
3882 {
3883 if (msg.hwnd == NULL)
3884 {
3885 switch (msg.message)
3886 {
3ef68e6b
AI
3887 case WM_NULL:
3888 /* Produced by complete_deferred_msg; just ignore. */
3889 break;
5ac45f98 3890 case WM_EMACS_CREATEWINDOW:
fbd6baed 3891 w32_createwindow ((struct frame *) msg.wParam);
1edf84e7
GV
3892 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0))
3893 abort ();
5ac45f98 3894 break;
dfdb4047
GV
3895 case WM_EMACS_SETLOCALE:
3896 SetThreadLocale (msg.wParam);
3897 /* Reply is not expected. */
3898 break;
ccc2d29c
GV
3899 case WM_EMACS_SETKEYBOARDLAYOUT:
3900 result = (int) ActivateKeyboardLayout ((HKL) msg.wParam, 0);
3901 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE,
3902 result, 0))
3903 abort ();
3904 break;
3905 case WM_EMACS_REGISTER_HOT_KEY:
3906 focus_window = GetFocus ();
3907 if (focus_window != NULL)
3908 RegisterHotKey (focus_window,
3909 HOTKEY_ID (msg.wParam),
3910 HOTKEY_MODIFIERS (msg.wParam),
3911 HOTKEY_VK_CODE (msg.wParam));
3912 /* Reply is not expected. */
3913 break;
3914 case WM_EMACS_UNREGISTER_HOT_KEY:
3915 focus_window = GetFocus ();
3916 if (focus_window != NULL)
3917 UnregisterHotKey (focus_window, HOTKEY_ID (msg.wParam));
adcc3809
GV
3918 /* Mark item as erased. NB: this code must be
3919 thread-safe. The next line is okay because the cons
3920 cell is never made into garbage and is not relocated by
3921 GC. */
f3fbd155 3922 XSETCAR ((Lisp_Object) msg.lParam, Qnil);
ccc2d29c
GV
3923 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0))
3924 abort ();
3925 break;
adcc3809
GV
3926 case WM_EMACS_TOGGLE_LOCK_KEY:
3927 {
3928 int vk_code = (int) msg.wParam;
3929 int cur_state = (GetKeyState (vk_code) & 1);
3930 Lisp_Object new_state = (Lisp_Object) msg.lParam;
3931
3932 /* NB: This code must be thread-safe. It is safe to
3933 call NILP because symbols are not relocated by GC,
3934 and pointer here is not touched by GC (so the markbit
3935 can't be set). Numbers are safe because they are
3936 immediate values. */
3937 if (NILP (new_state)
3938 || (NUMBERP (new_state)
8edb0a6f 3939 && ((XUINT (new_state)) & 1) != cur_state))
adcc3809
GV
3940 {
3941 one_w32_display_info.faked_key = vk_code;
3942
3943 keybd_event ((BYTE) vk_code,
3944 (BYTE) MapVirtualKey (vk_code, 0),
3945 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
3946 keybd_event ((BYTE) vk_code,
3947 (BYTE) MapVirtualKey (vk_code, 0),
3948 KEYEVENTF_EXTENDEDKEY | 0, 0);
3949 keybd_event ((BYTE) vk_code,
3950 (BYTE) MapVirtualKey (vk_code, 0),
3951 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
3952 cur_state = !cur_state;
3953 }
3954 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE,
3955 cur_state, 0))
3956 abort ();
3957 }
3958 break;
1edf84e7 3959 default:
1edf84e7 3960 DebPrint (("msg %x not expected by w32_msg_pump\n", msg.message));
5ac45f98
GV
3961 }
3962 }
3963 else
3964 {
3965 DispatchMessage (&msg);
3966 }
1edf84e7
GV
3967
3968 /* Exit nested loop when our deferred message has completed. */
3969 if (msg_buf->completed)
3970 break;
5ac45f98 3971 }
1edf84e7
GV
3972}
3973
3974deferred_msg * deferred_msg_head;
3975
3976static deferred_msg *
3977find_deferred_msg (HWND hwnd, UINT msg)
3978{
3979 deferred_msg * item;
3980
3981 /* Don't actually need synchronization for read access, since
3982 modification of single pointer is always atomic. */
3983 /* enter_crit (); */
3984
3985 for (item = deferred_msg_head; item != NULL; item = item->next)
3986 if (item->w32msg.msg.hwnd == hwnd
3987 && item->w32msg.msg.message == msg)
3988 break;
3989
3990 /* leave_crit (); */
3991
3992 return item;
3993}
3994
3995static LRESULT
3996send_deferred_msg (deferred_msg * msg_buf,
3997 HWND hwnd,
3998 UINT msg,
3999 WPARAM wParam,
4000 LPARAM lParam)
4001{
4002 /* Only input thread can send deferred messages. */
4003 if (GetCurrentThreadId () != dwWindowsThreadId)
4004 abort ();
4005
4006 /* It is an error to send a message that is already deferred. */
4007 if (find_deferred_msg (hwnd, msg) != NULL)
4008 abort ();
4009
4010 /* Enforced synchronization is not needed because this is the only
4011 function that alters deferred_msg_head, and the following critical
4012 section is guaranteed to only be serially reentered (since only the
4013 input thread can call us). */
4014
4015 /* enter_crit (); */
4016
4017 msg_buf->completed = 0;
4018 msg_buf->next = deferred_msg_head;
4019 deferred_msg_head = msg_buf;
4020 my_post_msg (&msg_buf->w32msg, hwnd, msg, wParam, lParam);
4021
4022 /* leave_crit (); */
4023
4024 /* Start a new nested message loop to process other messages until
4025 this one is completed. */
4026 w32_msg_pump (msg_buf);
4027
4028 deferred_msg_head = msg_buf->next;
4029
4030 return msg_buf->result;
4031}
4032
4033void
4034complete_deferred_msg (HWND hwnd, UINT msg, LRESULT result)
4035{
4036 deferred_msg * msg_buf = find_deferred_msg (hwnd, msg);
4037
4038 if (msg_buf == NULL)
3ef68e6b
AI
4039 /* Message may have been cancelled, so don't abort(). */
4040 return;
1edf84e7
GV
4041
4042 msg_buf->result = result;
4043 msg_buf->completed = 1;
4044
4045 /* Ensure input thread is woken so it notices the completion. */
4046 PostThreadMessage (dwWindowsThreadId, WM_NULL, 0, 0);
4047}
4048
3ef68e6b
AI
4049void
4050cancel_all_deferred_msgs ()
4051{
4052 deferred_msg * item;
4053
4054 /* Don't actually need synchronization for read access, since
4055 modification of single pointer is always atomic. */
4056 /* enter_crit (); */
4057
4058 for (item = deferred_msg_head; item != NULL; item = item->next)
4059 {
4060 item->result = 0;
4061 item->completed = 1;
4062 }
4063
4064 /* leave_crit (); */
4065
4066 /* Ensure input thread is woken so it notices the completion. */
4067 PostThreadMessage (dwWindowsThreadId, WM_NULL, 0, 0);
4068}
1edf84e7
GV
4069
4070DWORD
4071w32_msg_worker (dw)
4072 DWORD dw;
4073{
4074 MSG msg;
4075 deferred_msg dummy_buf;
4076
4077 /* Ensure our message queue is created */
4078
4079 PeekMessage (&msg, NULL, 0, 0, PM_NOREMOVE);
5ac45f98 4080
1edf84e7
GV
4081 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0))
4082 abort ();
4083
4084 memset (&dummy_buf, 0, sizeof (dummy_buf));
4085 dummy_buf.w32msg.msg.hwnd = NULL;
4086 dummy_buf.w32msg.msg.message = WM_NULL;
4087
4088 /* This is the inital message loop which should only exit when the
4089 application quits. */
4090 w32_msg_pump (&dummy_buf);
4091
4092 return 0;
5ac45f98
GV
4093}
4094
3ef68e6b
AI
4095static void
4096post_character_message (hwnd, msg, wParam, lParam, modifiers)
4097 HWND hwnd;
4098 UINT msg;
4099 WPARAM wParam;
4100 LPARAM lParam;
4101 DWORD modifiers;
4102
4103{
4104 W32Msg wmsg;
4105
4106 wmsg.dwModifiers = modifiers;
4107
4108 /* Detect quit_char and set quit-flag directly. Note that we
4109 still need to post a message to ensure the main thread will be
4110 woken up if blocked in sys_select(), but we do NOT want to post
4111 the quit_char message itself (because it will usually be as if
4112 the user had typed quit_char twice). Instead, we post a dummy
4113 message that has no particular effect. */
4114 {
4115 int c = wParam;
4116 if (isalpha (c) && wmsg.dwModifiers == ctrl_modifier)
4117 c = make_ctrl_char (c) & 0377;
7d081355
AI
4118 if (c == quit_char
4119 || (wmsg.dwModifiers == 0 &&
4120 XFASTINT (Vw32_quit_key) && wParam == XFASTINT (Vw32_quit_key)))
3ef68e6b
AI
4121 {
4122 Vquit_flag = Qt;
4123
4124 /* The choice of message is somewhat arbitrary, as long as
4125 the main thread handler just ignores it. */
4126 msg = WM_NULL;
4127
4128 /* Interrupt any blocking system calls. */
4129 signal_quit ();
4130
4131 /* As a safety precaution, forcibly complete any deferred
4132 messages. This is a kludge, but I don't see any particularly
4133 clean way to handle the situation where a deferred message is
4134 "dropped" in the lisp thread, and will thus never be
4135 completed, eg. by the user trying to activate the menubar
4136 when the lisp thread is busy, and then typing C-g when the
4137 menubar doesn't open promptly (with the result that the
4138 menubar never responds at all because the deferred
4139 WM_INITMENU message is never completed). Another problem
4140 situation is when the lisp thread calls SendMessage (to send
4141 a window manager command) when a message has been deferred;
4142 the lisp thread gets blocked indefinitely waiting for the
4143 deferred message to be completed, which itself is waiting for
4144 the lisp thread to respond.
4145
4146 Note that we don't want to block the input thread waiting for
4147 a reponse from the lisp thread (although that would at least
4148 solve the deadlock problem above), because we want to be able
4149 to receive C-g to interrupt the lisp thread. */
4150 cancel_all_deferred_msgs ();
4151 }
4152 }
4153
4154 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4155}
4156
ee78dc32
GV
4157/* Main window procedure */
4158
ee78dc32 4159LRESULT CALLBACK
fbd6baed 4160w32_wnd_proc (hwnd, msg, wParam, lParam)
ee78dc32
GV
4161 HWND hwnd;
4162 UINT msg;
4163 WPARAM wParam;
4164 LPARAM lParam;
4165{
4166 struct frame *f;
fbd6baed
GV
4167 struct w32_display_info *dpyinfo = &one_w32_display_info;
4168 W32Msg wmsg;
84fb1139 4169 int windows_translate;
576ba81c 4170 int key;
84fb1139 4171
a6085637
KH
4172 /* Note that it is okay to call x_window_to_frame, even though we are
4173 not running in the main lisp thread, because frame deletion
4174 requires the lisp thread to synchronize with this thread. Thus, if
4175 a frame struct is returned, it can be used without concern that the
4176 lisp thread might make it disappear while we are using it.
4177
4178 NB. Walking the frame list in this thread is safe (as long as
4179 writes of Lisp_Object slots are atomic, which they are on Windows).
4180 Although delete-frame can destructively modify the frame list while
4181 we are walking it, a garbage collection cannot occur until after
4182 delete-frame has synchronized with this thread.
4183
4184 It is also safe to use functions that make GDI calls, such as
fbd6baed 4185 w32_clear_rect, because these functions must obtain a DC handle
a6085637
KH
4186 from the frame struct using get_frame_dc which is thread-aware. */
4187
ee78dc32
GV
4188 switch (msg)
4189 {
4190 case WM_ERASEBKGND:
a6085637
KH
4191 f = x_window_to_frame (dpyinfo, hwnd);
4192 if (f)
4193 {
9badad41 4194 HDC hdc = get_frame_dc (f);
a6085637 4195 GetUpdateRect (hwnd, &wmsg.rect, FALSE);
9badad41
JR
4196 w32_clear_rect (f, hdc, &wmsg.rect);
4197 release_frame_dc (f, hdc);
ce6059da
AI
4198
4199#if defined (W32_DEBUG_DISPLAY)
18f0b342
AI
4200 DebPrint (("WM_ERASEBKGND (frame %p): erasing %d,%d-%d,%d\n",
4201 f,
4202 wmsg.rect.left, wmsg.rect.top,
4203 wmsg.rect.right, wmsg.rect.bottom));
ce6059da 4204#endif /* W32_DEBUG_DISPLAY */
a6085637 4205 }
5ac45f98
GV
4206 return 1;
4207 case WM_PALETTECHANGED:
4208 /* ignore our own changes */
4209 if ((HWND)wParam != hwnd)
4210 {
a6085637
KH
4211 f = x_window_to_frame (dpyinfo, hwnd);
4212 if (f)
4213 /* get_frame_dc will realize our palette and force all
4214 frames to be redrawn if needed. */
4215 release_frame_dc (f, get_frame_dc (f));
5ac45f98
GV
4216 }
4217 return 0;
ee78dc32 4218 case WM_PAINT:
ce6059da 4219 {
55dcfc15
AI
4220 PAINTSTRUCT paintStruct;
4221 RECT update_rect;
aa35b6ad 4222 bzero (&update_rect, sizeof (update_rect));
55dcfc15 4223
18f0b342
AI
4224 f = x_window_to_frame (dpyinfo, hwnd);
4225 if (f == 0)
4226 {
4227 DebPrint (("WM_PAINT received for unknown window %p\n", hwnd));
4228 return 0;
4229 }
4230
55dcfc15
AI
4231 /* MSDN Docs say not to call BeginPaint if GetUpdateRect
4232 fails. Apparently this can happen under some
4233 circumstances. */
aa35b6ad 4234 if (GetUpdateRect (hwnd, &update_rect, FALSE) || !w32_strict_painting)
55dcfc15
AI
4235 {
4236 enter_crit ();
4237 BeginPaint (hwnd, &paintStruct);
4238
aa35b6ad
JR
4239 /* The rectangles returned by GetUpdateRect and BeginPaint
4240 do not always match. Play it safe by assuming both areas
4241 are invalid. */
4242 UnionRect (&(wmsg.rect), &update_rect, &(paintStruct.rcPaint));
55dcfc15
AI
4243
4244#if defined (W32_DEBUG_DISPLAY)
18f0b342
AI
4245 DebPrint (("WM_PAINT (frame %p): painting %d,%d-%d,%d\n",
4246 f,
4247 wmsg.rect.left, wmsg.rect.top,
4248 wmsg.rect.right, wmsg.rect.bottom));
4249 DebPrint ((" [update region is %d,%d-%d,%d]\n",
55dcfc15
AI
4250 update_rect.left, update_rect.top,
4251 update_rect.right, update_rect.bottom));
4252#endif
4253 EndPaint (hwnd, &paintStruct);
4254 leave_crit ();
4255
4256 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4257
4258 return 0;
4259 }
c0611964
AI
4260
4261 /* If GetUpdateRect returns 0 (meaning there is no update
4262 region), assume the whole window needs to be repainted. */
4263 GetClientRect(hwnd, &wmsg.rect);
4264 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4265 return 0;
ee78dc32 4266 }
a1a80b40 4267
ccc2d29c
GV
4268 case WM_INPUTLANGCHANGE:
4269 /* Inform lisp thread of keyboard layout changes. */
4270 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4271
4272 /* Clear dead keys in the keyboard state; for simplicity only
4273 preserve modifier key states. */
4274 {
4275 int i;
4276 BYTE keystate[256];
4277
4278 GetKeyboardState (keystate);
4279 for (i = 0; i < 256; i++)
4280 if (1
4281 && i != VK_SHIFT
4282 && i != VK_LSHIFT
4283 && i != VK_RSHIFT
4284 && i != VK_CAPITAL
4285 && i != VK_NUMLOCK
4286 && i != VK_SCROLL
4287 && i != VK_CONTROL
4288 && i != VK_LCONTROL
4289 && i != VK_RCONTROL
4290 && i != VK_MENU
4291 && i != VK_LMENU
4292 && i != VK_RMENU
4293 && i != VK_LWIN
4294 && i != VK_RWIN)
4295 keystate[i] = 0;
4296 SetKeyboardState (keystate);
4297 }
4298 goto dflt;
4299
4300 case WM_HOTKEY:
4301 /* Synchronize hot keys with normal input. */
4302 PostMessage (hwnd, WM_KEYDOWN, HIWORD (lParam), 0);
4303 return (0);
4304
a1a80b40
GV
4305 case WM_KEYUP:
4306 case WM_SYSKEYUP:
4307 record_keyup (wParam, lParam);
4308 goto dflt;
4309
ee78dc32
GV
4310 case WM_KEYDOWN:
4311 case WM_SYSKEYDOWN:
ccc2d29c
GV
4312 /* Ignore keystrokes we fake ourself; see below. */
4313 if (dpyinfo->faked_key == wParam)
4314 {
4315 dpyinfo->faked_key = 0;
576ba81c
AI
4316 /* Make sure TranslateMessage sees them though (as long as
4317 they don't produce WM_CHAR messages). This ensures that
4318 indicator lights are toggled promptly on Windows 9x, for
4319 example. */
4320 if (lispy_function_keys[wParam] != 0)
4321 {
4322 windows_translate = 1;
4323 goto translate;
4324 }
4325 return 0;
ccc2d29c
GV
4326 }
4327
7830e24b
RS
4328 /* Synchronize modifiers with current keystroke. */
4329 sync_modifiers ();
a1a80b40 4330 record_keydown (wParam, lParam);
ccc2d29c 4331 wParam = map_keypad_keys (wParam, (lParam & 0x1000000L) != 0);
84fb1139
KH
4332
4333 windows_translate = 0;
ccc2d29c
GV
4334
4335 switch (wParam)
4336 {
4337 case VK_LWIN:
4338 if (NILP (Vw32_pass_lwindow_to_system))
4339 {
4340 /* Prevent system from acting on keyup (which opens the
4341 Start menu if no other key was pressed) by simulating a
4342 press of Space which we will ignore. */
4343 if (GetAsyncKeyState (wParam) & 1)
4344 {
adcc3809 4345 if (NUMBERP (Vw32_phantom_key_code))
576ba81c 4346 key = XUINT (Vw32_phantom_key_code) & 255;
adcc3809 4347 else
576ba81c
AI
4348 key = VK_SPACE;
4349 dpyinfo->faked_key = key;
4350 keybd_event (key, (BYTE) MapVirtualKey (key, 0), 0, 0);
ccc2d29c
GV
4351 }
4352 }
4353 if (!NILP (Vw32_lwindow_modifier))
4354 return 0;
4355 break;
4356 case VK_RWIN:
4357 if (NILP (Vw32_pass_rwindow_to_system))
4358 {
4359 if (GetAsyncKeyState (wParam) & 1)
4360 {
adcc3809 4361 if (NUMBERP (Vw32_phantom_key_code))
576ba81c 4362 key = XUINT (Vw32_phantom_key_code) & 255;
adcc3809 4363 else
576ba81c
AI
4364 key = VK_SPACE;
4365 dpyinfo->faked_key = key;
4366 keybd_event (key, (BYTE) MapVirtualKey (key, 0), 0, 0);
ccc2d29c
GV
4367 }
4368 }
4369 if (!NILP (Vw32_rwindow_modifier))
4370 return 0;
4371 break;
576ba81c 4372 case VK_APPS:
ccc2d29c
GV
4373 if (!NILP (Vw32_apps_modifier))
4374 return 0;
4375 break;
4376 case VK_MENU:
4377 if (NILP (Vw32_pass_alt_to_system))
adcc3809
GV
4378 /* Prevent DefWindowProc from activating the menu bar if an
4379 Alt key is pressed and released by itself. */
ccc2d29c 4380 return 0;
84fb1139 4381 windows_translate = 1;
ccc2d29c
GV
4382 break;
4383 case VK_CAPITAL:
4384 /* Decide whether to treat as modifier or function key. */
4385 if (NILP (Vw32_enable_caps_lock))
4386 goto disable_lock_key;
adcc3809
GV
4387 windows_translate = 1;
4388 break;
ccc2d29c
GV
4389 case VK_NUMLOCK:
4390 /* Decide whether to treat as modifier or function key. */
4391 if (NILP (Vw32_enable_num_lock))
4392 goto disable_lock_key;
adcc3809
GV
4393 windows_translate = 1;
4394 break;
ccc2d29c
GV
4395 case VK_SCROLL:
4396 /* Decide whether to treat as modifier or function key. */
4397 if (NILP (Vw32_scroll_lock_modifier))
4398 goto disable_lock_key;
adcc3809
GV
4399 windows_translate = 1;
4400 break;
ccc2d29c 4401 disable_lock_key:
adcc3809
GV
4402 /* Ensure the appropriate lock key state (and indicator light)
4403 remains in the same state. We do this by faking another
4404 press of the relevant key. Apparently, this really is the
4405 only way to toggle the state of the indicator lights. */
4406 dpyinfo->faked_key = wParam;
4407 keybd_event ((BYTE) wParam, (BYTE) MapVirtualKey (wParam, 0),
4408 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
4409 keybd_event ((BYTE) wParam, (BYTE) MapVirtualKey (wParam, 0),
4410 KEYEVENTF_EXTENDEDKEY | 0, 0);
4411 keybd_event ((BYTE) wParam, (BYTE) MapVirtualKey (wParam, 0),
4412 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
4413 /* Ensure indicator lights are updated promptly on Windows 9x
4414 (TranslateMessage apparently does this), after forwarding
4415 input event. */
4416 post_character_message (hwnd, msg, wParam, lParam,
4417 w32_get_key_modifiers (wParam, lParam));
4418 windows_translate = 1;
ccc2d29c
GV
4419 break;
4420 case VK_CONTROL:
4421 case VK_SHIFT:
4422 case VK_PROCESSKEY: /* Generated by IME. */
4423 windows_translate = 1;
4424 break;
adcc3809
GV
4425 case VK_CANCEL:
4426 /* Windows maps Ctrl-Pause (aka Ctrl-Break) into VK_CANCEL,
4427 which is confusing for purposes of key binding; convert
4428 VK_CANCEL events into VK_PAUSE events. */
4429 wParam = VK_PAUSE;
4430 break;
4431 case VK_PAUSE:
4432 /* Windows maps Ctrl-NumLock into VK_PAUSE, which is confusing
4433 for purposes of key binding; convert these back into
4434 VK_NUMLOCK events, at least when we want to see NumLock key
4435 presses. (Note that there is never any possibility that
4436 VK_PAUSE with Ctrl really is C-Pause as per above.) */
4437 if (NILP (Vw32_enable_num_lock) && modifier_set (VK_CONTROL))
4438 wParam = VK_NUMLOCK;
4439 break;
ccc2d29c
GV
4440 default:
4441 /* If not defined as a function key, change it to a WM_CHAR message. */
4442 if (lispy_function_keys[wParam] == 0)
4443 {
adcc3809
GV
4444 DWORD modifiers = construct_console_modifiers ();
4445
ccc2d29c
GV
4446 if (!NILP (Vw32_recognize_altgr)
4447 && modifier_set (VK_LCONTROL) && modifier_set (VK_RMENU))
4448 {
4449 /* Always let TranslateMessage handle AltGr key chords;
4450 for some reason, ToAscii doesn't always process AltGr
4451 chords correctly. */
4452 windows_translate = 1;
4453 }
adcc3809 4454 else if ((modifiers & (~SHIFT_PRESSED & ~CAPSLOCK_ON)) != 0)
ccc2d29c 4455 {
adcc3809
GV
4456 /* Handle key chords including any modifiers other
4457 than shift directly, in order to preserve as much
4458 modifier information as possible. */
ccc2d29c
GV
4459 if ('A' <= wParam && wParam <= 'Z')
4460 {
4461 /* Don't translate modified alphabetic keystrokes,
4462 so the user doesn't need to constantly switch
4463 layout to type control or meta keystrokes when
4464 the normal layout translates alphabetic
4465 characters to non-ascii characters. */
4466 if (!modifier_set (VK_SHIFT))
4467 wParam += ('a' - 'A');
4468 msg = WM_CHAR;
4469 }
4470 else
4471 {
4472 /* Try to handle other keystrokes by determining the
4473 base character (ie. translating the base key plus
4474 shift modifier). */
4475 int add;
4476 int isdead = 0;
4477 KEY_EVENT_RECORD key;
4478
4479 key.bKeyDown = TRUE;
4480 key.wRepeatCount = 1;
4481 key.wVirtualKeyCode = wParam;
4482 key.wVirtualScanCode = (lParam & 0xFF0000) >> 16;
4483 key.uChar.AsciiChar = 0;
adcc3809 4484 key.dwControlKeyState = modifiers;
ccc2d29c
GV
4485
4486 add = w32_kbd_patch_key (&key);
4487 /* 0 means an unrecognised keycode, negative means
4488 dead key. Ignore both. */
4489 while (--add >= 0)
4490 {
4491 /* Forward asciified character sequence. */
4492 post_character_message
4493 (hwnd, WM_CHAR, key.uChar.AsciiChar, lParam,
4494 w32_get_key_modifiers (wParam, lParam));
4495 w32_kbd_patch_key (&key);
4496 }
4497 return 0;
4498 }
4499 }
4500 else
4501 {
4502 /* Let TranslateMessage handle everything else. */
4503 windows_translate = 1;
4504 }
4505 }
4506 }
a1a80b40 4507
adcc3809 4508 translate:
84fb1139
KH
4509 if (windows_translate)
4510 {
e9e23e23 4511 MSG windows_msg = { hwnd, msg, wParam, lParam, 0, {0,0} };
84fb1139 4512
e9e23e23
GV
4513 windows_msg.time = GetMessageTime ();
4514 TranslateMessage (&windows_msg);
84fb1139
KH
4515 goto dflt;
4516 }
4517
ee78dc32
GV
4518 /* Fall through */
4519
4520 case WM_SYSCHAR:
4521 case WM_CHAR:
ccc2d29c
GV
4522 post_character_message (hwnd, msg, wParam, lParam,
4523 w32_get_key_modifiers (wParam, lParam));
ee78dc32 4524 break;
da36a4d6 4525
5ac45f98
GV
4526 /* Simulate middle mouse button events when left and right buttons
4527 are used together, but only if user has two button mouse. */
ee78dc32 4528 case WM_LBUTTONDOWN:
5ac45f98 4529 case WM_RBUTTONDOWN:
7ce9aaca 4530 if (XINT (Vw32_num_mouse_buttons) > 2)
5ac45f98
GV
4531 goto handle_plain_button;
4532
4533 {
4534 int this = (msg == WM_LBUTTONDOWN) ? LMOUSE : RMOUSE;
4535 int other = (msg == WM_LBUTTONDOWN) ? RMOUSE : LMOUSE;
4536
3cb20f4a
RS
4537 if (button_state & this)
4538 return 0;
5ac45f98
GV
4539
4540 if (button_state == 0)
4541 SetCapture (hwnd);
4542
4543 button_state |= this;
4544
4545 if (button_state & other)
4546 {
84fb1139 4547 if (mouse_button_timer)
5ac45f98 4548 {
84fb1139
KH
4549 KillTimer (hwnd, mouse_button_timer);
4550 mouse_button_timer = 0;
5ac45f98
GV
4551
4552 /* Generate middle mouse event instead. */
4553 msg = WM_MBUTTONDOWN;
4554 button_state |= MMOUSE;
4555 }
4556 else if (button_state & MMOUSE)
4557 {
4558 /* Ignore button event if we've already generated a
4559 middle mouse down event. This happens if the
4560 user releases and press one of the two buttons
4561 after we've faked a middle mouse event. */
4562 return 0;
4563 }
4564 else
4565 {
4566 /* Flush out saved message. */
84fb1139 4567 post_msg (&saved_mouse_button_msg);
5ac45f98 4568 }
fbd6baed 4569 wmsg.dwModifiers = w32_get_modifiers ();
5ac45f98
GV
4570 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4571
4572 /* Clear message buffer. */
84fb1139 4573 saved_mouse_button_msg.msg.hwnd = 0;
5ac45f98
GV
4574 }
4575 else
4576 {
4577 /* Hold onto message for now. */
84fb1139 4578 mouse_button_timer =
adcc3809
GV
4579 SetTimer (hwnd, MOUSE_BUTTON_ID,
4580 XINT (Vw32_mouse_button_tolerance), NULL);
84fb1139
KH
4581 saved_mouse_button_msg.msg.hwnd = hwnd;
4582 saved_mouse_button_msg.msg.message = msg;
4583 saved_mouse_button_msg.msg.wParam = wParam;
4584 saved_mouse_button_msg.msg.lParam = lParam;
4585 saved_mouse_button_msg.msg.time = GetMessageTime ();
fbd6baed 4586 saved_mouse_button_msg.dwModifiers = w32_get_modifiers ();
5ac45f98
GV
4587 }
4588 }
4589 return 0;
4590
ee78dc32 4591 case WM_LBUTTONUP:
5ac45f98 4592 case WM_RBUTTONUP:
7ce9aaca 4593 if (XINT (Vw32_num_mouse_buttons) > 2)
5ac45f98
GV
4594 goto handle_plain_button;
4595
4596 {
4597 int this = (msg == WM_LBUTTONUP) ? LMOUSE : RMOUSE;
4598 int other = (msg == WM_LBUTTONUP) ? RMOUSE : LMOUSE;
4599
3cb20f4a
RS
4600 if ((button_state & this) == 0)
4601 return 0;
5ac45f98
GV
4602
4603 button_state &= ~this;
4604
4605 if (button_state & MMOUSE)
4606 {
4607 /* Only generate event when second button is released. */
4608 if ((button_state & other) == 0)
4609 {
4610 msg = WM_MBUTTONUP;
4611 button_state &= ~MMOUSE;
4612
4613 if (button_state) abort ();
4614 }
4615 else
4616 return 0;
4617 }
4618 else
4619 {
4620 /* Flush out saved message if necessary. */
84fb1139 4621 if (saved_mouse_button_msg.msg.hwnd)
5ac45f98 4622 {
84fb1139 4623 post_msg (&saved_mouse_button_msg);
5ac45f98
GV
4624 }
4625 }
fbd6baed 4626 wmsg.dwModifiers = w32_get_modifiers ();
5ac45f98
GV
4627 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4628
4629 /* Always clear message buffer and cancel timer. */
84fb1139
KH
4630 saved_mouse_button_msg.msg.hwnd = 0;
4631 KillTimer (hwnd, mouse_button_timer);
4632 mouse_button_timer = 0;
5ac45f98
GV
4633
4634 if (button_state == 0)
4635 ReleaseCapture ();
4636 }
4637 return 0;
4638
74214547
JR
4639 case WM_XBUTTONDOWN:
4640 case WM_XBUTTONUP:
4641 if (w32_pass_extra_mouse_buttons_to_system)
4642 goto dflt;
4643 /* else fall through and process them. */
ee78dc32
GV
4644 case WM_MBUTTONDOWN:
4645 case WM_MBUTTONUP:
5ac45f98 4646 handle_plain_button:
ee78dc32
GV
4647 {
4648 BOOL up;
1edf84e7 4649 int button;
ee78dc32 4650
74214547 4651 if (parse_button (msg, HIWORD (wParam), &button, &up))
ee78dc32
GV
4652 {
4653 if (up) ReleaseCapture ();
4654 else SetCapture (hwnd);
1edf84e7
GV
4655 button = (button == 0) ? LMOUSE :
4656 ((button == 1) ? MMOUSE : RMOUSE);
4657 if (up)
4658 button_state &= ~button;
4659 else
4660 button_state |= button;
ee78dc32
GV
4661 }
4662 }
4663
fbd6baed 4664 wmsg.dwModifiers = w32_get_modifiers ();
ee78dc32 4665 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
74214547
JR
4666
4667 /* Need to return true for XBUTTON messages, false for others,
4668 to indicate that we processed the message. */
4669 return (msg == WM_XBUTTONDOWN || msg == WM_XBUTTONUP);
5ac45f98 4670
5ac45f98 4671 case WM_MOUSEMOVE:
9eb16b62
JR
4672 /* If the mouse has just moved into the frame, start tracking
4673 it, so we will be notified when it leaves the frame. Mouse
4674 tracking only works under W98 and NT4 and later. On earlier
4675 versions, there is no way of telling when the mouse leaves the
4676 frame, so we just have to put up with help-echo and mouse
4677 highlighting remaining while the frame is not active. */
4678 if (track_mouse_event_fn && !track_mouse_window)
4679 {
4680 TRACKMOUSEEVENT tme;
4681 tme.cbSize = sizeof (tme);
4682 tme.dwFlags = TME_LEAVE;
4683 tme.hwndTrack = hwnd;
4684
4685 track_mouse_event_fn (&tme);
4686 track_mouse_window = hwnd;
4687 }
4688 case WM_VSCROLL:
fbd6baed 4689 if (XINT (Vw32_mouse_move_interval) <= 0
84fb1139
KH
4690 || (msg == WM_MOUSEMOVE && button_state == 0))
4691 {
fbd6baed 4692 wmsg.dwModifiers = w32_get_modifiers ();
84fb1139
KH
4693 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4694 return 0;
4695 }
4696
4697 /* Hang onto mouse move and scroll messages for a bit, to avoid
4698 sending such events to Emacs faster than it can process them.
4699 If we get more events before the timer from the first message
4700 expires, we just replace the first message. */
4701
4702 if (saved_mouse_move_msg.msg.hwnd == 0)
4703 mouse_move_timer =
adcc3809
GV
4704 SetTimer (hwnd, MOUSE_MOVE_ID,
4705 XINT (Vw32_mouse_move_interval), NULL);
84fb1139
KH
4706
4707 /* Hold onto message for now. */
4708 saved_mouse_move_msg.msg.hwnd = hwnd;
4709 saved_mouse_move_msg.msg.message = msg;
4710 saved_mouse_move_msg.msg.wParam = wParam;
4711 saved_mouse_move_msg.msg.lParam = lParam;
4712 saved_mouse_move_msg.msg.time = GetMessageTime ();
fbd6baed 4713 saved_mouse_move_msg.dwModifiers = w32_get_modifiers ();
84fb1139
KH
4714
4715 return 0;
4716
1edf84e7
GV
4717 case WM_MOUSEWHEEL:
4718 wmsg.dwModifiers = w32_get_modifiers ();
4719 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4720 return 0;
4721
cb9e33d4
RS
4722 case WM_DROPFILES:
4723 wmsg.dwModifiers = w32_get_modifiers ();
4724 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4725 return 0;
4726
84fb1139
KH
4727 case WM_TIMER:
4728 /* Flush out saved messages if necessary. */
4729 if (wParam == mouse_button_timer)
5ac45f98 4730 {
84fb1139
KH
4731 if (saved_mouse_button_msg.msg.hwnd)
4732 {
4733 post_msg (&saved_mouse_button_msg);
4734 saved_mouse_button_msg.msg.hwnd = 0;
4735 }
4736 KillTimer (hwnd, mouse_button_timer);
4737 mouse_button_timer = 0;
4738 }
4739 else if (wParam == mouse_move_timer)
4740 {
4741 if (saved_mouse_move_msg.msg.hwnd)
4742 {
4743 post_msg (&saved_mouse_move_msg);
4744 saved_mouse_move_msg.msg.hwnd = 0;
4745 }
4746 KillTimer (hwnd, mouse_move_timer);
4747 mouse_move_timer = 0;
5ac45f98 4748 }
48094ace
JR
4749 else if (wParam == menu_free_timer)
4750 {
4751 KillTimer (hwnd, menu_free_timer);
4752 menu_free_timer = 0;
27605fa7 4753 f = x_window_to_frame (dpyinfo, hwnd);
48094ace
JR
4754 if (!f->output_data.w32->menu_command_in_progress)
4755 {
4756 /* Free memory used by owner-drawn and help-echo strings. */
4757 w32_free_menu_strings (hwnd);
4758 f->output_data.w32->menubar_active = 0;
4759 }
4760 }
5ac45f98 4761 return 0;
84fb1139
KH
4762
4763 case WM_NCACTIVATE:
4764 /* Windows doesn't send us focus messages when putting up and
e9e23e23 4765 taking down a system popup dialog as for Ctrl-Alt-Del on Windows 95.
84fb1139
KH
4766 The only indication we get that something happened is receiving
4767 this message afterwards. So this is a good time to reset our
4768 keyboard modifiers' state. */
4769 reset_modifiers ();
4770 goto dflt;
da36a4d6 4771
1edf84e7 4772 case WM_INITMENU:
487163ac
AI
4773 button_state = 0;
4774 ReleaseCapture ();
1edf84e7
GV
4775 /* We must ensure menu bar is fully constructed and up to date
4776 before allowing user interaction with it. To achieve this
4777 we send this message to the lisp thread and wait for a
4778 reply (whose value is not actually needed) to indicate that
4779 the menu bar is now ready for use, so we can now return.
4780
4781 To remain responsive in the meantime, we enter a nested message
4782 loop that can process all other messages.
4783
4784 However, we skip all this if the message results from calling
4785 TrackPopupMenu - in fact, we must NOT attempt to send the lisp
4786 thread a message because it is blocked on us at this point. We
4787 set menubar_active before calling TrackPopupMenu to indicate
4788 this (there is no possibility of confusion with real menubar
4789 being active). */
4790
4791 f = x_window_to_frame (dpyinfo, hwnd);
4792 if (f
4793 && (f->output_data.w32->menubar_active
4794 /* We can receive this message even in the absence of a
4795 menubar (ie. when the system menu is activated) - in this
4796 case we do NOT want to forward the message, otherwise it
4797 will cause the menubar to suddenly appear when the user
4798 had requested it to be turned off! */
4799 || f->output_data.w32->menubar_widget == NULL))
4800 return 0;
4801
4802 {
4803 deferred_msg msg_buf;
4804
4805 /* Detect if message has already been deferred; in this case
4806 we cannot return any sensible value to ignore this. */
4807 if (find_deferred_msg (hwnd, msg) != NULL)
4808 abort ();
4809
4810 return send_deferred_msg (&msg_buf, hwnd, msg, wParam, lParam);
4811 }
4812
4813 case WM_EXITMENULOOP:
4814 f = x_window_to_frame (dpyinfo, hwnd);
4815
48094ace
JR
4816 /* If a menu command is not already in progress, check again
4817 after a short delay, since Windows often (always?) sends the
4818 WM_EXITMENULOOP before the corresponding WM_COMMAND message. */
4819 if (f && !f->output_data.w32->menu_command_in_progress)
4820 menu_free_timer = SetTimer (hwnd, MENU_FREE_ID, MENU_FREE_DELAY, NULL);
1edf84e7
GV
4821 goto dflt;
4822
126f2e35 4823 case WM_MENUSELECT:
4e3a1c61
JR
4824 /* Direct handling of help_echo in menus. Should be safe now
4825 that we generate the help_echo by placing a help event in the
4826 keyboard buffer. */
ca56d953 4827 {
ca56d953
JR
4828 HMENU menu = (HMENU) lParam;
4829 UINT menu_item = (UINT) LOWORD (wParam);
4830 UINT flags = (UINT) HIWORD (wParam);
4831
4e3a1c61 4832 w32_menu_display_help (hwnd, menu, menu_item, flags);
ca56d953 4833 }
126f2e35
JR
4834 return 0;
4835
87996783
GV
4836 case WM_MEASUREITEM:
4837 f = x_window_to_frame (dpyinfo, hwnd);
4838 if (f)
4839 {
4840 MEASUREITEMSTRUCT * pMis = (MEASUREITEMSTRUCT *) lParam;
4841
4842 if (pMis->CtlType == ODT_MENU)
4843 {
4844 /* Work out dimensions for popup menu titles. */
4845 char * title = (char *) pMis->itemData;
4846 HDC hdc = GetDC (hwnd);
4847 HFONT menu_font = GetCurrentObject (hdc, OBJ_FONT);
4848 LOGFONT menu_logfont;
4849 HFONT old_font;
4850 SIZE size;
4851
4852 GetObject (menu_font, sizeof (menu_logfont), &menu_logfont);
4853 menu_logfont.lfWeight = FW_BOLD;
4854 menu_font = CreateFontIndirect (&menu_logfont);
4855 old_font = SelectObject (hdc, menu_font);
4856
dfff8a69
JR
4857 pMis->itemHeight = GetSystemMetrics (SM_CYMENUSIZE);
4858 if (title)
4859 {
4860 GetTextExtentPoint32 (hdc, title, strlen (title), &size);
4861 pMis->itemWidth = size.cx;
4862 if (pMis->itemHeight < size.cy)
4863 pMis->itemHeight = size.cy;
4864 }
4865 else
4866 pMis->itemWidth = 0;
87996783
GV
4867
4868 SelectObject (hdc, old_font);
4869 DeleteObject (menu_font);
4870 ReleaseDC (hwnd, hdc);
4871 return TRUE;
4872 }
4873 }
4874 return 0;
4875
4876 case WM_DRAWITEM:
4877 f = x_window_to_frame (dpyinfo, hwnd);
4878 if (f)
4879 {
4880 DRAWITEMSTRUCT * pDis = (DRAWITEMSTRUCT *) lParam;
4881
4882 if (pDis->CtlType == ODT_MENU)
4883 {
4884 /* Draw popup menu title. */
4885 char * title = (char *) pDis->itemData;
212da13b
JR
4886 if (title)
4887 {
4888 HDC hdc = pDis->hDC;
4889 HFONT menu_font = GetCurrentObject (hdc, OBJ_FONT);
4890 LOGFONT menu_logfont;
4891 HFONT old_font;
4892
4893 GetObject (menu_font, sizeof (menu_logfont), &menu_logfont);
4894 menu_logfont.lfWeight = FW_BOLD;
4895 menu_font = CreateFontIndirect (&menu_logfont);
4896 old_font = SelectObject (hdc, menu_font);
4897
4898 /* Always draw title as if not selected. */
4899 ExtTextOut (hdc,
4900 pDis->rcItem.left
4901 + GetSystemMetrics (SM_CXMENUCHECK),
4902 pDis->rcItem.top,
4903 ETO_OPAQUE, &pDis->rcItem,
4904 title, strlen (title), NULL);
4905
4906 SelectObject (hdc, old_font);
4907 DeleteObject (menu_font);
4908 }
87996783
GV
4909 return TRUE;
4910 }
4911 }
4912 return 0;
4913
1edf84e7
GV
4914#if 0
4915 /* Still not right - can't distinguish between clicks in the
4916 client area of the frame from clicks forwarded from the scroll
4917 bars - may have to hook WM_NCHITTEST to remember the mouse
4918 position and then check if it is in the client area ourselves. */
4919 case WM_MOUSEACTIVATE:
4920 /* Discard the mouse click that activates a frame, allowing the
4921 user to click anywhere without changing point (or worse!).
4922 Don't eat mouse clicks on scrollbars though!! */
4923 if (LOWORD (lParam) == HTCLIENT )
4924 return MA_ACTIVATEANDEAT;
4925 goto dflt;
4926#endif
4927
9eb16b62
JR
4928 case WM_MOUSELEAVE:
4929 /* No longer tracking mouse. */
4930 track_mouse_window = NULL;
4931
1edf84e7 4932 case WM_ACTIVATEAPP:
ccc2d29c 4933 case WM_ACTIVATE:
1edf84e7
GV
4934 case WM_WINDOWPOSCHANGED:
4935 case WM_SHOWWINDOW:
4936 /* Inform lisp thread that a frame might have just been obscured
4937 or exposed, so should recheck visibility of all frames. */
4938 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4939 goto dflt;
4940
da36a4d6 4941 case WM_SETFOCUS:
adcc3809
GV
4942 dpyinfo->faked_key = 0;
4943 reset_modifiers ();
ccc2d29c
GV
4944 register_hot_keys (hwnd);
4945 goto command;
8681157a 4946 case WM_KILLFOCUS:
ccc2d29c 4947 unregister_hot_keys (hwnd);
487163ac
AI
4948 button_state = 0;
4949 ReleaseCapture ();
65906840
JR
4950 /* Relinquish the system caret. */
4951 if (w32_system_caret_hwnd)
4952 {
93f2ca61 4953 w32_visible_system_caret_hwnd = NULL;
d285988b
JR
4954 w32_system_caret_hwnd = NULL;
4955 DestroyCaret ();
65906840 4956 }
48094ace
JR
4957 goto command;
4958 case WM_COMMAND:
4959 f = x_window_to_frame (dpyinfo, hwnd);
4960 if (f && HIWORD (wParam) == 0)
4961 {
4962 f->output_data.w32->menu_command_in_progress = 1;
4963 if (menu_free_timer)
4964 {
4965 KillTimer (hwnd, menu_free_timer);
4966 menu_free_timer = 0;
4967 }
4968 }
ee78dc32
GV
4969 case WM_MOVE:
4970 case WM_SIZE:
ccc2d29c 4971 command:
fbd6baed 4972 wmsg.dwModifiers = w32_get_modifiers ();
ee78dc32
GV
4973 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4974 goto dflt;
8847d890
RS
4975
4976 case WM_CLOSE:
fbd6baed 4977 wmsg.dwModifiers = w32_get_modifiers ();
8847d890
RS
4978 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4979 return 0;
4980
ee78dc32 4981 case WM_WINDOWPOSCHANGING:
bfd6edcc
JR
4982 /* Don't restrict the sizing of tip frames. */
4983 if (hwnd == tip_window)
4984 return 0;
ee78dc32
GV
4985 {
4986 WINDOWPLACEMENT wp;
4987 LPWINDOWPOS lppos = (WINDOWPOS *) lParam;
1edf84e7
GV
4988
4989 wp.length = sizeof (WINDOWPLACEMENT);
ee78dc32
GV
4990 GetWindowPlacement (hwnd, &wp);
4991
1edf84e7 4992 if (wp.showCmd != SW_SHOWMINIMIZED && (lppos->flags & SWP_NOSIZE) == 0)
ee78dc32
GV
4993 {
4994 RECT rect;
4995 int wdiff;
4996 int hdiff;
1edf84e7
GV
4997 DWORD font_width;
4998 DWORD line_height;
4999 DWORD internal_border;
5000 DWORD scrollbar_extra;
ee78dc32
GV
5001 RECT wr;
5002
5ac45f98 5003 wp.length = sizeof(wp);
ee78dc32
GV
5004 GetWindowRect (hwnd, &wr);
5005
3c190163 5006 enter_crit ();
ee78dc32 5007
1edf84e7
GV
5008 font_width = GetWindowLong (hwnd, WND_FONTWIDTH_INDEX);
5009 line_height = GetWindowLong (hwnd, WND_LINEHEIGHT_INDEX);
5010 internal_border = GetWindowLong (hwnd, WND_BORDER_INDEX);
5011 scrollbar_extra = GetWindowLong (hwnd, WND_SCROLLBAR_INDEX);
ee78dc32 5012
3c190163 5013 leave_crit ();
ee78dc32
GV
5014
5015 memset (&rect, 0, sizeof (rect));
5016 AdjustWindowRect (&rect, GetWindowLong (hwnd, GWL_STYLE),
5017 GetMenu (hwnd) != NULL);
5018
1edf84e7
GV
5019 /* Force width and height of client area to be exact
5020 multiples of the character cell dimensions. */
5021 wdiff = (lppos->cx - (rect.right - rect.left)
5022 - 2 * internal_border - scrollbar_extra)
5023 % font_width;
5024 hdiff = (lppos->cy - (rect.bottom - rect.top)
5025 - 2 * internal_border)
5026 % line_height;
ee78dc32
GV
5027
5028 if (wdiff || hdiff)
5029 {
5030 /* For right/bottom sizing we can just fix the sizes.
5031 However for top/left sizing we will need to fix the X
5032 and Y positions as well. */
5033
5034 lppos->cx -= wdiff;
5035 lppos->cy -= hdiff;
5036
5037 if (wp.showCmd != SW_SHOWMAXIMIZED
1edf84e7 5038 && (lppos->flags & SWP_NOMOVE) == 0)
ee78dc32
GV
5039 {
5040 if (lppos->x != wr.left || lppos->y != wr.top)
5041 {
5042 lppos->x += wdiff;
5043 lppos->y += hdiff;
5044 }
5045 else
5046 {
5047 lppos->flags |= SWP_NOMOVE;
5048 }
5049 }
5050
1edf84e7 5051 return 0;
ee78dc32
GV
5052 }
5053 }
5054 }
ee78dc32
GV
5055
5056 goto dflt;
1edf84e7 5057
b1f918f8
GV
5058 case WM_GETMINMAXINFO:
5059 /* Hack to correct bug that allows Emacs frames to be resized
5060 below the Minimum Tracking Size. */
5061 ((LPMINMAXINFO) lParam)->ptMinTrackSize.y++;
bf853fee
AI
5062 /* Hack to allow resizing the Emacs frame above the screen size.
5063 Note that Windows 9x limits coordinates to 16-bits. */
5064 ((LPMINMAXINFO) lParam)->ptMaxTrackSize.x = 32767;
5065 ((LPMINMAXINFO) lParam)->ptMaxTrackSize.y = 32767;
b1f918f8
GV
5066 return 0;
5067
1edf84e7
GV
5068 case WM_EMACS_CREATESCROLLBAR:
5069 return (LRESULT) w32_createscrollbar ((struct frame *) wParam,
5070 (struct scroll_bar *) lParam);
5071
5ac45f98 5072 case WM_EMACS_SHOWWINDOW:
1edf84e7
GV
5073 return ShowWindow ((HWND) wParam, (WPARAM) lParam);
5074
dfdb4047 5075 case WM_EMACS_SETFOREGROUND:
ce6059da
AI
5076 {
5077 HWND foreground_window;
5078 DWORD foreground_thread, retval;
5079
5080 /* On NT 5.0, and apparently Windows 98, it is necessary to
5081 attach to the thread that currently has focus in order to
5082 pull the focus away from it. */
5083 foreground_window = GetForegroundWindow ();
5084 foreground_thread = GetWindowThreadProcessId (foreground_window, NULL);
5085 if (!foreground_window
5086 || foreground_thread == GetCurrentThreadId ()
5087 || !AttachThreadInput (GetCurrentThreadId (),
5088 foreground_thread, TRUE))
5089 foreground_thread = 0;
5090
5091 retval = SetForegroundWindow ((HWND) wParam);
5092
5093 /* Detach from the previous foreground thread. */
5094 if (foreground_thread)
5095 AttachThreadInput (GetCurrentThreadId (),
5096 foreground_thread, FALSE);
5097
5098 return retval;
5099 }
dfdb4047 5100
5ac45f98
GV
5101 case WM_EMACS_SETWINDOWPOS:
5102 {
1edf84e7
GV
5103 WINDOWPOS * pos = (WINDOWPOS *) wParam;
5104 return SetWindowPos (hwnd, pos->hwndInsertAfter,
5ac45f98
GV
5105 pos->x, pos->y, pos->cx, pos->cy, pos->flags);
5106 }
1edf84e7 5107
ee78dc32 5108 case WM_EMACS_DESTROYWINDOW:
cb9e33d4 5109 DragAcceptFiles ((HWND) wParam, FALSE);
1edf84e7
GV
5110 return DestroyWindow ((HWND) wParam);
5111
93f2ca61
JR
5112 case WM_EMACS_HIDE_CARET:
5113 return HideCaret (hwnd);
5114
5115 case WM_EMACS_SHOW_CARET:
5116 return ShowCaret (hwnd);
5117
65906840
JR
5118 case WM_EMACS_DESTROY_CARET:
5119 w32_system_caret_hwnd = NULL;
93f2ca61 5120 w32_visible_system_caret_hwnd = NULL;
65906840
JR
5121 return DestroyCaret ();
5122
5123 case WM_EMACS_TRACK_CARET:
5124 /* If there is currently no system caret, create one. */
5125 if (w32_system_caret_hwnd == NULL)
5126 {
93f2ca61
JR
5127 /* Use the default caret width, and avoid changing it
5128 unneccesarily, as it confuses screen reader software. */
65906840 5129 w32_system_caret_hwnd = hwnd;
93f2ca61 5130 CreateCaret (hwnd, NULL, 0,
65906840
JR
5131 w32_system_caret_height);
5132 }
93f2ca61
JR
5133
5134 if (!SetCaretPos (w32_system_caret_x, w32_system_caret_y))
5135 return 0;
5136 /* Ensure visible caret gets turned on when requested. */
5137 else if (w32_use_visible_system_caret
5138 && w32_visible_system_caret_hwnd != hwnd)
5139 {
5140 w32_visible_system_caret_hwnd = hwnd;
5141 return ShowCaret (hwnd);
5142 }
5143 /* Ensure visible caret gets turned off when requested. */
5144 else if (!w32_use_visible_system_caret
5145 && w32_visible_system_caret_hwnd)
5146 {
5147 w32_visible_system_caret_hwnd = NULL;
5148 return HideCaret (hwnd);
5149 }
5150 else
5151 return 1;
65906840 5152
1edf84e7
GV
5153 case WM_EMACS_TRACKPOPUPMENU:
5154 {
5155 UINT flags;
5156 POINT *pos;
5157 int retval;
5158 pos = (POINT *)lParam;
5159 flags = TPM_CENTERALIGN;
5160 if (button_state & LMOUSE)
5161 flags |= TPM_LEFTBUTTON;
5162 else if (button_state & RMOUSE)
5163 flags |= TPM_RIGHTBUTTON;
5164
87996783
GV
5165 /* Remember we did a SetCapture on the initial mouse down event,
5166 so for safety, we make sure the capture is cancelled now. */
5167 ReleaseCapture ();
490822ff 5168 button_state = 0;
87996783 5169
1edf84e7
GV
5170 /* Use menubar_active to indicate that WM_INITMENU is from
5171 TrackPopupMenu below, and should be ignored. */
5172 f = x_window_to_frame (dpyinfo, hwnd);
5173 if (f)
5174 f->output_data.w32->menubar_active = 1;
5175
5176 if (TrackPopupMenu ((HMENU)wParam, flags, pos->x, pos->y,
5177 0, hwnd, NULL))
5178 {
5179 MSG amsg;
5180 /* Eat any mouse messages during popupmenu */
5181 while (PeekMessage (&amsg, hwnd, WM_MOUSEFIRST, WM_MOUSELAST,
5182 PM_REMOVE));
5183 /* Get the menu selection, if any */
5184 if (PeekMessage (&amsg, hwnd, WM_COMMAND, WM_COMMAND, PM_REMOVE))
5185 {
5186 retval = LOWORD (amsg.wParam);
5187 }
5188 else
5189 {
5190 retval = 0;
5191 }
1edf84e7
GV
5192 }
5193 else
5194 {
5195 retval = -1;
5196 }
5197
5198 return retval;
5199 }
5200
ee78dc32 5201 default:
93fbe8b7
GV
5202 /* Check for messages registered at runtime. */
5203 if (msg == msh_mousewheel)
5204 {
5205 wmsg.dwModifiers = w32_get_modifiers ();
5206 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
5207 return 0;
5208 }
5209
ee78dc32
GV
5210 dflt:
5211 return DefWindowProc (hwnd, msg, wParam, lParam);
5212 }
5213
1edf84e7
GV
5214
5215 /* The most common default return code for handled messages is 0. */
5216 return 0;
ee78dc32
GV
5217}
5218
5219void
5220my_create_window (f)
5221 struct frame * f;
5222{
5223 MSG msg;
5224
1edf84e7
GV
5225 if (!PostThreadMessage (dwWindowsThreadId, WM_EMACS_CREATEWINDOW, (WPARAM)f, 0))
5226 abort ();
ee78dc32
GV
5227 GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
5228}
5229
ca56d953
JR
5230
5231/* Create a tooltip window. Unlike my_create_window, we do not do this
5232 indirectly via the Window thread, as we do not need to process Window
5233 messages for the tooltip. Creating tooltips indirectly also creates
5234 deadlocks when tooltips are created for menu items. */
5235void
5236my_create_tip_window (f)
5237 struct frame *f;
5238{
bfd6edcc 5239 RECT rect;
ca56d953 5240
bfd6edcc
JR
5241 rect.left = rect.top = 0;
5242 rect.right = PIXEL_WIDTH (f);
5243 rect.bottom = PIXEL_HEIGHT (f);
5244
5245 AdjustWindowRect (&rect, f->output_data.w32->dwStyle,
5246 FRAME_EXTERNAL_MENU_BAR (f));
5247
5248 tip_window = FRAME_W32_WINDOW (f)
ca56d953
JR
5249 = CreateWindow (EMACS_CLASS,
5250 f->namebuf,
5251 f->output_data.w32->dwStyle,
5252 f->output_data.w32->left_pos,
5253 f->output_data.w32->top_pos,
bfd6edcc
JR
5254 rect.right - rect.left,
5255 rect.bottom - rect.top,
ca56d953
JR
5256 FRAME_W32_WINDOW (SELECTED_FRAME ()), /* owner */
5257 NULL,
5258 hinst,
5259 NULL);
5260
bfd6edcc 5261 if (tip_window)
ca56d953 5262 {
bfd6edcc
JR
5263 SetWindowLong (tip_window, WND_FONTWIDTH_INDEX, FONT_WIDTH (f->output_data.w32->font));
5264 SetWindowLong (tip_window, WND_LINEHEIGHT_INDEX, f->output_data.w32->line_height);
5265 SetWindowLong (tip_window, WND_BORDER_INDEX, f->output_data.w32->internal_border_width);
5266 SetWindowLong (tip_window, WND_BACKGROUND_INDEX, FRAME_BACKGROUND_PIXEL (f));
5267
5268 /* Tip frames have no scrollbars. */
5269 SetWindowLong (tip_window, WND_SCROLLBAR_INDEX, 0);
ca56d953
JR
5270
5271 /* Do this to discard the default setting specified by our parent. */
bfd6edcc 5272 ShowWindow (tip_window, SW_HIDE);
ca56d953
JR
5273 }
5274}
5275
5276
fbd6baed 5277/* Create and set up the w32 window for frame F. */
ee78dc32
GV
5278
5279static void
fbd6baed 5280w32_window (f, window_prompting, minibuffer_only)
ee78dc32
GV
5281 struct frame *f;
5282 long window_prompting;
5283 int minibuffer_only;
5284{
5285 BLOCK_INPUT;
5286
5287 /* Use the resource name as the top-level window name
5288 for looking up resources. Make a non-Lisp copy
5289 for the window manager, so GC relocation won't bother it.
5290
5291 Elsewhere we specify the window name for the window manager. */
5292
5293 {
d5db4077 5294 char *str = (char *) SDATA (Vx_resource_name);
ee78dc32
GV
5295 f->namebuf = (char *) xmalloc (strlen (str) + 1);
5296 strcpy (f->namebuf, str);
5297 }
5298
5299 my_create_window (f);
5300
5301 validate_x_resource_name ();
5302
5303 /* x_set_name normally ignores requests to set the name if the
5304 requested name is the same as the current name. This is the one
5305 place where that assumption isn't correct; f->name is set, but
5306 the server hasn't been told. */
5307 {
5308 Lisp_Object name;
5309 int explicit = f->explicit_name;
5310
5311 f->explicit_name = 0;
5312 name = f->name;
5313 f->name = Qnil;
5314 x_set_name (f, name, explicit);
5315 }
5316
5317 UNBLOCK_INPUT;
5318
5319 if (!minibuffer_only && FRAME_EXTERNAL_MENU_BAR (f))
5320 initialize_frame_menubar (f);
5321
fbd6baed 5322 if (FRAME_W32_WINDOW (f) == 0)
ee78dc32
GV
5323 error ("Unable to create window");
5324}
5325
5326/* Handle the icon stuff for this window. Perhaps later we might
5327 want an x_set_icon_position which can be called interactively as
5328 well. */
5329
5330static void
5331x_icon (f, parms)
5332 struct frame *f;
5333 Lisp_Object parms;
5334{
5335 Lisp_Object icon_x, icon_y;
5336
e9e23e23 5337 /* Set the position of the icon. Note that Windows 95 groups all
ee78dc32 5338 icons in the tray. */
6fc2811b
JR
5339 icon_x = w32_get_arg (parms, Qicon_left, 0, 0, RES_TYPE_NUMBER);
5340 icon_y = w32_get_arg (parms, Qicon_top, 0, 0, RES_TYPE_NUMBER);
ee78dc32
GV
5341 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
5342 {
b7826503
PJ
5343 CHECK_NUMBER (icon_x);
5344 CHECK_NUMBER (icon_y);
ee78dc32
GV
5345 }
5346 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
5347 error ("Both left and top icon corners of icon must be specified");
5348
5349 BLOCK_INPUT;
5350
5351 if (! EQ (icon_x, Qunbound))
5352 x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y));
5353
1edf84e7
GV
5354#if 0 /* TODO */
5355 /* Start up iconic or window? */
5356 x_wm_set_window_state
6fc2811b 5357 (f, (EQ (w32_get_arg (parms, Qvisibility, 0, 0, RES_TYPE_SYMBOL), Qicon)
1edf84e7
GV
5358 ? IconicState
5359 : NormalState));
5360
d5db4077 5361 x_text_icon (f, (char *) SDATA ((!NILP (f->icon_name)
1edf84e7 5362 ? f->icon_name
d5db4077 5363 : f->name)));
1edf84e7
GV
5364#endif
5365
ee78dc32
GV
5366 UNBLOCK_INPUT;
5367}
5368
6fc2811b
JR
5369
5370static void
5371x_make_gc (f)
5372 struct frame *f;
5373{
5374 XGCValues gc_values;
5375
5376 BLOCK_INPUT;
5377
5378 /* Create the GC's of this frame.
5379 Note that many default values are used. */
5380
5381 /* Normal video */
5382 gc_values.font = f->output_data.w32->font;
5383
5384 /* Cursor has cursor-color background, background-color foreground. */
5385 gc_values.foreground = FRAME_BACKGROUND_PIXEL (f);
5386 gc_values.background = f->output_data.w32->cursor_pixel;
5387 f->output_data.w32->cursor_gc
5388 = XCreateGC (NULL, FRAME_W32_WINDOW (f),
5389 (GCFont | GCForeground | GCBackground),
5390 &gc_values);
5391
5392 /* Reliefs. */
5393 f->output_data.w32->white_relief.gc = 0;
5394 f->output_data.w32->black_relief.gc = 0;
5395
5396 UNBLOCK_INPUT;
5397}
5398
5399
937e601e
AI
5400/* Handler for signals raised during x_create_frame and
5401 x_create_top_frame. FRAME is the frame which is partially
5402 constructed. */
5403
5404static Lisp_Object
5405unwind_create_frame (frame)
5406 Lisp_Object frame;
5407{
5408 struct frame *f = XFRAME (frame);
5409
5410 /* If frame is ``official'', nothing to do. */
5411 if (!CONSP (Vframe_list) || !EQ (XCAR (Vframe_list), frame))
5412 {
5413#ifdef GLYPH_DEBUG
5414 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
5415#endif
5416
5417 x_free_frame_resources (f);
5418
5419 /* Check that reference counts are indeed correct. */
5420 xassert (dpyinfo->reference_count == dpyinfo_refcount);
5421 xassert (dpyinfo->image_cache->refcount == image_cache_refcount);
c844a81a
GM
5422
5423 return Qt;
937e601e
AI
5424 }
5425
5426 return Qnil;
5427}
5428
5429
ee78dc32
GV
5430DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
5431 1, 1, 0,
74e1aeec
JR
5432 doc: /* Make a new window, which is called a \"frame\" in Emacs terms.
5433Returns an Emacs frame object.
5434ALIST is an alist of frame parameters.
5435If the parameters specify that the frame should not have a minibuffer,
5436and do not specify a specific minibuffer window to use,
5437then `default-minibuffer-frame' must be a frame whose minibuffer can
5438be shared by the new frame.
5439
5440This function is an internal primitive--use `make-frame' instead. */)
ee78dc32
GV
5441 (parms)
5442 Lisp_Object parms;
5443{
5444 struct frame *f;
5445 Lisp_Object frame, tem;
5446 Lisp_Object name;
5447 int minibuffer_only = 0;
5448 long window_prompting = 0;
5449 int width, height;
331379bf 5450 int count = SPECPDL_INDEX ();
1edf84e7 5451 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
ee78dc32 5452 Lisp_Object display;
6fc2811b 5453 struct w32_display_info *dpyinfo = NULL;
ee78dc32
GV
5454 Lisp_Object parent;
5455 struct kboard *kb;
5456
4587b026
GV
5457 check_w32 ();
5458
ee78dc32
GV
5459 /* Use this general default value to start with
5460 until we know if this frame has a specified name. */
5461 Vx_resource_name = Vinvocation_name;
5462
6fc2811b 5463 display = w32_get_arg (parms, Qdisplay, 0, 0, RES_TYPE_STRING);
ee78dc32
GV
5464 if (EQ (display, Qunbound))
5465 display = Qnil;
5466 dpyinfo = check_x_display_info (display);
5467#ifdef MULTI_KBOARD
5468 kb = dpyinfo->kboard;
5469#else
5470 kb = &the_only_kboard;
5471#endif
5472
6fc2811b 5473 name = w32_get_arg (parms, Qname, "name", "Name", RES_TYPE_STRING);
ee78dc32
GV
5474 if (!STRINGP (name)
5475 && ! EQ (name, Qunbound)
5476 && ! NILP (name))
5477 error ("Invalid frame name--not a string or nil");
5478
5479 if (STRINGP (name))
5480 Vx_resource_name = name;
5481
5482 /* See if parent window is specified. */
6fc2811b 5483 parent = w32_get_arg (parms, Qparent_id, NULL, NULL, RES_TYPE_NUMBER);
ee78dc32
GV
5484 if (EQ (parent, Qunbound))
5485 parent = Qnil;
5486 if (! NILP (parent))
b7826503 5487 CHECK_NUMBER (parent);
ee78dc32 5488
1edf84e7
GV
5489 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
5490 /* No need to protect DISPLAY because that's not used after passing
5491 it to make_frame_without_minibuffer. */
5492 frame = Qnil;
5493 GCPRO4 (parms, parent, name, frame);
1660f34a
JR
5494 tem = w32_get_arg (parms, Qminibuffer, "minibuffer", "Minibuffer",
5495 RES_TYPE_SYMBOL);
ee78dc32
GV
5496 if (EQ (tem, Qnone) || NILP (tem))
5497 f = make_frame_without_minibuffer (Qnil, kb, display);
5498 else if (EQ (tem, Qonly))
5499 {
5500 f = make_minibuffer_frame ();
5501 minibuffer_only = 1;
5502 }
5503 else if (WINDOWP (tem))
5504 f = make_frame_without_minibuffer (tem, kb, display);
5505 else
5506 f = make_frame (1);
5507
1edf84e7
GV
5508 XSETFRAME (frame, f);
5509
ee78dc32
GV
5510 /* Note that Windows does support scroll bars. */
5511 FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
5ac45f98
GV
5512 /* By default, make scrollbars the system standard width. */
5513 f->scroll_bar_pixel_width = GetSystemMetrics (SM_CXVSCROLL);
ee78dc32 5514
fbd6baed 5515 f->output_method = output_w32;
6fc2811b
JR
5516 f->output_data.w32 =
5517 (struct w32_output *) xmalloc (sizeof (struct w32_output));
fbd6baed 5518 bzero (f->output_data.w32, sizeof (struct w32_output));
4587b026 5519 FRAME_FONTSET (f) = -1;
937e601e 5520 record_unwind_protect (unwind_create_frame, frame);
4587b026 5521
1edf84e7 5522 f->icon_name
6fc2811b 5523 = w32_get_arg (parms, Qicon_name, "iconName", "Title", RES_TYPE_STRING);
1edf84e7
GV
5524 if (! STRINGP (f->icon_name))
5525 f->icon_name = Qnil;
5526
fbd6baed 5527/* FRAME_W32_DISPLAY_INFO (f) = dpyinfo; */
ee78dc32
GV
5528#ifdef MULTI_KBOARD
5529 FRAME_KBOARD (f) = kb;
5530#endif
5531
5532 /* Specify the parent under which to make this window. */
5533
5534 if (!NILP (parent))
5535 {
1660f34a 5536 f->output_data.w32->parent_desc = (Window) XFASTINT (parent);
fbd6baed 5537 f->output_data.w32->explicit_parent = 1;
ee78dc32
GV
5538 }
5539 else
5540 {
fbd6baed
GV
5541 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
5542 f->output_data.w32->explicit_parent = 0;
ee78dc32
GV
5543 }
5544
ee78dc32
GV
5545 /* Set the name; the functions to which we pass f expect the name to
5546 be set. */
5547 if (EQ (name, Qunbound) || NILP (name))
5548 {
fbd6baed 5549 f->name = build_string (dpyinfo->w32_id_name);
ee78dc32
GV
5550 f->explicit_name = 0;
5551 }
5552 else
5553 {
5554 f->name = name;
5555 f->explicit_name = 1;
5556 /* use the frame's title when getting resources for this frame. */
5557 specbind (Qx_resource_name, name);
5558 }
5559
5560 /* Extract the window parameters from the supplied values
5561 that are needed to determine window geometry. */
5562 {
5563 Lisp_Object font;
5564
6fc2811b
JR
5565 font = w32_get_arg (parms, Qfont, "font", "Font", RES_TYPE_STRING);
5566
ee78dc32
GV
5567 BLOCK_INPUT;
5568 /* First, try whatever font the caller has specified. */
5569 if (STRINGP (font))
4587b026
GV
5570 {
5571 tem = Fquery_fontset (font, Qnil);
5572 if (STRINGP (tem))
d5db4077 5573 font = x_new_fontset (f, SDATA (tem));
4587b026 5574 else
d5db4077 5575 font = x_new_font (f, SDATA (font));
4587b026 5576 }
ee78dc32
GV
5577 /* Try out a font which we hope has bold and italic variations. */
5578 if (!STRINGP (font))
e39649be 5579 font = x_new_font (f, "-*-Courier New-normal-r-*-*-*-100-*-*-c-*-iso8859-1");
ee78dc32 5580 if (! STRINGP (font))
6fc2811b 5581 font = x_new_font (f, "-*-Courier-normal-r-*-*-13-*-*-*-c-*-iso8859-1");
ee78dc32
GV
5582 /* If those didn't work, look for something which will at least work. */
5583 if (! STRINGP (font))
6fc2811b 5584 font = x_new_font (f, "-*-Fixedsys-normal-r-*-*-12-*-*-*-c-*-iso8859-1");
ee78dc32
GV
5585 UNBLOCK_INPUT;
5586 if (! STRINGP (font))
1edf84e7 5587 font = build_string ("Fixedsys");
ee78dc32
GV
5588
5589 x_default_parameter (f, parms, Qfont, font,
6fc2811b 5590 "font", "Font", RES_TYPE_STRING);
ee78dc32
GV
5591 }
5592
5593 x_default_parameter (f, parms, Qborder_width, make_number (2),
1660f34a 5594 "borderWidth", "BorderWidth", RES_TYPE_NUMBER);
ee78dc32
GV
5595 /* This defaults to 2 in order to match xterm. We recognize either
5596 internalBorderWidth or internalBorder (which is what xterm calls
5597 it). */
5598 if (NILP (Fassq (Qinternal_border_width, parms)))
5599 {
5600 Lisp_Object value;
5601
6fc2811b 5602 value = w32_get_arg (parms, Qinternal_border_width,
1660f34a 5603 "internalBorder", "InternalBorder", RES_TYPE_NUMBER);
ee78dc32
GV
5604 if (! EQ (value, Qunbound))
5605 parms = Fcons (Fcons (Qinternal_border_width, value),
5606 parms);
5607 }
1edf84e7 5608 /* Default internalBorderWidth to 0 on Windows to match other programs. */
ee78dc32 5609 x_default_parameter (f, parms, Qinternal_border_width, make_number (0),
1660f34a
JR
5610 "internalBorderWidth", "InternalBorder", RES_TYPE_NUMBER);
5611 x_default_parameter (f, parms, Qvertical_scroll_bars, Qright,
5612 "verticalScrollBars", "ScrollBars", RES_TYPE_SYMBOL);
ee78dc32
GV
5613
5614 /* Also do the stuff which must be set before the window exists. */
5615 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
6fc2811b 5616 "foreground", "Foreground", RES_TYPE_STRING);
ee78dc32 5617 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
6fc2811b 5618 "background", "Background", RES_TYPE_STRING);
ee78dc32 5619 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
6fc2811b 5620 "pointerColor", "Foreground", RES_TYPE_STRING);
ee78dc32 5621 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
6fc2811b 5622 "cursorColor", "Foreground", RES_TYPE_STRING);
ee78dc32 5623 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
6fc2811b
JR
5624 "borderColor", "BorderColor", RES_TYPE_STRING);
5625 x_default_parameter (f, parms, Qscreen_gamma, Qnil,
5626 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT);
dfff8a69
JR
5627 x_default_parameter (f, parms, Qline_spacing, Qnil,
5628 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER);
41c1bdd9
KS
5629 x_default_parameter (f, parms, Qleft_fringe, Qnil,
5630 "leftFringe", "LeftFringe", RES_TYPE_NUMBER);
5631 x_default_parameter (f, parms, Qright_fringe, Qnil,
5632 "rightFringe", "RightFringe", RES_TYPE_NUMBER);
6fc2811b 5633
ee78dc32 5634
6fc2811b
JR
5635 /* Init faces before x_default_parameter is called for scroll-bar
5636 parameters because that function calls x_set_scroll_bar_width,
5637 which calls change_frame_size, which calls Fset_window_buffer,
5638 which runs hooks, which call Fvertical_motion. At the end, we
5639 end up in init_iterator with a null face cache, which should not
5640 happen. */
5641 init_frame_faces (f);
5642
ee78dc32 5643 x_default_parameter (f, parms, Qmenu_bar_lines, make_number (1),
6fc2811b 5644 "menuBar", "MenuBar", RES_TYPE_NUMBER);
d3109773 5645 x_default_parameter (f, parms, Qtool_bar_lines, make_number (1),
6fc2811b 5646 "toolBar", "ToolBar", RES_TYPE_NUMBER);
919f1e88 5647
1edf84e7 5648 x_default_parameter (f, parms, Qbuffer_predicate, Qnil,
6fc2811b 5649 "bufferPredicate", "BufferPredicate", RES_TYPE_SYMBOL);
1edf84e7 5650 x_default_parameter (f, parms, Qtitle, Qnil,
6fc2811b 5651 "title", "Title", RES_TYPE_STRING);
f7b9d4d1
JR
5652 x_default_parameter (f, parms, Qfullscreen, Qnil,
5653 "fullscreen", "Fullscreen", RES_TYPE_SYMBOL);
ee78dc32 5654
fbd6baed
GV
5655 f->output_data.w32->dwStyle = WS_OVERLAPPEDWINDOW;
5656 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
3cf3436e
JR
5657
5658 /* Add the tool-bar height to the initial frame height so that the
5659 user gets a text display area of the size he specified with -g or
5660 via .Xdefaults. Later changes of the tool-bar height don't
5661 change the frame size. This is done so that users can create
5662 tall Emacs frames without having to guess how tall the tool-bar
5663 will get. */
5664 if (FRAME_TOOL_BAR_LINES (f))
5665 {
5666 int margin, relief, bar_height;
5667
a05e2bae 5668 relief = (tool_bar_button_relief >= 0
3cf3436e
JR
5669 ? tool_bar_button_relief
5670 : DEFAULT_TOOL_BAR_BUTTON_RELIEF);
5671
5672 if (INTEGERP (Vtool_bar_button_margin)
5673 && XINT (Vtool_bar_button_margin) > 0)
5674 margin = XFASTINT (Vtool_bar_button_margin);
5675 else if (CONSP (Vtool_bar_button_margin)
5676 && INTEGERP (XCDR (Vtool_bar_button_margin))
5677 && XINT (XCDR (Vtool_bar_button_margin)) > 0)
5678 margin = XFASTINT (XCDR (Vtool_bar_button_margin));
5679 else
5680 margin = 0;
5681
5682 bar_height = DEFAULT_TOOL_BAR_IMAGE_HEIGHT + 2 * margin + 2 * relief;
5683 f->height += (bar_height + CANON_Y_UNIT (f) - 1) / CANON_Y_UNIT (f);
5684 }
5685
ee78dc32
GV
5686 window_prompting = x_figure_window_size (f, parms);
5687
5688 if (window_prompting & XNegative)
5689 {
5690 if (window_prompting & YNegative)
fbd6baed 5691 f->output_data.w32->win_gravity = SouthEastGravity;
ee78dc32 5692 else
fbd6baed 5693 f->output_data.w32->win_gravity = NorthEastGravity;
ee78dc32
GV
5694 }
5695 else
5696 {
5697 if (window_prompting & YNegative)
fbd6baed 5698 f->output_data.w32->win_gravity = SouthWestGravity;
ee78dc32 5699 else
fbd6baed 5700 f->output_data.w32->win_gravity = NorthWestGravity;
ee78dc32
GV
5701 }
5702
fbd6baed 5703 f->output_data.w32->size_hint_flags = window_prompting;
ee78dc32 5704
6fc2811b
JR
5705 tem = w32_get_arg (parms, Qunsplittable, 0, 0, RES_TYPE_BOOLEAN);
5706 f->no_split = minibuffer_only || EQ (tem, Qt);
5707
fbd6baed 5708 w32_window (f, window_prompting, minibuffer_only);
ee78dc32 5709 x_icon (f, parms);
6fc2811b
JR
5710
5711 x_make_gc (f);
5712
5713 /* Now consider the frame official. */
5714 FRAME_W32_DISPLAY_INFO (f)->reference_count++;
5715 Vframe_list = Fcons (frame, Vframe_list);
ee78dc32
GV
5716
5717 /* We need to do this after creating the window, so that the
5718 icon-creation functions can say whose icon they're describing. */
5719 x_default_parameter (f, parms, Qicon_type, Qnil,
6fc2811b 5720 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL);
ee78dc32
GV
5721
5722 x_default_parameter (f, parms, Qauto_raise, Qnil,
6fc2811b 5723 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
ee78dc32 5724 x_default_parameter (f, parms, Qauto_lower, Qnil,
6fc2811b 5725 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
ee78dc32 5726 x_default_parameter (f, parms, Qcursor_type, Qbox,
6fc2811b
JR
5727 "cursorType", "CursorType", RES_TYPE_SYMBOL);
5728 x_default_parameter (f, parms, Qscroll_bar_width, Qnil,
5729 "scrollBarWidth", "ScrollBarWidth", RES_TYPE_NUMBER);
ee78dc32
GV
5730
5731 /* Dimensions, especially f->height, must be done via change_frame_size.
5732 Change will not be effected unless different from the current
5733 f->height. */
5734 width = f->width;
5735 height = f->height;
dc220243 5736
1026b400
RS
5737 f->height = 0;
5738 SET_FRAME_WIDTH (f, 0);
6fc2811b
JR
5739 change_frame_size (f, height, width, 1, 0, 0);
5740
6fc2811b
JR
5741 /* Tell the server what size and position, etc, we want, and how
5742 badly we want them. This should be done after we have the menu
5743 bar so that its size can be taken into account. */
ee78dc32
GV
5744 BLOCK_INPUT;
5745 x_wm_set_size_hint (f, window_prompting, 0);
5746 UNBLOCK_INPUT;
5747
815d969e
JR
5748 /* Avoid a bug that causes the new frame to never become visible if
5749 an echo area message is displayed during the following call1. */
5750 specbind(Qredisplay_dont_pause, Qt);
5751
4694d762
JR
5752 /* Set up faces after all frame parameters are known. This call
5753 also merges in face attributes specified for new frames. If we
5754 don't do this, the `menu' face for instance won't have the right
5755 colors, and the menu bar won't appear in the specified colors for
5756 new frames. */
5757 call1 (Qface_set_after_frame_default, frame);
5758
6fc2811b
JR
5759 /* Make the window appear on the frame and enable display, unless
5760 the caller says not to. However, with explicit parent, Emacs
5761 cannot control visibility, so don't try. */
fbd6baed 5762 if (! f->output_data.w32->explicit_parent)
ee78dc32
GV
5763 {
5764 Lisp_Object visibility;
5765
6fc2811b 5766 visibility = w32_get_arg (parms, Qvisibility, 0, 0, RES_TYPE_SYMBOL);
ee78dc32
GV
5767 if (EQ (visibility, Qunbound))
5768 visibility = Qt;
5769
5770 if (EQ (visibility, Qicon))
5771 x_iconify_frame (f);
5772 else if (! NILP (visibility))
5773 x_make_frame_visible (f);
5774 else
5775 /* Must have been Qnil. */
5776 ;
5777 }
6fc2811b 5778 UNGCPRO;
9e57df62
GM
5779
5780 /* Make sure windows on this frame appear in calls to next-window
5781 and similar functions. */
5782 Vwindow_list = Qnil;
5783
ee78dc32
GV
5784 return unbind_to (count, frame);
5785}
5786
5787/* FRAME is used only to get a handle on the X display. We don't pass the
5788 display info directly because we're called from frame.c, which doesn't
5789 know about that structure. */
5790Lisp_Object
5791x_get_focus_frame (frame)
5792 struct frame *frame;
5793{
fbd6baed 5794 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (frame);
ee78dc32 5795 Lisp_Object xfocus;
fbd6baed 5796 if (! dpyinfo->w32_focus_frame)
ee78dc32
GV
5797 return Qnil;
5798
fbd6baed 5799 XSETFRAME (xfocus, dpyinfo->w32_focus_frame);
ee78dc32
GV
5800 return xfocus;
5801}
1edf84e7
GV
5802
5803DEFUN ("w32-focus-frame", Fw32_focus_frame, Sw32_focus_frame, 1, 1, 0,
74e1aeec 5804 doc: /* Give FRAME input focus, raising to foreground if necessary. */)
1edf84e7
GV
5805 (frame)
5806 Lisp_Object frame;
5807{
5808 x_focus_on_frame (check_x_frame (frame));
5809 return Qnil;
5810}
5811
ee78dc32 5812\f
767b1ff0
JR
5813/* Return the charset portion of a font name. */
5814char * xlfd_charset_of_font (char * fontname)
5815{
5816 char *charset, *encoding;
5817
5818 encoding = strrchr(fontname, '-');
ceb12877 5819 if (!encoding || encoding == fontname)
767b1ff0
JR
5820 return NULL;
5821
478ea067
AI
5822 for (charset = encoding - 1; charset >= fontname; charset--)
5823 if (*charset == '-')
5824 break;
767b1ff0 5825
478ea067 5826 if (charset == fontname || strcmp(charset, "-*-*") == 0)
767b1ff0
JR
5827 return NULL;
5828
5829 return charset + 1;
5830}
5831
33d52f9c
GV
5832struct font_info *w32_load_bdf_font (struct frame *f, char *fontname,
5833 int size, char* filename);
8edb0a6f 5834static Lisp_Object w32_list_bdf_fonts (Lisp_Object pattern, int max_names);
c7501041
EZ
5835static BOOL w32_to_x_font (LOGFONT * lplf, char * lpxstr, int len,
5836 char * charset);
5837static BOOL x_to_w32_font (char *lpxstr, LOGFONT *lplogfont);
33d52f9c 5838
8edb0a6f 5839static struct font_info *
33d52f9c 5840w32_load_system_font (f,fontname,size)
55dcfc15
AI
5841 struct frame *f;
5842 char * fontname;
5843 int size;
ee78dc32 5844{
4587b026
GV
5845 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
5846 Lisp_Object font_names;
5847
4587b026
GV
5848 /* Get a list of all the fonts that match this name. Once we
5849 have a list of matching fonts, we compare them against the fonts
5850 we already have loaded by comparing names. */
5851 font_names = w32_list_fonts (f, build_string (fontname), size, 100);
5852
5853 if (!NILP (font_names))
3c190163 5854 {
4587b026
GV
5855 Lisp_Object tail;
5856 int i;
4587b026
GV
5857
5858 /* First check if any are already loaded, as that is cheaper
5859 than loading another one. */
5860 for (i = 0; i < dpyinfo->n_fonts; i++)
8e713be6 5861 for (tail = font_names; CONSP (tail); tail = XCDR (tail))
6fc2811b
JR
5862 if (dpyinfo->font_table[i].name
5863 && (!strcmp (dpyinfo->font_table[i].name,
d5db4077 5864 SDATA (XCAR (tail)))
6fc2811b 5865 || !strcmp (dpyinfo->font_table[i].full_name,
d5db4077 5866 SDATA (XCAR (tail)))))
4587b026 5867 return (dpyinfo->font_table + i);
6fc2811b 5868
d5db4077 5869 fontname = (char *) SDATA (XCAR (font_names));
4587b026 5870 }
1075afa9 5871 else if (w32_strict_fontnames)
5ca0cd71
GV
5872 {
5873 /* If EnumFontFamiliesEx was available, we got a full list of
5874 fonts back so stop now to avoid the possibility of loading a
5875 random font. If we had to fall back to EnumFontFamilies, the
5876 list is incomplete, so continue whether the font we want was
5877 listed or not. */
5878 HMODULE gdi32 = GetModuleHandle ("gdi32.dll");
5879 FARPROC enum_font_families_ex
1075afa9 5880 = GetProcAddress (gdi32, "EnumFontFamiliesExA");
5ca0cd71
GV
5881 if (enum_font_families_ex)
5882 return NULL;
5883 }
4587b026
GV
5884
5885 /* Load the font and add it to the table. */
5886 {
767b1ff0 5887 char *full_name, *encoding, *charset;
4587b026
GV
5888 XFontStruct *font;
5889 struct font_info *fontp;
3c190163 5890 LOGFONT lf;
4587b026 5891 BOOL ok;
19c291d3 5892 int codepage;
6fc2811b 5893 int i;
5ac45f98 5894
4587b026 5895 if (!fontname || !x_to_w32_font (fontname, &lf))
3c190163 5896 return (NULL);
5ac45f98 5897
4587b026
GV
5898 if (!*lf.lfFaceName)
5899 /* If no name was specified for the font, we get a random font
5900 from CreateFontIndirect - this is not particularly
5901 desirable, especially since CreateFontIndirect does not
5902 fill out the missing name in lf, so we never know what we
5903 ended up with. */
5904 return NULL;
5905
d65a9cdc
JR
5906 /* Specify anti-aliasing to prevent Cleartype fonts being used,
5907 since those fonts leave garbage behind. */
5908 lf.lfQuality = ANTIALIASED_QUALITY;
5909
3c190163 5910 font = (XFontStruct *) xmalloc (sizeof (XFontStruct));
c6be3860 5911 bzero (font, sizeof (*font));
5ac45f98 5912
33d52f9c
GV
5913 /* Set bdf to NULL to indicate that this is a Windows font. */
5914 font->bdf = NULL;
5ac45f98 5915
3c190163 5916 BLOCK_INPUT;
5ac45f98
GV
5917
5918 font->hfont = CreateFontIndirect (&lf);
ee78dc32 5919
1a292d24
AI
5920 if (font->hfont == NULL)
5921 {
5922 ok = FALSE;
5923 }
5924 else
5925 {
5926 HDC hdc;
5927 HANDLE oldobj;
19c291d3
AI
5928
5929 codepage = w32_codepage_for_font (fontname);
1a292d24
AI
5930
5931 hdc = GetDC (dpyinfo->root_window);
5932 oldobj = SelectObject (hdc, font->hfont);
5c6682be 5933
1a292d24 5934 ok = GetTextMetrics (hdc, &font->tm);
5c6682be
JR
5935 if (codepage == CP_UNICODE)
5936 font->double_byte_p = 1;
5937 else
8b77111c
AI
5938 {
5939 /* Unfortunately, some fonts (eg. MingLiU, a big5 ttf font)
5940 don't report themselves as double byte fonts, when
5941 patently they are. So instead of trusting
5942 GetFontLanguageInfo, we check the properties of the
5943 codepage directly, since that is ultimately what we are
5944 working from anyway. */
5945 /* font->double_byte_p = GetFontLanguageInfo(hdc) & GCP_DBCS; */
5946 CPINFO cpi = {0};
5947 GetCPInfo (codepage, &cpi);
5948 font->double_byte_p = cpi.MaxCharSize > 1;
5949 }
5c6682be 5950
1a292d24
AI
5951 SelectObject (hdc, oldobj);
5952 ReleaseDC (dpyinfo->root_window, hdc);
6fc2811b
JR
5953 /* Fill out details in lf according to the font that was
5954 actually loaded. */
5955 lf.lfHeight = font->tm.tmInternalLeading - font->tm.tmHeight;
5956 lf.lfWidth = font->tm.tmAveCharWidth;
5957 lf.lfWeight = font->tm.tmWeight;
5958 lf.lfItalic = font->tm.tmItalic;
5959 lf.lfCharSet = font->tm.tmCharSet;
5960 lf.lfPitchAndFamily = ((font->tm.tmPitchAndFamily & TMPF_FIXED_PITCH)
d88c567c 5961 ? VARIABLE_PITCH : FIXED_PITCH);
6fc2811b
JR
5962 lf.lfOutPrecision = ((font->tm.tmPitchAndFamily & TMPF_VECTOR)
5963 ? OUT_STROKE_PRECIS : OUT_STRING_PRECIS);
c6be3860
AI
5964
5965 w32_cache_char_metrics (font);
1a292d24 5966 }
5ac45f98 5967
1a292d24 5968 UNBLOCK_INPUT;
5ac45f98 5969
4587b026
GV
5970 if (!ok)
5971 {
1a292d24
AI
5972 w32_unload_font (dpyinfo, font);
5973 return (NULL);
5974 }
ee78dc32 5975
6fc2811b
JR
5976 /* Find a free slot in the font table. */
5977 for (i = 0; i < dpyinfo->n_fonts; ++i)
5978 if (dpyinfo->font_table[i].name == NULL)
5979 break;
5980
5981 /* If no free slot found, maybe enlarge the font table. */
5982 if (i == dpyinfo->n_fonts
5983 && dpyinfo->n_fonts == dpyinfo->font_table_size)
4587b026 5984 {
6fc2811b
JR
5985 int sz;
5986 dpyinfo->font_table_size = max (16, 2 * dpyinfo->font_table_size);
5987 sz = dpyinfo->font_table_size * sizeof *dpyinfo->font_table;
4587b026 5988 dpyinfo->font_table
6fc2811b 5989 = (struct font_info *) xrealloc (dpyinfo->font_table, sz);
4587b026
GV
5990 }
5991
6fc2811b
JR
5992 fontp = dpyinfo->font_table + i;
5993 if (i == dpyinfo->n_fonts)
5994 ++dpyinfo->n_fonts;
4587b026
GV
5995
5996 /* Now fill in the slots of *FONTP. */
5997 BLOCK_INPUT;
5998 fontp->font = font;
6fc2811b 5999 fontp->font_idx = i;
4587b026
GV
6000 fontp->name = (char *) xmalloc (strlen (fontname) + 1);
6001 bcopy (fontname, fontp->name, strlen (fontname) + 1);
6002
767b1ff0
JR
6003 charset = xlfd_charset_of_font (fontname);
6004
19c291d3
AI
6005 /* Cache the W32 codepage for a font. This makes w32_encode_char
6006 (called for every glyph during redisplay) much faster. */
6007 fontp->codepage = codepage;
6008
4587b026
GV
6009 /* Work out the font's full name. */
6010 full_name = (char *)xmalloc (100);
767b1ff0 6011 if (full_name && w32_to_x_font (&lf, full_name, 100, charset))
4587b026
GV
6012 fontp->full_name = full_name;
6013 else
6014 {
6015 /* If all else fails - just use the name we used to load it. */
6016 xfree (full_name);
6017 fontp->full_name = fontp->name;
6018 }
6019
6020 fontp->size = FONT_WIDTH (font);
6021 fontp->height = FONT_HEIGHT (font);
6022
6023 /* The slot `encoding' specifies how to map a character
6024 code-points (0x20..0x7F or 0x2020..0x7F7F) of each charset to
126f2e35
JR
6025 the font code-points (0:0x20..0x7F, 1:0xA0..0xFF), or
6026 (0:0x20..0x7F, 1:0xA0..0xFF,
6027 (0:0x2020..0x7F7F, 1:0xA0A0..0xFFFF, 3:0x20A0..0x7FFF,
4587b026 6028 2:0xA020..0xFF7F). For the moment, we don't know which charset
6fc2811b 6029 uses this font. So, we set information in fontp->encoding[1]
4587b026
GV
6030 which is never used by any charset. If mapping can't be
6031 decided, set FONT_ENCODING_NOT_DECIDED. */
33d52f9c
GV
6032
6033 /* SJIS fonts need to be set to type 4, all others seem to work as
6034 type FONT_ENCODING_NOT_DECIDED. */
6035 encoding = strrchr (fontp->name, '-');
d84b082d 6036 if (encoding && strnicmp (encoding+1, "sjis", 4) == 0)
1c885fe1 6037 fontp->encoding[1] = 4;
33d52f9c 6038 else
1c885fe1 6039 fontp->encoding[1] = FONT_ENCODING_NOT_DECIDED;
4587b026
GV
6040
6041 /* The following three values are set to 0 under W32, which is
6042 what they get set to if XGetFontProperty fails under X. */
6043 fontp->baseline_offset = 0;
6044 fontp->relative_compose = 0;
33d52f9c 6045 fontp->default_ascent = 0;
4587b026 6046
6fc2811b
JR
6047 /* Set global flag fonts_changed_p to non-zero if the font loaded
6048 has a character with a smaller width than any other character
f7b9d4d1 6049 before, or if the font loaded has a smaller height than any
6fc2811b
JR
6050 other font loaded before. If this happens, it will make a
6051 glyph matrix reallocation necessary. */
f7b9d4d1 6052 fonts_changed_p |= x_compute_min_glyph_bounds (f);
4587b026 6053 UNBLOCK_INPUT;
4587b026
GV
6054 return fontp;
6055 }
6056}
6057
33d52f9c
GV
6058/* Load font named FONTNAME of size SIZE for frame F, and return a
6059 pointer to the structure font_info while allocating it dynamically.
6060 If loading fails, return NULL. */
6061struct font_info *
6062w32_load_font (f,fontname,size)
6063struct frame *f;
6064char * fontname;
6065int size;
6066{
6067 Lisp_Object bdf_fonts;
6068 struct font_info *retval = NULL;
6069
8edb0a6f 6070 bdf_fonts = w32_list_bdf_fonts (build_string (fontname), 1);
33d52f9c
GV
6071
6072 while (!retval && CONSP (bdf_fonts))
6073 {
6074 char *bdf_name, *bdf_file;
6075 Lisp_Object bdf_pair;
6076
d5db4077 6077 bdf_name = SDATA (XCAR (bdf_fonts));
8e713be6 6078 bdf_pair = Fassoc (XCAR (bdf_fonts), Vw32_bdf_filename_alist);
d5db4077 6079 bdf_file = SDATA (XCDR (bdf_pair));
33d52f9c
GV
6080
6081 retval = w32_load_bdf_font (f, bdf_name, size, bdf_file);
6082
8e713be6 6083 bdf_fonts = XCDR (bdf_fonts);
33d52f9c
GV
6084 }
6085
6086 if (retval)
6087 return retval;
6088
6089 return w32_load_system_font(f, fontname, size);
6090}
6091
6092
ee78dc32 6093void
fbd6baed
GV
6094w32_unload_font (dpyinfo, font)
6095 struct w32_display_info *dpyinfo;
ee78dc32
GV
6096 XFontStruct * font;
6097{
6098 if (font)
6099 {
c6be3860 6100 if (font->per_char) xfree (font->per_char);
33d52f9c
GV
6101 if (font->bdf) w32_free_bdf_font (font->bdf);
6102
3c190163 6103 if (font->hfont) DeleteObject(font->hfont);
ee78dc32
GV
6104 xfree (font);
6105 }
6106}
6107
fbd6baed 6108/* The font conversion stuff between x and w32 */
ee78dc32
GV
6109
6110/* X font string is as follows (from faces.el)
6111 * (let ((- "[-?]")
6112 * (foundry "[^-]+")
6113 * (family "[^-]+")
6114 * (weight "\\(bold\\|demibold\\|medium\\)") ; 1
6115 * (weight\? "\\([^-]*\\)") ; 1
6116 * (slant "\\([ior]\\)") ; 2
6117 * (slant\? "\\([^-]?\\)") ; 2
6118 * (swidth "\\([^-]*\\)") ; 3
6119 * (adstyle "[^-]*") ; 4
6120 * (pixelsize "[0-9]+")
6121 * (pointsize "[0-9][0-9]+")
6122 * (resx "[0-9][0-9]+")
6123 * (resy "[0-9][0-9]+")
6124 * (spacing "[cmp?*]")
6125 * (avgwidth "[0-9]+")
6126 * (registry "[^-]+")
6127 * (encoding "[^-]+")
6128 * )
ee78dc32 6129 */
ee78dc32 6130
8edb0a6f 6131static LONG
fbd6baed 6132x_to_w32_weight (lpw)
ee78dc32
GV
6133 char * lpw;
6134{
6135 if (!lpw) return (FW_DONTCARE);
5ac45f98
GV
6136
6137 if (stricmp (lpw,"heavy") == 0) return FW_HEAVY;
6138 else if (stricmp (lpw,"extrabold") == 0) return FW_EXTRABOLD;
6139 else if (stricmp (lpw,"bold") == 0) return FW_BOLD;
6140 else if (stricmp (lpw,"demibold") == 0) return FW_SEMIBOLD;
1edf84e7 6141 else if (stricmp (lpw,"semibold") == 0) return FW_SEMIBOLD;
5ac45f98
GV
6142 else if (stricmp (lpw,"medium") == 0) return FW_MEDIUM;
6143 else if (stricmp (lpw,"normal") == 0) return FW_NORMAL;
6144 else if (stricmp (lpw,"light") == 0) return FW_LIGHT;
6145 else if (stricmp (lpw,"extralight") == 0) return FW_EXTRALIGHT;
6146 else if (stricmp (lpw,"thin") == 0) return FW_THIN;
ee78dc32 6147 else
5ac45f98 6148 return FW_DONTCARE;
ee78dc32
GV
6149}
6150
5ac45f98 6151
8edb0a6f 6152static char *
fbd6baed 6153w32_to_x_weight (fnweight)
ee78dc32
GV
6154 int fnweight;
6155{
5ac45f98
GV
6156 if (fnweight >= FW_HEAVY) return "heavy";
6157 if (fnweight >= FW_EXTRABOLD) return "extrabold";
6158 if (fnweight >= FW_BOLD) return "bold";
03f8fb34 6159 if (fnweight >= FW_SEMIBOLD) return "demibold";
5ac45f98
GV
6160 if (fnweight >= FW_MEDIUM) return "medium";
6161 if (fnweight >= FW_NORMAL) return "normal";
6162 if (fnweight >= FW_LIGHT) return "light";
6163 if (fnweight >= FW_EXTRALIGHT) return "extralight";
6164 if (fnweight >= FW_THIN) return "thin";
6165 else
6166 return "*";
6167}
6168
8edb0a6f 6169static LONG
fbd6baed 6170x_to_w32_charset (lpcs)
5ac45f98
GV
6171 char * lpcs;
6172{
767b1ff0 6173 Lisp_Object this_entry, w32_charset;
8b77111c
AI
6174 char *charset;
6175 int len = strlen (lpcs);
6176
6177 /* Support "*-#nnn" format for unknown charsets. */
6178 if (strncmp (lpcs, "*-#", 3) == 0)
6179 return atoi (lpcs + 3);
6180
6181 /* Handle wildcards by ignoring them; eg. treat "big5*-*" as "big5". */
6182 charset = alloca (len + 1);
6183 strcpy (charset, lpcs);
6184 lpcs = strchr (charset, '*');
6185 if (lpcs)
6186 *lpcs = 0;
4587b026 6187
dfff8a69
JR
6188 /* Look through w32-charset-info-alist for the character set.
6189 Format of each entry is
6190 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
6191 */
8b77111c 6192 this_entry = Fassoc (build_string(charset), Vw32_charset_info_alist);
4587b026 6193
767b1ff0
JR
6194 if (NILP(this_entry))
6195 {
6196 /* At startup, we want iso8859-1 fonts to come up properly. */
8b77111c 6197 if (stricmp(charset, "iso8859-1") == 0)
767b1ff0
JR
6198 return ANSI_CHARSET;
6199 else
6200 return DEFAULT_CHARSET;
6201 }
6202
6203 w32_charset = Fcar (Fcdr (this_entry));
6204
d84b082d 6205 /* Translate Lisp symbol to number. */
767b1ff0
JR
6206 if (w32_charset == Qw32_charset_ansi)
6207 return ANSI_CHARSET;
6208 if (w32_charset == Qw32_charset_symbol)
6209 return SYMBOL_CHARSET;
6210 if (w32_charset == Qw32_charset_shiftjis)
6211 return SHIFTJIS_CHARSET;
6212 if (w32_charset == Qw32_charset_hangeul)
6213 return HANGEUL_CHARSET;
6214 if (w32_charset == Qw32_charset_chinesebig5)
6215 return CHINESEBIG5_CHARSET;
6216 if (w32_charset == Qw32_charset_gb2312)
6217 return GB2312_CHARSET;
6218 if (w32_charset == Qw32_charset_oem)
6219 return OEM_CHARSET;
dfff8a69 6220#ifdef JOHAB_CHARSET
767b1ff0
JR
6221 if (w32_charset == Qw32_charset_johab)
6222 return JOHAB_CHARSET;
6223 if (w32_charset == Qw32_charset_easteurope)
6224 return EASTEUROPE_CHARSET;
6225 if (w32_charset == Qw32_charset_turkish)
6226 return TURKISH_CHARSET;
6227 if (w32_charset == Qw32_charset_baltic)
6228 return BALTIC_CHARSET;
6229 if (w32_charset == Qw32_charset_russian)
6230 return RUSSIAN_CHARSET;
6231 if (w32_charset == Qw32_charset_arabic)
6232 return ARABIC_CHARSET;
6233 if (w32_charset == Qw32_charset_greek)
6234 return GREEK_CHARSET;
6235 if (w32_charset == Qw32_charset_hebrew)
6236 return HEBREW_CHARSET;
6237 if (w32_charset == Qw32_charset_vietnamese)
6238 return VIETNAMESE_CHARSET;
6239 if (w32_charset == Qw32_charset_thai)
6240 return THAI_CHARSET;
6241 if (w32_charset == Qw32_charset_mac)
6242 return MAC_CHARSET;
dfff8a69 6243#endif /* JOHAB_CHARSET */
5ac45f98 6244#ifdef UNICODE_CHARSET
767b1ff0
JR
6245 if (w32_charset == Qw32_charset_unicode)
6246 return UNICODE_CHARSET;
5ac45f98 6247#endif
dfff8a69
JR
6248
6249 return DEFAULT_CHARSET;
5ac45f98
GV
6250}
6251
dfff8a69 6252
8edb0a6f 6253static char *
fbd6baed 6254w32_to_x_charset (fncharset)
5ac45f98
GV
6255 int fncharset;
6256{
5e905a57 6257 static char buf[32];
767b1ff0 6258 Lisp_Object charset_type;
1edf84e7 6259
5ac45f98
GV
6260 switch (fncharset)
6261 {
767b1ff0
JR
6262 case ANSI_CHARSET:
6263 /* Handle startup case of w32-charset-info-alist not
6264 being set up yet. */
6265 if (NILP(Vw32_charset_info_alist))
6266 return "iso8859-1";
6267 charset_type = Qw32_charset_ansi;
6268 break;
6269 case DEFAULT_CHARSET:
6270 charset_type = Qw32_charset_default;
6271 break;
6272 case SYMBOL_CHARSET:
6273 charset_type = Qw32_charset_symbol;
6274 break;
6275 case SHIFTJIS_CHARSET:
6276 charset_type = Qw32_charset_shiftjis;
6277 break;
6278 case HANGEUL_CHARSET:
6279 charset_type = Qw32_charset_hangeul;
6280 break;
6281 case GB2312_CHARSET:
6282 charset_type = Qw32_charset_gb2312;
6283 break;
6284 case CHINESEBIG5_CHARSET:
6285 charset_type = Qw32_charset_chinesebig5;
6286 break;
6287 case OEM_CHARSET:
6288 charset_type = Qw32_charset_oem;
6289 break;
4587b026
GV
6290
6291 /* More recent versions of Windows (95 and NT4.0) define more
6292 character sets. */
6293#ifdef EASTEUROPE_CHARSET
767b1ff0
JR
6294 case EASTEUROPE_CHARSET:
6295 charset_type = Qw32_charset_easteurope;
6296 break;
6297 case TURKISH_CHARSET:
6298 charset_type = Qw32_charset_turkish;
6299 break;
6300 case BALTIC_CHARSET:
6301 charset_type = Qw32_charset_baltic;
6302 break;
33d52f9c 6303 case RUSSIAN_CHARSET:
767b1ff0
JR
6304 charset_type = Qw32_charset_russian;
6305 break;
6306 case ARABIC_CHARSET:
6307 charset_type = Qw32_charset_arabic;
6308 break;
6309 case GREEK_CHARSET:
6310 charset_type = Qw32_charset_greek;
6311 break;
6312 case HEBREW_CHARSET:
6313 charset_type = Qw32_charset_hebrew;
6314 break;
6315 case VIETNAMESE_CHARSET:
6316 charset_type = Qw32_charset_vietnamese;
6317 break;
6318 case THAI_CHARSET:
6319 charset_type = Qw32_charset_thai;
6320 break;
6321 case MAC_CHARSET:
6322 charset_type = Qw32_charset_mac;
6323 break;
6324 case JOHAB_CHARSET:
6325 charset_type = Qw32_charset_johab;
6326 break;
4587b026
GV
6327#endif
6328
5ac45f98 6329#ifdef UNICODE_CHARSET
767b1ff0
JR
6330 case UNICODE_CHARSET:
6331 charset_type = Qw32_charset_unicode;
6332 break;
5ac45f98 6333#endif
767b1ff0
JR
6334 default:
6335 /* Encode numerical value of unknown charset. */
6336 sprintf (buf, "*-#%u", fncharset);
6337 return buf;
5ac45f98 6338 }
767b1ff0
JR
6339
6340 {
6341 Lisp_Object rest;
6342 char * best_match = NULL;
6343
6344 /* Look through w32-charset-info-alist for the character set.
6345 Prefer ISO codepages, and prefer lower numbers in the ISO
6346 range. Only return charsets for codepages which are installed.
6347
6348 Format of each entry is
6349 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
6350 */
6351 for (rest = Vw32_charset_info_alist; CONSP (rest); rest = XCDR (rest))
6352 {
6353 char * x_charset;
6354 Lisp_Object w32_charset;
6355 Lisp_Object codepage;
6356
6357 Lisp_Object this_entry = XCAR (rest);
6358
6359 /* Skip invalid entries in alist. */
6360 if (!CONSP (this_entry) || !STRINGP (XCAR (this_entry))
6361 || !CONSP (XCDR (this_entry))
6362 || !SYMBOLP (XCAR (XCDR (this_entry))))
6363 continue;
6364
d5db4077 6365 x_charset = SDATA (XCAR (this_entry));
767b1ff0
JR
6366 w32_charset = XCAR (XCDR (this_entry));
6367 codepage = XCDR (XCDR (this_entry));
6368
6369 /* Look for Same charset and a valid codepage (or non-int
6370 which means ignore). */
6371 if (w32_charset == charset_type
6372 && (!INTEGERP (codepage) || codepage == CP_DEFAULT
6373 || IsValidCodePage (XINT (codepage))))
6374 {
6375 /* If we don't have a match already, then this is the
6376 best. */
6377 if (!best_match)
6378 best_match = x_charset;
6379 /* If this is an ISO codepage, and the best so far isn't,
6380 then this is better. */
d84b082d
JR
6381 else if (strnicmp (best_match, "iso", 3) != 0
6382 && strnicmp (x_charset, "iso", 3) == 0)
767b1ff0
JR
6383 best_match = x_charset;
6384 /* If both are ISO8859 codepages, choose the one with the
6385 lowest number in the encoding field. */
d84b082d
JR
6386 else if (strnicmp (best_match, "iso8859-", 8) == 0
6387 && strnicmp (x_charset, "iso8859-", 8) == 0)
767b1ff0
JR
6388 {
6389 int best_enc = atoi (best_match + 8);
6390 int this_enc = atoi (x_charset + 8);
6391 if (this_enc > 0 && this_enc < best_enc)
6392 best_match = x_charset;
6393 }
6394 }
6395 }
6396
6397 /* If no match, encode the numeric value. */
6398 if (!best_match)
6399 {
6400 sprintf (buf, "*-#%u", fncharset);
6401 return buf;
6402 }
6403
5e905a57
JR
6404 strncpy(buf, best_match, 31);
6405 buf[31] = '\0';
767b1ff0
JR
6406 return buf;
6407 }
ee78dc32
GV
6408}
6409
dfff8a69 6410
d84b082d
JR
6411/* Return all the X charsets that map to a font. */
6412static Lisp_Object
6413w32_to_all_x_charsets (fncharset)
6414 int fncharset;
6415{
6416 static char buf[32];
6417 Lisp_Object charset_type;
6418 Lisp_Object retval = Qnil;
6419
6420 switch (fncharset)
6421 {
6422 case ANSI_CHARSET:
6423 /* Handle startup case of w32-charset-info-alist not
6424 being set up yet. */
6425 if (NILP(Vw32_charset_info_alist))
d86c35ee
JR
6426 return Fcons (build_string ("iso8859-1"), Qnil);
6427
d84b082d
JR
6428 charset_type = Qw32_charset_ansi;
6429 break;
6430 case DEFAULT_CHARSET:
6431 charset_type = Qw32_charset_default;
6432 break;
6433 case SYMBOL_CHARSET:
6434 charset_type = Qw32_charset_symbol;
6435 break;
6436 case SHIFTJIS_CHARSET:
6437 charset_type = Qw32_charset_shiftjis;
6438 break;
6439 case HANGEUL_CHARSET:
6440 charset_type = Qw32_charset_hangeul;
6441 break;
6442 case GB2312_CHARSET:
6443 charset_type = Qw32_charset_gb2312;
6444 break;
6445 case CHINESEBIG5_CHARSET:
6446 charset_type = Qw32_charset_chinesebig5;
6447 break;
6448 case OEM_CHARSET:
6449 charset_type = Qw32_charset_oem;
6450 break;
6451
6452 /* More recent versions of Windows (95 and NT4.0) define more
6453 character sets. */
6454#ifdef EASTEUROPE_CHARSET
6455 case EASTEUROPE_CHARSET:
6456 charset_type = Qw32_charset_easteurope;
6457 break;
6458 case TURKISH_CHARSET:
6459 charset_type = Qw32_charset_turkish;
6460 break;
6461 case BALTIC_CHARSET:
6462 charset_type = Qw32_charset_baltic;
6463 break;
6464 case RUSSIAN_CHARSET:
6465 charset_type = Qw32_charset_russian;
6466 break;
6467 case ARABIC_CHARSET:
6468 charset_type = Qw32_charset_arabic;
6469 break;
6470 case GREEK_CHARSET:
6471 charset_type = Qw32_charset_greek;
6472 break;
6473 case HEBREW_CHARSET:
6474 charset_type = Qw32_charset_hebrew;
6475 break;
6476 case VIETNAMESE_CHARSET:
6477 charset_type = Qw32_charset_vietnamese;
6478 break;
6479 case THAI_CHARSET:
6480 charset_type = Qw32_charset_thai;
6481 break;
6482 case MAC_CHARSET:
6483 charset_type = Qw32_charset_mac;
6484 break;
6485 case JOHAB_CHARSET:
6486 charset_type = Qw32_charset_johab;
6487 break;
6488#endif
6489
6490#ifdef UNICODE_CHARSET
6491 case UNICODE_CHARSET:
6492 charset_type = Qw32_charset_unicode;
6493 break;
6494#endif
6495 default:
6496 /* Encode numerical value of unknown charset. */
6497 sprintf (buf, "*-#%u", fncharset);
6498 return Fcons (build_string (buf), Qnil);
6499 }
6500
6501 {
6502 Lisp_Object rest;
6503 /* Look through w32-charset-info-alist for the character set.
6504 Only return charsets for codepages which are installed.
6505
6506 Format of each entry in Vw32_charset_info_alist is
6507 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
6508 */
6509 for (rest = Vw32_charset_info_alist; CONSP (rest); rest = XCDR (rest))
6510 {
6511 Lisp_Object x_charset;
6512 Lisp_Object w32_charset;
6513 Lisp_Object codepage;
6514
6515 Lisp_Object this_entry = XCAR (rest);
6516
6517 /* Skip invalid entries in alist. */
6518 if (!CONSP (this_entry) || !STRINGP (XCAR (this_entry))
6519 || !CONSP (XCDR (this_entry))
6520 || !SYMBOLP (XCAR (XCDR (this_entry))))
6521 continue;
6522
6523 x_charset = XCAR (this_entry);
6524 w32_charset = XCAR (XCDR (this_entry));
6525 codepage = XCDR (XCDR (this_entry));
6526
6527 /* Look for Same charset and a valid codepage (or non-int
6528 which means ignore). */
6529 if (w32_charset == charset_type
6530 && (!INTEGERP (codepage) || codepage == CP_DEFAULT
6531 || IsValidCodePage (XINT (codepage))))
6532 {
6533 retval = Fcons (x_charset, retval);
6534 }
6535 }
6536
6537 /* If no match, encode the numeric value. */
6538 if (NILP (retval))
6539 {
6540 sprintf (buf, "*-#%u", fncharset);
6541 return Fcons (build_string (buf), Qnil);
6542 }
6543
6544 return retval;
6545 }
6546}
6547
dfff8a69
JR
6548/* Get the Windows codepage corresponding to the specified font. The
6549 charset info in the font name is used to look up
6550 w32-charset-to-codepage-alist. */
6551int
6552w32_codepage_for_font (char *fontname)
6553{
767b1ff0
JR
6554 Lisp_Object codepage, entry;
6555 char *charset_str, *charset, *end;
dfff8a69 6556
767b1ff0 6557 if (NILP (Vw32_charset_info_alist))
dfff8a69
JR
6558 return CP_DEFAULT;
6559
767b1ff0
JR
6560 /* Extract charset part of font string. */
6561 charset = xlfd_charset_of_font (fontname);
6562
6563 if (!charset)
ceb12877 6564 return CP_UNKNOWN;
767b1ff0 6565
8b77111c 6566 charset_str = (char *) alloca (strlen (charset) + 1);
767b1ff0
JR
6567 strcpy (charset_str, charset);
6568
8b77111c 6569#if 0
dfff8a69
JR
6570 /* Remove leading "*-". */
6571 if (strncmp ("*-", charset_str, 2) == 0)
6572 charset = charset_str + 2;
6573 else
8b77111c 6574#endif
dfff8a69
JR
6575 charset = charset_str;
6576
6577 /* Stop match at wildcard (including preceding '-'). */
6578 if (end = strchr (charset, '*'))
6579 {
6580 if (end > charset && *(end-1) == '-')
6581 end--;
6582 *end = '\0';
6583 }
6584
767b1ff0
JR
6585 entry = Fassoc (build_string(charset), Vw32_charset_info_alist);
6586 if (NILP (entry))
ceb12877 6587 return CP_UNKNOWN;
767b1ff0
JR
6588
6589 codepage = Fcdr (Fcdr (entry));
6590
6591 if (NILP (codepage))
6592 return CP_8BIT;
6593 else if (XFASTINT (codepage) == XFASTINT (Qt))
6594 return CP_UNICODE;
6595 else if (INTEGERP (codepage))
dfff8a69
JR
6596 return XINT (codepage);
6597 else
ceb12877 6598 return CP_UNKNOWN;
dfff8a69
JR
6599}
6600
6601
8edb0a6f 6602static BOOL
767b1ff0 6603w32_to_x_font (lplogfont, lpxstr, len, specific_charset)
ee78dc32
GV
6604 LOGFONT * lplogfont;
6605 char * lpxstr;
6606 int len;
767b1ff0 6607 char * specific_charset;
ee78dc32 6608{
6fc2811b 6609 char* fonttype;
f46e6225 6610 char *fontname;
3cb20f4a
RS
6611 char height_pixels[8];
6612 char height_dpi[8];
6613 char width_pixels[8];
4587b026 6614 char *fontname_dash;
ac849ba4
JR
6615 int display_resy = (int) one_w32_display_info.resy;
6616 int display_resx = (int) one_w32_display_info.resx;
f46e6225
GV
6617 int bufsz;
6618 struct coding_system coding;
3cb20f4a
RS
6619
6620 if (!lpxstr) abort ();
ee78dc32 6621
3cb20f4a
RS
6622 if (!lplogfont)
6623 return FALSE;
6624
6fc2811b
JR
6625 if (lplogfont->lfOutPrecision == OUT_STRING_PRECIS)
6626 fonttype = "raster";
6627 else if (lplogfont->lfOutPrecision == OUT_STROKE_PRECIS)
6628 fonttype = "outline";
6629 else
6630 fonttype = "unknown";
6631
1fa3a200 6632 setup_coding_system (Fcheck_coding_system (Vlocale_coding_system),
f46e6225 6633 &coding);
aab5ac44
KH
6634 coding.src_multibyte = 0;
6635 coding.dst_multibyte = 1;
f46e6225 6636 coding.mode |= CODING_MODE_LAST_BLOCK;
65413122
KH
6637 /* We explicitely disable composition handling because selection
6638 data should not contain any composition sequence. */
6639 coding.composing = COMPOSITION_DISABLED;
f46e6225
GV
6640 bufsz = decoding_buffer_size (&coding, LF_FACESIZE);
6641
6642 fontname = alloca(sizeof(*fontname) * bufsz);
6643 decode_coding (&coding, lplogfont->lfFaceName, fontname,
6644 strlen(lplogfont->lfFaceName), bufsz - 1);
6645 *(fontname + coding.produced) = '\0';
4587b026
GV
6646
6647 /* Replace dashes with underscores so the dashes are not
f46e6225 6648 misinterpreted. */
4587b026
GV
6649 fontname_dash = fontname;
6650 while (fontname_dash = strchr (fontname_dash, '-'))
6651 *fontname_dash = '_';
6652
3cb20f4a 6653 if (lplogfont->lfHeight)
ee78dc32 6654 {
3cb20f4a
RS
6655 sprintf (height_pixels, "%u", abs (lplogfont->lfHeight));
6656 sprintf (height_dpi, "%u",
33d52f9c 6657 abs (lplogfont->lfHeight) * 720 / display_resy);
5ac45f98
GV
6658 }
6659 else
ee78dc32 6660 {
3cb20f4a
RS
6661 strcpy (height_pixels, "*");
6662 strcpy (height_dpi, "*");
ee78dc32 6663 }
3cb20f4a
RS
6664 if (lplogfont->lfWidth)
6665 sprintf (width_pixels, "%u", lplogfont->lfWidth * 10);
6666 else
6667 strcpy (width_pixels, "*");
6668
6669 _snprintf (lpxstr, len - 1,
6fc2811b
JR
6670 "-%s-%s-%s-%c-normal-normal-%s-%s-%d-%d-%c-%s-%s",
6671 fonttype, /* foundry */
4587b026
GV
6672 fontname, /* family */
6673 w32_to_x_weight (lplogfont->lfWeight), /* weight */
6674 lplogfont->lfItalic?'i':'r', /* slant */
6675 /* setwidth name */
6676 /* add style name */
6677 height_pixels, /* pixel size */
6678 height_dpi, /* point size */
33d52f9c
GV
6679 display_resx, /* resx */
6680 display_resy, /* resy */
4587b026
GV
6681 ((lplogfont->lfPitchAndFamily & 0x3) == VARIABLE_PITCH)
6682 ? 'p' : 'c', /* spacing */
6683 width_pixels, /* avg width */
767b1ff0
JR
6684 specific_charset ? specific_charset
6685 : w32_to_x_charset (lplogfont->lfCharSet)
6686 /* charset registry and encoding */
3cb20f4a
RS
6687 );
6688
ee78dc32
GV
6689 lpxstr[len - 1] = 0; /* just to be sure */
6690 return (TRUE);
6691}
6692
8edb0a6f 6693static BOOL
fbd6baed 6694x_to_w32_font (lpxstr, lplogfont)
ee78dc32
GV
6695 char * lpxstr;
6696 LOGFONT * lplogfont;
6697{
f46e6225
GV
6698 struct coding_system coding;
6699
ee78dc32 6700 if (!lplogfont) return (FALSE);
f46e6225 6701
ee78dc32 6702 memset (lplogfont, 0, sizeof (*lplogfont));
5ac45f98 6703
1a292d24 6704 /* Set default value for each field. */
771c47d5 6705#if 1
ee78dc32
GV
6706 lplogfont->lfOutPrecision = OUT_DEFAULT_PRECIS;
6707 lplogfont->lfClipPrecision = CLIP_DEFAULT_PRECIS;
6708 lplogfont->lfQuality = DEFAULT_QUALITY;
5ac45f98
GV
6709#else
6710 /* go for maximum quality */
6711 lplogfont->lfOutPrecision = OUT_STROKE_PRECIS;
6712 lplogfont->lfClipPrecision = CLIP_STROKE_PRECIS;
6713 lplogfont->lfQuality = PROOF_QUALITY;
6714#endif
6715
1a292d24
AI
6716 lplogfont->lfCharSet = DEFAULT_CHARSET;
6717 lplogfont->lfWeight = FW_DONTCARE;
6718 lplogfont->lfPitchAndFamily = DEFAULT_PITCH | FF_DONTCARE;
6719
5ac45f98
GV
6720 if (!lpxstr)
6721 return FALSE;
6722
6723 /* Provide a simple escape mechanism for specifying Windows font names
6724 * directly -- if font spec does not beginning with '-', assume this
6725 * format:
6726 * "<font name>[:height in pixels[:width in pixels[:weight]]]"
6727 */
ee78dc32 6728
5ac45f98
GV
6729 if (*lpxstr == '-')
6730 {
33d52f9c
GV
6731 int fields, tem;
6732 char name[50], weight[20], slant, pitch, pixels[10], height[10],
8b77111c 6733 width[10], resy[10], remainder[50];
5ac45f98 6734 char * encoding;
ac849ba4 6735 int dpi = (int) one_w32_display_info.resy;
5ac45f98
GV
6736
6737 fields = sscanf (lpxstr,
8b77111c 6738 "-%*[^-]-%49[^-]-%19[^-]-%c-%*[^-]-%*[^-]-%9[^-]-%9[^-]-%*[^-]-%9[^-]-%c-%9[^-]-%49s",
33d52f9c 6739 name, weight, &slant, pixels, height, resy, &pitch, width, remainder);
8b77111c
AI
6740 if (fields == EOF)
6741 return (FALSE);
6742
6743 /* In the general case when wildcards cover more than one field,
6744 we don't know which field is which, so don't fill any in.
6745 However, we need to cope with this particular form, which is
6746 generated by font_list_1 (invoked by try_font_list):
6747 "-raster-6x10-*-gb2312*-*"
6748 and make sure to correctly parse the charset field. */
6749 if (fields == 3)
6750 {
6751 fields = sscanf (lpxstr,
6752 "-%*[^-]-%49[^-]-*-%49s",
6753 name, remainder);
6754 }
6755 else if (fields < 9)
6756 {
6757 fields = 0;
6758 remainder[0] = 0;
6759 }
6fc2811b 6760
5ac45f98
GV
6761 if (fields > 0 && name[0] != '*')
6762 {
8ea3e054
RS
6763 int bufsize;
6764 unsigned char *buf;
6765
f46e6225 6766 setup_coding_system
1fa3a200 6767 (Fcheck_coding_system (Vlocale_coding_system), &coding);
aab5ac44
KH
6768 coding.src_multibyte = 1;
6769 coding.dst_multibyte = 1;
8ea3e054
RS
6770 bufsize = encoding_buffer_size (&coding, strlen (name));
6771 buf = (unsigned char *) alloca (bufsize);
f46e6225 6772 coding.mode |= CODING_MODE_LAST_BLOCK;
8ea3e054
RS
6773 encode_coding (&coding, name, buf, strlen (name), bufsize);
6774 if (coding.produced >= LF_FACESIZE)
6775 coding.produced = LF_FACESIZE - 1;
6776 buf[coding.produced] = 0;
6777 strcpy (lplogfont->lfFaceName, buf);
5ac45f98
GV
6778 }
6779 else
6780 {
6fc2811b 6781 lplogfont->lfFaceName[0] = '\0';
5ac45f98
GV
6782 }
6783
6784 fields--;
6785
fbd6baed 6786 lplogfont->lfWeight = x_to_w32_weight ((fields > 0 ? weight : ""));
5ac45f98
GV
6787
6788 fields--;
6789
c8874f14 6790 lplogfont->lfItalic = (fields > 0 && slant == 'i');
5ac45f98
GV
6791
6792 fields--;
6793
6794 if (fields > 0 && pixels[0] != '*')
6795 lplogfont->lfHeight = atoi (pixels);
6796
6797 fields--;
5ac45f98 6798 fields--;
33d52f9c
GV
6799 if (fields > 0 && resy[0] != '*')
6800 {
6fc2811b 6801 tem = atoi (resy);
33d52f9c
GV
6802 if (tem > 0) dpi = tem;
6803 }
5ac45f98 6804
33d52f9c
GV
6805 if (fields > -1 && lplogfont->lfHeight == 0 && height[0] != '*')
6806 lplogfont->lfHeight = atoi (height) * dpi / 720;
6807
6808 if (fields > 0)
5ac45f98
GV
6809 lplogfont->lfPitchAndFamily =
6810 (fields > 0 && pitch == 'p') ? VARIABLE_PITCH : FIXED_PITCH;
6811
6812 fields--;
6813
6814 if (fields > 0 && width[0] != '*')
6815 lplogfont->lfWidth = atoi (width) / 10;
6816
6817 fields--;
6818
4587b026 6819 /* Strip the trailing '-' if present. (it shouldn't be, as it
d88c567c 6820 fails the test against xlfd-tight-regexp in fontset.el). */
3c190163 6821 {
5ac45f98
GV
6822 int len = strlen (remainder);
6823 if (len > 0 && remainder[len-1] == '-')
6824 remainder[len-1] = 0;
ee78dc32 6825 }
5ac45f98 6826 encoding = remainder;
8b77111c 6827#if 0
5ac45f98
GV
6828 if (strncmp (encoding, "*-", 2) == 0)
6829 encoding += 2;
8b77111c
AI
6830#endif
6831 lplogfont->lfCharSet = x_to_w32_charset (encoding);
5ac45f98
GV
6832 }
6833 else
6834 {
6835 int fields;
6836 char name[100], height[10], width[10], weight[20];
a1a80b40 6837
5ac45f98
GV
6838 fields = sscanf (lpxstr,
6839 "%99[^:]:%9[^:]:%9[^:]:%19s",
6840 name, height, width, weight);
6841
6842 if (fields == EOF) return (FALSE);
6843
6844 if (fields > 0)
6845 {
6846 strncpy (lplogfont->lfFaceName,name, LF_FACESIZE);
6847 lplogfont->lfFaceName[LF_FACESIZE-1] = 0;
6848 }
6849 else
6850 {
6851 lplogfont->lfFaceName[0] = 0;
6852 }
6853
6854 fields--;
6855
6856 if (fields > 0)
6857 lplogfont->lfHeight = atoi (height);
6858
6859 fields--;
6860
6861 if (fields > 0)
6862 lplogfont->lfWidth = atoi (width);
6863
6864 fields--;
6865
fbd6baed 6866 lplogfont->lfWeight = x_to_w32_weight ((fields > 0 ? weight : ""));
5ac45f98
GV
6867 }
6868
6869 /* This makes TrueType fonts work better. */
6870 lplogfont->lfHeight = - abs (lplogfont->lfHeight);
6fc2811b 6871
ee78dc32
GV
6872 return (TRUE);
6873}
6874
d88c567c
JR
6875/* Strip the pixel height and point height from the given xlfd, and
6876 return the pixel height. If no pixel height is specified, calculate
6877 one from the point height, or if that isn't defined either, return
6878 0 (which usually signifies a scalable font).
6879*/
8edb0a6f
JR
6880static int
6881xlfd_strip_height (char *fontname)
d88c567c 6882{
8edb0a6f 6883 int pixel_height, field_number;
d88c567c
JR
6884 char *read_from, *write_to;
6885
6886 xassert (fontname);
6887
6888 pixel_height = field_number = 0;
6889 write_to = NULL;
6890
6891 /* Look for height fields. */
6892 for (read_from = fontname; *read_from; read_from++)
6893 {
6894 if (*read_from == '-')
6895 {
6896 field_number++;
6897 if (field_number == 7) /* Pixel height. */
6898 {
6899 read_from++;
6900 write_to = read_from;
6901
6902 /* Find end of field. */
6903 for (;*read_from && *read_from != '-'; read_from++)
6904 ;
6905
6906 /* Split the fontname at end of field. */
6907 if (*read_from)
6908 {
6909 *read_from = '\0';
6910 read_from++;
6911 }
6912 pixel_height = atoi (write_to);
6913 /* Blank out field. */
6914 if (read_from > write_to)
6915 {
6916 *write_to = '-';
6917 write_to++;
6918 }
767b1ff0 6919 /* If the pixel height field is at the end (partial xlfd),
d88c567c
JR
6920 return now. */
6921 else
6922 return pixel_height;
6923
6924 /* If we got a pixel height, the point height can be
6925 ignored. Just blank it out and break now. */
6926 if (pixel_height)
6927 {
6928 /* Find end of point size field. */
6929 for (; *read_from && *read_from != '-'; read_from++)
6930 ;
6931
6932 if (*read_from)
6933 read_from++;
6934
6935 /* Blank out the point size field. */
6936 if (read_from > write_to)
6937 {
6938 *write_to = '-';
6939 write_to++;
6940 }
6941 else
6942 return pixel_height;
6943
6944 break;
6945 }
6946 /* If the point height is already blank, break now. */
6947 if (*read_from == '-')
6948 {
6949 read_from++;
6950 break;
6951 }
6952 }
6953 else if (field_number == 8)
6954 {
6955 /* If we didn't get a pixel height, try to get the point
6956 height and convert that. */
6957 int point_size;
6958 char *point_size_start = read_from++;
6959
6960 /* Find end of field. */
6961 for (; *read_from && *read_from != '-'; read_from++)
6962 ;
6963
6964 if (*read_from)
6965 {
6966 *read_from = '\0';
6967 read_from++;
6968 }
6969
6970 point_size = atoi (point_size_start);
6971
6972 /* Convert to pixel height. */
6973 pixel_height = point_size
6974 * one_w32_display_info.height_in / 720;
6975
6976 /* Blank out this field and break. */
6977 *write_to = '-';
6978 write_to++;
6979 break;
6980 }
6981 }
6982 }
6983
6984 /* Shift the rest of the font spec into place. */
6985 if (write_to && read_from > write_to)
6986 {
6987 for (; *read_from; read_from++, write_to++)
6988 *write_to = *read_from;
6989 *write_to = '\0';
6990 }
6991
6992 return pixel_height;
6993}
6994
6fc2811b 6995/* Assume parameter 1 is fully qualified, no wildcards. */
8edb0a6f 6996static BOOL
6fc2811b
JR
6997w32_font_match (fontname, pattern)
6998 char * fontname;
6999 char * pattern;
ee78dc32 7000{
e7c72122 7001 char *regex = alloca (strlen (pattern) * 2 + 3);
d88c567c 7002 char *font_name_copy = alloca (strlen (fontname) + 1);
6fc2811b 7003 char *ptr;
ee78dc32 7004
d88c567c
JR
7005 /* Copy fontname so we can modify it during comparison. */
7006 strcpy (font_name_copy, fontname);
7007
6fc2811b
JR
7008 ptr = regex;
7009 *ptr++ = '^';
ee78dc32 7010
6fc2811b
JR
7011 /* Turn pattern into a regexp and do a regexp match. */
7012 for (; *pattern; pattern++)
7013 {
7014 if (*pattern == '?')
7015 *ptr++ = '.';
7016 else if (*pattern == '*')
7017 {
7018 *ptr++ = '.';
7019 *ptr++ = '*';
7020 }
33d52f9c 7021 else
6fc2811b 7022 *ptr++ = *pattern;
ee78dc32 7023 }
6fc2811b
JR
7024 *ptr = '$';
7025 *(ptr + 1) = '\0';
7026
d88c567c
JR
7027 /* Strip out font heights and compare them seperately, since
7028 rounding error can cause mismatches. This also allows a
7029 comparison between a font that declares only a pixel height and a
7030 pattern that declares the point height.
7031 */
7032 {
7033 int font_height, pattern_height;
7034
7035 font_height = xlfd_strip_height (font_name_copy);
7036 pattern_height = xlfd_strip_height (regex);
7037
7038 /* Compare now, and don't bother doing expensive regexp matching
7039 if the heights differ. */
7040 if (font_height && pattern_height && (font_height != pattern_height))
7041 return FALSE;
7042 }
7043
6fc2811b 7044 return (fast_c_string_match_ignore_case (build_string (regex),
d88c567c 7045 font_name_copy) >= 0);
ee78dc32
GV
7046}
7047
5ca0cd71
GV
7048/* Callback functions, and a structure holding info they need, for
7049 listing system fonts on W32. We need one set of functions to do the
7050 job properly, but these don't work on NT 3.51 and earlier, so we
7051 have a second set which don't handle character sets properly to
7052 fall back on.
7053
7054 In both cases, there are two passes made. The first pass gets one
7055 font from each family, the second pass lists all the fonts from
7056 each family. */
7057
ee78dc32
GV
7058typedef struct enumfont_t
7059{
7060 HDC hdc;
7061 int numFonts;
3cb20f4a 7062 LOGFONT logfont;
ee78dc32 7063 XFontStruct *size_ref;
23afac8f 7064 Lisp_Object pattern;
d84b082d 7065 Lisp_Object list;
ee78dc32
GV
7066} enumfont_t;
7067
d84b082d
JR
7068
7069static void
7070enum_font_maybe_add_to_list (enumfont_t *, LOGFONT *, char *, Lisp_Object);
7071
7072
8edb0a6f 7073static int CALLBACK
ee78dc32
GV
7074enum_font_cb2 (lplf, lptm, FontType, lpef)
7075 ENUMLOGFONT * lplf;
7076 NEWTEXTMETRIC * lptm;
7077 int FontType;
7078 enumfont_t * lpef;
7079{
66895301
JR
7080 /* Ignore struck out and underlined versions of fonts. */
7081 if (lplf->elfLogFont.lfStrikeOut || lplf->elfLogFont.lfUnderline)
7082 return 1;
7083
7084 /* Only return fonts with names starting with @ if they were
7085 explicitly specified, since Microsoft uses an initial @ to
7086 denote fonts for vertical writing, without providing a more
7087 convenient way of identifying them. */
7088 if (lplf->elfLogFont.lfFaceName[0] == '@'
7089 && lpef->logfont.lfFaceName[0] != '@')
5e905a57
JR
7090 return 1;
7091
4587b026
GV
7092 /* Check that the character set matches if it was specified */
7093 if (lpef->logfont.lfCharSet != DEFAULT_CHARSET &&
7094 lplf->elfLogFont.lfCharSet != lpef->logfont.lfCharSet)
5e905a57 7095 return 1;
4587b026 7096
6358474d
JR
7097 if (FontType == RASTER_FONTTYPE)
7098 {
7099 /* DBCS raster fonts have problems displaying, so skip them. */
7100 int charset = lplf->elfLogFont.lfCharSet;
7101 if (charset == SHIFTJIS_CHARSET
7102 || charset == HANGEUL_CHARSET
7103 || charset == CHINESEBIG5_CHARSET
7104 || charset == GB2312_CHARSET
7105#ifdef JOHAB_CHARSET
7106 || charset == JOHAB_CHARSET
7107#endif
7108 )
7109 return 1;
7110 }
7111
ee78dc32
GV
7112 {
7113 char buf[100];
4587b026 7114 Lisp_Object width = Qnil;
d84b082d 7115 Lisp_Object charset_list = Qnil;
767b1ff0 7116 char *charset = NULL;
ee78dc32 7117
6fc2811b
JR
7118 /* Truetype fonts do not report their true metrics until loaded */
7119 if (FontType != RASTER_FONTTYPE)
3cb20f4a 7120 {
23afac8f 7121 if (!NILP (lpef->pattern))
6fc2811b
JR
7122 {
7123 /* Scalable fonts are as big as you want them to be. */
7124 lplf->elfLogFont.lfHeight = lpef->logfont.lfHeight;
7125 lplf->elfLogFont.lfWidth = lpef->logfont.lfWidth;
7126 width = make_number (lpef->logfont.lfWidth);
7127 }
7128 else
7129 {
7130 lplf->elfLogFont.lfHeight = 0;
7131 lplf->elfLogFont.lfWidth = 0;
7132 }
3cb20f4a 7133 }
6fc2811b 7134
f46e6225
GV
7135 /* Make sure the height used here is the same as everywhere
7136 else (ie character height, not cell height). */
6fc2811b
JR
7137 if (lplf->elfLogFont.lfHeight > 0)
7138 {
7139 /* lptm can be trusted for RASTER fonts, but not scalable ones. */
7140 if (FontType == RASTER_FONTTYPE)
7141 lplf->elfLogFont.lfHeight = lptm->tmInternalLeading - lptm->tmHeight;
7142 else
7143 lplf->elfLogFont.lfHeight = -lplf->elfLogFont.lfHeight;
7144 }
4587b026 7145
23afac8f 7146 if (!NILP (lpef->pattern))
767b1ff0 7147 {
d5db4077 7148 charset = xlfd_charset_of_font (SDATA (lpef->pattern));
767b1ff0 7149
644cefdf
JR
7150 /* We already checked charsets above, but DEFAULT_CHARSET
7151 slipped through. So only allow exact matches for DEFAULT_CHARSET. */
7152 if (charset
7153 && strncmp (charset, "*-*", 3) != 0
7154 && lpef->logfont.lfCharSet == DEFAULT_CHARSET
7155 && strcmp (charset, w32_to_x_charset (DEFAULT_CHARSET)) != 0)
7156 return 1;
767b1ff0
JR
7157 }
7158
d84b082d
JR
7159 if (charset)
7160 charset_list = Fcons (build_string (charset), Qnil);
7161 else
7162 charset_list = w32_to_all_x_charsets (lplf->elfLogFont.lfCharSet);
ee78dc32 7163
d84b082d
JR
7164 /* Loop through the charsets. */
7165 for ( ; CONSP (charset_list); charset_list = Fcdr (charset_list))
ee78dc32 7166 {
d84b082d 7167 Lisp_Object this_charset = Fcar (charset_list);
d5db4077 7168 charset = SDATA (this_charset);
d84b082d
JR
7169
7170 /* List bold and italic variations if w32-enable-synthesized-fonts
7171 is non-nil and this is a plain font. */
7172 if (w32_enable_synthesized_fonts
7173 && lplf->elfLogFont.lfWeight == FW_NORMAL
7174 && lplf->elfLogFont.lfItalic == FALSE)
7175 {
7176 enum_font_maybe_add_to_list (lpef, &(lplf->elfLogFont),
7177 charset, width);
7178 /* bold. */
7179 lplf->elfLogFont.lfWeight = FW_BOLD;
7180 enum_font_maybe_add_to_list (lpef, &(lplf->elfLogFont),
7181 charset, width);
7182 /* bold italic. */
7183 lplf->elfLogFont.lfItalic = TRUE;
7184 enum_font_maybe_add_to_list (lpef, &(lplf->elfLogFont),
7185 charset, width);
7186 /* italic. */
7187 lplf->elfLogFont.lfWeight = FW_NORMAL;
7188 enum_font_maybe_add_to_list (lpef, &(lplf->elfLogFont),
7189 charset, width);
7190 }
7191 else
7192 enum_font_maybe_add_to_list (lpef, &(lplf->elfLogFont),
7193 charset, width);
ee78dc32
GV
7194 }
7195 }
6fc2811b 7196
5e905a57 7197 return 1;
ee78dc32
GV
7198}
7199
d84b082d
JR
7200static void
7201enum_font_maybe_add_to_list (lpef, logfont, match_charset, width)
7202 enumfont_t * lpef;
7203 LOGFONT * logfont;
7204 char * match_charset;
7205 Lisp_Object width;
7206{
7207 char buf[100];
7208
7209 if (!w32_to_x_font (logfont, buf, 100, match_charset))
7210 return;
7211
23afac8f 7212 if (NILP (lpef->pattern)
d5db4077 7213 || w32_font_match (buf, SDATA (lpef->pattern)))
d84b082d
JR
7214 {
7215 /* Check if we already listed this font. This may happen if
7216 w32_enable_synthesized_fonts is non-nil, and there are real
7217 bold and italic versions of the font. */
7218 Lisp_Object font_name = build_string (buf);
7219 if (NILP (Fmember (font_name, lpef->list)))
7220 {
23afac8f
JR
7221 Lisp_Object entry = Fcons (font_name, width);
7222 lpef->list = Fcons (entry, lpef->list);
d84b082d
JR
7223 lpef->numFonts++;
7224 }
7225 }
7226}
7227
7228
8edb0a6f 7229static int CALLBACK
ee78dc32
GV
7230enum_font_cb1 (lplf, lptm, FontType, lpef)
7231 ENUMLOGFONT * lplf;
7232 NEWTEXTMETRIC * lptm;
7233 int FontType;
7234 enumfont_t * lpef;
7235{
7236 return EnumFontFamilies (lpef->hdc,
7237 lplf->elfLogFont.lfFaceName,
7238 (FONTENUMPROC) enum_font_cb2,
7239 (LPARAM) lpef);
7240}
7241
7242
8edb0a6f 7243static int CALLBACK
5ca0cd71
GV
7244enum_fontex_cb2 (lplf, lptm, font_type, lpef)
7245 ENUMLOGFONTEX * lplf;
7246 NEWTEXTMETRICEX * lptm;
7247 int font_type;
7248 enumfont_t * lpef;
7249{
7250 /* We are not interested in the extra info we get back from the 'Ex
7251 version - only the fact that we get character set variations
7252 enumerated seperately. */
7253 return enum_font_cb2 ((ENUMLOGFONT *) lplf, (NEWTEXTMETRIC *) lptm,
7254 font_type, lpef);
7255}
7256
8edb0a6f 7257static int CALLBACK
5ca0cd71
GV
7258enum_fontex_cb1 (lplf, lptm, font_type, lpef)
7259 ENUMLOGFONTEX * lplf;
7260 NEWTEXTMETRICEX * lptm;
7261 int font_type;
7262 enumfont_t * lpef;
7263{
7264 HMODULE gdi32 = GetModuleHandle ("gdi32.dll");
7265 FARPROC enum_font_families_ex
7266 = GetProcAddress ( gdi32, "EnumFontFamiliesExA");
7267 /* We don't really expect EnumFontFamiliesEx to disappear once we
7268 get here, so don't bother handling it gracefully. */
7269 if (enum_font_families_ex == NULL)
7270 error ("gdi32.dll has disappeared!");
7271 return enum_font_families_ex (lpef->hdc,
7272 &lplf->elfLogFont,
7273 (FONTENUMPROC) enum_fontex_cb2,
7274 (LPARAM) lpef, 0);
7275}
7276
4587b026
GV
7277/* Interface to fontset handler. (adapted from mw32font.c in Meadow
7278 and xterm.c in Emacs 20.3) */
7279
8edb0a6f 7280static Lisp_Object w32_list_bdf_fonts (Lisp_Object pattern, int max_names)
33d52f9c
GV
7281{
7282 char *fontname, *ptnstr;
7283 Lisp_Object list, tem, newlist = Qnil;
55dcfc15 7284 int n_fonts = 0;
33d52f9c
GV
7285
7286 list = Vw32_bdf_filename_alist;
d5db4077 7287 ptnstr = SDATA (pattern);
33d52f9c 7288
8e713be6 7289 for ( ; CONSP (list); list = XCDR (list))
33d52f9c 7290 {
8e713be6 7291 tem = XCAR (list);
33d52f9c 7292 if (CONSP (tem))
d5db4077 7293 fontname = SDATA (XCAR (tem));
33d52f9c 7294 else if (STRINGP (tem))
d5db4077 7295 fontname = SDATA (tem);
33d52f9c
GV
7296 else
7297 continue;
7298
7299 if (w32_font_match (fontname, ptnstr))
5ca0cd71 7300 {
8e713be6 7301 newlist = Fcons (XCAR (tem), newlist);
5ca0cd71
GV
7302 n_fonts++;
7303 if (n_fonts >= max_names)
7304 break;
7305 }
33d52f9c
GV
7306 }
7307
7308 return newlist;
7309}
7310
5ca0cd71 7311
4587b026
GV
7312/* Return a list of names of available fonts matching PATTERN on frame
7313 F. If SIZE is not 0, it is the size (maximum bound width) of fonts
7314 to be listed. Frame F NULL means we have not yet created any
7315 frame, which means we can't get proper size info, as we don't have
7316 a device context to use for GetTextMetrics.
7317 MAXNAMES sets a limit on how many fonts to match. */
7318
7319Lisp_Object
dc220243
JR
7320w32_list_fonts (f, pattern, size, maxnames)
7321 struct frame *f;
7322 Lisp_Object pattern;
7323 int size;
7324 int maxnames;
4587b026 7325{
6fc2811b 7326 Lisp_Object patterns, key = Qnil, tem, tpat;
4587b026 7327 Lisp_Object list = Qnil, newlist = Qnil, second_best = Qnil;
33d52f9c 7328 struct w32_display_info *dpyinfo = &one_w32_display_info;
5ca0cd71 7329 int n_fonts = 0;
396594fe 7330
4587b026
GV
7331 patterns = Fassoc (pattern, Valternate_fontname_alist);
7332 if (NILP (patterns))
7333 patterns = Fcons (pattern, Qnil);
7334
8e713be6 7335 for (; CONSP (patterns); patterns = XCDR (patterns))
4587b026
GV
7336 {
7337 enumfont_t ef;
767b1ff0 7338 int codepage;
4587b026 7339
8e713be6 7340 tpat = XCAR (patterns);
4587b026 7341
767b1ff0
JR
7342 if (!STRINGP (tpat))
7343 continue;
7344
7345 /* Avoid expensive EnumFontFamilies functions if we are not
7346 going to be able to output one of these anyway. */
d5db4077 7347 codepage = w32_codepage_for_font (SDATA (tpat));
767b1ff0 7348 if (codepage != CP_8BIT && codepage != CP_UNICODE
ceb12877
AI
7349 && codepage != CP_DEFAULT && codepage != CP_UNKNOWN
7350 && !IsValidCodePage(codepage))
767b1ff0
JR
7351 continue;
7352
4587b026
GV
7353 /* See if we cached the result for this particular query.
7354 The cache is an alist of the form:
7355 ((PATTERN (FONTNAME . WIDTH) ...) ...)
7356 */
8e713be6 7357 if (tem = XCDR (dpyinfo->name_list_element),
33d52f9c 7358 !NILP (list = Fassoc (tpat, tem)))
4587b026
GV
7359 {
7360 list = Fcdr_safe (list);
7361 /* We have a cached list. Don't have to get the list again. */
7362 goto label_cached;
7363 }
7364
7365 BLOCK_INPUT;
7366 /* At first, put PATTERN in the cache. */
23afac8f
JR
7367 ef.pattern = tpat;
7368 ef.list = Qnil;
4587b026 7369 ef.numFonts = 0;
33d52f9c 7370
5ca0cd71
GV
7371 /* Use EnumFontFamiliesEx where it is available, as it knows
7372 about character sets. Fall back to EnumFontFamilies for
7373 older versions of NT that don't support the 'Ex function. */
d5db4077 7374 x_to_w32_font (SDATA (tpat), &ef.logfont);
4587b026 7375 {
5ca0cd71
GV
7376 LOGFONT font_match_pattern;
7377 HMODULE gdi32 = GetModuleHandle ("gdi32.dll");
7378 FARPROC enum_font_families_ex
7379 = GetProcAddress ( gdi32, "EnumFontFamiliesExA");
7380
7381 /* We do our own pattern matching so we can handle wildcards. */
7382 font_match_pattern.lfFaceName[0] = 0;
7383 font_match_pattern.lfPitchAndFamily = 0;
7384 /* We can use the charset, because if it is a wildcard it will
7385 be DEFAULT_CHARSET anyway. */
7386 font_match_pattern.lfCharSet = ef.logfont.lfCharSet;
7387
33d52f9c 7388 ef.hdc = GetDC (dpyinfo->root_window);
4587b026 7389
5ca0cd71
GV
7390 if (enum_font_families_ex)
7391 enum_font_families_ex (ef.hdc,
7392 &font_match_pattern,
7393 (FONTENUMPROC) enum_fontex_cb1,
7394 (LPARAM) &ef, 0);
7395 else
7396 EnumFontFamilies (ef.hdc, NULL, (FONTENUMPROC) enum_font_cb1,
7397 (LPARAM)&ef);
4587b026 7398
33d52f9c 7399 ReleaseDC (dpyinfo->root_window, ef.hdc);
4587b026
GV
7400 }
7401
7402 UNBLOCK_INPUT;
23afac8f 7403 list = ef.list;
4587b026
GV
7404
7405 /* Make a list of the fonts we got back.
7406 Store that in the font cache for the display. */
f3fbd155
KR
7407 XSETCDR (dpyinfo->name_list_element,
7408 Fcons (Fcons (tpat, list),
7409 XCDR (dpyinfo->name_list_element)));
4587b026
GV
7410
7411 label_cached:
7412 if (NILP (list)) continue; /* Try the remaining alternatives. */
7413
7414 newlist = second_best = Qnil;
7415
7416 /* Make a list of the fonts that have the right width. */
8e713be6 7417 for (; CONSP (list); list = XCDR (list))
4587b026
GV
7418 {
7419 int found_size;
8e713be6 7420 tem = XCAR (list);
4587b026
GV
7421
7422 if (!CONSP (tem))
7423 continue;
8e713be6 7424 if (NILP (XCAR (tem)))
4587b026
GV
7425 continue;
7426 if (!size)
7427 {
8e713be6 7428 newlist = Fcons (XCAR (tem), newlist);
5ca0cd71
GV
7429 n_fonts++;
7430 if (n_fonts >= maxnames)
7431 break;
7432 else
7433 continue;
4587b026 7434 }
8e713be6 7435 if (!INTEGERP (XCDR (tem)))
4587b026
GV
7436 {
7437 /* Since we don't yet know the size of the font, we must
7438 load it and try GetTextMetrics. */
4587b026
GV
7439 W32FontStruct thisinfo;
7440 LOGFONT lf;
7441 HDC hdc;
7442 HANDLE oldobj;
7443
d5db4077 7444 if (!x_to_w32_font (SDATA (XCAR (tem)), &lf))
4587b026
GV
7445 continue;
7446
7447 BLOCK_INPUT;
33d52f9c 7448 thisinfo.bdf = NULL;
4587b026
GV
7449 thisinfo.hfont = CreateFontIndirect (&lf);
7450 if (thisinfo.hfont == NULL)
7451 continue;
7452
7453 hdc = GetDC (dpyinfo->root_window);
7454 oldobj = SelectObject (hdc, thisinfo.hfont);
7455 if (GetTextMetrics (hdc, &thisinfo.tm))
f3fbd155 7456 XSETCDR (tem, make_number (FONT_WIDTH (&thisinfo)));
4587b026 7457 else
f3fbd155 7458 XSETCDR (tem, make_number (0));
4587b026
GV
7459 SelectObject (hdc, oldobj);
7460 ReleaseDC (dpyinfo->root_window, hdc);
7461 DeleteObject(thisinfo.hfont);
7462 UNBLOCK_INPUT;
7463 }
8e713be6 7464 found_size = XINT (XCDR (tem));
4587b026 7465 if (found_size == size)
5ca0cd71 7466 {
8e713be6 7467 newlist = Fcons (XCAR (tem), newlist);
5ca0cd71
GV
7468 n_fonts++;
7469 if (n_fonts >= maxnames)
7470 break;
7471 }
4587b026
GV
7472 /* keep track of the closest matching size in case
7473 no exact match is found. */
7474 else if (found_size > 0)
7475 {
7476 if (NILP (second_best))
7477 second_best = tem;
5ca0cd71 7478
4587b026
GV
7479 else if (found_size < size)
7480 {
8e713be6
KR
7481 if (XINT (XCDR (second_best)) > size
7482 || XINT (XCDR (second_best)) < found_size)
4587b026
GV
7483 second_best = tem;
7484 }
7485 else
7486 {
8e713be6
KR
7487 if (XINT (XCDR (second_best)) > size
7488 && XINT (XCDR (second_best)) >
4587b026
GV
7489 found_size)
7490 second_best = tem;
7491 }
7492 }
7493 }
7494
7495 if (!NILP (newlist))
7496 break;
7497 else if (!NILP (second_best))
7498 {
8e713be6 7499 newlist = Fcons (XCAR (second_best), Qnil);
4587b026
GV
7500 break;
7501 }
7502 }
7503
33d52f9c 7504 /* Include any bdf fonts. */
5ca0cd71 7505 if (n_fonts < maxnames)
33d52f9c
GV
7506 {
7507 Lisp_Object combined[2];
5ca0cd71 7508 combined[0] = w32_list_bdf_fonts (pattern, maxnames - n_fonts);
33d52f9c
GV
7509 combined[1] = newlist;
7510 newlist = Fnconc(2, combined);
7511 }
7512
4587b026
GV
7513 return newlist;
7514}
7515
5ca0cd71 7516
4587b026
GV
7517/* Return a pointer to struct font_info of font FONT_IDX of frame F. */
7518struct font_info *
7519w32_get_font_info (f, font_idx)
7520 FRAME_PTR f;
7521 int font_idx;
7522{
7523 return (FRAME_W32_FONT_TABLE (f) + font_idx);
7524}
7525
7526
7527struct font_info*
7528w32_query_font (struct frame *f, char *fontname)
7529{
7530 int i;
7531 struct font_info *pfi;
7532
7533 pfi = FRAME_W32_FONT_TABLE (f);
7534
7535 for (i = 0; i < one_w32_display_info.n_fonts ;i++, pfi++)
7536 {
7537 if (strcmp(pfi->name, fontname) == 0) return pfi;
7538 }
7539
7540 return NULL;
7541}
7542
7543/* Find a CCL program for a font specified by FONTP, and set the member
7544 `encoder' of the structure. */
7545
7546void
7547w32_find_ccl_program (fontp)
7548 struct font_info *fontp;
7549{
3545439c 7550 Lisp_Object list, elt;
4587b026 7551
8e713be6 7552 for (list = Vfont_ccl_encoder_alist; CONSP (list); list = XCDR (list))
4587b026 7553 {
8e713be6 7554 elt = XCAR (list);
4587b026 7555 if (CONSP (elt)
8e713be6
KR
7556 && STRINGP (XCAR (elt))
7557 && (fast_c_string_match_ignore_case (XCAR (elt), fontp->name)
4587b026 7558 >= 0))
3545439c
KH
7559 break;
7560 }
7561 if (! NILP (list))
7562 {
17eedd00
KH
7563 struct ccl_program *ccl
7564 = (struct ccl_program *) xmalloc (sizeof (struct ccl_program));
3545439c 7565
8e713be6 7566 if (setup_ccl_program (ccl, XCDR (elt)) < 0)
3545439c
KH
7567 xfree (ccl);
7568 else
7569 fontp->font_encoder = ccl;
4587b026
GV
7570 }
7571}
7572
7573\f
8edb0a6f
JR
7574/* Find BDF files in a specified directory. (use GCPRO when calling,
7575 as this calls lisp to get a directory listing). */
7576static Lisp_Object
7577w32_find_bdf_fonts_in_dir (Lisp_Object directory)
7578{
7579 Lisp_Object filelist, list = Qnil;
7580 char fontname[100];
7581
7582 if (!STRINGP(directory))
7583 return Qnil;
7584
7585 filelist = Fdirectory_files (directory, Qt,
7586 build_string (".*\\.[bB][dD][fF]"), Qt);
7587
7588 for ( ; CONSP(filelist); filelist = XCDR (filelist))
7589 {
7590 Lisp_Object filename = XCAR (filelist);
d5db4077 7591 if (w32_BDF_to_x_font (SDATA (filename), fontname, 100))
8edb0a6f
JR
7592 store_in_alist (&list, build_string (fontname), filename);
7593 }
7594 return list;
7595}
7596
6fc2811b
JR
7597DEFUN ("w32-find-bdf-fonts", Fw32_find_bdf_fonts, Sw32_find_bdf_fonts,
7598 1, 1, 0,
b3700ae7
JR
7599 doc: /* Return a list of BDF fonts in DIR.
7600The list is suitable for appending to w32-bdf-filename-alist. Fonts
7601which do not contain an xlfd description will not be included in the
7602list. DIR may be a list of directories. */)
6fc2811b
JR
7603 (directory)
7604 Lisp_Object directory;
7605{
7606 Lisp_Object list = Qnil;
7607 struct gcpro gcpro1, gcpro2;
ee78dc32 7608
6fc2811b
JR
7609 if (!CONSP (directory))
7610 return w32_find_bdf_fonts_in_dir (directory);
ee78dc32 7611
6fc2811b 7612 for ( ; CONSP (directory); directory = XCDR (directory))
ee78dc32 7613 {
6fc2811b
JR
7614 Lisp_Object pair[2];
7615 pair[0] = list;
7616 pair[1] = Qnil;
7617 GCPRO2 (directory, list);
7618 pair[1] = w32_find_bdf_fonts_in_dir( XCAR (directory) );
7619 list = Fnconc( 2, pair );
7620 UNGCPRO;
7621 }
7622 return list;
7623}
ee78dc32 7624
6fc2811b
JR
7625\f
7626DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0,
74e1aeec 7627 doc: /* Internal function called by `color-defined-p', which see. */)
6fc2811b
JR
7628 (color, frame)
7629 Lisp_Object color, frame;
7630{
7631 XColor foo;
7632 FRAME_PTR f = check_x_frame (frame);
ee78dc32 7633
b7826503 7634 CHECK_STRING (color);
ee78dc32 7635
d5db4077 7636 if (w32_defined_color (f, SDATA (color), &foo, 0))
6fc2811b
JR
7637 return Qt;
7638 else
7639 return Qnil;
7640}
ee78dc32 7641
2d764c78 7642DEFUN ("xw-color-values", Fxw_color_values, Sxw_color_values, 1, 2, 0,
74e1aeec 7643 doc: /* Internal function called by `color-values', which see. */)
ee78dc32
GV
7644 (color, frame)
7645 Lisp_Object color, frame;
7646{
6fc2811b 7647 XColor foo;
ee78dc32
GV
7648 FRAME_PTR f = check_x_frame (frame);
7649
b7826503 7650 CHECK_STRING (color);
ee78dc32 7651
d5db4077 7652 if (w32_defined_color (f, SDATA (color), &foo, 0))
ee78dc32
GV
7653 {
7654 Lisp_Object rgb[3];
7655
6fc2811b
JR
7656 rgb[0] = make_number ((GetRValue (foo.pixel) << 8)
7657 | GetRValue (foo.pixel));
7658 rgb[1] = make_number ((GetGValue (foo.pixel) << 8)
7659 | GetGValue (foo.pixel));
7660 rgb[2] = make_number ((GetBValue (foo.pixel) << 8)
7661 | GetBValue (foo.pixel));
ee78dc32
GV
7662 return Flist (3, rgb);
7663 }
7664 else
7665 return Qnil;
7666}
7667
2d764c78 7668DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0,
74e1aeec 7669 doc: /* Internal function called by `display-color-p', which see. */)
ee78dc32
GV
7670 (display)
7671 Lisp_Object display;
7672{
fbd6baed 7673 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV
7674
7675 if ((dpyinfo->n_planes * dpyinfo->n_cbits) <= 2)
7676 return Qnil;
7677
7678 return Qt;
7679}
7680
74e1aeec
JR
7681DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p,
7682 Sx_display_grayscale_p, 0, 1, 0,
7683 doc: /* Return t if the X display supports shades of gray.
7684Note that color displays do support shades of gray.
7685The optional argument DISPLAY specifies which display to ask about.
7686DISPLAY should be either a frame or a display name (a string).
7687If omitted or nil, that stands for the selected frame's display. */)
ee78dc32
GV
7688 (display)
7689 Lisp_Object display;
7690{
fbd6baed 7691 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV
7692
7693 if ((dpyinfo->n_planes * dpyinfo->n_cbits) <= 1)
7694 return Qnil;
7695
7696 return Qt;
7697}
7698
74e1aeec
JR
7699DEFUN ("x-display-pixel-width", Fx_display_pixel_width,
7700 Sx_display_pixel_width, 0, 1, 0,
7701 doc: /* Returns the width in pixels of DISPLAY.
7702The optional argument DISPLAY specifies which display to ask about.
7703DISPLAY should be either a frame or a display name (a string).
7704If omitted or nil, that stands for the selected frame's display. */)
ee78dc32
GV
7705 (display)
7706 Lisp_Object display;
7707{
fbd6baed 7708 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV
7709
7710 return make_number (dpyinfo->width);
7711}
7712
7713DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
74e1aeec
JR
7714 Sx_display_pixel_height, 0, 1, 0,
7715 doc: /* Returns the height in pixels of DISPLAY.
7716The optional argument DISPLAY specifies which display to ask about.
7717DISPLAY should be either a frame or a display name (a string).
7718If omitted or nil, that stands for the selected frame's display. */)
ee78dc32
GV
7719 (display)
7720 Lisp_Object display;
7721{
fbd6baed 7722 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV
7723
7724 return make_number (dpyinfo->height);
7725}
7726
7727DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
74e1aeec
JR
7728 0, 1, 0,
7729 doc: /* Returns the number of bitplanes of DISPLAY.
7730The optional argument DISPLAY specifies which display to ask about.
7731DISPLAY should be either a frame or a display name (a string).
7732If omitted or nil, that stands for the selected frame's display. */)
ee78dc32
GV
7733 (display)
7734 Lisp_Object display;
7735{
fbd6baed 7736 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV
7737
7738 return make_number (dpyinfo->n_planes * dpyinfo->n_cbits);
7739}
7740
7741DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
74e1aeec
JR
7742 0, 1, 0,
7743 doc: /* Returns the number of color cells of DISPLAY.
7744The optional argument DISPLAY specifies which display to ask about.
7745DISPLAY should be either a frame or a display name (a string).
7746If omitted or nil, that stands for the selected frame's display. */)
ee78dc32
GV
7747 (display)
7748 Lisp_Object display;
7749{
fbd6baed 7750 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV
7751 HDC hdc;
7752 int cap;
7753
5ac45f98
GV
7754 hdc = GetDC (dpyinfo->root_window);
7755 if (dpyinfo->has_palette)
7756 cap = GetDeviceCaps (hdc,SIZEPALETTE);
7757 else
7758 cap = GetDeviceCaps (hdc,NUMCOLORS);
abf8c61b 7759
007776bc
JB
7760 /* We force 24+ bit depths to 24-bit, both to prevent an overflow
7761 and because probably is more meaningful on Windows anyway */
abf8c61b 7762 if (cap < 0)
007776bc 7763 cap = 1 << min(dpyinfo->n_planes * dpyinfo->n_cbits, 24);
ee78dc32
GV
7764
7765 ReleaseDC (dpyinfo->root_window, hdc);
7766
7767 return make_number (cap);
7768}
7769
7770DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
7771 Sx_server_max_request_size,
74e1aeec
JR
7772 0, 1, 0,
7773 doc: /* Returns the maximum request size of the server of DISPLAY.
7774The optional argument DISPLAY specifies which display to ask about.
7775DISPLAY should be either a frame or a display name (a string).
7776If omitted or nil, that stands for the selected frame's display. */)
ee78dc32
GV
7777 (display)
7778 Lisp_Object display;
7779{
fbd6baed 7780 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV
7781
7782 return make_number (1);
7783}
7784
7785DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
74e1aeec
JR
7786 doc: /* Returns the vendor ID string of the W32 system (Microsoft).
7787The optional argument DISPLAY specifies which display to ask about.
7788DISPLAY should be either a frame or a display name (a string).
7789If omitted or nil, that stands for the selected frame's display. */)
ee78dc32
GV
7790 (display)
7791 Lisp_Object display;
7792{
dfff8a69 7793 return build_string ("Microsoft Corp.");
ee78dc32
GV
7794}
7795
7796DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
74e1aeec
JR
7797 doc: /* Returns the version numbers of the server of DISPLAY.
7798The value is a list of three integers: the major and minor
7799version numbers, and the vendor-specific release
7800number. See also the function `x-server-vendor'.
7801
7802The optional argument DISPLAY specifies which display to ask about.
7803DISPLAY should be either a frame or a display name (a string).
7804If omitted or nil, that stands for the selected frame's display. */)
ee78dc32
GV
7805 (display)
7806 Lisp_Object display;
7807{
fbd6baed 7808 return Fcons (make_number (w32_major_version),
58e0f0e4
AI
7809 Fcons (make_number (w32_minor_version),
7810 Fcons (make_number (w32_build_number), Qnil)));
ee78dc32
GV
7811}
7812
7813DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
74e1aeec
JR
7814 doc: /* Returns the number of screens on the server of DISPLAY.
7815The optional argument DISPLAY specifies which display to ask about.
7816DISPLAY should be either a frame or a display name (a string).
7817If omitted or nil, that stands for the selected frame's display. */)
ee78dc32
GV
7818 (display)
7819 Lisp_Object display;
7820{
ee78dc32
GV
7821 return make_number (1);
7822}
7823
74e1aeec
JR
7824DEFUN ("x-display-mm-height", Fx_display_mm_height,
7825 Sx_display_mm_height, 0, 1, 0,
7826 doc: /* Returns the height in millimeters of DISPLAY.
7827The optional argument DISPLAY specifies which display to ask about.
7828DISPLAY should be either a frame or a display name (a string).
7829If omitted or nil, that stands for the selected frame's display. */)
ee78dc32
GV
7830 (display)
7831 Lisp_Object display;
7832{
fbd6baed 7833 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV
7834 HDC hdc;
7835 int cap;
7836
5ac45f98 7837 hdc = GetDC (dpyinfo->root_window);
3c190163 7838
ee78dc32 7839 cap = GetDeviceCaps (hdc, VERTSIZE);
3c190163 7840
ee78dc32
GV
7841 ReleaseDC (dpyinfo->root_window, hdc);
7842
7843 return make_number (cap);
7844}
7845
7846DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
74e1aeec
JR
7847 doc: /* Returns the width in millimeters of DISPLAY.
7848The optional argument DISPLAY specifies which display to ask about.
7849DISPLAY should be either a frame or a display name (a string).
7850If omitted or nil, that stands for the selected frame's display. */)
ee78dc32
GV
7851 (display)
7852 Lisp_Object display;
7853{
fbd6baed 7854 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV
7855
7856 HDC hdc;
7857 int cap;
7858
5ac45f98 7859 hdc = GetDC (dpyinfo->root_window);
3c190163 7860
ee78dc32 7861 cap = GetDeviceCaps (hdc, HORZSIZE);
3c190163 7862
ee78dc32
GV
7863 ReleaseDC (dpyinfo->root_window, hdc);
7864
7865 return make_number (cap);
7866}
7867
7868DEFUN ("x-display-backing-store", Fx_display_backing_store,
74e1aeec
JR
7869 Sx_display_backing_store, 0, 1, 0,
7870 doc: /* Returns an indication of whether DISPLAY does backing store.
7871The value may be `always', `when-mapped', or `not-useful'.
7872The optional argument DISPLAY specifies which display to ask about.
7873DISPLAY should be either a frame or a display name (a string).
7874If omitted or nil, that stands for the selected frame's display. */)
ee78dc32
GV
7875 (display)
7876 Lisp_Object display;
7877{
7878 return intern ("not-useful");
7879}
7880
7881DEFUN ("x-display-visual-class", Fx_display_visual_class,
74e1aeec
JR
7882 Sx_display_visual_class, 0, 1, 0,
7883 doc: /* Returns the visual class of DISPLAY.
7884The value is one of the symbols `static-gray', `gray-scale',
7885`static-color', `pseudo-color', `true-color', or `direct-color'.
7886
7887The optional argument DISPLAY specifies which display to ask about.
7888DISPLAY should be either a frame or a display name (a string).
7889If omitted or nil, that stands for the selected frame's display. */)
ee78dc32
GV
7890 (display)
7891 Lisp_Object display;
7892{
fbd6baed 7893 struct w32_display_info *dpyinfo = check_x_display_info (display);
abf8c61b 7894 Lisp_Object result = Qnil;
ee78dc32 7895
abf8c61b
AI
7896 if (dpyinfo->has_palette)
7897 result = intern ("pseudo-color");
7898 else if (dpyinfo->n_planes * dpyinfo->n_cbits == 1)
7899 result = intern ("static-grey");
7900 else if (dpyinfo->n_planes * dpyinfo->n_cbits == 4)
7901 result = intern ("static-color");
7902 else if (dpyinfo->n_planes * dpyinfo->n_cbits > 8)
7903 result = intern ("true-color");
ee78dc32 7904
abf8c61b 7905 return result;
ee78dc32
GV
7906}
7907
7908DEFUN ("x-display-save-under", Fx_display_save_under,
74e1aeec
JR
7909 Sx_display_save_under, 0, 1, 0,
7910 doc: /* Returns t if DISPLAY supports the save-under feature.
7911The optional argument DISPLAY specifies which display to ask about.
7912DISPLAY should be either a frame or a display name (a string).
7913If omitted or nil, that stands for the selected frame's display. */)
ee78dc32
GV
7914 (display)
7915 Lisp_Object display;
7916{
6fc2811b
JR
7917 return Qnil;
7918}
7919\f
7920int
7921x_pixel_width (f)
7922 register struct frame *f;
7923{
7924 return PIXEL_WIDTH (f);
7925}
7926
7927int
7928x_pixel_height (f)
7929 register struct frame *f;
7930{
7931 return PIXEL_HEIGHT (f);
7932}
7933
7934int
7935x_char_width (f)
7936 register struct frame *f;
7937{
7938 return FONT_WIDTH (f->output_data.w32->font);
7939}
7940
7941int
7942x_char_height (f)
7943 register struct frame *f;
7944{
7945 return f->output_data.w32->line_height;
7946}
7947
7948int
7949x_screen_planes (f)
7950 register struct frame *f;
7951{
7952 return FRAME_W32_DISPLAY_INFO (f)->n_planes;
7953}
7954\f
7955/* Return the display structure for the display named NAME.
7956 Open a new connection if necessary. */
7957
7958struct w32_display_info *
7959x_display_info_for_name (name)
7960 Lisp_Object name;
7961{
7962 Lisp_Object names;
7963 struct w32_display_info *dpyinfo;
7964
b7826503 7965 CHECK_STRING (name);
6fc2811b
JR
7966
7967 for (dpyinfo = &one_w32_display_info, names = w32_display_name_list;
7968 dpyinfo;
7969 dpyinfo = dpyinfo->next, names = XCDR (names))
7970 {
7971 Lisp_Object tem;
7972 tem = Fstring_equal (XCAR (XCAR (names)), name);
7973 if (!NILP (tem))
7974 return dpyinfo;
7975 }
7976
7977 /* Use this general default value to start with. */
7978 Vx_resource_name = Vinvocation_name;
7979
7980 validate_x_resource_name ();
7981
7982 dpyinfo = w32_term_init (name, (unsigned char *)0,
d5db4077 7983 (char *) SDATA (Vx_resource_name));
6fc2811b
JR
7984
7985 if (dpyinfo == 0)
d5db4077 7986 error ("Cannot connect to server %s", SDATA (name));
6fc2811b
JR
7987
7988 w32_in_use = 1;
7989 XSETFASTINT (Vwindow_system_version, 3);
7990
7991 return dpyinfo;
7992}
7993
7994DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
74e1aeec
JR
7995 1, 3, 0, doc: /* Open a connection to a server.
7996DISPLAY is the name of the display to connect to.
7997Optional second arg XRM-STRING is a string of resources in xrdb format.
7998If the optional third arg MUST-SUCCEED is non-nil,
7999terminate Emacs if we can't open the connection. */)
6fc2811b
JR
8000 (display, xrm_string, must_succeed)
8001 Lisp_Object display, xrm_string, must_succeed;
8002{
8003 unsigned char *xrm_option;
8004 struct w32_display_info *dpyinfo;
8005
74e1aeec
JR
8006 /* If initialization has already been done, return now to avoid
8007 overwriting critical parts of one_w32_display_info. */
8008 if (w32_in_use)
8009 return Qnil;
8010
b7826503 8011 CHECK_STRING (display);
6fc2811b 8012 if (! NILP (xrm_string))
b7826503 8013 CHECK_STRING (xrm_string);
6fc2811b
JR
8014
8015 if (! EQ (Vwindow_system, intern ("w32")))
8016 error ("Not using Microsoft Windows");
8017
8018 /* Allow color mapping to be defined externally; first look in user's
8019 HOME directory, then in Emacs etc dir for a file called rgb.txt. */
8020 {
8021 Lisp_Object color_file;
8022 struct gcpro gcpro1;
8023
8024 color_file = build_string("~/rgb.txt");
8025
8026 GCPRO1 (color_file);
8027
8028 if (NILP (Ffile_readable_p (color_file)))
8029 color_file =
8030 Fexpand_file_name (build_string ("rgb.txt"),
8031 Fsymbol_value (intern ("data-directory")));
8032
8033 Vw32_color_map = Fw32_load_color_file (color_file);
8034
8035 UNGCPRO;
8036 }
8037 if (NILP (Vw32_color_map))
8038 Vw32_color_map = Fw32_default_color_map ();
8039
8040 if (! NILP (xrm_string))
d5db4077 8041 xrm_option = (unsigned char *) SDATA (xrm_string);
6fc2811b
JR
8042 else
8043 xrm_option = (unsigned char *) 0;
8044
8045 /* Use this general default value to start with. */
8046 /* First remove .exe suffix from invocation-name - it looks ugly. */
8047 {
8048 char basename[ MAX_PATH ], *str;
8049
d5db4077 8050 strcpy (basename, SDATA (Vinvocation_name));
6fc2811b
JR
8051 str = strrchr (basename, '.');
8052 if (str) *str = 0;
8053 Vinvocation_name = build_string (basename);
8054 }
8055 Vx_resource_name = Vinvocation_name;
8056
8057 validate_x_resource_name ();
8058
8059 /* This is what opens the connection and sets x_current_display.
8060 This also initializes many symbols, such as those used for input. */
8061 dpyinfo = w32_term_init (display, xrm_option,
d5db4077 8062 (char *) SDATA (Vx_resource_name));
6fc2811b
JR
8063
8064 if (dpyinfo == 0)
8065 {
8066 if (!NILP (must_succeed))
8067 fatal ("Cannot connect to server %s.\n",
d5db4077 8068 SDATA (display));
6fc2811b 8069 else
d5db4077 8070 error ("Cannot connect to server %s", SDATA (display));
6fc2811b
JR
8071 }
8072
8073 w32_in_use = 1;
8074
8075 XSETFASTINT (Vwindow_system_version, 3);
8076 return Qnil;
8077}
8078
8079DEFUN ("x-close-connection", Fx_close_connection,
8080 Sx_close_connection, 1, 1, 0,
74e1aeec
JR
8081 doc: /* Close the connection to DISPLAY's server.
8082For DISPLAY, specify either a frame or a display name (a string).
8083If DISPLAY is nil, that stands for the selected frame's display. */)
6fc2811b
JR
8084 (display)
8085 Lisp_Object display;
8086{
8087 struct w32_display_info *dpyinfo = check_x_display_info (display);
8088 int i;
8089
8090 if (dpyinfo->reference_count > 0)
8091 error ("Display still has frames on it");
8092
8093 BLOCK_INPUT;
8094 /* Free the fonts in the font table. */
8095 for (i = 0; i < dpyinfo->n_fonts; i++)
8096 if (dpyinfo->font_table[i].name)
8097 {
126f2e35
JR
8098 if (dpyinfo->font_table[i].name != dpyinfo->font_table[i].full_name)
8099 xfree (dpyinfo->font_table[i].full_name);
6fc2811b 8100 xfree (dpyinfo->font_table[i].name);
6fc2811b
JR
8101 w32_unload_font (dpyinfo, dpyinfo->font_table[i].font);
8102 }
8103 x_destroy_all_bitmaps (dpyinfo);
8104
8105 x_delete_display (dpyinfo);
8106 UNBLOCK_INPUT;
8107
8108 return Qnil;
8109}
8110
8111DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0,
74e1aeec 8112 doc: /* Return the list of display names that Emacs has connections to. */)
6fc2811b
JR
8113 ()
8114{
8115 Lisp_Object tail, result;
8116
8117 result = Qnil;
8118 for (tail = w32_display_name_list; ! NILP (tail); tail = XCDR (tail))
8119 result = Fcons (XCAR (XCAR (tail)), result);
8120
8121 return result;
8122}
8123
8124DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize, 1, 2, 0,
0a332240
PJ
8125 doc: /* This is a noop on W32 systems. */)
8126 (on, display)
8127 Lisp_Object display, on;
6fc2811b 8128{
6fc2811b
JR
8129 return Qnil;
8130}
8131
8132\f
6fc2811b
JR
8133/***********************************************************************
8134 Image types
8135 ***********************************************************************/
8136
8137/* Value is the number of elements of vector VECTOR. */
8138
8139#define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
8140
8141/* List of supported image types. Use define_image_type to add new
8142 types. Use lookup_image_type to find a type for a given symbol. */
8143
8144static struct image_type *image_types;
8145
6fc2811b
JR
8146/* The symbol `image' which is the car of the lists used to represent
8147 images in Lisp. */
8148
8149extern Lisp_Object Qimage;
8150
8151/* The symbol `xbm' which is used as the type symbol for XBM images. */
8152
8153Lisp_Object Qxbm;
8154
8155/* Keywords. */
8156
6fc2811b 8157extern Lisp_Object QCwidth, QCheight, QCforeground, QCbackground, QCfile;
77814035
KS
8158extern Lisp_Object QCdata, QCtype;
8159Lisp_Object QCascent, QCmargin, QCrelief;
a93f4566 8160Lisp_Object QCconversion, QCcolor_symbols, QCheuristic_mask;
3cf3436e 8161Lisp_Object QCindex, QCmatrix, QCcolor_adjustment, QCmask;
6fc2811b
JR
8162
8163/* Other symbols. */
8164
3cf3436e 8165Lisp_Object Qlaplace, Qemboss, Qedge_detection, Qheuristic;
6fc2811b
JR
8166
8167/* Time in seconds after which images should be removed from the cache
8168 if not displayed. */
8169
8170Lisp_Object Vimage_cache_eviction_delay;
8171
8172/* Function prototypes. */
8173
8174static void define_image_type P_ ((struct image_type *type));
8175static struct image_type *lookup_image_type P_ ((Lisp_Object symbol));
8176static void image_error P_ ((char *format, Lisp_Object, Lisp_Object));
8177static void x_laplace P_ ((struct frame *, struct image *));
3cf3436e 8178static void x_emboss P_ ((struct frame *, struct image *));
6fc2811b
JR
8179static int x_build_heuristic_mask P_ ((struct frame *, struct image *,
8180 Lisp_Object));
8181
dfff8a69 8182
6fc2811b
JR
8183/* Define a new image type from TYPE. This adds a copy of TYPE to
8184 image_types and adds the symbol *TYPE->type to Vimage_types. */
8185
8186static void
8187define_image_type (type)
8188 struct image_type *type;
8189{
8190 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
8191 The initialized data segment is read-only. */
8192 struct image_type *p = (struct image_type *) xmalloc (sizeof *p);
8193 bcopy (type, p, sizeof *p);
8194 p->next = image_types;
8195 image_types = p;
8196 Vimage_types = Fcons (*p->type, Vimage_types);
8197}
8198
8199
8200/* Look up image type SYMBOL, and return a pointer to its image_type
8201 structure. Value is null if SYMBOL is not a known image type. */
8202
8203static INLINE struct image_type *
8204lookup_image_type (symbol)
8205 Lisp_Object symbol;
8206{
8207 struct image_type *type;
8208
8209 for (type = image_types; type; type = type->next)
8210 if (EQ (symbol, *type->type))
8211 break;
8212
8213 return type;
8214}
8215
8216
8217/* Value is non-zero if OBJECT is a valid Lisp image specification. A
8218 valid image specification is a list whose car is the symbol
8219 `image', and whose rest is a property list. The property list must
8220 contain a value for key `:type'. That value must be the name of a
8221 supported image type. The rest of the property list depends on the
8222 image type. */
8223
8224int
8225valid_image_p (object)
8226 Lisp_Object object;
8227{
8228 int valid_p = 0;
8229
8230 if (CONSP (object) && EQ (XCAR (object), Qimage))
8231 {
3cf3436e
JR
8232 Lisp_Object tem;
8233
8234 for (tem = XCDR (object); CONSP (tem); tem = XCDR (tem))
8235 if (EQ (XCAR (tem), QCtype))
8236 {
8237 tem = XCDR (tem);
8238 if (CONSP (tem) && SYMBOLP (XCAR (tem)))
8239 {
8240 struct image_type *type;
8241 type = lookup_image_type (XCAR (tem));
8242 if (type)
8243 valid_p = type->valid_p (object);
8244 }
8245
8246 break;
8247 }
6fc2811b
JR
8248 }
8249
8250 return valid_p;
8251}
8252
8253
8254/* Log error message with format string FORMAT and argument ARG.
8255 Signaling an error, e.g. when an image cannot be loaded, is not a
8256 good idea because this would interrupt redisplay, and the error
8257 message display would lead to another redisplay. This function
8258 therefore simply displays a message. */
8259
8260static void
8261image_error (format, arg1, arg2)
8262 char *format;
8263 Lisp_Object arg1, arg2;
8264{
8265 add_to_log (format, arg1, arg2);
8266}
8267
8268
8269\f
8270/***********************************************************************
8271 Image specifications
8272 ***********************************************************************/
8273
8274enum image_value_type
8275{
8276 IMAGE_DONT_CHECK_VALUE_TYPE,
8277 IMAGE_STRING_VALUE,
3cf3436e 8278 IMAGE_STRING_OR_NIL_VALUE,
6fc2811b
JR
8279 IMAGE_SYMBOL_VALUE,
8280 IMAGE_POSITIVE_INTEGER_VALUE,
8edb0a6f 8281 IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR,
6fc2811b 8282 IMAGE_NON_NEGATIVE_INTEGER_VALUE,
dfff8a69 8283 IMAGE_ASCENT_VALUE,
6fc2811b
JR
8284 IMAGE_INTEGER_VALUE,
8285 IMAGE_FUNCTION_VALUE,
8286 IMAGE_NUMBER_VALUE,
8287 IMAGE_BOOL_VALUE
8288};
8289
8290/* Structure used when parsing image specifications. */
8291
8292struct image_keyword
8293{
8294 /* Name of keyword. */
8295 char *name;
8296
8297 /* The type of value allowed. */
8298 enum image_value_type type;
8299
8300 /* Non-zero means key must be present. */
8301 int mandatory_p;
8302
8303 /* Used to recognize duplicate keywords in a property list. */
8304 int count;
8305
8306 /* The value that was found. */
8307 Lisp_Object value;
8308};
8309
8310
8311static int parse_image_spec P_ ((Lisp_Object, struct image_keyword *,
8312 int, Lisp_Object));
8313static Lisp_Object image_spec_value P_ ((Lisp_Object, Lisp_Object, int *));
8314
8315
8316/* Parse image spec SPEC according to KEYWORDS. A valid image spec
8317 has the format (image KEYWORD VALUE ...). One of the keyword/
8318 value pairs must be `:type TYPE'. KEYWORDS is a vector of
8319 image_keywords structures of size NKEYWORDS describing other
8320 allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
8321
8322static int
8323parse_image_spec (spec, keywords, nkeywords, type)
8324 Lisp_Object spec;
8325 struct image_keyword *keywords;
8326 int nkeywords;
8327 Lisp_Object type;
8328{
8329 int i;
8330 Lisp_Object plist;
8331
8332 if (!CONSP (spec) || !EQ (XCAR (spec), Qimage))
8333 return 0;
8334
8335 plist = XCDR (spec);
8336 while (CONSP (plist))
8337 {
8338 Lisp_Object key, value;
8339
8340 /* First element of a pair must be a symbol. */
8341 key = XCAR (plist);
8342 plist = XCDR (plist);
8343 if (!SYMBOLP (key))
8344 return 0;
8345
8346 /* There must follow a value. */
8347 if (!CONSP (plist))
8348 return 0;
8349 value = XCAR (plist);
8350 plist = XCDR (plist);
8351
8352 /* Find key in KEYWORDS. Error if not found. */
8353 for (i = 0; i < nkeywords; ++i)
d5db4077 8354 if (strcmp (keywords[i].name, SDATA (SYMBOL_NAME (key))) == 0)
6fc2811b
JR
8355 break;
8356
8357 if (i == nkeywords)
8358 continue;
8359
8360 /* Record that we recognized the keyword. If a keywords
8361 was found more than once, it's an error. */
8362 keywords[i].value = value;
8363 ++keywords[i].count;
8364
8365 if (keywords[i].count > 1)
8366 return 0;
8367
8368 /* Check type of value against allowed type. */
8369 switch (keywords[i].type)
8370 {
8371 case IMAGE_STRING_VALUE:
8372 if (!STRINGP (value))
8373 return 0;
8374 break;
8375
3cf3436e
JR
8376 case IMAGE_STRING_OR_NIL_VALUE:
8377 if (!STRINGP (value) && !NILP (value))
8378 return 0;
8379 break;
8380
6fc2811b
JR
8381 case IMAGE_SYMBOL_VALUE:
8382 if (!SYMBOLP (value))
8383 return 0;
8384 break;
8385
8386 case IMAGE_POSITIVE_INTEGER_VALUE:
8387 if (!INTEGERP (value) || XINT (value) <= 0)
8388 return 0;
8389 break;
8390
8edb0a6f
JR
8391 case IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR:
8392 if (INTEGERP (value) && XINT (value) >= 0)
8393 break;
8394 if (CONSP (value)
8395 && INTEGERP (XCAR (value)) && INTEGERP (XCDR (value))
8396 && XINT (XCAR (value)) >= 0 && XINT (XCDR (value)) >= 0)
8397 break;
8398 return 0;
8399
dfff8a69
JR
8400 case IMAGE_ASCENT_VALUE:
8401 if (SYMBOLP (value) && EQ (value, Qcenter))
8402 break;
8403 else if (INTEGERP (value)
8404 && XINT (value) >= 0
8405 && XINT (value) <= 100)
8406 break;
8407 return 0;
8408
6fc2811b
JR
8409 case IMAGE_NON_NEGATIVE_INTEGER_VALUE:
8410 if (!INTEGERP (value) || XINT (value) < 0)
8411 return 0;
8412 break;
8413
8414 case IMAGE_DONT_CHECK_VALUE_TYPE:
8415 break;
8416
8417 case IMAGE_FUNCTION_VALUE:
8418 value = indirect_function (value);
8419 if (SUBRP (value)
8420 || COMPILEDP (value)
8421 || (CONSP (value) && EQ (XCAR (value), Qlambda)))
8422 break;
8423 return 0;
8424
8425 case IMAGE_NUMBER_VALUE:
8426 if (!INTEGERP (value) && !FLOATP (value))
8427 return 0;
8428 break;
8429
8430 case IMAGE_INTEGER_VALUE:
8431 if (!INTEGERP (value))
8432 return 0;
8433 break;
8434
8435 case IMAGE_BOOL_VALUE:
8436 if (!NILP (value) && !EQ (value, Qt))
8437 return 0;
8438 break;
8439
8440 default:
8441 abort ();
8442 break;
8443 }
8444
8445 if (EQ (key, QCtype) && !EQ (type, value))
8446 return 0;
8447 }
8448
8449 /* Check that all mandatory fields are present. */
8450 for (i = 0; i < nkeywords; ++i)
8451 if (keywords[i].mandatory_p && keywords[i].count == 0)
8452 return 0;
8453
8454 return NILP (plist);
8455}
8456
8457
8458/* Return the value of KEY in image specification SPEC. Value is nil
8459 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
8460 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
8461
8462static Lisp_Object
8463image_spec_value (spec, key, found)
8464 Lisp_Object spec, key;
8465 int *found;
8466{
8467 Lisp_Object tail;
8468
8469 xassert (valid_image_p (spec));
8470
8471 for (tail = XCDR (spec);
8472 CONSP (tail) && CONSP (XCDR (tail));
8473 tail = XCDR (XCDR (tail)))
8474 {
8475 if (EQ (XCAR (tail), key))
8476 {
8477 if (found)
8478 *found = 1;
8479 return XCAR (XCDR (tail));
8480 }
8481 }
8482
8483 if (found)
8484 *found = 0;
8485 return Qnil;
8486}
8487
8488
ac849ba4
JR
8489DEFUN ("image-size", Fimage_size, Simage_size, 1, 3, 0,
8490 doc: /* Return the size of image SPEC as pair (WIDTH . HEIGHT).
8491PIXELS non-nil means return the size in pixels, otherwise return the
8492size in canonical character units.
8493FRAME is the frame on which the image will be displayed. FRAME nil
8494or omitted means use the selected frame. */)
8495 (spec, pixels, frame)
8496 Lisp_Object spec, pixels, frame;
8497{
8498 Lisp_Object size;
8499
8500 size = Qnil;
8501 if (valid_image_p (spec))
8502 {
8503 struct frame *f = check_x_frame (frame);
8504 int id = lookup_image (f, spec);
8505 struct image *img = IMAGE_FROM_ID (f, id);
8506 int width = img->width + 2 * img->hmargin;
8507 int height = img->height + 2 * img->vmargin;
8508
8509 if (NILP (pixels))
8510 size = Fcons (make_float ((double) width / CANON_X_UNIT (f)),
8511 make_float ((double) height / CANON_Y_UNIT (f)));
8512 else
8513 size = Fcons (make_number (width), make_number (height));
8514 }
8515 else
8516 error ("Invalid image specification");
8517
8518 return size;
8519}
8520
8521
8522DEFUN ("image-mask-p", Fimage_mask_p, Simage_mask_p, 1, 2, 0,
8523 doc: /* Return t if image SPEC has a mask bitmap.
8524FRAME is the frame on which the image will be displayed. FRAME nil
8525or omitted means use the selected frame. */)
8526 (spec, frame)
8527 Lisp_Object spec, frame;
8528{
8529 Lisp_Object mask;
8530
8531 mask = Qnil;
8532 if (valid_image_p (spec))
8533 {
8534 struct frame *f = check_x_frame (frame);
8535 int id = lookup_image (f, spec);
8536 struct image *img = IMAGE_FROM_ID (f, id);
8537 if (img->mask)
8538 mask = Qt;
8539 }
8540 else
8541 error ("Invalid image specification");
8542
8543 return mask;
8544}
6fc2811b
JR
8545
8546\f
8547/***********************************************************************
8548 Image type independent image structures
8549 ***********************************************************************/
8550
8551static struct image *make_image P_ ((Lisp_Object spec, unsigned hash));
8552static void free_image P_ ((struct frame *f, struct image *img));
8553
8554
8555/* Allocate and return a new image structure for image specification
8556 SPEC. SPEC has a hash value of HASH. */
8557
8558static struct image *
8559make_image (spec, hash)
8560 Lisp_Object spec;
8561 unsigned hash;
8562{
8563 struct image *img = (struct image *) xmalloc (sizeof *img);
8564
8565 xassert (valid_image_p (spec));
8566 bzero (img, sizeof *img);
8567 img->type = lookup_image_type (image_spec_value (spec, QCtype, NULL));
8568 xassert (img->type != NULL);
8569 img->spec = spec;
8570 img->data.lisp_val = Qnil;
8571 img->ascent = DEFAULT_IMAGE_ASCENT;
8572 img->hash = hash;
8573 return img;
8574}
8575
8576
8577/* Free image IMG which was used on frame F, including its resources. */
8578
8579static void
8580free_image (f, img)
8581 struct frame *f;
8582 struct image *img;
8583{
8584 if (img)
8585 {
8586 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
8587
8588 /* Remove IMG from the hash table of its cache. */
8589 if (img->prev)
8590 img->prev->next = img->next;
8591 else
8592 c->buckets[img->hash % IMAGE_CACHE_BUCKETS_SIZE] = img->next;
8593
8594 if (img->next)
8595 img->next->prev = img->prev;
8596
8597 c->images[img->id] = NULL;
8598
8599 /* Free resources, then free IMG. */
8600 img->type->free (f, img);
8601 xfree (img);
8602 }
8603}
8604
8605
8606/* Prepare image IMG for display on frame F. Must be called before
8607 drawing an image. */
8608
8609void
8610prepare_image_for_display (f, img)
8611 struct frame *f;
8612 struct image *img;
8613{
8614 EMACS_TIME t;
8615
8616 /* We're about to display IMG, so set its timestamp to `now'. */
8617 EMACS_GET_TIME (t);
8618 img->timestamp = EMACS_SECS (t);
8619
8620 /* If IMG doesn't have a pixmap yet, load it now, using the image
8621 type dependent loader function. */
8622 if (img->pixmap == 0 && !img->load_failed_p)
8623 img->load_failed_p = img->type->load (f, img) == 0;
8624}
8625
8626
dfff8a69
JR
8627/* Value is the number of pixels for the ascent of image IMG when
8628 drawn in face FACE. */
8629
8630int
8631image_ascent (img, face)
8632 struct image *img;
8633 struct face *face;
8634{
8edb0a6f 8635 int height = img->height + img->vmargin;
dfff8a69
JR
8636 int ascent;
8637
8638 if (img->ascent == CENTERED_IMAGE_ASCENT)
8639 {
8640 if (face->font)
8641 ascent = height / 2 - (FONT_DESCENT(face->font)
8642 - FONT_BASE(face->font)) / 2;
8643 else
8644 ascent = height / 2;
8645 }
8646 else
ac849ba4 8647 ascent = (int) (height * img->ascent / 100.0);
dfff8a69
JR
8648
8649 return ascent;
8650}
8651
8652
6fc2811b 8653\f
a05e2bae
JR
8654/* Image background colors. */
8655
ac849ba4
JR
8656/* Find the "best" corner color of a bitmap. XIMG is assumed to a device
8657 context with the bitmap selected. */
8658static COLORREF
a05e2bae 8659four_corners_best (ximg, width, height)
ac849ba4 8660 HDC ximg;
a05e2bae
JR
8661 unsigned long width, height;
8662{
ac849ba4 8663 COLORREF corners[4], best;
a05e2bae
JR
8664 int i, best_count;
8665
8666 /* Get the colors at the corners of ximg. */
ac849ba4
JR
8667 corners[0] = GetPixel (ximg, 0, 0);
8668 corners[1] = GetPixel (ximg, width - 1, 0);
8669 corners[2] = GetPixel (ximg, width - 1, height - 1);
8670 corners[3] = GetPixel (ximg, 0, height - 1);
a05e2bae
JR
8671
8672 /* Choose the most frequently found color as background. */
8673 for (i = best_count = 0; i < 4; ++i)
8674 {
8675 int j, n;
8676
8677 for (j = n = 0; j < 4; ++j)
8678 if (corners[i] == corners[j])
8679 ++n;
8680
8681 if (n > best_count)
8682 best = corners[i], best_count = n;
8683 }
8684
8685 return best;
a05e2bae
JR
8686}
8687
8688/* Return the `background' field of IMG. If IMG doesn't have one yet,
8689 it is guessed heuristically. If non-zero, XIMG is an existing XImage
8690 object to use for the heuristic. */
8691
8692unsigned long
8693image_background (img, f, ximg)
8694 struct image *img;
8695 struct frame *f;
8696 XImage *ximg;
8697{
8698 if (! img->background_valid)
8699 /* IMG doesn't have a background yet, try to guess a reasonable value. */
8700 {
8701#if 0 /* TODO: Image support. */
8702 int free_ximg = !ximg;
8703
8704 if (! ximg)
8705 ximg = XGetImage (FRAME_X_DISPLAY (f), img->pixmap,
8706 0, 0, img->width, img->height, ~0, ZPixmap);
8707
8708 img->background = four_corners_best (ximg, img->width, img->height);
8709
8710 if (free_ximg)
8711 XDestroyImage (ximg);
8712
8713 img->background_valid = 1;
8714#endif
8715 }
8716
8717 return img->background;
8718}
8719
8720/* Return the `background_transparent' field of IMG. If IMG doesn't
8721 have one yet, it is guessed heuristically. If non-zero, MASK is an
8722 existing XImage object to use for the heuristic. */
8723
8724int
8725image_background_transparent (img, f, mask)
8726 struct image *img;
8727 struct frame *f;
8728 XImage *mask;
8729{
8730 if (! img->background_transparent_valid)
8731 /* IMG doesn't have a background yet, try to guess a reasonable value. */
8732 {
8733#if 0 /* TODO: Image support. */
8734 if (img->mask)
8735 {
8736 int free_mask = !mask;
8737
8738 if (! mask)
8739 mask = XGetImage (FRAME_X_DISPLAY (f), img->mask,
8740 0, 0, img->width, img->height, ~0, ZPixmap);
8741
8742 img->background_transparent
8743 = !four_corners_best (mask, img->width, img->height);
8744
8745 if (free_mask)
8746 XDestroyImage (mask);
8747 }
8748 else
8749#endif
8750 img->background_transparent = 0;
8751
8752 img->background_transparent_valid = 1;
8753 }
8754
8755 return img->background_transparent;
8756}
8757
8758\f
6fc2811b
JR
8759/***********************************************************************
8760 Helper functions for X image types
8761 ***********************************************************************/
8762
a05e2bae
JR
8763static void x_clear_image_1 P_ ((struct frame *, struct image *, int,
8764 int, int));
6fc2811b
JR
8765static void x_clear_image P_ ((struct frame *f, struct image *img));
8766static unsigned long x_alloc_image_color P_ ((struct frame *f,
8767 struct image *img,
8768 Lisp_Object color_name,
8769 unsigned long dflt));
8770
a05e2bae
JR
8771
8772/* Clear X resources of image IMG on frame F. PIXMAP_P non-zero means
8773 free the pixmap if any. MASK_P non-zero means clear the mask
8774 pixmap if any. COLORS_P non-zero means free colors allocated for
8775 the image, if any. */
8776
8777static void
8778x_clear_image_1 (f, img, pixmap_p, mask_p, colors_p)
8779 struct frame *f;
8780 struct image *img;
8781 int pixmap_p, mask_p, colors_p;
8782{
a05e2bae
JR
8783 if (pixmap_p && img->pixmap)
8784 {
ac849ba4
JR
8785 DeleteObject (img->pixmap);
8786 img->pixmap = NULL;
a05e2bae
JR
8787 img->background_valid = 0;
8788 }
8789
8790 if (mask_p && img->mask)
8791 {
ac849ba4
JR
8792 DeleteObject (img->mask);
8793 img->mask = NULL;
a05e2bae
JR
8794 img->background_transparent_valid = 0;
8795 }
8796
8797 if (colors_p && img->ncolors)
8798 {
bf76fe9c 8799#if 0 /* TODO: color table support. */
a05e2bae 8800 x_free_colors (f, img->colors, img->ncolors);
bf76fe9c 8801#endif
a05e2bae
JR
8802 xfree (img->colors);
8803 img->colors = NULL;
8804 img->ncolors = 0;
8805 }
a05e2bae
JR
8806}
8807
6fc2811b
JR
8808/* Free X resources of image IMG which is used on frame F. */
8809
8810static void
8811x_clear_image (f, img)
8812 struct frame *f;
8813 struct image *img;
8814{
6fc2811b
JR
8815 if (img->pixmap)
8816 {
8817 BLOCK_INPUT;
ac849ba4 8818 DeleteObject (img->pixmap);
6fc2811b
JR
8819 img->pixmap = 0;
8820 UNBLOCK_INPUT;
8821 }
8822
8823 if (img->ncolors)
8824 {
ac849ba4
JR
8825#if 0 /* TODO: color table support */
8826
6fc2811b
JR
8827 int class = FRAME_W32_DISPLAY_INFO (f)->visual->class;
8828
8829 /* If display has an immutable color map, freeing colors is not
8830 necessary and some servers don't allow it. So don't do it. */
8831 if (class != StaticColor
8832 && class != StaticGray
8833 && class != TrueColor)
8834 {
8835 Colormap cmap;
8836 BLOCK_INPUT;
8837 cmap = DefaultColormapOfScreen (FRAME_W32_DISPLAY_INFO (f)->screen);
8838 XFreeColors (FRAME_W32_DISPLAY (f), cmap, img->colors,
8839 img->ncolors, 0);
8840 UNBLOCK_INPUT;
8841 }
ac849ba4 8842#endif
6fc2811b
JR
8843
8844 xfree (img->colors);
8845 img->colors = NULL;
8846 img->ncolors = 0;
8847 }
6fc2811b
JR
8848}
8849
8850
8851/* Allocate color COLOR_NAME for image IMG on frame F. If color
8852 cannot be allocated, use DFLT. Add a newly allocated color to
8853 IMG->colors, so that it can be freed again. Value is the pixel
8854 color. */
8855
8856static unsigned long
8857x_alloc_image_color (f, img, color_name, dflt)
8858 struct frame *f;
8859 struct image *img;
8860 Lisp_Object color_name;
8861 unsigned long dflt;
8862{
6fc2811b
JR
8863 XColor color;
8864 unsigned long result;
8865
8866 xassert (STRINGP (color_name));
8867
d5db4077 8868 if (w32_defined_color (f, SDATA (color_name), &color, 1))
6fc2811b
JR
8869 {
8870 /* This isn't called frequently so we get away with simply
8871 reallocating the color vector to the needed size, here. */
8872 ++img->ncolors;
8873 img->colors =
8874 (unsigned long *) xrealloc (img->colors,
8875 img->ncolors * sizeof *img->colors);
8876 img->colors[img->ncolors - 1] = color.pixel;
8877 result = color.pixel;
8878 }
8879 else
8880 result = dflt;
8881 return result;
6fc2811b
JR
8882}
8883
8884
8885\f
8886/***********************************************************************
8887 Image Cache
8888 ***********************************************************************/
8889
8890static void cache_image P_ ((struct frame *f, struct image *img));
3cf3436e 8891static void postprocess_image P_ ((struct frame *, struct image *));
6fc2811b
JR
8892
8893
8894/* Return a new, initialized image cache that is allocated from the
8895 heap. Call free_image_cache to free an image cache. */
8896
8897struct image_cache *
8898make_image_cache ()
8899{
8900 struct image_cache *c = (struct image_cache *) xmalloc (sizeof *c);
8901 int size;
8902
8903 bzero (c, sizeof *c);
8904 c->size = 50;
8905 c->images = (struct image **) xmalloc (c->size * sizeof *c->images);
8906 size = IMAGE_CACHE_BUCKETS_SIZE * sizeof *c->buckets;
8907 c->buckets = (struct image **) xmalloc (size);
8908 bzero (c->buckets, size);
8909 return c;
8910}
8911
8912
8913/* Free image cache of frame F. Be aware that X frames share images
8914 caches. */
8915
8916void
8917free_image_cache (f)
8918 struct frame *f;
8919{
8920 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
8921 if (c)
8922 {
8923 int i;
8924
8925 /* Cache should not be referenced by any frame when freed. */
8926 xassert (c->refcount == 0);
8927
8928 for (i = 0; i < c->used; ++i)
8929 free_image (f, c->images[i]);
8930 xfree (c->images);
8931 xfree (c);
8932 xfree (c->buckets);
8933 FRAME_X_IMAGE_CACHE (f) = NULL;
8934 }
8935}
8936
8937
8938/* Clear image cache of frame F. FORCE_P non-zero means free all
8939 images. FORCE_P zero means clear only images that haven't been
8940 displayed for some time. Should be called from time to time to
dfff8a69
JR
8941 reduce the number of loaded images. If image-eviction-seconds is
8942 non-nil, this frees images in the cache which weren't displayed for
6fc2811b
JR
8943 at least that many seconds. */
8944
8945void
8946clear_image_cache (f, force_p)
8947 struct frame *f;
8948 int force_p;
8949{
8950 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
8951
8952 if (c && INTEGERP (Vimage_cache_eviction_delay))
8953 {
8954 EMACS_TIME t;
8955 unsigned long old;
0327b4cc 8956 int i, nfreed;
6fc2811b
JR
8957
8958 EMACS_GET_TIME (t);
8959 old = EMACS_SECS (t) - XFASTINT (Vimage_cache_eviction_delay);
8960
0327b4cc
JR
8961 /* Block input so that we won't be interrupted by a SIGIO
8962 while being in an inconsistent state. */
8963 BLOCK_INPUT;
8964
8965 for (i = nfreed = 0; i < c->used; ++i)
6fc2811b
JR
8966 {
8967 struct image *img = c->images[i];
8968 if (img != NULL
0327b4cc 8969 && (force_p || (img->timestamp < old)))
6fc2811b
JR
8970 {
8971 free_image (f, img);
0327b4cc 8972 ++nfreed;
6fc2811b
JR
8973 }
8974 }
8975
8976 /* We may be clearing the image cache because, for example,
8977 Emacs was iconified for a longer period of time. In that
8978 case, current matrices may still contain references to
8979 images freed above. So, clear these matrices. */
0327b4cc 8980 if (nfreed)
6fc2811b 8981 {
0327b4cc
JR
8982 Lisp_Object tail, frame;
8983
8984 FOR_EACH_FRAME (tail, frame)
8985 {
8986 struct frame *f = XFRAME (frame);
8987 if (FRAME_W32_P (f)
8988 && FRAME_X_IMAGE_CACHE (f) == c)
8989 clear_current_matrices (f);
8990 }
8991
6fc2811b
JR
8992 ++windows_or_buffers_changed;
8993 }
0327b4cc
JR
8994
8995 UNBLOCK_INPUT;
6fc2811b
JR
8996 }
8997}
8998
8999
9000DEFUN ("clear-image-cache", Fclear_image_cache, Sclear_image_cache,
9001 0, 1, 0,
74e1aeec
JR
9002 doc: /* Clear the image cache of FRAME.
9003FRAME nil or omitted means use the selected frame.
9004FRAME t means clear the image caches of all frames. */)
6fc2811b
JR
9005 (frame)
9006 Lisp_Object frame;
9007{
9008 if (EQ (frame, Qt))
9009 {
9010 Lisp_Object tail;
9011
9012 FOR_EACH_FRAME (tail, frame)
9013 if (FRAME_W32_P (XFRAME (frame)))
9014 clear_image_cache (XFRAME (frame), 1);
9015 }
9016 else
9017 clear_image_cache (check_x_frame (frame), 1);
9018
9019 return Qnil;
9020}
9021
9022
3cf3436e
JR
9023/* Compute masks and transform image IMG on frame F, as specified
9024 by the image's specification, */
9025
9026static void
9027postprocess_image (f, img)
9028 struct frame *f;
9029 struct image *img;
9030{
9031#if 0 /* TODO: image support. */
9032 /* Manipulation of the image's mask. */
9033 if (img->pixmap)
9034 {
9035 Lisp_Object conversion, spec;
9036 Lisp_Object mask;
9037
9038 spec = img->spec;
9039
9040 /* `:heuristic-mask t'
9041 `:mask heuristic'
9042 means build a mask heuristically.
9043 `:heuristic-mask (R G B)'
9044 `:mask (heuristic (R G B))'
9045 means build a mask from color (R G B) in the
9046 image.
9047 `:mask nil'
9048 means remove a mask, if any. */
9049
9050 mask = image_spec_value (spec, QCheuristic_mask, NULL);
9051 if (!NILP (mask))
9052 x_build_heuristic_mask (f, img, mask);
9053 else
9054 {
9055 int found_p;
9056
9057 mask = image_spec_value (spec, QCmask, &found_p);
9058
9059 if (EQ (mask, Qheuristic))
9060 x_build_heuristic_mask (f, img, Qt);
9061 else if (CONSP (mask)
9062 && EQ (XCAR (mask), Qheuristic))
9063 {
9064 if (CONSP (XCDR (mask)))
9065 x_build_heuristic_mask (f, img, XCAR (XCDR (mask)));
9066 else
9067 x_build_heuristic_mask (f, img, XCDR (mask));
9068 }
9069 else if (NILP (mask) && found_p && img->mask)
9070 {
ac849ba4 9071 DeleteObject (img->mask);
3cf3436e
JR
9072 img->mask = NULL;
9073 }
9074 }
9075
9076
9077 /* Should we apply an image transformation algorithm? */
9078 conversion = image_spec_value (spec, QCconversion, NULL);
9079 if (EQ (conversion, Qdisabled))
9080 x_disable_image (f, img);
9081 else if (EQ (conversion, Qlaplace))
9082 x_laplace (f, img);
9083 else if (EQ (conversion, Qemboss))
9084 x_emboss (f, img);
9085 else if (CONSP (conversion)
9086 && EQ (XCAR (conversion), Qedge_detection))
9087 {
9088 Lisp_Object tem;
9089 tem = XCDR (conversion);
9090 if (CONSP (tem))
9091 x_edge_detection (f, img,
9092 Fplist_get (tem, QCmatrix),
9093 Fplist_get (tem, QCcolor_adjustment));
9094 }
9095 }
9096#endif
9097}
9098
9099
6fc2811b
JR
9100/* Return the id of image with Lisp specification SPEC on frame F.
9101 SPEC must be a valid Lisp image specification (see valid_image_p). */
9102
9103int
9104lookup_image (f, spec)
9105 struct frame *f;
9106 Lisp_Object spec;
9107{
9108 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
9109 struct image *img;
9110 int i;
9111 unsigned hash;
9112 struct gcpro gcpro1;
9113 EMACS_TIME now;
9114
9115 /* F must be a window-system frame, and SPEC must be a valid image
9116 specification. */
9117 xassert (FRAME_WINDOW_P (f));
9118 xassert (valid_image_p (spec));
9119
9120 GCPRO1 (spec);
9121
9122 /* Look up SPEC in the hash table of the image cache. */
9123 hash = sxhash (spec, 0);
9124 i = hash % IMAGE_CACHE_BUCKETS_SIZE;
9125
9126 for (img = c->buckets[i]; img; img = img->next)
9127 if (img->hash == hash && !NILP (Fequal (img->spec, spec)))
9128 break;
9129
9130 /* If not found, create a new image and cache it. */
9131 if (img == NULL)
9132 {
3cf3436e
JR
9133 extern Lisp_Object Qpostscript;
9134
8edb0a6f 9135 BLOCK_INPUT;
6fc2811b
JR
9136 img = make_image (spec, hash);
9137 cache_image (f, img);
9138 img->load_failed_p = img->type->load (f, img) == 0;
6fc2811b
JR
9139
9140 /* If we can't load the image, and we don't have a width and
9141 height, use some arbitrary width and height so that we can
9142 draw a rectangle for it. */
9143 if (img->load_failed_p)
9144 {
9145 Lisp_Object value;
9146
9147 value = image_spec_value (spec, QCwidth, NULL);
9148 img->width = (INTEGERP (value)
9149 ? XFASTINT (value) : DEFAULT_IMAGE_WIDTH);
9150 value = image_spec_value (spec, QCheight, NULL);
9151 img->height = (INTEGERP (value)
9152 ? XFASTINT (value) : DEFAULT_IMAGE_HEIGHT);
9153 }
9154 else
9155 {
9156 /* Handle image type independent image attributes
a05e2bae
JR
9157 `:ascent PERCENT', `:margin MARGIN', `:relief RELIEF',
9158 `:background COLOR'. */
9159 Lisp_Object ascent, margin, relief, bg;
6fc2811b
JR
9160
9161 ascent = image_spec_value (spec, QCascent, NULL);
9162 if (INTEGERP (ascent))
9163 img->ascent = XFASTINT (ascent);
dfff8a69
JR
9164 else if (EQ (ascent, Qcenter))
9165 img->ascent = CENTERED_IMAGE_ASCENT;
9166
6fc2811b
JR
9167 margin = image_spec_value (spec, QCmargin, NULL);
9168 if (INTEGERP (margin) && XINT (margin) >= 0)
8edb0a6f
JR
9169 img->vmargin = img->hmargin = XFASTINT (margin);
9170 else if (CONSP (margin) && INTEGERP (XCAR (margin))
9171 && INTEGERP (XCDR (margin)))
9172 {
9173 if (XINT (XCAR (margin)) > 0)
9174 img->hmargin = XFASTINT (XCAR (margin));
9175 if (XINT (XCDR (margin)) > 0)
9176 img->vmargin = XFASTINT (XCDR (margin));
9177 }
6fc2811b
JR
9178
9179 relief = image_spec_value (spec, QCrelief, NULL);
9180 if (INTEGERP (relief))
9181 {
9182 img->relief = XINT (relief);
8edb0a6f
JR
9183 img->hmargin += abs (img->relief);
9184 img->vmargin += abs (img->relief);
6fc2811b
JR
9185 }
9186
a05e2bae
JR
9187 if (! img->background_valid)
9188 {
9189 bg = image_spec_value (img->spec, QCbackground, NULL);
9190 if (!NILP (bg))
9191 {
9192 img->background
9193 = x_alloc_image_color (f, img, bg,
9194 FRAME_BACKGROUND_PIXEL (f));
9195 img->background_valid = 1;
9196 }
9197 }
9198
3cf3436e
JR
9199 /* Do image transformations and compute masks, unless we
9200 don't have the image yet. */
9201 if (!EQ (*img->type->type, Qpostscript))
9202 postprocess_image (f, img);
6fc2811b 9203 }
3cf3436e 9204
8edb0a6f
JR
9205 UNBLOCK_INPUT;
9206 xassert (!interrupt_input_blocked);
6fc2811b
JR
9207 }
9208
9209 /* We're using IMG, so set its timestamp to `now'. */
9210 EMACS_GET_TIME (now);
9211 img->timestamp = EMACS_SECS (now);
9212
9213 UNGCPRO;
9214
9215 /* Value is the image id. */
9216 return img->id;
9217}
9218
9219
9220/* Cache image IMG in the image cache of frame F. */
9221
9222static void
9223cache_image (f, img)
9224 struct frame *f;
9225 struct image *img;
9226{
9227 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
9228 int i;
9229
9230 /* Find a free slot in c->images. */
9231 for (i = 0; i < c->used; ++i)
9232 if (c->images[i] == NULL)
9233 break;
9234
9235 /* If no free slot found, maybe enlarge c->images. */
9236 if (i == c->used && c->used == c->size)
9237 {
9238 c->size *= 2;
9239 c->images = (struct image **) xrealloc (c->images,
9240 c->size * sizeof *c->images);
9241 }
9242
9243 /* Add IMG to c->images, and assign IMG an id. */
9244 c->images[i] = img;
9245 img->id = i;
9246 if (i == c->used)
9247 ++c->used;
9248
9249 /* Add IMG to the cache's hash table. */
9250 i = img->hash % IMAGE_CACHE_BUCKETS_SIZE;
9251 img->next = c->buckets[i];
9252 if (img->next)
9253 img->next->prev = img;
9254 img->prev = NULL;
9255 c->buckets[i] = img;
9256}
9257
9258
9259/* Call FN on every image in the image cache of frame F. Used to mark
9260 Lisp Objects in the image cache. */
9261
9262void
9263forall_images_in_image_cache (f, fn)
9264 struct frame *f;
9265 void (*fn) P_ ((struct image *img));
9266{
9267 if (FRAME_LIVE_P (f) && FRAME_W32_P (f))
9268 {
9269 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
9270 if (c)
9271 {
9272 int i;
9273 for (i = 0; i < c->used; ++i)
9274 if (c->images[i])
9275 fn (c->images[i]);
9276 }
9277 }
9278}
9279
9280
9281\f
9282/***********************************************************************
9283 W32 support code
9284 ***********************************************************************/
9285
6fc2811b
JR
9286static int x_create_x_image_and_pixmap P_ ((struct frame *, int, int, int,
9287 XImage **, Pixmap *));
9288static void x_destroy_x_image P_ ((XImage *));
9289static void x_put_x_image P_ ((struct frame *, XImage *, Pixmap, int, int));
9290
9291
9292/* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
9293 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
9294 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
ac849ba4
JR
9295 via xmalloc. DEPTH of zero signifies a 24 bit image, otherwise
9296 DEPTH should indicate the bit depth of the image. Print error
9297 messages via image_error if an error occurs. Value is non-zero if
9298 successful. */
6fc2811b
JR
9299
9300static int
9301x_create_x_image_and_pixmap (f, width, height, depth, ximg, pixmap)
9302 struct frame *f;
9303 int width, height, depth;
9304 XImage **ximg;
9305 Pixmap *pixmap;
9306{
ac849ba4
JR
9307 BITMAPINFOHEADER *header;
9308 HDC hdc;
9309 int scanline_width_bits;
9310 int remainder;
9311 int palette_colors = 0;
6fc2811b 9312
ac849ba4
JR
9313 if (depth == 0)
9314 depth = 24;
6fc2811b 9315
ac849ba4
JR
9316 if (depth != 1 && depth != 4 && depth != 8
9317 && depth != 16 && depth != 24 && depth != 32)
9318 {
9319 image_error ("Invalid image bit depth specified", Qnil, Qnil);
9320 return 0;
9321 }
9322
9323 scanline_width_bits = width * depth;
9324 remainder = scanline_width_bits % 32;
9325
9326 if (remainder)
9327 scanline_width_bits += 32 - remainder;
9328
9329 /* Bitmaps with a depth less than 16 need a palette. */
9330 /* BITMAPINFO structure already contains the first RGBQUAD. */
9331 if (depth < 16)
9332 palette_colors = 1 << depth - 1;
9333
9334 *ximg = xmalloc (sizeof (XImage) + palette_colors * sizeof (RGBQUAD));
6fc2811b
JR
9335 if (*ximg == NULL)
9336 {
ac849ba4 9337 image_error ("Unable to allocate memory for XImage", Qnil, Qnil);
6fc2811b
JR
9338 return 0;
9339 }
9340
ac849ba4
JR
9341 header = &((*ximg)->info.bmiHeader);
9342 bzero (&((*ximg)->info), sizeof (BITMAPINFO));
9343 header->biSize = sizeof (*header);
9344 header->biWidth = width;
9345 header->biHeight = -height; /* negative indicates a top-down bitmap. */
9346 header->biPlanes = 1;
9347 header->biBitCount = depth;
9348 header->biCompression = BI_RGB;
9349 header->biClrUsed = palette_colors;
6fc2811b 9350
ac849ba4
JR
9351 hdc = get_frame_dc (f);
9352
9353 /* Create a DIBSection and raster array for the bitmap,
9354 and store its handle in *pixmap. */
9355 *pixmap = CreateDIBSection (hdc, &((*ximg)->info), DIB_RGB_COLORS,
9356 &((*ximg)->data), NULL, 0);
9357
9358 /* Realize display palette and garbage all frames. */
9359 release_frame_dc (f, hdc);
9360
9361 if (*pixmap == NULL)
6fc2811b 9362 {
ac849ba4
JR
9363 DWORD err = GetLastError();
9364 Lisp_Object errcode;
9365 /* All system errors are < 10000, so the following is safe. */
9366 XSETINT (errcode, (int) err);
9367 image_error ("Unable to create bitmap, error code %d", errcode, Qnil);
6fc2811b 9368 x_destroy_x_image (*ximg);
6fc2811b
JR
9369 return 0;
9370 }
ac849ba4 9371
6fc2811b
JR
9372 return 1;
9373}
9374
9375
9376/* Destroy XImage XIMG. Free XIMG->data. */
9377
9378static void
9379x_destroy_x_image (ximg)
9380 XImage *ximg;
9381{
9382 xassert (interrupt_input_blocked);
9383 if (ximg)
9384 {
ac849ba4 9385 /* Data will be freed by DestroyObject. */
6fc2811b 9386 ximg->data = NULL;
ac849ba4 9387 xfree (ximg);
6fc2811b
JR
9388 }
9389}
9390
9391
9392/* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
9393 are width and height of both the image and pixmap. */
9394
9395static void
9396x_put_x_image (f, ximg, pixmap, width, height)
9397 struct frame *f;
9398 XImage *ximg;
9399 Pixmap pixmap;
9400{
ac849ba4
JR
9401
9402#if TODO /* W32 specific image code. */
6fc2811b 9403 GC gc;
ac849ba4 9404
6fc2811b
JR
9405 xassert (interrupt_input_blocked);
9406 gc = XCreateGC (NULL, pixmap, 0, NULL);
9407 XPutImage (NULL, pixmap, gc, ximg, 0, 0, 0, 0, width, height);
9408 XFreeGC (NULL, gc);
6fc2811b 9409#endif
ac849ba4 9410}
6fc2811b
JR
9411
9412\f
9413/***********************************************************************
3cf3436e 9414 File Handling
6fc2811b
JR
9415 ***********************************************************************/
9416
9417static Lisp_Object x_find_image_file P_ ((Lisp_Object));
3cf3436e
JR
9418static char *slurp_file P_ ((char *, int *));
9419
6fc2811b
JR
9420
9421/* Find image file FILE. Look in data-directory, then
9422 x-bitmap-file-path. Value is the full name of the file found, or
9423 nil if not found. */
9424
9425static Lisp_Object
9426x_find_image_file (file)
9427 Lisp_Object file;
9428{
9429 Lisp_Object file_found, search_path;
9430 struct gcpro gcpro1, gcpro2;
9431 int fd;
9432
9433 file_found = Qnil;
9434 search_path = Fcons (Vdata_directory, Vx_bitmap_file_path);
9435 GCPRO2 (file_found, search_path);
9436
9437 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
de2413e9 9438 fd = openp (search_path, file, Qnil, &file_found, Qnil);
6fc2811b 9439
939d6465 9440 if (fd == -1)
6fc2811b
JR
9441 file_found = Qnil;
9442 else
9443 close (fd);
9444
9445 UNGCPRO;
9446 return file_found;
9447}
9448
9449
3cf3436e
JR
9450/* Read FILE into memory. Value is a pointer to a buffer allocated
9451 with xmalloc holding FILE's contents. Value is null if an error
9452 occurred. *SIZE is set to the size of the file. */
9453
9454static char *
9455slurp_file (file, size)
9456 char *file;
9457 int *size;
9458{
9459 FILE *fp = NULL;
9460 char *buf = NULL;
9461 struct stat st;
9462
9463 if (stat (file, &st) == 0
9464 && (fp = fopen (file, "r")) != NULL
9465 && (buf = (char *) xmalloc (st.st_size),
9466 fread (buf, 1, st.st_size, fp) == st.st_size))
9467 {
9468 *size = st.st_size;
9469 fclose (fp);
9470 }
9471 else
9472 {
9473 if (fp)
9474 fclose (fp);
9475 if (buf)
9476 {
9477 xfree (buf);
9478 buf = NULL;
9479 }
9480 }
9481
9482 return buf;
9483}
9484
9485
6fc2811b
JR
9486\f
9487/***********************************************************************
9488 XBM images
9489 ***********************************************************************/
9490
217e5be0 9491static int xbm_scan P_ ((char **, char *, char *, int *));
6fc2811b 9492static int xbm_load P_ ((struct frame *f, struct image *img));
217e5be0
JR
9493static int xbm_load_image P_ ((struct frame *f, struct image *img,
9494 char *, char *));
6fc2811b 9495static int xbm_image_p P_ ((Lisp_Object object));
217e5be0
JR
9496static int xbm_read_bitmap_data P_ ((char *, char *, int *, int *,
9497 unsigned char **));
9498static int xbm_file_p P_ ((Lisp_Object));
6fc2811b
JR
9499
9500
9501/* Indices of image specification fields in xbm_format, below. */
9502
9503enum xbm_keyword_index
9504{
9505 XBM_TYPE,
9506 XBM_FILE,
9507 XBM_WIDTH,
9508 XBM_HEIGHT,
9509 XBM_DATA,
9510 XBM_FOREGROUND,
9511 XBM_BACKGROUND,
9512 XBM_ASCENT,
9513 XBM_MARGIN,
9514 XBM_RELIEF,
9515 XBM_ALGORITHM,
9516 XBM_HEURISTIC_MASK,
a05e2bae 9517 XBM_MASK,
6fc2811b
JR
9518 XBM_LAST
9519};
9520
9521/* Vector of image_keyword structures describing the format
9522 of valid XBM image specifications. */
9523
9524static struct image_keyword xbm_format[XBM_LAST] =
9525{
9526 {":type", IMAGE_SYMBOL_VALUE, 1},
9527 {":file", IMAGE_STRING_VALUE, 0},
9528 {":width", IMAGE_POSITIVE_INTEGER_VALUE, 0},
9529 {":height", IMAGE_POSITIVE_INTEGER_VALUE, 0},
9530 {":data", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
217e5be0
JR
9531 {":foreground", IMAGE_STRING_OR_NIL_VALUE, 0},
9532 {":background", IMAGE_STRING_OR_NIL_VALUE, 0},
9533 {":ascent", IMAGE_ASCENT_VALUE, 0},
8edb0a6f 9534 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
6fc2811b 9535 {":relief", IMAGE_INTEGER_VALUE, 0},
a93f4566 9536 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
217e5be0
JR
9537 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
9538 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
6fc2811b
JR
9539};
9540
9541/* Structure describing the image type XBM. */
9542
9543static struct image_type xbm_type =
9544{
9545 &Qxbm,
9546 xbm_image_p,
9547 xbm_load,
9548 x_clear_image,
9549 NULL
9550};
9551
9552/* Tokens returned from xbm_scan. */
9553
9554enum xbm_token
9555{
9556 XBM_TK_IDENT = 256,
9557 XBM_TK_NUMBER
9558};
9559
9560
9561/* Return non-zero if OBJECT is a valid XBM-type image specification.
9562 A valid specification is a list starting with the symbol `image'
9563 The rest of the list is a property list which must contain an
9564 entry `:type xbm..
9565
9566 If the specification specifies a file to load, it must contain
9567 an entry `:file FILENAME' where FILENAME is a string.
9568
9569 If the specification is for a bitmap loaded from memory it must
9570 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
9571 WIDTH and HEIGHT are integers > 0. DATA may be:
9572
9573 1. a string large enough to hold the bitmap data, i.e. it must
9574 have a size >= (WIDTH + 7) / 8 * HEIGHT
9575
9576 2. a bool-vector of size >= WIDTH * HEIGHT
9577
9578 3. a vector of strings or bool-vectors, one for each line of the
9579 bitmap.
9580
217e5be0
JR
9581 4. A string containing an in-memory XBM file. WIDTH and HEIGHT
9582 may not be specified in this case because they are defined in the
9583 XBM file.
9584
6fc2811b
JR
9585 Both the file and data forms may contain the additional entries
9586 `:background COLOR' and `:foreground COLOR'. If not present,
9587 foreground and background of the frame on which the image is
217e5be0 9588 displayed is used. */
6fc2811b
JR
9589
9590static int
9591xbm_image_p (object)
9592 Lisp_Object object;
9593{
9594 struct image_keyword kw[XBM_LAST];
9595
9596 bcopy (xbm_format, kw, sizeof kw);
9597 if (!parse_image_spec (object, kw, XBM_LAST, Qxbm))
9598 return 0;
9599
9600 xassert (EQ (kw[XBM_TYPE].value, Qxbm));
9601
9602 if (kw[XBM_FILE].count)
9603 {
9604 if (kw[XBM_WIDTH].count || kw[XBM_HEIGHT].count || kw[XBM_DATA].count)
9605 return 0;
9606 }
217e5be0
JR
9607 else if (kw[XBM_DATA].count && xbm_file_p (kw[XBM_DATA].value))
9608 {
9609 /* In-memory XBM file. */
9610 if (kw[XBM_WIDTH].count || kw[XBM_HEIGHT].count || kw[XBM_FILE].count)
9611 return 0;
9612 }
6fc2811b
JR
9613 else
9614 {
9615 Lisp_Object data;
9616 int width, height;
9617
9618 /* Entries for `:width', `:height' and `:data' must be present. */
9619 if (!kw[XBM_WIDTH].count
9620 || !kw[XBM_HEIGHT].count
9621 || !kw[XBM_DATA].count)
9622 return 0;
9623
9624 data = kw[XBM_DATA].value;
9625 width = XFASTINT (kw[XBM_WIDTH].value);
9626 height = XFASTINT (kw[XBM_HEIGHT].value);
9627
9628 /* Check type of data, and width and height against contents of
9629 data. */
9630 if (VECTORP (data))
9631 {
9632 int i;
9633
9634 /* Number of elements of the vector must be >= height. */
9635 if (XVECTOR (data)->size < height)
9636 return 0;
9637
9638 /* Each string or bool-vector in data must be large enough
9639 for one line of the image. */
9640 for (i = 0; i < height; ++i)
9641 {
9642 Lisp_Object elt = XVECTOR (data)->contents[i];
9643
9644 if (STRINGP (elt))
9645 {
d5db4077 9646 if (SCHARS (elt)
6fc2811b
JR
9647 < (width + BITS_PER_CHAR - 1) / BITS_PER_CHAR)
9648 return 0;
9649 }
9650 else if (BOOL_VECTOR_P (elt))
9651 {
9652 if (XBOOL_VECTOR (elt)->size < width)
9653 return 0;
9654 }
9655 else
9656 return 0;
9657 }
9658 }
9659 else if (STRINGP (data))
9660 {
d5db4077 9661 if (SCHARS (data)
6fc2811b
JR
9662 < (width + BITS_PER_CHAR - 1) / BITS_PER_CHAR * height)
9663 return 0;
9664 }
9665 else if (BOOL_VECTOR_P (data))
9666 {
9667 if (XBOOL_VECTOR (data)->size < width * height)
9668 return 0;
9669 }
9670 else
9671 return 0;
9672 }
9673
6fc2811b
JR
9674 return 1;
9675}
9676
9677
9678/* Scan a bitmap file. FP is the stream to read from. Value is
9679 either an enumerator from enum xbm_token, or a character for a
9680 single-character token, or 0 at end of file. If scanning an
9681 identifier, store the lexeme of the identifier in SVAL. If
9682 scanning a number, store its value in *IVAL. */
9683
9684static int
3cf3436e
JR
9685xbm_scan (s, end, sval, ival)
9686 char **s, *end;
6fc2811b
JR
9687 char *sval;
9688 int *ival;
9689{
9690 int c;
3cf3436e
JR
9691
9692 loop:
9693
6fc2811b 9694 /* Skip white space. */
af3f7be7 9695 while (*s < end && (c = *(*s)++, isspace (c)))
6fc2811b
JR
9696 ;
9697
3cf3436e 9698 if (*s >= end)
6fc2811b
JR
9699 c = 0;
9700 else if (isdigit (c))
9701 {
9702 int value = 0, digit;
9703
3cf3436e 9704 if (c == '0' && *s < end)
6fc2811b 9705 {
3cf3436e 9706 c = *(*s)++;
6fc2811b
JR
9707 if (c == 'x' || c == 'X')
9708 {
3cf3436e 9709 while (*s < end)
6fc2811b 9710 {
3cf3436e 9711 c = *(*s)++;
6fc2811b
JR
9712 if (isdigit (c))
9713 digit = c - '0';
9714 else if (c >= 'a' && c <= 'f')
9715 digit = c - 'a' + 10;
9716 else if (c >= 'A' && c <= 'F')
9717 digit = c - 'A' + 10;
9718 else
9719 break;
9720 value = 16 * value + digit;
9721 }
9722 }
9723 else if (isdigit (c))
9724 {
9725 value = c - '0';
3cf3436e
JR
9726 while (*s < end
9727 && (c = *(*s)++, isdigit (c)))
6fc2811b
JR
9728 value = 8 * value + c - '0';
9729 }
9730 }
9731 else
9732 {
9733 value = c - '0';
3cf3436e
JR
9734 while (*s < end
9735 && (c = *(*s)++, isdigit (c)))
6fc2811b
JR
9736 value = 10 * value + c - '0';
9737 }
9738
3cf3436e
JR
9739 if (*s < end)
9740 *s = *s - 1;
6fc2811b
JR
9741 *ival = value;
9742 c = XBM_TK_NUMBER;
9743 }
9744 else if (isalpha (c) || c == '_')
9745 {
9746 *sval++ = c;
3cf3436e
JR
9747 while (*s < end
9748 && (c = *(*s)++, (isalnum (c) || c == '_')))
6fc2811b
JR
9749 *sval++ = c;
9750 *sval = 0;
3cf3436e
JR
9751 if (*s < end)
9752 *s = *s - 1;
6fc2811b
JR
9753 c = XBM_TK_IDENT;
9754 }
3cf3436e
JR
9755 else if (c == '/' && **s == '*')
9756 {
9757 /* C-style comment. */
9758 ++*s;
9759 while (**s && (**s != '*' || *(*s + 1) != '/'))
9760 ++*s;
9761 if (**s)
9762 {
9763 *s += 2;
9764 goto loop;
9765 }
9766 }
6fc2811b
JR
9767
9768 return c;
9769}
9770
9771
217e5be0
JR
9772/* XBM bits seem to be backward within bytes compared with how
9773 Windows does things. */
9774static unsigned char reflect_byte (unsigned char orig)
9775{
9776 int i;
9777 unsigned char reflected = 0x00;
9778 for (i = 0; i < 8; i++)
9779 {
9780 if (orig & (0x01 << i))
9781 reflected |= 0x80 >> i;
9782 }
9783 return reflected;
9784}
9785
9786
af3f7be7
JR
9787/* Create a Windows bitmap from X bitmap data. */
9788static HBITMAP
9789w32_create_pixmap_from_bitmap_data (int width, int height, char *data)
9790{
9791 int i, j, w1, w2;
9792 char *bits, *p;
9793 HBITMAP bmp;
9794
9795 w1 = (width + 7) / 8; /* nb of 8bits elt in X bitmap */
9796 w2 = ((width + 15) / 16) * 2; /* nb of 16bits elt in W32 bitmap */
9797 bits = (char *) xmalloc (height * w2);
9798 bzero (bits, height * w2);
9799 for (i = 0; i < height; i++)
9800 {
9801 p = bits + i*w2;
9802 for (j = 0; j < w1; j++)
9803 *p++ = reflect_byte(*data++);
9804 }
9805 bmp = CreateBitmap (width, height, 1, 1, bits);
9806 xfree (bits);
9807
9808 return bmp;
9809}
9810
9811
6fc2811b 9812/* Replacement for XReadBitmapFileData which isn't available under old
3cf3436e
JR
9813 X versions. CONTENTS is a pointer to a buffer to parse; END is the
9814 buffer's end. Set *WIDTH and *HEIGHT to the width and height of
9815 the image. Return in *DATA the bitmap data allocated with xmalloc.
9816 Value is non-zero if successful. DATA null means just test if
9817 CONTENTS looks like an in-memory XBM file. */
6fc2811b
JR
9818
9819static int
3cf3436e
JR
9820xbm_read_bitmap_data (contents, end, width, height, data)
9821 char *contents, *end;
6fc2811b
JR
9822 int *width, *height;
9823 unsigned char **data;
9824{
3cf3436e 9825 char *s = contents;
6fc2811b
JR
9826 char buffer[BUFSIZ];
9827 int padding_p = 0;
9828 int v10 = 0;
af3f7be7 9829 int bytes_per_line, i, nbytes;
6fc2811b
JR
9830 unsigned char *p;
9831 int value;
9832 int LA1;
9833
9834#define match() \
217e5be0 9835 LA1 = xbm_scan (&s, end, buffer, &value)
6fc2811b
JR
9836
9837#define expect(TOKEN) \
9838 if (LA1 != (TOKEN)) \
9839 goto failure; \
9840 else \
9841 match ()
9842
9843#define expect_ident(IDENT) \
9844 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
9845 match (); \
9846 else \
9847 goto failure
9848
6fc2811b 9849 *width = *height = -1;
3cf3436e
JR
9850 if (data)
9851 *data = NULL;
9852 LA1 = xbm_scan (&s, end, buffer, &value);
6fc2811b
JR
9853
9854 /* Parse defines for width, height and hot-spots. */
9855 while (LA1 == '#')
9856 {
9857 match ();
9858 expect_ident ("define");
9859 expect (XBM_TK_IDENT);
9860
9861 if (LA1 == XBM_TK_NUMBER);
9862 {
9863 char *p = strrchr (buffer, '_');
9864 p = p ? p + 1 : buffer;
9865 if (strcmp (p, "width") == 0)
9866 *width = value;
9867 else if (strcmp (p, "height") == 0)
9868 *height = value;
9869 }
9870 expect (XBM_TK_NUMBER);
9871 }
9872
9873 if (*width < 0 || *height < 0)
9874 goto failure;
3cf3436e
JR
9875 else if (data == NULL)
9876 goto success;
6fc2811b
JR
9877
9878 /* Parse bits. Must start with `static'. */
9879 expect_ident ("static");
9880 if (LA1 == XBM_TK_IDENT)
9881 {
9882 if (strcmp (buffer, "unsigned") == 0)
9883 {
9884 match ();
9885 expect_ident ("char");
9886 }
9887 else if (strcmp (buffer, "short") == 0)
9888 {
9889 match ();
9890 v10 = 1;
af3f7be7
JR
9891 if (*width % 16 && *width % 16 < 9)
9892 padding_p = 1;
6fc2811b
JR
9893 }
9894 else if (strcmp (buffer, "char") == 0)
9895 match ();
9896 else
9897 goto failure;
9898 }
9899 else
9900 goto failure;
9901
9902 expect (XBM_TK_IDENT);
9903 expect ('[');
9904 expect (']');
9905 expect ('=');
9906 expect ('{');
9907
af3f7be7
JR
9908 bytes_per_line = (*width + 7) / 8 + padding_p;
9909 nbytes = bytes_per_line * *height;
9910 p = *data = (char *) xmalloc (nbytes);
6fc2811b
JR
9911
9912 if (v10)
9913 {
6fc2811b
JR
9914 for (i = 0; i < nbytes; i += 2)
9915 {
9916 int val = value;
9917 expect (XBM_TK_NUMBER);
9918
af3f7be7
JR
9919 *p++ = val;
9920 if (!padding_p || ((i + 2) % bytes_per_line))
9921 *p++ = value >> 8;
6fc2811b
JR
9922
9923 if (LA1 == ',' || LA1 == '}')
9924 match ();
9925 else
9926 goto failure;
9927 }
9928 }
9929 else
9930 {
9931 for (i = 0; i < nbytes; ++i)
9932 {
9933 int val = value;
9934 expect (XBM_TK_NUMBER);
9935
af3f7be7 9936 *p++ = val;
217e5be0 9937
6fc2811b
JR
9938 if (LA1 == ',' || LA1 == '}')
9939 match ();
9940 else
9941 goto failure;
9942 }
9943 }
9944
3cf3436e 9945 success:
6fc2811b
JR
9946 return 1;
9947
9948 failure:
3cf3436e
JR
9949
9950 if (data && *data)
6fc2811b
JR
9951 {
9952 xfree (*data);
9953 *data = NULL;
9954 }
9955 return 0;
9956
9957#undef match
9958#undef expect
9959#undef expect_ident
9960}
9961
9962
3cf3436e
JR
9963/* Load XBM image IMG which will be displayed on frame F from buffer
9964 CONTENTS. END is the end of the buffer. Value is non-zero if
9965 successful. */
6fc2811b
JR
9966
9967static int
3cf3436e 9968xbm_load_image (f, img, contents, end)
6fc2811b
JR
9969 struct frame *f;
9970 struct image *img;
3cf3436e 9971 char *contents, *end;
6fc2811b
JR
9972{
9973 int rc;
9974 unsigned char *data;
9975 int success_p = 0;
6fc2811b 9976
3cf3436e 9977 rc = xbm_read_bitmap_data (contents, end, &img->width, &img->height, &data);
6fc2811b
JR
9978 if (rc)
9979 {
6fc2811b
JR
9980 unsigned long foreground = FRAME_FOREGROUND_PIXEL (f);
9981 unsigned long background = FRAME_BACKGROUND_PIXEL (f);
9982 Lisp_Object value;
9983
9984 xassert (img->width > 0 && img->height > 0);
9985
9986 /* Get foreground and background colors, maybe allocate colors. */
9987 value = image_spec_value (img->spec, QCforeground, NULL);
9988 if (!NILP (value))
9989 foreground = x_alloc_image_color (f, img, value, foreground);
6fc2811b
JR
9990 value = image_spec_value (img->spec, QCbackground, NULL);
9991 if (!NILP (value))
a05e2bae
JR
9992 {
9993 background = x_alloc_image_color (f, img, value, background);
9994 img->background = background;
9995 img->background_valid = 1;
9996 }
6fc2811b 9997 img->pixmap
af3f7be7 9998 = w32_create_pixmap_from_bitmap_data (img->width, img->height, data);
ac849ba4 9999
6fc2811b
JR
10000 xfree (data);
10001
10002 if (img->pixmap == 0)
10003 {
10004 x_clear_image (f, img);
3cf3436e 10005 image_error ("Unable to create X pixmap for `%s'", img->spec, Qnil);
6fc2811b
JR
10006 }
10007 else
10008 success_p = 1;
6fc2811b
JR
10009 }
10010 else
10011 image_error ("Error loading XBM image `%s'", img->spec, Qnil);
10012
6fc2811b
JR
10013 return success_p;
10014}
10015
10016
3cf3436e
JR
10017/* Value is non-zero if DATA looks like an in-memory XBM file. */
10018
10019static int
10020xbm_file_p (data)
10021 Lisp_Object data;
10022{
10023 int w, h;
10024 return (STRINGP (data)
d5db4077
KR
10025 && xbm_read_bitmap_data (SDATA (data),
10026 (SDATA (data)
10027 + SBYTES (data)),
3cf3436e
JR
10028 &w, &h, NULL));
10029}
10030
10031
6fc2811b
JR
10032/* Fill image IMG which is used on frame F with pixmap data. Value is
10033 non-zero if successful. */
10034
10035static int
10036xbm_load (f, img)
10037 struct frame *f;
10038 struct image *img;
10039{
10040 int success_p = 0;
10041 Lisp_Object file_name;
10042
10043 xassert (xbm_image_p (img->spec));
10044
10045 /* If IMG->spec specifies a file name, create a non-file spec from it. */
10046 file_name = image_spec_value (img->spec, QCfile, NULL);
10047 if (STRINGP (file_name))
3cf3436e
JR
10048 {
10049 Lisp_Object file;
10050 char *contents;
10051 int size;
10052 struct gcpro gcpro1;
10053
10054 file = x_find_image_file (file_name);
10055 GCPRO1 (file);
10056 if (!STRINGP (file))
10057 {
10058 image_error ("Cannot find image file `%s'", file_name, Qnil);
10059 UNGCPRO;
10060 return 0;
10061 }
10062
d5db4077 10063 contents = slurp_file (SDATA (file), &size);
3cf3436e
JR
10064 if (contents == NULL)
10065 {
10066 image_error ("Error loading XBM image `%s'", img->spec, Qnil);
10067 UNGCPRO;
10068 return 0;
10069 }
10070
10071 success_p = xbm_load_image (f, img, contents, contents + size);
10072 UNGCPRO;
10073 }
6fc2811b
JR
10074 else
10075 {
10076 struct image_keyword fmt[XBM_LAST];
10077 Lisp_Object data;
10078 int depth;
10079 unsigned long foreground = FRAME_FOREGROUND_PIXEL (f);
10080 unsigned long background = FRAME_BACKGROUND_PIXEL (f);
10081 char *bits;
10082 int parsed_p;
3cf3436e
JR
10083 int in_memory_file_p = 0;
10084
10085 /* See if data looks like an in-memory XBM file. */
10086 data = image_spec_value (img->spec, QCdata, NULL);
10087 in_memory_file_p = xbm_file_p (data);
6fc2811b 10088
217e5be0 10089 /* Parse the image specification. */
6fc2811b
JR
10090 bcopy (xbm_format, fmt, sizeof fmt);
10091 parsed_p = parse_image_spec (img->spec, fmt, XBM_LAST, Qxbm);
10092 xassert (parsed_p);
10093
10094 /* Get specified width, and height. */
3cf3436e
JR
10095 if (!in_memory_file_p)
10096 {
10097 img->width = XFASTINT (fmt[XBM_WIDTH].value);
10098 img->height = XFASTINT (fmt[XBM_HEIGHT].value);
10099 xassert (img->width > 0 && img->height > 0);
10100 }
217e5be0 10101
6fc2811b 10102 /* Get foreground and background colors, maybe allocate colors. */
3cf3436e
JR
10103 if (fmt[XBM_FOREGROUND].count
10104 && STRINGP (fmt[XBM_FOREGROUND].value))
6fc2811b
JR
10105 foreground = x_alloc_image_color (f, img, fmt[XBM_FOREGROUND].value,
10106 foreground);
3cf3436e
JR
10107 if (fmt[XBM_BACKGROUND].count
10108 && STRINGP (fmt[XBM_BACKGROUND].value))
6fc2811b
JR
10109 background = x_alloc_image_color (f, img, fmt[XBM_BACKGROUND].value,
10110 background);
10111
3cf3436e 10112 if (in_memory_file_p)
d5db4077
KR
10113 success_p = xbm_load_image (f, img, SDATA (data),
10114 (SDATA (data)
10115 + SBYTES (data)));
3cf3436e 10116 else
6fc2811b 10117 {
3cf3436e
JR
10118 if (VECTORP (data))
10119 {
10120 int i;
10121 char *p;
10122 int nbytes = (img->width + BITS_PER_CHAR - 1) / BITS_PER_CHAR;
6fc2811b 10123
3cf3436e
JR
10124 p = bits = (char *) alloca (nbytes * img->height);
10125 for (i = 0; i < img->height; ++i, p += nbytes)
10126 {
10127 Lisp_Object line = XVECTOR (data)->contents[i];
10128 if (STRINGP (line))
d5db4077 10129 bcopy (SDATA (line), p, nbytes);
3cf3436e
JR
10130 else
10131 bcopy (XBOOL_VECTOR (line)->data, p, nbytes);
10132 }
10133 }
10134 else if (STRINGP (data))
d5db4077 10135 bits = SDATA (data);
3cf3436e
JR
10136 else
10137 bits = XBOOL_VECTOR (data)->data;
af3f7be7 10138
3cf3436e 10139 /* Create the pixmap. */
a05e2bae 10140 depth = one_w32_display_info.n_cbits;
3cf3436e 10141 img->pixmap
af3f7be7
JR
10142 = w32_create_pixmap_from_bitmap_data (img->width, img->height,
10143 bits);
10144
3cf3436e
JR
10145 if (img->pixmap)
10146 success_p = 1;
10147 else
6fc2811b 10148 {
3cf3436e
JR
10149 image_error ("Unable to create pixmap for XBM image `%s'",
10150 img->spec, Qnil);
10151 x_clear_image (f, img);
6fc2811b
JR
10152 }
10153 }
6fc2811b
JR
10154 }
10155
10156 return success_p;
10157}
10158
10159
10160\f
10161/***********************************************************************
10162 XPM images
10163 ***********************************************************************/
10164
10165#if HAVE_XPM
10166
10167static int xpm_image_p P_ ((Lisp_Object object));
10168static int xpm_load P_ ((struct frame *f, struct image *img));
10169static int xpm_valid_color_symbols_p P_ ((Lisp_Object));
10170
10171#include "X11/xpm.h"
10172
10173/* The symbol `xpm' identifying XPM-format images. */
10174
10175Lisp_Object Qxpm;
10176
10177/* Indices of image specification fields in xpm_format, below. */
10178
10179enum xpm_keyword_index
10180{
10181 XPM_TYPE,
10182 XPM_FILE,
10183 XPM_DATA,
10184 XPM_ASCENT,
10185 XPM_MARGIN,
10186 XPM_RELIEF,
10187 XPM_ALGORITHM,
10188 XPM_HEURISTIC_MASK,
a05e2bae 10189 XPM_MASK,
6fc2811b 10190 XPM_COLOR_SYMBOLS,
a05e2bae 10191 XPM_BACKGROUND,
6fc2811b
JR
10192 XPM_LAST
10193};
10194
10195/* Vector of image_keyword structures describing the format
10196 of valid XPM image specifications. */
10197
10198static struct image_keyword xpm_format[XPM_LAST] =
10199{
10200 {":type", IMAGE_SYMBOL_VALUE, 1},
10201 {":file", IMAGE_STRING_VALUE, 0},
10202 {":data", IMAGE_STRING_VALUE, 0},
10203 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
8edb0a6f 10204 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
6fc2811b 10205 {":relief", IMAGE_INTEGER_VALUE, 0},
a93f4566 10206 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6fc2811b 10207 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
a05e2bae
JR
10208 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
10209 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
10210 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
6fc2811b
JR
10211};
10212
10213/* Structure describing the image type XBM. */
10214
10215static struct image_type xpm_type =
10216{
10217 &Qxpm,
10218 xpm_image_p,
10219 xpm_load,
10220 x_clear_image,
10221 NULL
10222};
10223
10224
10225/* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
10226 for XPM images. Such a list must consist of conses whose car and
10227 cdr are strings. */
10228
10229static int
10230xpm_valid_color_symbols_p (color_symbols)
10231 Lisp_Object color_symbols;
10232{
10233 while (CONSP (color_symbols))
10234 {
10235 Lisp_Object sym = XCAR (color_symbols);
10236 if (!CONSP (sym)
10237 || !STRINGP (XCAR (sym))
10238 || !STRINGP (XCDR (sym)))
10239 break;
10240 color_symbols = XCDR (color_symbols);
10241 }
10242
10243 return NILP (color_symbols);
10244}
10245
10246
10247/* Value is non-zero if OBJECT is a valid XPM image specification. */
10248
10249static int
10250xpm_image_p (object)
10251 Lisp_Object object;
10252{
10253 struct image_keyword fmt[XPM_LAST];
10254 bcopy (xpm_format, fmt, sizeof fmt);
10255 return (parse_image_spec (object, fmt, XPM_LAST, Qxpm)
10256 /* Either `:file' or `:data' must be present. */
10257 && fmt[XPM_FILE].count + fmt[XPM_DATA].count == 1
10258 /* Either no `:color-symbols' or it's a list of conses
10259 whose car and cdr are strings. */
10260 && (fmt[XPM_COLOR_SYMBOLS].count == 0
10261 || xpm_valid_color_symbols_p (fmt[XPM_COLOR_SYMBOLS].value))
10262 && (fmt[XPM_ASCENT].count == 0
10263 || XFASTINT (fmt[XPM_ASCENT].value) < 100));
10264}
10265
10266
10267/* Load image IMG which will be displayed on frame F. Value is
10268 non-zero if successful. */
10269
10270static int
10271xpm_load (f, img)
10272 struct frame *f;
10273 struct image *img;
10274{
10275 int rc, i;
10276 XpmAttributes attrs;
10277 Lisp_Object specified_file, color_symbols;
10278
10279 /* Configure the XPM lib. Use the visual of frame F. Allocate
10280 close colors. Return colors allocated. */
10281 bzero (&attrs, sizeof attrs);
dfff8a69
JR
10282 attrs.visual = FRAME_X_VISUAL (f);
10283 attrs.colormap = FRAME_X_COLORMAP (f);
6fc2811b 10284 attrs.valuemask |= XpmVisual;
dfff8a69 10285 attrs.valuemask |= XpmColormap;
6fc2811b 10286 attrs.valuemask |= XpmReturnAllocPixels;
dfff8a69 10287#ifdef XpmAllocCloseColors
6fc2811b
JR
10288 attrs.alloc_close_colors = 1;
10289 attrs.valuemask |= XpmAllocCloseColors;
dfff8a69
JR
10290#else
10291 attrs.closeness = 600;
10292 attrs.valuemask |= XpmCloseness;
10293#endif
6fc2811b
JR
10294
10295 /* If image specification contains symbolic color definitions, add
10296 these to `attrs'. */
10297 color_symbols = image_spec_value (img->spec, QCcolor_symbols, NULL);
10298 if (CONSP (color_symbols))
10299 {
10300 Lisp_Object tail;
10301 XpmColorSymbol *xpm_syms;
10302 int i, size;
10303
10304 attrs.valuemask |= XpmColorSymbols;
10305
10306 /* Count number of symbols. */
10307 attrs.numsymbols = 0;
10308 for (tail = color_symbols; CONSP (tail); tail = XCDR (tail))
10309 ++attrs.numsymbols;
10310
10311 /* Allocate an XpmColorSymbol array. */
10312 size = attrs.numsymbols * sizeof *xpm_syms;
10313 xpm_syms = (XpmColorSymbol *) alloca (size);
10314 bzero (xpm_syms, size);
10315 attrs.colorsymbols = xpm_syms;
10316
10317 /* Fill the color symbol array. */
10318 for (tail = color_symbols, i = 0;
10319 CONSP (tail);
10320 ++i, tail = XCDR (tail))
10321 {
10322 Lisp_Object name = XCAR (XCAR (tail));
10323 Lisp_Object color = XCDR (XCAR (tail));
d5db4077
KR
10324 xpm_syms[i].name = (char *) alloca (SCHARS (name) + 1);
10325 strcpy (xpm_syms[i].name, SDATA (name));
10326 xpm_syms[i].value = (char *) alloca (SCHARS (color) + 1);
10327 strcpy (xpm_syms[i].value, SDATA (color));
6fc2811b
JR
10328 }
10329 }
10330
10331 /* Create a pixmap for the image, either from a file, or from a
10332 string buffer containing data in the same format as an XPM file. */
10333 BLOCK_INPUT;
10334 specified_file = image_spec_value (img->spec, QCfile, NULL);
10335 if (STRINGP (specified_file))
10336 {
10337 Lisp_Object file = x_find_image_file (specified_file);
10338 if (!STRINGP (file))
10339 {
10340 image_error ("Cannot find image file `%s'", specified_file, Qnil);
10341 UNBLOCK_INPUT;
10342 return 0;
10343 }
10344
10345 rc = XpmReadFileToPixmap (NULL, FRAME_W32_WINDOW (f),
d5db4077 10346 SDATA (file), &img->pixmap, &img->mask,
6fc2811b
JR
10347 &attrs);
10348 }
10349 else
10350 {
10351 Lisp_Object buffer = image_spec_value (img->spec, QCdata, NULL);
10352 rc = XpmCreatePixmapFromBuffer (NULL, FRAME_W32_WINDOW (f),
d5db4077 10353 SDATA (buffer),
6fc2811b
JR
10354 &img->pixmap, &img->mask,
10355 &attrs);
10356 }
10357 UNBLOCK_INPUT;
10358
10359 if (rc == XpmSuccess)
10360 {
10361 /* Remember allocated colors. */
10362 img->ncolors = attrs.nalloc_pixels;
10363 img->colors = (unsigned long *) xmalloc (img->ncolors
10364 * sizeof *img->colors);
10365 for (i = 0; i < attrs.nalloc_pixels; ++i)
10366 img->colors[i] = attrs.alloc_pixels[i];
10367
10368 img->width = attrs.width;
10369 img->height = attrs.height;
10370 xassert (img->width > 0 && img->height > 0);
10371
10372 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
10373 BLOCK_INPUT;
10374 XpmFreeAttributes (&attrs);
10375 UNBLOCK_INPUT;
10376 }
10377 else
10378 {
10379 switch (rc)
10380 {
10381 case XpmOpenFailed:
10382 image_error ("Error opening XPM file (%s)", img->spec, Qnil);
10383 break;
10384
10385 case XpmFileInvalid:
10386 image_error ("Invalid XPM file (%s)", img->spec, Qnil);
10387 break;
10388
10389 case XpmNoMemory:
10390 image_error ("Out of memory (%s)", img->spec, Qnil);
10391 break;
10392
10393 case XpmColorFailed:
10394 image_error ("Color allocation error (%s)", img->spec, Qnil);
10395 break;
10396
10397 default:
10398 image_error ("Unknown error (%s)", img->spec, Qnil);
10399 break;
10400 }
10401 }
10402
10403 return rc == XpmSuccess;
10404}
10405
10406#endif /* HAVE_XPM != 0 */
10407
10408\f
767b1ff0 10409#if 0 /* TODO : Color tables on W32. */
6fc2811b
JR
10410/***********************************************************************
10411 Color table
10412 ***********************************************************************/
10413
10414/* An entry in the color table mapping an RGB color to a pixel color. */
10415
10416struct ct_color
10417{
10418 int r, g, b;
10419 unsigned long pixel;
10420
10421 /* Next in color table collision list. */
10422 struct ct_color *next;
10423};
10424
10425/* The bucket vector size to use. Must be prime. */
10426
10427#define CT_SIZE 101
10428
10429/* Value is a hash of the RGB color given by R, G, and B. */
10430
10431#define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
10432
10433/* The color hash table. */
10434
10435struct ct_color **ct_table;
10436
10437/* Number of entries in the color table. */
10438
10439int ct_colors_allocated;
10440
10441/* Function prototypes. */
10442
10443static void init_color_table P_ ((void));
10444static void free_color_table P_ ((void));
10445static unsigned long *colors_in_color_table P_ ((int *n));
10446static unsigned long lookup_rgb_color P_ ((struct frame *f, int r, int g, int b));
10447static unsigned long lookup_pixel_color P_ ((struct frame *f, unsigned long p));
10448
10449
10450/* Initialize the color table. */
10451
10452static void
10453init_color_table ()
10454{
10455 int size = CT_SIZE * sizeof (*ct_table);
10456 ct_table = (struct ct_color **) xmalloc (size);
10457 bzero (ct_table, size);
10458 ct_colors_allocated = 0;
10459}
10460
10461
10462/* Free memory associated with the color table. */
10463
10464static void
10465free_color_table ()
10466{
10467 int i;
10468 struct ct_color *p, *next;
10469
10470 for (i = 0; i < CT_SIZE; ++i)
10471 for (p = ct_table[i]; p; p = next)
10472 {
10473 next = p->next;
10474 xfree (p);
10475 }
10476
10477 xfree (ct_table);
10478 ct_table = NULL;
10479}
10480
10481
10482/* Value is a pixel color for RGB color R, G, B on frame F. If an
10483 entry for that color already is in the color table, return the
10484 pixel color of that entry. Otherwise, allocate a new color for R,
10485 G, B, and make an entry in the color table. */
10486
10487static unsigned long
10488lookup_rgb_color (f, r, g, b)
10489 struct frame *f;
10490 int r, g, b;
10491{
10492 unsigned hash = CT_HASH_RGB (r, g, b);
10493 int i = hash % CT_SIZE;
10494 struct ct_color *p;
10495
10496 for (p = ct_table[i]; p; p = p->next)
10497 if (p->r == r && p->g == g && p->b == b)
10498 break;
10499
10500 if (p == NULL)
10501 {
10502 COLORREF color;
10503 Colormap cmap;
10504 int rc;
10505
10506 color = PALETTERGB (r, g, b);
10507
10508 ++ct_colors_allocated;
10509
10510 p = (struct ct_color *) xmalloc (sizeof *p);
10511 p->r = r;
10512 p->g = g;
10513 p->b = b;
10514 p->pixel = color;
10515 p->next = ct_table[i];
10516 ct_table[i] = p;
10517 }
10518
10519 return p->pixel;
10520}
10521
10522
10523/* Look up pixel color PIXEL which is used on frame F in the color
10524 table. If not already present, allocate it. Value is PIXEL. */
10525
10526static unsigned long
10527lookup_pixel_color (f, pixel)
10528 struct frame *f;
10529 unsigned long pixel;
10530{
10531 int i = pixel % CT_SIZE;
10532 struct ct_color *p;
10533
10534 for (p = ct_table[i]; p; p = p->next)
10535 if (p->pixel == pixel)
10536 break;
10537
10538 if (p == NULL)
10539 {
10540 XColor color;
10541 Colormap cmap;
10542 int rc;
10543
10544 BLOCK_INPUT;
10545
10546 cmap = DefaultColormapOfScreen (FRAME_X_SCREEN (f));
10547 color.pixel = pixel;
10548 XQueryColor (NULL, cmap, &color);
10549 rc = x_alloc_nearest_color (f, cmap, &color);
10550 UNBLOCK_INPUT;
10551
10552 if (rc)
10553 {
10554 ++ct_colors_allocated;
10555
10556 p = (struct ct_color *) xmalloc (sizeof *p);
10557 p->r = color.red;
10558 p->g = color.green;
10559 p->b = color.blue;
10560 p->pixel = pixel;
10561 p->next = ct_table[i];
10562 ct_table[i] = p;
10563 }
10564 else
10565 return FRAME_FOREGROUND_PIXEL (f);
10566 }
10567 return p->pixel;
10568}
10569
10570
10571/* Value is a vector of all pixel colors contained in the color table,
10572 allocated via xmalloc. Set *N to the number of colors. */
10573
10574static unsigned long *
10575colors_in_color_table (n)
10576 int *n;
10577{
10578 int i, j;
10579 struct ct_color *p;
10580 unsigned long *colors;
10581
10582 if (ct_colors_allocated == 0)
10583 {
10584 *n = 0;
10585 colors = NULL;
10586 }
10587 else
10588 {
10589 colors = (unsigned long *) xmalloc (ct_colors_allocated
10590 * sizeof *colors);
10591 *n = ct_colors_allocated;
10592
10593 for (i = j = 0; i < CT_SIZE; ++i)
10594 for (p = ct_table[i]; p; p = p->next)
10595 colors[j++] = p->pixel;
10596 }
10597
10598 return colors;
10599}
10600
767b1ff0 10601#endif /* TODO */
6fc2811b
JR
10602
10603\f
10604/***********************************************************************
10605 Algorithms
10606 ***********************************************************************/
3cf3436e
JR
10607static XColor *x_to_xcolors P_ ((struct frame *, struct image *, int));
10608static void x_from_xcolors P_ ((struct frame *, struct image *, XColor *));
10609static void x_detect_edges P_ ((struct frame *, struct image *, int[9], int));
ac849ba4 10610static void XPutPixel (XImage *, int, int, COLORREF);
3cf3436e
JR
10611
10612/* Non-zero means draw a cross on images having `:conversion
10613 disabled'. */
6fc2811b 10614
3cf3436e 10615int cross_disabled_images;
6fc2811b 10616
3cf3436e
JR
10617/* Edge detection matrices for different edge-detection
10618 strategies. */
6fc2811b 10619
3cf3436e
JR
10620static int emboss_matrix[9] = {
10621 /* x - 1 x x + 1 */
10622 2, -1, 0, /* y - 1 */
10623 -1, 0, 1, /* y */
10624 0, 1, -2 /* y + 1 */
10625};
10626
10627static int laplace_matrix[9] = {
10628 /* x - 1 x x + 1 */
10629 1, 0, 0, /* y - 1 */
10630 0, 0, 0, /* y */
10631 0, 0, -1 /* y + 1 */
10632};
10633
10634/* Value is the intensity of the color whose red/green/blue values
10635 are R, G, and B. */
10636
10637#define COLOR_INTENSITY(R, G, B) ((2 * (R) + 3 * (G) + (B)) / 6)
10638
10639
10640/* On frame F, return an array of XColor structures describing image
10641 IMG->pixmap. Each XColor structure has its pixel color set. RGB_P
10642 non-zero means also fill the red/green/blue members of the XColor
10643 structures. Value is a pointer to the array of XColors structures,
10644 allocated with xmalloc; it must be freed by the caller. */
10645
10646static XColor *
10647x_to_xcolors (f, img, rgb_p)
10648 struct frame *f;
10649 struct image *img;
10650 int rgb_p;
10651{
10652 int x, y;
10653 XColor *colors, *p;
10654 XImage *ximg;
10655
10656 colors = (XColor *) xmalloc (img->width * img->height * sizeof *colors);
ac849ba4 10657#if 0 /* TODO: implement image colors. */
3cf3436e
JR
10658 /* Get the X image IMG->pixmap. */
10659 ximg = XGetImage (FRAME_X_DISPLAY (f), img->pixmap,
10660 0, 0, img->width, img->height, ~0, ZPixmap);
10661
10662 /* Fill the `pixel' members of the XColor array. I wished there
10663 were an easy and portable way to circumvent XGetPixel. */
10664 p = colors;
10665 for (y = 0; y < img->height; ++y)
10666 {
10667 XColor *row = p;
10668
10669 for (x = 0; x < img->width; ++x, ++p)
10670 p->pixel = XGetPixel (ximg, x, y);
10671
10672 if (rgb_p)
10673 x_query_colors (f, row, img->width);
10674 }
10675
10676 XDestroyImage (ximg);
ac849ba4 10677#endif
3cf3436e
JR
10678 return colors;
10679}
10680
ac849ba4
JR
10681/* Put a pixel of COLOR at position X, Y in XIMG. XIMG must have been
10682 created with CreateDIBSection, with the pointer to the bit values
10683 stored in ximg->data. */
10684
10685static void XPutPixel (ximg, x, y, color)
10686 XImage * ximg;
10687 int x, y;
10688 COLORREF color;
10689{
10690 int width = ximg->info.bmiHeader.biWidth;
10691 int height = ximg->info.bmiHeader.biHeight;
10692 int rowbytes = width * 3;
10693 unsigned char * pixel;
10694
10695 /* Don't support putting pixels in images with palettes. */
10696 xassert (ximg->info.bmiHeader.biBitCount == 24);
10697
10698 /* Ensure scanlines are aligned on 4 byte boundaries. */
10699 if (rowbytes % 4)
10700 rowbytes += 4 - (rowbytes % 4);
10701
10702 pixel = ximg->data + y * rowbytes + x * 3;
10703 *pixel = 255 - GetRValue (color);
10704 *(pixel + 1) = 255 - GetGValue (color);
10705 *(pixel + 2) = 255 - GetBValue (color);
10706}
10707
3cf3436e
JR
10708
10709/* Create IMG->pixmap from an array COLORS of XColor structures, whose
10710 RGB members are set. F is the frame on which this all happens.
10711 COLORS will be freed; an existing IMG->pixmap will be freed, too. */
6fc2811b
JR
10712
10713static void
3cf3436e 10714x_from_xcolors (f, img, colors)
6fc2811b 10715 struct frame *f;
3cf3436e 10716 struct image *img;
6fc2811b 10717 XColor *colors;
6fc2811b 10718{
3cf3436e
JR
10719 int x, y;
10720 XImage *oimg;
10721 Pixmap pixmap;
10722 XColor *p;
ac849ba4 10723#if 0 /* TODO: color tables. */
3cf3436e 10724 init_color_table ();
ac849ba4 10725#endif
3cf3436e
JR
10726 x_create_x_image_and_pixmap (f, img->width, img->height, 0,
10727 &oimg, &pixmap);
10728 p = colors;
10729 for (y = 0; y < img->height; ++y)
10730 for (x = 0; x < img->width; ++x, ++p)
10731 {
10732 unsigned long pixel;
ac849ba4 10733#if 0 /* TODO: color tables. */
3cf3436e 10734 pixel = lookup_rgb_color (f, p->red, p->green, p->blue);
ac849ba4
JR
10735#else
10736 pixel = PALETTERGB (p->red, p->green, p->blue);
10737#endif
3cf3436e
JR
10738 XPutPixel (oimg, x, y, pixel);
10739 }
6fc2811b 10740
3cf3436e
JR
10741 xfree (colors);
10742 x_clear_image_1 (f, img, 1, 0, 1);
6fc2811b 10743
3cf3436e
JR
10744 x_put_x_image (f, oimg, pixmap, img->width, img->height);
10745 x_destroy_x_image (oimg);
10746 img->pixmap = pixmap;
ac849ba4 10747#if 0 /* TODO: color tables. */
3cf3436e
JR
10748 img->colors = colors_in_color_table (&img->ncolors);
10749 free_color_table ();
ac849ba4 10750#endif
6fc2811b
JR
10751}
10752
10753
3cf3436e
JR
10754/* On frame F, perform edge-detection on image IMG.
10755
10756 MATRIX is a nine-element array specifying the transformation
10757 matrix. See emboss_matrix for an example.
10758
10759 COLOR_ADJUST is a color adjustment added to each pixel of the
10760 outgoing image. */
6fc2811b
JR
10761
10762static void
3cf3436e 10763x_detect_edges (f, img, matrix, color_adjust)
6fc2811b 10764 struct frame *f;
3cf3436e
JR
10765 struct image *img;
10766 int matrix[9], color_adjust;
6fc2811b 10767{
3cf3436e
JR
10768 XColor *colors = x_to_xcolors (f, img, 1);
10769 XColor *new, *p;
10770 int x, y, i, sum;
10771
10772 for (i = sum = 0; i < 9; ++i)
10773 sum += abs (matrix[i]);
10774
10775#define COLOR(A, X, Y) ((A) + (Y) * img->width + (X))
10776
10777 new = (XColor *) xmalloc (img->width * img->height * sizeof *new);
10778
10779 for (y = 0; y < img->height; ++y)
10780 {
10781 p = COLOR (new, 0, y);
10782 p->red = p->green = p->blue = 0xffff/2;
10783 p = COLOR (new, img->width - 1, y);
10784 p->red = p->green = p->blue = 0xffff/2;
10785 }
6fc2811b 10786
3cf3436e
JR
10787 for (x = 1; x < img->width - 1; ++x)
10788 {
10789 p = COLOR (new, x, 0);
10790 p->red = p->green = p->blue = 0xffff/2;
10791 p = COLOR (new, x, img->height - 1);
10792 p->red = p->green = p->blue = 0xffff/2;
10793 }
10794
10795 for (y = 1; y < img->height - 1; ++y)
10796 {
10797 p = COLOR (new, 1, y);
10798
10799 for (x = 1; x < img->width - 1; ++x, ++p)
10800 {
10801 int r, g, b, y1, x1;
10802
10803 r = g = b = i = 0;
10804 for (y1 = y - 1; y1 < y + 2; ++y1)
10805 for (x1 = x - 1; x1 < x + 2; ++x1, ++i)
10806 if (matrix[i])
10807 {
10808 XColor *t = COLOR (colors, x1, y1);
10809 r += matrix[i] * t->red;
10810 g += matrix[i] * t->green;
10811 b += matrix[i] * t->blue;
10812 }
10813
10814 r = (r / sum + color_adjust) & 0xffff;
10815 g = (g / sum + color_adjust) & 0xffff;
10816 b = (b / sum + color_adjust) & 0xffff;
10817 p->red = p->green = p->blue = COLOR_INTENSITY (r, g, b);
10818 }
10819 }
10820
10821 xfree (colors);
10822 x_from_xcolors (f, img, new);
10823
10824#undef COLOR
10825}
10826
10827
10828/* Perform the pre-defined `emboss' edge-detection on image IMG
10829 on frame F. */
10830
10831static void
10832x_emboss (f, img)
10833 struct frame *f;
10834 struct image *img;
10835{
10836 x_detect_edges (f, img, emboss_matrix, 0xffff / 2);
6fc2811b 10837}
3cf3436e 10838
6fc2811b
JR
10839
10840/* Transform image IMG which is used on frame F with a Laplace
10841 edge-detection algorithm. The result is an image that can be used
10842 to draw disabled buttons, for example. */
10843
10844static void
10845x_laplace (f, img)
10846 struct frame *f;
10847 struct image *img;
10848{
3cf3436e
JR
10849 x_detect_edges (f, img, laplace_matrix, 45000);
10850}
6fc2811b 10851
6fc2811b 10852
3cf3436e
JR
10853/* Perform edge-detection on image IMG on frame F, with specified
10854 transformation matrix MATRIX and color-adjustment COLOR_ADJUST.
6fc2811b 10855
3cf3436e 10856 MATRIX must be either
6fc2811b 10857
3cf3436e
JR
10858 - a list of at least 9 numbers in row-major form
10859 - a vector of at least 9 numbers
6fc2811b 10860
3cf3436e
JR
10861 COLOR_ADJUST nil means use a default; otherwise it must be a
10862 number. */
6fc2811b 10863
3cf3436e
JR
10864static void
10865x_edge_detection (f, img, matrix, color_adjust)
10866 struct frame *f;
10867 struct image *img;
10868 Lisp_Object matrix, color_adjust;
10869{
10870 int i = 0;
10871 int trans[9];
10872
10873 if (CONSP (matrix))
6fc2811b 10874 {
3cf3436e
JR
10875 for (i = 0;
10876 i < 9 && CONSP (matrix) && NUMBERP (XCAR (matrix));
10877 ++i, matrix = XCDR (matrix))
10878 trans[i] = XFLOATINT (XCAR (matrix));
10879 }
10880 else if (VECTORP (matrix) && ASIZE (matrix) >= 9)
10881 {
10882 for (i = 0; i < 9 && NUMBERP (AREF (matrix, i)); ++i)
10883 trans[i] = XFLOATINT (AREF (matrix, i));
10884 }
10885
10886 if (NILP (color_adjust))
10887 color_adjust = make_number (0xffff / 2);
10888
10889 if (i == 9 && NUMBERP (color_adjust))
10890 x_detect_edges (f, img, trans, (int) XFLOATINT (color_adjust));
10891}
10892
6fc2811b 10893
3cf3436e 10894/* Transform image IMG on frame F so that it looks disabled. */
6fc2811b 10895
3cf3436e
JR
10896static void
10897x_disable_image (f, img)
10898 struct frame *f;
10899 struct image *img;
10900{
ac849ba4 10901 struct w32_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
3cf3436e 10902
ac849ba4 10903 if (dpyinfo->n_planes * dpyinfo->n_cbits >= 2)
3cf3436e
JR
10904 {
10905 /* Color (or grayscale). Convert to gray, and equalize. Just
10906 drawing such images with a stipple can look very odd, so
10907 we're using this method instead. */
10908 XColor *colors = x_to_xcolors (f, img, 1);
10909 XColor *p, *end;
10910 const int h = 15000;
10911 const int l = 30000;
10912
10913 for (p = colors, end = colors + img->width * img->height;
10914 p < end;
10915 ++p)
6fc2811b 10916 {
3cf3436e
JR
10917 int i = COLOR_INTENSITY (p->red, p->green, p->blue);
10918 int i2 = (0xffff - h - l) * i / 0xffff + l;
10919 p->red = p->green = p->blue = i2;
6fc2811b
JR
10920 }
10921
3cf3436e 10922 x_from_xcolors (f, img, colors);
6fc2811b
JR
10923 }
10924
3cf3436e
JR
10925 /* Draw a cross over the disabled image, if we must or if we
10926 should. */
ac849ba4 10927 if (dpyinfo->n_planes * dpyinfo->n_cbits < 2 || cross_disabled_images)
3cf3436e 10928 {
ac849ba4 10929#if 0 /* TODO: full image support */
3cf3436e
JR
10930 Display *dpy = FRAME_X_DISPLAY (f);
10931 GC gc;
6fc2811b 10932
3cf3436e
JR
10933 gc = XCreateGC (dpy, img->pixmap, 0, NULL);
10934 XSetForeground (dpy, gc, BLACK_PIX_DEFAULT (f));
10935 XDrawLine (dpy, img->pixmap, gc, 0, 0,
10936 img->width - 1, img->height - 1);
10937 XDrawLine (dpy, img->pixmap, gc, 0, img->height - 1,
10938 img->width - 1, 0);
10939 XFreeGC (dpy, gc);
6fc2811b 10940
3cf3436e
JR
10941 if (img->mask)
10942 {
10943 gc = XCreateGC (dpy, img->mask, 0, NULL);
10944 XSetForeground (dpy, gc, WHITE_PIX_DEFAULT (f));
10945 XDrawLine (dpy, img->mask, gc, 0, 0,
10946 img->width - 1, img->height - 1);
10947 XDrawLine (dpy, img->mask, gc, 0, img->height - 1,
10948 img->width - 1, 0);
10949 XFreeGC (dpy, gc);
10950 }
ac849ba4 10951#endif
3cf3436e 10952 }
6fc2811b
JR
10953}
10954
10955
10956/* Build a mask for image IMG which is used on frame F. FILE is the
10957 name of an image file, for error messages. HOW determines how to
10958 determine the background color of IMG. If it is a list '(R G B)',
10959 with R, G, and B being integers >= 0, take that as the color of the
10960 background. Otherwise, determine the background color of IMG
10961 heuristically. Value is non-zero if successful. */
10962
10963static int
10964x_build_heuristic_mask (f, img, how)
10965 struct frame *f;
10966 struct image *img;
10967 Lisp_Object how;
10968{
ac849ba4 10969#if 0 /* TODO: full image support. */
6fc2811b
JR
10970 Display *dpy = FRAME_W32_DISPLAY (f);
10971 XImage *ximg, *mask_img;
a05e2bae
JR
10972 int x, y, rc, use_img_background;
10973 unsigned long bg = 0;
10974
10975 if (img->mask)
10976 {
10977 XFreePixmap (FRAME_X_DISPLAY (f), img->mask);
10978 img->mask = None;
10979 img->background_transparent_valid = 0;
10980 }
6fc2811b 10981
6fc2811b
JR
10982 /* Create an image and pixmap serving as mask. */
10983 rc = x_create_x_image_and_pixmap (f, img->width, img->height, 1,
10984 &mask_img, &img->mask);
10985 if (!rc)
a05e2bae 10986 return 0;
6fc2811b
JR
10987
10988 /* Get the X image of IMG->pixmap. */
10989 ximg = XGetImage (dpy, img->pixmap, 0, 0, img->width, img->height,
10990 ~0, ZPixmap);
10991
10992 /* Determine the background color of ximg. If HOW is `(R G B)'
a05e2bae
JR
10993 take that as color. Otherwise, use the image's background color. */
10994 use_img_background = 1;
6fc2811b
JR
10995
10996 if (CONSP (how))
10997 {
a05e2bae 10998 int rgb[3], i;
6fc2811b 10999
a05e2bae 11000 for (i = 0; i < 3 && CONSP (how) && NATNUMP (XCAR (how)); ++i)
6fc2811b
JR
11001 {
11002 rgb[i] = XFASTINT (XCAR (how)) & 0xffff;
11003 how = XCDR (how);
11004 }
11005
11006 if (i == 3 && NILP (how))
11007 {
11008 char color_name[30];
6fc2811b 11009 sprintf (color_name, "#%04x%04x%04x", rgb[0], rgb[1], rgb[2]);
a05e2bae
JR
11010 bg = x_alloc_image_color (f, img, build_string (color_name), 0);
11011 use_img_background = 0;
6fc2811b
JR
11012 }
11013 }
11014
a05e2bae
JR
11015 if (use_img_background)
11016 bg = four_corners_best (ximg, img->width, img->height);
6fc2811b
JR
11017
11018 /* Set all bits in mask_img to 1 whose color in ximg is different
11019 from the background color bg. */
11020 for (y = 0; y < img->height; ++y)
11021 for (x = 0; x < img->width; ++x)
11022 XPutPixel (mask_img, x, y, XGetPixel (ximg, x, y) != bg);
11023
a05e2bae
JR
11024 /* Fill in the background_transparent field while we have the mask handy. */
11025 image_background_transparent (img, f, mask_img);
11026
6fc2811b
JR
11027 /* Put mask_img into img->mask. */
11028 x_put_x_image (f, mask_img, img->mask, img->width, img->height);
11029 x_destroy_x_image (mask_img);
11030 XDestroyImage (ximg);
6fc2811b
JR
11031
11032 return 1;
ac849ba4
JR
11033#else
11034 return 0;
11035#endif
6fc2811b 11036}
217e5be0 11037
6fc2811b
JR
11038\f
11039/***********************************************************************
11040 PBM (mono, gray, color)
11041 ***********************************************************************/
6fc2811b
JR
11042
11043static int pbm_image_p P_ ((Lisp_Object object));
11044static int pbm_load P_ ((struct frame *f, struct image *img));
11045static int pbm_scan_number P_ ((unsigned char **, unsigned char *));
11046
11047/* The symbol `pbm' identifying images of this type. */
11048
11049Lisp_Object Qpbm;
11050
11051/* Indices of image specification fields in gs_format, below. */
11052
11053enum pbm_keyword_index
11054{
11055 PBM_TYPE,
11056 PBM_FILE,
11057 PBM_DATA,
11058 PBM_ASCENT,
11059 PBM_MARGIN,
11060 PBM_RELIEF,
11061 PBM_ALGORITHM,
11062 PBM_HEURISTIC_MASK,
a05e2bae
JR
11063 PBM_MASK,
11064 PBM_FOREGROUND,
11065 PBM_BACKGROUND,
6fc2811b
JR
11066 PBM_LAST
11067};
11068
11069/* Vector of image_keyword structures describing the format
11070 of valid user-defined image specifications. */
11071
11072static struct image_keyword pbm_format[PBM_LAST] =
11073{
11074 {":type", IMAGE_SYMBOL_VALUE, 1},
11075 {":file", IMAGE_STRING_VALUE, 0},
11076 {":data", IMAGE_STRING_VALUE, 0},
11077 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
8edb0a6f 11078 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
6fc2811b 11079 {":relief", IMAGE_INTEGER_VALUE, 0},
a93f4566 11080 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
3cf3436e
JR
11081 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
11082 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
11083 {":foreground", IMAGE_STRING_OR_NIL_VALUE, 0},
11084 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
6fc2811b
JR
11085};
11086
11087/* Structure describing the image type `pbm'. */
11088
11089static struct image_type pbm_type =
11090{
11091 &Qpbm,
11092 pbm_image_p,
11093 pbm_load,
11094 x_clear_image,
11095 NULL
11096};
11097
11098
11099/* Return non-zero if OBJECT is a valid PBM image specification. */
11100
11101static int
11102pbm_image_p (object)
11103 Lisp_Object object;
11104{
11105 struct image_keyword fmt[PBM_LAST];
11106
11107 bcopy (pbm_format, fmt, sizeof fmt);
11108
11109 if (!parse_image_spec (object, fmt, PBM_LAST, Qpbm)
11110 || (fmt[PBM_ASCENT].count
11111 && XFASTINT (fmt[PBM_ASCENT].value) > 100))
11112 return 0;
11113
11114 /* Must specify either :data or :file. */
11115 return fmt[PBM_DATA].count + fmt[PBM_FILE].count == 1;
11116}
11117
11118
11119/* Scan a decimal number from *S and return it. Advance *S while
11120 reading the number. END is the end of the string. Value is -1 at
11121 end of input. */
11122
11123static int
11124pbm_scan_number (s, end)
11125 unsigned char **s, *end;
11126{
11127 int c, val = -1;
11128
11129 while (*s < end)
11130 {
11131 /* Skip white-space. */
11132 while (*s < end && (c = *(*s)++, isspace (c)))
11133 ;
11134
11135 if (c == '#')
11136 {
11137 /* Skip comment to end of line. */
11138 while (*s < end && (c = *(*s)++, c != '\n'))
11139 ;
11140 }
11141 else if (isdigit (c))
11142 {
11143 /* Read decimal number. */
11144 val = c - '0';
11145 while (*s < end && (c = *(*s)++, isdigit (c)))
11146 val = 10 * val + c - '0';
11147 break;
11148 }
11149 else
11150 break;
11151 }
11152
11153 return val;
11154}
11155
11156
11157/* Read FILE into memory. Value is a pointer to a buffer allocated
11158 with xmalloc holding FILE's contents. Value is null if an error
6f826971 11159 occurred. *SIZE is set to the size of the file. */
6fc2811b
JR
11160
11161static char *
11162pbm_read_file (file, size)
11163 Lisp_Object file;
11164 int *size;
11165{
11166 FILE *fp = NULL;
11167 char *buf = NULL;
11168 struct stat st;
11169
d5db4077
KR
11170 if (stat (SDATA (file), &st) == 0
11171 && (fp = fopen (SDATA (file), "r")) != NULL
6fc2811b
JR
11172 && (buf = (char *) xmalloc (st.st_size),
11173 fread (buf, 1, st.st_size, fp) == st.st_size))
11174 {
11175 *size = st.st_size;
11176 fclose (fp);
11177 }
11178 else
11179 {
11180 if (fp)
11181 fclose (fp);
11182 if (buf)
11183 {
11184 xfree (buf);
11185 buf = NULL;
11186 }
11187 }
11188
11189 return buf;
11190}
11191
11192
11193/* Load PBM image IMG for use on frame F. */
11194
11195static int
11196pbm_load (f, img)
11197 struct frame *f;
11198 struct image *img;
11199{
11200 int raw_p, x, y;
11201 int width, height, max_color_idx = 0;
11202 XImage *ximg;
11203 Lisp_Object file, specified_file;
11204 enum {PBM_MONO, PBM_GRAY, PBM_COLOR} type;
11205 struct gcpro gcpro1;
11206 unsigned char *contents = NULL;
11207 unsigned char *end, *p;
11208 int size;
11209
11210 specified_file = image_spec_value (img->spec, QCfile, NULL);
11211 file = Qnil;
11212 GCPRO1 (file);
11213
11214 if (STRINGP (specified_file))
11215 {
11216 file = x_find_image_file (specified_file);
11217 if (!STRINGP (file))
11218 {
11219 image_error ("Cannot find image file `%s'", specified_file, Qnil);
11220 UNGCPRO;
11221 return 0;
11222 }
11223
d5db4077 11224 contents = slurp_file (SDATA (file), &size);
6fc2811b
JR
11225 if (contents == NULL)
11226 {
11227 image_error ("Error reading `%s'", file, Qnil);
11228 UNGCPRO;
11229 return 0;
11230 }
11231
11232 p = contents;
11233 end = contents + size;
11234 }
11235 else
11236 {
11237 Lisp_Object data;
11238 data = image_spec_value (img->spec, QCdata, NULL);
d5db4077
KR
11239 p = SDATA (data);
11240 end = p + SBYTES (data);
6fc2811b
JR
11241 }
11242
11243 /* Check magic number. */
11244 if (end - p < 2 || *p++ != 'P')
11245 {
11246 image_error ("Not a PBM image: `%s'", img->spec, Qnil);
11247 error:
11248 xfree (contents);
11249 UNGCPRO;
11250 return 0;
11251 }
11252
6fc2811b
JR
11253 switch (*p++)
11254 {
11255 case '1':
11256 raw_p = 0, type = PBM_MONO;
11257 break;
11258
11259 case '2':
11260 raw_p = 0, type = PBM_GRAY;
11261 break;
11262
11263 case '3':
11264 raw_p = 0, type = PBM_COLOR;
11265 break;
11266
11267 case '4':
11268 raw_p = 1, type = PBM_MONO;
11269 break;
11270
11271 case '5':
11272 raw_p = 1, type = PBM_GRAY;
11273 break;
11274
11275 case '6':
11276 raw_p = 1, type = PBM_COLOR;
11277 break;
11278
11279 default:
11280 image_error ("Not a PBM image: `%s'", img->spec, Qnil);
11281 goto error;
11282 }
11283
11284 /* Read width, height, maximum color-component. Characters
11285 starting with `#' up to the end of a line are ignored. */
11286 width = pbm_scan_number (&p, end);
11287 height = pbm_scan_number (&p, end);
11288
11289 if (type != PBM_MONO)
11290 {
11291 max_color_idx = pbm_scan_number (&p, end);
11292 if (raw_p && max_color_idx > 255)
11293 max_color_idx = 255;
11294 }
11295
11296 if (width < 0
11297 || height < 0
11298 || (type != PBM_MONO && max_color_idx < 0))
11299 goto error;
11300
ac849ba4 11301 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg, &img->pixmap))
3cf3436e
JR
11302 goto error;
11303
ac849ba4 11304#if 0 /* TODO: color tables. */
6fc2811b
JR
11305 /* Initialize the color hash table. */
11306 init_color_table ();
ac849ba4 11307#endif
6fc2811b
JR
11308
11309 if (type == PBM_MONO)
11310 {
11311 int c = 0, g;
3cf3436e
JR
11312 struct image_keyword fmt[PBM_LAST];
11313 unsigned long fg = FRAME_FOREGROUND_PIXEL (f);
11314 unsigned long bg = FRAME_BACKGROUND_PIXEL (f);
11315
11316 /* Parse the image specification. */
11317 bcopy (pbm_format, fmt, sizeof fmt);
11318 parse_image_spec (img->spec, fmt, PBM_LAST, Qpbm);
11319
11320 /* Get foreground and background colors, maybe allocate colors. */
11321 if (fmt[PBM_FOREGROUND].count
11322 && STRINGP (fmt[PBM_FOREGROUND].value))
11323 fg = x_alloc_image_color (f, img, fmt[PBM_FOREGROUND].value, fg);
11324 if (fmt[PBM_BACKGROUND].count
11325 && STRINGP (fmt[PBM_BACKGROUND].value))
a05e2bae
JR
11326 {
11327 bg = x_alloc_image_color (f, img, fmt[PBM_BACKGROUND].value, bg);
11328 img->background = bg;
11329 img->background_valid = 1;
11330 }
11331
6fc2811b
JR
11332 for (y = 0; y < height; ++y)
11333 for (x = 0; x < width; ++x)
11334 {
11335 if (raw_p)
11336 {
11337 if ((x & 7) == 0)
11338 c = *p++;
11339 g = c & 0x80;
11340 c <<= 1;
11341 }
11342 else
11343 g = pbm_scan_number (&p, end);
11344
3cf3436e 11345 XPutPixel (ximg, x, y, g ? fg : bg);
6fc2811b
JR
11346 }
11347 }
11348 else
11349 {
11350 for (y = 0; y < height; ++y)
11351 for (x = 0; x < width; ++x)
11352 {
11353 int r, g, b;
11354
11355 if (type == PBM_GRAY)
11356 r = g = b = raw_p ? *p++ : pbm_scan_number (&p, end);
11357 else if (raw_p)
11358 {
11359 r = *p++;
11360 g = *p++;
11361 b = *p++;
11362 }
11363 else
11364 {
11365 r = pbm_scan_number (&p, end);
11366 g = pbm_scan_number (&p, end);
11367 b = pbm_scan_number (&p, end);
11368 }
11369
11370 if (r < 0 || g < 0 || b < 0)
11371 {
ac849ba4 11372 x_destroy_x_image (ximg);
6fc2811b
JR
11373 image_error ("Invalid pixel value in image `%s'",
11374 img->spec, Qnil);
11375 goto error;
11376 }
11377
11378 /* RGB values are now in the range 0..max_color_idx.
ac849ba4
JR
11379 Scale this to the range 0..0xff supported by W32. */
11380 r = (int) ((double) r * 255 / max_color_idx);
11381 g = (int) ((double) g * 255 / max_color_idx);
11382 b = (int) ((double) b * 255 / max_color_idx);
11383 XPutPixel (ximg, x, y,
11384#if 0 /* TODO: color tables. */
11385 lookup_rgb_color (f, r, g, b));
11386#else
11387 PALETTERGB (r, g, b));
11388#endif
6fc2811b
JR
11389 }
11390 }
ac849ba4
JR
11391
11392#if 0 /* TODO: color tables. */
6fc2811b
JR
11393 /* Store in IMG->colors the colors allocated for the image, and
11394 free the color table. */
11395 img->colors = colors_in_color_table (&img->ncolors);
11396 free_color_table ();
ac849ba4 11397#endif
a05e2bae
JR
11398 /* Maybe fill in the background field while we have ximg handy. */
11399 if (NILP (image_spec_value (img->spec, QCbackground, NULL)))
11400 IMAGE_BACKGROUND (img, f, ximg);
11401
6fc2811b
JR
11402 /* Put the image into a pixmap. */
11403 x_put_x_image (f, ximg, img->pixmap, width, height);
11404 x_destroy_x_image (ximg);
6fc2811b
JR
11405
11406 img->width = width;
11407 img->height = height;
11408
11409 UNGCPRO;
11410 xfree (contents);
11411 return 1;
11412}
6fc2811b
JR
11413
11414\f
11415/***********************************************************************
11416 PNG
11417 ***********************************************************************/
11418
11419#if HAVE_PNG
11420
11421#include <png.h>
11422
11423/* Function prototypes. */
11424
11425static int png_image_p P_ ((Lisp_Object object));
11426static int png_load P_ ((struct frame *f, struct image *img));
11427
11428/* The symbol `png' identifying images of this type. */
11429
11430Lisp_Object Qpng;
11431
11432/* Indices of image specification fields in png_format, below. */
11433
11434enum png_keyword_index
11435{
11436 PNG_TYPE,
11437 PNG_DATA,
11438 PNG_FILE,
11439 PNG_ASCENT,
11440 PNG_MARGIN,
11441 PNG_RELIEF,
11442 PNG_ALGORITHM,
11443 PNG_HEURISTIC_MASK,
a05e2bae
JR
11444 PNG_MASK,
11445 PNG_BACKGROUND,
6fc2811b
JR
11446 PNG_LAST
11447};
11448
11449/* Vector of image_keyword structures describing the format
11450 of valid user-defined image specifications. */
11451
11452static struct image_keyword png_format[PNG_LAST] =
11453{
11454 {":type", IMAGE_SYMBOL_VALUE, 1},
11455 {":data", IMAGE_STRING_VALUE, 0},
11456 {":file", IMAGE_STRING_VALUE, 0},
11457 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
8edb0a6f 11458 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
6fc2811b 11459 {":relief", IMAGE_INTEGER_VALUE, 0},
a93f4566 11460 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
a05e2bae
JR
11461 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
11462 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
11463 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
6fc2811b
JR
11464};
11465
11466/* Structure describing the image type `png'. */
11467
11468static struct image_type png_type =
11469{
11470 &Qpng,
11471 png_image_p,
11472 png_load,
11473 x_clear_image,
11474 NULL
11475};
11476
11477
11478/* Return non-zero if OBJECT is a valid PNG image specification. */
11479
11480static int
11481png_image_p (object)
11482 Lisp_Object object;
11483{
11484 struct image_keyword fmt[PNG_LAST];
11485 bcopy (png_format, fmt, sizeof fmt);
11486
11487 if (!parse_image_spec (object, fmt, PNG_LAST, Qpng)
11488 || (fmt[PNG_ASCENT].count
11489 && XFASTINT (fmt[PNG_ASCENT].value) > 100))
11490 return 0;
11491
11492 /* Must specify either the :data or :file keyword. */
11493 return fmt[PNG_FILE].count + fmt[PNG_DATA].count == 1;
11494}
11495
11496
11497/* Error and warning handlers installed when the PNG library
11498 is initialized. */
11499
11500static void
11501my_png_error (png_ptr, msg)
11502 png_struct *png_ptr;
11503 char *msg;
11504{
11505 xassert (png_ptr != NULL);
11506 image_error ("PNG error: %s", build_string (msg), Qnil);
11507 longjmp (png_ptr->jmpbuf, 1);
11508}
11509
11510
11511static void
11512my_png_warning (png_ptr, msg)
11513 png_struct *png_ptr;
11514 char *msg;
11515{
11516 xassert (png_ptr != NULL);
11517 image_error ("PNG warning: %s", build_string (msg), Qnil);
11518}
11519
6fc2811b
JR
11520/* Memory source for PNG decoding. */
11521
11522struct png_memory_storage
11523{
11524 unsigned char *bytes; /* The data */
11525 size_t len; /* How big is it? */
11526 int index; /* Where are we? */
11527};
11528
11529
11530/* Function set as reader function when reading PNG image from memory.
11531 PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
11532 bytes from the input to DATA. */
11533
11534static void
11535png_read_from_memory (png_ptr, data, length)
11536 png_structp png_ptr;
11537 png_bytep data;
11538 png_size_t length;
11539{
11540 struct png_memory_storage *tbr
11541 = (struct png_memory_storage *) png_get_io_ptr (png_ptr);
11542
11543 if (length > tbr->len - tbr->index)
11544 png_error (png_ptr, "Read error");
11545
11546 bcopy (tbr->bytes + tbr->index, data, length);
11547 tbr->index = tbr->index + length;
11548}
11549
6fc2811b
JR
11550/* Load PNG image IMG for use on frame F. Value is non-zero if
11551 successful. */
11552
11553static int
11554png_load (f, img)
11555 struct frame *f;
11556 struct image *img;
11557{
11558 Lisp_Object file, specified_file;
11559 Lisp_Object specified_data;
11560 int x, y, i;
11561 XImage *ximg, *mask_img = NULL;
11562 struct gcpro gcpro1;
11563 png_struct *png_ptr = NULL;
11564 png_info *info_ptr = NULL, *end_info = NULL;
a05e2bae 11565 FILE *volatile fp = NULL;
6fc2811b 11566 png_byte sig[8];
a05e2bae
JR
11567 png_byte *volatile pixels = NULL;
11568 png_byte **volatile rows = NULL;
6fc2811b
JR
11569 png_uint_32 width, height;
11570 int bit_depth, color_type, interlace_type;
11571 png_byte channels;
11572 png_uint_32 row_bytes;
11573 int transparent_p;
11574 char *gamma_str;
11575 double screen_gamma, image_gamma;
11576 int intent;
11577 struct png_memory_storage tbr; /* Data to be read */
11578
11579 /* Find out what file to load. */
11580 specified_file = image_spec_value (img->spec, QCfile, NULL);
11581 specified_data = image_spec_value (img->spec, QCdata, NULL);
11582 file = Qnil;
11583 GCPRO1 (file);
11584
11585 if (NILP (specified_data))
11586 {
11587 file = x_find_image_file (specified_file);
11588 if (!STRINGP (file))
11589 {
11590 image_error ("Cannot find image file `%s'", specified_file, Qnil);
11591 UNGCPRO;
11592 return 0;
11593 }
11594
11595 /* Open the image file. */
d5db4077 11596 fp = fopen (SDATA (file), "rb");
6fc2811b
JR
11597 if (!fp)
11598 {
11599 image_error ("Cannot open image file `%s'", file, Qnil);
11600 UNGCPRO;
11601 fclose (fp);
11602 return 0;
11603 }
11604
11605 /* Check PNG signature. */
11606 if (fread (sig, 1, sizeof sig, fp) != sizeof sig
11607 || !png_check_sig (sig, sizeof sig))
11608 {
11609 image_error ("Not a PNG file:` %s'", file, Qnil);
11610 UNGCPRO;
11611 fclose (fp);
11612 return 0;
11613 }
11614 }
11615 else
11616 {
11617 /* Read from memory. */
d5db4077
KR
11618 tbr.bytes = SDATA (specified_data);
11619 tbr.len = SBYTES (specified_data);
6fc2811b
JR
11620 tbr.index = 0;
11621
11622 /* Check PNG signature. */
11623 if (tbr.len < sizeof sig
11624 || !png_check_sig (tbr.bytes, sizeof sig))
11625 {
11626 image_error ("Not a PNG image: `%s'", img->spec, Qnil);
11627 UNGCPRO;
11628 return 0;
11629 }
11630
11631 /* Need to skip past the signature. */
11632 tbr.bytes += sizeof (sig);
11633 }
11634
6fc2811b
JR
11635 /* Initialize read and info structs for PNG lib. */
11636 png_ptr = png_create_read_struct (PNG_LIBPNG_VER_STRING, NULL,
11637 my_png_error, my_png_warning);
11638 if (!png_ptr)
11639 {
11640 if (fp) fclose (fp);
11641 UNGCPRO;
11642 return 0;
11643 }
11644
11645 info_ptr = png_create_info_struct (png_ptr);
11646 if (!info_ptr)
11647 {
11648 png_destroy_read_struct (&png_ptr, NULL, NULL);
11649 if (fp) fclose (fp);
11650 UNGCPRO;
11651 return 0;
11652 }
11653
11654 end_info = png_create_info_struct (png_ptr);
11655 if (!end_info)
11656 {
11657 png_destroy_read_struct (&png_ptr, &info_ptr, NULL);
11658 if (fp) fclose (fp);
11659 UNGCPRO;
11660 return 0;
11661 }
11662
11663 /* Set error jump-back. We come back here when the PNG library
11664 detects an error. */
11665 if (setjmp (png_ptr->jmpbuf))
11666 {
11667 error:
11668 if (png_ptr)
11669 png_destroy_read_struct (&png_ptr, &info_ptr, &end_info);
11670 xfree (pixels);
11671 xfree (rows);
11672 if (fp) fclose (fp);
11673 UNGCPRO;
11674 return 0;
11675 }
11676
11677 /* Read image info. */
11678 if (!NILP (specified_data))
11679 png_set_read_fn (png_ptr, (void *) &tbr, png_read_from_memory);
11680 else
11681 png_init_io (png_ptr, fp);
11682
11683 png_set_sig_bytes (png_ptr, sizeof sig);
11684 png_read_info (png_ptr, info_ptr);
11685 png_get_IHDR (png_ptr, info_ptr, &width, &height, &bit_depth, &color_type,
11686 &interlace_type, NULL, NULL);
11687
11688 /* If image contains simply transparency data, we prefer to
11689 construct a clipping mask. */
11690 if (png_get_valid (png_ptr, info_ptr, PNG_INFO_tRNS))
11691 transparent_p = 1;
11692 else
11693 transparent_p = 0;
11694
11695 /* This function is easier to write if we only have to handle
11696 one data format: RGB or RGBA with 8 bits per channel. Let's
11697 transform other formats into that format. */
11698
11699 /* Strip more than 8 bits per channel. */
11700 if (bit_depth == 16)
11701 png_set_strip_16 (png_ptr);
11702
11703 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
11704 if available. */
11705 png_set_expand (png_ptr);
11706
11707 /* Convert grayscale images to RGB. */
11708 if (color_type == PNG_COLOR_TYPE_GRAY
11709 || color_type == PNG_COLOR_TYPE_GRAY_ALPHA)
11710 png_set_gray_to_rgb (png_ptr);
11711
11712 /* The value 2.2 is a guess for PC monitors from PNG example.c. */
11713 gamma_str = getenv ("SCREEN_GAMMA");
11714 screen_gamma = gamma_str ? atof (gamma_str) : 2.2;
11715
11716 /* Tell the PNG lib to handle gamma correction for us. */
11717
11718#if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
11719 if (png_get_sRGB (png_ptr, info_ptr, &intent))
11720 /* There is a special chunk in the image specifying the gamma. */
11721 png_set_sRGB (png_ptr, info_ptr, intent);
11722 else
11723#endif
11724 if (png_get_gAMA (png_ptr, info_ptr, &image_gamma))
11725 /* Image contains gamma information. */
11726 png_set_gamma (png_ptr, screen_gamma, image_gamma);
11727 else
11728 /* Use a default of 0.5 for the image gamma. */
11729 png_set_gamma (png_ptr, screen_gamma, 0.5);
11730
11731 /* Handle alpha channel by combining the image with a background
11732 color. Do this only if a real alpha channel is supplied. For
11733 simple transparency, we prefer a clipping mask. */
11734 if (!transparent_p)
11735 {
11736 png_color_16 *image_background;
a05e2bae
JR
11737 Lisp_Object specified_bg
11738 = image_spec_value (img->spec, QCbackground, NULL);
11739
11740
11741 if (STRINGP (specified_bg))
11742 /* The user specified `:background', use that. */
11743 {
11744 COLORREF color;
d5db4077 11745 if (w32_defined_color (f, SDATA (specified_bg), &color, 0))
a05e2bae
JR
11746 {
11747 png_color_16 user_bg;
11748
11749 bzero (&user_bg, sizeof user_bg);
11750 user_bg.red = color.red;
11751 user_bg.green = color.green;
11752 user_bg.blue = color.blue;
6fc2811b 11753
a05e2bae
JR
11754 png_set_background (png_ptr, &user_bg,
11755 PNG_BACKGROUND_GAMMA_SCREEN, 0, 1.0);
11756 }
11757 }
11758 else if (png_get_bKGD (png_ptr, info_ptr, &image_background))
6fc2811b
JR
11759 /* Image contains a background color with which to
11760 combine the image. */
11761 png_set_background (png_ptr, image_background,
11762 PNG_BACKGROUND_GAMMA_FILE, 1, 1.0);
11763 else
11764 {
11765 /* Image does not contain a background color with which
11766 to combine the image data via an alpha channel. Use
11767 the frame's background instead. */
11768 XColor color;
11769 Colormap cmap;
11770 png_color_16 frame_background;
11771
a05e2bae 11772 cmap = FRAME_X_COLORMAP (f);
6fc2811b 11773 color.pixel = FRAME_BACKGROUND_PIXEL (f);
a05e2bae 11774 x_query_color (f, &color);
6fc2811b
JR
11775
11776 bzero (&frame_background, sizeof frame_background);
11777 frame_background.red = color.red;
11778 frame_background.green = color.green;
11779 frame_background.blue = color.blue;
11780
11781 png_set_background (png_ptr, &frame_background,
11782 PNG_BACKGROUND_GAMMA_SCREEN, 0, 1.0);
11783 }
11784 }
11785
11786 /* Update info structure. */
11787 png_read_update_info (png_ptr, info_ptr);
11788
11789 /* Get number of channels. Valid values are 1 for grayscale images
11790 and images with a palette, 2 for grayscale images with transparency
11791 information (alpha channel), 3 for RGB images, and 4 for RGB
11792 images with alpha channel, i.e. RGBA. If conversions above were
11793 sufficient we should only have 3 or 4 channels here. */
11794 channels = png_get_channels (png_ptr, info_ptr);
11795 xassert (channels == 3 || channels == 4);
11796
11797 /* Number of bytes needed for one row of the image. */
11798 row_bytes = png_get_rowbytes (png_ptr, info_ptr);
11799
11800 /* Allocate memory for the image. */
11801 pixels = (png_byte *) xmalloc (row_bytes * height * sizeof *pixels);
11802 rows = (png_byte **) xmalloc (height * sizeof *rows);
11803 for (i = 0; i < height; ++i)
11804 rows[i] = pixels + i * row_bytes;
11805
11806 /* Read the entire image. */
11807 png_read_image (png_ptr, rows);
11808 png_read_end (png_ptr, info_ptr);
11809 if (fp)
11810 {
11811 fclose (fp);
11812 fp = NULL;
11813 }
11814
6fc2811b
JR
11815 /* Create the X image and pixmap. */
11816 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg,
11817 &img->pixmap))
a05e2bae 11818 goto error;
6fc2811b
JR
11819
11820 /* Create an image and pixmap serving as mask if the PNG image
11821 contains an alpha channel. */
11822 if (channels == 4
11823 && !transparent_p
11824 && !x_create_x_image_and_pixmap (f, width, height, 1,
11825 &mask_img, &img->mask))
11826 {
11827 x_destroy_x_image (ximg);
11828 XFreePixmap (FRAME_W32_DISPLAY (f), img->pixmap);
11829 img->pixmap = 0;
6fc2811b
JR
11830 goto error;
11831 }
11832
11833 /* Fill the X image and mask from PNG data. */
11834 init_color_table ();
11835
11836 for (y = 0; y < height; ++y)
11837 {
11838 png_byte *p = rows[y];
11839
11840 for (x = 0; x < width; ++x)
11841 {
11842 unsigned r, g, b;
11843
11844 r = *p++ << 8;
11845 g = *p++ << 8;
11846 b = *p++ << 8;
11847 XPutPixel (ximg, x, y, lookup_rgb_color (f, r, g, b));
11848
11849 /* An alpha channel, aka mask channel, associates variable
11850 transparency with an image. Where other image formats
11851 support binary transparency---fully transparent or fully
11852 opaque---PNG allows up to 254 levels of partial transparency.
11853 The PNG library implements partial transparency by combining
11854 the image with a specified background color.
11855
11856 I'm not sure how to handle this here nicely: because the
11857 background on which the image is displayed may change, for
11858 real alpha channel support, it would be necessary to create
11859 a new image for each possible background.
11860
11861 What I'm doing now is that a mask is created if we have
11862 boolean transparency information. Otherwise I'm using
11863 the frame's background color to combine the image with. */
11864
11865 if (channels == 4)
11866 {
11867 if (mask_img)
11868 XPutPixel (mask_img, x, y, *p > 0);
11869 ++p;
11870 }
11871 }
11872 }
11873
a05e2bae
JR
11874 if (NILP (image_spec_value (img->spec, QCbackground, NULL)))
11875 /* Set IMG's background color from the PNG image, unless the user
11876 overrode it. */
11877 {
11878 png_color_16 *bg;
11879 if (png_get_bKGD (png_ptr, info_ptr, &bg))
11880 {
11881 img->background = lookup_rgb_color (f, bg->red, bg->green, bg->blue);
11882 img->background_valid = 1;
11883 }
11884 }
11885
6fc2811b
JR
11886 /* Remember colors allocated for this image. */
11887 img->colors = colors_in_color_table (&img->ncolors);
11888 free_color_table ();
11889
11890 /* Clean up. */
11891 png_destroy_read_struct (&png_ptr, &info_ptr, &end_info);
11892 xfree (rows);
11893 xfree (pixels);
11894
11895 img->width = width;
11896 img->height = height;
11897
a05e2bae
JR
11898 /* Maybe fill in the background field while we have ximg handy. */
11899 IMAGE_BACKGROUND (img, f, ximg);
11900
6fc2811b
JR
11901 /* Put the image into the pixmap, then free the X image and its buffer. */
11902 x_put_x_image (f, ximg, img->pixmap, width, height);
11903 x_destroy_x_image (ximg);
11904
11905 /* Same for the mask. */
11906 if (mask_img)
11907 {
a05e2bae
JR
11908 /* Fill in the background_transparent field while we have the mask
11909 handy. */
11910 image_background_transparent (img, f, mask_img);
11911
6fc2811b
JR
11912 x_put_x_image (f, mask_img, img->mask, img->width, img->height);
11913 x_destroy_x_image (mask_img);
11914 }
11915
6fc2811b
JR
11916 UNGCPRO;
11917 return 1;
11918}
11919
11920#endif /* HAVE_PNG != 0 */
11921
11922
11923\f
11924/***********************************************************************
11925 JPEG
11926 ***********************************************************************/
11927
11928#if HAVE_JPEG
11929
11930/* Work around a warning about HAVE_STDLIB_H being redefined in
11931 jconfig.h. */
11932#ifdef HAVE_STDLIB_H
11933#define HAVE_STDLIB_H_1
11934#undef HAVE_STDLIB_H
11935#endif /* HAVE_STLIB_H */
11936
11937#include <jpeglib.h>
11938#include <jerror.h>
11939#include <setjmp.h>
11940
11941#ifdef HAVE_STLIB_H_1
11942#define HAVE_STDLIB_H 1
11943#endif
11944
11945static int jpeg_image_p P_ ((Lisp_Object object));
11946static int jpeg_load P_ ((struct frame *f, struct image *img));
11947
11948/* The symbol `jpeg' identifying images of this type. */
11949
11950Lisp_Object Qjpeg;
11951
11952/* Indices of image specification fields in gs_format, below. */
11953
11954enum jpeg_keyword_index
11955{
11956 JPEG_TYPE,
11957 JPEG_DATA,
11958 JPEG_FILE,
11959 JPEG_ASCENT,
11960 JPEG_MARGIN,
11961 JPEG_RELIEF,
11962 JPEG_ALGORITHM,
11963 JPEG_HEURISTIC_MASK,
a05e2bae
JR
11964 JPEG_MASK,
11965 JPEG_BACKGROUND,
6fc2811b
JR
11966 JPEG_LAST
11967};
11968
11969/* Vector of image_keyword structures describing the format
11970 of valid user-defined image specifications. */
11971
11972static struct image_keyword jpeg_format[JPEG_LAST] =
11973{
11974 {":type", IMAGE_SYMBOL_VALUE, 1},
11975 {":data", IMAGE_STRING_VALUE, 0},
11976 {":file", IMAGE_STRING_VALUE, 0},
11977 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
8edb0a6f 11978 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
6fc2811b 11979 {":relief", IMAGE_INTEGER_VALUE, 0},
a05e2bae
JR
11980 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
11981 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
11982 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
11983 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
6fc2811b
JR
11984};
11985
11986/* Structure describing the image type `jpeg'. */
11987
11988static struct image_type jpeg_type =
11989{
11990 &Qjpeg,
11991 jpeg_image_p,
11992 jpeg_load,
11993 x_clear_image,
11994 NULL
11995};
11996
11997
11998/* Return non-zero if OBJECT is a valid JPEG image specification. */
11999
12000static int
12001jpeg_image_p (object)
12002 Lisp_Object object;
12003{
12004 struct image_keyword fmt[JPEG_LAST];
12005
12006 bcopy (jpeg_format, fmt, sizeof fmt);
12007
12008 if (!parse_image_spec (object, fmt, JPEG_LAST, Qjpeg)
12009 || (fmt[JPEG_ASCENT].count
12010 && XFASTINT (fmt[JPEG_ASCENT].value) > 100))
12011 return 0;
12012
12013 /* Must specify either the :data or :file keyword. */
12014 return fmt[JPEG_FILE].count + fmt[JPEG_DATA].count == 1;
12015}
12016
12017
12018struct my_jpeg_error_mgr
12019{
12020 struct jpeg_error_mgr pub;
12021 jmp_buf setjmp_buffer;
12022};
12023
12024static void
12025my_error_exit (cinfo)
12026 j_common_ptr cinfo;
12027{
12028 struct my_jpeg_error_mgr *mgr = (struct my_jpeg_error_mgr *) cinfo->err;
12029 longjmp (mgr->setjmp_buffer, 1);
12030}
12031
6fc2811b
JR
12032/* Init source method for JPEG data source manager. Called by
12033 jpeg_read_header() before any data is actually read. See
12034 libjpeg.doc from the JPEG lib distribution. */
12035
12036static void
12037our_init_source (cinfo)
12038 j_decompress_ptr cinfo;
12039{
12040}
12041
12042
12043/* Fill input buffer method for JPEG data source manager. Called
12044 whenever more data is needed. We read the whole image in one step,
12045 so this only adds a fake end of input marker at the end. */
12046
12047static boolean
12048our_fill_input_buffer (cinfo)
12049 j_decompress_ptr cinfo;
12050{
12051 /* Insert a fake EOI marker. */
12052 struct jpeg_source_mgr *src = cinfo->src;
12053 static JOCTET buffer[2];
12054
12055 buffer[0] = (JOCTET) 0xFF;
12056 buffer[1] = (JOCTET) JPEG_EOI;
12057
12058 src->next_input_byte = buffer;
12059 src->bytes_in_buffer = 2;
12060 return TRUE;
12061}
12062
12063
12064/* Method to skip over NUM_BYTES bytes in the image data. CINFO->src
12065 is the JPEG data source manager. */
12066
12067static void
12068our_skip_input_data (cinfo, num_bytes)
12069 j_decompress_ptr cinfo;
12070 long num_bytes;
12071{
12072 struct jpeg_source_mgr *src = (struct jpeg_source_mgr *) cinfo->src;
12073
12074 if (src)
12075 {
12076 if (num_bytes > src->bytes_in_buffer)
12077 ERREXIT (cinfo, JERR_INPUT_EOF);
12078
12079 src->bytes_in_buffer -= num_bytes;
12080 src->next_input_byte += num_bytes;
12081 }
12082}
12083
12084
12085/* Method to terminate data source. Called by
12086 jpeg_finish_decompress() after all data has been processed. */
12087
12088static void
12089our_term_source (cinfo)
12090 j_decompress_ptr cinfo;
12091{
12092}
12093
12094
12095/* Set up the JPEG lib for reading an image from DATA which contains
12096 LEN bytes. CINFO is the decompression info structure created for
12097 reading the image. */
12098
12099static void
12100jpeg_memory_src (cinfo, data, len)
12101 j_decompress_ptr cinfo;
12102 JOCTET *data;
12103 unsigned int len;
12104{
12105 struct jpeg_source_mgr *src;
12106
12107 if (cinfo->src == NULL)
12108 {
12109 /* First time for this JPEG object? */
12110 cinfo->src = (struct jpeg_source_mgr *)
12111 (*cinfo->mem->alloc_small) ((j_common_ptr) cinfo, JPOOL_PERMANENT,
12112 sizeof (struct jpeg_source_mgr));
12113 src = (struct jpeg_source_mgr *) cinfo->src;
12114 src->next_input_byte = data;
12115 }
12116
12117 src = (struct jpeg_source_mgr *) cinfo->src;
12118 src->init_source = our_init_source;
12119 src->fill_input_buffer = our_fill_input_buffer;
12120 src->skip_input_data = our_skip_input_data;
12121 src->resync_to_restart = jpeg_resync_to_restart; /* Use default method. */
12122 src->term_source = our_term_source;
12123 src->bytes_in_buffer = len;
12124 src->next_input_byte = data;
12125}
12126
12127
12128/* Load image IMG for use on frame F. Patterned after example.c
12129 from the JPEG lib. */
12130
12131static int
12132jpeg_load (f, img)
12133 struct frame *f;
12134 struct image *img;
12135{
12136 struct jpeg_decompress_struct cinfo;
12137 struct my_jpeg_error_mgr mgr;
12138 Lisp_Object file, specified_file;
12139 Lisp_Object specified_data;
a05e2bae 12140 FILE * volatile fp = NULL;
6fc2811b
JR
12141 JSAMPARRAY buffer;
12142 int row_stride, x, y;
12143 XImage *ximg = NULL;
12144 int rc;
12145 unsigned long *colors;
12146 int width, height;
12147 struct gcpro gcpro1;
12148
12149 /* Open the JPEG file. */
12150 specified_file = image_spec_value (img->spec, QCfile, NULL);
12151 specified_data = image_spec_value (img->spec, QCdata, NULL);
12152 file = Qnil;
12153 GCPRO1 (file);
12154
6fc2811b
JR
12155 if (NILP (specified_data))
12156 {
12157 file = x_find_image_file (specified_file);
12158 if (!STRINGP (file))
12159 {
12160 image_error ("Cannot find image file `%s'", specified_file, Qnil);
12161 UNGCPRO;
12162 return 0;
12163 }
12164
d5db4077 12165 fp = fopen (SDATA (file), "r");
6fc2811b
JR
12166 if (fp == NULL)
12167 {
12168 image_error ("Cannot open `%s'", file, Qnil);
12169 UNGCPRO;
12170 return 0;
12171 }
12172 }
12173
12174 /* Customize libjpeg's error handling to call my_error_exit when an
12175 error is detected. This function will perform a longjmp. */
6fc2811b 12176 cinfo.err = jpeg_std_error (&mgr.pub);
a05e2bae 12177 mgr.pub.error_exit = my_error_exit;
6fc2811b
JR
12178
12179 if ((rc = setjmp (mgr.setjmp_buffer)) != 0)
12180 {
12181 if (rc == 1)
12182 {
12183 /* Called from my_error_exit. Display a JPEG error. */
12184 char buffer[JMSG_LENGTH_MAX];
12185 cinfo.err->format_message ((j_common_ptr) &cinfo, buffer);
12186 image_error ("Error reading JPEG image `%s': %s", img->spec,
12187 build_string (buffer));
12188 }
12189
12190 /* Close the input file and destroy the JPEG object. */
12191 if (fp)
12192 fclose (fp);
12193 jpeg_destroy_decompress (&cinfo);
6fc2811b
JR
12194
12195 /* If we already have an XImage, free that. */
12196 x_destroy_x_image (ximg);
12197
12198 /* Free pixmap and colors. */
12199 x_clear_image (f, img);
12200
6fc2811b
JR
12201 UNGCPRO;
12202 return 0;
12203 }
12204
12205 /* Create the JPEG decompression object. Let it read from fp.
12206 Read the JPEG image header. */
12207 jpeg_create_decompress (&cinfo);
12208
12209 if (NILP (specified_data))
12210 jpeg_stdio_src (&cinfo, fp);
12211 else
d5db4077
KR
12212 jpeg_memory_src (&cinfo, SDATA (specified_data),
12213 SBYTES (specified_data));
6fc2811b
JR
12214
12215 jpeg_read_header (&cinfo, TRUE);
12216
12217 /* Customize decompression so that color quantization will be used.
12218 Start decompression. */
12219 cinfo.quantize_colors = TRUE;
12220 jpeg_start_decompress (&cinfo);
12221 width = img->width = cinfo.output_width;
12222 height = img->height = cinfo.output_height;
12223
6fc2811b
JR
12224 /* Create X image and pixmap. */
12225 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg,
12226 &img->pixmap))
a05e2bae 12227 longjmp (mgr.setjmp_buffer, 2);
6fc2811b
JR
12228
12229 /* Allocate colors. When color quantization is used,
12230 cinfo.actual_number_of_colors has been set with the number of
12231 colors generated, and cinfo.colormap is a two-dimensional array
12232 of color indices in the range 0..cinfo.actual_number_of_colors.
12233 No more than 255 colors will be generated. */
12234 {
12235 int i, ir, ig, ib;
12236
12237 if (cinfo.out_color_components > 2)
12238 ir = 0, ig = 1, ib = 2;
12239 else if (cinfo.out_color_components > 1)
12240 ir = 0, ig = 1, ib = 0;
12241 else
12242 ir = 0, ig = 0, ib = 0;
12243
12244 /* Use the color table mechanism because it handles colors that
12245 cannot be allocated nicely. Such colors will be replaced with
12246 a default color, and we don't have to care about which colors
12247 can be freed safely, and which can't. */
12248 init_color_table ();
12249 colors = (unsigned long *) alloca (cinfo.actual_number_of_colors
12250 * sizeof *colors);
12251
12252 for (i = 0; i < cinfo.actual_number_of_colors; ++i)
12253 {
12254 /* Multiply RGB values with 255 because X expects RGB values
12255 in the range 0..0xffff. */
12256 int r = cinfo.colormap[ir][i] << 8;
12257 int g = cinfo.colormap[ig][i] << 8;
12258 int b = cinfo.colormap[ib][i] << 8;
12259 colors[i] = lookup_rgb_color (f, r, g, b);
12260 }
12261
12262 /* Remember those colors actually allocated. */
12263 img->colors = colors_in_color_table (&img->ncolors);
12264 free_color_table ();
12265 }
12266
12267 /* Read pixels. */
12268 row_stride = width * cinfo.output_components;
12269 buffer = cinfo.mem->alloc_sarray ((j_common_ptr) &cinfo, JPOOL_IMAGE,
12270 row_stride, 1);
12271 for (y = 0; y < height; ++y)
12272 {
12273 jpeg_read_scanlines (&cinfo, buffer, 1);
12274 for (x = 0; x < cinfo.output_width; ++x)
12275 XPutPixel (ximg, x, y, colors[buffer[0][x]]);
12276 }
12277
12278 /* Clean up. */
12279 jpeg_finish_decompress (&cinfo);
12280 jpeg_destroy_decompress (&cinfo);
12281 if (fp)
12282 fclose (fp);
12283
a05e2bae
JR
12284 /* Maybe fill in the background field while we have ximg handy. */
12285 if (NILP (image_spec_value (img->spec, QCbackground, NULL)))
12286 IMAGE_BACKGROUND (img, f, ximg);
12287
6fc2811b
JR
12288 /* Put the image into the pixmap. */
12289 x_put_x_image (f, ximg, img->pixmap, width, height);
12290 x_destroy_x_image (ximg);
12291 UNBLOCK_INPUT;
12292 UNGCPRO;
12293 return 1;
12294}
12295
12296#endif /* HAVE_JPEG */
12297
12298
12299\f
12300/***********************************************************************
12301 TIFF
12302 ***********************************************************************/
12303
12304#if HAVE_TIFF
12305
12306#include <tiffio.h>
12307
12308static int tiff_image_p P_ ((Lisp_Object object));
12309static int tiff_load P_ ((struct frame *f, struct image *img));
12310
12311/* The symbol `tiff' identifying images of this type. */
12312
12313Lisp_Object Qtiff;
12314
12315/* Indices of image specification fields in tiff_format, below. */
12316
12317enum tiff_keyword_index
12318{
12319 TIFF_TYPE,
12320 TIFF_DATA,
12321 TIFF_FILE,
12322 TIFF_ASCENT,
12323 TIFF_MARGIN,
12324 TIFF_RELIEF,
12325 TIFF_ALGORITHM,
12326 TIFF_HEURISTIC_MASK,
a05e2bae
JR
12327 TIFF_MASK,
12328 TIFF_BACKGROUND,
6fc2811b
JR
12329 TIFF_LAST
12330};
12331
12332/* Vector of image_keyword structures describing the format
12333 of valid user-defined image specifications. */
12334
12335static struct image_keyword tiff_format[TIFF_LAST] =
12336{
12337 {":type", IMAGE_SYMBOL_VALUE, 1},
12338 {":data", IMAGE_STRING_VALUE, 0},
12339 {":file", IMAGE_STRING_VALUE, 0},
12340 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
8edb0a6f 12341 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
6fc2811b 12342 {":relief", IMAGE_INTEGER_VALUE, 0},
a05e2bae
JR
12343 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
12344 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
12345 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
12346 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
6fc2811b
JR
12347};
12348
12349/* Structure describing the image type `tiff'. */
12350
12351static struct image_type tiff_type =
12352{
12353 &Qtiff,
12354 tiff_image_p,
12355 tiff_load,
12356 x_clear_image,
12357 NULL
12358};
12359
12360
12361/* Return non-zero if OBJECT is a valid TIFF image specification. */
12362
12363static int
12364tiff_image_p (object)
12365 Lisp_Object object;
12366{
12367 struct image_keyword fmt[TIFF_LAST];
12368 bcopy (tiff_format, fmt, sizeof fmt);
12369
12370 if (!parse_image_spec (object, fmt, TIFF_LAST, Qtiff)
12371 || (fmt[TIFF_ASCENT].count
12372 && XFASTINT (fmt[TIFF_ASCENT].value) > 100))
12373 return 0;
12374
12375 /* Must specify either the :data or :file keyword. */
12376 return fmt[TIFF_FILE].count + fmt[TIFF_DATA].count == 1;
12377}
12378
12379
12380/* Reading from a memory buffer for TIFF images Based on the PNG
12381 memory source, but we have to provide a lot of extra functions.
12382 Blah.
12383
12384 We really only need to implement read and seek, but I am not
12385 convinced that the TIFF library is smart enough not to destroy
12386 itself if we only hand it the function pointers we need to
12387 override. */
12388
12389typedef struct
12390{
12391 unsigned char *bytes;
12392 size_t len;
12393 int index;
12394}
12395tiff_memory_source;
12396
12397static size_t
12398tiff_read_from_memory (data, buf, size)
12399 thandle_t data;
12400 tdata_t buf;
12401 tsize_t size;
12402{
12403 tiff_memory_source *src = (tiff_memory_source *) data;
12404
12405 if (size > src->len - src->index)
12406 return (size_t) -1;
12407 bcopy (src->bytes + src->index, buf, size);
12408 src->index += size;
12409 return size;
12410}
12411
12412static size_t
12413tiff_write_from_memory (data, buf, size)
12414 thandle_t data;
12415 tdata_t buf;
12416 tsize_t size;
12417{
12418 return (size_t) -1;
12419}
12420
12421static toff_t
12422tiff_seek_in_memory (data, off, whence)
12423 thandle_t data;
12424 toff_t off;
12425 int whence;
12426{
12427 tiff_memory_source *src = (tiff_memory_source *) data;
12428 int idx;
12429
12430 switch (whence)
12431 {
12432 case SEEK_SET: /* Go from beginning of source. */
12433 idx = off;
12434 break;
12435
12436 case SEEK_END: /* Go from end of source. */
12437 idx = src->len + off;
12438 break;
12439
12440 case SEEK_CUR: /* Go from current position. */
12441 idx = src->index + off;
12442 break;
12443
12444 default: /* Invalid `whence'. */
12445 return -1;
12446 }
12447
12448 if (idx > src->len || idx < 0)
12449 return -1;
12450
12451 src->index = idx;
12452 return src->index;
12453}
12454
12455static int
12456tiff_close_memory (data)
12457 thandle_t data;
12458{
12459 /* NOOP */
12460 return 0;
12461}
12462
12463static int
12464tiff_mmap_memory (data, pbase, psize)
12465 thandle_t data;
12466 tdata_t *pbase;
12467 toff_t *psize;
12468{
12469 /* It is already _IN_ memory. */
12470 return 0;
12471}
12472
12473static void
12474tiff_unmap_memory (data, base, size)
12475 thandle_t data;
12476 tdata_t base;
12477 toff_t size;
12478{
12479 /* We don't need to do this. */
12480}
12481
12482static toff_t
12483tiff_size_of_memory (data)
12484 thandle_t data;
12485{
12486 return ((tiff_memory_source *) data)->len;
12487}
12488
3cf3436e
JR
12489
12490static void
12491tiff_error_handler (title, format, ap)
12492 const char *title, *format;
12493 va_list ap;
12494{
12495 char buf[512];
12496 int len;
12497
12498 len = sprintf (buf, "TIFF error: %s ", title);
12499 vsprintf (buf + len, format, ap);
12500 add_to_log (buf, Qnil, Qnil);
12501}
12502
12503
12504static void
12505tiff_warning_handler (title, format, ap)
12506 const char *title, *format;
12507 va_list ap;
12508{
12509 char buf[512];
12510 int len;
12511
12512 len = sprintf (buf, "TIFF warning: %s ", title);
12513 vsprintf (buf + len, format, ap);
12514 add_to_log (buf, Qnil, Qnil);
12515}
12516
12517
6fc2811b
JR
12518/* Load TIFF image IMG for use on frame F. Value is non-zero if
12519 successful. */
12520
12521static int
12522tiff_load (f, img)
12523 struct frame *f;
12524 struct image *img;
12525{
12526 Lisp_Object file, specified_file;
12527 Lisp_Object specified_data;
12528 TIFF *tiff;
12529 int width, height, x, y;
12530 uint32 *buf;
12531 int rc;
12532 XImage *ximg;
12533 struct gcpro gcpro1;
12534 tiff_memory_source memsrc;
12535
12536 specified_file = image_spec_value (img->spec, QCfile, NULL);
12537 specified_data = image_spec_value (img->spec, QCdata, NULL);
12538 file = Qnil;
12539 GCPRO1 (file);
12540
3cf3436e
JR
12541 TIFFSetErrorHandler (tiff_error_handler);
12542 TIFFSetWarningHandler (tiff_warning_handler);
12543
6fc2811b
JR
12544 if (NILP (specified_data))
12545 {
12546 /* Read from a file */
12547 file = x_find_image_file (specified_file);
12548 if (!STRINGP (file))
3cf3436e
JR
12549 {
12550 image_error ("Cannot find image file `%s'", file, Qnil);
12551 UNGCPRO;
12552 return 0;
12553 }
12554
6fc2811b 12555 /* Try to open the image file. */
d5db4077 12556 tiff = TIFFOpen (SDATA (file), "r");
6fc2811b 12557 if (tiff == NULL)
3cf3436e
JR
12558 {
12559 image_error ("Cannot open `%s'", file, Qnil);
12560 UNGCPRO;
12561 return 0;
12562 }
6fc2811b
JR
12563 }
12564 else
12565 {
12566 /* Memory source! */
d5db4077
KR
12567 memsrc.bytes = SDATA (specified_data);
12568 memsrc.len = SBYTES (specified_data);
6fc2811b
JR
12569 memsrc.index = 0;
12570
12571 tiff = TIFFClientOpen ("memory_source", "r", &memsrc,
12572 (TIFFReadWriteProc) tiff_read_from_memory,
12573 (TIFFReadWriteProc) tiff_write_from_memory,
12574 tiff_seek_in_memory,
12575 tiff_close_memory,
12576 tiff_size_of_memory,
12577 tiff_mmap_memory,
12578 tiff_unmap_memory);
12579
12580 if (!tiff)
12581 {
12582 image_error ("Cannot open memory source for `%s'", img->spec, Qnil);
12583 UNGCPRO;
12584 return 0;
12585 }
12586 }
12587
12588 /* Get width and height of the image, and allocate a raster buffer
12589 of width x height 32-bit values. */
12590 TIFFGetField (tiff, TIFFTAG_IMAGEWIDTH, &width);
12591 TIFFGetField (tiff, TIFFTAG_IMAGELENGTH, &height);
12592 buf = (uint32 *) xmalloc (width * height * sizeof *buf);
12593
12594 rc = TIFFReadRGBAImage (tiff, width, height, buf, 0);
12595 TIFFClose (tiff);
12596 if (!rc)
12597 {
12598 image_error ("Error reading TIFF image `%s'", img->spec, Qnil);
12599 xfree (buf);
12600 UNGCPRO;
12601 return 0;
12602 }
12603
6fc2811b
JR
12604 /* Create the X image and pixmap. */
12605 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg, &img->pixmap))
12606 {
6fc2811b
JR
12607 xfree (buf);
12608 UNGCPRO;
12609 return 0;
12610 }
12611
12612 /* Initialize the color table. */
12613 init_color_table ();
12614
12615 /* Process the pixel raster. Origin is in the lower-left corner. */
12616 for (y = 0; y < height; ++y)
12617 {
12618 uint32 *row = buf + y * width;
12619
12620 for (x = 0; x < width; ++x)
12621 {
12622 uint32 abgr = row[x];
12623 int r = TIFFGetR (abgr) << 8;
12624 int g = TIFFGetG (abgr) << 8;
12625 int b = TIFFGetB (abgr) << 8;
12626 XPutPixel (ximg, x, height - 1 - y, lookup_rgb_color (f, r, g, b));
12627 }
12628 }
12629
12630 /* Remember the colors allocated for the image. Free the color table. */
12631 img->colors = colors_in_color_table (&img->ncolors);
12632 free_color_table ();
12633
a05e2bae
JR
12634 img->width = width;
12635 img->height = height;
12636
12637 /* Maybe fill in the background field while we have ximg handy. */
12638 if (NILP (image_spec_value (img->spec, QCbackground, NULL)))
12639 IMAGE_BACKGROUND (img, f, ximg);
12640
6fc2811b
JR
12641 /* Put the image into the pixmap, then free the X image and its buffer. */
12642 x_put_x_image (f, ximg, img->pixmap, width, height);
12643 x_destroy_x_image (ximg);
12644 xfree (buf);
6fc2811b
JR
12645
12646 UNGCPRO;
12647 return 1;
12648}
12649
12650#endif /* HAVE_TIFF != 0 */
12651
12652
12653\f
12654/***********************************************************************
12655 GIF
12656 ***********************************************************************/
12657
12658#if HAVE_GIF
12659
12660#include <gif_lib.h>
12661
12662static int gif_image_p P_ ((Lisp_Object object));
12663static int gif_load P_ ((struct frame *f, struct image *img));
12664
12665/* The symbol `gif' identifying images of this type. */
12666
12667Lisp_Object Qgif;
12668
12669/* Indices of image specification fields in gif_format, below. */
12670
12671enum gif_keyword_index
12672{
12673 GIF_TYPE,
12674 GIF_DATA,
12675 GIF_FILE,
12676 GIF_ASCENT,
12677 GIF_MARGIN,
12678 GIF_RELIEF,
12679 GIF_ALGORITHM,
12680 GIF_HEURISTIC_MASK,
a05e2bae 12681 GIF_MASK,
6fc2811b 12682 GIF_IMAGE,
a05e2bae 12683 GIF_BACKGROUND,
6fc2811b
JR
12684 GIF_LAST
12685};
12686
12687/* Vector of image_keyword structures describing the format
12688 of valid user-defined image specifications. */
12689
12690static struct image_keyword gif_format[GIF_LAST] =
12691{
12692 {":type", IMAGE_SYMBOL_VALUE, 1},
12693 {":data", IMAGE_STRING_VALUE, 0},
12694 {":file", IMAGE_STRING_VALUE, 0},
12695 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
8edb0a6f 12696 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
6fc2811b 12697 {":relief", IMAGE_INTEGER_VALUE, 0},
a93f4566 12698 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6fc2811b 12699 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
a05e2bae
JR
12700 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
12701 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
12702 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
6fc2811b
JR
12703};
12704
12705/* Structure describing the image type `gif'. */
12706
12707static struct image_type gif_type =
12708{
12709 &Qgif,
12710 gif_image_p,
12711 gif_load,
12712 x_clear_image,
12713 NULL
12714};
12715
12716/* Return non-zero if OBJECT is a valid GIF image specification. */
12717
12718static int
12719gif_image_p (object)
12720 Lisp_Object object;
12721{
12722 struct image_keyword fmt[GIF_LAST];
12723 bcopy (gif_format, fmt, sizeof fmt);
12724
12725 if (!parse_image_spec (object, fmt, GIF_LAST, Qgif)
12726 || (fmt[GIF_ASCENT].count
12727 && XFASTINT (fmt[GIF_ASCENT].value) > 100))
12728 return 0;
12729
12730 /* Must specify either the :data or :file keyword. */
12731 return fmt[GIF_FILE].count + fmt[GIF_DATA].count == 1;
12732}
12733
12734/* Reading a GIF image from memory
12735 Based on the PNG memory stuff to a certain extent. */
12736
12737typedef struct
12738{
12739 unsigned char *bytes;
12740 size_t len;
12741 int index;
12742}
12743gif_memory_source;
12744
12745/* Make the current memory source available to gif_read_from_memory.
12746 It's done this way because not all versions of libungif support
12747 a UserData field in the GifFileType structure. */
12748static gif_memory_source *current_gif_memory_src;
12749
12750static int
12751gif_read_from_memory (file, buf, len)
12752 GifFileType *file;
12753 GifByteType *buf;
12754 int len;
12755{
12756 gif_memory_source *src = current_gif_memory_src;
12757
12758 if (len > src->len - src->index)
12759 return -1;
12760
12761 bcopy (src->bytes + src->index, buf, len);
12762 src->index += len;
12763 return len;
12764}
12765
12766
12767/* Load GIF image IMG for use on frame F. Value is non-zero if
12768 successful. */
12769
12770static int
12771gif_load (f, img)
12772 struct frame *f;
12773 struct image *img;
12774{
12775 Lisp_Object file, specified_file;
12776 Lisp_Object specified_data;
12777 int rc, width, height, x, y, i;
12778 XImage *ximg;
12779 ColorMapObject *gif_color_map;
12780 unsigned long pixel_colors[256];
12781 GifFileType *gif;
12782 struct gcpro gcpro1;
12783 Lisp_Object image;
12784 int ino, image_left, image_top, image_width, image_height;
12785 gif_memory_source memsrc;
12786 unsigned char *raster;
12787
12788 specified_file = image_spec_value (img->spec, QCfile, NULL);
12789 specified_data = image_spec_value (img->spec, QCdata, NULL);
12790 file = Qnil;
dfff8a69 12791 GCPRO1 (file);
6fc2811b
JR
12792
12793 if (NILP (specified_data))
12794 {
12795 file = x_find_image_file (specified_file);
6fc2811b
JR
12796 if (!STRINGP (file))
12797 {
12798 image_error ("Cannot find image file `%s'", specified_file, Qnil);
12799 UNGCPRO;
12800 return 0;
12801 }
12802
12803 /* Open the GIF file. */
d5db4077 12804 gif = DGifOpenFileName (SDATA (file));
6fc2811b
JR
12805 if (gif == NULL)
12806 {
12807 image_error ("Cannot open `%s'", file, Qnil);
12808 UNGCPRO;
12809 return 0;
12810 }
12811 }
12812 else
12813 {
12814 /* Read from memory! */
12815 current_gif_memory_src = &memsrc;
d5db4077
KR
12816 memsrc.bytes = SDATA (specified_data);
12817 memsrc.len = SBYTES (specified_data);
6fc2811b
JR
12818 memsrc.index = 0;
12819
12820 gif = DGifOpen(&memsrc, gif_read_from_memory);
12821 if (!gif)
12822 {
12823 image_error ("Cannot open memory source `%s'", img->spec, Qnil);
12824 UNGCPRO;
12825 return 0;
12826 }
12827 }
12828
12829 /* Read entire contents. */
12830 rc = DGifSlurp (gif);
12831 if (rc == GIF_ERROR)
12832 {
12833 image_error ("Error reading `%s'", img->spec, Qnil);
12834 DGifCloseFile (gif);
12835 UNGCPRO;
12836 return 0;
12837 }
12838
12839 image = image_spec_value (img->spec, QCindex, NULL);
12840 ino = INTEGERP (image) ? XFASTINT (image) : 0;
12841 if (ino >= gif->ImageCount)
12842 {
12843 image_error ("Invalid image number `%s' in image `%s'",
12844 image, img->spec);
12845 DGifCloseFile (gif);
12846 UNGCPRO;
12847 return 0;
12848 }
12849
12850 width = img->width = gif->SWidth;
12851 height = img->height = gif->SHeight;
12852
6fc2811b
JR
12853 /* Create the X image and pixmap. */
12854 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg, &img->pixmap))
12855 {
6fc2811b
JR
12856 DGifCloseFile (gif);
12857 UNGCPRO;
12858 return 0;
12859 }
12860
12861 /* Allocate colors. */
12862 gif_color_map = gif->SavedImages[ino].ImageDesc.ColorMap;
12863 if (!gif_color_map)
12864 gif_color_map = gif->SColorMap;
12865 init_color_table ();
12866 bzero (pixel_colors, sizeof pixel_colors);
12867
12868 for (i = 0; i < gif_color_map->ColorCount; ++i)
12869 {
12870 int r = gif_color_map->Colors[i].Red << 8;
12871 int g = gif_color_map->Colors[i].Green << 8;
12872 int b = gif_color_map->Colors[i].Blue << 8;
12873 pixel_colors[i] = lookup_rgb_color (f, r, g, b);
12874 }
12875
12876 img->colors = colors_in_color_table (&img->ncolors);
12877 free_color_table ();
12878
12879 /* Clear the part of the screen image that are not covered by
12880 the image from the GIF file. Full animated GIF support
12881 requires more than can be done here (see the gif89 spec,
12882 disposal methods). Let's simply assume that the part
12883 not covered by a sub-image is in the frame's background color. */
12884 image_top = gif->SavedImages[ino].ImageDesc.Top;
12885 image_left = gif->SavedImages[ino].ImageDesc.Left;
12886 image_width = gif->SavedImages[ino].ImageDesc.Width;
12887 image_height = gif->SavedImages[ino].ImageDesc.Height;
12888
12889 for (y = 0; y < image_top; ++y)
12890 for (x = 0; x < width; ++x)
12891 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
12892
12893 for (y = image_top + image_height; y < height; ++y)
12894 for (x = 0; x < width; ++x)
12895 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
12896
12897 for (y = image_top; y < image_top + image_height; ++y)
12898 {
12899 for (x = 0; x < image_left; ++x)
12900 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
12901 for (x = image_left + image_width; x < width; ++x)
12902 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
12903 }
12904
12905 /* Read the GIF image into the X image. We use a local variable
12906 `raster' here because RasterBits below is a char *, and invites
12907 problems with bytes >= 0x80. */
12908 raster = (unsigned char *) gif->SavedImages[ino].RasterBits;
12909
12910 if (gif->SavedImages[ino].ImageDesc.Interlace)
12911 {
12912 static int interlace_start[] = {0, 4, 2, 1};
12913 static int interlace_increment[] = {8, 8, 4, 2};
a05e2bae 12914 int pass;
6fc2811b
JR
12915 int row = interlace_start[0];
12916
12917 pass = 0;
12918
12919 for (y = 0; y < image_height; y++)
12920 {
12921 if (row >= image_height)
12922 {
12923 row = interlace_start[++pass];
12924 while (row >= image_height)
12925 row = interlace_start[++pass];
12926 }
12927
12928 for (x = 0; x < image_width; x++)
12929 {
12930 int i = raster[(y * image_width) + x];
12931 XPutPixel (ximg, x + image_left, row + image_top,
12932 pixel_colors[i]);
12933 }
12934
12935 row += interlace_increment[pass];
12936 }
12937 }
12938 else
12939 {
12940 for (y = 0; y < image_height; ++y)
12941 for (x = 0; x < image_width; ++x)
12942 {
12943 int i = raster[y* image_width + x];
12944 XPutPixel (ximg, x + image_left, y + image_top, pixel_colors[i]);
12945 }
12946 }
12947
12948 DGifCloseFile (gif);
a05e2bae
JR
12949
12950 /* Maybe fill in the background field while we have ximg handy. */
12951 if (NILP (image_spec_value (img->spec, QCbackground, NULL)))
12952 IMAGE_BACKGROUND (img, f, ximg);
12953
6fc2811b
JR
12954 /* Put the image into the pixmap, then free the X image and its buffer. */
12955 x_put_x_image (f, ximg, img->pixmap, width, height);
12956 x_destroy_x_image (ximg);
6fc2811b
JR
12957
12958 UNGCPRO;
12959 return 1;
12960}
12961
12962#endif /* HAVE_GIF != 0 */
12963
12964
12965\f
12966/***********************************************************************
12967 Ghostscript
12968 ***********************************************************************/
12969
3cf3436e
JR
12970Lisp_Object Qpostscript;
12971
6fc2811b
JR
12972#ifdef HAVE_GHOSTSCRIPT
12973static int gs_image_p P_ ((Lisp_Object object));
12974static int gs_load P_ ((struct frame *f, struct image *img));
12975static void gs_clear_image P_ ((struct frame *f, struct image *img));
12976
12977/* The symbol `postscript' identifying images of this type. */
12978
6fc2811b
JR
12979/* Keyword symbols. */
12980
12981Lisp_Object QCloader, QCbounding_box, QCpt_width, QCpt_height;
12982
12983/* Indices of image specification fields in gs_format, below. */
12984
12985enum gs_keyword_index
12986{
12987 GS_TYPE,
12988 GS_PT_WIDTH,
12989 GS_PT_HEIGHT,
12990 GS_FILE,
12991 GS_LOADER,
12992 GS_BOUNDING_BOX,
12993 GS_ASCENT,
12994 GS_MARGIN,
12995 GS_RELIEF,
12996 GS_ALGORITHM,
12997 GS_HEURISTIC_MASK,
a05e2bae
JR
12998 GS_MASK,
12999 GS_BACKGROUND,
6fc2811b
JR
13000 GS_LAST
13001};
13002
13003/* Vector of image_keyword structures describing the format
13004 of valid user-defined image specifications. */
13005
13006static struct image_keyword gs_format[GS_LAST] =
13007{
13008 {":type", IMAGE_SYMBOL_VALUE, 1},
13009 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE, 1},
13010 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE, 1},
13011 {":file", IMAGE_STRING_VALUE, 1},
13012 {":loader", IMAGE_FUNCTION_VALUE, 0},
13013 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE, 1},
13014 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
8edb0a6f 13015 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
6fc2811b 13016 {":relief", IMAGE_INTEGER_VALUE, 0},
a93f4566 13017 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
a05e2bae
JR
13018 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
13019 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
13020 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
6fc2811b
JR
13021};
13022
13023/* Structure describing the image type `ghostscript'. */
13024
13025static struct image_type gs_type =
13026{
13027 &Qpostscript,
13028 gs_image_p,
13029 gs_load,
13030 gs_clear_image,
13031 NULL
13032};
13033
13034
13035/* Free X resources of Ghostscript image IMG which is used on frame F. */
13036
13037static void
13038gs_clear_image (f, img)
13039 struct frame *f;
13040 struct image *img;
13041{
13042 /* IMG->data.ptr_val may contain a recorded colormap. */
13043 xfree (img->data.ptr_val);
13044 x_clear_image (f, img);
13045}
13046
13047
13048/* Return non-zero if OBJECT is a valid Ghostscript image
13049 specification. */
13050
13051static int
13052gs_image_p (object)
13053 Lisp_Object object;
13054{
13055 struct image_keyword fmt[GS_LAST];
13056 Lisp_Object tem;
13057 int i;
13058
13059 bcopy (gs_format, fmt, sizeof fmt);
13060
13061 if (!parse_image_spec (object, fmt, GS_LAST, Qpostscript)
13062 || (fmt[GS_ASCENT].count
13063 && XFASTINT (fmt[GS_ASCENT].value) > 100))
13064 return 0;
13065
13066 /* Bounding box must be a list or vector containing 4 integers. */
13067 tem = fmt[GS_BOUNDING_BOX].value;
13068 if (CONSP (tem))
13069 {
13070 for (i = 0; i < 4; ++i, tem = XCDR (tem))
13071 if (!CONSP (tem) || !INTEGERP (XCAR (tem)))
13072 return 0;
13073 if (!NILP (tem))
13074 return 0;
13075 }
13076 else if (VECTORP (tem))
13077 {
13078 if (XVECTOR (tem)->size != 4)
13079 return 0;
13080 for (i = 0; i < 4; ++i)
13081 if (!INTEGERP (XVECTOR (tem)->contents[i]))
13082 return 0;
13083 }
13084 else
13085 return 0;
13086
13087 return 1;
13088}
13089
13090
13091/* Load Ghostscript image IMG for use on frame F. Value is non-zero
13092 if successful. */
13093
13094static int
13095gs_load (f, img)
13096 struct frame *f;
13097 struct image *img;
13098{
13099 char buffer[100];
13100 Lisp_Object window_and_pixmap_id = Qnil, loader, pt_height, pt_width;
13101 struct gcpro gcpro1, gcpro2;
13102 Lisp_Object frame;
13103 double in_width, in_height;
13104 Lisp_Object pixel_colors = Qnil;
13105
13106 /* Compute pixel size of pixmap needed from the given size in the
13107 image specification. Sizes in the specification are in pt. 1 pt
13108 = 1/72 in, xdpi and ydpi are stored in the frame's X display
13109 info. */
13110 pt_width = image_spec_value (img->spec, QCpt_width, NULL);
13111 in_width = XFASTINT (pt_width) / 72.0;
13112 img->width = in_width * FRAME_W32_DISPLAY_INFO (f)->resx;
13113 pt_height = image_spec_value (img->spec, QCpt_height, NULL);
13114 in_height = XFASTINT (pt_height) / 72.0;
13115 img->height = in_height * FRAME_W32_DISPLAY_INFO (f)->resy;
13116
13117 /* Create the pixmap. */
13118 BLOCK_INPUT;
13119 xassert (img->pixmap == 0);
13120 img->pixmap = XCreatePixmap (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
13121 img->width, img->height,
a05e2bae 13122 one_w32_display_info.n_cbits);
6fc2811b
JR
13123 UNBLOCK_INPUT;
13124
13125 if (!img->pixmap)
13126 {
13127 image_error ("Unable to create pixmap for `%s'", img->spec, Qnil);
13128 return 0;
13129 }
13130
13131 /* Call the loader to fill the pixmap. It returns a process object
13132 if successful. We do not record_unwind_protect here because
13133 other places in redisplay like calling window scroll functions
13134 don't either. Let the Lisp loader use `unwind-protect' instead. */
13135 GCPRO2 (window_and_pixmap_id, pixel_colors);
13136
13137 sprintf (buffer, "%lu %lu",
13138 (unsigned long) FRAME_W32_WINDOW (f),
13139 (unsigned long) img->pixmap);
13140 window_and_pixmap_id = build_string (buffer);
13141
13142 sprintf (buffer, "%lu %lu",
13143 FRAME_FOREGROUND_PIXEL (f),
13144 FRAME_BACKGROUND_PIXEL (f));
13145 pixel_colors = build_string (buffer);
13146
13147 XSETFRAME (frame, f);
13148 loader = image_spec_value (img->spec, QCloader, NULL);
13149 if (NILP (loader))
13150 loader = intern ("gs-load-image");
13151
13152 img->data.lisp_val = call6 (loader, frame, img->spec,
13153 make_number (img->width),
13154 make_number (img->height),
13155 window_and_pixmap_id,
13156 pixel_colors);
13157 UNGCPRO;
13158 return PROCESSP (img->data.lisp_val);
13159}
13160
13161
13162/* Kill the Ghostscript process that was started to fill PIXMAP on
13163 frame F. Called from XTread_socket when receiving an event
13164 telling Emacs that Ghostscript has finished drawing. */
13165
13166void
13167x_kill_gs_process (pixmap, f)
13168 Pixmap pixmap;
13169 struct frame *f;
13170{
13171 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
13172 int class, i;
13173 struct image *img;
13174
13175 /* Find the image containing PIXMAP. */
13176 for (i = 0; i < c->used; ++i)
13177 if (c->images[i]->pixmap == pixmap)
13178 break;
13179
3cf3436e
JR
13180 /* Should someone in between have cleared the image cache, for
13181 instance, give up. */
13182 if (i == c->used)
13183 return;
13184
6fc2811b
JR
13185 /* Kill the GS process. We should have found PIXMAP in the image
13186 cache and its image should contain a process object. */
6fc2811b
JR
13187 img = c->images[i];
13188 xassert (PROCESSP (img->data.lisp_val));
13189 Fkill_process (img->data.lisp_val, Qnil);
13190 img->data.lisp_val = Qnil;
13191
13192 /* On displays with a mutable colormap, figure out the colors
13193 allocated for the image by looking at the pixels of an XImage for
13194 img->pixmap. */
13195 class = FRAME_W32_DISPLAY_INFO (f)->visual->class;
13196 if (class != StaticColor && class != StaticGray && class != TrueColor)
13197 {
13198 XImage *ximg;
13199
13200 BLOCK_INPUT;
13201
13202 /* Try to get an XImage for img->pixmep. */
13203 ximg = XGetImage (FRAME_W32_DISPLAY (f), img->pixmap,
13204 0, 0, img->width, img->height, ~0, ZPixmap);
13205 if (ximg)
13206 {
13207 int x, y;
13208
13209 /* Initialize the color table. */
13210 init_color_table ();
13211
13212 /* For each pixel of the image, look its color up in the
13213 color table. After having done so, the color table will
13214 contain an entry for each color used by the image. */
13215 for (y = 0; y < img->height; ++y)
13216 for (x = 0; x < img->width; ++x)
13217 {
13218 unsigned long pixel = XGetPixel (ximg, x, y);
13219 lookup_pixel_color (f, pixel);
13220 }
13221
13222 /* Record colors in the image. Free color table and XImage. */
13223 img->colors = colors_in_color_table (&img->ncolors);
13224 free_color_table ();
13225 XDestroyImage (ximg);
13226
13227#if 0 /* This doesn't seem to be the case. If we free the colors
13228 here, we get a BadAccess later in x_clear_image when
13229 freeing the colors. */
13230 /* We have allocated colors once, but Ghostscript has also
13231 allocated colors on behalf of us. So, to get the
13232 reference counts right, free them once. */
13233 if (img->ncolors)
3cf3436e 13234 x_free_colors (FRAME_W32_DISPLAY (f), cmap,
6fc2811b 13235 img->colors, img->ncolors, 0);
6fc2811b
JR
13236#endif
13237 }
13238 else
13239 image_error ("Cannot get X image of `%s'; colors will not be freed",
13240 img->spec, Qnil);
13241
13242 UNBLOCK_INPUT;
13243 }
3cf3436e
JR
13244
13245 /* Now that we have the pixmap, compute mask and transform the
13246 image if requested. */
13247 BLOCK_INPUT;
13248 postprocess_image (f, img);
13249 UNBLOCK_INPUT;
6fc2811b
JR
13250}
13251
13252#endif /* HAVE_GHOSTSCRIPT */
13253
13254\f
13255/***********************************************************************
13256 Window properties
13257 ***********************************************************************/
13258
13259DEFUN ("x-change-window-property", Fx_change_window_property,
13260 Sx_change_window_property, 2, 3, 0,
74e1aeec
JR
13261 doc: /* Change window property PROP to VALUE on the X window of FRAME.
13262PROP and VALUE must be strings. FRAME nil or omitted means use the
13263selected frame. Value is VALUE. */)
6fc2811b
JR
13264 (prop, value, frame)
13265 Lisp_Object frame, prop, value;
13266{
767b1ff0 13267#if 0 /* TODO : port window properties to W32 */
6fc2811b
JR
13268 struct frame *f = check_x_frame (frame);
13269 Atom prop_atom;
13270
b7826503
PJ
13271 CHECK_STRING (prop);
13272 CHECK_STRING (value);
6fc2811b
JR
13273
13274 BLOCK_INPUT;
d5db4077 13275 prop_atom = XInternAtom (FRAME_W32_DISPLAY (f), SDATA (prop), False);
6fc2811b
JR
13276 XChangeProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
13277 prop_atom, XA_STRING, 8, PropModeReplace,
d5db4077 13278 SDATA (value), SCHARS (value));
6fc2811b
JR
13279
13280 /* Make sure the property is set when we return. */
13281 XFlush (FRAME_W32_DISPLAY (f));
13282 UNBLOCK_INPUT;
13283
767b1ff0 13284#endif /* TODO */
6fc2811b
JR
13285
13286 return value;
13287}
13288
13289
13290DEFUN ("x-delete-window-property", Fx_delete_window_property,
13291 Sx_delete_window_property, 1, 2, 0,
74e1aeec
JR
13292 doc: /* Remove window property PROP from X window of FRAME.
13293FRAME nil or omitted means use the selected frame. Value is PROP. */)
6fc2811b
JR
13294 (prop, frame)
13295 Lisp_Object prop, frame;
13296{
767b1ff0 13297#if 0 /* TODO : port window properties to W32 */
6fc2811b
JR
13298
13299 struct frame *f = check_x_frame (frame);
13300 Atom prop_atom;
13301
b7826503 13302 CHECK_STRING (prop);
6fc2811b 13303 BLOCK_INPUT;
d5db4077 13304 prop_atom = XInternAtom (FRAME_W32_DISPLAY (f), SDATA (prop), False);
6fc2811b
JR
13305 XDeleteProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f), prop_atom);
13306
13307 /* Make sure the property is removed when we return. */
13308 XFlush (FRAME_W32_DISPLAY (f));
13309 UNBLOCK_INPUT;
767b1ff0 13310#endif /* TODO */
6fc2811b
JR
13311
13312 return prop;
13313}
13314
13315
13316DEFUN ("x-window-property", Fx_window_property, Sx_window_property,
13317 1, 2, 0,
74e1aeec
JR
13318 doc: /* Value is the value of window property PROP on FRAME.
13319If FRAME is nil or omitted, use the selected frame. Value is nil
13320if FRAME hasn't a property with name PROP or if PROP has no string
13321value. */)
6fc2811b
JR
13322 (prop, frame)
13323 Lisp_Object prop, frame;
13324{
767b1ff0 13325#if 0 /* TODO : port window properties to W32 */
6fc2811b
JR
13326
13327 struct frame *f = check_x_frame (frame);
13328 Atom prop_atom;
13329 int rc;
13330 Lisp_Object prop_value = Qnil;
13331 char *tmp_data = NULL;
13332 Atom actual_type;
13333 int actual_format;
13334 unsigned long actual_size, bytes_remaining;
13335
b7826503 13336 CHECK_STRING (prop);
6fc2811b 13337 BLOCK_INPUT;
d5db4077 13338 prop_atom = XInternAtom (FRAME_W32_DISPLAY (f), SDATA (prop), False);
6fc2811b
JR
13339 rc = XGetWindowProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
13340 prop_atom, 0, 0, False, XA_STRING,
13341 &actual_type, &actual_format, &actual_size,
13342 &bytes_remaining, (unsigned char **) &tmp_data);
13343 if (rc == Success)
13344 {
13345 int size = bytes_remaining;
13346
13347 XFree (tmp_data);
13348 tmp_data = NULL;
13349
13350 rc = XGetWindowProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
13351 prop_atom, 0, bytes_remaining,
13352 False, XA_STRING,
13353 &actual_type, &actual_format,
13354 &actual_size, &bytes_remaining,
13355 (unsigned char **) &tmp_data);
13356 if (rc == Success)
13357 prop_value = make_string (tmp_data, size);
13358
13359 XFree (tmp_data);
13360 }
13361
13362 UNBLOCK_INPUT;
13363
13364 return prop_value;
13365
767b1ff0 13366#endif /* TODO */
6fc2811b
JR
13367 return Qnil;
13368}
13369
13370
13371\f
13372/***********************************************************************
13373 Busy cursor
13374 ***********************************************************************/
13375
f79e6790 13376/* If non-null, an asynchronous timer that, when it expires, displays
0af913d7 13377 an hourglass cursor on all frames. */
6fc2811b 13378
0af913d7 13379static struct atimer *hourglass_atimer;
6fc2811b 13380
0af913d7 13381/* Non-zero means an hourglass cursor is currently shown. */
6fc2811b 13382
0af913d7 13383static int hourglass_shown_p;
6fc2811b 13384
0af913d7 13385/* Number of seconds to wait before displaying an hourglass cursor. */
6fc2811b 13386
0af913d7 13387static Lisp_Object Vhourglass_delay;
6fc2811b 13388
0af913d7 13389/* Default number of seconds to wait before displaying an hourglass
f79e6790
JR
13390 cursor. */
13391
0af913d7 13392#define DEFAULT_HOURGLASS_DELAY 1
f79e6790
JR
13393
13394/* Function prototypes. */
13395
0af913d7
GM
13396static void show_hourglass P_ ((struct atimer *));
13397static void hide_hourglass P_ ((void));
f79e6790
JR
13398
13399
0af913d7 13400/* Cancel a currently active hourglass timer, and start a new one. */
f79e6790
JR
13401
13402void
0af913d7 13403start_hourglass ()
f79e6790 13404{
767b1ff0 13405#if 0 /* TODO: cursor shape changes. */
f79e6790 13406 EMACS_TIME delay;
dfff8a69 13407 int secs, usecs = 0;
f79e6790 13408
0af913d7 13409 cancel_hourglass ();
f79e6790 13410
0af913d7
GM
13411 if (INTEGERP (Vhourglass_delay)
13412 && XINT (Vhourglass_delay) > 0)
13413 secs = XFASTINT (Vhourglass_delay);
13414 else if (FLOATP (Vhourglass_delay)
13415 && XFLOAT_DATA (Vhourglass_delay) > 0)
dfff8a69
JR
13416 {
13417 Lisp_Object tem;
0af913d7 13418 tem = Ftruncate (Vhourglass_delay, Qnil);
dfff8a69 13419 secs = XFASTINT (tem);
0af913d7 13420 usecs = (XFLOAT_DATA (Vhourglass_delay) - secs) * 1000000;
dfff8a69 13421 }
f79e6790 13422 else
0af913d7 13423 secs = DEFAULT_HOURGLASS_DELAY;
f79e6790 13424
dfff8a69 13425 EMACS_SET_SECS_USECS (delay, secs, usecs);
0af913d7
GM
13426 hourglass_atimer = start_atimer (ATIMER_RELATIVE, delay,
13427 show_hourglass, NULL);
f79e6790
JR
13428#endif
13429}
13430
13431
0af913d7
GM
13432/* Cancel the hourglass cursor timer if active, hide an hourglass
13433 cursor if shown. */
f79e6790
JR
13434
13435void
0af913d7 13436cancel_hourglass ()
f79e6790 13437{
0af913d7 13438 if (hourglass_atimer)
dfff8a69 13439 {
0af913d7
GM
13440 cancel_atimer (hourglass_atimer);
13441 hourglass_atimer = NULL;
dfff8a69
JR
13442 }
13443
0af913d7
GM
13444 if (hourglass_shown_p)
13445 hide_hourglass ();
f79e6790
JR
13446}
13447
13448
0af913d7
GM
13449/* Timer function of hourglass_atimer. TIMER is equal to
13450 hourglass_atimer.
f79e6790 13451
0af913d7
GM
13452 Display an hourglass cursor on all frames by mapping the frames'
13453 hourglass_window. Set the hourglass_p flag in the frames'
13454 output_data.x structure to indicate that an hourglass cursor is
13455 shown on the frames. */
f79e6790
JR
13456
13457static void
0af913d7 13458show_hourglass (timer)
f79e6790 13459 struct atimer *timer;
6fc2811b 13460{
767b1ff0 13461#if 0 /* TODO: cursor shape changes. */
f79e6790 13462 /* The timer implementation will cancel this timer automatically
0af913d7 13463 after this function has run. Set hourglass_atimer to null
f79e6790 13464 so that we know the timer doesn't have to be canceled. */
0af913d7 13465 hourglass_atimer = NULL;
f79e6790 13466
0af913d7 13467 if (!hourglass_shown_p)
6fc2811b
JR
13468 {
13469 Lisp_Object rest, frame;
f79e6790
JR
13470
13471 BLOCK_INPUT;
13472
6fc2811b 13473 FOR_EACH_FRAME (rest, frame)
dc220243 13474 if (FRAME_W32_P (XFRAME (frame)))
6fc2811b
JR
13475 {
13476 struct frame *f = XFRAME (frame);
f79e6790 13477
0af913d7 13478 f->output_data.w32->hourglass_p = 1;
f79e6790 13479
0af913d7 13480 if (!f->output_data.w32->hourglass_window)
6fc2811b
JR
13481 {
13482 unsigned long mask = CWCursor;
13483 XSetWindowAttributes attrs;
f79e6790 13484
0af913d7 13485 attrs.cursor = f->output_data.w32->hourglass_cursor;
f79e6790 13486
0af913d7 13487 f->output_data.w32->hourglass_window
f79e6790 13488 = XCreateWindow (FRAME_X_DISPLAY (f),
6fc2811b
JR
13489 FRAME_OUTER_WINDOW (f),
13490 0, 0, 32000, 32000, 0, 0,
f79e6790
JR
13491 InputOnly,
13492 CopyFromParent,
6fc2811b
JR
13493 mask, &attrs);
13494 }
f79e6790 13495
0af913d7
GM
13496 XMapRaised (FRAME_X_DISPLAY (f),
13497 f->output_data.w32->hourglass_window);
f79e6790 13498 XFlush (FRAME_X_DISPLAY (f));
6fc2811b 13499 }
6fc2811b 13500
0af913d7 13501 hourglass_shown_p = 1;
f79e6790
JR
13502 UNBLOCK_INPUT;
13503 }
13504#endif
6fc2811b
JR
13505}
13506
13507
0af913d7 13508/* Hide the hourglass cursor on all frames, if it is currently shown. */
6fc2811b 13509
f79e6790 13510static void
0af913d7 13511hide_hourglass ()
f79e6790 13512{
767b1ff0 13513#if 0 /* TODO: cursor shape changes. */
0af913d7 13514 if (hourglass_shown_p)
6fc2811b 13515 {
f79e6790
JR
13516 Lisp_Object rest, frame;
13517
13518 BLOCK_INPUT;
13519 FOR_EACH_FRAME (rest, frame)
6fc2811b 13520 {
f79e6790
JR
13521 struct frame *f = XFRAME (frame);
13522
dc220243 13523 if (FRAME_W32_P (f)
f79e6790 13524 /* Watch out for newly created frames. */
0af913d7 13525 && f->output_data.x->hourglass_window)
f79e6790 13526 {
0af913d7
GM
13527 XUnmapWindow (FRAME_X_DISPLAY (f),
13528 f->output_data.x->hourglass_window);
13529 /* Sync here because XTread_socket looks at the
13530 hourglass_p flag that is reset to zero below. */
f79e6790 13531 XSync (FRAME_X_DISPLAY (f), False);
0af913d7 13532 f->output_data.x->hourglass_p = 0;
f79e6790 13533 }
6fc2811b 13534 }
6fc2811b 13535
0af913d7 13536 hourglass_shown_p = 0;
f79e6790
JR
13537 UNBLOCK_INPUT;
13538 }
13539#endif
6fc2811b
JR
13540}
13541
13542
13543\f
13544/***********************************************************************
13545 Tool tips
13546 ***********************************************************************/
13547
13548static Lisp_Object x_create_tip_frame P_ ((struct w32_display_info *,
3cf3436e
JR
13549 Lisp_Object, Lisp_Object));
13550static void compute_tip_xy P_ ((struct frame *, Lisp_Object, Lisp_Object,
13551 Lisp_Object, int, int, int *, int *));
6fc2811b 13552
3cf3436e 13553/* The frame of a currently visible tooltip. */
6fc2811b 13554
937e601e 13555Lisp_Object tip_frame;
6fc2811b
JR
13556
13557/* If non-nil, a timer started that hides the last tooltip when it
13558 fires. */
13559
13560Lisp_Object tip_timer;
13561Window tip_window;
13562
3cf3436e
JR
13563/* If non-nil, a vector of 3 elements containing the last args
13564 with which x-show-tip was called. See there. */
13565
13566Lisp_Object last_show_tip_args;
13567
13568/* Maximum size for tooltips; a cons (COLUMNS . ROWS). */
13569
13570Lisp_Object Vx_max_tooltip_size;
13571
13572
937e601e
AI
13573static Lisp_Object
13574unwind_create_tip_frame (frame)
13575 Lisp_Object frame;
13576{
c844a81a
GM
13577 Lisp_Object deleted;
13578
13579 deleted = unwind_create_frame (frame);
13580 if (EQ (deleted, Qt))
13581 {
13582 tip_window = NULL;
13583 tip_frame = Qnil;
13584 }
13585
13586 return deleted;
937e601e
AI
13587}
13588
13589
6fc2811b 13590/* Create a frame for a tooltip on the display described by DPYINFO.
3cf3436e
JR
13591 PARMS is a list of frame parameters. TEXT is the string to
13592 display in the tip frame. Value is the frame.
937e601e
AI
13593
13594 Note that functions called here, esp. x_default_parameter can
13595 signal errors, for instance when a specified color name is
13596 undefined. We have to make sure that we're in a consistent state
13597 when this happens. */
6fc2811b
JR
13598
13599static Lisp_Object
3cf3436e 13600x_create_tip_frame (dpyinfo, parms, text)
6fc2811b 13601 struct w32_display_info *dpyinfo;
3cf3436e 13602 Lisp_Object parms, text;
6fc2811b 13603{
6fc2811b
JR
13604 struct frame *f;
13605 Lisp_Object frame, tem;
13606 Lisp_Object name;
13607 long window_prompting = 0;
13608 int width, height;
331379bf 13609 int count = SPECPDL_INDEX ();
6fc2811b
JR
13610 struct gcpro gcpro1, gcpro2, gcpro3;
13611 struct kboard *kb;
3cf3436e
JR
13612 int face_change_count_before = face_change_count;
13613 Lisp_Object buffer;
13614 struct buffer *old_buffer;
6fc2811b 13615
ca56d953 13616 check_w32 ();
6fc2811b
JR
13617
13618 /* Use this general default value to start with until we know if
13619 this frame has a specified name. */
13620 Vx_resource_name = Vinvocation_name;
13621
13622#ifdef MULTI_KBOARD
13623 kb = dpyinfo->kboard;
13624#else
13625 kb = &the_only_kboard;
13626#endif
13627
13628 /* Get the name of the frame to use for resource lookup. */
13629 name = w32_get_arg (parms, Qname, "name", "Name", RES_TYPE_STRING);
13630 if (!STRINGP (name)
13631 && !EQ (name, Qunbound)
13632 && !NILP (name))
13633 error ("Invalid frame name--not a string or nil");
13634 Vx_resource_name = name;
13635
13636 frame = Qnil;
13637 GCPRO3 (parms, name, frame);
9eb16b62
JR
13638 /* Make a frame without minibuffer nor mode-line. */
13639 f = make_frame (0);
13640 f->wants_modeline = 0;
6fc2811b 13641 XSETFRAME (frame, f);
3cf3436e
JR
13642
13643 buffer = Fget_buffer_create (build_string (" *tip*"));
13644 Fset_window_buffer (FRAME_ROOT_WINDOW (f), buffer);
13645 old_buffer = current_buffer;
13646 set_buffer_internal_1 (XBUFFER (buffer));
13647 current_buffer->truncate_lines = Qnil;
13648 Ferase_buffer ();
13649 Finsert (1, &text);
13650 set_buffer_internal_1 (old_buffer);
13651
6fc2811b 13652 FRAME_CAN_HAVE_SCROLL_BARS (f) = 0;
937e601e 13653 record_unwind_protect (unwind_create_tip_frame, frame);
6fc2811b 13654
3cf3436e
JR
13655 /* By setting the output method, we're essentially saying that
13656 the frame is live, as per FRAME_LIVE_P. If we get a signal
13657 from this point on, x_destroy_window might screw up reference
13658 counts etc. */
d88c567c 13659 f->output_method = output_w32;
6fc2811b
JR
13660 f->output_data.w32 =
13661 (struct w32_output *) xmalloc (sizeof (struct w32_output));
13662 bzero (f->output_data.w32, sizeof (struct w32_output));
ca56d953
JR
13663
13664 FRAME_FONTSET (f) = -1;
6fc2811b
JR
13665 f->icon_name = Qnil;
13666
ca56d953 13667#if 0 /* GLYPH_DEBUG TODO: image support. */
937e601e
AI
13668 image_cache_refcount = FRAME_X_IMAGE_CACHE (f)->refcount;
13669 dpyinfo_refcount = dpyinfo->reference_count;
13670#endif /* GLYPH_DEBUG */
6fc2811b
JR
13671#ifdef MULTI_KBOARD
13672 FRAME_KBOARD (f) = kb;
13673#endif
13674 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
13675 f->output_data.w32->explicit_parent = 0;
13676
13677 /* Set the name; the functions to which we pass f expect the name to
13678 be set. */
13679 if (EQ (name, Qunbound) || NILP (name))
13680 {
ca56d953 13681 f->name = build_string (dpyinfo->w32_id_name);
6fc2811b
JR
13682 f->explicit_name = 0;
13683 }
13684 else
13685 {
13686 f->name = name;
13687 f->explicit_name = 1;
13688 /* use the frame's title when getting resources for this frame. */
13689 specbind (Qx_resource_name, name);
13690 }
13691
6fc2811b
JR
13692 /* Extract the window parameters from the supplied values
13693 that are needed to determine window geometry. */
13694 {
13695 Lisp_Object font;
13696
13697 font = w32_get_arg (parms, Qfont, "font", "Font", RES_TYPE_STRING);
13698
13699 BLOCK_INPUT;
13700 /* First, try whatever font the caller has specified. */
13701 if (STRINGP (font))
13702 {
13703 tem = Fquery_fontset (font, Qnil);
13704 if (STRINGP (tem))
d5db4077 13705 font = x_new_fontset (f, SDATA (tem));
6fc2811b 13706 else
d5db4077 13707 font = x_new_font (f, SDATA (font));
6fc2811b
JR
13708 }
13709
13710 /* Try out a font which we hope has bold and italic variations. */
13711 if (!STRINGP (font))
ca56d953 13712 font = x_new_font (f, "-*-Courier New-normal-r-*-*-*-100-*-*-c-*-iso8859-1");
6fc2811b 13713 if (! STRINGP (font))
ca56d953 13714 font = x_new_font (f, "-*-Courier-normal-r-*-*-13-*-*-*-c-*-iso8859-1");
6fc2811b
JR
13715 /* If those didn't work, look for something which will at least work. */
13716 if (! STRINGP (font))
ca56d953 13717 font = x_new_font (f, "-*-Fixedsys-normal-r-*-*-12-*-*-*-c-*-iso8859-1");
6fc2811b
JR
13718 UNBLOCK_INPUT;
13719 if (! STRINGP (font))
ca56d953 13720 font = build_string ("Fixedsys");
6fc2811b
JR
13721
13722 x_default_parameter (f, parms, Qfont, font,
13723 "font", "Font", RES_TYPE_STRING);
13724 }
13725
13726 x_default_parameter (f, parms, Qborder_width, make_number (2),
13727 "borderWidth", "BorderWidth", RES_TYPE_NUMBER);
6fc2811b
JR
13728 /* This defaults to 2 in order to match xterm. We recognize either
13729 internalBorderWidth or internalBorder (which is what xterm calls
13730 it). */
13731 if (NILP (Fassq (Qinternal_border_width, parms)))
13732 {
13733 Lisp_Object value;
13734
13735 value = w32_get_arg (parms, Qinternal_border_width,
13736 "internalBorder", "internalBorder", RES_TYPE_NUMBER);
13737 if (! EQ (value, Qunbound))
13738 parms = Fcons (Fcons (Qinternal_border_width, value),
13739 parms);
13740 }
bfd6edcc 13741 x_default_parameter (f, parms, Qinternal_border_width, make_number (1),
6fc2811b
JR
13742 "internalBorderWidth", "internalBorderWidth",
13743 RES_TYPE_NUMBER);
13744
13745 /* Also do the stuff which must be set before the window exists. */
13746 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
13747 "foreground", "Foreground", RES_TYPE_STRING);
13748 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
13749 "background", "Background", RES_TYPE_STRING);
13750 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
13751 "pointerColor", "Foreground", RES_TYPE_STRING);
13752 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
13753 "cursorColor", "Foreground", RES_TYPE_STRING);
13754 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
13755 "borderColor", "BorderColor", RES_TYPE_STRING);
13756
13757 /* Init faces before x_default_parameter is called for scroll-bar
13758 parameters because that function calls x_set_scroll_bar_width,
13759 which calls change_frame_size, which calls Fset_window_buffer,
13760 which runs hooks, which call Fvertical_motion. At the end, we
13761 end up in init_iterator with a null face cache, which should not
13762 happen. */
13763 init_frame_faces (f);
ca56d953
JR
13764
13765 f->output_data.w32->dwStyle = WS_BORDER | WS_POPUP | WS_DISABLED;
6fc2811b 13766 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
9eb16b62 13767
6fc2811b
JR
13768 window_prompting = x_figure_window_size (f, parms);
13769
9eb16b62
JR
13770 /* No fringes on tip frame. */
13771 f->output_data.w32->fringes_extra = 0;
13772 f->output_data.w32->fringe_cols = 0;
13773 f->output_data.w32->left_fringe_width = 0;
13774 f->output_data.w32->right_fringe_width = 0;
13775
6fc2811b
JR
13776 if (window_prompting & XNegative)
13777 {
13778 if (window_prompting & YNegative)
13779 f->output_data.w32->win_gravity = SouthEastGravity;
13780 else
13781 f->output_data.w32->win_gravity = NorthEastGravity;
13782 }
13783 else
13784 {
13785 if (window_prompting & YNegative)
13786 f->output_data.w32->win_gravity = SouthWestGravity;
13787 else
13788 f->output_data.w32->win_gravity = NorthWestGravity;
13789 }
13790
13791 f->output_data.w32->size_hint_flags = window_prompting;
ca56d953
JR
13792
13793 BLOCK_INPUT;
13794 my_create_tip_window (f);
13795 UNBLOCK_INPUT;
6fc2811b
JR
13796
13797 x_make_gc (f);
13798
13799 x_default_parameter (f, parms, Qauto_raise, Qnil,
13800 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
13801 x_default_parameter (f, parms, Qauto_lower, Qnil,
13802 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
13803 x_default_parameter (f, parms, Qcursor_type, Qbox,
13804 "cursorType", "CursorType", RES_TYPE_SYMBOL);
13805
13806 /* Dimensions, especially f->height, must be done via change_frame_size.
13807 Change will not be effected unless different from the current
13808 f->height. */
13809 width = f->width;
13810 height = f->height;
13811 f->height = 0;
13812 SET_FRAME_WIDTH (f, 0);
13813 change_frame_size (f, height, width, 1, 0, 0);
13814
3cf3436e
JR
13815 /* Set up faces after all frame parameters are known. This call
13816 also merges in face attributes specified for new frames.
13817
13818 Frame parameters may be changed if .Xdefaults contains
13819 specifications for the default font. For example, if there is an
13820 `Emacs.default.attributeBackground: pink', the `background-color'
13821 attribute of the frame get's set, which let's the internal border
13822 of the tooltip frame appear in pink. Prevent this. */
13823 {
13824 Lisp_Object bg = Fframe_parameter (frame, Qbackground_color);
13825
13826 /* Set tip_frame here, so that */
13827 tip_frame = frame;
13828 call1 (Qface_set_after_frame_default, frame);
13829
13830 if (!EQ (bg, Fframe_parameter (frame, Qbackground_color)))
13831 Fmodify_frame_parameters (frame, Fcons (Fcons (Qbackground_color, bg),
13832 Qnil));
13833 }
13834
6fc2811b
JR
13835 f->no_split = 1;
13836
13837 UNGCPRO;
13838
13839 /* It is now ok to make the frame official even if we get an error
13840 below. And the frame needs to be on Vframe_list or making it
13841 visible won't work. */
13842 Vframe_list = Fcons (frame, Vframe_list);
13843
13844 /* Now that the frame is official, it counts as a reference to
13845 its display. */
13846 FRAME_W32_DISPLAY_INFO (f)->reference_count++;
ee78dc32 13847
3cf3436e
JR
13848 /* Setting attributes of faces of the tooltip frame from resources
13849 and similar will increment face_change_count, which leads to the
13850 clearing of all current matrices. Since this isn't necessary
13851 here, avoid it by resetting face_change_count to the value it
13852 had before we created the tip frame. */
13853 face_change_count = face_change_count_before;
13854
13855 /* Discard the unwind_protect. */
6fc2811b 13856 return unbind_to (count, frame);
ee78dc32
GV
13857}
13858
3cf3436e
JR
13859
13860/* Compute where to display tip frame F. PARMS is the list of frame
13861 parameters for F. DX and DY are specified offsets from the current
13862 location of the mouse. WIDTH and HEIGHT are the width and height
13863 of the tooltip. Return coordinates relative to the root window of
13864 the display in *ROOT_X, and *ROOT_Y. */
13865
13866static void
13867compute_tip_xy (f, parms, dx, dy, width, height, root_x, root_y)
13868 struct frame *f;
13869 Lisp_Object parms, dx, dy;
13870 int width, height;
13871 int *root_x, *root_y;
13872{
3cf3436e 13873 Lisp_Object left, top;
3cf3436e
JR
13874
13875 /* User-specified position? */
13876 left = Fcdr (Fassq (Qleft, parms));
13877 top = Fcdr (Fassq (Qtop, parms));
13878
13879 /* Move the tooltip window where the mouse pointer is. Resize and
13880 show it. */
ca56d953 13881 if (!INTEGERP (left) || !INTEGERP (top))
3cf3436e 13882 {
ca56d953
JR
13883 POINT pt;
13884
3cf3436e 13885 BLOCK_INPUT;
ca56d953
JR
13886 GetCursorPos (&pt);
13887 *root_x = pt.x;
13888 *root_y = pt.y;
3cf3436e
JR
13889 UNBLOCK_INPUT;
13890 }
13891
13892 if (INTEGERP (top))
13893 *root_y = XINT (top);
13894 else if (*root_y + XINT (dy) - height < 0)
13895 *root_y -= XINT (dy);
13896 else
13897 {
13898 *root_y -= height;
13899 *root_y += XINT (dy);
13900 }
13901
13902 if (INTEGERP (left))
13903 *root_x = XINT (left);
72e4adef
JR
13904 else if (*root_x + XINT (dx) + width <= FRAME_W32_DISPLAY_INFO (f)->width)
13905 /* It fits to the right of the pointer. */
13906 *root_x += XINT (dx);
13907 else if (width + XINT (dx) <= *root_x)
13908 /* It fits to the left of the pointer. */
3cf3436e
JR
13909 *root_x -= width + XINT (dx);
13910 else
72e4adef
JR
13911 /* Put it left justified on the screen -- it ought to fit that way. */
13912 *root_x = 0;
3cf3436e
JR
13913}
13914
13915
71eab8d1 13916DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
74e1aeec
JR
13917 doc: /* Show STRING in a \"tooltip\" window on frame FRAME.
13918A tooltip window is a small window displaying a string.
13919
13920FRAME nil or omitted means use the selected frame.
13921
13922PARMS is an optional list of frame parameters which can be
13923used to change the tooltip's appearance.
13924
ca56d953
JR
13925Automatically hide the tooltip after TIMEOUT seconds. TIMEOUT nil
13926means use the default timeout of 5 seconds.
74e1aeec 13927
ca56d953 13928If the list of frame parameters PARAMS contains a `left' parameter,
74e1aeec
JR
13929the tooltip is displayed at that x-position. Otherwise it is
13930displayed at the mouse position, with offset DX added (default is 5 if
13931DX isn't specified). Likewise for the y-position; if a `top' frame
13932parameter is specified, it determines the y-position of the tooltip
13933window, otherwise it is displayed at the mouse position, with offset
13934DY added (default is -10).
13935
13936A tooltip's maximum size is specified by `x-max-tooltip-size'.
13937Text larger than the specified size is clipped. */)
71eab8d1
AI
13938 (string, frame, parms, timeout, dx, dy)
13939 Lisp_Object string, frame, parms, timeout, dx, dy;
ee78dc32 13940{
6fc2811b
JR
13941 struct frame *f;
13942 struct window *w;
3cf3436e 13943 int root_x, root_y;
6fc2811b
JR
13944 struct buffer *old_buffer;
13945 struct text_pos pos;
13946 int i, width, height;
6fc2811b
JR
13947 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
13948 int old_windows_or_buffers_changed = windows_or_buffers_changed;
331379bf 13949 int count = SPECPDL_INDEX ();
6fc2811b
JR
13950
13951 specbind (Qinhibit_redisplay, Qt);
ee78dc32 13952
dfff8a69 13953 GCPRO4 (string, parms, frame, timeout);
ee78dc32 13954
b7826503 13955 CHECK_STRING (string);
6fc2811b
JR
13956 f = check_x_frame (frame);
13957 if (NILP (timeout))
13958 timeout = make_number (5);
13959 else
b7826503 13960 CHECK_NATNUM (timeout);
ee78dc32 13961
71eab8d1
AI
13962 if (NILP (dx))
13963 dx = make_number (5);
13964 else
b7826503 13965 CHECK_NUMBER (dx);
71eab8d1
AI
13966
13967 if (NILP (dy))
dc220243 13968 dy = make_number (-10);
71eab8d1 13969 else
b7826503 13970 CHECK_NUMBER (dy);
71eab8d1 13971
dc220243
JR
13972 if (NILP (last_show_tip_args))
13973 last_show_tip_args = Fmake_vector (make_number (3), Qnil);
13974
13975 if (!NILP (tip_frame))
13976 {
13977 Lisp_Object last_string = AREF (last_show_tip_args, 0);
13978 Lisp_Object last_frame = AREF (last_show_tip_args, 1);
13979 Lisp_Object last_parms = AREF (last_show_tip_args, 2);
13980
13981 if (EQ (frame, last_frame)
13982 && !NILP (Fequal (last_string, string))
13983 && !NILP (Fequal (last_parms, parms)))
13984 {
13985 struct frame *f = XFRAME (tip_frame);
13986
13987 /* Only DX and DY have changed. */
13988 if (!NILP (tip_timer))
13989 {
13990 Lisp_Object timer = tip_timer;
13991 tip_timer = Qnil;
13992 call1 (Qcancel_timer, timer);
13993 }
13994
13995 BLOCK_INPUT;
ca56d953
JR
13996 compute_tip_xy (f, parms, dx, dy, PIXEL_WIDTH (f),
13997 PIXEL_HEIGHT (f), &root_x, &root_y);
d65a9cdc
JR
13998
13999 /* Put tooltip in topmost group and in position. */
ca56d953
JR
14000 SetWindowPos (FRAME_W32_WINDOW (f), HWND_TOPMOST,
14001 root_x, root_y, 0, 0,
14002 SWP_NOSIZE | SWP_NOACTIVATE);
d65a9cdc
JR
14003
14004 /* Ensure tooltip is on top of other topmost windows (eg menus). */
14005 SetWindowPos (FRAME_W32_WINDOW (f), HWND_TOP,
14006 0, 0, 0, 0,
14007 SWP_NOMOVE | SWP_NOSIZE | SWP_NOACTIVATE);
14008
dc220243
JR
14009 UNBLOCK_INPUT;
14010 goto start_timer;
14011 }
14012 }
14013
6fc2811b
JR
14014 /* Hide a previous tip, if any. */
14015 Fx_hide_tip ();
ee78dc32 14016
dc220243
JR
14017 ASET (last_show_tip_args, 0, string);
14018 ASET (last_show_tip_args, 1, frame);
14019 ASET (last_show_tip_args, 2, parms);
14020
6fc2811b
JR
14021 /* Add default values to frame parameters. */
14022 if (NILP (Fassq (Qname, parms)))
14023 parms = Fcons (Fcons (Qname, build_string ("tooltip")), parms);
14024 if (NILP (Fassq (Qinternal_border_width, parms)))
14025 parms = Fcons (Fcons (Qinternal_border_width, make_number (3)), parms);
14026 if (NILP (Fassq (Qborder_width, parms)))
14027 parms = Fcons (Fcons (Qborder_width, make_number (1)), parms);
14028 if (NILP (Fassq (Qborder_color, parms)))
14029 parms = Fcons (Fcons (Qborder_color, build_string ("lightyellow")), parms);
14030 if (NILP (Fassq (Qbackground_color, parms)))
14031 parms = Fcons (Fcons (Qbackground_color, build_string ("lightyellow")),
14032 parms);
14033
0e3fcdef
JR
14034 /* Block input until the tip has been fully drawn, to avoid crashes
14035 when drawing tips in menus. */
14036 BLOCK_INPUT;
14037
6fc2811b
JR
14038 /* Create a frame for the tooltip, and record it in the global
14039 variable tip_frame. */
ca56d953 14040 frame = x_create_tip_frame (FRAME_W32_DISPLAY_INFO (f), parms, string);
937e601e 14041 f = XFRAME (frame);
6fc2811b 14042
3cf3436e 14043 /* Set up the frame's root window. */
6fc2811b
JR
14044 w = XWINDOW (FRAME_ROOT_WINDOW (f));
14045 w->left = w->top = make_number (0);
3cf3436e
JR
14046
14047 if (CONSP (Vx_max_tooltip_size)
14048 && INTEGERP (XCAR (Vx_max_tooltip_size))
14049 && XINT (XCAR (Vx_max_tooltip_size)) > 0
14050 && INTEGERP (XCDR (Vx_max_tooltip_size))
14051 && XINT (XCDR (Vx_max_tooltip_size)) > 0)
14052 {
14053 w->width = XCAR (Vx_max_tooltip_size);
14054 w->height = XCDR (Vx_max_tooltip_size);
14055 }
14056 else
14057 {
14058 w->width = make_number (80);
14059 w->height = make_number (40);
14060 }
14061
14062 f->window_width = XINT (w->width);
6fc2811b
JR
14063 adjust_glyphs (f);
14064 w->pseudo_window_p = 1;
14065
14066 /* Display the tooltip text in a temporary buffer. */
6fc2811b 14067 old_buffer = current_buffer;
3cf3436e
JR
14068 set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f))->buffer));
14069 current_buffer->truncate_lines = Qnil;
6fc2811b
JR
14070 clear_glyph_matrix (w->desired_matrix);
14071 clear_glyph_matrix (w->current_matrix);
14072 SET_TEXT_POS (pos, BEGV, BEGV_BYTE);
14073 try_window (FRAME_ROOT_WINDOW (f), pos);
14074
14075 /* Compute width and height of the tooltip. */
14076 width = height = 0;
14077 for (i = 0; i < w->desired_matrix->nrows; ++i)
ee78dc32 14078 {
6fc2811b
JR
14079 struct glyph_row *row = &w->desired_matrix->rows[i];
14080 struct glyph *last;
14081 int row_width;
14082
14083 /* Stop at the first empty row at the end. */
14084 if (!row->enabled_p || !row->displays_text_p)
14085 break;
14086
14087 /* Let the row go over the full width of the frame. */
14088 row->full_width_p = 1;
14089
4e3a1c61
JR
14090#ifdef TODO /* Investigate why some fonts need more width than is
14091 calculated for some tooltips. */
6fc2811b
JR
14092 /* There's a glyph at the end of rows that is use to place
14093 the cursor there. Don't include the width of this glyph. */
14094 if (row->used[TEXT_AREA])
14095 {
14096 last = &row->glyphs[TEXT_AREA][row->used[TEXT_AREA] - 1];
14097 row_width = row->pixel_width - last->pixel_width;
14098 }
14099 else
4e3a1c61 14100#endif
6fc2811b
JR
14101 row_width = row->pixel_width;
14102
ca56d953 14103 /* TODO: find why tips do not draw along baseline as instructed. */
bfd6edcc 14104 height += row->height;
6fc2811b 14105 width = max (width, row_width);
ee78dc32
GV
14106 }
14107
6fc2811b
JR
14108 /* Add the frame's internal border to the width and height the X
14109 window should have. */
14110 height += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
14111 width += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
ee78dc32 14112
6fc2811b
JR
14113 /* Move the tooltip window where the mouse pointer is. Resize and
14114 show it. */
3cf3436e 14115 compute_tip_xy (f, parms, dx, dy, width, height, &root_x, &root_y);
71eab8d1 14116
bfd6edcc
JR
14117 {
14118 /* Adjust Window size to take border into account. */
14119 RECT rect;
14120 rect.left = rect.top = 0;
14121 rect.right = width;
14122 rect.bottom = height;
14123 AdjustWindowRect (&rect, f->output_data.w32->dwStyle,
14124 FRAME_EXTERNAL_MENU_BAR (f));
14125
d65a9cdc 14126 /* Position and size tooltip, and put it in the topmost group. */
bfd6edcc
JR
14127 SetWindowPos (FRAME_W32_WINDOW (f), HWND_TOPMOST,
14128 root_x, root_y, rect.right - rect.left,
14129 rect.bottom - rect.top, SWP_NOACTIVATE);
14130
d65a9cdc
JR
14131 /* Ensure tooltip is on top of other topmost windows (eg menus). */
14132 SetWindowPos (FRAME_W32_WINDOW (f), HWND_TOP,
14133 0, 0, 0, 0,
14134 SWP_NOMOVE | SWP_NOSIZE | SWP_NOACTIVATE);
14135
bfd6edcc
JR
14136 /* Let redisplay know that we have made the frame visible already. */
14137 f->async_visible = 1;
14138
14139 ShowWindow (FRAME_W32_WINDOW (f), SW_SHOWNOACTIVATE);
14140 }
ee78dc32 14141
6fc2811b
JR
14142 /* Draw into the window. */
14143 w->must_be_updated_p = 1;
14144 update_single_window (w, 1);
ee78dc32 14145
0e3fcdef
JR
14146 UNBLOCK_INPUT;
14147
6fc2811b
JR
14148 /* Restore original current buffer. */
14149 set_buffer_internal_1 (old_buffer);
14150 windows_or_buffers_changed = old_windows_or_buffers_changed;
ee78dc32 14151
dc220243 14152 start_timer:
6fc2811b
JR
14153 /* Let the tip disappear after timeout seconds. */
14154 tip_timer = call3 (intern ("run-at-time"), timeout, Qnil,
14155 intern ("x-hide-tip"));
ee78dc32 14156
dfff8a69 14157 UNGCPRO;
6fc2811b 14158 return unbind_to (count, Qnil);
ee78dc32
GV
14159}
14160
ee78dc32 14161
6fc2811b 14162DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0,
74e1aeec
JR
14163 doc: /* Hide the current tooltip window, if there is any.
14164Value is t if tooltip was open, nil otherwise. */)
6fc2811b
JR
14165 ()
14166{
937e601e
AI
14167 int count;
14168 Lisp_Object deleted, frame, timer;
14169 struct gcpro gcpro1, gcpro2;
14170
14171 /* Return quickly if nothing to do. */
14172 if (NILP (tip_timer) && NILP (tip_frame))
14173 return Qnil;
14174
14175 frame = tip_frame;
14176 timer = tip_timer;
14177 GCPRO2 (frame, timer);
14178 tip_frame = tip_timer = deleted = Qnil;
6fc2811b 14179
331379bf 14180 count = SPECPDL_INDEX ();
6fc2811b 14181 specbind (Qinhibit_redisplay, Qt);
937e601e 14182 specbind (Qinhibit_quit, Qt);
6fc2811b 14183
937e601e 14184 if (!NILP (timer))
dc220243 14185 call1 (Qcancel_timer, timer);
ee78dc32 14186
937e601e 14187 if (FRAMEP (frame))
6fc2811b 14188 {
937e601e
AI
14189 Fdelete_frame (frame, Qnil);
14190 deleted = Qt;
6fc2811b 14191 }
1edf84e7 14192
937e601e
AI
14193 UNGCPRO;
14194 return unbind_to (count, deleted);
6fc2811b 14195}
5ac45f98 14196
5ac45f98 14197
6fc2811b
JR
14198\f
14199/***********************************************************************
14200 File selection dialog
14201 ***********************************************************************/
6fc2811b
JR
14202extern Lisp_Object Qfile_name_history;
14203
1030b26b
JR
14204/* Callback for altering the behaviour of the Open File dialog.
14205 Makes the Filename text field contain "Current Directory" and be
14206 read-only when "Directories" is selected in the filter. This
14207 allows us to work around the fact that the standard Open File
14208 dialog does not support directories. */
14209UINT CALLBACK
14210file_dialog_callback (hwnd, msg, wParam, lParam)
14211 HWND hwnd;
14212 UINT msg;
14213 WPARAM wParam;
14214 LPARAM lParam;
14215{
14216 if (msg == WM_NOTIFY)
14217 {
14218 OFNOTIFY * notify = (OFNOTIFY *)lParam;
14219 /* Detect when the Filter dropdown is changed. */
14220 if (notify->hdr.code == CDN_TYPECHANGE)
14221 {
14222 HWND dialog = GetParent (hwnd);
14223 HWND edit_control = GetDlgItem (dialog, FILE_NAME_TEXT_FIELD);
14224
14225 /* Directories is in index 2. */
14226 if (notify->lpOFN->nFilterIndex == 2)
14227 {
14228 CommDlg_OpenSave_SetControlText (dialog, FILE_NAME_TEXT_FIELD,
14229 "Current Directory");
14230 EnableWindow (edit_control, FALSE);
14231 }
14232 else
14233 {
14234 CommDlg_OpenSave_SetControlText (dialog, FILE_NAME_TEXT_FIELD,
14235 "");
14236 EnableWindow (edit_control, TRUE);
14237 }
14238 }
14239 }
14240 return 0;
14241}
14242
6fc2811b 14243DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 4, 0,
74e1aeec
JR
14244 doc: /* Read file name, prompting with PROMPT in directory DIR.
14245Use a file selection dialog.
14246Select DEFAULT-FILENAME in the dialog's file selection box, if
14247specified. Ensure that file exists if MUSTMATCH is non-nil. */)
6fc2811b
JR
14248 (prompt, dir, default_filename, mustmatch)
14249 Lisp_Object prompt, dir, default_filename, mustmatch;
14250{
14251 struct frame *f = SELECTED_FRAME ();
14252 Lisp_Object file = Qnil;
aed13378 14253 int count = SPECPDL_INDEX ();
6fc2811b
JR
14254 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
14255 char filename[MAX_PATH + 1];
14256 char init_dir[MAX_PATH + 1];
6fc2811b
JR
14257
14258 GCPRO5 (prompt, dir, default_filename, mustmatch, file);
b7826503
PJ
14259 CHECK_STRING (prompt);
14260 CHECK_STRING (dir);
6fc2811b
JR
14261
14262 /* Create the dialog with PROMPT as title, using DIR as initial
14263 directory and using "*" as pattern. */
14264 dir = Fexpand_file_name (dir, Qnil);
d5db4077 14265 strncpy (init_dir, SDATA (dir), MAX_PATH);
6fc2811b
JR
14266 init_dir[MAX_PATH] = '\0';
14267 unixtodos_filename (init_dir);
14268
14269 if (STRINGP (default_filename))
14270 {
14271 char *file_name_only;
d5db4077 14272 char *full_path_name = SDATA (default_filename);
5ac45f98 14273
6fc2811b 14274 unixtodos_filename (full_path_name);
5ac45f98 14275
6fc2811b
JR
14276 file_name_only = strrchr (full_path_name, '\\');
14277 if (!file_name_only)
14278 file_name_only = full_path_name;
14279 else
14280 {
14281 file_name_only++;
6fc2811b 14282 }
ee78dc32 14283
6fc2811b
JR
14284 strncpy (filename, file_name_only, MAX_PATH);
14285 filename[MAX_PATH] = '\0';
14286 }
ee78dc32 14287 else
6fc2811b 14288 filename[0] = '\0';
ee78dc32 14289
1030b26b
JR
14290 {
14291 OPENFILENAME file_details;
5ac45f98 14292
1030b26b
JR
14293 /* Prevent redisplay. */
14294 specbind (Qinhibit_redisplay, Qt);
14295 BLOCK_INPUT;
ee78dc32 14296
1030b26b
JR
14297 bzero (&file_details, sizeof (file_details));
14298 file_details.lStructSize = sizeof (file_details);
14299 file_details.hwndOwner = FRAME_W32_WINDOW (f);
14300 /* Undocumented Bug in Common File Dialog:
14301 If a filter is not specified, shell links are not resolved. */
14302 file_details.lpstrFilter = "All Files (*.*)\0*.*\0Directories\0*|*\0\0";
14303 file_details.lpstrFile = filename;
14304 file_details.nMaxFile = sizeof (filename);
14305 file_details.lpstrInitialDir = init_dir;
d5db4077 14306 file_details.lpstrTitle = SDATA (prompt);
1030b26b
JR
14307 file_details.Flags = (OFN_HIDEREADONLY | OFN_NOCHANGEDIR
14308 | OFN_EXPLORER | OFN_ENABLEHOOK);
14309 if (!NILP (mustmatch))
14310 file_details.Flags |= OFN_FILEMUSTEXIST | OFN_PATHMUSTEXIST;
14311
14312 file_details.lpfnHook = (LPOFNHOOKPROC) file_dialog_callback;
14313
14314 if (GetOpenFileName (&file_details))
14315 {
14316 dostounix_filename (filename);
14317 if (file_details.nFilterIndex == 2)
14318 {
14319 /* "Folder Only" selected - strip dummy file name. */
14320 char * last = strrchr (filename, '/');
14321 *last = '\0';
14322 }
6fc2811b 14323
1030b26b
JR
14324 file = DECODE_FILE(build_string (filename));
14325 }
14326 /* User cancelled the dialog without making a selection. */
14327 else if (!CommDlgExtendedError ())
14328 file = Qnil;
14329 /* An error occurred, fallback on reading from the mini-buffer. */
14330 else
14331 file = Fcompleting_read (prompt, intern ("read-file-name-internal"),
14332 dir, mustmatch, dir, Qfile_name_history,
14333 default_filename, Qnil);
14334
14335 UNBLOCK_INPUT;
14336 file = unbind_to (count, file);
14337 }
ee78dc32 14338
6fc2811b 14339 UNGCPRO;
1edf84e7 14340
6fc2811b
JR
14341 /* Make "Cancel" equivalent to C-g. */
14342 if (NILP (file))
14343 Fsignal (Qquit, Qnil);
ee78dc32 14344
dfff8a69 14345 return unbind_to (count, file);
6fc2811b 14346}
ee78dc32 14347
ee78dc32 14348
6fc2811b 14349\f
6fc2811b
JR
14350/***********************************************************************
14351 w32 specialized functions
14352 ***********************************************************************/
ee78dc32 14353
d84b082d 14354DEFUN ("w32-select-font", Fw32_select_font, Sw32_select_font, 0, 2, 0,
74e1aeec
JR
14355 doc: /* Select a font using the W32 font dialog.
14356Returns an X font string corresponding to the selection. */)
d84b082d
JR
14357 (frame, include_proportional)
14358 Lisp_Object frame, include_proportional;
ee78dc32
GV
14359{
14360 FRAME_PTR f = check_x_frame (frame);
14361 CHOOSEFONT cf;
14362 LOGFONT lf;
f46e6225
GV
14363 TEXTMETRIC tm;
14364 HDC hdc;
14365 HANDLE oldobj;
ee78dc32
GV
14366 char buf[100];
14367
14368 bzero (&cf, sizeof (cf));
f46e6225 14369 bzero (&lf, sizeof (lf));
ee78dc32
GV
14370
14371 cf.lStructSize = sizeof (cf);
fbd6baed 14372 cf.hwndOwner = FRAME_W32_WINDOW (f);
d84b082d
JR
14373 cf.Flags = CF_FORCEFONTEXIST | CF_SCREENFONTS | CF_NOVERTFONTS;
14374
14375 /* Unless include_proportional is non-nil, limit the selection to
14376 monospaced fonts. */
14377 if (NILP (include_proportional))
14378 cf.Flags |= CF_FIXEDPITCHONLY;
14379
ee78dc32
GV
14380 cf.lpLogFont = &lf;
14381
f46e6225
GV
14382 /* Initialize as much of the font details as we can from the current
14383 default font. */
14384 hdc = GetDC (FRAME_W32_WINDOW (f));
14385 oldobj = SelectObject (hdc, FRAME_FONT (f)->hfont);
14386 GetTextFace (hdc, LF_FACESIZE, lf.lfFaceName);
14387 if (GetTextMetrics (hdc, &tm))
14388 {
14389 lf.lfHeight = tm.tmInternalLeading - tm.tmHeight;
14390 lf.lfWeight = tm.tmWeight;
14391 lf.lfItalic = tm.tmItalic;
14392 lf.lfUnderline = tm.tmUnderlined;
14393 lf.lfStrikeOut = tm.tmStruckOut;
f46e6225
GV
14394 lf.lfCharSet = tm.tmCharSet;
14395 cf.Flags |= CF_INITTOLOGFONTSTRUCT;
14396 }
14397 SelectObject (hdc, oldobj);
6fc2811b 14398 ReleaseDC (FRAME_W32_WINDOW (f), hdc);
f46e6225 14399
767b1ff0 14400 if (!ChooseFont (&cf) || !w32_to_x_font (&lf, buf, 100, NULL))
3c190163 14401 return Qnil;
ee78dc32
GV
14402
14403 return build_string (buf);
14404}
14405
74e1aeec
JR
14406DEFUN ("w32-send-sys-command", Fw32_send_sys_command,
14407 Sw32_send_sys_command, 1, 2, 0,
14408 doc: /* Send frame a Windows WM_SYSCOMMAND message of type COMMAND.
d84b082d
JR
14409Some useful values for command are #xf030 to maximise frame (#xf020
14410to minimize), #xf120 to restore frame to original size, and #xf100
14411to activate the menubar for keyboard access. #xf140 activates the
74e1aeec
JR
14412screen saver if defined.
14413
14414If optional parameter FRAME is not specified, use selected frame. */)
1edf84e7
GV
14415 (command, frame)
14416 Lisp_Object command, frame;
14417{
1edf84e7
GV
14418 FRAME_PTR f = check_x_frame (frame);
14419
b7826503 14420 CHECK_NUMBER (command);
1edf84e7 14421
ce6059da 14422 PostMessage (FRAME_W32_WINDOW (f), WM_SYSCOMMAND, XINT (command), 0);
1edf84e7
GV
14423
14424 return Qnil;
14425}
14426
55dcfc15 14427DEFUN ("w32-shell-execute", Fw32_shell_execute, Sw32_shell_execute, 2, 4, 0,
74e1aeec
JR
14428 doc: /* Get Windows to perform OPERATION on DOCUMENT.
14429This is a wrapper around the ShellExecute system function, which
14430invokes the application registered to handle OPERATION for DOCUMENT.
14431OPERATION is typically \"open\", \"print\" or \"explore\" (but can be
14432nil for the default action), and DOCUMENT is typically the name of a
14433document file or URL, but can also be a program executable to run or
14434a directory to open in the Windows Explorer.
14435
14436If DOCUMENT is a program executable, PARAMETERS can be a string
14437containing command line parameters, but otherwise should be nil.
14438
14439SHOW-FLAG can be used to control whether the invoked application is hidden
14440or minimized. If SHOW-FLAG is nil, the application is displayed normally,
14441otherwise it is an integer representing a ShowWindow flag:
14442
14443 0 - start hidden
14444 1 - start normally
14445 3 - start maximized
14446 6 - start minimized */)
55dcfc15
AI
14447 (operation, document, parameters, show_flag)
14448 Lisp_Object operation, document, parameters, show_flag;
14449{
14450 Lisp_Object current_dir;
14451
b7826503 14452 CHECK_STRING (document);
55dcfc15
AI
14453
14454 /* Encode filename and current directory. */
14455 current_dir = ENCODE_FILE (current_buffer->directory);
14456 document = ENCODE_FILE (document);
14457 if ((int) ShellExecute (NULL,
6fc2811b 14458 (STRINGP (operation) ?
d5db4077
KR
14459 SDATA (operation) : NULL),
14460 SDATA (document),
55dcfc15 14461 (STRINGP (parameters) ?
d5db4077
KR
14462 SDATA (parameters) : NULL),
14463 SDATA (current_dir),
55dcfc15
AI
14464 (INTEGERP (show_flag) ?
14465 XINT (show_flag) : SW_SHOWDEFAULT))
14466 > 32)
14467 return Qt;
90d97e64 14468 error ("ShellExecute failed: %s", w32_strerror (0));
55dcfc15
AI
14469}
14470
ccc2d29c
GV
14471/* Lookup virtual keycode from string representing the name of a
14472 non-ascii keystroke into the corresponding virtual key, using
14473 lispy_function_keys. */
14474static int
14475lookup_vk_code (char *key)
14476{
14477 int i;
14478
14479 for (i = 0; i < 256; i++)
14480 if (lispy_function_keys[i] != 0
14481 && strcmp (lispy_function_keys[i], key) == 0)
14482 return i;
14483
14484 return -1;
14485}
14486
14487/* Convert a one-element vector style key sequence to a hot key
14488 definition. */
14489static int
14490w32_parse_hot_key (key)
14491 Lisp_Object key;
14492{
14493 /* Copied from Fdefine_key and store_in_keymap. */
14494 register Lisp_Object c;
14495 int vk_code;
14496 int lisp_modifiers;
14497 int w32_modifiers;
14498 struct gcpro gcpro1;
14499
b7826503 14500 CHECK_VECTOR (key);
ccc2d29c
GV
14501
14502 if (XFASTINT (Flength (key)) != 1)
14503 return Qnil;
14504
14505 GCPRO1 (key);
14506
14507 c = Faref (key, make_number (0));
14508
14509 if (CONSP (c) && lucid_event_type_list_p (c))
14510 c = Fevent_convert_list (c);
14511
14512 UNGCPRO;
14513
14514 if (! INTEGERP (c) && ! SYMBOLP (c))
14515 error ("Key definition is invalid");
14516
14517 /* Work out the base key and the modifiers. */
14518 if (SYMBOLP (c))
14519 {
14520 c = parse_modifiers (c);
14521 lisp_modifiers = Fcar (Fcdr (c));
14522 c = Fcar (c);
14523 if (!SYMBOLP (c))
14524 abort ();
d5db4077 14525 vk_code = lookup_vk_code (SDATA (SYMBOL_NAME (c)));
ccc2d29c
GV
14526 }
14527 else if (INTEGERP (c))
14528 {
14529 lisp_modifiers = XINT (c) & ~CHARACTERBITS;
14530 /* Many ascii characters are their own virtual key code. */
14531 vk_code = XINT (c) & CHARACTERBITS;
14532 }
14533
14534 if (vk_code < 0 || vk_code > 255)
14535 return Qnil;
14536
14537 if ((lisp_modifiers & meta_modifier) != 0
14538 && !NILP (Vw32_alt_is_meta))
14539 lisp_modifiers |= alt_modifier;
14540
71eab8d1
AI
14541 /* Supply defs missing from mingw32. */
14542#ifndef MOD_ALT
14543#define MOD_ALT 0x0001
14544#define MOD_CONTROL 0x0002
14545#define MOD_SHIFT 0x0004
14546#define MOD_WIN 0x0008
14547#endif
14548
ccc2d29c
GV
14549 /* Convert lisp modifiers to Windows hot-key form. */
14550 w32_modifiers = (lisp_modifiers & hyper_modifier) ? MOD_WIN : 0;
14551 w32_modifiers |= (lisp_modifiers & alt_modifier) ? MOD_ALT : 0;
14552 w32_modifiers |= (lisp_modifiers & ctrl_modifier) ? MOD_CONTROL : 0;
14553 w32_modifiers |= (lisp_modifiers & shift_modifier) ? MOD_SHIFT : 0;
14554
14555 return HOTKEY (vk_code, w32_modifiers);
14556}
14557
74e1aeec
JR
14558DEFUN ("w32-register-hot-key", Fw32_register_hot_key,
14559 Sw32_register_hot_key, 1, 1, 0,
14560 doc: /* Register KEY as a hot-key combination.
14561Certain key combinations like Alt-Tab are reserved for system use on
14562Windows, and therefore are normally intercepted by the system. However,
14563most of these key combinations can be received by registering them as
14564hot-keys, overriding their special meaning.
14565
14566KEY must be a one element key definition in vector form that would be
14567acceptable to `define-key' (e.g. [A-tab] for Alt-Tab). The meta
14568modifier is interpreted as Alt if `w32-alt-is-meta' is t, and hyper
14569is always interpreted as the Windows modifier keys.
14570
14571The return value is the hotkey-id if registered, otherwise nil. */)
ccc2d29c
GV
14572 (key)
14573 Lisp_Object key;
14574{
14575 key = w32_parse_hot_key (key);
14576
14577 if (NILP (Fmemq (key, w32_grabbed_keys)))
14578 {
14579 /* Reuse an empty slot if possible. */
14580 Lisp_Object item = Fmemq (Qnil, w32_grabbed_keys);
14581
14582 /* Safe to add new key to list, even if we have focus. */
14583 if (NILP (item))
14584 w32_grabbed_keys = Fcons (key, w32_grabbed_keys);
14585 else
f3fbd155 14586 XSETCAR (item, key);
ccc2d29c
GV
14587
14588 /* Notify input thread about new hot-key definition, so that it
14589 takes effect without needing to switch focus. */
14590 PostThreadMessage (dwWindowsThreadId, WM_EMACS_REGISTER_HOT_KEY,
14591 (WPARAM) key, 0);
14592 }
14593
14594 return key;
14595}
14596
74e1aeec
JR
14597DEFUN ("w32-unregister-hot-key", Fw32_unregister_hot_key,
14598 Sw32_unregister_hot_key, 1, 1, 0,
14599 doc: /* Unregister HOTKEY as a hot-key combination. */)
ccc2d29c
GV
14600 (key)
14601 Lisp_Object key;
14602{
14603 Lisp_Object item;
14604
14605 if (!INTEGERP (key))
14606 key = w32_parse_hot_key (key);
14607
14608 item = Fmemq (key, w32_grabbed_keys);
14609
14610 if (!NILP (item))
14611 {
14612 /* Notify input thread about hot-key definition being removed, so
14613 that it takes effect without needing focus switch. */
14614 if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_UNREGISTER_HOT_KEY,
14615 (WPARAM) XINT (XCAR (item)), (LPARAM) item))
14616 {
14617 MSG msg;
14618 GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
14619 }
14620 return Qt;
14621 }
14622 return Qnil;
14623}
14624
74e1aeec
JR
14625DEFUN ("w32-registered-hot-keys", Fw32_registered_hot_keys,
14626 Sw32_registered_hot_keys, 0, 0, 0,
14627 doc: /* Return list of registered hot-key IDs. */)
ccc2d29c
GV
14628 ()
14629{
14630 return Fcopy_sequence (w32_grabbed_keys);
14631}
14632
74e1aeec
JR
14633DEFUN ("w32-reconstruct-hot-key", Fw32_reconstruct_hot_key,
14634 Sw32_reconstruct_hot_key, 1, 1, 0,
14635 doc: /* Convert hot-key ID to a lisp key combination. */)
ccc2d29c
GV
14636 (hotkeyid)
14637 Lisp_Object hotkeyid;
14638{
14639 int vk_code, w32_modifiers;
14640 Lisp_Object key;
14641
b7826503 14642 CHECK_NUMBER (hotkeyid);
ccc2d29c
GV
14643
14644 vk_code = HOTKEY_VK_CODE (hotkeyid);
14645 w32_modifiers = HOTKEY_MODIFIERS (hotkeyid);
14646
14647 if (lispy_function_keys[vk_code])
14648 key = intern (lispy_function_keys[vk_code]);
14649 else
14650 key = make_number (vk_code);
14651
14652 key = Fcons (key, Qnil);
14653 if (w32_modifiers & MOD_SHIFT)
3ef68e6b 14654 key = Fcons (Qshift, key);
ccc2d29c 14655 if (w32_modifiers & MOD_CONTROL)
3ef68e6b 14656 key = Fcons (Qctrl, key);
ccc2d29c 14657 if (w32_modifiers & MOD_ALT)
3ef68e6b 14658 key = Fcons (NILP (Vw32_alt_is_meta) ? Qalt : Qmeta, key);
ccc2d29c 14659 if (w32_modifiers & MOD_WIN)
3ef68e6b 14660 key = Fcons (Qhyper, key);
ccc2d29c
GV
14661
14662 return key;
14663}
adcc3809 14664
74e1aeec
JR
14665DEFUN ("w32-toggle-lock-key", Fw32_toggle_lock_key,
14666 Sw32_toggle_lock_key, 1, 2, 0,
14667 doc: /* Toggle the state of the lock key KEY.
14668KEY can be `capslock', `kp-numlock', or `scroll'.
14669If the optional parameter NEW-STATE is a number, then the state of KEY
14670is set to off if the low bit of NEW-STATE is zero, otherwise on. */)
adcc3809
GV
14671 (key, new_state)
14672 Lisp_Object key, new_state;
14673{
14674 int vk_code;
adcc3809
GV
14675
14676 if (EQ (key, intern ("capslock")))
14677 vk_code = VK_CAPITAL;
14678 else if (EQ (key, intern ("kp-numlock")))
14679 vk_code = VK_NUMLOCK;
14680 else if (EQ (key, intern ("scroll")))
14681 vk_code = VK_SCROLL;
14682 else
14683 return Qnil;
14684
14685 if (!dwWindowsThreadId)
14686 return make_number (w32_console_toggle_lock_key (vk_code, new_state));
14687
14688 if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_TOGGLE_LOCK_KEY,
14689 (WPARAM) vk_code, (LPARAM) new_state))
14690 {
14691 MSG msg;
14692 GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
14693 return make_number (msg.wParam);
14694 }
14695 return Qnil;
14696}
ee78dc32 14697\f
2254bcde 14698DEFUN ("file-system-info", Ffile_system_info, Sfile_system_info, 1, 1, 0,
74e1aeec
JR
14699 doc: /* Return storage information about the file system FILENAME is on.
14700Value is a list of floats (TOTAL FREE AVAIL), where TOTAL is the total
14701storage of the file system, FREE is the free storage, and AVAIL is the
14702storage available to a non-superuser. All 3 numbers are in bytes.
14703If the underlying system call fails, value is nil. */)
2254bcde
AI
14704 (filename)
14705 Lisp_Object filename;
14706{
14707 Lisp_Object encoded, value;
14708
b7826503 14709 CHECK_STRING (filename);
2254bcde
AI
14710 filename = Fexpand_file_name (filename, Qnil);
14711 encoded = ENCODE_FILE (filename);
14712
14713 value = Qnil;
14714
14715 /* Determining the required information on Windows turns out, sadly,
14716 to be more involved than one would hope. The original Win32 api
14717 call for this will return bogus information on some systems, but we
14718 must dynamically probe for the replacement api, since that was
14719 added rather late on. */
14720 {
14721 HMODULE hKernel = GetModuleHandle ("kernel32");
14722 BOOL (*pfn_GetDiskFreeSpaceEx)
14723 (char *, PULARGE_INTEGER, PULARGE_INTEGER, PULARGE_INTEGER)
14724 = (void *) GetProcAddress (hKernel, "GetDiskFreeSpaceEx");
14725
14726 /* On Windows, we may need to specify the root directory of the
14727 volume holding FILENAME. */
14728 char rootname[MAX_PATH];
d5db4077 14729 char *name = SDATA (encoded);
2254bcde
AI
14730
14731 /* find the root name of the volume if given */
14732 if (isalpha (name[0]) && name[1] == ':')
14733 {
14734 rootname[0] = name[0];
14735 rootname[1] = name[1];
14736 rootname[2] = '\\';
14737 rootname[3] = 0;
14738 }
14739 else if (IS_DIRECTORY_SEP (name[0]) && IS_DIRECTORY_SEP (name[1]))
14740 {
14741 char *str = rootname;
14742 int slashes = 4;
14743 do
14744 {
14745 if (IS_DIRECTORY_SEP (*name) && --slashes == 0)
14746 break;
14747 *str++ = *name++;
14748 }
14749 while ( *name );
14750
14751 *str++ = '\\';
14752 *str = 0;
14753 }
14754
14755 if (pfn_GetDiskFreeSpaceEx)
14756 {
ac849ba4
JR
14757 /* Unsigned large integers cannot be cast to double, so
14758 use signed ones instead. */
2254bcde
AI
14759 LARGE_INTEGER availbytes;
14760 LARGE_INTEGER freebytes;
14761 LARGE_INTEGER totalbytes;
14762
14763 if (pfn_GetDiskFreeSpaceEx(rootname,
ac849ba4
JR
14764 (ULARGE_INTEGER *)&availbytes,
14765 (ULARGE_INTEGER *)&totalbytes,
14766 (ULARGE_INTEGER *)&freebytes))
2254bcde
AI
14767 value = list3 (make_float ((double) totalbytes.QuadPart),
14768 make_float ((double) freebytes.QuadPart),
14769 make_float ((double) availbytes.QuadPart));
14770 }
14771 else
14772 {
14773 DWORD sectors_per_cluster;
14774 DWORD bytes_per_sector;
14775 DWORD free_clusters;
14776 DWORD total_clusters;
14777
14778 if (GetDiskFreeSpace(rootname,
14779 &sectors_per_cluster,
14780 &bytes_per_sector,
14781 &free_clusters,
14782 &total_clusters))
14783 value = list3 (make_float ((double) total_clusters
14784 * sectors_per_cluster * bytes_per_sector),
14785 make_float ((double) free_clusters
14786 * sectors_per_cluster * bytes_per_sector),
14787 make_float ((double) free_clusters
14788 * sectors_per_cluster * bytes_per_sector));
14789 }
14790 }
14791
14792 return value;
14793}
14794\f
0e3fcdef
JR
14795/***********************************************************************
14796 Initialization
14797 ***********************************************************************/
14798
14799void
fbd6baed 14800syms_of_w32fns ()
ee78dc32 14801{
9eb16b62
JR
14802 HMODULE user32_lib = GetModuleHandle ("user32.dll");
14803
1edf84e7
GV
14804 /* This is zero if not using MS-Windows. */
14805 w32_in_use = 0;
14806
9eb16b62
JR
14807 /* TrackMouseEvent not available in all versions of Windows, so must load
14808 it dynamically. Do it once, here, instead of every time it is used. */
14809 track_mouse_event_fn = GetProcAddress (user32_lib, "TrackMouseEvent");
14810 track_mouse_window = NULL;
14811
d285988b
JR
14812 w32_visible_system_caret_hwnd = NULL;
14813
ee78dc32
GV
14814 Qauto_raise = intern ("auto-raise");
14815 staticpro (&Qauto_raise);
14816 Qauto_lower = intern ("auto-lower");
14817 staticpro (&Qauto_lower);
ee78dc32
GV
14818 Qborder_color = intern ("border-color");
14819 staticpro (&Qborder_color);
14820 Qborder_width = intern ("border-width");
14821 staticpro (&Qborder_width);
ee78dc32
GV
14822 Qcursor_color = intern ("cursor-color");
14823 staticpro (&Qcursor_color);
14824 Qcursor_type = intern ("cursor-type");
14825 staticpro (&Qcursor_type);
ee78dc32
GV
14826 Qgeometry = intern ("geometry");
14827 staticpro (&Qgeometry);
14828 Qicon_left = intern ("icon-left");
14829 staticpro (&Qicon_left);
14830 Qicon_top = intern ("icon-top");
14831 staticpro (&Qicon_top);
14832 Qicon_type = intern ("icon-type");
14833 staticpro (&Qicon_type);
14834 Qicon_name = intern ("icon-name");
14835 staticpro (&Qicon_name);
14836 Qinternal_border_width = intern ("internal-border-width");
14837 staticpro (&Qinternal_border_width);
14838 Qleft = intern ("left");
14839 staticpro (&Qleft);
1026b400
RS
14840 Qright = intern ("right");
14841 staticpro (&Qright);
ee78dc32
GV
14842 Qmouse_color = intern ("mouse-color");
14843 staticpro (&Qmouse_color);
14844 Qnone = intern ("none");
14845 staticpro (&Qnone);
14846 Qparent_id = intern ("parent-id");
14847 staticpro (&Qparent_id);
14848 Qscroll_bar_width = intern ("scroll-bar-width");
14849 staticpro (&Qscroll_bar_width);
14850 Qsuppress_icon = intern ("suppress-icon");
14851 staticpro (&Qsuppress_icon);
ee78dc32
GV
14852 Qundefined_color = intern ("undefined-color");
14853 staticpro (&Qundefined_color);
14854 Qvertical_scroll_bars = intern ("vertical-scroll-bars");
14855 staticpro (&Qvertical_scroll_bars);
14856 Qvisibility = intern ("visibility");
14857 staticpro (&Qvisibility);
14858 Qwindow_id = intern ("window-id");
14859 staticpro (&Qwindow_id);
14860 Qx_frame_parameter = intern ("x-frame-parameter");
14861 staticpro (&Qx_frame_parameter);
14862 Qx_resource_name = intern ("x-resource-name");
14863 staticpro (&Qx_resource_name);
14864 Quser_position = intern ("user-position");
14865 staticpro (&Quser_position);
14866 Quser_size = intern ("user-size");
14867 staticpro (&Quser_size);
6fc2811b
JR
14868 Qscreen_gamma = intern ("screen-gamma");
14869 staticpro (&Qscreen_gamma);
dfff8a69
JR
14870 Qline_spacing = intern ("line-spacing");
14871 staticpro (&Qline_spacing);
14872 Qcenter = intern ("center");
14873 staticpro (&Qcenter);
dc220243
JR
14874 Qcancel_timer = intern ("cancel-timer");
14875 staticpro (&Qcancel_timer);
f7b9d4d1
JR
14876 Qfullscreen = intern ("fullscreen");
14877 staticpro (&Qfullscreen);
14878 Qfullwidth = intern ("fullwidth");
14879 staticpro (&Qfullwidth);
14880 Qfullheight = intern ("fullheight");
14881 staticpro (&Qfullheight);
14882 Qfullboth = intern ("fullboth");
14883 staticpro (&Qfullboth);
ee78dc32 14884
adcc3809
GV
14885 Qhyper = intern ("hyper");
14886 staticpro (&Qhyper);
14887 Qsuper = intern ("super");
14888 staticpro (&Qsuper);
14889 Qmeta = intern ("meta");
14890 staticpro (&Qmeta);
14891 Qalt = intern ("alt");
14892 staticpro (&Qalt);
14893 Qctrl = intern ("ctrl");
14894 staticpro (&Qctrl);
14895 Qcontrol = intern ("control");
14896 staticpro (&Qcontrol);
14897 Qshift = intern ("shift");
14898 staticpro (&Qshift);
f7b9d4d1 14899 /* This is the end of symbol initialization. */
adcc3809 14900
6fc2811b
JR
14901 /* Text property `display' should be nonsticky by default. */
14902 Vtext_property_default_nonsticky
14903 = Fcons (Fcons (Qdisplay, Qt), Vtext_property_default_nonsticky);
14904
14905
14906 Qlaplace = intern ("laplace");
14907 staticpro (&Qlaplace);
3cf3436e
JR
14908 Qemboss = intern ("emboss");
14909 staticpro (&Qemboss);
14910 Qedge_detection = intern ("edge-detection");
14911 staticpro (&Qedge_detection);
14912 Qheuristic = intern ("heuristic");
14913 staticpro (&Qheuristic);
14914 QCmatrix = intern (":matrix");
14915 staticpro (&QCmatrix);
14916 QCcolor_adjustment = intern (":color-adjustment");
14917 staticpro (&QCcolor_adjustment);
14918 QCmask = intern (":mask");
14919 staticpro (&QCmask);
6fc2811b 14920
4b817373
RS
14921 Qface_set_after_frame_default = intern ("face-set-after-frame-default");
14922 staticpro (&Qface_set_after_frame_default);
14923
ee78dc32
GV
14924 Fput (Qundefined_color, Qerror_conditions,
14925 Fcons (Qundefined_color, Fcons (Qerror, Qnil)));
14926 Fput (Qundefined_color, Qerror_message,
14927 build_string ("Undefined color"));
14928
ccc2d29c
GV
14929 staticpro (&w32_grabbed_keys);
14930 w32_grabbed_keys = Qnil;
14931
fbd6baed 14932 DEFVAR_LISP ("w32-color-map", &Vw32_color_map,
74e1aeec 14933 doc: /* An array of color name mappings for windows. */);
fbd6baed 14934 Vw32_color_map = Qnil;
ee78dc32 14935
fbd6baed 14936 DEFVAR_LISP ("w32-pass-alt-to-system", &Vw32_pass_alt_to_system,
74e1aeec
JR
14937 doc: /* Non-nil if alt key presses are passed on to Windows.
14938When non-nil, for example, alt pressed and released and then space will
14939open the System menu. When nil, Emacs silently swallows alt key events. */);
fbd6baed 14940 Vw32_pass_alt_to_system = Qnil;
da36a4d6 14941
fbd6baed 14942 DEFVAR_LISP ("w32-alt-is-meta", &Vw32_alt_is_meta,
74e1aeec
JR
14943 doc: /* Non-nil if the alt key is to be considered the same as the meta key.
14944When nil, Emacs will translate the alt key to the Alt modifier, and not Meta. */);
fbd6baed 14945 Vw32_alt_is_meta = Qt;
8c205c63 14946
7d081355 14947 DEFVAR_INT ("w32-quit-key", &Vw32_quit_key,
74e1aeec 14948 doc: /* If non-zero, the virtual key code for an alternative quit key. */);
7d081355
AI
14949 XSETINT (Vw32_quit_key, 0);
14950
ccc2d29c
GV
14951 DEFVAR_LISP ("w32-pass-lwindow-to-system",
14952 &Vw32_pass_lwindow_to_system,
74e1aeec
JR
14953 doc: /* Non-nil if the left \"Windows\" key is passed on to Windows.
14954When non-nil, the Start menu is opened by tapping the key. */);
ccc2d29c
GV
14955 Vw32_pass_lwindow_to_system = Qt;
14956
14957 DEFVAR_LISP ("w32-pass-rwindow-to-system",
14958 &Vw32_pass_rwindow_to_system,
74e1aeec
JR
14959 doc: /* Non-nil if the right \"Windows\" key is passed on to Windows.
14960When non-nil, the Start menu is opened by tapping the key. */);
ccc2d29c
GV
14961 Vw32_pass_rwindow_to_system = Qt;
14962
adcc3809
GV
14963 DEFVAR_INT ("w32-phantom-key-code",
14964 &Vw32_phantom_key_code,
74e1aeec
JR
14965 doc: /* Virtual key code used to generate \"phantom\" key presses.
14966Value is a number between 0 and 255.
14967
14968Phantom key presses are generated in order to stop the system from
14969acting on \"Windows\" key events when `w32-pass-lwindow-to-system' or
14970`w32-pass-rwindow-to-system' is nil. */);
ce6059da
AI
14971 /* Although 255 is technically not a valid key code, it works and
14972 means that this hack won't interfere with any real key code. */
14973 Vw32_phantom_key_code = 255;
adcc3809 14974
ccc2d29c
GV
14975 DEFVAR_LISP ("w32-enable-num-lock",
14976 &Vw32_enable_num_lock,
74e1aeec
JR
14977 doc: /* Non-nil if Num Lock should act normally.
14978Set to nil to see Num Lock as the key `kp-numlock'. */);
ccc2d29c
GV
14979 Vw32_enable_num_lock = Qt;
14980
14981 DEFVAR_LISP ("w32-enable-caps-lock",
14982 &Vw32_enable_caps_lock,
74e1aeec
JR
14983 doc: /* Non-nil if Caps Lock should act normally.
14984Set to nil to see Caps Lock as the key `capslock'. */);
ccc2d29c
GV
14985 Vw32_enable_caps_lock = Qt;
14986
14987 DEFVAR_LISP ("w32-scroll-lock-modifier",
14988 &Vw32_scroll_lock_modifier,
74e1aeec
JR
14989 doc: /* Modifier to use for the Scroll Lock on state.
14990The value can be hyper, super, meta, alt, control or shift for the
14991respective modifier, or nil to see Scroll Lock as the key `scroll'.
14992Any other value will cause the key to be ignored. */);
ccc2d29c
GV
14993 Vw32_scroll_lock_modifier = Qt;
14994
14995 DEFVAR_LISP ("w32-lwindow-modifier",
14996 &Vw32_lwindow_modifier,
74e1aeec
JR
14997 doc: /* Modifier to use for the left \"Windows\" key.
14998The value can be hyper, super, meta, alt, control or shift for the
14999respective modifier, or nil to appear as the key `lwindow'.
15000Any other value will cause the key to be ignored. */);
ccc2d29c
GV
15001 Vw32_lwindow_modifier = Qnil;
15002
15003 DEFVAR_LISP ("w32-rwindow-modifier",
15004 &Vw32_rwindow_modifier,
74e1aeec
JR
15005 doc: /* Modifier to use for the right \"Windows\" key.
15006The value can be hyper, super, meta, alt, control or shift for the
15007respective modifier, or nil to appear as the key `rwindow'.
15008Any other value will cause the key to be ignored. */);
ccc2d29c
GV
15009 Vw32_rwindow_modifier = Qnil;
15010
15011 DEFVAR_LISP ("w32-apps-modifier",
15012 &Vw32_apps_modifier,
74e1aeec
JR
15013 doc: /* Modifier to use for the \"Apps\" key.
15014The value can be hyper, super, meta, alt, control or shift for the
15015respective modifier, or nil to appear as the key `apps'.
15016Any other value will cause the key to be ignored. */);
ccc2d29c 15017 Vw32_apps_modifier = Qnil;
da36a4d6 15018
d84b082d 15019 DEFVAR_BOOL ("w32-enable-synthesized-fonts", &w32_enable_synthesized_fonts,
74e1aeec 15020 doc: /* Non-nil enables selection of artificially italicized and bold fonts. */);
d84b082d 15021 w32_enable_synthesized_fonts = 0;
5ac45f98 15022
fbd6baed 15023 DEFVAR_LISP ("w32-enable-palette", &Vw32_enable_palette,
74e1aeec 15024 doc: /* Non-nil enables Windows palette management to map colors exactly. */);
fbd6baed 15025 Vw32_enable_palette = Qt;
5ac45f98 15026
fbd6baed
GV
15027 DEFVAR_INT ("w32-mouse-button-tolerance",
15028 &Vw32_mouse_button_tolerance,
74e1aeec
JR
15029 doc: /* Analogue of double click interval for faking middle mouse events.
15030The value is the minimum time in milliseconds that must elapse between
15031left/right button down events before they are considered distinct events.
15032If both mouse buttons are depressed within this interval, a middle mouse
15033button down event is generated instead. */);
fbd6baed 15034 XSETINT (Vw32_mouse_button_tolerance, GetDoubleClickTime () / 2);
5ac45f98 15035
fbd6baed
GV
15036 DEFVAR_INT ("w32-mouse-move-interval",
15037 &Vw32_mouse_move_interval,
74e1aeec
JR
15038 doc: /* Minimum interval between mouse move events.
15039The value is the minimum time in milliseconds that must elapse between
15040successive mouse move (or scroll bar drag) events before they are
15041reported as lisp events. */);
247be837 15042 XSETINT (Vw32_mouse_move_interval, 0);
84fb1139 15043
74214547
JR
15044 DEFVAR_BOOL ("w32-pass-extra-mouse-buttons-to-system",
15045 &w32_pass_extra_mouse_buttons_to_system,
15046 doc: /* Non-nil if the fourth and fifth mouse buttons are passed to Windows.
15047Recent versions of Windows support mice with up to five buttons.
15048Since most applications don't support these extra buttons, most mouse
15049drivers will allow you to map them to functions at the system level.
15050If this variable is non-nil, Emacs will pass them on, allowing the
15051system to handle them. */);
15052 w32_pass_extra_mouse_buttons_to_system = 0;
15053
ee78dc32
GV
15054 init_x_parm_symbols ();
15055
15056 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path,
74e1aeec 15057 doc: /* List of directories to search for bitmap files for w32. */);
ee78dc32
GV
15058 Vx_bitmap_file_path = decode_env_path ((char *) 0, "PATH");
15059
15060 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape,
74e1aeec
JR
15061 doc: /* The shape of the pointer when over text.
15062Changing the value does not affect existing frames
15063unless you set the mouse color. */);
ee78dc32
GV
15064 Vx_pointer_shape = Qnil;
15065
15066 DEFVAR_LISP ("x-resource-name", &Vx_resource_name,
74e1aeec
JR
15067 doc: /* The name Emacs uses to look up resources; for internal use only.
15068`x-get-resource' uses this as the first component of the instance name
15069when requesting resource values.
15070Emacs initially sets `x-resource-name' to the name under which Emacs
15071was invoked, or to the value specified with the `-name' or `-rn'
15072switches, if present. */);
ee78dc32
GV
15073 Vx_resource_name = Qnil;
15074
15075 Vx_nontext_pointer_shape = Qnil;
15076
15077 Vx_mode_pointer_shape = Qnil;
15078
0af913d7 15079 DEFVAR_LISP ("x-hourglass-pointer-shape", &Vx_hourglass_pointer_shape,
74e1aeec
JR
15080 doc: /* The shape of the pointer when Emacs is busy.
15081This variable takes effect when you create a new frame
15082or when you set the mouse color. */);
0af913d7 15083 Vx_hourglass_pointer_shape = Qnil;
6fc2811b 15084
0af913d7 15085 DEFVAR_BOOL ("display-hourglass", &display_hourglass_p,
74e1aeec 15086 doc: /* Non-zero means Emacs displays an hourglass pointer on window systems. */);
0af913d7 15087 display_hourglass_p = 1;
6fc2811b 15088
0af913d7 15089 DEFVAR_LISP ("hourglass-delay", &Vhourglass_delay,
74e1aeec
JR
15090 doc: /* *Seconds to wait before displaying an hourglass pointer.
15091Value must be an integer or float. */);
0af913d7 15092 Vhourglass_delay = make_number (DEFAULT_HOURGLASS_DELAY);
f79e6790 15093
6fc2811b 15094 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
ee78dc32 15095 &Vx_sensitive_text_pointer_shape,
74e1aeec
JR
15096 doc: /* The shape of the pointer when over mouse-sensitive text.
15097This variable takes effect when you create a new frame
15098or when you set the mouse color. */);
ee78dc32
GV
15099 Vx_sensitive_text_pointer_shape = Qnil;
15100
4694d762
JR
15101 DEFVAR_LISP ("x-window-horizontal-drag-cursor",
15102 &Vx_window_horizontal_drag_shape,
74e1aeec
JR
15103 doc: /* Pointer shape to use for indicating a window can be dragged horizontally.
15104This variable takes effect when you create a new frame
15105or when you set the mouse color. */);
4694d762
JR
15106 Vx_window_horizontal_drag_shape = Qnil;
15107
ee78dc32 15108 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel,
74e1aeec 15109 doc: /* A string indicating the foreground color of the cursor box. */);
ee78dc32
GV
15110 Vx_cursor_fore_pixel = Qnil;
15111
3cf3436e 15112 DEFVAR_LISP ("x-max-tooltip-size", &Vx_max_tooltip_size,
b3700ae7
JR
15113 doc: /* Maximum size for tooltips.
15114Value is a pair (COLUMNS . ROWS). Text larger than this is clipped. */);
3cf3436e
JR
15115 Vx_max_tooltip_size = Fcons (make_number (80), make_number (40));
15116
ee78dc32 15117 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager,
74e1aeec
JR
15118 doc: /* Non-nil if no window manager is in use.
15119Emacs doesn't try to figure this out; this is always nil
15120unless you set it to something else. */);
ee78dc32
GV
15121 /* We don't have any way to find this out, so set it to nil
15122 and maybe the user would like to set it to t. */
15123 Vx_no_window_manager = Qnil;
15124
4587b026
GV
15125 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
15126 &Vx_pixel_size_width_font_regexp,
74e1aeec
JR
15127 doc: /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'.
15128
15129Since Emacs gets width of a font matching with this regexp from
15130PIXEL_SIZE field of the name, font finding mechanism gets faster for
15131such a font. This is especially effective for such large fonts as
15132Chinese, Japanese, and Korean. */);
4587b026
GV
15133 Vx_pixel_size_width_font_regexp = Qnil;
15134
6fc2811b 15135 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay,
74e1aeec
JR
15136 doc: /* Time after which cached images are removed from the cache.
15137When an image has not been displayed this many seconds, remove it
15138from the image cache. Value must be an integer or nil with nil
15139meaning don't clear the cache. */);
6fc2811b
JR
15140 Vimage_cache_eviction_delay = make_number (30 * 60);
15141
33d52f9c
GV
15142 DEFVAR_LISP ("w32-bdf-filename-alist",
15143 &Vw32_bdf_filename_alist,
74e1aeec 15144 doc: /* List of bdf fonts and their corresponding filenames. */);
33d52f9c
GV
15145 Vw32_bdf_filename_alist = Qnil;
15146
1075afa9
GV
15147 DEFVAR_BOOL ("w32-strict-fontnames",
15148 &w32_strict_fontnames,
74e1aeec
JR
15149 doc: /* Non-nil means only use fonts that are exact matches for those requested.
15150Default is nil, which allows old fontnames that are not XLFD compliant,
15151and allows third-party CJK display to work by specifying false charset
15152fields to trick Emacs into translating to Big5, SJIS etc.
15153Setting this to t will prevent wrong fonts being selected when
15154fontsets are automatically created. */);
1075afa9
GV
15155 w32_strict_fontnames = 0;
15156
c0611964
AI
15157 DEFVAR_BOOL ("w32-strict-painting",
15158 &w32_strict_painting,
74e1aeec
JR
15159 doc: /* Non-nil means use strict rules for repainting frames.
15160Set this to nil to get the old behaviour for repainting; this should
15161only be necessary if the default setting causes problems. */);
c0611964
AI
15162 w32_strict_painting = 1;
15163
dfff8a69
JR
15164 DEFVAR_LISP ("w32-charset-info-alist",
15165 &Vw32_charset_info_alist,
b3700ae7
JR
15166 doc: /* Alist linking Emacs character sets to Windows fonts and codepages.
15167Each entry should be of the form:
74e1aeec
JR
15168
15169 (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE))
15170
15171where CHARSET_NAME is a string used in font names to identify the charset,
15172WINDOWS_CHARSET is a symbol that can be one of:
15173w32-charset-ansi, w32-charset-default, w32-charset-symbol,
15174w32-charset-shiftjis, w32-charset-hangeul, w32-charset-gb2312,
15175w32-charset-chinesebig5,
dfff8a69 15176#ifdef JOHAB_CHARSET
74e1aeec
JR
15177w32-charset-johab, w32-charset-hebrew,
15178w32-charset-arabic, w32-charset-greek, w32-charset-turkish,
15179w32-charset-vietnamese, w32-charset-thai, w32-charset-easteurope,
15180w32-charset-russian, w32-charset-mac, w32-charset-baltic,
dfff8a69
JR
15181#endif
15182#ifdef UNICODE_CHARSET
74e1aeec 15183w32-charset-unicode,
dfff8a69 15184#endif
74e1aeec
JR
15185or w32-charset-oem.
15186CODEPAGE should be an integer specifying the codepage that should be used
15187to display the character set, t to do no translation and output as Unicode,
15188or nil to do no translation and output as 8 bit (or multibyte on far-east
15189versions of Windows) characters. */);
dfff8a69
JR
15190 Vw32_charset_info_alist = Qnil;
15191
15192 staticpro (&Qw32_charset_ansi);
15193 Qw32_charset_ansi = intern ("w32-charset-ansi");
15194 staticpro (&Qw32_charset_symbol);
15195 Qw32_charset_symbol = intern ("w32-charset-symbol");
15196 staticpro (&Qw32_charset_shiftjis);
15197 Qw32_charset_shiftjis = intern ("w32-charset-shiftjis");
767b1ff0
JR
15198 staticpro (&Qw32_charset_hangeul);
15199 Qw32_charset_hangeul = intern ("w32-charset-hangeul");
dfff8a69
JR
15200 staticpro (&Qw32_charset_chinesebig5);
15201 Qw32_charset_chinesebig5 = intern ("w32-charset-chinesebig5");
15202 staticpro (&Qw32_charset_gb2312);
15203 Qw32_charset_gb2312 = intern ("w32-charset-gb2312");
15204 staticpro (&Qw32_charset_oem);
15205 Qw32_charset_oem = intern ("w32-charset-oem");
15206
15207#ifdef JOHAB_CHARSET
15208 {
15209 static int w32_extra_charsets_defined = 1;
74e1aeec
JR
15210 DEFVAR_BOOL ("w32-extra-charsets-defined", &w32_extra_charsets_defined,
15211 doc: /* Internal variable. */);
dfff8a69
JR
15212
15213 staticpro (&Qw32_charset_johab);
15214 Qw32_charset_johab = intern ("w32-charset-johab");
15215 staticpro (&Qw32_charset_easteurope);
15216 Qw32_charset_easteurope = intern ("w32-charset-easteurope");
15217 staticpro (&Qw32_charset_turkish);
15218 Qw32_charset_turkish = intern ("w32-charset-turkish");
15219 staticpro (&Qw32_charset_baltic);
15220 Qw32_charset_baltic = intern ("w32-charset-baltic");
15221 staticpro (&Qw32_charset_russian);
15222 Qw32_charset_russian = intern ("w32-charset-russian");
15223 staticpro (&Qw32_charset_arabic);
15224 Qw32_charset_arabic = intern ("w32-charset-arabic");
15225 staticpro (&Qw32_charset_greek);
15226 Qw32_charset_greek = intern ("w32-charset-greek");
15227 staticpro (&Qw32_charset_hebrew);
15228 Qw32_charset_hebrew = intern ("w32-charset-hebrew");
767b1ff0
JR
15229 staticpro (&Qw32_charset_vietnamese);
15230 Qw32_charset_vietnamese = intern ("w32-charset-vietnamese");
dfff8a69
JR
15231 staticpro (&Qw32_charset_thai);
15232 Qw32_charset_thai = intern ("w32-charset-thai");
15233 staticpro (&Qw32_charset_mac);
15234 Qw32_charset_mac = intern ("w32-charset-mac");
15235 }
15236#endif
15237
15238#ifdef UNICODE_CHARSET
15239 {
15240 static int w32_unicode_charset_defined = 1;
15241 DEFVAR_BOOL ("w32-unicode-charset-defined",
74e1aeec
JR
15242 &w32_unicode_charset_defined,
15243 doc: /* Internal variable. */);
dfff8a69
JR
15244
15245 staticpro (&Qw32_charset_unicode);
15246 Qw32_charset_unicode = intern ("w32-charset-unicode");
15247#endif
15248
ee78dc32 15249 defsubr (&Sx_get_resource);
767b1ff0 15250#if 0 /* TODO: Port to W32 */
6fc2811b
JR
15251 defsubr (&Sx_change_window_property);
15252 defsubr (&Sx_delete_window_property);
15253 defsubr (&Sx_window_property);
15254#endif
2d764c78 15255 defsubr (&Sxw_display_color_p);
ee78dc32 15256 defsubr (&Sx_display_grayscale_p);
2d764c78
EZ
15257 defsubr (&Sxw_color_defined_p);
15258 defsubr (&Sxw_color_values);
ee78dc32
GV
15259 defsubr (&Sx_server_max_request_size);
15260 defsubr (&Sx_server_vendor);
15261 defsubr (&Sx_server_version);
15262 defsubr (&Sx_display_pixel_width);
15263 defsubr (&Sx_display_pixel_height);
15264 defsubr (&Sx_display_mm_width);
15265 defsubr (&Sx_display_mm_height);
15266 defsubr (&Sx_display_screens);
15267 defsubr (&Sx_display_planes);
15268 defsubr (&Sx_display_color_cells);
15269 defsubr (&Sx_display_visual_class);
15270 defsubr (&Sx_display_backing_store);
15271 defsubr (&Sx_display_save_under);
15272 defsubr (&Sx_parse_geometry);
15273 defsubr (&Sx_create_frame);
ee78dc32
GV
15274 defsubr (&Sx_open_connection);
15275 defsubr (&Sx_close_connection);
15276 defsubr (&Sx_display_list);
15277 defsubr (&Sx_synchronize);
15278
fbd6baed 15279 /* W32 specific functions */
ee78dc32 15280
1edf84e7 15281 defsubr (&Sw32_focus_frame);
fbd6baed
GV
15282 defsubr (&Sw32_select_font);
15283 defsubr (&Sw32_define_rgb_color);
15284 defsubr (&Sw32_default_color_map);
15285 defsubr (&Sw32_load_color_file);
1edf84e7 15286 defsubr (&Sw32_send_sys_command);
55dcfc15 15287 defsubr (&Sw32_shell_execute);
ccc2d29c
GV
15288 defsubr (&Sw32_register_hot_key);
15289 defsubr (&Sw32_unregister_hot_key);
15290 defsubr (&Sw32_registered_hot_keys);
15291 defsubr (&Sw32_reconstruct_hot_key);
adcc3809 15292 defsubr (&Sw32_toggle_lock_key);
33d52f9c 15293 defsubr (&Sw32_find_bdf_fonts);
4587b026 15294
2254bcde
AI
15295 defsubr (&Sfile_system_info);
15296
4587b026
GV
15297 /* Setting callback functions for fontset handler. */
15298 get_font_info_func = w32_get_font_info;
6fc2811b
JR
15299
15300#if 0 /* This function pointer doesn't seem to be used anywhere.
15301 And the pointer assigned has the wrong type, anyway. */
4587b026 15302 list_fonts_func = w32_list_fonts;
6fc2811b
JR
15303#endif
15304
4587b026
GV
15305 load_font_func = w32_load_font;
15306 find_ccl_program_func = w32_find_ccl_program;
15307 query_font_func = w32_query_font;
15308 set_frame_fontset_func = x_set_font;
15309 check_window_system_func = check_w32;
6fc2811b 15310
6fc2811b
JR
15311 /* Images. */
15312 Qxbm = intern ("xbm");
15313 staticpro (&Qxbm);
a93f4566
GM
15314 QCconversion = intern (":conversion");
15315 staticpro (&QCconversion);
6fc2811b
JR
15316 QCheuristic_mask = intern (":heuristic-mask");
15317 staticpro (&QCheuristic_mask);
15318 QCcolor_symbols = intern (":color-symbols");
15319 staticpro (&QCcolor_symbols);
6fc2811b
JR
15320 QCascent = intern (":ascent");
15321 staticpro (&QCascent);
15322 QCmargin = intern (":margin");
15323 staticpro (&QCmargin);
15324 QCrelief = intern (":relief");
15325 staticpro (&QCrelief);
15326 Qpostscript = intern ("postscript");
15327 staticpro (&Qpostscript);
ac849ba4 15328#if 0 /* TODO: These need entries at top of file. */
6fc2811b
JR
15329 QCloader = intern (":loader");
15330 staticpro (&QCloader);
15331 QCbounding_box = intern (":bounding-box");
15332 staticpro (&QCbounding_box);
15333 QCpt_width = intern (":pt-width");
15334 staticpro (&QCpt_width);
15335 QCpt_height = intern (":pt-height");
15336 staticpro (&QCpt_height);
ac849ba4 15337#endif
6fc2811b
JR
15338 QCindex = intern (":index");
15339 staticpro (&QCindex);
15340 Qpbm = intern ("pbm");
15341 staticpro (&Qpbm);
15342
15343#if HAVE_XPM
15344 Qxpm = intern ("xpm");
15345 staticpro (&Qxpm);
15346#endif
15347
15348#if HAVE_JPEG
15349 Qjpeg = intern ("jpeg");
15350 staticpro (&Qjpeg);
15351#endif
15352
15353#if HAVE_TIFF
15354 Qtiff = intern ("tiff");
15355 staticpro (&Qtiff);
15356#endif
15357
15358#if HAVE_GIF
15359 Qgif = intern ("gif");
15360 staticpro (&Qgif);
15361#endif
15362
15363#if HAVE_PNG
15364 Qpng = intern ("png");
15365 staticpro (&Qpng);
15366#endif
15367
15368 defsubr (&Sclear_image_cache);
ac849ba4
JR
15369 defsubr (&Simage_size);
15370 defsubr (&Simage_mask_p);
6fc2811b
JR
15371
15372#if GLYPH_DEBUG
15373 defsubr (&Simagep);
15374 defsubr (&Slookup_image);
15375#endif
6fc2811b 15376
0af913d7
GM
15377 hourglass_atimer = NULL;
15378 hourglass_shown_p = 0;
6fc2811b
JR
15379 defsubr (&Sx_show_tip);
15380 defsubr (&Sx_hide_tip);
6fc2811b 15381 tip_timer = Qnil;
57fa2774
JR
15382 staticpro (&tip_timer);
15383 tip_frame = Qnil;
15384 staticpro (&tip_frame);
6fc2811b 15385
ca56d953
JR
15386 last_show_tip_args = Qnil;
15387 staticpro (&last_show_tip_args);
15388
6fc2811b
JR
15389 defsubr (&Sx_file_dialog);
15390}
15391
15392
15393void
15394init_xfns ()
15395{
15396 image_types = NULL;
15397 Vimage_types = Qnil;
15398
ac849ba4 15399 define_image_type (&pbm_type);
6fc2811b 15400 define_image_type (&xbm_type);
217e5be0 15401#if 0 /* TODO : Image support for W32 */
6fc2811b 15402 define_image_type (&gs_type);
ac849ba4 15403#endif
6fc2811b
JR
15404
15405#if HAVE_XPM
15406 define_image_type (&xpm_type);
15407#endif
15408
15409#if HAVE_JPEG
15410 define_image_type (&jpeg_type);
15411#endif
15412
15413#if HAVE_TIFF
15414 define_image_type (&tiff_type);
15415#endif
919f1e88 15416
6fc2811b
JR
15417#if HAVE_GIF
15418 define_image_type (&gif_type);
15419#endif
15420
15421#if HAVE_PNG
15422 define_image_type (&png_type);
15423#endif
ee78dc32
GV
15424}
15425
15426#undef abort
15427
15428void
fbd6baed 15429w32_abort()
ee78dc32 15430{
5ac45f98
GV
15431 int button;
15432 button = MessageBox (NULL,
15433 "A fatal error has occurred!\n\n"
15434 "Select Abort to exit, Retry to debug, Ignore to continue",
15435 "Emacs Abort Dialog",
15436 MB_ICONEXCLAMATION | MB_TASKMODAL
15437 | MB_SETFOREGROUND | MB_ABORTRETRYIGNORE);
15438 switch (button)
15439 {
15440 case IDRETRY:
15441 DebugBreak ();
15442 break;
15443 case IDIGNORE:
15444 break;
15445 case IDABORT:
15446 default:
15447 abort ();
15448 break;
15449 }
ee78dc32 15450}
d573caac 15451
83c75055
GV
15452/* For convenience when debugging. */
15453int
15454w32_last_error()
15455{
15456 return GetLastError ();
15457}