HCoop / bpt / emacs.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
(w32_defined_color): Apply gamma correction before trying to map to
[bpt/emacs.git] / src / w32fns.c
CommitLineData
e9e23e23 1/* Graphical user interface functions for the Microsoft W32 API.
6fc2811b
JR		 2 Copyright (C) 1989, 92, 93, 94, 95, 1996, 1997, 1998, 1999
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
GV		 32#include "charset.h"
33#include "fontset.h"
ee78dc32
GV		 34#include "w32term.h"
35#include "frame.h"
36#include "window.h"
37#include "buffer.h"
38#include "dispextern.h"
6fc2811b 39#include "intervals.h"
ee78dc32
GV		 40#include "keyboard.h"
41#include "blockinput.h"
57bda87a 42#include "epaths.h"
489f9371 43#include "w32heap.h"
ee78dc32 44#include "termhooks.h"
4587b026 45#include "coding.h"
3545439c 46#include "ccl.h"
6fc2811b
JR		 47#include "systime.h"
48
49#include "bitmaps/gray.xbm"
ee78dc32
GV		 50
51#include <commdlg.h>
cb9e33d4 52#include <shellapi.h>
6fc2811b 53#include <ctype.h>
ee78dc32 54
ee78dc32 55extern void free_frame_menubar ();
6fc2811b 56extern double atof ();
ee78dc32 57extern struct scroll_bar *x_window_to_scroll_bar ();
adcc3809 58extern int w32_console_toggle_lock_key (int vk_code, Lisp_Object new_state);
5ac45f98 59extern int quit_char;
ee78dc32 60
6fc2811b
JR		 61/* A definition of XColor for non-X frames. */
62#ifndef HAVE_X_WINDOWS
63typedef struct {
64 unsigned long pixel;
65 unsigned short red, green, blue;
66 char flags;
67 char pad;
68} XColor;
69#endif
70
ccc2d29c
GV		 71extern char *lispy_function_keys[];
72
6fc2811b
JR		 73/* The gray bitmap `bitmaps/gray'. This is done because w32term.c uses
74 it, and including `bitmaps/gray' more than once is a problem when
75 config.h defines `static' as an empty replacement string. */
76
77int gray_bitmap_width = gray_width;
78int gray_bitmap_height = gray_height;
79unsigned char *gray_bitmap_bits = gray_bits;
80
ee78dc32 81/* The colormap for converting color names to RGB values */
fbd6baed 82Lisp_Object Vw32_color_map;
ee78dc32 83
da36a4d6 84/* Non nil if alt key presses are passed on to Windows. */
fbd6baed 85Lisp_Object Vw32_pass_alt_to_system;
da36a4d6 86
8c205c63
RS		 87/* Non nil if alt key is translated to meta_modifier, nil if it is translated
88 to alt_modifier. */
fbd6baed 89Lisp_Object Vw32_alt_is_meta;
8c205c63 90
7d081355
AI		 91/* If non-zero, the windows virtual key code for an alternative quit key. */
92Lisp_Object Vw32_quit_key;
93
ccc2d29c
GV		 94/* Non nil if left window key events are passed on to Windows (this only
95 affects whether "tapping" the key opens the Start menu). */
96Lisp_Object Vw32_pass_lwindow_to_system;
97
98/* Non nil if right window key events are passed on to Windows (this
99 only affects whether "tapping" the key opens the Start menu). */
100Lisp_Object Vw32_pass_rwindow_to_system;
101
adcc3809
GV		 102/* Virtual key code used to generate "phantom" key presses in order
103 to stop system from acting on Windows key events. */
104Lisp_Object Vw32_phantom_key_code;
105
ccc2d29c
GV		 106/* Modifier associated with the left "Windows" key, or nil to act as a
107 normal key. */
108Lisp_Object Vw32_lwindow_modifier;
109
110/* Modifier associated with the right "Windows" key, or nil to act as a
111 normal key. */
112Lisp_Object Vw32_rwindow_modifier;
113
114/* Modifier associated with the "Apps" key, or nil to act as a normal
115 key. */
116Lisp_Object Vw32_apps_modifier;
117
118/* Value is nil if Num Lock acts as a function key. */
119Lisp_Object Vw32_enable_num_lock;
120
121/* Value is nil if Caps Lock acts as a function key. */
122Lisp_Object Vw32_enable_caps_lock;
123
124/* Modifier associated with Scroll Lock, or nil to act as a normal key. */
125Lisp_Object Vw32_scroll_lock_modifier;
da36a4d6 126
6fc2811b
JR		 127/* Switch to control whether we inhibit requests for synthesyzed bold
128 and italic versions of fonts. */
129Lisp_Object Vw32_enable_synthesized_fonts;
5ac45f98
GV		 130
131/* Enable palette management. */
fbd6baed 132Lisp_Object Vw32_enable_palette;
5ac45f98
GV		 133
134/* Control how close left/right button down events must be to
135 be converted to a middle button down event. */
fbd6baed 136Lisp_Object Vw32_mouse_button_tolerance;
5ac45f98 137
84fb1139
KH		 138/* Minimum interval between mouse movement (and scroll bar drag)
139 events that are passed on to the event loop. */
fbd6baed 140Lisp_Object Vw32_mouse_move_interval;
84fb1139 141
ee78dc32
GV		 142/* The name we're using in resource queries. */
143Lisp_Object Vx_resource_name;
144
145/* Non nil if no window manager is in use. */
146Lisp_Object Vx_no_window_manager;
147
6fc2811b
JR		 148/* Non-zero means we're allowed to display a busy cursor. */
149int display_busy_cursor_p;
150
ee78dc32
GV		 151/* The background and shape of the mouse pointer, and shape when not
152 over text or in the modeline. */
153Lisp_Object Vx_pointer_shape, Vx_nontext_pointer_shape, Vx_mode_pointer_shape;
6fc2811b
JR		 154Lisp_Object Vx_busy_pointer_shape;
155
ee78dc32
GV		 156/* The shape when over mouse-sensitive text. */
157Lisp_Object Vx_sensitive_text_pointer_shape;
158
159/* Color of chars displayed in cursor box. */
160Lisp_Object Vx_cursor_fore_pixel;
161
1edf84e7
GV		 162/* Nonzero if using Windows. */
163static int w32_in_use;
164
ee78dc32
GV		 165/* Search path for bitmap files. */
166Lisp_Object Vx_bitmap_file_path;
167
4587b026
GV		 168/* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
169Lisp_Object Vx_pixel_size_width_font_regexp;
170
33d52f9c
GV		 171/* Alist of bdf fonts and the files that define them. */
172Lisp_Object Vw32_bdf_filename_alist;
173
f46e6225
GV		 174Lisp_Object Vw32_system_coding_system;
175
f46e6225 176/* A flag to control whether fonts are matched strictly or not. */
1075afa9
GV		 177int w32_strict_fontnames;
178
c0611964
AI		 179/* A flag to control whether we should only repaint if GetUpdateRect
180 indicates there is an update region. */
181int w32_strict_painting;
182
ee78dc32
GV		 183/* Evaluate this expression to rebuild the section of syms_of_w32fns
184 that initializes and staticpros the symbols declared below. Note
185 that Emacs 18 has a bug that keeps C-x C-e from being able to
186 evaluate this expression.
187
188(progn
189 ;; Accumulate a list of the symbols we want to initialize from the
190 ;; declarations at the top of the file.
191 (goto-char (point-min))
192 (search-forward "/\*&&& symbols declared here &&&*\/\n")
193 (let (symbol-list)
194 (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)")
195 (setq symbol-list
196 (cons (buffer-substring (match-beginning 1) (match-end 1))
197 symbol-list))
198 (forward-line 1))
199 (setq symbol-list (nreverse symbol-list))
200 ;; Delete the section of syms_of_... where we initialize the symbols.
201 (search-forward "\n /\*&&& init symbols here &&&*\/\n")
202 (let ((start (point)))
203 (while (looking-at "^ Q")
204 (forward-line 2))
205 (kill-region start (point)))
206 ;; Write a new symbol initialization section.
207 (while symbol-list
208 (insert (format " %s = intern (\"" (car symbol-list)))
209 (let ((start (point)))
210 (insert (substring (car symbol-list) 1))
211 (subst-char-in-region start (point) ?_ ?-))
212 (insert (format "\");\n staticpro (&%s);\n" (car symbol-list)))
213 (setq symbol-list (cdr symbol-list)))))
214
215 */
216
217/*&&& symbols declared here &&&*/
218Lisp_Object Qauto_raise;
219Lisp_Object Qauto_lower;
ee78dc32
GV		 220Lisp_Object Qbar;
221Lisp_Object Qborder_color;
222Lisp_Object Qborder_width;
223Lisp_Object Qbox;
224Lisp_Object Qcursor_color;
225Lisp_Object Qcursor_type;
ee78dc32
GV		 226Lisp_Object Qgeometry;
227Lisp_Object Qicon_left;
228Lisp_Object Qicon_top;
229Lisp_Object Qicon_type;
230Lisp_Object Qicon_name;
231Lisp_Object Qinternal_border_width;
232Lisp_Object Qleft;
1026b400 233Lisp_Object Qright;
ee78dc32
GV		 234Lisp_Object Qmouse_color;
235Lisp_Object Qnone;
236Lisp_Object Qparent_id;
237Lisp_Object Qscroll_bar_width;
238Lisp_Object Qsuppress_icon;
ee78dc32
GV		 239Lisp_Object Qundefined_color;
240Lisp_Object Qvertical_scroll_bars;
241Lisp_Object Qvisibility;
242Lisp_Object Qwindow_id;
243Lisp_Object Qx_frame_parameter;
244Lisp_Object Qx_resource_name;
245Lisp_Object Quser_position;
246Lisp_Object Quser_size;
6fc2811b 247Lisp_Object Qscreen_gamma;
adcc3809
GV		 248Lisp_Object Qhyper;
249Lisp_Object Qsuper;
250Lisp_Object Qmeta;
251Lisp_Object Qalt;
252Lisp_Object Qctrl;
253Lisp_Object Qcontrol;
254Lisp_Object Qshift;
255
6fc2811b
JR		 256extern Lisp_Object Qtop;
257extern Lisp_Object Qdisplay;
258extern Lisp_Object Qtool_bar_lines;
259
5ac45f98
GV		 260/* State variables for emulating a three button mouse. */
261#define LMOUSE 1
262#define MMOUSE 2
263#define RMOUSE 4
264
265static int button_state = 0;
fbd6baed 266static W32Msg saved_mouse_button_msg;
84fb1139 267static unsigned mouse_button_timer; /* non-zero when timer is active */
fbd6baed 268static W32Msg saved_mouse_move_msg;
84fb1139
KH		 269static unsigned mouse_move_timer;
270
93fbe8b7
GV		 271/* W95 mousewheel handler */
272unsigned int msh_mousewheel = 0;
273
84fb1139
KH		 274#define MOUSE_BUTTON_ID 1
275#define MOUSE_MOVE_ID 2
5ac45f98 276
ee78dc32
GV		 277/* The below are defined in frame.c. */
278extern Lisp_Object Qheight, Qminibuffer, Qname, Qonly, Qwidth;
1edf84e7 279extern Lisp_Object Qunsplittable, Qmenu_bar_lines, Qbuffer_predicate, Qtitle;
6fc2811b 280extern Lisp_Object Qtool_bar_lines;
ee78dc32
GV		 281
282extern Lisp_Object Vwindow_system_version;
283
4b817373
RS		 284Lisp_Object Qface_set_after_frame_default;
285
ee78dc32
GV		 286extern Lisp_Object last_mouse_scroll_bar;
287extern int last_mouse_scroll_bar_pos;
5ac45f98 288
fbd6baed
GV		 289/* From w32term.c. */
290extern Lisp_Object Vw32_num_mouse_buttons;
ccc2d29c 291extern Lisp_Object Vw32_recognize_altgr;
5ac45f98 292
ee78dc32 293\f
1edf84e7
GV		 294/* Error if we are not connected to MS-Windows. */
295void
296check_w32 ()
297{
298 if (! w32_in_use)
299 error ("MS-Windows not in use or not initialized");
300}
301
302/* Nonzero if we can use mouse menus.
303 You should not call this unless HAVE_MENUS is defined. */
304
305int
306have_menus_p ()
307{
308 return w32_in_use;
309}
310
ee78dc32 311/* Extract a frame as a FRAME_PTR, defaulting to the selected frame
fbd6baed 312 and checking validity for W32. */
ee78dc32
GV		 313
314FRAME_PTR
315check_x_frame (frame)
316 Lisp_Object frame;
317{
318 FRAME_PTR f;
319
320 if (NILP (frame))
6fc2811b
JR		 321 frame = selected_frame;
322 CHECK_LIVE_FRAME (frame, 0);
323 f = XFRAME (frame);
fbd6baed
GV		 324 if (! FRAME_W32_P (f))
325 error ("non-w32 frame used");
ee78dc32
GV		 326 return f;
327}
328
329/* Let the user specify an display with a frame.
fbd6baed 330 nil stands for the selected frame--or, if that is not a w32 frame,
ee78dc32
GV		 331 the first display on the list. */
332
fbd6baed 333static struct w32_display_info *
ee78dc32
GV		 334check_x_display_info (frame)
335 Lisp_Object frame;
336{
337 if (NILP (frame))
338 {
6fc2811b
JR		 339 struct frame *sf = XFRAME (selected_frame);
340
341 if (FRAME_W32_P (sf) && FRAME_LIVE_P (sf))
342 return FRAME_W32_DISPLAY_INFO (sf);
ee78dc32 343 else
fbd6baed 344 return &one_w32_display_info;
ee78dc32
GV		 345 }
346 else if (STRINGP (frame))
347 return x_display_info_for_name (frame);
348 else
349 {
350 FRAME_PTR f;
351
352 CHECK_LIVE_FRAME (frame, 0);
353 f = XFRAME (frame);
fbd6baed
GV		 354 if (! FRAME_W32_P (f))
355 error ("non-w32 frame used");
356 return FRAME_W32_DISPLAY_INFO (f);
ee78dc32
GV		 357 }
358}
359\f
fbd6baed 360/* Return the Emacs frame-object corresponding to an w32 window.
ee78dc32
GV		 361 It could be the frame's main window or an icon window. */
362
363/* This function can be called during GC, so use GC_xxx type test macros. */
364
365struct frame *
366x_window_to_frame (dpyinfo, wdesc)
fbd6baed 367 struct w32_display_info *dpyinfo;
ee78dc32
GV		 368 HWND wdesc;
369{
370 Lisp_Object tail, frame;
371 struct frame *f;
372
8e713be6 373 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
ee78dc32 374 {
8e713be6 375 frame = XCAR (tail);
ee78dc32
GV		 376 if (!GC_FRAMEP (frame))
377 continue;
378 f = XFRAME (frame);
2d764c78 379 if (!FRAME_W32_P (f) || FRAME_W32_DISPLAY_INFO (f) != dpyinfo)
ee78dc32 380 continue;
fbd6baed 381 if (FRAME_W32_WINDOW (f) == wdesc)
ee78dc32
GV		 382 return f;
383 }
384 return 0;
385}
386
387\f
388
389/* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
390 id, which is just an int that this section returns. Bitmaps are
391 reference counted so they can be shared among frames.
392
393 Bitmap indices are guaranteed to be > 0, so a negative number can
394 be used to indicate no bitmap.
395
396 If you use x_create_bitmap_from_data, then you must keep track of
397 the bitmaps yourself. That is, creating a bitmap from the same
398 data more than once will not be caught. */
399
400
401/* Functions to access the contents of a bitmap, given an id. */
402
403int
404x_bitmap_height (f, id)
405 FRAME_PTR f;
406 int id;
407{
fbd6baed 408 return FRAME_W32_DISPLAY_INFO (f)->bitmaps[id - 1].height;
ee78dc32
GV		 409}
410
411int
412x_bitmap_width (f, id)
413 FRAME_PTR f;
414 int id;
415{
fbd6baed 416 return FRAME_W32_DISPLAY_INFO (f)->bitmaps[id - 1].width;
ee78dc32
GV		 417}
418
419int
420x_bitmap_pixmap (f, id)
421 FRAME_PTR f;
422 int id;
423{
fbd6baed 424 return (int) FRAME_W32_DISPLAY_INFO (f)->bitmaps[id - 1].pixmap;
ee78dc32
GV		 425}
426
427
428/* Allocate a new bitmap record. Returns index of new record. */
429
430static int
431x_allocate_bitmap_record (f)
432 FRAME_PTR f;
433{
fbd6baed 434 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
ee78dc32
GV		 435 int i;
436
437 if (dpyinfo->bitmaps == NULL)
438 {
439 dpyinfo->bitmaps_size = 10;
440 dpyinfo->bitmaps
fbd6baed 441 = (struct w32_bitmap_record *) xmalloc (dpyinfo->bitmaps_size * sizeof (struct w32_bitmap_record));
ee78dc32
GV		 442 dpyinfo->bitmaps_last = 1;
443 return 1;
444 }
445
446 if (dpyinfo->bitmaps_last < dpyinfo->bitmaps_size)
447 return ++dpyinfo->bitmaps_last;
448
449 for (i = 0; i < dpyinfo->bitmaps_size; ++i)
450 if (dpyinfo->bitmaps[i].refcount == 0)
451 return i + 1;
452
453 dpyinfo->bitmaps_size *= 2;
454 dpyinfo->bitmaps
fbd6baed
GV		 455 = (struct w32_bitmap_record *) xrealloc (dpyinfo->bitmaps,
456 dpyinfo->bitmaps_size * sizeof (struct w32_bitmap_record));
ee78dc32
GV		 457 return ++dpyinfo->bitmaps_last;
458}
459
460/* Add one reference to the reference count of the bitmap with id ID. */
461
462void
463x_reference_bitmap (f, id)
464 FRAME_PTR f;
465 int id;
466{
fbd6baed 467 ++FRAME_W32_DISPLAY_INFO (f)->bitmaps[id - 1].refcount;
ee78dc32
GV		 468}
469
470/* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
471
472int
473x_create_bitmap_from_data (f, bits, width, height)
474 struct frame *f;
475 char *bits;
476 unsigned int width, height;
477{
fbd6baed 478 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
ee78dc32
GV		 479 Pixmap bitmap;
480 int id;
481
482 bitmap = CreateBitmap (width, height,
fbd6baed
GV		 483 FRAME_W32_DISPLAY_INFO (XFRAME (frame))->n_planes,
484 FRAME_W32_DISPLAY_INFO (XFRAME (frame))->n_cbits,
ee78dc32
GV		 485 bits);
486
487 if (! bitmap)
488 return -1;
489
490 id = x_allocate_bitmap_record (f);
491 dpyinfo->bitmaps[id - 1].pixmap = bitmap;
492 dpyinfo->bitmaps[id - 1].file = NULL;
493 dpyinfo->bitmaps[id - 1].hinst = NULL;
494 dpyinfo->bitmaps[id - 1].refcount = 1;
495 dpyinfo->bitmaps[id - 1].depth = 1;
496 dpyinfo->bitmaps[id - 1].height = height;
497 dpyinfo->bitmaps[id - 1].width = width;
498
499 return id;
500}
501
502/* Create bitmap from file FILE for frame F. */
503
504int
505x_create_bitmap_from_file (f, file)
506 struct frame *f;
507 Lisp_Object file;
508{
509 return -1;
6fc2811b 510#if 0 /* NTEMACS_TODO : bitmap support */
fbd6baed 511 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
ee78dc32 512 unsigned int width, height;
6fc2811b 513 HBITMAP bitmap;
ee78dc32
GV		 514 int xhot, yhot, result, id;
515 Lisp_Object found;
516 int fd;
517 char *filename;
518 HINSTANCE hinst;
519
520 /* Look for an existing bitmap with the same name. */
521 for (id = 0; id < dpyinfo->bitmaps_last; ++id)
522 {
523 if (dpyinfo->bitmaps[id].refcount
524 && dpyinfo->bitmaps[id].file
525 && !strcmp (dpyinfo->bitmaps[id].file, (char *) XSTRING (file)->data))
526 {
527 ++dpyinfo->bitmaps[id].refcount;
528 return id + 1;
529 }
530 }
531
532 /* Search bitmap-file-path for the file, if appropriate. */
533 fd = openp (Vx_bitmap_file_path, file, "", &found, 0);
534 if (fd < 0)
535 return -1;
5d7fed93
GV		 536 /* LoadLibraryEx won't handle special files handled by Emacs handler. */
537 if (fd == 0)
538 return -1;
6fc2811b 539 emacs_close (fd);
ee78dc32
GV		 540
541 filename = (char *) XSTRING (found)->data;
542
543 hinst = LoadLibraryEx (filename, NULL, LOAD_LIBRARY_AS_DATAFILE);
544
545 if (hinst == NULL)
546 return -1;
547
548
fbd6baed 549 result = XReadBitmapFile (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
ee78dc32
GV		 550 filename, &width, &height, &bitmap, &xhot, &yhot);
551 if (result != BitmapSuccess)
552 return -1;
553
554 id = x_allocate_bitmap_record (f);
555 dpyinfo->bitmaps[id - 1].pixmap = bitmap;
556 dpyinfo->bitmaps[id - 1].refcount = 1;
557 dpyinfo->bitmaps[id - 1].file = (char *) xmalloc (XSTRING (file)->size + 1);
558 dpyinfo->bitmaps[id - 1].depth = 1;
559 dpyinfo->bitmaps[id - 1].height = height;
560 dpyinfo->bitmaps[id - 1].width = width;
561 strcpy (dpyinfo->bitmaps[id - 1].file, XSTRING (file)->data);
562
563 return id;
6fc2811b 564#endif /* NTEMACS_TODO */
ee78dc32
GV		 565}
566
567/* Remove reference to bitmap with id number ID. */
568
33d52f9c 569void
ee78dc32
GV		 570x_destroy_bitmap (f, id)
571 FRAME_PTR f;
572 int id;
573{
fbd6baed 574 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
ee78dc32
GV		 575
576 if (id > 0)
577 {
578 --dpyinfo->bitmaps[id - 1].refcount;
579 if (dpyinfo->bitmaps[id - 1].refcount == 0)
580 {
581 BLOCK_INPUT;
582 DeleteObject (dpyinfo->bitmaps[id - 1].pixmap);
583 if (dpyinfo->bitmaps[id - 1].file)
584 {
6fc2811b 585 xfree (dpyinfo->bitmaps[id - 1].file);
ee78dc32
GV		 586 dpyinfo->bitmaps[id - 1].file = NULL;
587 }
588 UNBLOCK_INPUT;
589 }
590 }
591}
592
593/* Free all the bitmaps for the display specified by DPYINFO. */
594
595static void
596x_destroy_all_bitmaps (dpyinfo)
fbd6baed 597 struct w32_display_info *dpyinfo;
ee78dc32
GV		 598{
599 int i;
600 for (i = 0; i < dpyinfo->bitmaps_last; i++)
601 if (dpyinfo->bitmaps[i].refcount > 0)
602 {
603 DeleteObject (dpyinfo->bitmaps[i].pixmap);
604 if (dpyinfo->bitmaps[i].file)
6fc2811b 605 xfree (dpyinfo->bitmaps[i].file);
ee78dc32
GV		 606 }
607 dpyinfo->bitmaps_last = 0;
608}
609\f
fbd6baed 610/* Connect the frame-parameter names for W32 frames
ee78dc32
GV		 611 to the ways of passing the parameter values to the window system.
612
613 The name of a parameter, as a Lisp symbol,
614 has an `x-frame-parameter' property which is an integer in Lisp
615 but can be interpreted as an `enum x_frame_parm' in C. */
616
617enum x_frame_parm
618{
619 X_PARM_FOREGROUND_COLOR,
620 X_PARM_BACKGROUND_COLOR,
621 X_PARM_MOUSE_COLOR,
622 X_PARM_CURSOR_COLOR,
623 X_PARM_BORDER_COLOR,
624 X_PARM_ICON_TYPE,
625 X_PARM_FONT,
626 X_PARM_BORDER_WIDTH,
627 X_PARM_INTERNAL_BORDER_WIDTH,
628 X_PARM_NAME,
629 X_PARM_AUTORAISE,
630 X_PARM_AUTOLOWER,
631 X_PARM_VERT_SCROLL_BAR,
632 X_PARM_VISIBILITY,
633 X_PARM_MENU_BAR_LINES
634};
635
636
637struct x_frame_parm_table
638{
639 char *name;
6fc2811b 640 void (*setter) P_ ((struct frame *, Lisp_Object, Lisp_Object));
ee78dc32
GV		 641};
642
6fc2811b
JR		 643/* NTEMACS_TODO: Native Input Method support; see x_create_im. */
644void x_set_foreground_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
645void x_set_background_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
646void x_set_mouse_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
647void x_set_cursor_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
648void x_set_border_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
649void x_set_cursor_type P_ ((struct frame *, Lisp_Object, Lisp_Object));
650void x_set_icon_type P_ ((struct frame *, Lisp_Object, Lisp_Object));
651void x_set_icon_name P_ ((struct frame *, Lisp_Object, Lisp_Object));
652void x_set_font P_ ((struct frame *, Lisp_Object, Lisp_Object));
653void x_set_border_width P_ ((struct frame *, Lisp_Object, Lisp_Object));
654void x_set_internal_border_width P_ ((struct frame *, Lisp_Object,
655 Lisp_Object));
656void x_explicitly_set_name P_ ((struct frame *, Lisp_Object, Lisp_Object));
657void x_set_autoraise P_ ((struct frame *, Lisp_Object, Lisp_Object));
658void x_set_autolower P_ ((struct frame *, Lisp_Object, Lisp_Object));
659void x_set_vertical_scroll_bars P_ ((struct frame *, Lisp_Object,
660 Lisp_Object));
661void x_set_visibility P_ ((struct frame *, Lisp_Object, Lisp_Object));
662void x_set_menu_bar_lines P_ ((struct frame *, Lisp_Object, Lisp_Object));
663void x_set_scroll_bar_width P_ ((struct frame *, Lisp_Object, Lisp_Object));
664void x_set_title P_ ((struct frame *, Lisp_Object, Lisp_Object));
665void x_set_unsplittable P_ ((struct frame *, Lisp_Object, Lisp_Object));
666void x_set_tool_bar_lines P_ ((struct frame *, Lisp_Object, Lisp_Object));
667static void x_set_screen_gamma P_ ((struct frame *, Lisp_Object, Lisp_Object));
ee78dc32
GV		 668
669static struct x_frame_parm_table x_frame_parms[] =
670{
1edf84e7
GV		 671 "auto-raise", x_set_autoraise,
672 "auto-lower", x_set_autolower,
ee78dc32 673 "background-color", x_set_background_color,
ee78dc32 674 "border-color", x_set_border_color,
1edf84e7
GV		 675 "border-width", x_set_border_width,
676 "cursor-color", x_set_cursor_color,
ee78dc32 677 "cursor-type", x_set_cursor_type,
ee78dc32 678 "font", x_set_font,
1edf84e7
GV		 679 "foreground-color", x_set_foreground_color,
680 "icon-name", x_set_icon_name,
681 "icon-type", x_set_icon_type,
ee78dc32 682 "internal-border-width", x_set_internal_border_width,
ee78dc32 683 "menu-bar-lines", x_set_menu_bar_lines,
1edf84e7
GV		 684 "mouse-color", x_set_mouse_color,
685 "name", x_explicitly_set_name,
ee78dc32 686 "scroll-bar-width", x_set_scroll_bar_width,
1edf84e7 687 "title", x_set_title,
ee78dc32 688 "unsplittable", x_set_unsplittable,
1edf84e7
GV		 689 "vertical-scroll-bars", x_set_vertical_scroll_bars,
690 "visibility", x_set_visibility,
6fc2811b
JR		 691 "tool-bar-lines", x_set_tool_bar_lines,
692 "screen-gamma", x_set_screen_gamma
ee78dc32
GV		 693};
694
695/* Attach the `x-frame-parameter' properties to
fbd6baed 696 the Lisp symbol names of parameters relevant to W32. */
ee78dc32
GV		 697
698init_x_parm_symbols ()
699{
700 int i;
701
702 for (i = 0; i < sizeof (x_frame_parms) / sizeof (x_frame_parms[0]); i++)
703 Fput (intern (x_frame_parms[i].name), Qx_frame_parameter,
704 make_number (i));
705}
706\f
707/* Change the parameters of FRAME as specified by ALIST.
708 If a parameter is not specially recognized, do nothing;
709 otherwise call the `x_set_...' function for that parameter. */
710
711void
712x_set_frame_parameters (f, alist)
713 FRAME_PTR f;
714 Lisp_Object alist;
715{
716 Lisp_Object tail;
717
718 /* If both of these parameters are present, it's more efficient to
719 set them both at once. So we wait until we've looked at the
720 entire list before we set them. */
b839712d 721 int width, height;
ee78dc32
GV		 722
723 /* Same here. */
724 Lisp_Object left, top;
725
726 /* Same with these. */
727 Lisp_Object icon_left, icon_top;
728
729 /* Record in these vectors all the parms specified. */
730 Lisp_Object *parms;
731 Lisp_Object *values;
a797a73d 732 int i, p;
ee78dc32
GV		 733 int left_no_change = 0, top_no_change = 0;
734 int icon_left_no_change = 0, icon_top_no_change = 0;
735
5878523b
RS		 736 struct gcpro gcpro1, gcpro2;
737
ee78dc32
GV		 738 i = 0;
739 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
740 i++;
741
742 parms = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
743 values = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
744
745 /* Extract parm names and values into those vectors. */
746
747 i = 0;
748 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
749 {
6fc2811b 750 Lisp_Object elt;
ee78dc32
GV		 751
752 elt = Fcar (tail);
753 parms[i] = Fcar (elt);
754 values[i] = Fcdr (elt);
755 i++;
756 }
757
5878523b
RS		 758 /* TAIL and ALIST are not used again below here. */
759 alist = tail = Qnil;
760
761 GCPRO2 (*parms, *values);
762 gcpro1.nvars = i;
763 gcpro2.nvars = i;
764
765 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
766 because their values appear in VALUES and strings are not valid. */
b839712d 767 top = left = Qunbound;
ee78dc32
GV		 768 icon_left = icon_top = Qunbound;
769
b839712d
RS		 770 /* Provide default values for HEIGHT and WIDTH. */
771 width = FRAME_WIDTH (f);
772 height = FRAME_HEIGHT (f);
773
a797a73d
GV		 774 /* Process foreground_color and background_color before anything else.
775 They are independent of other properties, but other properties (e.g.,
776 cursor_color) are dependent upon them. */
777 for (p = 0; p < i; p++)
778 {
779 Lisp_Object prop, val;
780
781 prop = parms[p];
782 val = values[p];
783 if (EQ (prop, Qforeground_color) || EQ (prop, Qbackground_color))
784 {
785 register Lisp_Object param_index, old_value;
786
787 param_index = Fget (prop, Qx_frame_parameter);
788 old_value = get_frame_param (f, prop);
789 store_frame_param (f, prop, val);
790 if (NATNUMP (param_index)
791 && (XFASTINT (param_index)
792 < sizeof (x_frame_parms)/sizeof (x_frame_parms[0])))
793 (*x_frame_parms[XINT (param_index)].setter)(f, val, old_value);
794 }
795 }
796
ee78dc32
GV		 797 /* Now process them in reverse of specified order. */
798 for (i--; i >= 0; i--)
799 {
800 Lisp_Object prop, val;
801
802 prop = parms[i];
803 val = values[i];
804
b839712d
RS		 805 if (EQ (prop, Qwidth) && NUMBERP (val))
806 width = XFASTINT (val);
807 else if (EQ (prop, Qheight) && NUMBERP (val))
808 height = XFASTINT (val);
ee78dc32
GV		 809 else if (EQ (prop, Qtop))
810 top = val;
811 else if (EQ (prop, Qleft))
812 left = val;
813 else if (EQ (prop, Qicon_top))
814 icon_top = val;
815 else if (EQ (prop, Qicon_left))
816 icon_left = val;
a797a73d
GV		 817 else if (EQ (prop, Qforeground_color) || EQ (prop, Qbackground_color))
818 /* Processed above. */
819 continue;
ee78dc32
GV		 820 else
821 {
822 register Lisp_Object param_index, old_value;
823
824 param_index = Fget (prop, Qx_frame_parameter);
825 old_value = get_frame_param (f, prop);
826 store_frame_param (f, prop, val);
827 if (NATNUMP (param_index)
828 && (XFASTINT (param_index)
829 < sizeof (x_frame_parms)/sizeof (x_frame_parms[0])))
3c190163 830 (*x_frame_parms[XINT (param_index)].setter)(f, val, old_value);
ee78dc32
GV		 831 }
832 }
833
834 /* Don't die if just one of these was set. */
835 if (EQ (left, Qunbound))
836 {
837 left_no_change = 1;
fbd6baed
GV		 838 if (f->output_data.w32->left_pos < 0)
839 left = Fcons (Qplus, Fcons (make_number (f->output_data.w32->left_pos), Qnil));
ee78dc32 840 else
fbd6baed 841 XSETINT (left, f->output_data.w32->left_pos);
ee78dc32
GV		 842 }
843 if (EQ (top, Qunbound))
844 {
845 top_no_change = 1;
fbd6baed
GV		 846 if (f->output_data.w32->top_pos < 0)
847 top = Fcons (Qplus, Fcons (make_number (f->output_data.w32->top_pos), Qnil));
ee78dc32 848 else
fbd6baed 849 XSETINT (top, f->output_data.w32->top_pos);
ee78dc32
GV		 850 }
851
852 /* If one of the icon positions was not set, preserve or default it. */
853 if (EQ (icon_left, Qunbound) || ! INTEGERP (icon_left))
854 {
855 icon_left_no_change = 1;
856 icon_left = Fcdr (Fassq (Qicon_left, f->param_alist));
857 if (NILP (icon_left))
858 XSETINT (icon_left, 0);
859 }
860 if (EQ (icon_top, Qunbound) || ! INTEGERP (icon_top))
861 {
862 icon_top_no_change = 1;
863 icon_top = Fcdr (Fassq (Qicon_top, f->param_alist));
864 if (NILP (icon_top))
865 XSETINT (icon_top, 0);
866 }
867
ee78dc32
GV		 868 /* Don't set these parameters unless they've been explicitly
869 specified. The window might be mapped or resized while we're in
870 this function, and we don't want to override that unless the lisp
871 code has asked for it.
872
873 Don't set these parameters unless they actually differ from the
874 window's current parameters; the window may not actually exist
875 yet. */
876 {
877 Lisp_Object frame;
878
879 check_frame_size (f, &height, &width);
880
881 XSETFRAME (frame, f);
882
b839712d
RS		 883 if (XINT (width) != FRAME_WIDTH (f)
884 || XINT (height) != FRAME_HEIGHT (f))
885 Fset_frame_size (frame, make_number (width), make_number (height));
ee78dc32
GV		 886
887 if ((!NILP (left) || !NILP (top))
888 && ! (left_no_change && top_no_change)
fbd6baed
GV		 889 && ! (NUMBERP (left) && XINT (left) == f->output_data.w32->left_pos
890 && NUMBERP (top) && XINT (top) == f->output_data.w32->top_pos))
ee78dc32
GV		 891 {
892 int leftpos = 0;
893 int toppos = 0;
894
895 /* Record the signs. */
fbd6baed 896 f->output_data.w32->size_hint_flags &= ~ (XNegative | YNegative);
ee78dc32 897 if (EQ (left, Qminus))
fbd6baed 898 f->output_data.w32->size_hint_flags |= XNegative;
ee78dc32
GV		 899 else if (INTEGERP (left))
900 {
901 leftpos = XINT (left);
902 if (leftpos < 0)
fbd6baed 903 f->output_data.w32->size_hint_flags |= XNegative;
ee78dc32 904 }
8e713be6
KR		 905 else if (CONSP (left) && EQ (XCAR (left), Qminus)
906 && CONSP (XCDR (left))
907 && INTEGERP (XCAR (XCDR (left))))
ee78dc32 908 {
8e713be6 909 leftpos = - XINT (XCAR (XCDR (left)));
fbd6baed 910 f->output_data.w32->size_hint_flags |= XNegative;
ee78dc32 911 }
8e713be6
KR		 912 else if (CONSP (left) && EQ (XCAR (left), Qplus)
913 && CONSP (XCDR (left))
914 && INTEGERP (XCAR (XCDR (left))))
ee78dc32 915 {
8e713be6 916 leftpos = XINT (XCAR (XCDR (left)));
ee78dc32
GV		 917 }
918
919 if (EQ (top, Qminus))
fbd6baed 920 f->output_data.w32->size_hint_flags |= YNegative;
ee78dc32
GV		 921 else if (INTEGERP (top))
922 {
923 toppos = XINT (top);
924 if (toppos < 0)
fbd6baed 925 f->output_data.w32->size_hint_flags |= YNegative;
ee78dc32 926 }
8e713be6
KR		 927 else if (CONSP (top) && EQ (XCAR (top), Qminus)
928 && CONSP (XCDR (top))
929 && INTEGERP (XCAR (XCDR (top))))
ee78dc32 930 {
8e713be6 931 toppos = - XINT (XCAR (XCDR (top)));
fbd6baed 932 f->output_data.w32->size_hint_flags |= YNegative;
ee78dc32 933 }
8e713be6
KR		 934 else if (CONSP (top) && EQ (XCAR (top), Qplus)
935 && CONSP (XCDR (top))
936 && INTEGERP (XCAR (XCDR (top))))
ee78dc32 937 {
8e713be6 938 toppos = XINT (XCAR (XCDR (top)));
ee78dc32
GV		 939 }
940
941
942 /* Store the numeric value of the position. */
fbd6baed
GV		 943 f->output_data.w32->top_pos = toppos;
944 f->output_data.w32->left_pos = leftpos;
ee78dc32 945
fbd6baed 946 f->output_data.w32->win_gravity = NorthWestGravity;
ee78dc32
GV		 947
948 /* Actually set that position, and convert to absolute. */
949 x_set_offset (f, leftpos, toppos, -1);
950 }
951
952 if ((!NILP (icon_left) || !NILP (icon_top))
953 && ! (icon_left_no_change && icon_top_no_change))
954 x_wm_set_icon_position (f, XINT (icon_left), XINT (icon_top));
955 }
5878523b
RS		 956
957 UNGCPRO;
ee78dc32
GV		 958}
959
960/* Store the screen positions of frame F into XPTR and YPTR.
961 These are the positions of the containing window manager window,
962 not Emacs's own window. */
963
964void
965x_real_positions (f, xptr, yptr)
966 FRAME_PTR f;
967 int *xptr, *yptr;
968{
969 POINT pt;
3c190163
GV		 970
971 {
972 RECT rect;
ee78dc32 973
fbd6baed
GV		 974 GetClientRect(FRAME_W32_WINDOW(f), &rect);
975 AdjustWindowRect(&rect, f->output_data.w32->dwStyle, FRAME_EXTERNAL_MENU_BAR(f));
ee78dc32 976
3c190163
GV		 977 pt.x = rect.left;
978 pt.y = rect.top;
979 }
ee78dc32 980
fbd6baed 981 ClientToScreen (FRAME_W32_WINDOW(f), &pt);
ee78dc32
GV		 982
983 *xptr = pt.x;
984 *yptr = pt.y;
985}
986
987/* Insert a description of internally-recorded parameters of frame X
988 into the parameter alist *ALISTPTR that is to be given to the user.
fbd6baed 989 Only parameters that are specific to W32
ee78dc32
GV		 990 and whose values are not correctly recorded in the frame's
991 param_alist need to be considered here. */
992
993x_report_frame_params (f, alistptr)
994 struct frame *f;
995 Lisp_Object *alistptr;
996{
997 char buf[16];
998 Lisp_Object tem;
999
1000 /* Represent negative positions (off the top or left screen edge)
1001 in a way that Fmodify_frame_parameters will understand correctly. */
fbd6baed
GV		 1002 XSETINT (tem, f->output_data.w32->left_pos);
1003 if (f->output_data.w32->left_pos >= 0)
ee78dc32
GV		 1004 store_in_alist (alistptr, Qleft, tem);
1005 else
1006 store_in_alist (alistptr, Qleft, Fcons (Qplus, Fcons (tem, Qnil)));
1007
fbd6baed
GV		 1008 XSETINT (tem, f->output_data.w32->top_pos);
1009 if (f->output_data.w32->top_pos >= 0)
ee78dc32
GV		 1010 store_in_alist (alistptr, Qtop, tem);
1011 else
1012 store_in_alist (alistptr, Qtop, Fcons (Qplus, Fcons (tem, Qnil)));
1013
1014 store_in_alist (alistptr, Qborder_width,
fbd6baed 1015 make_number (f->output_data.w32->border_width));
ee78dc32 1016 store_in_alist (alistptr, Qinternal_border_width,
fbd6baed
GV		 1017 make_number (f->output_data.w32->internal_border_width));
1018 sprintf (buf, "%ld", (long) FRAME_W32_WINDOW (f));
ee78dc32
GV		 1019 store_in_alist (alistptr, Qwindow_id,
1020 build_string (buf));
1021 store_in_alist (alistptr, Qicon_name, f->icon_name);
1022 FRAME_SAMPLE_VISIBILITY (f);
1023 store_in_alist (alistptr, Qvisibility,
1024 (FRAME_VISIBLE_P (f) ? Qt
1025 : FRAME_ICONIFIED_P (f) ? Qicon : Qnil));
1026 store_in_alist (alistptr, Qdisplay,
8e713be6 1027 XCAR (FRAME_W32_DISPLAY_INFO (f)->name_list_element));
ee78dc32
GV		 1028}
1029\f
1030
fbd6baed 1031DEFUN ("w32-define-rgb-color", Fw32_define_rgb_color, Sw32_define_rgb_color, 4, 4, 0,
5ac45f98 1032 "Convert RGB numbers to a windows color reference and associate with NAME (a string).\n\
fbd6baed 1033This adds or updates a named color to w32-color-map, making it available for use.\n\
5ac45f98
GV		 1034The original entry's RGB ref is returned, or nil if the entry is new.")
1035 (red, green, blue, name)
1036 Lisp_Object red, green, blue, name;
ee78dc32 1037{
5ac45f98
GV		 1038 Lisp_Object rgb;
1039 Lisp_Object oldrgb = Qnil;
1040 Lisp_Object entry;
1041
1042 CHECK_NUMBER (red, 0);
1043 CHECK_NUMBER (green, 0);
1044 CHECK_NUMBER (blue, 0);
1045 CHECK_STRING (name, 0);
ee78dc32 1046
5ac45f98 1047 XSET (rgb, Lisp_Int, RGB(XUINT (red), XUINT (green), XUINT (blue)));
ee78dc32 1048
5ac45f98 1049 BLOCK_INPUT;
ee78dc32 1050
fbd6baed
GV		 1051 /* replace existing entry in w32-color-map or add new entry. */
1052 entry = Fassoc (name, Vw32_color_map);
5ac45f98
GV		 1053 if (NILP (entry))
1054 {
1055 entry = Fcons (name, rgb);
fbd6baed 1056 Vw32_color_map = Fcons (entry, Vw32_color_map);
5ac45f98
GV		 1057 }
1058 else
1059 {
1060 oldrgb = Fcdr (entry);
1061 Fsetcdr (entry, rgb);
1062 }
1063
1064 UNBLOCK_INPUT;
1065
1066 return (oldrgb);
ee78dc32
GV		 1067}
1068
fbd6baed 1069DEFUN ("w32-load-color-file", Fw32_load_color_file, Sw32_load_color_file, 1, 1, 0,
5ac45f98 1070 "Create an alist of color entries from an external file (ie. rgb.txt).\n\
fbd6baed 1071Assign this value to w32-color-map to replace the existing color map.\n\
5ac45f98
GV		 1072\
1073The file should define one named RGB color per line like so:\
1074 R G B name\n\
1075where R,G,B are numbers between 0 and 255 and name is an arbitrary string.")
1076 (filename)
1077 Lisp_Object filename;
1078{
1079 FILE *fp;
1080 Lisp_Object cmap = Qnil;
1081 Lisp_Object abspath;
1082
1083 CHECK_STRING (filename, 0);
1084 abspath = Fexpand_file_name (filename, Qnil);
1085
1086 fp = fopen (XSTRING (filename)->data, "rt");
1087 if (fp)
1088 {
1089 char buf[512];
1090 int red, green, blue;
1091 int num;
1092
1093 BLOCK_INPUT;
1094
1095 while (fgets (buf, sizeof (buf), fp) != NULL) {
1096 if (sscanf (buf, "%u %u %u %n", &red, &green, &blue, &num) == 3)
1097 {
1098 char *name = buf + num;
1099 num = strlen (name) - 1;
1100 if (name[num] == '\n')
1101 name[num] = 0;
1102 cmap = Fcons (Fcons (build_string (name),
1103 make_number (RGB (red, green, blue))),
1104 cmap);
1105 }
1106 }
1107 fclose (fp);
1108
1109 UNBLOCK_INPUT;
1110 }
1111
1112 return cmap;
1113}
ee78dc32 1114
fbd6baed 1115/* The default colors for the w32 color map */
ee78dc32
GV		 1116typedef struct colormap_t
1117{
1118 char *name;
1119 COLORREF colorref;
1120} colormap_t;
1121
fbd6baed 1122colormap_t w32_color_map[] =
ee78dc32 1123{
1da8a614
GV		 1124 {"snow" , PALETTERGB (255,250,250)},
1125 {"ghost white" , PALETTERGB (248,248,255)},
1126 {"GhostWhite" , PALETTERGB (248,248,255)},
1127 {"white smoke" , PALETTERGB (245,245,245)},
1128 {"WhiteSmoke" , PALETTERGB (245,245,245)},
1129 {"gainsboro" , PALETTERGB (220,220,220)},
1130 {"floral white" , PALETTERGB (255,250,240)},
1131 {"FloralWhite" , PALETTERGB (255,250,240)},
1132 {"old lace" , PALETTERGB (253,245,230)},
1133 {"OldLace" , PALETTERGB (253,245,230)},
1134 {"linen" , PALETTERGB (250,240,230)},
1135 {"antique white" , PALETTERGB (250,235,215)},
1136 {"AntiqueWhite" , PALETTERGB (250,235,215)},
1137 {"papaya whip" , PALETTERGB (255,239,213)},
1138 {"PapayaWhip" , PALETTERGB (255,239,213)},
1139 {"blanched almond" , PALETTERGB (255,235,205)},
1140 {"BlanchedAlmond" , PALETTERGB (255,235,205)},
1141 {"bisque" , PALETTERGB (255,228,196)},
1142 {"peach puff" , PALETTERGB (255,218,185)},
1143 {"PeachPuff" , PALETTERGB (255,218,185)},
1144 {"navajo white" , PALETTERGB (255,222,173)},
1145 {"NavajoWhite" , PALETTERGB (255,222,173)},
1146 {"moccasin" , PALETTERGB (255,228,181)},
1147 {"cornsilk" , PALETTERGB (255,248,220)},
1148 {"ivory" , PALETTERGB (255,255,240)},
1149 {"lemon chiffon" , PALETTERGB (255,250,205)},
1150 {"LemonChiffon" , PALETTERGB (255,250,205)},
1151 {"seashell" , PALETTERGB (255,245,238)},
1152 {"honeydew" , PALETTERGB (240,255,240)},
1153 {"mint cream" , PALETTERGB (245,255,250)},
1154 {"MintCream" , PALETTERGB (245,255,250)},
1155 {"azure" , PALETTERGB (240,255,255)},
1156 {"alice blue" , PALETTERGB (240,248,255)},
1157 {"AliceBlue" , PALETTERGB (240,248,255)},
1158 {"lavender" , PALETTERGB (230,230,250)},
1159 {"lavender blush" , PALETTERGB (255,240,245)},
1160 {"LavenderBlush" , PALETTERGB (255,240,245)},
1161 {"misty rose" , PALETTERGB (255,228,225)},
1162 {"MistyRose" , PALETTERGB (255,228,225)},
1163 {"white" , PALETTERGB (255,255,255)},
1164 {"black" , PALETTERGB ( 0, 0, 0)},
1165 {"dark slate gray" , PALETTERGB ( 47, 79, 79)},
1166 {"DarkSlateGray" , PALETTERGB ( 47, 79, 79)},
1167 {"dark slate grey" , PALETTERGB ( 47, 79, 79)},
1168 {"DarkSlateGrey" , PALETTERGB ( 47, 79, 79)},
1169 {"dim gray" , PALETTERGB (105,105,105)},
1170 {"DimGray" , PALETTERGB (105,105,105)},
1171 {"dim grey" , PALETTERGB (105,105,105)},
1172 {"DimGrey" , PALETTERGB (105,105,105)},
1173 {"slate gray" , PALETTERGB (112,128,144)},
1174 {"SlateGray" , PALETTERGB (112,128,144)},
1175 {"slate grey" , PALETTERGB (112,128,144)},
1176 {"SlateGrey" , PALETTERGB (112,128,144)},
1177 {"light slate gray" , PALETTERGB (119,136,153)},
1178 {"LightSlateGray" , PALETTERGB (119,136,153)},
1179 {"light slate grey" , PALETTERGB (119,136,153)},
1180 {"LightSlateGrey" , PALETTERGB (119,136,153)},
1181 {"gray" , PALETTERGB (190,190,190)},
1182 {"grey" , PALETTERGB (190,190,190)},
1183 {"light grey" , PALETTERGB (211,211,211)},
1184 {"LightGrey" , PALETTERGB (211,211,211)},
1185 {"light gray" , PALETTERGB (211,211,211)},
1186 {"LightGray" , PALETTERGB (211,211,211)},
1187 {"midnight blue" , PALETTERGB ( 25, 25,112)},
1188 {"MidnightBlue" , PALETTERGB ( 25, 25,112)},
1189 {"navy" , PALETTERGB ( 0, 0,128)},
1190 {"navy blue" , PALETTERGB ( 0, 0,128)},
1191 {"NavyBlue" , PALETTERGB ( 0, 0,128)},
1192 {"cornflower blue" , PALETTERGB (100,149,237)},
1193 {"CornflowerBlue" , PALETTERGB (100,149,237)},
1194 {"dark slate blue" , PALETTERGB ( 72, 61,139)},
1195 {"DarkSlateBlue" , PALETTERGB ( 72, 61,139)},
1196 {"slate blue" , PALETTERGB (106, 90,205)},
1197 {"SlateBlue" , PALETTERGB (106, 90,205)},
1198 {"medium slate blue" , PALETTERGB (123,104,238)},
1199 {"MediumSlateBlue" , PALETTERGB (123,104,238)},
1200 {"light slate blue" , PALETTERGB (132,112,255)},
1201 {"LightSlateBlue" , PALETTERGB (132,112,255)},
1202 {"medium blue" , PALETTERGB ( 0, 0,205)},
1203 {"MediumBlue" , PALETTERGB ( 0, 0,205)},
1204 {"royal blue" , PALETTERGB ( 65,105,225)},
1205 {"RoyalBlue" , PALETTERGB ( 65,105,225)},
1206 {"blue" , PALETTERGB ( 0, 0,255)},
1207 {"dodger blue" , PALETTERGB ( 30,144,255)},
1208 {"DodgerBlue" , PALETTERGB ( 30,144,255)},
1209 {"deep sky blue" , PALETTERGB ( 0,191,255)},
1210 {"DeepSkyBlue" , PALETTERGB ( 0,191,255)},
1211 {"sky blue" , PALETTERGB (135,206,235)},
1212 {"SkyBlue" , PALETTERGB (135,206,235)},
1213 {"light sky blue" , PALETTERGB (135,206,250)},
1214 {"LightSkyBlue" , PALETTERGB (135,206,250)},
1215 {"steel blue" , PALETTERGB ( 70,130,180)},
1216 {"SteelBlue" , PALETTERGB ( 70,130,180)},
1217 {"light steel blue" , PALETTERGB (176,196,222)},
1218 {"LightSteelBlue" , PALETTERGB (176,196,222)},
1219 {"light blue" , PALETTERGB (173,216,230)},
1220 {"LightBlue" , PALETTERGB (173,216,230)},
1221 {"powder blue" , PALETTERGB (176,224,230)},
1222 {"PowderBlue" , PALETTERGB (176,224,230)},
1223 {"pale turquoise" , PALETTERGB (175,238,238)},
1224 {"PaleTurquoise" , PALETTERGB (175,238,238)},
1225 {"dark turquoise" , PALETTERGB ( 0,206,209)},
1226 {"DarkTurquoise" , PALETTERGB ( 0,206,209)},
1227 {"medium turquoise" , PALETTERGB ( 72,209,204)},
1228 {"MediumTurquoise" , PALETTERGB ( 72,209,204)},
1229 {"turquoise" , PALETTERGB ( 64,224,208)},
1230 {"cyan" , PALETTERGB ( 0,255,255)},
1231 {"light cyan" , PALETTERGB (224,255,255)},
1232 {"LightCyan" , PALETTERGB (224,255,255)},
1233 {"cadet blue" , PALETTERGB ( 95,158,160)},
1234 {"CadetBlue" , PALETTERGB ( 95,158,160)},
1235 {"medium aquamarine" , PALETTERGB (102,205,170)},
1236 {"MediumAquamarine" , PALETTERGB (102,205,170)},
1237 {"aquamarine" , PALETTERGB (127,255,212)},
1238 {"dark green" , PALETTERGB ( 0,100, 0)},
1239 {"DarkGreen" , PALETTERGB ( 0,100, 0)},
1240 {"dark olive green" , PALETTERGB ( 85,107, 47)},
1241 {"DarkOliveGreen" , PALETTERGB ( 85,107, 47)},
1242 {"dark sea green" , PALETTERGB (143,188,143)},
1243 {"DarkSeaGreen" , PALETTERGB (143,188,143)},
1244 {"sea green" , PALETTERGB ( 46,139, 87)},
1245 {"SeaGreen" , PALETTERGB ( 46,139, 87)},
1246 {"medium sea green" , PALETTERGB ( 60,179,113)},
1247 {"MediumSeaGreen" , PALETTERGB ( 60,179,113)},
1248 {"light sea green" , PALETTERGB ( 32,178,170)},
1249 {"LightSeaGreen" , PALETTERGB ( 32,178,170)},
1250 {"pale green" , PALETTERGB (152,251,152)},
1251 {"PaleGreen" , PALETTERGB (152,251,152)},
1252 {"spring green" , PALETTERGB ( 0,255,127)},
1253 {"SpringGreen" , PALETTERGB ( 0,255,127)},
1254 {"lawn green" , PALETTERGB (124,252, 0)},
1255 {"LawnGreen" , PALETTERGB (124,252, 0)},
1256 {"green" , PALETTERGB ( 0,255, 0)},
1257 {"chartreuse" , PALETTERGB (127,255, 0)},
1258 {"medium spring green" , PALETTERGB ( 0,250,154)},
1259 {"MediumSpringGreen" , PALETTERGB ( 0,250,154)},
1260 {"green yellow" , PALETTERGB (173,255, 47)},
1261 {"GreenYellow" , PALETTERGB (173,255, 47)},
1262 {"lime green" , PALETTERGB ( 50,205, 50)},
1263 {"LimeGreen" , PALETTERGB ( 50,205, 50)},
1264 {"yellow green" , PALETTERGB (154,205, 50)},
1265 {"YellowGreen" , PALETTERGB (154,205, 50)},
1266 {"forest green" , PALETTERGB ( 34,139, 34)},
1267 {"ForestGreen" , PALETTERGB ( 34,139, 34)},
1268 {"olive drab" , PALETTERGB (107,142, 35)},
1269 {"OliveDrab" , PALETTERGB (107,142, 35)},
1270 {"dark khaki" , PALETTERGB (189,183,107)},
1271 {"DarkKhaki" , PALETTERGB (189,183,107)},
1272 {"khaki" , PALETTERGB (240,230,140)},
1273 {"pale goldenrod" , PALETTERGB (238,232,170)},
1274 {"PaleGoldenrod" , PALETTERGB (238,232,170)},
1275 {"light goldenrod yellow" , PALETTERGB (250,250,210)},
1276 {"LightGoldenrodYellow" , PALETTERGB (250,250,210)},
1277 {"light yellow" , PALETTERGB (255,255,224)},
1278 {"LightYellow" , PALETTERGB (255,255,224)},
1279 {"yellow" , PALETTERGB (255,255, 0)},
1280 {"gold" , PALETTERGB (255,215, 0)},
1281 {"light goldenrod" , PALETTERGB (238,221,130)},
1282 {"LightGoldenrod" , PALETTERGB (238,221,130)},
1283 {"goldenrod" , PALETTERGB (218,165, 32)},
1284 {"dark goldenrod" , PALETTERGB (184,134, 11)},
1285 {"DarkGoldenrod" , PALETTERGB (184,134, 11)},
1286 {"rosy brown" , PALETTERGB (188,143,143)},
1287 {"RosyBrown" , PALETTERGB (188,143,143)},
1288 {"indian red" , PALETTERGB (205, 92, 92)},
1289 {"IndianRed" , PALETTERGB (205, 92, 92)},
1290 {"saddle brown" , PALETTERGB (139, 69, 19)},
1291 {"SaddleBrown" , PALETTERGB (139, 69, 19)},
1292 {"sienna" , PALETTERGB (160, 82, 45)},
1293 {"peru" , PALETTERGB (205,133, 63)},
1294 {"burlywood" , PALETTERGB (222,184,135)},
1295 {"beige" , PALETTERGB (245,245,220)},
1296 {"wheat" , PALETTERGB (245,222,179)},
1297 {"sandy brown" , PALETTERGB (244,164, 96)},
1298 {"SandyBrown" , PALETTERGB (244,164, 96)},
1299 {"tan" , PALETTERGB (210,180,140)},
1300 {"chocolate" , PALETTERGB (210,105, 30)},
1301 {"firebrick" , PALETTERGB (178,34, 34)},
1302 {"brown" , PALETTERGB (165,42, 42)},
1303 {"dark salmon" , PALETTERGB (233,150,122)},
1304 {"DarkSalmon" , PALETTERGB (233,150,122)},
1305 {"salmon" , PALETTERGB (250,128,114)},
1306 {"light salmon" , PALETTERGB (255,160,122)},
1307 {"LightSalmon" , PALETTERGB (255,160,122)},
1308 {"orange" , PALETTERGB (255,165, 0)},
1309 {"dark orange" , PALETTERGB (255,140, 0)},
1310 {"DarkOrange" , PALETTERGB (255,140, 0)},
1311 {"coral" , PALETTERGB (255,127, 80)},
1312 {"light coral" , PALETTERGB (240,128,128)},
1313 {"LightCoral" , PALETTERGB (240,128,128)},
1314 {"tomato" , PALETTERGB (255, 99, 71)},
1315 {"orange red" , PALETTERGB (255, 69, 0)},
1316 {"OrangeRed" , PALETTERGB (255, 69, 0)},
1317 {"red" , PALETTERGB (255, 0, 0)},
1318 {"hot pink" , PALETTERGB (255,105,180)},
1319 {"HotPink" , PALETTERGB (255,105,180)},
1320 {"deep pink" , PALETTERGB (255, 20,147)},
1321 {"DeepPink" , PALETTERGB (255, 20,147)},
1322 {"pink" , PALETTERGB (255,192,203)},
1323 {"light pink" , PALETTERGB (255,182,193)},
1324 {"LightPink" , PALETTERGB (255,182,193)},
1325 {"pale violet red" , PALETTERGB (219,112,147)},
1326 {"PaleVioletRed" , PALETTERGB (219,112,147)},
1327 {"maroon" , PALETTERGB (176, 48, 96)},
1328 {"medium violet red" , PALETTERGB (199, 21,133)},
1329 {"MediumVioletRed" , PALETTERGB (199, 21,133)},
1330 {"violet red" , PALETTERGB (208, 32,144)},
1331 {"VioletRed" , PALETTERGB (208, 32,144)},
1332 {"magenta" , PALETTERGB (255, 0,255)},
1333 {"violet" , PALETTERGB (238,130,238)},
1334 {"plum" , PALETTERGB (221,160,221)},
1335 {"orchid" , PALETTERGB (218,112,214)},
1336 {"medium orchid" , PALETTERGB (186, 85,211)},
1337 {"MediumOrchid" , PALETTERGB (186, 85,211)},
1338 {"dark orchid" , PALETTERGB (153, 50,204)},
1339 {"DarkOrchid" , PALETTERGB (153, 50,204)},
1340 {"dark violet" , PALETTERGB (148, 0,211)},
1341 {"DarkViolet" , PALETTERGB (148, 0,211)},
1342 {"blue violet" , PALETTERGB (138, 43,226)},
1343 {"BlueViolet" , PALETTERGB (138, 43,226)},
1344 {"purple" , PALETTERGB (160, 32,240)},
1345 {"medium purple" , PALETTERGB (147,112,219)},
1346 {"MediumPurple" , PALETTERGB (147,112,219)},
1347 {"thistle" , PALETTERGB (216,191,216)},
1348 {"gray0" , PALETTERGB ( 0, 0, 0)},
1349 {"grey0" , PALETTERGB ( 0, 0, 0)},
1350 {"dark grey" , PALETTERGB (169,169,169)},
1351 {"DarkGrey" , PALETTERGB (169,169,169)},
1352 {"dark gray" , PALETTERGB (169,169,169)},
1353 {"DarkGray" , PALETTERGB (169,169,169)},
1354 {"dark blue" , PALETTERGB ( 0, 0,139)},
1355 {"DarkBlue" , PALETTERGB ( 0, 0,139)},
1356 {"dark cyan" , PALETTERGB ( 0,139,139)},
1357 {"DarkCyan" , PALETTERGB ( 0,139,139)},
1358 {"dark magenta" , PALETTERGB (139, 0,139)},
1359 {"DarkMagenta" , PALETTERGB (139, 0,139)},
1360 {"dark red" , PALETTERGB (139, 0, 0)},
1361 {"DarkRed" , PALETTERGB (139, 0, 0)},
1362 {"light green" , PALETTERGB (144,238,144)},
1363 {"LightGreen" , PALETTERGB (144,238,144)},
ee78dc32
GV		 1364};
1365
fbd6baed 1366DEFUN ("w32-default-color-map", Fw32_default_color_map, Sw32_default_color_map,
ee78dc32
GV		 1367 0, 0, 0, "Return the default color map.")
1368 ()
1369{
1370 int i;
fbd6baed 1371 colormap_t *pc = w32_color_map;
ee78dc32
GV		 1372 Lisp_Object cmap;
1373
1374 BLOCK_INPUT;
1375
1376 cmap = Qnil;
1377
fbd6baed 1378 for (i = 0; i < sizeof (w32_color_map) / sizeof (w32_color_map[0]);
ee78dc32
GV		 1379 pc++, i++)
1380 cmap = Fcons (Fcons (build_string (pc->name),
1381 make_number (pc->colorref)),
1382 cmap);
1383
1384 UNBLOCK_INPUT;
1385
1386 return (cmap);
1387}
ee78dc32
GV		 1388
1389Lisp_Object
fbd6baed 1390w32_to_x_color (rgb)
ee78dc32
GV		 1391 Lisp_Object rgb;
1392{
1393 Lisp_Object color;
1394
1395 CHECK_NUMBER (rgb, 0);
1396
1397 BLOCK_INPUT;
1398
fbd6baed 1399 color = Frassq (rgb, Vw32_color_map);
ee78dc32
GV		 1400
1401 UNBLOCK_INPUT;
1402
1403 if (!NILP (color))
1404 return (Fcar (color));
1405 else
1406 return Qnil;
1407}
1408
5d7fed93
GV		 1409COLORREF
1410w32_color_map_lookup (colorname)
1411 char *colorname;
1412{
1413 Lisp_Object tail, ret = Qnil;
1414
1415 BLOCK_INPUT;
1416
1417 for (tail = Vw32_color_map; !NILP (tail); tail = Fcdr (tail))
1418 {
1419 register Lisp_Object elt, tem;
1420
1421 elt = Fcar (tail);
1422 if (!CONSP (elt)) continue;
1423
1424 tem = Fcar (elt);
1425
1426 if (lstrcmpi (XSTRING (tem)->data, colorname) == 0)
1427 {
1428 ret = XUINT (Fcdr (elt));
1429 break;
1430 }
1431
1432 QUIT;
1433 }
1434
1435
1436 UNBLOCK_INPUT;
1437
1438 return ret;
1439}
1440
ee78dc32 1441COLORREF
fbd6baed 1442x_to_w32_color (colorname)
ee78dc32
GV		 1443 char * colorname;
1444{
1445 register Lisp_Object tail, ret = Qnil;
1446
1447 BLOCK_INPUT;
1edf84e7
GV		 1448
1449 if (colorname[0] == '#')
1450 {
1451 /* Could be an old-style RGB Device specification. */
1452 char *color;
1453 int size;
1454 color = colorname + 1;
1455
1456 size = strlen(color);
1457 if (size == 3 || size == 6 || size == 9 || size == 12)
1458 {
1459 UINT colorval;
1460 int i, pos;
1461 pos = 0;
1462 size /= 3;
1463 colorval = 0;
1464
1465 for (i = 0; i < 3; i++)
1466 {
1467 char *end;
1468 char t;
1469 unsigned long value;
1470
1471 /* The check for 'x' in the following conditional takes into
1472 account the fact that strtol allows a "0x" in front of
1473 our numbers, and we don't. */
1474 if (!isxdigit(color[0]) || color[1] == 'x')
1475 break;
1476 t = color[size];
1477 color[size] = '\0';
1478 value = strtoul(color, &end, 16);
1479 color[size] = t;
1480 if (errno == ERANGE || end - color != size)
1481 break;
1482 switch (size)
1483 {
1484 case 1:
1485 value = value * 0x10;
1486 break;
1487 case 2:
1488 break;
1489 case 3:
1490 value /= 0x10;
1491 break;
1492 case 4:
1493 value /= 0x100;
1494 break;
1495 }
1496 colorval |= (value << pos);
1497 pos += 0x8;
1498 if (i == 2)
1499 {
1500 UNBLOCK_INPUT;
1501 return (colorval);
1502 }
1503 color = end;
1504 }
1505 }
1506 }
1507 else if (strnicmp(colorname, "rgb:", 4) == 0)
1508 {
1509 char *color;
1510 UINT colorval;
1511 int i, pos;
1512 pos = 0;
1513
1514 colorval = 0;
1515 color = colorname + 4;
1516 for (i = 0; i < 3; i++)
1517 {
1518 char *end;
1519 unsigned long value;
1520
1521 /* The check for 'x' in the following conditional takes into
1522 account the fact that strtol allows a "0x" in front of
1523 our numbers, and we don't. */
1524 if (!isxdigit(color[0]) || color[1] == 'x')
1525 break;
1526 value = strtoul(color, &end, 16);
1527 if (errno == ERANGE)
1528 break;
1529 switch (end - color)
1530 {
1531 case 1:
1532 value = value * 0x10 + value;
1533 break;
1534 case 2:
1535 break;
1536 case 3:
1537 value /= 0x10;
1538 break;
1539 case 4:
1540 value /= 0x100;
1541 break;
1542 default:
1543 value = ULONG_MAX;
1544 }
1545 if (value == ULONG_MAX)
1546 break;
1547 colorval |= (value << pos);
1548 pos += 0x8;
1549 if (i == 2)
1550 {
1551 if (*end != '\0')
1552 break;
1553 UNBLOCK_INPUT;
1554 return (colorval);
1555 }
1556 if (*end != '/')
1557 break;
1558 color = end + 1;
1559 }
1560 }
1561 else if (strnicmp(colorname, "rgbi:", 5) == 0)
1562 {
1563 /* This is an RGB Intensity specification. */
1564 char *color;
1565 UINT colorval;
1566 int i, pos;
1567 pos = 0;
1568
1569 colorval = 0;
1570 color = colorname + 5;
1571 for (i = 0; i < 3; i++)
1572 {
1573 char *end;
1574 double value;
1575 UINT val;
1576
1577 value = strtod(color, &end);
1578 if (errno == ERANGE)
1579 break;
1580 if (value < 0.0 || value > 1.0)
1581 break;
1582 val = (UINT)(0x100 * value);
1583 /* We used 0x100 instead of 0xFF to give an continuous
1584 range between 0.0 and 1.0 inclusive. The next statement
1585 fixes the 1.0 case. */
1586 if (val == 0x100)
1587 val = 0xFF;
1588 colorval |= (val << pos);
1589 pos += 0x8;
1590 if (i == 2)
1591 {
1592 if (*end != '\0')
1593 break;
1594 UNBLOCK_INPUT;
1595 return (colorval);
1596 }
1597 if (*end != '/')
1598 break;
1599 color = end + 1;
1600 }
1601 }
1602 /* I am not going to attempt to handle any of the CIE color schemes
1603 or TekHVC, since I don't know the algorithms for conversion to
1604 RGB. */
f695b4b1
GV		 1605
1606 /* If we fail to lookup the color name in w32_color_map, then check the
1607 colorname to see if it can be crudely approximated: If the X color
1608 ends in a number (e.g., "darkseagreen2"), strip the number and
1609 return the result of looking up the base color name. */
1610 ret = w32_color_map_lookup (colorname);
1611 if (NILP (ret))
ee78dc32 1612 {
f695b4b1 1613 int len = strlen (colorname);
ee78dc32 1614
f695b4b1
GV		 1615 if (isdigit (colorname[len - 1]))
1616 {
1617 char *ptr, *approx = alloca (len);
ee78dc32 1618
f695b4b1
GV		 1619 strcpy (approx, colorname);
1620 ptr = &approx[len - 1];
1621 while (ptr > approx && isdigit (*ptr))
1622 *ptr-- = '\0';
ee78dc32 1623
f695b4b1 1624 ret = w32_color_map_lookup (approx);
ee78dc32 1625 }
ee78dc32
GV		 1626 }
1627
1628 UNBLOCK_INPUT;
ee78dc32
GV		 1629 return ret;
1630}
1631
5ac45f98
GV		 1632
1633void
fbd6baed 1634w32_regenerate_palette (FRAME_PTR f)
5ac45f98 1635{
fbd6baed 1636 struct w32_palette_entry * list;
5ac45f98
GV		 1637 LOGPALETTE * log_palette;
1638 HPALETTE new_palette;
1639 int i;
1640
1641 /* don't bother trying to create palette if not supported */
fbd6baed 1642 if (! FRAME_W32_DISPLAY_INFO (f)->has_palette)
5ac45f98
GV		 1643 return;
1644
1645 log_palette = (LOGPALETTE *)
1646 alloca (sizeof (LOGPALETTE) +
fbd6baed 1647 FRAME_W32_DISPLAY_INFO (f)->num_colors * sizeof (PALETTEENTRY));
5ac45f98 1648 log_palette->palVersion = 0x300;
fbd6baed 1649 log_palette->palNumEntries = FRAME_W32_DISPLAY_INFO (f)->num_colors;
5ac45f98 1650
fbd6baed 1651 list = FRAME_W32_DISPLAY_INFO (f)->color_list;
5ac45f98 1652 for (i = 0;
fbd6baed 1653 i < FRAME_W32_DISPLAY_INFO (f)->num_colors;
5ac45f98
GV		 1654 i++, list = list->next)
1655 log_palette->palPalEntry[i] = list->entry;
1656
1657 new_palette = CreatePalette (log_palette);
1658
1659 enter_crit ();
1660
fbd6baed
GV		 1661 if (FRAME_W32_DISPLAY_INFO (f)->palette)
1662 DeleteObject (FRAME_W32_DISPLAY_INFO (f)->palette);
1663 FRAME_W32_DISPLAY_INFO (f)->palette = new_palette;
5ac45f98
GV		 1664
1665 /* Realize display palette and garbage all frames. */
1666 release_frame_dc (f, get_frame_dc (f));
1667
1668 leave_crit ();
1669}
1670
fbd6baed
GV		 1671#define W32_COLOR(pe) RGB (pe.peRed, pe.peGreen, pe.peBlue)
1672#define SET_W32_COLOR(pe, color) \
5ac45f98
GV		 1673 do \
1674 { \
1675 pe.peRed = GetRValue (color); \
1676 pe.peGreen = GetGValue (color); \
1677 pe.peBlue = GetBValue (color); \
1678 pe.peFlags = 0; \
1679 } while (0)
1680
1681#if 0
1682/* Keep these around in case we ever want to track color usage. */
1683void
fbd6baed 1684w32_map_color (FRAME_PTR f, COLORREF color)
5ac45f98 1685{
fbd6baed 1686 struct w32_palette_entry * list = FRAME_W32_DISPLAY_INFO (f)->color_list;
5ac45f98 1687
fbd6baed 1688 if (NILP (Vw32_enable_palette))
5ac45f98
GV		 1689 return;
1690
1691 /* check if color is already mapped */
1692 while (list)
1693 {
fbd6baed 1694 if (W32_COLOR (list->entry) == color)
5ac45f98
GV		 1695 {
1696 ++list->refcount;
1697 return;
1698 }
1699 list = list->next;
1700 }
1701
1702 /* not already mapped, so add to list and recreate Windows palette */
fbd6baed
GV		 1703 list = (struct w32_palette_entry *)
1704 xmalloc (sizeof (struct w32_palette_entry));
1705 SET_W32_COLOR (list->entry, color);
5ac45f98 1706 list->refcount = 1;
fbd6baed
GV		 1707 list->next = FRAME_W32_DISPLAY_INFO (f)->color_list;
1708 FRAME_W32_DISPLAY_INFO (f)->color_list = list;
1709 FRAME_W32_DISPLAY_INFO (f)->num_colors++;
5ac45f98
GV		 1710
1711 /* set flag that palette must be regenerated */
fbd6baed 1712 FRAME_W32_DISPLAY_INFO (f)->regen_palette = TRUE;
5ac45f98
GV		 1713}
1714
1715void
fbd6baed 1716w32_unmap_color (FRAME_PTR f, COLORREF color)
5ac45f98 1717{
fbd6baed
GV		 1718 struct w32_palette_entry * list = FRAME_W32_DISPLAY_INFO (f)->color_list;
1719 struct w32_palette_entry **prev = &FRAME_W32_DISPLAY_INFO (f)->color_list;
5ac45f98 1720
fbd6baed 1721 if (NILP (Vw32_enable_palette))
5ac45f98
GV		 1722 return;
1723
1724 /* check if color is already mapped */
1725 while (list)
1726 {
fbd6baed 1727 if (W32_COLOR (list->entry) == color)
5ac45f98
GV		 1728 {
1729 if (--list->refcount == 0)
1730 {
1731 *prev = list->next;
1732 xfree (list);
fbd6baed 1733 FRAME_W32_DISPLAY_INFO (f)->num_colors--;
5ac45f98
GV		 1734 break;
1735 }
1736 else
1737 return;
1738 }
1739 prev = &list->next;
1740 list = list->next;
1741 }
1742
1743 /* set flag that palette must be regenerated */
fbd6baed 1744 FRAME_W32_DISPLAY_INFO (f)->regen_palette = TRUE;
5ac45f98
GV		 1745}
1746#endif
1747
6fc2811b
JR		 1748
1749/* Gamma-correct COLOR on frame F. */
1750
1751void
1752gamma_correct (f, color)
1753 struct frame *f;
1754 COLORREF *color;
1755{
1756 if (f->gamma)
1757 {
1758 *color = PALETTERGB (
1759 pow (GetRValue (*color) / 255.0, f->gamma) * 255.0 + 0.5,
1760 pow (GetGValue (*color) / 255.0, f->gamma) * 255.0 + 0.5,
1761 pow (GetBValue (*color) / 255.0, f->gamma) * 255.0 + 0.5);
1762 }
1763}
1764
1765
ee78dc32
GV		 1766/* Decide if color named COLOR is valid for the display associated with
1767 the selected frame; if so, return the rgb values in COLOR_DEF.
1768 If ALLOC is nonzero, allocate a new colormap cell. */
1769
1770int
6fc2811b 1771w32_defined_color (f, color, color_def, alloc)
ee78dc32
GV		 1772 FRAME_PTR f;
1773 char *color;
6fc2811b 1774 XColor *color_def;
ee78dc32
GV		 1775 int alloc;
1776{
1777 register Lisp_Object tem;
6fc2811b 1778 COLORREF w32_color_ref;
3c190163 1779
fbd6baed 1780 tem = x_to_w32_color (color);
3c190163 1781
ee78dc32
GV		 1782 if (!NILP (tem))
1783 {
9badad41
JR		 1784 /* Apply gamma correction. */
1785 w32_color_ref = XUINT (tem);
1786 gamma_correct (f, &w32_color_ref);
1787 XSETINT (tem, w32_color_ref);
1788
1789 /* Map this color to the palette if it is enabled. */
fbd6baed 1790 if (!NILP (Vw32_enable_palette))
5ac45f98 1791 {
fbd6baed
GV		 1792 struct w32_palette_entry * entry =
1793 FRAME_W32_DISPLAY_INFO (f)->color_list;
1794 struct w32_palette_entry ** prev =
1795 &FRAME_W32_DISPLAY_INFO (f)->color_list;
5ac45f98
GV		 1796
1797 /* check if color is already mapped */
1798 while (entry)
1799 {
fbd6baed 1800 if (W32_COLOR (entry->entry) == XUINT (tem))
5ac45f98
GV		 1801 break;
1802 prev = &entry->next;
1803 entry = entry->next;
1804 }
1805
1806 if (entry == NULL && alloc)
1807 {
1808 /* not already mapped, so add to list */
fbd6baed
GV		 1809 entry = (struct w32_palette_entry *)
1810 xmalloc (sizeof (struct w32_palette_entry));
1811 SET_W32_COLOR (entry->entry, XUINT (tem));
5ac45f98
GV		 1812 entry->next = NULL;
1813 *prev = entry;
fbd6baed 1814 FRAME_W32_DISPLAY_INFO (f)->num_colors++;
5ac45f98
GV		 1815
1816 /* set flag that palette must be regenerated */
fbd6baed 1817 FRAME_W32_DISPLAY_INFO (f)->regen_palette = TRUE;
5ac45f98
GV		 1818 }
1819 }
1820 /* Ensure COLORREF value is snapped to nearest color in (default)
1821 palette by simulating the PALETTERGB macro. This works whether
1822 or not the display device has a palette. */
6fc2811b
JR		 1823 w32_color_ref = XUINT (tem) | 0x2000000;
1824
6fc2811b
JR		 1825 color_def->pixel = w32_color_ref;
1826 color_def->red = GetRValue (w32_color_ref);
1827 color_def->green = GetGValue (w32_color_ref);
1828 color_def->blue = GetBValue (w32_color_ref);
1829
ee78dc32 1830 return 1;
5ac45f98 1831 }
7fb46567 1832 else
3c190163
GV		 1833 {
1834 return 0;
1835 }
ee78dc32
GV		 1836}
1837
1838/* Given a string ARG naming a color, compute a pixel value from it
1839 suitable for screen F.
1840 If F is not a color screen, return DEF (default) regardless of what
1841 ARG says. */
1842
1843int
1844x_decode_color (f, arg, def)
1845 FRAME_PTR f;
1846 Lisp_Object arg;
1847 int def;
1848{
6fc2811b 1849 XColor cdef;
ee78dc32
GV		 1850
1851 CHECK_STRING (arg, 0);
1852
1853 if (strcmp (XSTRING (arg)->data, "black") == 0)
1854 return BLACK_PIX_DEFAULT (f);
1855 else if (strcmp (XSTRING (arg)->data, "white") == 0)
1856 return WHITE_PIX_DEFAULT (f);
1857
fbd6baed 1858 if ((FRAME_W32_DISPLAY_INFO (f)->n_planes * FRAME_W32_DISPLAY_INFO (f)->n_cbits) == 1)
ee78dc32
GV		 1859 return def;
1860
6fc2811b 1861 /* w32_defined_color is responsible for coping with failures
ee78dc32 1862 by looking for a near-miss. */
6fc2811b
JR		 1863 if (w32_defined_color (f, XSTRING (arg)->data, &cdef, 1))
1864 return cdef.pixel;
ee78dc32
GV		 1865
1866 /* defined_color failed; return an ultimate default. */
1867 return def;
1868}
1869\f
6fc2811b
JR		 1870/* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
1871 the previous value of that parameter, NEW_VALUE is the new value. */
1872
1873static void
1874x_set_screen_gamma (f, new_value, old_value)
1875 struct frame *f;
1876 Lisp_Object new_value, old_value;
1877{
1878 if (NILP (new_value))
1879 f->gamma = 0;
1880 else if (NUMBERP (new_value) && XFLOATINT (new_value) > 0)
1881 /* The value 0.4545 is the normal viewing gamma. */
1882 f->gamma = 1.0 / (0.4545 * XFLOATINT (new_value));
1883 else
1884 Fsignal (Qerror, Fcons (build_string ("Illegal screen-gamma"),
1885 Fcons (new_value, Qnil)));
1886
1887 clear_face_cache (0);
1888}
1889
1890
ee78dc32
GV		 1891/* Functions called only from `x_set_frame_param'
1892 to set individual parameters.
1893
fbd6baed 1894 If FRAME_W32_WINDOW (f) is 0,
ee78dc32
GV		 1895 the frame is being created and its window does not exist yet.
1896 In that case, just record the parameter's new value
1897 in the standard place; do not attempt to change the window. */
1898
1899void
1900x_set_foreground_color (f, arg, oldval)
1901 struct frame *f;
1902 Lisp_Object arg, oldval;
1903{
6fc2811b 1904 FRAME_FOREGROUND_PIXEL (f)
ee78dc32 1905 = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
5ac45f98 1906
fbd6baed 1907 if (FRAME_W32_WINDOW (f) != 0)
ee78dc32 1908 {
6fc2811b 1909 update_face_from_frame_parameter (f, Qforeground_color, arg);
ee78dc32
GV		 1910 if (FRAME_VISIBLE_P (f))
1911 redraw_frame (f);
1912 }
1913}
1914
1915void
1916x_set_background_color (f, arg, oldval)
1917 struct frame *f;
1918 Lisp_Object arg, oldval;
1919{
6fc2811b 1920 FRAME_BACKGROUND_PIXEL (f)
ee78dc32
GV		 1921 = x_decode_color (f, arg, WHITE_PIX_DEFAULT (f));
1922
fbd6baed 1923 if (FRAME_W32_WINDOW (f) != 0)
ee78dc32 1924 {
6fc2811b
JR		 1925 SetWindowLong (FRAME_W32_WINDOW (f), WND_BACKGROUND_INDEX,
1926 FRAME_BACKGROUND_PIXEL (f));
ee78dc32 1927
6fc2811b 1928 update_face_from_frame_parameter (f, Qbackground_color, arg);
ee78dc32
GV		 1929
1930 if (FRAME_VISIBLE_P (f))
1931 redraw_frame (f);
1932 }
1933}
1934
1935void
1936x_set_mouse_color (f, arg, oldval)
1937 struct frame *f;
1938 Lisp_Object arg, oldval;
1939{
6fc2811b 1940
ee78dc32 1941 Cursor cursor, nontext_cursor, mode_cursor, cross_cursor;
dfc465d3 1942 int count;
ee78dc32
GV		 1943 int mask_color;
1944
1945 if (!EQ (Qnil, arg))
fbd6baed 1946 f->output_data.w32->mouse_pixel
ee78dc32 1947 = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
6fc2811b
JR		 1948 mask_color = FRAME_BACKGROUND_PIXEL (f);
1949
1950 /* Don't let pointers be invisible. */
fbd6baed 1951 if (mask_color == f->output_data.w32->mouse_pixel
6fc2811b
JR		 1952 && mask_color == FRAME_BACKGROUND_PIXEL (f))
1953 f->output_data.w32->mouse_pixel = FRAME_FOREGROUND_PIXEL (f);
ee78dc32 1954
6fc2811b 1955#if 0 /* NTEMACS_TODO : cursor changes */
ee78dc32
GV		 1956 BLOCK_INPUT;
1957
1958 /* It's not okay to crash if the user selects a screwy cursor. */
fadca6c6 1959 count = x_catch_errors (FRAME_W32_DISPLAY (f));
ee78dc32
GV		 1960
1961 if (!EQ (Qnil, Vx_pointer_shape))
1962 {
1963 CHECK_NUMBER (Vx_pointer_shape, 0);
fbd6baed 1964 cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XINT (Vx_pointer_shape));
ee78dc32
GV		 1965 }
1966 else
fbd6baed
GV		 1967 cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_xterm);
1968 x_check_errors (FRAME_W32_DISPLAY (f), "bad text pointer cursor: %s");
ee78dc32
GV		 1969
1970 if (!EQ (Qnil, Vx_nontext_pointer_shape))
1971 {
1972 CHECK_NUMBER (Vx_nontext_pointer_shape, 0);
fbd6baed 1973 nontext_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f),
ee78dc32
GV		 1974 XINT (Vx_nontext_pointer_shape));
1975 }
1976 else
fbd6baed
GV		 1977 nontext_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_left_ptr);
1978 x_check_errors (FRAME_W32_DISPLAY (f), "bad nontext pointer cursor: %s");
ee78dc32 1979
6fc2811b
JR		 1980 if (!EQ (Qnil, Vx_busy_pointer_shape))
1981 {
1982 CHECK_NUMBER (Vx_busy_pointer_shape, 0);
1983 busy_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f),
1984 XINT (Vx_busy_pointer_shape));
1985 }
1986 else
1987 busy_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_watch);
1988 x_check_errors (FRAME_W32_DISPLAY (f), "bad busy pointer cursor: %s");
1989
1990 x_check_errors (FRAME_W32_DISPLAY (f), "bad nontext pointer cursor: %s");
ee78dc32
GV		 1991 if (!EQ (Qnil, Vx_mode_pointer_shape))
1992 {
1993 CHECK_NUMBER (Vx_mode_pointer_shape, 0);
fbd6baed 1994 mode_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f),
ee78dc32
GV		 1995 XINT (Vx_mode_pointer_shape));
1996 }
1997 else
fbd6baed
GV		 1998 mode_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_xterm);
1999 x_check_errors (FRAME_W32_DISPLAY (f), "bad modeline pointer cursor: %s");
ee78dc32
GV		 2000
2001 if (!EQ (Qnil, Vx_sensitive_text_pointer_shape))
2002 {
2003 CHECK_NUMBER (Vx_sensitive_text_pointer_shape, 0);
2004 cross_cursor
fbd6baed 2005 = XCreateFontCursor (FRAME_W32_DISPLAY (f),
ee78dc32
GV		 2006 XINT (Vx_sensitive_text_pointer_shape));
2007 }
2008 else
fbd6baed 2009 cross_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_crosshair);
ee78dc32
GV		 2010
2011 /* Check and report errors with the above calls. */
fbd6baed 2012 x_check_errors (FRAME_W32_DISPLAY (f), "can't set cursor shape: %s");
fadca6c6 2013 x_uncatch_errors (FRAME_W32_DISPLAY (f), count);
ee78dc32
GV		 2014
2015 {
2016 XColor fore_color, back_color;
2017
fbd6baed 2018 fore_color.pixel = f->output_data.w32->mouse_pixel;
ee78dc32 2019 back_color.pixel = mask_color;
fbd6baed
GV		 2020 XQueryColor (FRAME_W32_DISPLAY (f),
2021 DefaultColormap (FRAME_W32_DISPLAY (f),
2022 DefaultScreen (FRAME_W32_DISPLAY (f))),
ee78dc32 2023 &fore_color);
fbd6baed
GV		 2024 XQueryColor (FRAME_W32_DISPLAY (f),
2025 DefaultColormap (FRAME_W32_DISPLAY (f),
2026 DefaultScreen (FRAME_W32_DISPLAY (f))),
ee78dc32 2027 &back_color);
fbd6baed 2028 XRecolorCursor (FRAME_W32_DISPLAY (f), cursor,
ee78dc32 2029 &fore_color, &back_color);
fbd6baed 2030 XRecolorCursor (FRAME_W32_DISPLAY (f), nontext_cursor,
ee78dc32 2031 &fore_color, &back_color);
fbd6baed 2032 XRecolorCursor (FRAME_W32_DISPLAY (f), mode_cursor,
ee78dc32 2033 &fore_color, &back_color);
fbd6baed 2034 XRecolorCursor (FRAME_W32_DISPLAY (f), cross_cursor,
ee78dc32 2035 &fore_color, &back_color);
6fc2811b
JR		 2036 XRecolorCursor (FRAME_W32_DISPLAY (f), busy_cursor,
2037 &fore_color, &back_color);
ee78dc32
GV		 2038 }
2039
fbd6baed 2040 if (FRAME_W32_WINDOW (f) != 0)
6fc2811b 2041 XDefineCursor (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f), cursor);
ee78dc32 2042
fbd6baed
GV		 2043 if (cursor != f->output_data.w32->text_cursor && f->output_data.w32->text_cursor != 0)
2044 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->text_cursor);
2045 f->output_data.w32->text_cursor = cursor;
2046
2047 if (nontext_cursor != f->output_data.w32->nontext_cursor
2048 && f->output_data.w32->nontext_cursor != 0)
2049 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->nontext_cursor);
2050 f->output_data.w32->nontext_cursor = nontext_cursor;
2051
6fc2811b
JR		 2052 if (busy_cursor != f->output_data.w32->busy_cursor
2053 && f->output_data.w32->busy_cursor != 0)
2054 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->busy_cursor);
2055 f->output_data.w32->busy_cursor = busy_cursor;
2056
fbd6baed
GV		 2057 if (mode_cursor != f->output_data.w32->modeline_cursor
2058 && f->output_data.w32->modeline_cursor != 0)
2059 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->modeline_cursor);
2060 f->output_data.w32->modeline_cursor = mode_cursor;
6fc2811b 2061
fbd6baed
GV		 2062 if (cross_cursor != f->output_data.w32->cross_cursor
2063 && f->output_data.w32->cross_cursor != 0)
2064 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->cross_cursor);
2065 f->output_data.w32->cross_cursor = cross_cursor;
2066
2067 XFlush (FRAME_W32_DISPLAY (f));
ee78dc32 2068 UNBLOCK_INPUT;
6fc2811b
JR		 2069
2070 update_face_from_frame_parameter (f, Qmouse_color, arg);
2071#endif /* NTEMACS_TODO */
ee78dc32
GV		 2072}
2073
2074void
2075x_set_cursor_color (f, arg, oldval)
2076 struct frame *f;
2077 Lisp_Object arg, oldval;
2078{
2079 unsigned long fore_pixel;
2080
2081 if (!EQ (Vx_cursor_fore_pixel, Qnil))
2082 fore_pixel = x_decode_color (f, Vx_cursor_fore_pixel,
2083 WHITE_PIX_DEFAULT (f));
2084 else
6fc2811b 2085 fore_pixel = FRAME_BACKGROUND_PIXEL (f);
fbd6baed 2086 f->output_data.w32->cursor_pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
ee78dc32
GV		 2087
2088 /* Make sure that the cursor color differs from the background color. */
6fc2811b 2089 if (f->output_data.w32->cursor_pixel == FRAME_BACKGROUND_PIXEL (f))
ee78dc32 2090 {
fbd6baed
GV		 2091 f->output_data.w32->cursor_pixel = f->output_data.w32->mouse_pixel;
2092 if (f->output_data.w32->cursor_pixel == fore_pixel)
6fc2811b 2093 fore_pixel = FRAME_BACKGROUND_PIXEL (f);
ee78dc32 2094 }
6fc2811b 2095 FRAME_FOREGROUND_PIXEL (f) = fore_pixel;
ee78dc32 2096
fbd6baed 2097 if (FRAME_W32_WINDOW (f) != 0)
ee78dc32
GV		 2098 {
2099 if (FRAME_VISIBLE_P (f))
2100 {
2101 x_display_cursor (f, 0);
2102 x_display_cursor (f, 1);
2103 }
2104 }
6fc2811b
JR		 2105
2106 update_face_from_frame_parameter (f, Qcursor_color, arg);
ee78dc32
GV		 2107}
2108
33d52f9c
GV		 2109/* Set the border-color of frame F to pixel value PIX.
2110 Note that this does not fully take effect if done before
2111 F has an window. */
2112void
2113x_set_border_pixel (f, pix)
2114 struct frame *f;
2115 int pix;
2116{
2117 f->output_data.w32->border_pixel = pix;
2118
2119 if (FRAME_W32_WINDOW (f) != 0 && f->output_data.w32->border_width > 0)
2120 {
2121 if (FRAME_VISIBLE_P (f))
2122 redraw_frame (f);
2123 }
2124}
2125
ee78dc32
GV		 2126/* Set the border-color of frame F to value described by ARG.
2127 ARG can be a string naming a color.
2128 The border-color is used for the border that is drawn by the server.
2129 Note that this does not fully take effect if done before
2130 F has a window; it must be redone when the window is created. */
2131
2132void
2133x_set_border_color (f, arg, oldval)
2134 struct frame *f;
2135 Lisp_Object arg, oldval;
2136{
ee78dc32
GV		 2137 int pix;
2138
2139 CHECK_STRING (arg, 0);
ee78dc32 2140 pix = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
ee78dc32 2141 x_set_border_pixel (f, pix);
6fc2811b 2142 update_face_from_frame_parameter (f, Qborder_color, arg);
ee78dc32
GV		 2143}
2144
ee78dc32
GV		 2145void
2146x_set_cursor_type (f, arg, oldval)
2147 FRAME_PTR f;
2148 Lisp_Object arg, oldval;
2149{
2150 if (EQ (arg, Qbar))
2151 {
6fc2811b 2152 FRAME_DESIRED_CURSOR (f) = BAR_CURSOR;
fbd6baed 2153 f->output_data.w32->cursor_width = 2;
ee78dc32 2154 }
8e713be6
KR		 2155 else if (CONSP (arg) && EQ (XCAR (arg), Qbar)
2156 && INTEGERP (XCDR (arg)))
ee78dc32 2157 {
6fc2811b 2158 FRAME_DESIRED_CURSOR (f) = BAR_CURSOR;
8e713be6 2159 f->output_data.w32->cursor_width = XINT (XCDR (arg));
ee78dc32
GV		 2160 }
2161 else
2162 /* Treat anything unknown as "box cursor".
2163 It was bad to signal an error; people have trouble fixing
2164 .Xdefaults with Emacs, when it has something bad in it. */
6fc2811b 2165 FRAME_DESIRED_CURSOR (f) = FILLED_BOX_CURSOR;
ee78dc32
GV		 2166
2167 /* Make sure the cursor gets redrawn. This is overkill, but how
2168 often do people change cursor types? */
2169 update_mode_lines++;
2170}
2171
2172void
2173x_set_icon_type (f, arg, oldval)
2174 struct frame *f;
2175 Lisp_Object arg, oldval;
2176{
ee78dc32
GV		 2177 int result;
2178
eb7576ce
GV		 2179 if (NILP (arg) && NILP (oldval))
2180 return;
2181
2182 if (STRINGP (arg) && STRINGP (oldval)
2183 && EQ (Fstring_equal (oldval, arg), Qt))
2184 return;
2185
2186 if (SYMBOLP (arg) && SYMBOLP (oldval) && EQ (arg, oldval))
ee78dc32
GV		 2187 return;
2188
2189 BLOCK_INPUT;
ee78dc32 2190
eb7576ce 2191 result = x_bitmap_icon (f, arg);
ee78dc32
GV		 2192 if (result)
2193 {
2194 UNBLOCK_INPUT;
2195 error ("No icon window available");
2196 }
2197
ee78dc32 2198 UNBLOCK_INPUT;
ee78dc32
GV		 2199}
2200
2201/* Return non-nil if frame F wants a bitmap icon. */
2202
2203Lisp_Object
2204x_icon_type (f)
2205 FRAME_PTR f;
2206{
2207 Lisp_Object tem;
2208
2209 tem = assq_no_quit (Qicon_type, f->param_alist);
2210 if (CONSP (tem))
8e713be6 2211 return XCDR (tem);
ee78dc32
GV		 2212 else
2213 return Qnil;
2214}
2215
2216void
2217x_set_icon_name (f, arg, oldval)
2218 struct frame *f;
2219 Lisp_Object arg, oldval;
2220{
ee78dc32
GV		 2221 int result;
2222
2223 if (STRINGP (arg))
2224 {
2225 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
2226 return;
2227 }
2228 else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
2229 return;
2230
2231 f->icon_name = arg;
2232
2233#if 0
fbd6baed 2234 if (f->output_data.w32->icon_bitmap != 0)
ee78dc32
GV		 2235 return;
2236
2237 BLOCK_INPUT;
2238
2239 result = x_text_icon (f,
1edf84e7 2240 (char *) XSTRING ((!NILP (f->icon_name)
ee78dc32 2241 ? f->icon_name
1edf84e7
GV		 2242 : !NILP (f->title)
2243 ? f->title
ee78dc32
GV		 2244 : f->name))->data);
2245
2246 if (result)
2247 {
2248 UNBLOCK_INPUT;
2249 error ("No icon window available");
2250 }
2251
2252 /* If the window was unmapped (and its icon was mapped),
2253 the new icon is not mapped, so map the window in its stead. */
2254 if (FRAME_VISIBLE_P (f))
2255 {
2256#ifdef USE_X_TOOLKIT
fbd6baed 2257 XtPopup (f->output_data.w32->widget, XtGrabNone);
ee78dc32 2258#endif
fbd6baed 2259 XMapWindow (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f));
ee78dc32
GV		 2260 }
2261
fbd6baed 2262 XFlush (FRAME_W32_DISPLAY (f));
ee78dc32
GV		 2263 UNBLOCK_INPUT;
2264#endif
2265}
2266
2267extern Lisp_Object x_new_font ();
4587b026 2268extern Lisp_Object x_new_fontset();
ee78dc32
GV		 2269
2270void
2271x_set_font (f, arg, oldval)
2272 struct frame *f;
2273 Lisp_Object arg, oldval;
2274{
2275 Lisp_Object result;
4587b026 2276 Lisp_Object fontset_name;
4b817373 2277 Lisp_Object frame;
ee78dc32
GV		 2278
2279 CHECK_STRING (arg, 1);
2280
4587b026
GV		 2281 fontset_name = Fquery_fontset (arg, Qnil);
2282
ee78dc32 2283 BLOCK_INPUT;
4587b026
GV		 2284 result = (STRINGP (fontset_name)
2285 ? x_new_fontset (f, XSTRING (fontset_name)->data)
2286 : x_new_font (f, XSTRING (arg)->data));
ee78dc32
GV		 2287 UNBLOCK_INPUT;
2288
2289 if (EQ (result, Qnil))
2290 error ("Font \"%s\" is not defined", XSTRING (arg)->data);
2291 else if (EQ (result, Qt))
2292 error ("the characters of the given font have varying widths");
2293 else if (STRINGP (result))
2294 {
ee78dc32 2295 store_frame_param (f, Qfont, result);
6fc2811b 2296 recompute_basic_faces (f);
ee78dc32
GV		 2297 }
2298 else
2299 abort ();
4b817373 2300
6fc2811b
JR		 2301 do_pending_window_change (0);
2302
2303 /* Don't call `face-set-after-frame-default' when faces haven't been
2304 initialized yet. This is the case when called from
2305 Fx_create_frame. In that case, the X widget or window doesn't
2306 exist either, and we can end up in x_report_frame_params with a
2307 null widget which gives a segfault. */
2308 if (FRAME_FACE_CACHE (f))
2309 {
2310 XSETFRAME (frame, f);
2311 call1 (Qface_set_after_frame_default, frame);
2312 }
ee78dc32
GV		 2313}
2314
2315void
2316x_set_border_width (f, arg, oldval)
2317 struct frame *f;
2318 Lisp_Object arg, oldval;
2319{
2320 CHECK_NUMBER (arg, 0);
2321
fbd6baed 2322 if (XINT (arg) == f->output_data.w32->border_width)
ee78dc32
GV		 2323 return;
2324
fbd6baed 2325 if (FRAME_W32_WINDOW (f) != 0)
ee78dc32
GV		 2326 error ("Cannot change the border width of a window");
2327
fbd6baed 2328 f->output_data.w32->border_width = XINT (arg);
ee78dc32
GV		 2329}
2330
2331void
2332x_set_internal_border_width (f, arg, oldval)
2333 struct frame *f;
2334 Lisp_Object arg, oldval;
2335{
fbd6baed 2336 int old = f->output_data.w32->internal_border_width;
ee78dc32
GV		 2337
2338 CHECK_NUMBER (arg, 0);
fbd6baed
GV		 2339 f->output_data.w32->internal_border_width = XINT (arg);
2340 if (f->output_data.w32->internal_border_width < 0)
2341 f->output_data.w32->internal_border_width = 0;
ee78dc32 2342
fbd6baed 2343 if (f->output_data.w32->internal_border_width == old)
ee78dc32
GV		 2344 return;
2345
fbd6baed 2346 if (FRAME_W32_WINDOW (f) != 0)
ee78dc32 2347 {
ee78dc32 2348 x_set_window_size (f, 0, f->width, f->height);
ee78dc32 2349 SET_FRAME_GARBAGED (f);
6fc2811b 2350 do_pending_window_change (0);
ee78dc32
GV		 2351 }
2352}
2353
2354void
2355x_set_visibility (f, value, oldval)
2356 struct frame *f;
2357 Lisp_Object value, oldval;
2358{
2359 Lisp_Object frame;
2360 XSETFRAME (frame, f);
2361
2362 if (NILP (value))
2363 Fmake_frame_invisible (frame, Qt);
2364 else if (EQ (value, Qicon))
2365 Ficonify_frame (frame);
2366 else
2367 Fmake_frame_visible (frame);
2368}
2369
2370void
2371x_set_menu_bar_lines (f, value, oldval)
2372 struct frame *f;
2373 Lisp_Object value, oldval;
2374{
2375 int nlines;
2376 int olines = FRAME_MENU_BAR_LINES (f);
2377
2378 /* Right now, menu bars don't work properly in minibuf-only frames;
2379 most of the commands try to apply themselves to the minibuffer
6fc2811b 2380 frame itself, and get an error because you can't switch buffers
ee78dc32
GV		 2381 in or split the minibuffer window. */
2382 if (FRAME_MINIBUF_ONLY_P (f))
2383 return;
2384
2385 if (INTEGERP (value))
2386 nlines = XINT (value);
2387 else
2388 nlines = 0;
2389
2390 FRAME_MENU_BAR_LINES (f) = 0;
2391 if (nlines)
2392 FRAME_EXTERNAL_MENU_BAR (f) = 1;
2393 else
2394 {
2395 if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
2396 free_frame_menubar (f);
2397 FRAME_EXTERNAL_MENU_BAR (f) = 0;
1edf84e7
GV		 2398
2399 /* Adjust the frame size so that the client (text) dimensions
2400 remain the same. This depends on FRAME_EXTERNAL_MENU_BAR being
2401 set correctly. */
2402 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
6fc2811b 2403 do_pending_window_change (0);
ee78dc32 2404 }
6fc2811b
JR		 2405 adjust_glyphs (f);
2406}
2407
2408
2409/* Set the number of lines used for the tool bar of frame F to VALUE.
2410 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
2411 is the old number of tool bar lines. This function changes the
2412 height of all windows on frame F to match the new tool bar height.
2413 The frame's height doesn't change. */
2414
2415void
2416x_set_tool_bar_lines (f, value, oldval)
2417 struct frame *f;
2418 Lisp_Object value, oldval;
2419{
2420 int delta, nlines;
2421
2422 /* Use VALUE only if an integer >= 0. */
2423 if (INTEGERP (value) && XINT (value) >= 0)
2424 nlines = XFASTINT (value);
2425 else
2426 nlines = 0;
2427
2428 /* Make sure we redisplay all windows in this frame. */
2429 ++windows_or_buffers_changed;
2430
2431 delta = nlines - FRAME_TOOL_BAR_LINES (f);
2432 FRAME_TOOL_BAR_LINES (f) = nlines;
2433 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
2434 do_pending_window_change (0);
2435 adjust_glyphs (f);
ee78dc32
GV		 2436}
2437
6fc2811b 2438
ee78dc32 2439/* Change the name of frame F to NAME. If NAME is nil, set F's name to
fbd6baed 2440 w32_id_name.
ee78dc32
GV		 2441
2442 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2443 name; if NAME is a string, set F's name to NAME and set
2444 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2445
2446 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2447 suggesting a new name, which lisp code should override; if
2448 F->explicit_name is set, ignore the new name; otherwise, set it. */
2449
2450void
2451x_set_name (f, name, explicit)
2452 struct frame *f;
2453 Lisp_Object name;
2454 int explicit;
2455{
2456 /* Make sure that requests from lisp code override requests from
2457 Emacs redisplay code. */
2458 if (explicit)
2459 {
2460 /* If we're switching from explicit to implicit, we had better
2461 update the mode lines and thereby update the title. */
2462 if (f->explicit_name && NILP (name))
2463 update_mode_lines = 1;
2464
2465 f->explicit_name = ! NILP (name);
2466 }
2467 else if (f->explicit_name)
2468 return;
2469
fbd6baed 2470 /* If NAME is nil, set the name to the w32_id_name. */
ee78dc32
GV		 2471 if (NILP (name))
2472 {
2473 /* Check for no change needed in this very common case
2474 before we do any consing. */
fbd6baed 2475 if (!strcmp (FRAME_W32_DISPLAY_INFO (f)->w32_id_name,
ee78dc32
GV		 2476 XSTRING (f->name)->data))
2477 return;
fbd6baed 2478 name = build_string (FRAME_W32_DISPLAY_INFO (f)->w32_id_name);
ee78dc32
GV		 2479 }
2480 else
2481 CHECK_STRING (name, 0);
2482
2483 /* Don't change the name if it's already NAME. */
2484 if (! NILP (Fstring_equal (name, f->name)))
2485 return;
2486
1edf84e7
GV		 2487 f->name = name;
2488
2489 /* For setting the frame title, the title parameter should override
2490 the name parameter. */
2491 if (! NILP (f->title))
2492 name = f->title;
2493
fbd6baed 2494 if (FRAME_W32_WINDOW (f))
ee78dc32 2495 {
6fc2811b
JR		 2496 if (STRING_MULTIBYTE (name))
2497 name = string_make_unibyte (name);
2498
ee78dc32 2499 BLOCK_INPUT;
fbd6baed 2500 SetWindowText(FRAME_W32_WINDOW (f), XSTRING (name)->data);
ee78dc32
GV		 2501 UNBLOCK_INPUT;
2502 }
ee78dc32
GV		 2503}
2504
2505/* This function should be called when the user's lisp code has
2506 specified a name for the frame; the name will override any set by the
2507 redisplay code. */
2508void
2509x_explicitly_set_name (f, arg, oldval)
2510 FRAME_PTR f;
2511 Lisp_Object arg, oldval;
2512{
2513 x_set_name (f, arg, 1);
2514}
2515
2516/* This function should be called by Emacs redisplay code to set the
2517 name; names set this way will never override names set by the user's
2518 lisp code. */
2519void
2520x_implicitly_set_name (f, arg, oldval)
2521 FRAME_PTR f;
2522 Lisp_Object arg, oldval;
2523{
2524 x_set_name (f, arg, 0);
2525}
1edf84e7
GV		 2526\f
2527/* Change the title of frame F to NAME.
2528 If NAME is nil, use the frame name as the title.
2529
2530 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2531 name; if NAME is a string, set F's name to NAME and set
2532 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2533
2534 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2535 suggesting a new name, which lisp code should override; if
2536 F->explicit_name is set, ignore the new name; otherwise, set it. */
ee78dc32 2537
1edf84e7 2538void
6fc2811b 2539x_set_title (f, name, old_name)
1edf84e7 2540 struct frame *f;
6fc2811b 2541 Lisp_Object name, old_name;
1edf84e7
GV		 2542{
2543 /* Don't change the title if it's already NAME. */
2544 if (EQ (name, f->title))
2545 return;
2546
2547 update_mode_lines = 1;
2548
2549 f->title = name;
2550
2551 if (NILP (name))
2552 name = f->name;
2553
2554 if (FRAME_W32_WINDOW (f))
2555 {
6fc2811b
JR		 2556 if (STRING_MULTIBYTE (name))
2557 name = string_make_unibyte (name);
2558
1edf84e7
GV		 2559 BLOCK_INPUT;
2560 SetWindowText(FRAME_W32_WINDOW (f), XSTRING (name)->data);
2561 UNBLOCK_INPUT;
2562 }
2563}
2564\f
ee78dc32
GV		 2565void
2566x_set_autoraise (f, arg, oldval)
2567 struct frame *f;
2568 Lisp_Object arg, oldval;
2569{
2570 f->auto_raise = !EQ (Qnil, arg);
2571}
2572
2573void
2574x_set_autolower (f, arg, oldval)
2575 struct frame *f;
2576 Lisp_Object arg, oldval;
2577{
2578 f->auto_lower = !EQ (Qnil, arg);
2579}
2580
2581void
2582x_set_unsplittable (f, arg, oldval)
2583 struct frame *f;
2584 Lisp_Object arg, oldval;
2585{
2586 f->no_split = !NILP (arg);
2587}
2588
2589void
2590x_set_vertical_scroll_bars (f, arg, oldval)
2591 struct frame *f;
2592 Lisp_Object arg, oldval;
2593{
1026b400
RS		 2594 if ((EQ (arg, Qleft) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f))
2595 || (EQ (arg, Qright) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f))
2596 || (NILP (arg) && FRAME_HAS_VERTICAL_SCROLL_BARS (f))
2597 || (!NILP (arg) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f)))
ee78dc32 2598 {
1026b400
RS		 2599 FRAME_VERTICAL_SCROLL_BAR_TYPE (f) = NILP (arg) ?
2600 vertical_scroll_bar_none :
87996783
GV		 2601 /* Put scroll bars on the right by default, as is conventional
2602 on MS-Windows. */
2603 EQ (Qleft, arg)
2604 ? vertical_scroll_bar_left
2605 : vertical_scroll_bar_right;
ee78dc32
GV		 2606
2607 /* We set this parameter before creating the window for the
2608 frame, so we can get the geometry right from the start.
2609 However, if the window hasn't been created yet, we shouldn't
2610 call x_set_window_size. */
fbd6baed 2611 if (FRAME_W32_WINDOW (f))
ee78dc32 2612 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
6fc2811b 2613 do_pending_window_change (0);
ee78dc32
GV		 2614 }
2615}
2616
2617void
2618x_set_scroll_bar_width (f, arg, oldval)
2619 struct frame *f;
2620 Lisp_Object arg, oldval;
2621{
6fc2811b
JR		 2622 int wid = FONT_WIDTH (f->output_data.w32->font);
2623
ee78dc32
GV		 2624 if (NILP (arg))
2625 {
6fc2811b
JR		 2626 FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = GetSystemMetrics (SM_CXVSCROLL);
2627 FRAME_SCROLL_BAR_COLS (f) = (FRAME_SCROLL_BAR_PIXEL_WIDTH (f) +
2628 wid - 1) / wid;
2629 if (FRAME_W32_WINDOW (f))
2630 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
2631 do_pending_window_change (0);
ee78dc32
GV		 2632 }
2633 else if (INTEGERP (arg) && XINT (arg) > 0
2634 && XFASTINT (arg) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f))
2635 {
ee78dc32 2636 FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = XFASTINT (arg);
6fc2811b
JR		 2637 FRAME_SCROLL_BAR_COLS (f) = (FRAME_SCROLL_BAR_PIXEL_WIDTH (f)
2638 + wid-1) / wid;
fbd6baed 2639 if (FRAME_W32_WINDOW (f))
ee78dc32 2640 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
6fc2811b 2641 do_pending_window_change (0);
ee78dc32 2642 }
6fc2811b
JR		 2643 change_frame_size (f, 0, FRAME_WIDTH (f), 0, 0, 0);
2644 XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.hpos = 0;
2645 XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.x = 0;
ee78dc32
GV		 2646}
2647\f
2648/* Subroutines of creating an frame. */
2649
2650/* Make sure that Vx_resource_name is set to a reasonable value.
2651 Fix it up, or set it to `emacs' if it is too hopeless. */
2652
2653static void
2654validate_x_resource_name ()
2655{
6fc2811b 2656 int len = 0;
ee78dc32
GV		 2657 /* Number of valid characters in the resource name. */
2658 int good_count = 0;
2659 /* Number of invalid characters in the resource name. */
2660 int bad_count = 0;
2661 Lisp_Object new;
2662 int i;
2663
2664 if (STRINGP (Vx_resource_name))
2665 {
2666 unsigned char *p = XSTRING (Vx_resource_name)->data;
2667 int i;
2668
2669 len = XSTRING (Vx_resource_name)->size;
2670
2671 /* Only letters, digits, - and _ are valid in resource names.
2672 Count the valid characters and count the invalid ones. */
2673 for (i = 0; i < len; i++)
2674 {
2675 int c = p[i];
2676 if (! ((c >= 'a' && c <= 'z')
2677 || (c >= 'A' && c <= 'Z')
2678 || (c >= '0' && c <= '9')
2679 || c == '-' || c == '_'))
2680 bad_count++;
2681 else
2682 good_count++;
2683 }
2684 }
2685 else
2686 /* Not a string => completely invalid. */
2687 bad_count = 5, good_count = 0;
2688
2689 /* If name is valid already, return. */
2690 if (bad_count == 0)
2691 return;
2692
2693 /* If name is entirely invalid, or nearly so, use `emacs'. */
2694 if (good_count == 0
2695 || (good_count == 1 && bad_count > 0))
2696 {
2697 Vx_resource_name = build_string ("emacs");
2698 return;
2699 }
2700
2701 /* Name is partly valid. Copy it and replace the invalid characters
2702 with underscores. */
2703
2704 Vx_resource_name = new = Fcopy_sequence (Vx_resource_name);
2705
2706 for (i = 0; i < len; i++)
2707 {
2708 int c = XSTRING (new)->data[i];
2709 if (! ((c >= 'a' && c <= 'z')
2710 || (c >= 'A' && c <= 'Z')
2711 || (c >= '0' && c <= '9')
2712 || c == '-' || c == '_'))
2713 XSTRING (new)->data[i] = '_';
2714 }
2715}
2716
2717
2718extern char *x_get_string_resource ();
2719
2720DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 2, 4, 0,
2721 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
2722This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
2723class, where INSTANCE is the name under which Emacs was invoked, or\n\
2724the name specified by the `-name' or `-rn' command-line arguments.\n\
2725\n\
2726The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
2727class, respectively. You must specify both of them or neither.\n\
2728If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
2729and the class is `Emacs.CLASS.SUBCLASS'.")
2730 (attribute, class, component, subclass)
2731 Lisp_Object attribute, class, component, subclass;
2732{
2733 register char *value;
2734 char *name_key;
2735 char *class_key;
2736
2737 CHECK_STRING (attribute, 0);
2738 CHECK_STRING (class, 0);
2739
2740 if (!NILP (component))
2741 CHECK_STRING (component, 1);
2742 if (!NILP (subclass))
2743 CHECK_STRING (subclass, 2);
2744 if (NILP (component) != NILP (subclass))
2745 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2746
2747 validate_x_resource_name ();
2748
2749 /* Allocate space for the components, the dots which separate them,
2750 and the final '\0'. Make them big enough for the worst case. */
2751 name_key = (char *) alloca (XSTRING (Vx_resource_name)->size
2752 + (STRINGP (component)
2753 ? XSTRING (component)->size : 0)
2754 + XSTRING (attribute)->size
2755 + 3);
2756
2757 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
2758 + XSTRING (class)->size
2759 + (STRINGP (subclass)
2760 ? XSTRING (subclass)->size : 0)
2761 + 3);
2762
2763 /* Start with emacs.FRAMENAME for the name (the specific one)
2764 and with `Emacs' for the class key (the general one). */
2765 strcpy (name_key, XSTRING (Vx_resource_name)->data);
2766 strcpy (class_key, EMACS_CLASS);
2767
2768 strcat (class_key, ".");
2769 strcat (class_key, XSTRING (class)->data);
2770
2771 if (!NILP (component))
2772 {
2773 strcat (class_key, ".");
2774 strcat (class_key, XSTRING (subclass)->data);
2775
2776 strcat (name_key, ".");
2777 strcat (name_key, XSTRING (component)->data);
2778 }
2779
2780 strcat (name_key, ".");
2781 strcat (name_key, XSTRING (attribute)->data);
2782
2783 value = x_get_string_resource (Qnil,
2784 name_key, class_key);
2785
2786 if (value != (char *) 0)
2787 return build_string (value);
2788 else
2789 return Qnil;
2790}
2791
2792/* Used when C code wants a resource value. */
2793
2794char *
2795x_get_resource_string (attribute, class)
2796 char *attribute, *class;
2797{
ee78dc32
GV		 2798 char *name_key;
2799 char *class_key;
6fc2811b 2800 struct frame *sf = SELECTED_FRAME ();
ee78dc32
GV		 2801
2802 /* Allocate space for the components, the dots which separate them,
2803 and the final '\0'. */
2804 name_key = (char *) alloca (XSTRING (Vinvocation_name)->size
2805 + strlen (attribute) + 2);
2806 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
2807 + strlen (class) + 2);
2808
2809 sprintf (name_key, "%s.%s",
2810 XSTRING (Vinvocation_name)->data,
2811 attribute);
2812 sprintf (class_key, "%s.%s", EMACS_CLASS, class);
2813
6fc2811b 2814 return x_get_string_resource (sf, name_key, class_key);
ee78dc32
GV		 2815}
2816
2817/* Types we might convert a resource string into. */
2818enum resource_types
6fc2811b
JR		 2819{
2820 RES_TYPE_NUMBER,
2821 RES_TYPE_FLOAT,
2822 RES_TYPE_BOOLEAN,
2823 RES_TYPE_STRING,
2824 RES_TYPE_SYMBOL
2825};
ee78dc32
GV		 2826
2827/* Return the value of parameter PARAM.
2828
2829 First search ALIST, then Vdefault_frame_alist, then the X defaults
2830 database, using ATTRIBUTE as the attribute name and CLASS as its class.
2831
2832 Convert the resource to the type specified by desired_type.
2833
2834 If no default is specified, return Qunbound. If you call
6fc2811b 2835 w32_get_arg, make sure you deal with Qunbound in a reasonable way,
ee78dc32
GV		 2836 and don't let it get stored in any Lisp-visible variables! */
2837
2838static Lisp_Object
6fc2811b 2839w32_get_arg (alist, param, attribute, class, type)
ee78dc32
GV		 2840 Lisp_Object alist, param;
2841 char *attribute;
2842 char *class;
2843 enum resource_types type;
2844{
2845 register Lisp_Object tem;
2846
2847 tem = Fassq (param, alist);
2848 if (EQ (tem, Qnil))
2849 tem = Fassq (param, Vdefault_frame_alist);
2850 if (EQ (tem, Qnil))
2851 {
2852
2853 if (attribute)
2854 {
2855 tem = Fx_get_resource (build_string (attribute),
2856 build_string (class),
2857 Qnil, Qnil);
2858
2859 if (NILP (tem))
2860 return Qunbound;
2861
2862 switch (type)
2863 {
6fc2811b 2864 case RES_TYPE_NUMBER:
ee78dc32
GV		 2865 return make_number (atoi (XSTRING (tem)->data));
2866
6fc2811b
JR		 2867 case RES_TYPE_FLOAT:
2868 return make_float (atof (XSTRING (tem)->data));
2869
2870 case RES_TYPE_BOOLEAN:
ee78dc32
GV		 2871 tem = Fdowncase (tem);
2872 if (!strcmp (XSTRING (tem)->data, "on")
2873 || !strcmp (XSTRING (tem)->data, "true"))
2874 return Qt;
2875 else
2876 return Qnil;
2877
6fc2811b 2878 case RES_TYPE_STRING:
ee78dc32
GV		 2879 return tem;
2880
6fc2811b 2881 case RES_TYPE_SYMBOL:
ee78dc32
GV		 2882 /* As a special case, we map the values `true' and `on'
2883 to Qt, and `false' and `off' to Qnil. */
2884 {
2885 Lisp_Object lower;
2886 lower = Fdowncase (tem);
2887 if (!strcmp (XSTRING (lower)->data, "on")
2888 || !strcmp (XSTRING (lower)->data, "true"))
2889 return Qt;
2890 else if (!strcmp (XSTRING (lower)->data, "off")
2891 || !strcmp (XSTRING (lower)->data, "false"))
2892 return Qnil;
2893 else
2894 return Fintern (tem, Qnil);
2895 }
2896
2897 default:
2898 abort ();
2899 }
2900 }
2901 else
2902 return Qunbound;
2903 }
2904 return Fcdr (tem);
2905}
2906
2907/* Record in frame F the specified or default value according to ALIST
2908 of the parameter named PARAM (a Lisp symbol).
2909 If no value is specified for PARAM, look for an X default for XPROP
2910 on the frame named NAME.
2911 If that is not found either, use the value DEFLT. */
2912
2913static Lisp_Object
2914x_default_parameter (f, alist, prop, deflt, xprop, xclass, type)
2915 struct frame *f;
2916 Lisp_Object alist;
2917 Lisp_Object prop;
2918 Lisp_Object deflt;
2919 char *xprop;
2920 char *xclass;
2921 enum resource_types type;
2922{
2923 Lisp_Object tem;
2924
6fc2811b 2925 tem = w32_get_arg (alist, prop, xprop, xclass, type);
ee78dc32
GV		 2926 if (EQ (tem, Qunbound))
2927 tem = deflt;
2928 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
2929 return tem;
2930}
2931\f
2932DEFUN ("x-parse-geometry", Fx_parse_geometry, Sx_parse_geometry, 1, 1, 0,
2933 "Parse an X-style geometry string STRING.\n\
2934Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
2935The properties returned may include `top', `left', `height', and `width'.\n\
2936The value of `left' or `top' may be an integer,\n\
2937or a list (+ N) meaning N pixels relative to top/left corner,\n\
2938or a list (- N) meaning -N pixels relative to bottom/right corner.")
2939 (string)
2940 Lisp_Object string;
2941{
2942 int geometry, x, y;
2943 unsigned int width, height;
2944 Lisp_Object result;
2945
2946 CHECK_STRING (string, 0);
2947
2948 geometry = XParseGeometry ((char *) XSTRING (string)->data,
2949 &x, &y, &width, &height);
2950
2951 result = Qnil;
2952 if (geometry & XValue)
2953 {
2954 Lisp_Object element;
2955
2956 if (x >= 0 && (geometry & XNegative))
2957 element = Fcons (Qleft, Fcons (Qminus, Fcons (make_number (-x), Qnil)));
2958 else if (x < 0 && ! (geometry & XNegative))
2959 element = Fcons (Qleft, Fcons (Qplus, Fcons (make_number (x), Qnil)));
2960 else
2961 element = Fcons (Qleft, make_number (x));
2962 result = Fcons (element, result);
2963 }
2964
2965 if (geometry & YValue)
2966 {
2967 Lisp_Object element;
2968
2969 if (y >= 0 && (geometry & YNegative))
2970 element = Fcons (Qtop, Fcons (Qminus, Fcons (make_number (-y), Qnil)));
2971 else if (y < 0 && ! (geometry & YNegative))
2972 element = Fcons (Qtop, Fcons (Qplus, Fcons (make_number (y), Qnil)));
2973 else
2974 element = Fcons (Qtop, make_number (y));
2975 result = Fcons (element, result);
2976 }
2977
2978 if (geometry & WidthValue)
2979 result = Fcons (Fcons (Qwidth, make_number (width)), result);
2980 if (geometry & HeightValue)
2981 result = Fcons (Fcons (Qheight, make_number (height)), result);
2982
2983 return result;
2984}
2985
2986/* Calculate the desired size and position of this window,
2987 and return the flags saying which aspects were specified.
2988
2989 This function does not make the coordinates positive. */
2990
2991#define DEFAULT_ROWS 40
2992#define DEFAULT_COLS 80
2993
2994static int
2995x_figure_window_size (f, parms)
2996 struct frame *f;
2997 Lisp_Object parms;
2998{
2999 register Lisp_Object tem0, tem1, tem2;
ee78dc32
GV		 3000 long window_prompting = 0;
3001
3002 /* Default values if we fall through.
3003 Actually, if that happens we should get
3004 window manager prompting. */
1026b400 3005 SET_FRAME_WIDTH (f, DEFAULT_COLS);
ee78dc32
GV		 3006 f->height = DEFAULT_ROWS;
3007 /* Window managers expect that if program-specified
3008 positions are not (0,0), they're intentional, not defaults. */
fbd6baed
GV		 3009 f->output_data.w32->top_pos = 0;
3010 f->output_data.w32->left_pos = 0;
ee78dc32 3011
6fc2811b
JR		 3012 tem0 = w32_get_arg (parms, Qheight, 0, 0, RES_TYPE_NUMBER);
3013 tem1 = w32_get_arg (parms, Qwidth, 0, 0, RES_TYPE_NUMBER);
3014 tem2 = w32_get_arg (parms, Quser_size, 0, 0, RES_TYPE_NUMBER);
ee78dc32
GV		 3015 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
3016 {
3017 if (!EQ (tem0, Qunbound))
3018 {
3019 CHECK_NUMBER (tem0, 0);
3020 f->height = XINT (tem0);
3021 }
3022 if (!EQ (tem1, Qunbound))
3023 {
3024 CHECK_NUMBER (tem1, 0);
1026b400 3025 SET_FRAME_WIDTH (f, XINT (tem1));
ee78dc32
GV		 3026 }
3027 if (!NILP (tem2) && !EQ (tem2, Qunbound))
3028 window_prompting |= USSize;
3029 else
3030 window_prompting |= PSize;
3031 }
3032
fbd6baed 3033 f->output_data.w32->vertical_scroll_bar_extra
ee78dc32
GV		 3034 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f)
3035 ? 0
3036 : FRAME_SCROLL_BAR_PIXEL_WIDTH (f) > 0
3037 ? FRAME_SCROLL_BAR_PIXEL_WIDTH (f)
fbd6baed 3038 : (FRAME_SCROLL_BAR_COLS (f) * FONT_WIDTH (f->output_data.w32->font)));
6fc2811b
JR		 3039 f->output_data.w32->flags_areas_extra
3040 = FRAME_FLAGS_AREA_WIDTH (f);
fbd6baed
GV		 3041 f->output_data.w32->pixel_width = CHAR_TO_PIXEL_WIDTH (f, f->width);
3042 f->output_data.w32->pixel_height = CHAR_TO_PIXEL_HEIGHT (f, f->height);
ee78dc32 3043
6fc2811b
JR		 3044 tem0 = w32_get_arg (parms, Qtop, 0, 0, RES_TYPE_NUMBER);
3045 tem1 = w32_get_arg (parms, Qleft, 0, 0, RES_TYPE_NUMBER);
3046 tem2 = w32_get_arg (parms, Quser_position, 0, 0, RES_TYPE_NUMBER);
ee78dc32
GV		 3047 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
3048 {
3049 if (EQ (tem0, Qminus))
3050 {
fbd6baed 3051 f->output_data.w32->top_pos = 0;
ee78dc32
GV		 3052 window_prompting |= YNegative;
3053 }
8e713be6
KR		 3054 else if (CONSP (tem0) && EQ (XCAR (tem0), Qminus)
3055 && CONSP (XCDR (tem0))
3056 && INTEGERP (XCAR (XCDR (tem0))))
ee78dc32 3057 {
8e713be6 3058 f->output_data.w32->top_pos = - XINT (XCAR (XCDR (tem0)));
ee78dc32
GV		 3059 window_prompting |= YNegative;
3060 }
8e713be6
KR		 3061 else if (CONSP (tem0) && EQ (XCAR (tem0), Qplus)
3062 && CONSP (XCDR (tem0))
3063 && INTEGERP (XCAR (XCDR (tem0))))
ee78dc32 3064 {
8e713be6 3065 f->output_data.w32->top_pos = XINT (XCAR (XCDR (tem0)));
ee78dc32
GV		 3066 }
3067 else if (EQ (tem0, Qunbound))
fbd6baed 3068 f->output_data.w32->top_pos = 0;
ee78dc32
GV		 3069 else
3070 {
3071 CHECK_NUMBER (tem0, 0);
fbd6baed
GV		 3072 f->output_data.w32->top_pos = XINT (tem0);
3073 if (f->output_data.w32->top_pos < 0)
ee78dc32
GV		 3074 window_prompting |= YNegative;
3075 }
3076
3077 if (EQ (tem1, Qminus))
3078 {
fbd6baed 3079 f->output_data.w32->left_pos = 0;
ee78dc32
GV		 3080 window_prompting |= XNegative;
3081 }
8e713be6
KR		 3082 else if (CONSP (tem1) && EQ (XCAR (tem1), Qminus)
3083 && CONSP (XCDR (tem1))
3084 && INTEGERP (XCAR (XCDR (tem1))))
ee78dc32 3085 {
8e713be6 3086 f->output_data.w32->left_pos = - XINT (XCAR (XCDR (tem1)));
ee78dc32
GV		 3087 window_prompting |= XNegative;
3088 }
8e713be6
KR		 3089 else if (CONSP (tem1) && EQ (XCAR (tem1), Qplus)
3090 && CONSP (XCDR (tem1))
3091 && INTEGERP (XCAR (XCDR (tem1))))
ee78dc32 3092 {
8e713be6 3093 f->output_data.w32->left_pos = XINT (XCAR (XCDR (tem1)));
ee78dc32
GV		 3094 }
3095 else if (EQ (tem1, Qunbound))
fbd6baed 3096 f->output_data.w32->left_pos = 0;
ee78dc32
GV		 3097 else
3098 {
3099 CHECK_NUMBER (tem1, 0);
fbd6baed
GV		 3100 f->output_data.w32->left_pos = XINT (tem1);
3101 if (f->output_data.w32->left_pos < 0)
ee78dc32
GV		 3102 window_prompting |= XNegative;
3103 }
3104
3105 if (!NILP (tem2) && ! EQ (tem2, Qunbound))
3106 window_prompting |= USPosition;
3107 else
3108 window_prompting |= PPosition;
3109 }
3110
3111 return window_prompting;
3112}
3113
3114\f
3115
fbd6baed 3116extern LRESULT CALLBACK w32_wnd_proc ();
ee78dc32
GV		 3117
3118BOOL
fbd6baed 3119w32_init_class (hinst)
ee78dc32
GV		 3120 HINSTANCE hinst;
3121{
3122 WNDCLASS wc;
3123
5ac45f98 3124 wc.style = CS_HREDRAW | CS_VREDRAW;
fbd6baed 3125 wc.lpfnWndProc = (WNDPROC) w32_wnd_proc;
ee78dc32
GV		 3126 wc.cbClsExtra = 0;
3127 wc.cbWndExtra = WND_EXTRA_BYTES;
3128 wc.hInstance = hinst;
3129 wc.hIcon = LoadIcon (hinst, EMACS_CLASS);
3130 wc.hCursor = LoadCursor (NULL, IDC_ARROW);
4587b026 3131 wc.hbrBackground = NULL; /* GetStockObject (WHITE_BRUSH); */
ee78dc32
GV		 3132 wc.lpszMenuName = NULL;
3133 wc.lpszClassName = EMACS_CLASS;
3134
3135 return (RegisterClass (&wc));
3136}
3137
3138HWND
fbd6baed 3139w32_createscrollbar (f, bar)
ee78dc32
GV		 3140 struct frame *f;
3141 struct scroll_bar * bar;
3142{
3143 return (CreateWindow ("SCROLLBAR", "", SBS_VERT | WS_CHILD | WS_VISIBLE,
3144 /* Position and size of scroll bar. */
6fc2811b
JR		 3145 XINT(bar->left) + VERTICAL_SCROLL_BAR_WIDTH_TRIM,
3146 XINT(bar->top),
3147 XINT(bar->width) - VERTICAL_SCROLL_BAR_WIDTH_TRIM * 2,
3148 XINT(bar->height),
fbd6baed 3149 FRAME_W32_WINDOW (f),
ee78dc32
GV		 3150 NULL,
3151 hinst,
3152 NULL));
3153}
3154
3155void
fbd6baed 3156w32_createwindow (f)
ee78dc32
GV		 3157 struct frame *f;
3158{
3159 HWND hwnd;
1edf84e7
GV		 3160 RECT rect;
3161
3162 rect.left = rect.top = 0;
3163 rect.right = PIXEL_WIDTH (f);
3164 rect.bottom = PIXEL_HEIGHT (f);
3165
3166 AdjustWindowRect (&rect, f->output_data.w32->dwStyle,
3167 FRAME_EXTERNAL_MENU_BAR (f));
ee78dc32
GV		 3168
3169 /* Do first time app init */
3170
3171 if (!hprevinst)
3172 {
fbd6baed 3173 w32_init_class (hinst);
ee78dc32
GV		 3174 }
3175
1edf84e7
GV		 3176 FRAME_W32_WINDOW (f) = hwnd
3177 = CreateWindow (EMACS_CLASS,
3178 f->namebuf,
3179 f->output_data.w32->dwStyle | WS_CLIPCHILDREN,
3180 f->output_data.w32->left_pos,
3181 f->output_data.w32->top_pos,
3182 rect.right - rect.left,
3183 rect.bottom - rect.top,
3184 NULL,
3185 NULL,
3186 hinst,
3187 NULL);
3188
ee78dc32
GV		 3189 if (hwnd)
3190 {
1edf84e7
GV		 3191 SetWindowLong (hwnd, WND_FONTWIDTH_INDEX, FONT_WIDTH (f->output_data.w32->font));
3192 SetWindowLong (hwnd, WND_LINEHEIGHT_INDEX, f->output_data.w32->line_height);
3193 SetWindowLong (hwnd, WND_BORDER_INDEX, f->output_data.w32->internal_border_width);
3194 SetWindowLong (hwnd, WND_SCROLLBAR_INDEX, f->output_data.w32->vertical_scroll_bar_extra);
6fc2811b 3195 SetWindowLong (hwnd, WND_BACKGROUND_INDEX, FRAME_BACKGROUND_PIXEL (f));
ee78dc32 3196
cb9e33d4
RS		 3197 /* Enable drag-n-drop. */
3198 DragAcceptFiles (hwnd, TRUE);
3199
5ac45f98
GV		 3200 /* Do this to discard the default setting specified by our parent. */
3201 ShowWindow (hwnd, SW_HIDE);
3c190163 3202 }
3c190163
GV		 3203}
3204
ee78dc32
GV		 3205void
3206my_post_msg (wmsg, hwnd, msg, wParam, lParam)
fbd6baed 3207 W32Msg * wmsg;
ee78dc32
GV		 3208 HWND hwnd;
3209 UINT msg;
3210 WPARAM wParam;
3211 LPARAM lParam;
3212{
3213 wmsg->msg.hwnd = hwnd;
3214 wmsg->msg.message = msg;
3215 wmsg->msg.wParam = wParam;
3216 wmsg->msg.lParam = lParam;
3217 wmsg->msg.time = GetMessageTime ();
3218
3219 post_msg (wmsg);
3220}
3221
e9e23e23 3222/* GetKeyState and MapVirtualKey on Windows 95 do not actually distinguish
a1a80b40
GV		 3223 between left and right keys as advertised. We test for this
3224 support dynamically, and set a flag when the support is absent. If
3225 absent, we keep track of the left and right control and alt keys
3226 ourselves. This is particularly necessary on keyboards that rely
3227 upon the AltGr key, which is represented as having the left control
3228 and right alt keys pressed. For these keyboards, we need to know
3229 when the left alt key has been pressed in addition to the AltGr key
3230 so that we can properly support M-AltGr-key sequences (such as M-@
3231 on Swedish keyboards). */
3232
3233#define EMACS_LCONTROL 0
3234#define EMACS_RCONTROL 1
3235#define EMACS_LMENU 2
3236#define EMACS_RMENU 3
3237
3238static int modifiers[4];
3239static int modifiers_recorded;
3240static int modifier_key_support_tested;
3241
3242static void
3243test_modifier_support (unsigned int wparam)
3244{
3245 unsigned int l, r;
3246
3247 if (wparam != VK_CONTROL && wparam != VK_MENU)
3248 return;
3249 if (wparam == VK_CONTROL)
3250 {
3251 l = VK_LCONTROL;
3252 r = VK_RCONTROL;
3253 }
3254 else
3255 {
3256 l = VK_LMENU;
3257 r = VK_RMENU;
3258 }
3259 if (!(GetKeyState (l) & 0x8000) && !(GetKeyState (r) & 0x8000))
3260 modifiers_recorded = 1;
3261 else
3262 modifiers_recorded = 0;
3263 modifier_key_support_tested = 1;
3264}
3265
3266static void
3267record_keydown (unsigned int wparam, unsigned int lparam)
3268{
3269 int i;
3270
3271 if (!modifier_key_support_tested)
3272 test_modifier_support (wparam);
3273
3274 if ((wparam != VK_CONTROL && wparam != VK_MENU) || !modifiers_recorded)
3275 return;
3276
3277 if (wparam == VK_CONTROL)
3278 i = (lparam & 0x1000000) ? EMACS_RCONTROL : EMACS_LCONTROL;
3279 else
3280 i = (lparam & 0x1000000) ? EMACS_RMENU : EMACS_LMENU;
3281
3282 modifiers[i] = 1;
3283}
3284
3285static void
3286record_keyup (unsigned int wparam, unsigned int lparam)
3287{
3288 int i;
3289
3290 if ((wparam != VK_CONTROL && wparam != VK_MENU) || !modifiers_recorded)
3291 return;
3292
3293 if (wparam == VK_CONTROL)
3294 i = (lparam & 0x1000000) ? EMACS_RCONTROL : EMACS_LCONTROL;
3295 else
3296 i = (lparam & 0x1000000) ? EMACS_RMENU : EMACS_LMENU;
3297
3298 modifiers[i] = 0;
3299}
3300
da36a4d6
GV		 3301/* Emacs can lose focus while a modifier key has been pressed. When
3302 it regains focus, be conservative and clear all modifiers since
3303 we cannot reconstruct the left and right modifier state. */
3304static void
3305reset_modifiers ()
3306{
8681157a
RS		 3307 SHORT ctrl, alt;
3308
adcc3809
GV		 3309 if (GetFocus () == NULL)
3310 /* Emacs doesn't have keyboard focus. Do nothing. */
da36a4d6 3311 return;
8681157a
RS		 3312
3313 ctrl = GetAsyncKeyState (VK_CONTROL);
3314 alt = GetAsyncKeyState (VK_MENU);
3315
8681157a
RS		 3316 if (!(ctrl & 0x08000))
3317 /* Clear any recorded control modifier state. */
3318 modifiers[EMACS_RCONTROL] = modifiers[EMACS_LCONTROL] = 0;
3319
3320 if (!(alt & 0x08000))
3321 /* Clear any recorded alt modifier state. */
3322 modifiers[EMACS_RMENU] = modifiers[EMACS_LMENU] = 0;
3323
adcc3809
GV		 3324 /* Update the state of all modifier keys, because modifiers used in
3325 hot-key combinations can get stuck on if Emacs loses focus as a
3326 result of a hot-key being pressed. */
3327 {
3328 BYTE keystate[256];
3329
3330#define CURRENT_STATE(key) ((GetAsyncKeyState (key) & 0x8000) >> 8)
3331
3332 GetKeyboardState (keystate);
3333 keystate[VK_SHIFT] = CURRENT_STATE (VK_SHIFT);
3334 keystate[VK_CONTROL] = CURRENT_STATE (VK_CONTROL);
3335 keystate[VK_LCONTROL] = CURRENT_STATE (VK_LCONTROL);
3336 keystate[VK_RCONTROL] = CURRENT_STATE (VK_RCONTROL);
3337 keystate[VK_MENU] = CURRENT_STATE (VK_MENU);
3338 keystate[VK_LMENU] = CURRENT_STATE (VK_LMENU);
3339 keystate[VK_RMENU] = CURRENT_STATE (VK_RMENU);
3340 keystate[VK_LWIN] = CURRENT_STATE (VK_LWIN);
3341 keystate[VK_RWIN] = CURRENT_STATE (VK_RWIN);
3342 keystate[VK_APPS] = CURRENT_STATE (VK_APPS);
3343 SetKeyboardState (keystate);
3344 }
da36a4d6
GV		 3345}
3346
7830e24b
RS		 3347/* Synchronize modifier state with what is reported with the current
3348 keystroke. Even if we cannot distinguish between left and right
3349 modifier keys, we know that, if no modifiers are set, then neither
3350 the left or right modifier should be set. */
3351static void
3352sync_modifiers ()
3353{
3354 if (!modifiers_recorded)
3355 return;
3356
3357 if (!(GetKeyState (VK_CONTROL) & 0x8000))
3358 modifiers[EMACS_RCONTROL] = modifiers[EMACS_LCONTROL] = 0;
3359
3360 if (!(GetKeyState (VK_MENU) & 0x8000))
3361 modifiers[EMACS_RMENU] = modifiers[EMACS_LMENU] = 0;
3362}
3363
a1a80b40
GV		 3364static int
3365modifier_set (int vkey)
3366{
ccc2d29c 3367 if (vkey == VK_CAPITAL || vkey == VK_SCROLL)
891560d6 3368 return (GetKeyState (vkey) & 0x1);
a1a80b40
GV		 3369 if (!modifiers_recorded)
3370 return (GetKeyState (vkey) & 0x8000);
3371
3372 switch (vkey)
3373 {
3374 case VK_LCONTROL:
3375 return modifiers[EMACS_LCONTROL];
3376 case VK_RCONTROL:
3377 return modifiers[EMACS_RCONTROL];
3378 case VK_LMENU:
3379 return modifiers[EMACS_LMENU];
3380 case VK_RMENU:
3381 return modifiers[EMACS_RMENU];
a1a80b40
GV		 3382 }
3383 return (GetKeyState (vkey) & 0x8000);
3384}
3385
ccc2d29c
GV		 3386/* Convert between the modifier bits W32 uses and the modifier bits
3387 Emacs uses. */
3388
3389unsigned int
3390w32_key_to_modifier (int key)
3391{
3392 Lisp_Object key_mapping;
3393
3394 switch (key)
3395 {
3396 case VK_LWIN:
3397 key_mapping = Vw32_lwindow_modifier;
3398 break;
3399 case VK_RWIN:
3400 key_mapping = Vw32_rwindow_modifier;
3401 break;
3402 case VK_APPS:
3403 key_mapping = Vw32_apps_modifier;
3404 break;
3405 case VK_SCROLL:
3406 key_mapping = Vw32_scroll_lock_modifier;
3407 break;
3408 default:
3409 key_mapping = Qnil;
3410 }
3411
adcc3809
GV		 3412 /* NB. This code runs in the input thread, asychronously to the lisp
3413 thread, so we must be careful to ensure access to lisp data is
3414 thread-safe. The following code is safe because the modifier
3415 variable values are updated atomically from lisp and symbols are
3416 not relocated by GC. Also, we don't have to worry about seeing GC
3417 markbits here. */
3418 if (EQ (key_mapping, Qhyper))
ccc2d29c 3419 return hyper_modifier;
adcc3809 3420 if (EQ (key_mapping, Qsuper))
ccc2d29c 3421 return super_modifier;
adcc3809 3422 if (EQ (key_mapping, Qmeta))
ccc2d29c 3423 return meta_modifier;
adcc3809 3424 if (EQ (key_mapping, Qalt))
ccc2d29c 3425 return alt_modifier;
adcc3809 3426 if (EQ (key_mapping, Qctrl))
ccc2d29c 3427 return ctrl_modifier;
adcc3809 3428 if (EQ (key_mapping, Qcontrol)) /* synonym for ctrl */
ccc2d29c 3429 return ctrl_modifier;
adcc3809 3430 if (EQ (key_mapping, Qshift))
ccc2d29c
GV		 3431 return shift_modifier;
3432
3433 /* Don't generate any modifier if not explicitly requested. */
3434 return 0;
3435}
3436
3437unsigned int
3438w32_get_modifiers ()
3439{
3440 return ((modifier_set (VK_SHIFT) ? shift_modifier : 0) |
3441 (modifier_set (VK_CONTROL) ? ctrl_modifier : 0) |
3442 (modifier_set (VK_LWIN) ? w32_key_to_modifier (VK_LWIN) : 0) |
3443 (modifier_set (VK_RWIN) ? w32_key_to_modifier (VK_RWIN) : 0) |
3444 (modifier_set (VK_APPS) ? w32_key_to_modifier (VK_APPS) : 0) |
3445 (modifier_set (VK_SCROLL) ? w32_key_to_modifier (VK_SCROLL) : 0) |
3446 (modifier_set (VK_MENU) ?
3447 ((NILP (Vw32_alt_is_meta)) ? alt_modifier : meta_modifier) : 0));
3448}
3449
a1a80b40
GV		 3450/* We map the VK_* modifiers into console modifier constants
3451 so that we can use the same routines to handle both console
3452 and window input. */
3453
3454static int
ccc2d29c 3455construct_console_modifiers ()
a1a80b40
GV		 3456{
3457 int mods;
3458
a1a80b40
GV		 3459 mods = 0;
3460 mods |= (modifier_set (VK_SHIFT)) ? SHIFT_PRESSED : 0;
3461 mods |= (modifier_set (VK_CAPITAL)) ? CAPSLOCK_ON : 0;
ccc2d29c
GV		 3462 mods |= (modifier_set (VK_SCROLL)) ? SCROLLLOCK_ON : 0;
3463 mods |= (modifier_set (VK_NUMLOCK)) ? NUMLOCK_ON : 0;
a1a80b40
GV		 3464 mods |= (modifier_set (VK_LCONTROL)) ? LEFT_CTRL_PRESSED : 0;
3465 mods |= (modifier_set (VK_RCONTROL)) ? RIGHT_CTRL_PRESSED : 0;
3466 mods |= (modifier_set (VK_LMENU)) ? LEFT_ALT_PRESSED : 0;
3467 mods |= (modifier_set (VK_RMENU)) ? RIGHT_ALT_PRESSED : 0;
ccc2d29c
GV		 3468 mods |= (modifier_set (VK_LWIN)) ? LEFT_WIN_PRESSED : 0;
3469 mods |= (modifier_set (VK_RWIN)) ? RIGHT_WIN_PRESSED : 0;
3470 mods |= (modifier_set (VK_APPS)) ? APPS_PRESSED : 0;
a1a80b40
GV		 3471
3472 return mods;
3473}
3474
ccc2d29c
GV		 3475static int
3476w32_get_key_modifiers (unsigned int wparam, unsigned int lparam)
da36a4d6 3477{
ccc2d29c
GV		 3478 int mods;
3479
3480 /* Convert to emacs modifiers. */
3481 mods = w32_kbd_mods_to_emacs (construct_console_modifiers (), wparam);
3482
3483 return mods;
3484}
da36a4d6 3485
ccc2d29c
GV		 3486unsigned int
3487map_keypad_keys (unsigned int virt_key, unsigned int extended)
3488{
3489 if (virt_key < VK_CLEAR || virt_key > VK_DELETE)
3490 return virt_key;
da36a4d6 3491
ccc2d29c 3492 if (virt_key == VK_RETURN)
da36a4d6
GV		 3493 return (extended ? VK_NUMPAD_ENTER : VK_RETURN);
3494
ccc2d29c
GV		 3495 if (virt_key >= VK_PRIOR && virt_key <= VK_DOWN)
3496 return (!extended ? (VK_NUMPAD_PRIOR + (virt_key - VK_PRIOR)) : virt_key);
3497
3498 if (virt_key == VK_INSERT || virt_key == VK_DELETE)
3499 return (!extended ? (VK_NUMPAD_INSERT + (virt_key - VK_INSERT)) : virt_key);
3500
3501 if (virt_key == VK_CLEAR)
3502 return (!extended ? VK_NUMPAD_CLEAR : virt_key);
3503
3504 return virt_key;
3505}
3506
3507/* List of special key combinations which w32 would normally capture,
3508 but emacs should grab instead. Not directly visible to lisp, to
3509 simplify synchronization. Each item is an integer encoding a virtual
3510 key code and modifier combination to capture. */
3511Lisp_Object w32_grabbed_keys;
3512
3513#define HOTKEY(vk,mods) make_number (((vk) & 255) | ((mods) << 8))
3514#define HOTKEY_ID(k) (XFASTINT (k) & 0xbfff)
3515#define HOTKEY_VK_CODE(k) (XFASTINT (k) & 255)
3516#define HOTKEY_MODIFIERS(k) (XFASTINT (k) >> 8)
3517
3518/* Register hot-keys for reserved key combinations when Emacs has
3519 keyboard focus, since this is the only way Emacs can receive key
3520 combinations like Alt-Tab which are used by the system. */
3521
3522static void
3523register_hot_keys (hwnd)
3524 HWND hwnd;
3525{
3526 Lisp_Object keylist;
3527
3528 /* Use GC_CONSP, since we are called asynchronously. */
3529 for (keylist = w32_grabbed_keys; GC_CONSP (keylist); keylist = XCDR (keylist))
3530 {
3531 Lisp_Object key = XCAR (keylist);
3532
3533 /* Deleted entries get set to nil. */
3534 if (!INTEGERP (key))
3535 continue;
3536
3537 RegisterHotKey (hwnd, HOTKEY_ID (key),
3538 HOTKEY_MODIFIERS (key), HOTKEY_VK_CODE (key));
3539 }
3540}
3541
3542static void
3543unregister_hot_keys (hwnd)
3544 HWND hwnd;
3545{
3546 Lisp_Object keylist;
3547
3548 /* Use GC_CONSP, since we are called asynchronously. */
3549 for (keylist = w32_grabbed_keys; GC_CONSP (keylist); keylist = XCDR (keylist))
3550 {
3551 Lisp_Object key = XCAR (keylist);
3552
3553 if (!INTEGERP (key))
3554 continue;
3555
3556 UnregisterHotKey (hwnd, HOTKEY_ID (key));
3557 }
3558}
3559
5ac45f98
GV		 3560/* Main message dispatch loop. */
3561
1edf84e7
GV		 3562static void
3563w32_msg_pump (deferred_msg * msg_buf)
5ac45f98
GV		 3564{
3565 MSG msg;
ccc2d29c
GV		 3566 int result;
3567 HWND focus_window;
93fbe8b7
GV		 3568
3569 msh_mousewheel = RegisterWindowMessage (MSH_MOUSEWHEEL);
5ac45f98 3570
5ac45f98
GV		 3571 while (GetMessage (&msg, NULL, 0, 0))
3572 {
3573 if (msg.hwnd == NULL)
3574 {
3575 switch (msg.message)
3576 {
3ef68e6b
AI		 3577 case WM_NULL:
3578 /* Produced by complete_deferred_msg; just ignore. */
3579 break;
5ac45f98 3580 case WM_EMACS_CREATEWINDOW:
fbd6baed 3581 w32_createwindow ((struct frame *) msg.wParam);
1edf84e7
GV		 3582 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0))
3583 abort ();
5ac45f98 3584 break;
dfdb4047
GV		 3585 case WM_EMACS_SETLOCALE:
3586 SetThreadLocale (msg.wParam);
3587 /* Reply is not expected. */
3588 break;
ccc2d29c
GV		 3589 case WM_EMACS_SETKEYBOARDLAYOUT:
3590 result = (int) ActivateKeyboardLayout ((HKL) msg.wParam, 0);
3591 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE,
3592 result, 0))
3593 abort ();
3594 break;
3595 case WM_EMACS_REGISTER_HOT_KEY:
3596 focus_window = GetFocus ();
3597 if (focus_window != NULL)
3598 RegisterHotKey (focus_window,
3599 HOTKEY_ID (msg.wParam),
3600 HOTKEY_MODIFIERS (msg.wParam),
3601 HOTKEY_VK_CODE (msg.wParam));
3602 /* Reply is not expected. */
3603 break;
3604 case WM_EMACS_UNREGISTER_HOT_KEY:
3605 focus_window = GetFocus ();
3606 if (focus_window != NULL)
3607 UnregisterHotKey (focus_window, HOTKEY_ID (msg.wParam));
adcc3809
GV		 3608 /* Mark item as erased. NB: this code must be
3609 thread-safe. The next line is okay because the cons
3610 cell is never made into garbage and is not relocated by
3611 GC. */
ccc2d29c
GV		 3612 XCAR ((Lisp_Object) msg.lParam) = Qnil;
3613 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0))
3614 abort ();
3615 break;
adcc3809
GV		 3616 case WM_EMACS_TOGGLE_LOCK_KEY:
3617 {
3618 int vk_code = (int) msg.wParam;
3619 int cur_state = (GetKeyState (vk_code) & 1);
3620 Lisp_Object new_state = (Lisp_Object) msg.lParam;
3621
3622 /* NB: This code must be thread-safe. It is safe to
3623 call NILP because symbols are not relocated by GC,
3624 and pointer here is not touched by GC (so the markbit
3625 can't be set). Numbers are safe because they are
3626 immediate values. */
3627 if (NILP (new_state)
3628 || (NUMBERP (new_state)
3629 && (XUINT (new_state)) & 1 != cur_state))
3630 {
3631 one_w32_display_info.faked_key = vk_code;
3632
3633 keybd_event ((BYTE) vk_code,
3634 (BYTE) MapVirtualKey (vk_code, 0),
3635 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
3636 keybd_event ((BYTE) vk_code,
3637 (BYTE) MapVirtualKey (vk_code, 0),
3638 KEYEVENTF_EXTENDEDKEY | 0, 0);
3639 keybd_event ((BYTE) vk_code,
3640 (BYTE) MapVirtualKey (vk_code, 0),
3641 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
3642 cur_state = !cur_state;
3643 }
3644 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE,
3645 cur_state, 0))
3646 abort ();
3647 }
3648 break;
1edf84e7 3649 default:
1edf84e7 3650 DebPrint (("msg %x not expected by w32_msg_pump\n", msg.message));
5ac45f98
GV		 3651 }
3652 }
3653 else
3654 {
3655 DispatchMessage (&msg);
3656 }
1edf84e7
GV		 3657
3658 /* Exit nested loop when our deferred message has completed. */
3659 if (msg_buf->completed)
3660 break;
5ac45f98 3661 }
1edf84e7
GV		 3662}
3663
3664deferred_msg * deferred_msg_head;
3665
3666static deferred_msg *
3667find_deferred_msg (HWND hwnd, UINT msg)
3668{
3669 deferred_msg * item;
3670
3671 /* Don't actually need synchronization for read access, since
3672 modification of single pointer is always atomic. */
3673 /* enter_crit (); */
3674
3675 for (item = deferred_msg_head; item != NULL; item = item->next)
3676 if (item->w32msg.msg.hwnd == hwnd
3677 && item->w32msg.msg.message == msg)
3678 break;
3679
3680 /* leave_crit (); */
3681
3682 return item;
3683}
3684
3685static LRESULT
3686send_deferred_msg (deferred_msg * msg_buf,
3687 HWND hwnd,
3688 UINT msg,
3689 WPARAM wParam,
3690 LPARAM lParam)
3691{
3692 /* Only input thread can send deferred messages. */
3693 if (GetCurrentThreadId () != dwWindowsThreadId)
3694 abort ();
3695
3696 /* It is an error to send a message that is already deferred. */
3697 if (find_deferred_msg (hwnd, msg) != NULL)
3698 abort ();
3699
3700 /* Enforced synchronization is not needed because this is the only
3701 function that alters deferred_msg_head, and the following critical
3702 section is guaranteed to only be serially reentered (since only the
3703 input thread can call us). */
3704
3705 /* enter_crit (); */
3706
3707 msg_buf->completed = 0;
3708 msg_buf->next = deferred_msg_head;
3709 deferred_msg_head = msg_buf;
3710 my_post_msg (&msg_buf->w32msg, hwnd, msg, wParam, lParam);
3711
3712 /* leave_crit (); */
3713
3714 /* Start a new nested message loop to process other messages until
3715 this one is completed. */
3716 w32_msg_pump (msg_buf);
3717
3718 deferred_msg_head = msg_buf->next;
3719
3720 return msg_buf->result;
3721}
3722
3723void
3724complete_deferred_msg (HWND hwnd, UINT msg, LRESULT result)
3725{
3726 deferred_msg * msg_buf = find_deferred_msg (hwnd, msg);
3727
3728 if (msg_buf == NULL)
3ef68e6b
AI		 3729 /* Message may have been cancelled, so don't abort(). */
3730 return;
1edf84e7
GV		 3731
3732 msg_buf->result = result;
3733 msg_buf->completed = 1;
3734
3735 /* Ensure input thread is woken so it notices the completion. */
3736 PostThreadMessage (dwWindowsThreadId, WM_NULL, 0, 0);
3737}
3738
3ef68e6b
AI		 3739void
3740cancel_all_deferred_msgs ()
3741{
3742 deferred_msg * item;
3743
3744 /* Don't actually need synchronization for read access, since
3745 modification of single pointer is always atomic. */
3746 /* enter_crit (); */
3747
3748 for (item = deferred_msg_head; item != NULL; item = item->next)
3749 {
3750 item->result = 0;
3751 item->completed = 1;
3752 }
3753
3754 /* leave_crit (); */
3755
3756 /* Ensure input thread is woken so it notices the completion. */
3757 PostThreadMessage (dwWindowsThreadId, WM_NULL, 0, 0);
3758}
1edf84e7
GV		 3759
3760DWORD
3761w32_msg_worker (dw)
3762 DWORD dw;
3763{
3764 MSG msg;
3765 deferred_msg dummy_buf;
3766
3767 /* Ensure our message queue is created */
3768
3769 PeekMessage (&msg, NULL, 0, 0, PM_NOREMOVE);
5ac45f98 3770
1edf84e7
GV		 3771 if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0))
3772 abort ();
3773
3774 memset (&dummy_buf, 0, sizeof (dummy_buf));
3775 dummy_buf.w32msg.msg.hwnd = NULL;
3776 dummy_buf.w32msg.msg.message = WM_NULL;
3777
3778 /* This is the inital message loop which should only exit when the
3779 application quits. */
3780 w32_msg_pump (&dummy_buf);
3781
3782 return 0;
5ac45f98
GV		 3783}
3784
3ef68e6b
AI		 3785static void
3786post_character_message (hwnd, msg, wParam, lParam, modifiers)
3787 HWND hwnd;
3788 UINT msg;
3789 WPARAM wParam;
3790 LPARAM lParam;
3791 DWORD modifiers;
3792
3793{
3794 W32Msg wmsg;
3795
3796 wmsg.dwModifiers = modifiers;
3797
3798 /* Detect quit_char and set quit-flag directly. Note that we
3799 still need to post a message to ensure the main thread will be
3800 woken up if blocked in sys_select(), but we do NOT want to post
3801 the quit_char message itself (because it will usually be as if
3802 the user had typed quit_char twice). Instead, we post a dummy
3803 message that has no particular effect. */
3804 {
3805 int c = wParam;
3806 if (isalpha (c) && wmsg.dwModifiers == ctrl_modifier)
3807 c = make_ctrl_char (c) & 0377;
7d081355
AI		 3808 if (c == quit_char
3809 || (wmsg.dwModifiers == 0 &&
3810 XFASTINT (Vw32_quit_key) && wParam == XFASTINT (Vw32_quit_key)))
3ef68e6b
AI		 3811 {
3812 Vquit_flag = Qt;
3813
3814 /* The choice of message is somewhat arbitrary, as long as
3815 the main thread handler just ignores it. */
3816 msg = WM_NULL;
3817
3818 /* Interrupt any blocking system calls. */
3819 signal_quit ();
3820
3821 /* As a safety precaution, forcibly complete any deferred
3822 messages. This is a kludge, but I don't see any particularly
3823 clean way to handle the situation where a deferred message is
3824 "dropped" in the lisp thread, and will thus never be
3825 completed, eg. by the user trying to activate the menubar
3826 when the lisp thread is busy, and then typing C-g when the
3827 menubar doesn't open promptly (with the result that the
3828 menubar never responds at all because the deferred
3829 WM_INITMENU message is never completed). Another problem
3830 situation is when the lisp thread calls SendMessage (to send
3831 a window manager command) when a message has been deferred;
3832 the lisp thread gets blocked indefinitely waiting for the
3833 deferred message to be completed, which itself is waiting for
3834 the lisp thread to respond.
3835
3836 Note that we don't want to block the input thread waiting for
3837 a reponse from the lisp thread (although that would at least
3838 solve the deadlock problem above), because we want to be able
3839 to receive C-g to interrupt the lisp thread. */
3840 cancel_all_deferred_msgs ();
3841 }
3842 }
3843
3844 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3845}
3846
ee78dc32
GV		 3847/* Main window procedure */
3848
ee78dc32 3849LRESULT CALLBACK
fbd6baed 3850w32_wnd_proc (hwnd, msg, wParam, lParam)
ee78dc32
GV		 3851 HWND hwnd;
3852 UINT msg;
3853 WPARAM wParam;
3854 LPARAM lParam;
3855{
3856 struct frame *f;
fbd6baed
GV		 3857 struct w32_display_info *dpyinfo = &one_w32_display_info;
3858 W32Msg wmsg;
84fb1139 3859 int windows_translate;
576ba81c 3860 int key;
84fb1139 3861
a6085637
KH		 3862 /* Note that it is okay to call x_window_to_frame, even though we are
3863 not running in the main lisp thread, because frame deletion
3864 requires the lisp thread to synchronize with this thread. Thus, if
3865 a frame struct is returned, it can be used without concern that the
3866 lisp thread might make it disappear while we are using it.
3867
3868 NB. Walking the frame list in this thread is safe (as long as
3869 writes of Lisp_Object slots are atomic, which they are on Windows).
3870 Although delete-frame can destructively modify the frame list while
3871 we are walking it, a garbage collection cannot occur until after
3872 delete-frame has synchronized with this thread.
3873
3874 It is also safe to use functions that make GDI calls, such as
fbd6baed 3875 w32_clear_rect, because these functions must obtain a DC handle
a6085637
KH		 3876 from the frame struct using get_frame_dc which is thread-aware. */
3877
ee78dc32
GV		 3878 switch (msg)
3879 {
3880 case WM_ERASEBKGND:
a6085637
KH		 3881 f = x_window_to_frame (dpyinfo, hwnd);
3882 if (f)
3883 {
9badad41 3884 HDC hdc = get_frame_dc (f);
a6085637 3885 GetUpdateRect (hwnd, &wmsg.rect, FALSE);
9badad41
JR		 3886 w32_clear_rect (f, hdc, &wmsg.rect);
3887 release_frame_dc (f, hdc);
ce6059da
AI		 3888
3889#if defined (W32_DEBUG_DISPLAY)
3890 DebPrint (("WM_ERASEBKGND: erasing %d,%d-%d,%d\n",
3891 wmsg.rect.left, wmsg.rect.top, wmsg.rect.right,
3892 wmsg.rect.bottom));
3893#endif /* W32_DEBUG_DISPLAY */
a6085637 3894 }
5ac45f98
GV		 3895 return 1;
3896 case WM_PALETTECHANGED:
3897 /* ignore our own changes */
3898 if ((HWND)wParam != hwnd)
3899 {
a6085637
KH		 3900 f = x_window_to_frame (dpyinfo, hwnd);
3901 if (f)
3902 /* get_frame_dc will realize our palette and force all
3903 frames to be redrawn if needed. */
3904 release_frame_dc (f, get_frame_dc (f));
5ac45f98
GV		 3905 }
3906 return 0;
ee78dc32 3907 case WM_PAINT:
ce6059da 3908 {
55dcfc15
AI		 3909 PAINTSTRUCT paintStruct;
3910 RECT update_rect;
3911
3912 /* MSDN Docs say not to call BeginPaint if GetUpdateRect
3913 fails. Apparently this can happen under some
3914 circumstances. */
c0611964 3915 if (!w32_strict_painting || GetUpdateRect (hwnd, &update_rect, FALSE))
55dcfc15
AI		 3916 {
3917 enter_crit ();
3918 BeginPaint (hwnd, &paintStruct);
3919
c0611964
AI		 3920 if (w32_strict_painting)
3921 /* The rectangles returned by GetUpdateRect and BeginPaint
3922 do not always match. GetUpdateRect seems to be the
3923 more reliable of the two. */
3924 wmsg.rect = update_rect;
3925 else
3926 wmsg.rect = paintStruct.rcPaint;
55dcfc15
AI		 3927
3928#if defined (W32_DEBUG_DISPLAY)
3929 DebPrint (("WM_PAINT: painting %d,%d-%d,%d\n", wmsg.rect.left,
3930 wmsg.rect.top, wmsg.rect.right, wmsg.rect.bottom));
3931 DebPrint (("WM_PAINT: update region is %d,%d-%d,%d\n",
3932 update_rect.left, update_rect.top,
3933 update_rect.right, update_rect.bottom));
3934#endif
3935 EndPaint (hwnd, &paintStruct);
3936 leave_crit ();
3937
3938 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3939
3940 return 0;
3941 }
c0611964
AI		 3942
3943 /* If GetUpdateRect returns 0 (meaning there is no update
3944 region), assume the whole window needs to be repainted. */
3945 GetClientRect(hwnd, &wmsg.rect);
3946 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3947 return 0;
ee78dc32 3948 }
a1a80b40 3949
ccc2d29c
GV		 3950 case WM_INPUTLANGCHANGE:
3951 /* Inform lisp thread of keyboard layout changes. */
3952 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
3953
3954 /* Clear dead keys in the keyboard state; for simplicity only
3955 preserve modifier key states. */
3956 {
3957 int i;
3958 BYTE keystate[256];
3959
3960 GetKeyboardState (keystate);
3961 for (i = 0; i < 256; i++)
3962 if (1
3963 && i != VK_SHIFT
3964 && i != VK_LSHIFT
3965 && i != VK_RSHIFT
3966 && i != VK_CAPITAL
3967 && i != VK_NUMLOCK
3968 && i != VK_SCROLL
3969 && i != VK_CONTROL
3970 && i != VK_LCONTROL
3971 && i != VK_RCONTROL
3972 && i != VK_MENU
3973 && i != VK_LMENU
3974 && i != VK_RMENU
3975 && i != VK_LWIN
3976 && i != VK_RWIN)
3977 keystate[i] = 0;
3978 SetKeyboardState (keystate);
3979 }
3980 goto dflt;
3981
3982 case WM_HOTKEY:
3983 /* Synchronize hot keys with normal input. */
3984 PostMessage (hwnd, WM_KEYDOWN, HIWORD (lParam), 0);
3985 return (0);
3986
a1a80b40
GV		 3987 case WM_KEYUP:
3988 case WM_SYSKEYUP:
3989 record_keyup (wParam, lParam);
3990 goto dflt;
3991
ee78dc32
GV		 3992 case WM_KEYDOWN:
3993 case WM_SYSKEYDOWN:
ccc2d29c
GV		 3994 /* Ignore keystrokes we fake ourself; see below. */
3995 if (dpyinfo->faked_key == wParam)
3996 {
3997 dpyinfo->faked_key = 0;
576ba81c
AI		 3998 /* Make sure TranslateMessage sees them though (as long as
3999 they don't produce WM_CHAR messages). This ensures that
4000 indicator lights are toggled promptly on Windows 9x, for
4001 example. */
4002 if (lispy_function_keys[wParam] != 0)
4003 {
4004 windows_translate = 1;
4005 goto translate;
4006 }
4007 return 0;
ccc2d29c
GV		 4008 }
4009
7830e24b
RS		 4010 /* Synchronize modifiers with current keystroke. */
4011 sync_modifiers ();
a1a80b40 4012 record_keydown (wParam, lParam);
ccc2d29c 4013 wParam = map_keypad_keys (wParam, (lParam & 0x1000000L) != 0);
84fb1139
KH		 4014
4015 windows_translate = 0;
ccc2d29c
GV		 4016
4017 switch (wParam)
4018 {
4019 case VK_LWIN:
4020 if (NILP (Vw32_pass_lwindow_to_system))
4021 {
4022 /* Prevent system from acting on keyup (which opens the
4023 Start menu if no other key was pressed) by simulating a
4024 press of Space which we will ignore. */
4025 if (GetAsyncKeyState (wParam) & 1)
4026 {
adcc3809 4027 if (NUMBERP (Vw32_phantom_key_code))
576ba81c 4028 key = XUINT (Vw32_phantom_key_code) & 255;
adcc3809 4029 else
576ba81c
AI		 4030 key = VK_SPACE;
4031 dpyinfo->faked_key = key;
4032 keybd_event (key, (BYTE) MapVirtualKey (key, 0), 0, 0);
ccc2d29c
GV		 4033 }
4034 }
4035 if (!NILP (Vw32_lwindow_modifier))
4036 return 0;
4037 break;
4038 case VK_RWIN:
4039 if (NILP (Vw32_pass_rwindow_to_system))
4040 {
4041 if (GetAsyncKeyState (wParam) & 1)
4042 {
adcc3809 4043 if (NUMBERP (Vw32_phantom_key_code))
576ba81c 4044 key = XUINT (Vw32_phantom_key_code) & 255;
adcc3809 4045 else
576ba81c
AI		 4046 key = VK_SPACE;
4047 dpyinfo->faked_key = key;
4048 keybd_event (key, (BYTE) MapVirtualKey (key, 0), 0, 0);
ccc2d29c
GV		 4049 }
4050 }
4051 if (!NILP (Vw32_rwindow_modifier))
4052 return 0;
4053 break;
576ba81c 4054 case VK_APPS:
ccc2d29c
GV		 4055 if (!NILP (Vw32_apps_modifier))
4056 return 0;
4057 break;
4058 case VK_MENU:
4059 if (NILP (Vw32_pass_alt_to_system))
adcc3809
GV		 4060 /* Prevent DefWindowProc from activating the menu bar if an
4061 Alt key is pressed and released by itself. */
ccc2d29c 4062 return 0;
84fb1139 4063 windows_translate = 1;
ccc2d29c
GV		 4064 break;
4065 case VK_CAPITAL:
4066 /* Decide whether to treat as modifier or function key. */
4067 if (NILP (Vw32_enable_caps_lock))
4068 goto disable_lock_key;
adcc3809
GV		 4069 windows_translate = 1;
4070 break;
ccc2d29c
GV		 4071 case VK_NUMLOCK:
4072 /* Decide whether to treat as modifier or function key. */
4073 if (NILP (Vw32_enable_num_lock))
4074 goto disable_lock_key;
adcc3809
GV		 4075 windows_translate = 1;
4076 break;
ccc2d29c
GV		 4077 case VK_SCROLL:
4078 /* Decide whether to treat as modifier or function key. */
4079 if (NILP (Vw32_scroll_lock_modifier))
4080 goto disable_lock_key;
adcc3809
GV		 4081 windows_translate = 1;
4082 break;
ccc2d29c 4083 disable_lock_key:
adcc3809
GV		 4084 /* Ensure the appropriate lock key state (and indicator light)
4085 remains in the same state. We do this by faking another
4086 press of the relevant key. Apparently, this really is the
4087 only way to toggle the state of the indicator lights. */
4088 dpyinfo->faked_key = wParam;
4089 keybd_event ((BYTE) wParam, (BYTE) MapVirtualKey (wParam, 0),
4090 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
4091 keybd_event ((BYTE) wParam, (BYTE) MapVirtualKey (wParam, 0),
4092 KEYEVENTF_EXTENDEDKEY | 0, 0);
4093 keybd_event ((BYTE) wParam, (BYTE) MapVirtualKey (wParam, 0),
4094 KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP, 0);
4095 /* Ensure indicator lights are updated promptly on Windows 9x
4096 (TranslateMessage apparently does this), after forwarding
4097 input event. */
4098 post_character_message (hwnd, msg, wParam, lParam,
4099 w32_get_key_modifiers (wParam, lParam));
4100 windows_translate = 1;
ccc2d29c
GV		 4101 break;
4102 case VK_CONTROL:
4103 case VK_SHIFT:
4104 case VK_PROCESSKEY: /* Generated by IME. */
4105 windows_translate = 1;
4106 break;
adcc3809
GV		 4107 case VK_CANCEL:
4108 /* Windows maps Ctrl-Pause (aka Ctrl-Break) into VK_CANCEL,
4109 which is confusing for purposes of key binding; convert
4110 VK_CANCEL events into VK_PAUSE events. */
4111 wParam = VK_PAUSE;
4112 break;
4113 case VK_PAUSE:
4114 /* Windows maps Ctrl-NumLock into VK_PAUSE, which is confusing
4115 for purposes of key binding; convert these back into
4116 VK_NUMLOCK events, at least when we want to see NumLock key
4117 presses. (Note that there is never any possibility that
4118 VK_PAUSE with Ctrl really is C-Pause as per above.) */
4119 if (NILP (Vw32_enable_num_lock) && modifier_set (VK_CONTROL))
4120 wParam = VK_NUMLOCK;
4121 break;
ccc2d29c
GV		 4122 default:
4123 /* If not defined as a function key, change it to a WM_CHAR message. */
4124 if (lispy_function_keys[wParam] == 0)
4125 {
adcc3809
GV		 4126 DWORD modifiers = construct_console_modifiers ();
4127
ccc2d29c
GV		 4128 if (!NILP (Vw32_recognize_altgr)
4129 && modifier_set (VK_LCONTROL) && modifier_set (VK_RMENU))
4130 {
4131 /* Always let TranslateMessage handle AltGr key chords;
4132 for some reason, ToAscii doesn't always process AltGr
4133 chords correctly. */
4134 windows_translate = 1;
4135 }
adcc3809 4136 else if ((modifiers & (~SHIFT_PRESSED & ~CAPSLOCK_ON)) != 0)
ccc2d29c 4137 {
adcc3809
GV		 4138 /* Handle key chords including any modifiers other
4139 than shift directly, in order to preserve as much
4140 modifier information as possible. */
ccc2d29c
GV		 4141 if ('A' <= wParam && wParam <= 'Z')
4142 {
4143 /* Don't translate modified alphabetic keystrokes,
4144 so the user doesn't need to constantly switch
4145 layout to type control or meta keystrokes when
4146 the normal layout translates alphabetic
4147 characters to non-ascii characters. */
4148 if (!modifier_set (VK_SHIFT))
4149 wParam += ('a' - 'A');
4150 msg = WM_CHAR;
4151 }
4152 else
4153 {
4154 /* Try to handle other keystrokes by determining the
4155 base character (ie. translating the base key plus
4156 shift modifier). */
4157 int add;
4158 int isdead = 0;
4159 KEY_EVENT_RECORD key;
4160
4161 key.bKeyDown = TRUE;
4162 key.wRepeatCount = 1;
4163 key.wVirtualKeyCode = wParam;
4164 key.wVirtualScanCode = (lParam & 0xFF0000) >> 16;
4165 key.uChar.AsciiChar = 0;
adcc3809 4166 key.dwControlKeyState = modifiers;
ccc2d29c
GV		 4167
4168 add = w32_kbd_patch_key (&key);
4169 /* 0 means an unrecognised keycode, negative means
4170 dead key. Ignore both. */
4171 while (--add >= 0)
4172 {
4173 /* Forward asciified character sequence. */
4174 post_character_message
4175 (hwnd, WM_CHAR, key.uChar.AsciiChar, lParam,
4176 w32_get_key_modifiers (wParam, lParam));
4177 w32_kbd_patch_key (&key);
4178 }
4179 return 0;
4180 }
4181 }
4182 else
4183 {
4184 /* Let TranslateMessage handle everything else. */
4185 windows_translate = 1;
4186 }
4187 }
4188 }
a1a80b40 4189
adcc3809 4190 translate:
84fb1139
KH		 4191 if (windows_translate)
4192 {
e9e23e23 4193 MSG windows_msg = { hwnd, msg, wParam, lParam, 0, {0,0} };
84fb1139 4194
e9e23e23
GV		 4195 windows_msg.time = GetMessageTime ();
4196 TranslateMessage (&windows_msg);
84fb1139
KH		 4197 goto dflt;
4198 }
4199
ee78dc32
GV		 4200 /* Fall through */
4201
4202 case WM_SYSCHAR:
4203 case WM_CHAR:
ccc2d29c
GV		 4204 post_character_message (hwnd, msg, wParam, lParam,
4205 w32_get_key_modifiers (wParam, lParam));
ee78dc32 4206 break;
da36a4d6 4207
5ac45f98
GV		 4208 /* Simulate middle mouse button events when left and right buttons
4209 are used together, but only if user has two button mouse. */
ee78dc32 4210 case WM_LBUTTONDOWN:
5ac45f98 4211 case WM_RBUTTONDOWN:
fbd6baed 4212 if (XINT (Vw32_num_mouse_buttons) == 3)
5ac45f98
GV		 4213 goto handle_plain_button;
4214
4215 {
4216 int this = (msg == WM_LBUTTONDOWN) ? LMOUSE : RMOUSE;
4217 int other = (msg == WM_LBUTTONDOWN) ? RMOUSE : LMOUSE;
4218
3cb20f4a
RS		 4219 if (button_state & this)
4220 return 0;
5ac45f98
GV		 4221
4222 if (button_state == 0)
4223 SetCapture (hwnd);
4224
4225 button_state |= this;
4226
4227 if (button_state & other)
4228 {
84fb1139 4229 if (mouse_button_timer)
5ac45f98 4230 {
84fb1139
KH		 4231 KillTimer (hwnd, mouse_button_timer);
4232 mouse_button_timer = 0;
5ac45f98
GV		 4233
4234 /* Generate middle mouse event instead. */
4235 msg = WM_MBUTTONDOWN;
4236 button_state |= MMOUSE;
4237 }
4238 else if (button_state & MMOUSE)
4239 {
4240 /* Ignore button event if we've already generated a
4241 middle mouse down event. This happens if the
4242 user releases and press one of the two buttons
4243 after we've faked a middle mouse event. */
4244 return 0;
4245 }
4246 else
4247 {
4248 /* Flush out saved message. */
84fb1139 4249 post_msg (&saved_mouse_button_msg);
5ac45f98 4250 }
fbd6baed 4251 wmsg.dwModifiers = w32_get_modifiers ();
5ac45f98
GV		 4252 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4253
4254 /* Clear message buffer. */
84fb1139 4255 saved_mouse_button_msg.msg.hwnd = 0;
5ac45f98
GV		 4256 }
4257 else
4258 {
4259 /* Hold onto message for now. */
84fb1139 4260 mouse_button_timer =
adcc3809
GV		 4261 SetTimer (hwnd, MOUSE_BUTTON_ID,
4262 XINT (Vw32_mouse_button_tolerance), NULL);
84fb1139
KH		 4263 saved_mouse_button_msg.msg.hwnd = hwnd;
4264 saved_mouse_button_msg.msg.message = msg;
4265 saved_mouse_button_msg.msg.wParam = wParam;
4266 saved_mouse_button_msg.msg.lParam = lParam;
4267 saved_mouse_button_msg.msg.time = GetMessageTime ();
fbd6baed 4268 saved_mouse_button_msg.dwModifiers = w32_get_modifiers ();
5ac45f98
GV		 4269 }
4270 }
4271 return 0;
4272
ee78dc32 4273 case WM_LBUTTONUP:
5ac45f98 4274 case WM_RBUTTONUP:
fbd6baed 4275 if (XINT (Vw32_num_mouse_buttons) == 3)
5ac45f98
GV		 4276 goto handle_plain_button;
4277
4278 {
4279 int this = (msg == WM_LBUTTONUP) ? LMOUSE : RMOUSE;
4280 int other = (msg == WM_LBUTTONUP) ? RMOUSE : LMOUSE;
4281
3cb20f4a
RS		 4282 if ((button_state & this) == 0)
4283 return 0;
5ac45f98
GV		 4284
4285 button_state &= ~this;
4286
4287 if (button_state & MMOUSE)
4288 {
4289 /* Only generate event when second button is released. */
4290 if ((button_state & other) == 0)
4291 {
4292 msg = WM_MBUTTONUP;
4293 button_state &= ~MMOUSE;
4294
4295 if (button_state) abort ();
4296 }
4297 else
4298 return 0;
4299 }
4300 else
4301 {
4302 /* Flush out saved message if necessary. */
84fb1139 4303 if (saved_mouse_button_msg.msg.hwnd)
5ac45f98 4304 {
84fb1139 4305 post_msg (&saved_mouse_button_msg);
5ac45f98
GV		 4306 }
4307 }
fbd6baed 4308 wmsg.dwModifiers = w32_get_modifiers ();
5ac45f98
GV		 4309 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4310
4311 /* Always clear message buffer and cancel timer. */
84fb1139
KH		 4312 saved_mouse_button_msg.msg.hwnd = 0;
4313 KillTimer (hwnd, mouse_button_timer);
4314 mouse_button_timer = 0;
5ac45f98
GV		 4315
4316 if (button_state == 0)
4317 ReleaseCapture ();
4318 }
4319 return 0;
4320
ee78dc32
GV		 4321 case WM_MBUTTONDOWN:
4322 case WM_MBUTTONUP:
5ac45f98 4323 handle_plain_button:
ee78dc32
GV		 4324 {
4325 BOOL up;
1edf84e7 4326 int button;
ee78dc32 4327
1edf84e7 4328 if (parse_button (msg, &button, &up))
ee78dc32
GV		 4329 {
4330 if (up) ReleaseCapture ();
4331 else SetCapture (hwnd);
1edf84e7
GV		 4332 button = (button == 0) ? LMOUSE :
4333 ((button == 1) ? MMOUSE : RMOUSE);
4334 if (up)
4335 button_state &= ~button;
4336 else
4337 button_state |= button;
ee78dc32
GV		 4338 }
4339 }
4340
fbd6baed 4341 wmsg.dwModifiers = w32_get_modifiers ();
ee78dc32 4342 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
5ac45f98
GV		 4343 return 0;
4344
84fb1139 4345 case WM_VSCROLL:
5ac45f98 4346 case WM_MOUSEMOVE:
fbd6baed 4347 if (XINT (Vw32_mouse_move_interval) <= 0
84fb1139
KH		 4348 || (msg == WM_MOUSEMOVE && button_state == 0))
4349 {
fbd6baed 4350 wmsg.dwModifiers = w32_get_modifiers ();
84fb1139
KH		 4351 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4352 return 0;
4353 }
4354
4355 /* Hang onto mouse move and scroll messages for a bit, to avoid
4356 sending such events to Emacs faster than it can process them.
4357 If we get more events before the timer from the first message
4358 expires, we just replace the first message. */
4359
4360 if (saved_mouse_move_msg.msg.hwnd == 0)
4361 mouse_move_timer =
adcc3809
GV		 4362 SetTimer (hwnd, MOUSE_MOVE_ID,
4363 XINT (Vw32_mouse_move_interval), NULL);
84fb1139
KH		 4364
4365 /* Hold onto message for now. */
4366 saved_mouse_move_msg.msg.hwnd = hwnd;
4367 saved_mouse_move_msg.msg.message = msg;
4368 saved_mouse_move_msg.msg.wParam = wParam;
4369 saved_mouse_move_msg.msg.lParam = lParam;
4370 saved_mouse_move_msg.msg.time = GetMessageTime ();
fbd6baed 4371 saved_mouse_move_msg.dwModifiers = w32_get_modifiers ();
84fb1139
KH		 4372
4373 return 0;
4374
1edf84e7
GV		 4375 case WM_MOUSEWHEEL:
4376 wmsg.dwModifiers = w32_get_modifiers ();
4377 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4378 return 0;
4379
cb9e33d4
RS		 4380 case WM_DROPFILES:
4381 wmsg.dwModifiers = w32_get_modifiers ();
4382 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4383 return 0;
4384
84fb1139
KH		 4385 case WM_TIMER:
4386 /* Flush out saved messages if necessary. */
4387 if (wParam == mouse_button_timer)
5ac45f98 4388 {
84fb1139
KH		 4389 if (saved_mouse_button_msg.msg.hwnd)
4390 {
4391 post_msg (&saved_mouse_button_msg);
4392 saved_mouse_button_msg.msg.hwnd = 0;
4393 }
4394 KillTimer (hwnd, mouse_button_timer);
4395 mouse_button_timer = 0;
4396 }
4397 else if (wParam == mouse_move_timer)
4398 {
4399 if (saved_mouse_move_msg.msg.hwnd)
4400 {
4401 post_msg (&saved_mouse_move_msg);
4402 saved_mouse_move_msg.msg.hwnd = 0;
4403 }
4404 KillTimer (hwnd, mouse_move_timer);
4405 mouse_move_timer = 0;
5ac45f98 4406 }
5ac45f98 4407 return 0;
84fb1139
KH		 4408
4409 case WM_NCACTIVATE:
4410 /* Windows doesn't send us focus messages when putting up and
e9e23e23 4411 taking down a system popup dialog as for Ctrl-Alt-Del on Windows 95.
84fb1139
KH		 4412 The only indication we get that something happened is receiving
4413 this message afterwards. So this is a good time to reset our
4414 keyboard modifiers' state. */
4415 reset_modifiers ();
4416 goto dflt;
da36a4d6 4417
1edf84e7 4418 case WM_INITMENU:
487163ac
AI		 4419 button_state = 0;
4420 ReleaseCapture ();
1edf84e7
GV		 4421 /* We must ensure menu bar is fully constructed and up to date
4422 before allowing user interaction with it. To achieve this
4423 we send this message to the lisp thread and wait for a
4424 reply (whose value is not actually needed) to indicate that
4425 the menu bar is now ready for use, so we can now return.
4426
4427 To remain responsive in the meantime, we enter a nested message
4428 loop that can process all other messages.
4429
4430 However, we skip all this if the message results from calling
4431 TrackPopupMenu - in fact, we must NOT attempt to send the lisp
4432 thread a message because it is blocked on us at this point. We
4433 set menubar_active before calling TrackPopupMenu to indicate
4434 this (there is no possibility of confusion with real menubar
4435 being active). */
4436
4437 f = x_window_to_frame (dpyinfo, hwnd);
4438 if (f
4439 && (f->output_data.w32->menubar_active
4440 /* We can receive this message even in the absence of a
4441 menubar (ie. when the system menu is activated) - in this
4442 case we do NOT want to forward the message, otherwise it
4443 will cause the menubar to suddenly appear when the user
4444 had requested it to be turned off! */
4445 || f->output_data.w32->menubar_widget == NULL))
4446 return 0;
4447
4448 {
4449 deferred_msg msg_buf;
4450
4451 /* Detect if message has already been deferred; in this case
4452 we cannot return any sensible value to ignore this. */
4453 if (find_deferred_msg (hwnd, msg) != NULL)
4454 abort ();
4455
4456 return send_deferred_msg (&msg_buf, hwnd, msg, wParam, lParam);
4457 }
4458
4459 case WM_EXITMENULOOP:
4460 f = x_window_to_frame (dpyinfo, hwnd);
4461
4462 /* Indicate that menubar can be modified again. */
4463 if (f)
4464 f->output_data.w32->menubar_active = 0;
4465 goto dflt;
4466
87996783
GV		 4467 case WM_MEASUREITEM:
4468 f = x_window_to_frame (dpyinfo, hwnd);
4469 if (f)
4470 {
4471 MEASUREITEMSTRUCT * pMis = (MEASUREITEMSTRUCT *) lParam;
4472
4473 if (pMis->CtlType == ODT_MENU)
4474 {
4475 /* Work out dimensions for popup menu titles. */
4476 char * title = (char *) pMis->itemData;
4477 HDC hdc = GetDC (hwnd);
4478 HFONT menu_font = GetCurrentObject (hdc, OBJ_FONT);
4479 LOGFONT menu_logfont;
4480 HFONT old_font;
4481 SIZE size;
4482
4483 GetObject (menu_font, sizeof (menu_logfont), &menu_logfont);
4484 menu_logfont.lfWeight = FW_BOLD;
4485 menu_font = CreateFontIndirect (&menu_logfont);
4486 old_font = SelectObject (hdc, menu_font);
4487
4488 GetTextExtentPoint32 (hdc, title, strlen (title), &size);
4489 pMis->itemWidth = size.cx;
4490 pMis->itemHeight = GetSystemMetrics (SM_CYMENUSIZE);
4491 if (pMis->itemHeight < size.cy)
4492 pMis->itemHeight = size.cy;
4493
4494 SelectObject (hdc, old_font);
4495 DeleteObject (menu_font);
4496 ReleaseDC (hwnd, hdc);
4497 return TRUE;
4498 }
4499 }
4500 return 0;
4501
4502 case WM_DRAWITEM:
4503 f = x_window_to_frame (dpyinfo, hwnd);
4504 if (f)
4505 {
4506 DRAWITEMSTRUCT * pDis = (DRAWITEMSTRUCT *) lParam;
4507
4508 if (pDis->CtlType == ODT_MENU)
4509 {
4510 /* Draw popup menu title. */
4511 char * title = (char *) pDis->itemData;
4512 HDC hdc = pDis->hDC;
4513 HFONT menu_font = GetCurrentObject (hdc, OBJ_FONT);
4514 LOGFONT menu_logfont;
4515 HFONT old_font;
4516
4517 GetObject (menu_font, sizeof (menu_logfont), &menu_logfont);
4518 menu_logfont.lfWeight = FW_BOLD;
4519 menu_font = CreateFontIndirect (&menu_logfont);
4520 old_font = SelectObject (hdc, menu_font);
4521
4522 /* Always draw title as if not selected. */
4523 ExtTextOut (hdc,
4524 pDis->rcItem.left + GetSystemMetrics (SM_CXMENUCHECK),
4525 pDis->rcItem.top,
4526 ETO_OPAQUE, &pDis->rcItem,
4527 title, strlen (title), NULL);
4528
4529 SelectObject (hdc, old_font);
4530 DeleteObject (menu_font);
4531 return TRUE;
4532 }
4533 }
4534 return 0;
4535
1edf84e7
GV		 4536#if 0
4537 /* Still not right - can't distinguish between clicks in the
4538 client area of the frame from clicks forwarded from the scroll
4539 bars - may have to hook WM_NCHITTEST to remember the mouse
4540 position and then check if it is in the client area ourselves. */
4541 case WM_MOUSEACTIVATE:
4542 /* Discard the mouse click that activates a frame, allowing the
4543 user to click anywhere without changing point (or worse!).
4544 Don't eat mouse clicks on scrollbars though!! */
4545 if (LOWORD (lParam) == HTCLIENT )
4546 return MA_ACTIVATEANDEAT;
4547 goto dflt;
4548#endif
4549
1edf84e7 4550 case WM_ACTIVATEAPP:
ccc2d29c 4551 case WM_ACTIVATE:
1edf84e7
GV		 4552 case WM_WINDOWPOSCHANGED:
4553 case WM_SHOWWINDOW:
4554 /* Inform lisp thread that a frame might have just been obscured
4555 or exposed, so should recheck visibility of all frames. */
4556 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4557 goto dflt;
4558
da36a4d6 4559 case WM_SETFOCUS:
adcc3809
GV		 4560 dpyinfo->faked_key = 0;
4561 reset_modifiers ();
ccc2d29c
GV		 4562 register_hot_keys (hwnd);
4563 goto command;
8681157a 4564 case WM_KILLFOCUS:
ccc2d29c 4565 unregister_hot_keys (hwnd);
487163ac
AI		 4566 button_state = 0;
4567 ReleaseCapture ();
ee78dc32
GV		 4568 case WM_MOVE:
4569 case WM_SIZE:
ee78dc32 4570 case WM_COMMAND:
ccc2d29c 4571 command:
fbd6baed 4572 wmsg.dwModifiers = w32_get_modifiers ();
ee78dc32
GV		 4573 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4574 goto dflt;
8847d890
RS		 4575
4576 case WM_CLOSE:
fbd6baed 4577 wmsg.dwModifiers = w32_get_modifiers ();
8847d890
RS		 4578 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4579 return 0;
4580
ee78dc32
GV		 4581 case WM_WINDOWPOSCHANGING:
4582 {
4583 WINDOWPLACEMENT wp;
4584 LPWINDOWPOS lppos = (WINDOWPOS *) lParam;
1edf84e7
GV		 4585
4586 wp.length = sizeof (WINDOWPLACEMENT);
ee78dc32
GV		 4587 GetWindowPlacement (hwnd, &wp);
4588
1edf84e7 4589 if (wp.showCmd != SW_SHOWMINIMIZED && (lppos->flags & SWP_NOSIZE) == 0)
ee78dc32
GV		 4590 {
4591 RECT rect;
4592 int wdiff;
4593 int hdiff;
1edf84e7
GV		 4594 DWORD font_width;
4595 DWORD line_height;
4596 DWORD internal_border;
4597 DWORD scrollbar_extra;
ee78dc32
GV		 4598 RECT wr;
4599
5ac45f98 4600 wp.length = sizeof(wp);
ee78dc32
GV		 4601 GetWindowRect (hwnd, &wr);
4602
3c190163 4603 enter_crit ();
ee78dc32 4604
1edf84e7
GV		 4605 font_width = GetWindowLong (hwnd, WND_FONTWIDTH_INDEX);
4606 line_height = GetWindowLong (hwnd, WND_LINEHEIGHT_INDEX);
4607 internal_border = GetWindowLong (hwnd, WND_BORDER_INDEX);
4608 scrollbar_extra = GetWindowLong (hwnd, WND_SCROLLBAR_INDEX);
ee78dc32 4609
3c190163 4610 leave_crit ();
ee78dc32
GV		 4611
4612 memset (&rect, 0, sizeof (rect));
4613 AdjustWindowRect (&rect, GetWindowLong (hwnd, GWL_STYLE),
4614 GetMenu (hwnd) != NULL);
4615
1edf84e7
GV		 4616 /* Force width and height of client area to be exact
4617 multiples of the character cell dimensions. */
4618 wdiff = (lppos->cx - (rect.right - rect.left)
4619 - 2 * internal_border - scrollbar_extra)
4620 % font_width;
4621 hdiff = (lppos->cy - (rect.bottom - rect.top)
4622 - 2 * internal_border)
4623 % line_height;
ee78dc32
GV		 4624
4625 if (wdiff || hdiff)
4626 {
4627 /* For right/bottom sizing we can just fix the sizes.
4628 However for top/left sizing we will need to fix the X
4629 and Y positions as well. */
4630
4631 lppos->cx -= wdiff;
4632 lppos->cy -= hdiff;
4633
4634 if (wp.showCmd != SW_SHOWMAXIMIZED
1edf84e7 4635 && (lppos->flags & SWP_NOMOVE) == 0)
ee78dc32
GV		 4636 {
4637 if (lppos->x != wr.left || lppos->y != wr.top)
4638 {
4639 lppos->x += wdiff;
4640 lppos->y += hdiff;
4641 }
4642 else
4643 {
4644 lppos->flags |= SWP_NOMOVE;
4645 }
4646 }
4647
1edf84e7 4648 return 0;
ee78dc32
GV		 4649 }
4650 }
4651 }
ee78dc32
GV		 4652
4653 goto dflt;
1edf84e7 4654
b1f918f8
GV		 4655 case WM_GETMINMAXINFO:
4656 /* Hack to correct bug that allows Emacs frames to be resized
4657 below the Minimum Tracking Size. */
4658 ((LPMINMAXINFO) lParam)->ptMinTrackSize.y++;
4659 return 0;
4660
1edf84e7
GV		 4661 case WM_EMACS_CREATESCROLLBAR:
4662 return (LRESULT) w32_createscrollbar ((struct frame *) wParam,
4663 (struct scroll_bar *) lParam);
4664
5ac45f98 4665 case WM_EMACS_SHOWWINDOW:
1edf84e7
GV		 4666 return ShowWindow ((HWND) wParam, (WPARAM) lParam);
4667
dfdb4047 4668 case WM_EMACS_SETFOREGROUND:
ce6059da
AI		 4669 {
4670 HWND foreground_window;
4671 DWORD foreground_thread, retval;
4672
4673 /* On NT 5.0, and apparently Windows 98, it is necessary to
4674 attach to the thread that currently has focus in order to
4675 pull the focus away from it. */
4676 foreground_window = GetForegroundWindow ();
4677 foreground_thread = GetWindowThreadProcessId (foreground_window, NULL);
4678 if (!foreground_window
4679 || foreground_thread == GetCurrentThreadId ()
4680 || !AttachThreadInput (GetCurrentThreadId (),
4681 foreground_thread, TRUE))
4682 foreground_thread = 0;
4683
4684 retval = SetForegroundWindow ((HWND) wParam);
4685
4686 /* Detach from the previous foreground thread. */
4687 if (foreground_thread)
4688 AttachThreadInput (GetCurrentThreadId (),
4689 foreground_thread, FALSE);
4690
4691 return retval;
4692 }
dfdb4047 4693
5ac45f98
GV		 4694 case WM_EMACS_SETWINDOWPOS:
4695 {
1edf84e7
GV		 4696 WINDOWPOS * pos = (WINDOWPOS *) wParam;
4697 return SetWindowPos (hwnd, pos->hwndInsertAfter,
5ac45f98
GV		 4698 pos->x, pos->y, pos->cx, pos->cy, pos->flags);
4699 }
1edf84e7 4700
ee78dc32 4701 case WM_EMACS_DESTROYWINDOW:
cb9e33d4 4702 DragAcceptFiles ((HWND) wParam, FALSE);
1edf84e7
GV		 4703 return DestroyWindow ((HWND) wParam);
4704
4705 case WM_EMACS_TRACKPOPUPMENU:
4706 {
4707 UINT flags;
4708 POINT *pos;
4709 int retval;
4710 pos = (POINT *)lParam;
4711 flags = TPM_CENTERALIGN;
4712 if (button_state & LMOUSE)
4713 flags |= TPM_LEFTBUTTON;
4714 else if (button_state & RMOUSE)
4715 flags |= TPM_RIGHTBUTTON;
4716
87996783
GV		 4717 /* Remember we did a SetCapture on the initial mouse down event,
4718 so for safety, we make sure the capture is cancelled now. */
4719 ReleaseCapture ();
490822ff 4720 button_state = 0;
87996783 4721
1edf84e7
GV		 4722 /* Use menubar_active to indicate that WM_INITMENU is from
4723 TrackPopupMenu below, and should be ignored. */
4724 f = x_window_to_frame (dpyinfo, hwnd);
4725 if (f)
4726 f->output_data.w32->menubar_active = 1;
4727
4728 if (TrackPopupMenu ((HMENU)wParam, flags, pos->x, pos->y,
4729 0, hwnd, NULL))
4730 {
4731 MSG amsg;
4732 /* Eat any mouse messages during popupmenu */
4733 while (PeekMessage (&amsg, hwnd, WM_MOUSEFIRST, WM_MOUSELAST,
4734 PM_REMOVE));
4735 /* Get the menu selection, if any */
4736 if (PeekMessage (&amsg, hwnd, WM_COMMAND, WM_COMMAND, PM_REMOVE))
4737 {
4738 retval = LOWORD (amsg.wParam);
4739 }
4740 else
4741 {
4742 retval = 0;
4743 }
1edf84e7
GV		 4744 }
4745 else
4746 {
4747 retval = -1;
4748 }
4749
4750 return retval;
4751 }
4752
ee78dc32 4753 default:
93fbe8b7
GV		 4754 /* Check for messages registered at runtime. */
4755 if (msg == msh_mousewheel)
4756 {
4757 wmsg.dwModifiers = w32_get_modifiers ();
4758 my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
4759 return 0;
4760 }
4761
ee78dc32
GV		 4762 dflt:
4763 return DefWindowProc (hwnd, msg, wParam, lParam);
4764 }
4765
1edf84e7
GV		 4766
4767 /* The most common default return code for handled messages is 0. */
4768 return 0;
ee78dc32
GV		 4769}
4770
4771void
4772my_create_window (f)
4773 struct frame * f;
4774{
4775 MSG msg;
4776
1edf84e7
GV		 4777 if (!PostThreadMessage (dwWindowsThreadId, WM_EMACS_CREATEWINDOW, (WPARAM)f, 0))
4778 abort ();
ee78dc32
GV		 4779 GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
4780}
4781
fbd6baed 4782/* Create and set up the w32 window for frame F. */
ee78dc32
GV		 4783
4784static void
fbd6baed 4785w32_window (f, window_prompting, minibuffer_only)
ee78dc32
GV		 4786 struct frame *f;
4787 long window_prompting;
4788 int minibuffer_only;
4789{
4790 BLOCK_INPUT;
4791
4792 /* Use the resource name as the top-level window name
4793 for looking up resources. Make a non-Lisp copy
4794 for the window manager, so GC relocation won't bother it.
4795
4796 Elsewhere we specify the window name for the window manager. */
4797
4798 {
4799 char *str = (char *) XSTRING (Vx_resource_name)->data;
4800 f->namebuf = (char *) xmalloc (strlen (str) + 1);
4801 strcpy (f->namebuf, str);
4802 }
4803
4804 my_create_window (f);
4805
4806 validate_x_resource_name ();
4807
4808 /* x_set_name normally ignores requests to set the name if the
4809 requested name is the same as the current name. This is the one
4810 place where that assumption isn't correct; f->name is set, but
4811 the server hasn't been told. */
4812 {
4813 Lisp_Object name;
4814 int explicit = f->explicit_name;
4815
4816 f->explicit_name = 0;
4817 name = f->name;
4818 f->name = Qnil;
4819 x_set_name (f, name, explicit);
4820 }
4821
4822 UNBLOCK_INPUT;
4823
4824 if (!minibuffer_only && FRAME_EXTERNAL_MENU_BAR (f))
4825 initialize_frame_menubar (f);
4826
fbd6baed 4827 if (FRAME_W32_WINDOW (f) == 0)
ee78dc32
GV		 4828 error ("Unable to create window");
4829}
4830
4831/* Handle the icon stuff for this window. Perhaps later we might
4832 want an x_set_icon_position which can be called interactively as
4833 well. */
4834
4835static void
4836x_icon (f, parms)
4837 struct frame *f;
4838 Lisp_Object parms;
4839{
4840 Lisp_Object icon_x, icon_y;
4841
e9e23e23 4842 /* Set the position of the icon. Note that Windows 95 groups all
ee78dc32 4843 icons in the tray. */
6fc2811b
JR		 4844 icon_x = w32_get_arg (parms, Qicon_left, 0, 0, RES_TYPE_NUMBER);
4845 icon_y = w32_get_arg (parms, Qicon_top, 0, 0, RES_TYPE_NUMBER);
ee78dc32
GV		 4846 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
4847 {
4848 CHECK_NUMBER (icon_x, 0);
4849 CHECK_NUMBER (icon_y, 0);
4850 }
4851 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
4852 error ("Both left and top icon corners of icon must be specified");
4853
4854 BLOCK_INPUT;
4855
4856 if (! EQ (icon_x, Qunbound))
4857 x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y));
4858
1edf84e7
GV		 4859#if 0 /* TODO */
4860 /* Start up iconic or window? */
4861 x_wm_set_window_state
6fc2811b 4862 (f, (EQ (w32_get_arg (parms, Qvisibility, 0, 0, RES_TYPE_SYMBOL), Qicon)
1edf84e7
GV		 4863 ? IconicState
4864 : NormalState));
4865
4866 x_text_icon (f, (char *) XSTRING ((!NILP (f->icon_name)
4867 ? f->icon_name
4868 : f->name))->data);
4869#endif
4870
ee78dc32
GV		 4871 UNBLOCK_INPUT;
4872}
4873
6fc2811b
JR		 4874
4875static void
4876x_make_gc (f)
4877 struct frame *f;
4878{
4879 XGCValues gc_values;
4880
4881 BLOCK_INPUT;
4882
4883 /* Create the GC's of this frame.
4884 Note that many default values are used. */
4885
4886 /* Normal video */
4887 gc_values.font = f->output_data.w32->font;
4888
4889 /* Cursor has cursor-color background, background-color foreground. */
4890 gc_values.foreground = FRAME_BACKGROUND_PIXEL (f);
4891 gc_values.background = f->output_data.w32->cursor_pixel;
4892 f->output_data.w32->cursor_gc
4893 = XCreateGC (NULL, FRAME_W32_WINDOW (f),
4894 (GCFont | GCForeground | GCBackground),
4895 &gc_values);
4896
4897 /* Reliefs. */
4898 f->output_data.w32->white_relief.gc = 0;
4899 f->output_data.w32->black_relief.gc = 0;
4900
4901 UNBLOCK_INPUT;
4902}
4903
4904
ee78dc32
GV		 4905DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
4906 1, 1, 0,
4907 "Make a new window, which is called a \"frame\" in Emacs terms.\n\
4908Returns an Emacs frame object.\n\
4909ALIST is an alist of frame parameters.\n\
4910If the parameters specify that the frame should not have a minibuffer,\n\
4911and do not specify a specific minibuffer window to use,\n\
4912then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
4913be shared by the new frame.\n\
4914\n\
4915This function is an internal primitive--use `make-frame' instead.")
4916 (parms)
4917 Lisp_Object parms;
4918{
4919 struct frame *f;
4920 Lisp_Object frame, tem;
4921 Lisp_Object name;
4922 int minibuffer_only = 0;
4923 long window_prompting = 0;
4924 int width, height;
4925 int count = specpdl_ptr - specpdl;
1edf84e7 4926 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
ee78dc32 4927 Lisp_Object display;
6fc2811b 4928 struct w32_display_info *dpyinfo = NULL;
ee78dc32
GV		 4929 Lisp_Object parent;
4930 struct kboard *kb;
4931
4587b026
GV		 4932 check_w32 ();
4933
ee78dc32
GV		 4934 /* Use this general default value to start with
4935 until we know if this frame has a specified name. */
4936 Vx_resource_name = Vinvocation_name;
4937
6fc2811b 4938 display = w32_get_arg (parms, Qdisplay, 0, 0, RES_TYPE_STRING);
ee78dc32
GV		 4939 if (EQ (display, Qunbound))
4940 display = Qnil;
4941 dpyinfo = check_x_display_info (display);
4942#ifdef MULTI_KBOARD
4943 kb = dpyinfo->kboard;
4944#else
4945 kb = &the_only_kboard;
4946#endif
4947
6fc2811b 4948 name = w32_get_arg (parms, Qname, "name", "Name", RES_TYPE_STRING);
ee78dc32
GV		 4949 if (!STRINGP (name)
4950 && ! EQ (name, Qunbound)
4951 && ! NILP (name))
4952 error ("Invalid frame name--not a string or nil");
4953
4954 if (STRINGP (name))
4955 Vx_resource_name = name;
4956
4957 /* See if parent window is specified. */
6fc2811b 4958 parent = w32_get_arg (parms, Qparent_id, NULL, NULL, RES_TYPE_NUMBER);
ee78dc32
GV		 4959 if (EQ (parent, Qunbound))
4960 parent = Qnil;
4961 if (! NILP (parent))
4962 CHECK_NUMBER (parent, 0);
4963
1edf84e7
GV		 4964 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
4965 /* No need to protect DISPLAY because that's not used after passing
4966 it to make_frame_without_minibuffer. */
4967 frame = Qnil;
4968 GCPRO4 (parms, parent, name, frame);
6fc2811b 4969 tem = w32_get_arg (parms, Qminibuffer, 0, 0, RES_TYPE_SYMBOL);
ee78dc32
GV		 4970 if (EQ (tem, Qnone) || NILP (tem))
4971 f = make_frame_without_minibuffer (Qnil, kb, display);
4972 else if (EQ (tem, Qonly))
4973 {
4974 f = make_minibuffer_frame ();
4975 minibuffer_only = 1;
4976 }
4977 else if (WINDOWP (tem))
4978 f = make_frame_without_minibuffer (tem, kb, display);
4979 else
4980 f = make_frame (1);
4981
1edf84e7
GV		 4982 XSETFRAME (frame, f);
4983
ee78dc32
GV		 4984 /* Note that Windows does support scroll bars. */
4985 FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
5ac45f98
GV		 4986 /* By default, make scrollbars the system standard width. */
4987 f->scroll_bar_pixel_width = GetSystemMetrics (SM_CXVSCROLL);
ee78dc32 4988
fbd6baed 4989 f->output_method = output_w32;
6fc2811b
JR		 4990 f->output_data.w32 =
4991 (struct w32_output *) xmalloc (sizeof (struct w32_output));
fbd6baed 4992 bzero (f->output_data.w32, sizeof (struct w32_output));
ee78dc32 4993
4587b026
GV		 4994 FRAME_FONTSET (f) = -1;
4995
1edf84e7 4996 f->icon_name
6fc2811b 4997 = w32_get_arg (parms, Qicon_name, "iconName", "Title", RES_TYPE_STRING);
1edf84e7
GV		 4998 if (! STRINGP (f->icon_name))
4999 f->icon_name = Qnil;
5000
fbd6baed 5001/* FRAME_W32_DISPLAY_INFO (f) = dpyinfo; */
ee78dc32
GV		 5002#ifdef MULTI_KBOARD
5003 FRAME_KBOARD (f) = kb;
5004#endif
5005
5006 /* Specify the parent under which to make this window. */
5007
5008 if (!NILP (parent))
5009 {
fbd6baed
GV		 5010 f->output_data.w32->parent_desc = (Window) parent;
5011 f->output_data.w32->explicit_parent = 1;
ee78dc32
GV		 5012 }
5013 else
5014 {
fbd6baed
GV		 5015 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
5016 f->output_data.w32->explicit_parent = 0;
ee78dc32
GV		 5017 }
5018
ee78dc32
GV		 5019 /* Set the name; the functions to which we pass f expect the name to
5020 be set. */
5021 if (EQ (name, Qunbound) || NILP (name))
5022 {
fbd6baed 5023 f->name = build_string (dpyinfo->w32_id_name);
ee78dc32
GV		 5024 f->explicit_name = 0;
5025 }
5026 else
5027 {
5028 f->name = name;
5029 f->explicit_name = 1;
5030 /* use the frame's title when getting resources for this frame. */
5031 specbind (Qx_resource_name, name);
5032 }
5033
4587b026 5034 /* Create fontsets from `global_fontset_alist' before handling fonts. */
8e713be6
KR		 5035 for (tem = Vglobal_fontset_alist; CONSP (tem); tem = XCDR (tem))
5036 fs_register_fontset (f, XCAR (tem));
4587b026 5037
ee78dc32
GV		 5038 /* Extract the window parameters from the supplied values
5039 that are needed to determine window geometry. */
5040 {
5041 Lisp_Object font;
5042
6fc2811b
JR		 5043 font = w32_get_arg (parms, Qfont, "font", "Font", RES_TYPE_STRING);
5044
ee78dc32
GV		 5045 BLOCK_INPUT;
5046 /* First, try whatever font the caller has specified. */
5047 if (STRINGP (font))
4587b026
GV		 5048 {
5049 tem = Fquery_fontset (font, Qnil);
5050 if (STRINGP (tem))
5051 font = x_new_fontset (f, XSTRING (tem)->data);
5052 else
1075afa9 5053 font = x_new_font (f, XSTRING (font)->data);
4587b026 5054 }
ee78dc32
GV		 5055 /* Try out a font which we hope has bold and italic variations. */
5056 if (!STRINGP (font))
4587b026 5057 font = x_new_font (f, "-*-Courier New-normal-r-*-*-13-*-*-*-c-*-iso8859-1");
ee78dc32 5058 if (! STRINGP (font))
6fc2811b 5059 font = x_new_font (f, "-*-Courier-normal-r-*-*-13-*-*-*-c-*-iso8859-1");
ee78dc32
GV		 5060 /* If those didn't work, look for something which will at least work. */
5061 if (! STRINGP (font))
6fc2811b 5062 font = x_new_font (f, "-*-Fixedsys-normal-r-*-*-12-*-*-*-c-*-iso8859-1");
ee78dc32
GV		 5063 UNBLOCK_INPUT;
5064 if (! STRINGP (font))
1edf84e7 5065 font = build_string ("Fixedsys");
ee78dc32
GV		 5066
5067 x_default_parameter (f, parms, Qfont, font,
6fc2811b 5068 "font", "Font", RES_TYPE_STRING);
ee78dc32
GV		 5069 }
5070
5071 x_default_parameter (f, parms, Qborder_width, make_number (2),
6fc2811b 5072 "borderwidth", "BorderWidth", RES_TYPE_NUMBER);
ee78dc32
GV		 5073 /* This defaults to 2 in order to match xterm. We recognize either
5074 internalBorderWidth or internalBorder (which is what xterm calls
5075 it). */
5076 if (NILP (Fassq (Qinternal_border_width, parms)))
5077 {
5078 Lisp_Object value;
5079
6fc2811b
JR		 5080 value = w32_get_arg (parms, Qinternal_border_width,
5081 "internalBorder", "BorderWidth", RES_TYPE_NUMBER);
ee78dc32
GV		 5082 if (! EQ (value, Qunbound))
5083 parms = Fcons (Fcons (Qinternal_border_width, value),
5084 parms);
5085 }
1edf84e7 5086 /* Default internalBorderWidth to 0 on Windows to match other programs. */
ee78dc32 5087 x_default_parameter (f, parms, Qinternal_border_width, make_number (0),
6fc2811b 5088 "internalBorderWidth", "BorderWidth", RES_TYPE_NUMBER);
ee78dc32 5089 x_default_parameter (f, parms, Qvertical_scroll_bars, Qt,
6fc2811b 5090 "verticalScrollBars", "ScrollBars", RES_TYPE_BOOLEAN);
ee78dc32
GV		 5091
5092 /* Also do the stuff which must be set before the window exists. */
5093 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
6fc2811b 5094 "foreground", "Foreground", RES_TYPE_STRING);
ee78dc32 5095 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
6fc2811b 5096 "background", "Background", RES_TYPE_STRING);
ee78dc32 5097 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
6fc2811b 5098 "pointerColor", "Foreground", RES_TYPE_STRING);
ee78dc32 5099 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
6fc2811b 5100 "cursorColor", "Foreground", RES_TYPE_STRING);
ee78dc32 5101 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
6fc2811b
JR		 5102 "borderColor", "BorderColor", RES_TYPE_STRING);
5103 x_default_parameter (f, parms, Qscreen_gamma, Qnil,
5104 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT);
5105
ee78dc32 5106
6fc2811b
JR		 5107 /* Init faces before x_default_parameter is called for scroll-bar
5108 parameters because that function calls x_set_scroll_bar_width,
5109 which calls change_frame_size, which calls Fset_window_buffer,
5110 which runs hooks, which call Fvertical_motion. At the end, we
5111 end up in init_iterator with a null face cache, which should not
5112 happen. */
5113 init_frame_faces (f);
5114
ee78dc32 5115 x_default_parameter (f, parms, Qmenu_bar_lines, make_number (1),
6fc2811b
JR		 5116 "menuBar", "MenuBar", RES_TYPE_NUMBER);
5117 x_default_parameter (f, parms, Qtool_bar_lines, make_number (0),
5118 "toolBar", "ToolBar", RES_TYPE_NUMBER);
1edf84e7 5119 x_default_parameter (f, parms, Qbuffer_predicate, Qnil,
6fc2811b 5120 "bufferPredicate", "BufferPredicate", RES_TYPE_SYMBOL);
1edf84e7 5121 x_default_parameter (f, parms, Qtitle, Qnil,
6fc2811b 5122 "title", "Title", RES_TYPE_STRING);
ee78dc32 5123
fbd6baed
GV		 5124 f->output_data.w32->dwStyle = WS_OVERLAPPEDWINDOW;
5125 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
ee78dc32
GV		 5126 window_prompting = x_figure_window_size (f, parms);
5127
5128 if (window_prompting & XNegative)
5129 {
5130 if (window_prompting & YNegative)
fbd6baed 5131 f->output_data.w32->win_gravity = SouthEastGravity;
ee78dc32 5132 else
fbd6baed 5133 f->output_data.w32->win_gravity = NorthEastGravity;
ee78dc32
GV		 5134 }
5135 else
5136 {
5137 if (window_prompting & YNegative)
fbd6baed 5138 f->output_data.w32->win_gravity = SouthWestGravity;
ee78dc32 5139 else
fbd6baed 5140 f->output_data.w32->win_gravity = NorthWestGravity;
ee78dc32
GV		 5141 }
5142
fbd6baed 5143 f->output_data.w32->size_hint_flags = window_prompting;
ee78dc32 5144
6fc2811b
JR		 5145 tem = w32_get_arg (parms, Qunsplittable, 0, 0, RES_TYPE_BOOLEAN);
5146 f->no_split = minibuffer_only || EQ (tem, Qt);
5147
5148 /* Create the window. Add the tool-bar height to the initial frame
5149 height so that the user gets a text display area of the size he
5150 specified with -g or via the registry. Later changes of the
5151 tool-bar height don't change the frame size. This is done so that
5152 users can create tall Emacs frames without having to guess how
5153 tall the tool-bar will get. */
5154 f->height += FRAME_TOOL_BAR_LINES (f);
fbd6baed 5155 w32_window (f, window_prompting, minibuffer_only);
ee78dc32 5156 x_icon (f, parms);
6fc2811b
JR		 5157
5158 x_make_gc (f);
5159
5160 /* Now consider the frame official. */
5161 FRAME_W32_DISPLAY_INFO (f)->reference_count++;
5162 Vframe_list = Fcons (frame, Vframe_list);
ee78dc32
GV		 5163
5164 /* We need to do this after creating the window, so that the
5165 icon-creation functions can say whose icon they're describing. */
5166 x_default_parameter (f, parms, Qicon_type, Qnil,
6fc2811b 5167 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL);
ee78dc32
GV		 5168
5169 x_default_parameter (f, parms, Qauto_raise, Qnil,
6fc2811b 5170 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
ee78dc32 5171 x_default_parameter (f, parms, Qauto_lower, Qnil,
6fc2811b 5172 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
ee78dc32 5173 x_default_parameter (f, parms, Qcursor_type, Qbox,
6fc2811b
JR		 5174 "cursorType", "CursorType", RES_TYPE_SYMBOL);
5175 x_default_parameter (f, parms, Qscroll_bar_width, Qnil,
5176 "scrollBarWidth", "ScrollBarWidth", RES_TYPE_NUMBER);
ee78dc32
GV		 5177
5178 /* Dimensions, especially f->height, must be done via change_frame_size.
5179 Change will not be effected unless different from the current
5180 f->height. */
5181 width = f->width;
5182 height = f->height;
1026b400
RS		 5183 f->height = 0;
5184 SET_FRAME_WIDTH (f, 0);
6fc2811b
JR		 5185 change_frame_size (f, height, width, 1, 0, 0);
5186
5187 /* Set up faces after all frame parameters are known. */
5188 call1 (Qface_set_after_frame_default, frame);
ee78dc32 5189
6fc2811b
JR		 5190 /* Tell the server what size and position, etc, we want, and how
5191 badly we want them. This should be done after we have the menu
5192 bar so that its size can be taken into account. */
ee78dc32
GV		 5193 BLOCK_INPUT;
5194 x_wm_set_size_hint (f, window_prompting, 0);
5195 UNBLOCK_INPUT;
5196
6fc2811b
JR		 5197 /* Make the window appear on the frame and enable display, unless
5198 the caller says not to. However, with explicit parent, Emacs
5199 cannot control visibility, so don't try. */
fbd6baed 5200 if (! f->output_data.w32->explicit_parent)
ee78dc32
GV		 5201 {
5202 Lisp_Object visibility;
5203
6fc2811b 5204 visibility = w32_get_arg (parms, Qvisibility, 0, 0, RES_TYPE_SYMBOL);
ee78dc32
GV		 5205 if (EQ (visibility, Qunbound))
5206 visibility = Qt;
5207
5208 if (EQ (visibility, Qicon))
5209 x_iconify_frame (f);
5210 else if (! NILP (visibility))
5211 x_make_frame_visible (f);
5212 else
5213 /* Must have been Qnil. */
5214 ;
5215 }
6fc2811b 5216 UNGCPRO;
ee78dc32
GV		 5217 return unbind_to (count, frame);
5218}
5219
5220/* FRAME is used only to get a handle on the X display. We don't pass the
5221 display info directly because we're called from frame.c, which doesn't
5222 know about that structure. */
5223Lisp_Object
5224x_get_focus_frame (frame)
5225 struct frame *frame;
5226{
fbd6baed 5227 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (frame);
ee78dc32 5228 Lisp_Object xfocus;
fbd6baed 5229 if (! dpyinfo->w32_focus_frame)
ee78dc32
GV		 5230 return Qnil;
5231
fbd6baed 5232 XSETFRAME (xfocus, dpyinfo->w32_focus_frame);
ee78dc32
GV		 5233 return xfocus;
5234}
1edf84e7
GV		 5235
5236DEFUN ("w32-focus-frame", Fw32_focus_frame, Sw32_focus_frame, 1, 1, 0,
5237 "Give FRAME input focus, raising to foreground if necessary.")
5238 (frame)
5239 Lisp_Object frame;
5240{
5241 x_focus_on_frame (check_x_frame (frame));
5242 return Qnil;
5243}
5244
ee78dc32 5245\f
33d52f9c
GV		 5246struct font_info *w32_load_bdf_font (struct frame *f, char *fontname,
5247 int size, char* filename);
5248
4587b026 5249struct font_info *
33d52f9c 5250w32_load_system_font (f,fontname,size)
55dcfc15
AI		 5251 struct frame *f;
5252 char * fontname;
5253 int size;
ee78dc32 5254{
4587b026
GV		 5255 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
5256 Lisp_Object font_names;
5257
4587b026
GV		 5258 /* Get a list of all the fonts that match this name. Once we
5259 have a list of matching fonts, we compare them against the fonts
5260 we already have loaded by comparing names. */
5261 font_names = w32_list_fonts (f, build_string (fontname), size, 100);
5262
5263 if (!NILP (font_names))
3c190163 5264 {
4587b026
GV		 5265 Lisp_Object tail;
5266 int i;
4587b026
GV		 5267
5268 /* First check if any are already loaded, as that is cheaper
5269 than loading another one. */
5270 for (i = 0; i < dpyinfo->n_fonts; i++)
8e713be6 5271 for (tail = font_names; CONSP (tail); tail = XCDR (tail))
6fc2811b
JR		 5272 if (dpyinfo->font_table[i].name
5273 && (!strcmp (dpyinfo->font_table[i].name,
5274 XSTRING (XCAR (tail))->data)
5275 || !strcmp (dpyinfo->font_table[i].full_name,
5276 XSTRING (XCAR (tail))->data)))
4587b026 5277 return (dpyinfo->font_table + i);
6fc2811b 5278
8e713be6 5279 fontname = (char *) XSTRING (XCAR (font_names))->data;
4587b026 5280 }
1075afa9 5281 else if (w32_strict_fontnames)
5ca0cd71
GV		 5282 {
5283 /* If EnumFontFamiliesEx was available, we got a full list of
5284 fonts back so stop now to avoid the possibility of loading a
5285 random font. If we had to fall back to EnumFontFamilies, the
5286 list is incomplete, so continue whether the font we want was
5287 listed or not. */
5288 HMODULE gdi32 = GetModuleHandle ("gdi32.dll");
5289 FARPROC enum_font_families_ex
1075afa9 5290 = GetProcAddress (gdi32, "EnumFontFamiliesExA");
5ca0cd71
GV		 5291 if (enum_font_families_ex)
5292 return NULL;
5293 }
4587b026
GV		 5294
5295 /* Load the font and add it to the table. */
5296 {
33d52f9c 5297 char *full_name, *encoding;
4587b026
GV		 5298 XFontStruct *font;
5299 struct font_info *fontp;
3c190163 5300 LOGFONT lf;
4587b026 5301 BOOL ok;
6fc2811b 5302 int i;
5ac45f98 5303
4587b026 5304 if (!fontname || !x_to_w32_font (fontname, &lf))
3c190163 5305 return (NULL);
5ac45f98 5306
4587b026
GV		 5307 if (!*lf.lfFaceName)
5308 /* If no name was specified for the font, we get a random font
5309 from CreateFontIndirect - this is not particularly
5310 desirable, especially since CreateFontIndirect does not
5311 fill out the missing name in lf, so we never know what we
5312 ended up with. */
5313 return NULL;
5314
3c190163 5315 font = (XFontStruct *) xmalloc (sizeof (XFontStruct));
5ac45f98 5316
33d52f9c
GV		 5317 /* Set bdf to NULL to indicate that this is a Windows font. */
5318 font->bdf = NULL;
5ac45f98 5319
3c190163 5320 BLOCK_INPUT;
5ac45f98
GV		 5321
5322 font->hfont = CreateFontIndirect (&lf);
ee78dc32 5323
1a292d24
AI		 5324 if (font->hfont == NULL)
5325 {
5326 ok = FALSE;
5327 }
5328 else
5329 {
5330 HDC hdc;
5331 HANDLE oldobj;
5332
5333 hdc = GetDC (dpyinfo->root_window);
5334 oldobj = SelectObject (hdc, font->hfont);
5335 ok = GetTextMetrics (hdc, &font->tm);
5336 SelectObject (hdc, oldobj);
5337 ReleaseDC (dpyinfo->root_window, hdc);
6fc2811b
JR		 5338 /* Fill out details in lf according to the font that was
5339 actually loaded. */
5340 lf.lfHeight = font->tm.tmInternalLeading - font->tm.tmHeight;
5341 lf.lfWidth = font->tm.tmAveCharWidth;
5342 lf.lfWeight = font->tm.tmWeight;
5343 lf.lfItalic = font->tm.tmItalic;
5344 lf.lfCharSet = font->tm.tmCharSet;
5345 lf.lfPitchAndFamily = ((font->tm.tmPitchAndFamily & TMPF_FIXED_PITCH)
5346 ? FIXED_PITCH : VARIABLE_PITCH);
5347 lf.lfOutPrecision = ((font->tm.tmPitchAndFamily & TMPF_VECTOR)
5348 ? OUT_STROKE_PRECIS : OUT_STRING_PRECIS);
1a292d24 5349 }
5ac45f98 5350
1a292d24 5351 UNBLOCK_INPUT;
5ac45f98 5352
4587b026
GV		 5353 if (!ok)
5354 {
1a292d24
AI		 5355 w32_unload_font (dpyinfo, font);
5356 return (NULL);
5357 }
ee78dc32 5358
6fc2811b
JR		 5359 /* Find a free slot in the font table. */
5360 for (i = 0; i < dpyinfo->n_fonts; ++i)
5361 if (dpyinfo->font_table[i].name == NULL)
5362 break;
5363
5364 /* If no free slot found, maybe enlarge the font table. */
5365 if (i == dpyinfo->n_fonts
5366 && dpyinfo->n_fonts == dpyinfo->font_table_size)
4587b026 5367 {
6fc2811b
JR		 5368 int sz;
5369 dpyinfo->font_table_size = max (16, 2 * dpyinfo->font_table_size);
5370 sz = dpyinfo->font_table_size * sizeof *dpyinfo->font_table;
4587b026 5371 dpyinfo->font_table
6fc2811b 5372 = (struct font_info *) xrealloc (dpyinfo->font_table, sz);
4587b026
GV		 5373 }
5374
6fc2811b
JR		 5375 fontp = dpyinfo->font_table + i;
5376 if (i == dpyinfo->n_fonts)
5377 ++dpyinfo->n_fonts;
4587b026
GV		 5378
5379 /* Now fill in the slots of *FONTP. */
5380 BLOCK_INPUT;
5381 fontp->font = font;
6fc2811b 5382 fontp->font_idx = i;
4587b026
GV		 5383 fontp->name = (char *) xmalloc (strlen (fontname) + 1);
5384 bcopy (fontname, fontp->name, strlen (fontname) + 1);
5385
5386 /* Work out the font's full name. */
5387 full_name = (char *)xmalloc (100);
5388 if (full_name && w32_to_x_font (&lf, full_name, 100))
5389 fontp->full_name = full_name;
5390 else
5391 {
5392 /* If all else fails - just use the name we used to load it. */
5393 xfree (full_name);
5394 fontp->full_name = fontp->name;
5395 }
5396
5397 fontp->size = FONT_WIDTH (font);
5398 fontp->height = FONT_HEIGHT (font);
5399
5400 /* The slot `encoding' specifies how to map a character
5401 code-points (0x20..0x7F or 0x2020..0x7F7F) of each charset to
5402 the font code-points (0:0x20..0x7F, 1:0xA0..0xFF, 0:0x2020..0x7F7F,
5403 the font code-points (0:0x20..0x7F, 1:0xA0..0xFF,
5404 0:0x2020..0x7F7F, 1:0xA0A0..0xFFFF, 3:0x20A0..0x7FFF, or
5405 2:0xA020..0xFF7F). For the moment, we don't know which charset
6fc2811b 5406 uses this font. So, we set information in fontp->encoding[1]
4587b026
GV		 5407 which is never used by any charset. If mapping can't be
5408 decided, set FONT_ENCODING_NOT_DECIDED. */
33d52f9c
GV		 5409
5410 /* SJIS fonts need to be set to type 4, all others seem to work as
5411 type FONT_ENCODING_NOT_DECIDED. */
5412 encoding = strrchr (fontp->name, '-');
5413 if (encoding && stricmp (encoding+1, "sjis") == 0)
1c885fe1 5414 fontp->encoding[1] = 4;
33d52f9c 5415 else
1c885fe1 5416 fontp->encoding[1] = FONT_ENCODING_NOT_DECIDED;
4587b026
GV		 5417
5418 /* The following three values are set to 0 under W32, which is
5419 what they get set to if XGetFontProperty fails under X. */
5420 fontp->baseline_offset = 0;
5421 fontp->relative_compose = 0;
33d52f9c 5422 fontp->default_ascent = 0;
4587b026 5423
6fc2811b
JR		 5424 /* Set global flag fonts_changed_p to non-zero if the font loaded
5425 has a character with a smaller width than any other character
5426 before, or if the font loaded has a smalle>r height than any
5427 other font loaded before. If this happens, it will make a
5428 glyph matrix reallocation necessary. */
5429 fonts_changed_p = x_compute_min_glyph_bounds (f);
4587b026 5430 UNBLOCK_INPUT;
4587b026
GV		 5431 return fontp;
5432 }
5433}
5434
33d52f9c
GV		 5435/* Load font named FONTNAME of size SIZE for frame F, and return a
5436 pointer to the structure font_info while allocating it dynamically.
5437 If loading fails, return NULL. */
5438struct font_info *
5439w32_load_font (f,fontname,size)
5440struct frame *f;
5441char * fontname;
5442int size;
5443{
5444 Lisp_Object bdf_fonts;
5445 struct font_info *retval = NULL;
5446
5447 bdf_fonts = w32_list_bdf_fonts (build_string (fontname));
5448
5449 while (!retval && CONSP (bdf_fonts))
5450 {
5451 char *bdf_name, *bdf_file;
5452 Lisp_Object bdf_pair;
5453
8e713be6
KR		 5454 bdf_name = XSTRING (XCAR (bdf_fonts))->data;
5455 bdf_pair = Fassoc (XCAR (bdf_fonts), Vw32_bdf_filename_alist);
5456 bdf_file = XSTRING (XCDR (bdf_pair))->data;
33d52f9c
GV		 5457
5458 retval = w32_load_bdf_font (f, bdf_name, size, bdf_file);
5459
8e713be6 5460 bdf_fonts = XCDR (bdf_fonts);
33d52f9c
GV		 5461 }
5462
5463 if (retval)
5464 return retval;
5465
5466 return w32_load_system_font(f, fontname, size);
5467}
5468
5469
ee78dc32 5470void
fbd6baed
GV		 5471w32_unload_font (dpyinfo, font)
5472 struct w32_display_info *dpyinfo;
ee78dc32
GV		 5473 XFontStruct * font;
5474{
5475 if (font)
5476 {
33d52f9c
GV		 5477 if (font->bdf) w32_free_bdf_font (font->bdf);
5478
3c190163 5479 if (font->hfont) DeleteObject(font->hfont);
ee78dc32
GV		 5480 xfree (font);
5481 }
5482}
5483
fbd6baed 5484/* The font conversion stuff between x and w32 */
ee78dc32
GV		 5485
5486/* X font string is as follows (from faces.el)
5487 * (let ((- "[-?]")
5488 * (foundry "[^-]+")
5489 * (family "[^-]+")
5490 * (weight "\\(bold\\|demibold\\|medium\\)") ; 1
5491 * (weight\? "\\([^-]*\\)") ; 1
5492 * (slant "\\([ior]\\)") ; 2
5493 * (slant\? "\\([^-]?\\)") ; 2
5494 * (swidth "\\([^-]*\\)") ; 3
5495 * (adstyle "[^-]*") ; 4
5496 * (pixelsize "[0-9]+")
5497 * (pointsize "[0-9][0-9]+")
5498 * (resx "[0-9][0-9]+")
5499 * (resy "[0-9][0-9]+")
5500 * (spacing "[cmp?*]")
5501 * (avgwidth "[0-9]+")
5502 * (registry "[^-]+")
5503 * (encoding "[^-]+")
5504 * )
5505 * (setq x-font-regexp
5506 * (concat "\\`\\*?[-?*]"
5507 * foundry - family - weight\? - slant\? - swidth - adstyle -
5508 * pixelsize - pointsize - resx - resy - spacing - registry -
5509 * encoding "[-?*]\\*?\\'"
5510 * ))
5511 * (setq x-font-regexp-head
5512 * (concat "\\`[-?*]" foundry - family - weight\? - slant\?
5513 * "\\([-*?]\\|\\'\\)"))
5514 * (setq x-font-regexp-slant (concat - slant -))
5515 * (setq x-font-regexp-weight (concat - weight -))
5516 * nil)
5517 */
5518
5519#define FONT_START "[-?]"
5520#define FONT_FOUNDRY "[^-]+"
5521#define FONT_FAMILY "\\([^-]+\\)" /* 1 */
5522#define FONT_WEIGHT "\\(bold\\|demibold\\|medium\\)" /* 2 */
5523#define FONT_WEIGHT_Q "\\([^-]*\\)" /* 2 */
5524#define FONT_SLANT "\\([ior]\\)" /* 3 */
5525#define FONT_SLANT_Q "\\([^-]?\\)" /* 3 */
5526#define FONT_SWIDTH "\\([^-]*\\)" /* 4 */
5527#define FONT_ADSTYLE "[^-]*"
5528#define FONT_PIXELSIZE "[^-]*"
5529#define FONT_POINTSIZE "\\([0-9][0-9]+\\|\\*\\)" /* 5 */
5530#define FONT_RESX "[0-9][0-9]+"
5531#define FONT_RESY "[0-9][0-9]+"
5532#define FONT_SPACING "[cmp?*]"
5533#define FONT_AVGWIDTH "[0-9]+"
5534#define FONT_REGISTRY "[^-]+"
5535#define FONT_ENCODING "[^-]+"
5536
5537#define FONT_REGEXP ("\\`\\*?[-?*]" \
5538 FONT_FOUNDRY "-" \
5539 FONT_FAMILY "-" \
5540 FONT_WEIGHT_Q "-" \
5541 FONT_SLANT_Q "-" \
5542 FONT_SWIDTH "-" \
5543 FONT_ADSTYLE "-" \
5544 FONT_PIXELSIZE "-" \
5545 FONT_POINTSIZE "-" \
5546 "[-?*]\\|\\'")
5547
5548#define FONT_REGEXP_HEAD ("\\`[-?*]" \
5549 FONT_FOUNDRY "-" \
5550 FONT_FAMILY "-" \
5551 FONT_WEIGHT_Q "-" \
5552 FONT_SLANT_Q \
5553 "\\([-*?]\\|\\'\\)")
5554
5555#define FONT_REGEXP_SLANT "-" FONT_SLANT "-"
5556#define FONT_REGEXP_WEIGHT "-" FONT_WEIGHT "-"
5557
5558LONG
fbd6baed 5559x_to_w32_weight (lpw)
ee78dc32
GV		 5560 char * lpw;
5561{
5562 if (!lpw) return (FW_DONTCARE);
5ac45f98
GV		 5563
5564 if (stricmp (lpw,"heavy") == 0) return FW_HEAVY;
5565 else if (stricmp (lpw,"extrabold") == 0) return FW_EXTRABOLD;
5566 else if (stricmp (lpw,"bold") == 0) return FW_BOLD;
5567 else if (stricmp (lpw,"demibold") == 0) return FW_SEMIBOLD;
1edf84e7 5568 else if (stricmp (lpw,"semibold") == 0) return FW_SEMIBOLD;
5ac45f98
GV		 5569 else if (stricmp (lpw,"medium") == 0) return FW_MEDIUM;
5570 else if (stricmp (lpw,"normal") == 0) return FW_NORMAL;
5571 else if (stricmp (lpw,"light") == 0) return FW_LIGHT;
5572 else if (stricmp (lpw,"extralight") == 0) return FW_EXTRALIGHT;
5573 else if (stricmp (lpw,"thin") == 0) return FW_THIN;
ee78dc32 5574 else
5ac45f98 5575 return FW_DONTCARE;
ee78dc32
GV		 5576}
5577
5ac45f98 5578
ee78dc32 5579char *
fbd6baed 5580w32_to_x_weight (fnweight)
ee78dc32
GV		 5581 int fnweight;
5582{
5ac45f98
GV		 5583 if (fnweight >= FW_HEAVY) return "heavy";
5584 if (fnweight >= FW_EXTRABOLD) return "extrabold";
5585 if (fnweight >= FW_BOLD) return "bold";
03f8fb34 5586 if (fnweight >= FW_SEMIBOLD) return "demibold";
5ac45f98
GV		 5587 if (fnweight >= FW_MEDIUM) return "medium";
5588 if (fnweight >= FW_NORMAL) return "normal";
5589 if (fnweight >= FW_LIGHT) return "light";
5590 if (fnweight >= FW_EXTRALIGHT) return "extralight";
5591 if (fnweight >= FW_THIN) return "thin";
5592 else
5593 return "*";
5594}
5595
5596LONG
fbd6baed 5597x_to_w32_charset (lpcs)
5ac45f98
GV		 5598 char * lpcs;
5599{
5600 if (!lpcs) return (0);
5601
1a292d24
AI		 5602 if (stricmp (lpcs,"ansi") == 0) return ANSI_CHARSET;
5603 else if (stricmp (lpcs,"iso8859-1") == 0) return ANSI_CHARSET;
33d52f9c 5604 else if (stricmp (lpcs, "ms-symbol") == 0) return SYMBOL_CHARSET;
1c885fe1
AI		 5605 /* Map all Japanese charsets to the Windows Shift-JIS charset. */
5606 else if (strnicmp (lpcs, "jis", 3) == 0) return SHIFTJIS_CHARSET;
ce6059da
AI		 5607 /* Map all GB charsets to the Windows GB2312 charset. */
5608 else if (strnicmp (lpcs, "gb2312", 6) == 0) return GB2312_CHARSET;
5609 /* Map all Big5 charsets to the Windows Big5 charset. */
5610 else if (strnicmp (lpcs, "big5", 4) == 0) return CHINESEBIG5_CHARSET;
33d52f9c 5611 else if (stricmp (lpcs, "ksc5601.1987") == 0) return HANGEUL_CHARSET;
33d52f9c 5612 else if (stricmp (lpcs, "ms-oem") == 0) return OEM_CHARSET;
4587b026
GV		 5613
5614#ifdef EASTEUROPE_CHARSET
5615 else if (stricmp (lpcs, "iso8859-2") == 0) return EASTEUROPE_CHARSET;
5616 else if (stricmp (lpcs, "iso8859-3") == 0) return TURKISH_CHARSET;
5617 else if (stricmp (lpcs, "iso8859-4") == 0) return BALTIC_CHARSET;
5618 else if (stricmp (lpcs, "iso8859-5") == 0) return RUSSIAN_CHARSET;
5619 else if (stricmp (lpcs, "koi8") == 0) return RUSSIAN_CHARSET;
5620 else if (stricmp (lpcs, "iso8859-6") == 0) return ARABIC_CHARSET;
5621 else if (stricmp (lpcs, "iso8859-7") == 0) return GREEK_CHARSET;
5622 else if (stricmp (lpcs, "iso8859-8") == 0) return HEBREW_CHARSET;
a4e691ee 5623 else if (stricmp (lpcs, "iso8859-9") == 0) return TURKISH_CHARSET;
ce6059da
AI		 5624#ifndef VIETNAMESE_CHARSET
5625#define VIETNAMESE_CHARSET 163
5626#endif
5627 /* Map all Viscii charsets to the Windows Vietnamese charset. */
5628 else if (strnicmp (lpcs, "viscii", 6) == 0) return VIETNAMESE_CHARSET;
5629 else if (strnicmp (lpcs, "vscii", 5) == 0) return VIETNAMESE_CHARSET;
5630 /* Map all TIS charsets to the Windows Thai charset. */
5631 else if (strnicmp (lpcs, "tis620", 6) == 0) return THAI_CHARSET;
4587b026 5632 else if (stricmp (lpcs, "mac") == 0) return MAC_CHARSET;
33d52f9c 5633 else if (stricmp (lpcs, "ksc5601.1992") == 0) return JOHAB_CHARSET;
ce6059da
AI		 5634 /* For backwards compatibility with previous 20.4 pretests, map
5635 non-specific KSC charsets to the Windows Hangeul charset. */
5636 else if (strnicmp (lpcs, "ksc5601", 7) == 0) return HANGEUL_CHARSET;
33d52f9c 5637 else if (stricmp (lpcs, "johab") == 0) return JOHAB_CHARSET;
4587b026
GV		 5638#endif
5639
5ac45f98 5640#ifdef UNICODE_CHARSET
1a292d24
AI		 5641 else if (stricmp (lpcs,"iso10646") == 0) return UNICODE_CHARSET;
5642 else if (stricmp (lpcs, "unicode") == 0) return UNICODE_CHARSET;
5ac45f98 5643#endif
1a292d24 5644 else if (lpcs[0] == '#') return atoi (lpcs + 1);
5ac45f98 5645 else
1edf84e7 5646 return DEFAULT_CHARSET;
5ac45f98
GV		 5647}
5648
5649char *
fbd6baed 5650w32_to_x_charset (fncharset)
5ac45f98
GV		 5651 int fncharset;
5652{
1edf84e7
GV		 5653 static char buf[16];
5654
5ac45f98
GV		 5655 switch (fncharset)
5656 {
4587b026
GV		 5657 /* ansi is considered iso8859-1, as most modern ansi fonts are. */
5658 case ANSI_CHARSET: return "iso8859-1";
5659 case DEFAULT_CHARSET: return "ascii-*";
33d52f9c 5660 case SYMBOL_CHARSET: return "ms-symbol";
a4e691ee 5661 case SHIFTJIS_CHARSET: return "jisx0208-sjis";
33d52f9c 5662 case HANGEUL_CHARSET: return "ksc5601.1987-*";
4587b026
GV		 5663 case GB2312_CHARSET: return "gb2312-*";
5664 case CHINESEBIG5_CHARSET: return "big5-*";
33d52f9c 5665 case OEM_CHARSET: return "ms-oem";
4587b026
GV		 5666
5667 /* More recent versions of Windows (95 and NT4.0) define more
5668 character sets. */
5669#ifdef EASTEUROPE_CHARSET
5670 case EASTEUROPE_CHARSET: return "iso8859-2";
a4e691ee 5671 case TURKISH_CHARSET: return "iso8859-9";
4587b026 5672 case BALTIC_CHARSET: return "iso8859-4";
33d52f9c
GV		 5673
5674 /* W95 with international support but not IE4 often has the
5675 KOI8-R codepage but not ISO8859-5. */
5676 case RUSSIAN_CHARSET:
5677 if (!IsValidCodePage(28595) && IsValidCodePage(20886))
5678 return "koi8-r";
5679 else
5680 return "iso8859-5";
4587b026
GV		 5681 case ARABIC_CHARSET: return "iso8859-6";
5682 case GREEK_CHARSET: return "iso8859-7";
5683 case HEBREW_CHARSET: return "iso8859-8";
5684 case VIETNAMESE_CHARSET: return "viscii1.1-*";
5685 case THAI_CHARSET: return "tis620-*";
33d52f9c
GV		 5686 case MAC_CHARSET: return "mac-*";
5687 case JOHAB_CHARSET: return "ksc5601.1992-*";
a4e691ee 5688
4587b026
GV		 5689#endif
5690
5ac45f98 5691#ifdef UNICODE_CHARSET
4587b026 5692 case UNICODE_CHARSET: return "iso10646-unicode";
5ac45f98
GV		 5693#endif
5694 }
1edf84e7 5695 /* Encode numerical value of unknown charset. */
4587b026 5696 sprintf (buf, "*-#%u", fncharset);
1edf84e7 5697 return buf;
ee78dc32
GV		 5698}
5699
5700BOOL
fbd6baed 5701w32_to_x_font (lplogfont, lpxstr, len)
ee78dc32
GV		 5702 LOGFONT * lplogfont;
5703 char * lpxstr;
5704 int len;
5705{
6fc2811b 5706 char* fonttype;
f46e6225 5707 char *fontname;
3cb20f4a
RS		 5708 char height_pixels[8];
5709 char height_dpi[8];
5710 char width_pixels[8];
4587b026 5711 char *fontname_dash;
33d52f9c
GV		 5712 int display_resy = one_w32_display_info.height_in;
5713 int display_resx = one_w32_display_info.width_in;
f46e6225
GV		 5714 int bufsz;
5715 struct coding_system coding;
3cb20f4a
RS		 5716
5717 if (!lpxstr) abort ();
ee78dc32 5718
3cb20f4a
RS		 5719 if (!lplogfont)
5720 return FALSE;
5721
6fc2811b
JR		 5722 if (lplogfont->lfOutPrecision == OUT_STRING_PRECIS)
5723 fonttype = "raster";
5724 else if (lplogfont->lfOutPrecision == OUT_STROKE_PRECIS)
5725 fonttype = "outline";
5726 else
5727 fonttype = "unknown";
5728
f46e6225
GV		 5729 setup_coding_system (Fcheck_coding_system (Vw32_system_coding_system),
5730 &coding);
5731 coding.mode |= CODING_MODE_LAST_BLOCK;
5732 bufsz = decoding_buffer_size (&coding, LF_FACESIZE);
5733
5734 fontname = alloca(sizeof(*fontname) * bufsz);
5735 decode_coding (&coding, lplogfont->lfFaceName, fontname,
5736 strlen(lplogfont->lfFaceName), bufsz - 1);
5737 *(fontname + coding.produced) = '\0';
4587b026
GV		 5738
5739 /* Replace dashes with underscores so the dashes are not
f46e6225 5740 misinterpreted. */
4587b026
GV		 5741 fontname_dash = fontname;
5742 while (fontname_dash = strchr (fontname_dash, '-'))
5743 *fontname_dash = '_';
5744
3cb20f4a 5745 if (lplogfont->lfHeight)
ee78dc32 5746 {
3cb20f4a
RS		 5747 sprintf (height_pixels, "%u", abs (lplogfont->lfHeight));
5748 sprintf (height_dpi, "%u",
33d52f9c 5749 abs (lplogfont->lfHeight) * 720 / display_resy);
5ac45f98
GV		 5750 }
5751 else
ee78dc32 5752 {
3cb20f4a
RS		 5753 strcpy (height_pixels, "*");
5754 strcpy (height_dpi, "*");
ee78dc32 5755 }
3cb20f4a
RS		 5756 if (lplogfont->lfWidth)
5757 sprintf (width_pixels, "%u", lplogfont->lfWidth * 10);
5758 else
5759 strcpy (width_pixels, "*");
5760
5761 _snprintf (lpxstr, len - 1,
6fc2811b
JR		 5762 "-%s-%s-%s-%c-normal-normal-%s-%s-%d-%d-%c-%s-%s",
5763 fonttype, /* foundry */
4587b026
GV		 5764 fontname, /* family */
5765 w32_to_x_weight (lplogfont->lfWeight), /* weight */
5766 lplogfont->lfItalic?'i':'r', /* slant */
5767 /* setwidth name */
5768 /* add style name */
5769 height_pixels, /* pixel size */
5770 height_dpi, /* point size */
33d52f9c
GV		 5771 display_resx, /* resx */
5772 display_resy, /* resy */
4587b026
GV		 5773 ((lplogfont->lfPitchAndFamily & 0x3) == VARIABLE_PITCH)
5774 ? 'p' : 'c', /* spacing */
5775 width_pixels, /* avg width */
5776 w32_to_x_charset (lplogfont->lfCharSet) /* charset registry
5777 and encoding*/
3cb20f4a
RS		 5778 );
5779
ee78dc32
GV		 5780 lpxstr[len - 1] = 0; /* just to be sure */
5781 return (TRUE);
5782}
5783
5784BOOL
fbd6baed 5785x_to_w32_font (lpxstr, lplogfont)
ee78dc32
GV		 5786 char * lpxstr;
5787 LOGFONT * lplogfont;
5788{
f46e6225
GV		 5789 struct coding_system coding;
5790
ee78dc32 5791 if (!lplogfont) return (FALSE);
f46e6225 5792
ee78dc32 5793 memset (lplogfont, 0, sizeof (*lplogfont));
5ac45f98 5794
1a292d24 5795 /* Set default value for each field. */
771c47d5 5796#if 1
ee78dc32
GV		 5797 lplogfont->lfOutPrecision = OUT_DEFAULT_PRECIS;
5798 lplogfont->lfClipPrecision = CLIP_DEFAULT_PRECIS;
5799 lplogfont->lfQuality = DEFAULT_QUALITY;
5ac45f98
GV		 5800#else
5801 /* go for maximum quality */
5802 lplogfont->lfOutPrecision = OUT_STROKE_PRECIS;
5803 lplogfont->lfClipPrecision = CLIP_STROKE_PRECIS;
5804 lplogfont->lfQuality = PROOF_QUALITY;
5805#endif
5806
1a292d24
AI		 5807 lplogfont->lfCharSet = DEFAULT_CHARSET;
5808 lplogfont->lfWeight = FW_DONTCARE;
5809 lplogfont->lfPitchAndFamily = DEFAULT_PITCH | FF_DONTCARE;
5810
5ac45f98
GV		 5811 if (!lpxstr)
5812 return FALSE;
5813
5814 /* Provide a simple escape mechanism for specifying Windows font names
5815 * directly -- if font spec does not beginning with '-', assume this
5816 * format:
5817 * "<font name>[:height in pixels[:width in pixels[:weight]]]"
5818 */
ee78dc32 5819
5ac45f98
GV		 5820 if (*lpxstr == '-')
5821 {
33d52f9c
GV		 5822 int fields, tem;
5823 char name[50], weight[20], slant, pitch, pixels[10], height[10],
5824 width[10], resy[10], remainder[20];
5ac45f98 5825 char * encoding;
33d52f9c 5826 int dpi = one_w32_display_info.height_in;
5ac45f98
GV		 5827
5828 fields = sscanf (lpxstr,
33d52f9c
GV		 5829 "-%*[^-]-%49[^-]-%19[^-]-%c-%*[^-]-%*[^-]-%9[^-]-%9[^-]-%*[^-]-%9[^-]-%c-%9[^-]-%19s",
5830 name, weight, &slant, pixels, height, resy, &pitch, width, remainder);
5ac45f98
GV		 5831 if (fields == EOF) return (FALSE);
5832
6fc2811b
JR		 5833 /* If wildcards cover more than one field, we don't know which
5834 field is which, so don't fill any in. */
5835
5836 if (fields < 9)
5837 fields = 0;
5838
5ac45f98
GV		 5839 if (fields > 0 && name[0] != '*')
5840 {
8ea3e054
RS		 5841 int bufsize;
5842 unsigned char *buf;
5843
f46e6225
GV		 5844 setup_coding_system
5845 (Fcheck_coding_system (Vw32_system_coding_system), &coding);
8ea3e054
RS		 5846 bufsize = encoding_buffer_size (&coding, strlen (name));
5847 buf = (unsigned char *) alloca (bufsize);
f46e6225 5848 coding.mode |= CODING_MODE_LAST_BLOCK;
8ea3e054
RS		 5849 encode_coding (&coding, name, buf, strlen (name), bufsize);
5850 if (coding.produced >= LF_FACESIZE)
5851 coding.produced = LF_FACESIZE - 1;
5852 buf[coding.produced] = 0;
5853 strcpy (lplogfont->lfFaceName, buf);
5ac45f98
GV		 5854 }
5855 else
5856 {
6fc2811b 5857 lplogfont->lfFaceName[0] = '\0';
5ac45f98
GV		 5858 }
5859
5860 fields--;
5861
fbd6baed 5862 lplogfont->lfWeight = x_to_w32_weight ((fields > 0 ? weight : ""));
5ac45f98
GV		 5863
5864 fields--;
5865
6fc2811b 5866 if (!NILP (Vw32_enable_synthesized_fonts))
5ac45f98
GV		 5867 lplogfont->lfItalic = (fields > 0 && slant == 'i');
5868
5869 fields--;
5870
5871 if (fields > 0 && pixels[0] != '*')
5872 lplogfont->lfHeight = atoi (pixels);
5873
5874 fields--;
5ac45f98 5875 fields--;
33d52f9c
GV		 5876 if (fields > 0 && resy[0] != '*')
5877 {
6fc2811b 5878 tem = atoi (resy);
33d52f9c
GV		 5879 if (tem > 0) dpi = tem;
5880 }
5ac45f98 5881
33d52f9c
GV		 5882 if (fields > -1 && lplogfont->lfHeight == 0 && height[0] != '*')
5883 lplogfont->lfHeight = atoi (height) * dpi / 720;
5884
5885 if (fields > 0)
5ac45f98
GV		 5886 lplogfont->lfPitchAndFamily =
5887 (fields > 0 && pitch == 'p') ? VARIABLE_PITCH : FIXED_PITCH;
5888
5889 fields--;
5890
5891 if (fields > 0 && width[0] != '*')
5892 lplogfont->lfWidth = atoi (width) / 10;
5893
5894 fields--;
5895
4587b026
GV		 5896 /* Strip the trailing '-' if present. (it shouldn't be, as it
5897 fails the test against xlfn-tight-regexp in fontset.el). */
3c190163 5898 {
5ac45f98
GV		 5899 int len = strlen (remainder);
5900 if (len > 0 && remainder[len-1] == '-')
5901 remainder[len-1] = 0;
ee78dc32 5902 }
5ac45f98
GV		 5903 encoding = remainder;
5904 if (strncmp (encoding, "*-", 2) == 0)
5905 encoding += 2;
fbd6baed 5906 lplogfont->lfCharSet = x_to_w32_charset (fields > 0 ? encoding : "");
5ac45f98
GV		 5907 }
5908 else
5909 {
5910 int fields;
5911 char name[100], height[10], width[10], weight[20];
a1a80b40 5912
5ac45f98
GV		 5913 fields = sscanf (lpxstr,
5914 "%99[^:]:%9[^:]:%9[^:]:%19s",
5915 name, height, width, weight);
5916
5917 if (fields == EOF) return (FALSE);
5918
5919 if (fields > 0)
5920 {
5921 strncpy (lplogfont->lfFaceName,name, LF_FACESIZE);
5922 lplogfont->lfFaceName[LF_FACESIZE-1] = 0;
5923 }
5924 else
5925 {
5926 lplogfont->lfFaceName[0] = 0;
5927 }
5928
5929 fields--;
5930
5931 if (fields > 0)
5932 lplogfont->lfHeight = atoi (height);
5933
5934 fields--;
5935
5936 if (fields > 0)
5937 lplogfont->lfWidth = atoi (width);
5938
5939 fields--;
5940
fbd6baed 5941 lplogfont->lfWeight = x_to_w32_weight ((fields > 0 ? weight : ""));
5ac45f98
GV		 5942 }
5943
5944 /* This makes TrueType fonts work better. */
5945 lplogfont->lfHeight = - abs (lplogfont->lfHeight);
6fc2811b 5946
ee78dc32
GV		 5947 return (TRUE);
5948}
5949
6fc2811b 5950/* Assume parameter 1 is fully qualified, no wildcards. */
ee78dc32 5951BOOL
6fc2811b
JR		 5952w32_font_match (fontname, pattern)
5953 char * fontname;
5954 char * pattern;
ee78dc32 5955{
6fc2811b
JR		 5956 char *regex = alloca (strlen (pattern) * 2);
5957 char *ptr;
ee78dc32 5958
6fc2811b
JR		 5959 ptr = regex;
5960 *ptr++ = '^';
ee78dc32 5961
6fc2811b
JR		 5962 /* Turn pattern into a regexp and do a regexp match. */
5963 for (; *pattern; pattern++)
5964 {
5965 if (*pattern == '?')
5966 *ptr++ = '.';
5967 else if (*pattern == '*')
5968 {
5969 *ptr++ = '.';
5970 *ptr++ = '*';
5971 }
33d52f9c 5972 else
6fc2811b 5973 *ptr++ = *pattern;
ee78dc32 5974 }
6fc2811b
JR		 5975 *ptr = '$';
5976 *(ptr + 1) = '\0';
5977
5978 return (fast_c_string_match_ignore_case (build_string (regex),
5979 fontname) >= 0);
ee78dc32
GV		 5980}
5981
5ca0cd71
GV		 5982/* Callback functions, and a structure holding info they need, for
5983 listing system fonts on W32. We need one set of functions to do the
5984 job properly, but these don't work on NT 3.51 and earlier, so we
5985 have a second set which don't handle character sets properly to
5986 fall back on.
5987
5988 In both cases, there are two passes made. The first pass gets one
5989 font from each family, the second pass lists all the fonts from
5990 each family. */
5991
ee78dc32
GV		 5992typedef struct enumfont_t
5993{
5994 HDC hdc;
5995 int numFonts;
3cb20f4a 5996 LOGFONT logfont;
ee78dc32
GV		 5997 XFontStruct *size_ref;
5998 Lisp_Object *pattern;
ee78dc32
GV		 5999 Lisp_Object *tail;
6000} enumfont_t;
6001
6002int CALLBACK
6003enum_font_cb2 (lplf, lptm, FontType, lpef)
6004 ENUMLOGFONT * lplf;
6005 NEWTEXTMETRIC * lptm;
6006 int FontType;
6007 enumfont_t * lpef;
6008{
1edf84e7 6009 if (lplf->elfLogFont.lfStrikeOut || lplf->elfLogFont.lfUnderline)
ee78dc32
GV		 6010 return (1);
6011
4587b026
GV		 6012 /* Check that the character set matches if it was specified */
6013 if (lpef->logfont.lfCharSet != DEFAULT_CHARSET &&
6014 lplf->elfLogFont.lfCharSet != lpef->logfont.lfCharSet)
6015 return (1);
6016
ee78dc32
GV		 6017 {
6018 char buf[100];
4587b026 6019 Lisp_Object width = Qnil;
ee78dc32 6020
6fc2811b
JR		 6021 /* Truetype fonts do not report their true metrics until loaded */
6022 if (FontType != RASTER_FONTTYPE)
3cb20f4a 6023 {
6fc2811b
JR		 6024 if (!NILP (*(lpef->pattern)))
6025 {
6026 /* Scalable fonts are as big as you want them to be. */
6027 lplf->elfLogFont.lfHeight = lpef->logfont.lfHeight;
6028 lplf->elfLogFont.lfWidth = lpef->logfont.lfWidth;
6029 width = make_number (lpef->logfont.lfWidth);
6030 }
6031 else
6032 {
6033 lplf->elfLogFont.lfHeight = 0;
6034 lplf->elfLogFont.lfWidth = 0;
6035 }
3cb20f4a 6036 }
6fc2811b 6037
f46e6225
GV		 6038 /* Make sure the height used here is the same as everywhere
6039 else (ie character height, not cell height). */
6fc2811b
JR		 6040 if (lplf->elfLogFont.lfHeight > 0)
6041 {
6042 /* lptm can be trusted for RASTER fonts, but not scalable ones. */
6043 if (FontType == RASTER_FONTTYPE)
6044 lplf->elfLogFont.lfHeight = lptm->tmInternalLeading - lptm->tmHeight;
6045 else
6046 lplf->elfLogFont.lfHeight = -lplf->elfLogFont.lfHeight;
6047 }
4587b026 6048
33d52f9c
GV		 6049 if (!w32_to_x_font (&(lplf->elfLogFont), buf, 100))
6050 return (0);
ee78dc32 6051
5ca0cd71
GV		 6052 if (NILP (*(lpef->pattern))
6053 || w32_font_match (buf, XSTRING (*(lpef->pattern))->data))
ee78dc32 6054 {
4587b026 6055 *lpef->tail = Fcons (Fcons (build_string (buf), width), Qnil);
8e713be6 6056 lpef->tail = &(XCDR (*lpef->tail));
ee78dc32
GV		 6057 lpef->numFonts++;
6058 }
6059 }
6fc2811b 6060
ee78dc32
GV		 6061 return (1);
6062}
6063
6064int CALLBACK
6065enum_font_cb1 (lplf, lptm, FontType, lpef)
6066 ENUMLOGFONT * lplf;
6067 NEWTEXTMETRIC * lptm;
6068 int FontType;
6069 enumfont_t * lpef;
6070{
6071 return EnumFontFamilies (lpef->hdc,
6072 lplf->elfLogFont.lfFaceName,
6073 (FONTENUMPROC) enum_font_cb2,
6074 (LPARAM) lpef);
6075}
6076
6077
5ca0cd71
GV		 6078int CALLBACK
6079enum_fontex_cb2 (lplf, lptm, font_type, lpef)
6080 ENUMLOGFONTEX * lplf;
6081 NEWTEXTMETRICEX * lptm;
6082 int font_type;
6083 enumfont_t * lpef;
6084{
6085 /* We are not interested in the extra info we get back from the 'Ex
6086 version - only the fact that we get character set variations
6087 enumerated seperately. */
6088 return enum_font_cb2 ((ENUMLOGFONT *) lplf, (NEWTEXTMETRIC *) lptm,
6089 font_type, lpef);
6090}
6091
6092int CALLBACK
6093enum_fontex_cb1 (lplf, lptm, font_type, lpef)
6094 ENUMLOGFONTEX * lplf;
6095 NEWTEXTMETRICEX * lptm;
6096 int font_type;
6097 enumfont_t * lpef;
6098{
6099 HMODULE gdi32 = GetModuleHandle ("gdi32.dll");
6100 FARPROC enum_font_families_ex
6101 = GetProcAddress ( gdi32, "EnumFontFamiliesExA");
6102 /* We don't really expect EnumFontFamiliesEx to disappear once we
6103 get here, so don't bother handling it gracefully. */
6104 if (enum_font_families_ex == NULL)
6105 error ("gdi32.dll has disappeared!");
6106 return enum_font_families_ex (lpef->hdc,
6107 &lplf->elfLogFont,
6108 (FONTENUMPROC) enum_fontex_cb2,
6109 (LPARAM) lpef, 0);
6110}
6111
4587b026
GV		 6112/* Interface to fontset handler. (adapted from mw32font.c in Meadow
6113 and xterm.c in Emacs 20.3) */
6114
5ca0cd71 6115Lisp_Object w32_list_bdf_fonts (Lisp_Object pattern, int max_names)
33d52f9c
GV		 6116{
6117 char *fontname, *ptnstr;
6118 Lisp_Object list, tem, newlist = Qnil;
55dcfc15 6119 int n_fonts = 0;
33d52f9c
GV		 6120
6121 list = Vw32_bdf_filename_alist;
6122 ptnstr = XSTRING (pattern)->data;
6123
8e713be6 6124 for ( ; CONSP (list); list = XCDR (list))
33d52f9c 6125 {
8e713be6 6126 tem = XCAR (list);
33d52f9c 6127 if (CONSP (tem))
8e713be6 6128 fontname = XSTRING (XCAR (tem))->data;
33d52f9c
GV		 6129 else if (STRINGP (tem))
6130 fontname = XSTRING (tem)->data;
6131 else
6132 continue;
6133
6134 if (w32_font_match (fontname, ptnstr))
5ca0cd71 6135 {
8e713be6 6136 newlist = Fcons (XCAR (tem), newlist);
5ca0cd71
GV		 6137 n_fonts++;
6138 if (n_fonts >= max_names)
6139 break;
6140 }
33d52f9c
GV		 6141 }
6142
6143 return newlist;
6144}
6145
5ca0cd71
GV		 6146Lisp_Object w32_list_synthesized_fonts (FRAME_PTR f, Lisp_Object pattern,
6147 int size, int max_names);
6148
4587b026
GV		 6149/* Return a list of names of available fonts matching PATTERN on frame
6150 F. If SIZE is not 0, it is the size (maximum bound width) of fonts
6151 to be listed. Frame F NULL means we have not yet created any
6152 frame, which means we can't get proper size info, as we don't have
6153 a device context to use for GetTextMetrics.
6154 MAXNAMES sets a limit on how many fonts to match. */
6155
6156Lisp_Object
6157w32_list_fonts (FRAME_PTR f, Lisp_Object pattern, int size, int maxnames )
6158{
6fc2811b 6159 Lisp_Object patterns, key = Qnil, tem, tpat;
4587b026 6160 Lisp_Object list = Qnil, newlist = Qnil, second_best = Qnil;
33d52f9c 6161 struct w32_display_info *dpyinfo = &one_w32_display_info;
5ca0cd71 6162 int n_fonts = 0;
396594fe 6163
4587b026
GV		 6164 patterns = Fassoc (pattern, Valternate_fontname_alist);
6165 if (NILP (patterns))
6166 patterns = Fcons (pattern, Qnil);
6167
8e713be6 6168 for (; CONSP (patterns); patterns = XCDR (patterns))
4587b026
GV		 6169 {
6170 enumfont_t ef;
6171
8e713be6 6172 tpat = XCAR (patterns);
4587b026
GV		 6173
6174 /* See if we cached the result for this particular query.
6175 The cache is an alist of the form:
6176 ((PATTERN (FONTNAME . WIDTH) ...) ...)
6177 */
8e713be6 6178 if (tem = XCDR (dpyinfo->name_list_element),
33d52f9c 6179 !NILP (list = Fassoc (tpat, tem)))
4587b026
GV		 6180 {
6181 list = Fcdr_safe (list);
6182 /* We have a cached list. Don't have to get the list again. */
6183 goto label_cached;
6184 }
6185
6186 BLOCK_INPUT;
6187 /* At first, put PATTERN in the cache. */
6188 list = Qnil;
33d52f9c
GV		 6189 ef.pattern = &tpat;
6190 ef.tail = &list;
4587b026 6191 ef.numFonts = 0;
33d52f9c 6192
5ca0cd71
GV		 6193 /* Use EnumFontFamiliesEx where it is available, as it knows
6194 about character sets. Fall back to EnumFontFamilies for
6195 older versions of NT that don't support the 'Ex function. */
33d52f9c 6196 x_to_w32_font (STRINGP (tpat) ? XSTRING (tpat)->data :
4587b026
GV		 6197 NULL, &ef.logfont);
6198 {
5ca0cd71
GV		 6199 LOGFONT font_match_pattern;
6200 HMODULE gdi32 = GetModuleHandle ("gdi32.dll");
6201 FARPROC enum_font_families_ex
6202 = GetProcAddress ( gdi32, "EnumFontFamiliesExA");
6203
6204 /* We do our own pattern matching so we can handle wildcards. */
6205 font_match_pattern.lfFaceName[0] = 0;
6206 font_match_pattern.lfPitchAndFamily = 0;
6207 /* We can use the charset, because if it is a wildcard it will
6208 be DEFAULT_CHARSET anyway. */
6209 font_match_pattern.lfCharSet = ef.logfont.lfCharSet;
6210
33d52f9c 6211 ef.hdc = GetDC (dpyinfo->root_window);
4587b026 6212
5ca0cd71
GV		 6213 if (enum_font_families_ex)
6214 enum_font_families_ex (ef.hdc,
6215 &font_match_pattern,
6216 (FONTENUMPROC) enum_fontex_cb1,
6217 (LPARAM) &ef, 0);
6218 else
6219 EnumFontFamilies (ef.hdc, NULL, (FONTENUMPROC) enum_font_cb1,
6220 (LPARAM)&ef);
4587b026 6221
33d52f9c 6222 ReleaseDC (dpyinfo->root_window, ef.hdc);
4587b026
GV		 6223 }
6224
6225 UNBLOCK_INPUT;
6226
6227 /* Make a list of the fonts we got back.
6228 Store that in the font cache for the display. */
8e713be6 6229 XCDR (dpyinfo->name_list_element)
33d52f9c 6230 = Fcons (Fcons (tpat, list),
8e713be6 6231 XCDR (dpyinfo->name_list_element));
4587b026
GV		 6232
6233 label_cached:
6234 if (NILP (list)) continue; /* Try the remaining alternatives. */
6235
6236 newlist = second_best = Qnil;
6237
6238 /* Make a list of the fonts that have the right width. */
8e713be6 6239 for (; CONSP (list); list = XCDR (list))
4587b026
GV		 6240 {
6241 int found_size;
8e713be6 6242 tem = XCAR (list);
4587b026
GV		 6243
6244 if (!CONSP (tem))
6245 continue;
8e713be6 6246 if (NILP (XCAR (tem)))
4587b026
GV		 6247 continue;
6248 if (!size)
6249 {
8e713be6 6250 newlist = Fcons (XCAR (tem), newlist);
5ca0cd71
GV		 6251 n_fonts++;
6252 if (n_fonts >= maxnames)
6253 break;
6254 else
6255 continue;
4587b026 6256 }
8e713be6 6257 if (!INTEGERP (XCDR (tem)))
4587b026
GV		 6258 {
6259 /* Since we don't yet know the size of the font, we must
6260 load it and try GetTextMetrics. */
4587b026
GV		 6261 W32FontStruct thisinfo;
6262 LOGFONT lf;
6263 HDC hdc;
6264 HANDLE oldobj;
6265
8e713be6 6266 if (!x_to_w32_font (XSTRING (XCAR (tem))->data, &lf))
4587b026
GV		 6267 continue;
6268
6269 BLOCK_INPUT;
33d52f9c 6270 thisinfo.bdf = NULL;
4587b026
GV		 6271 thisinfo.hfont = CreateFontIndirect (&lf);
6272 if (thisinfo.hfont == NULL)
6273 continue;
6274
6275 hdc = GetDC (dpyinfo->root_window);
6276 oldobj = SelectObject (hdc, thisinfo.hfont);
6277 if (GetTextMetrics (hdc, &thisinfo.tm))
8e713be6 6278 XCDR (tem) = make_number (FONT_WIDTH (&thisinfo));
4587b026 6279 else
8e713be6 6280 XCDR (tem) = make_number (0);
4587b026
GV		 6281 SelectObject (hdc, oldobj);
6282 ReleaseDC (dpyinfo->root_window, hdc);
6283 DeleteObject(thisinfo.hfont);
6284 UNBLOCK_INPUT;
6285 }
8e713be6 6286 found_size = XINT (XCDR (tem));
4587b026 6287 if (found_size == size)
5ca0cd71 6288 {
8e713be6 6289 newlist = Fcons (XCAR (tem), newlist);
5ca0cd71
GV		 6290 n_fonts++;
6291 if (n_fonts >= maxnames)
6292 break;
6293 }
4587b026
GV		 6294 /* keep track of the closest matching size in case
6295 no exact match is found. */
6296 else if (found_size > 0)
6297 {
6298 if (NILP (second_best))
6299 second_best = tem;
5ca0cd71 6300
4587b026
GV		 6301 else if (found_size < size)
6302 {
8e713be6
KR		 6303 if (XINT (XCDR (second_best)) > size
6304 || XINT (XCDR (second_best)) < found_size)
4587b026
GV		 6305 second_best = tem;
6306 }
6307 else
6308 {
8e713be6
KR		 6309 if (XINT (XCDR (second_best)) > size
6310 && XINT (XCDR (second_best)) >
4587b026
GV		 6311 found_size)
6312 second_best = tem;
6313 }
6314 }
6315 }
6316
6317 if (!NILP (newlist))
6318 break;
6319 else if (!NILP (second_best))
6320 {
8e713be6 6321 newlist = Fcons (XCAR (second_best), Qnil);
4587b026
GV		 6322 break;
6323 }
6324 }
6325
33d52f9c 6326 /* Include any bdf fonts. */
5ca0cd71 6327 if (n_fonts < maxnames)
33d52f9c
GV		 6328 {
6329 Lisp_Object combined[2];
5ca0cd71 6330 combined[0] = w32_list_bdf_fonts (pattern, maxnames - n_fonts);
33d52f9c
GV		 6331 combined[1] = newlist;
6332 newlist = Fnconc(2, combined);
6333 }
6334
5ca0cd71
GV		 6335 /* If we can't find a font that matches, check if Windows would be
6336 able to synthesize it from a different style. */
6fc2811b 6337 if (NILP (newlist) && !NILP (Vw32_enable_synthesized_fonts))
5ca0cd71
GV		 6338 newlist = w32_list_synthesized_fonts (f, pattern, size, maxnames);
6339
4587b026
GV		 6340 return newlist;
6341}
6342
5ca0cd71
GV		 6343Lisp_Object
6344w32_list_synthesized_fonts (f, pattern, size, max_names)
6345 FRAME_PTR f;
6346 Lisp_Object pattern;
6347 int size;
6348 int max_names;
6349{
6350 int fields;
6351 char *full_pattn, *new_pattn, foundary[50], family[50], *pattn_part2;
6352 char style[20], slant;
6353 Lisp_Object matches, match, tem, synthed_matches = Qnil;
6354
6355 full_pattn = XSTRING (pattern)->data;
6356
6357 pattn_part2 = alloca (XSTRING (pattern)->size);
6358 /* Allow some space for wildcard expansion. */
6359 new_pattn = alloca (XSTRING (pattern)->size + 100);
6360
6361 fields = sscanf (full_pattn, "-%49[^-]-%49[^-]-%19[^-]-%c-%s",
6362 foundary, family, style, &slant, pattn_part2);
6363 if (fields == EOF || fields < 5)
6364 return Qnil;
6365
6366 /* If the style and slant are wildcards already there is no point
6367 checking again (and we don't want to keep recursing). */
6368 if (*style == '*' && slant == '*')
6369 return Qnil;
6370
6371 sprintf (new_pattn, "-%s-%s-*-*-%s", foundary, family, pattn_part2);
6372
6373 matches = w32_list_fonts (f, build_string (new_pattn), size, max_names);
6374
8e713be6 6375 for ( ; CONSP (matches); matches = XCDR (matches))
5ca0cd71 6376 {
8e713be6 6377 tem = XCAR (matches);
5ca0cd71
GV		 6378 if (!STRINGP (tem))
6379 continue;
6380
6381 full_pattn = XSTRING (tem)->data;
6382 fields = sscanf (full_pattn, "-%49[^-]-%49[^-]-%*[^-]-%*c-%s",
6383 foundary, family, pattn_part2);
6384 if (fields == EOF || fields < 3)
6385 continue;
6386
6387 sprintf (new_pattn, "-%s-%s-%s-%c-%s", foundary, family, style,
6388 slant, pattn_part2);
6389
6390 synthed_matches = Fcons (build_string (new_pattn),
6391 synthed_matches);
6392 }
6393
6394 return synthed_matches;
6395}
6396
6397
4587b026
GV		 6398/* Return a pointer to struct font_info of font FONT_IDX of frame F. */
6399struct font_info *
6400w32_get_font_info (f, font_idx)
6401 FRAME_PTR f;
6402 int font_idx;
6403{
6404 return (FRAME_W32_FONT_TABLE (f) + font_idx);
6405}
6406
6407
6408struct font_info*
6409w32_query_font (struct frame *f, char *fontname)
6410{
6411 int i;
6412 struct font_info *pfi;
6413
6414 pfi = FRAME_W32_FONT_TABLE (f);
6415
6416 for (i = 0; i < one_w32_display_info.n_fonts ;i++, pfi++)
6417 {
6418 if (strcmp(pfi->name, fontname) == 0) return pfi;
6419 }
6420
6421 return NULL;
6422}
6423
6424/* Find a CCL program for a font specified by FONTP, and set the member
6425 `encoder' of the structure. */
6426
6427void
6428w32_find_ccl_program (fontp)
6429 struct font_info *fontp;
6430{
3545439c 6431 Lisp_Object list, elt;
4587b026 6432
8e713be6 6433 for (list = Vfont_ccl_encoder_alist; CONSP (list); list = XCDR (list))
4587b026 6434 {
8e713be6 6435 elt = XCAR (list);
4587b026 6436 if (CONSP (elt)
8e713be6
KR		 6437 && STRINGP (XCAR (elt))
6438 && (fast_c_string_match_ignore_case (XCAR (elt), fontp->name)
4587b026 6439 >= 0))
3545439c
KH		 6440 break;
6441 }
6442 if (! NILP (list))
6443 {
17eedd00
KH		 6444 struct ccl_program *ccl
6445 = (struct ccl_program *) xmalloc (sizeof (struct ccl_program));
3545439c 6446
8e713be6 6447 if (setup_ccl_program (ccl, XCDR (elt)) < 0)
3545439c
KH		 6448 xfree (ccl);
6449 else
6450 fontp->font_encoder = ccl;
4587b026
GV		 6451 }
6452}
6453
6454\f
6fc2811b
JR		 6455DEFUN ("w32-find-bdf-fonts", Fw32_find_bdf_fonts, Sw32_find_bdf_fonts,
6456 1, 1, 0,
6457 "Return a list of BDF fonts in DIR, suitable for appending to\n\
6458w32-bdf-filename-alist. Fonts which do not contain an xfld description\n\
6459will not be included in the list. DIR may be a list of directories.")
6460 (directory)
6461 Lisp_Object directory;
6462{
6463 Lisp_Object list = Qnil;
6464 struct gcpro gcpro1, gcpro2;
ee78dc32 6465
6fc2811b
JR		 6466 if (!CONSP (directory))
6467 return w32_find_bdf_fonts_in_dir (directory);
ee78dc32 6468
6fc2811b 6469 for ( ; CONSP (directory); directory = XCDR (directory))
ee78dc32 6470 {
6fc2811b
JR		 6471 Lisp_Object pair[2];
6472 pair[0] = list;
6473 pair[1] = Qnil;
6474 GCPRO2 (directory, list);
6475 pair[1] = w32_find_bdf_fonts_in_dir( XCAR (directory) );
6476 list = Fnconc( 2, pair );
6477 UNGCPRO;
6478 }
6479 return list;
6480}
ee78dc32 6481
6fc2811b
JR		 6482/* Find BDF files in a specified directory. (use GCPRO when calling,
6483 as this calls lisp to get a directory listing). */
6484Lisp_Object w32_find_bdf_fonts_in_dir( Lisp_Object directory )
6485{
6486 Lisp_Object filelist, list = Qnil;
6487 char fontname[100];
ee78dc32 6488
6fc2811b
JR		 6489 if (!STRINGP(directory))
6490 return Qnil;
ee78dc32 6491
6fc2811b
JR		 6492 filelist = Fdirectory_files (directory, Qt,
6493 build_string (".*\\.[bB][dD][fF]"), Qt);
ee78dc32 6494
6fc2811b 6495 for ( ; CONSP(filelist); filelist = XCDR (filelist))
ee78dc32 6496 {
6fc2811b
JR		 6497 Lisp_Object filename = XCAR (filelist);
6498 if (w32_BDF_to_x_font (XSTRING (filename)->data, fontname, 100))
6499 store_in_alist (&list, build_string (fontname), filename);
6500 }
6501 return list;
6502}
ee78dc32 6503
6fc2811b
JR		 6504\f
6505DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0,
6506 "Return non-nil if color COLOR is supported on frame FRAME.\n\
6507If FRAME is omitted or nil, use the selected frame.")
6508 (color, frame)
6509 Lisp_Object color, frame;
6510{
6511 XColor foo;
6512 FRAME_PTR f = check_x_frame (frame);
ee78dc32 6513
6fc2811b 6514 CHECK_STRING (color, 1);
ee78dc32 6515
6fc2811b
JR		 6516 if (w32_defined_color (f, XSTRING (color)->data, &foo, 0))
6517 return Qt;
6518 else
6519 return Qnil;
6520}
ee78dc32 6521
2d764c78 6522DEFUN ("xw-color-values", Fxw_color_values, Sxw_color_values, 1, 2, 0,
6fc2811b
JR		 6523 "Return a description of the color named COLOR on frame FRAME.\n\
6524The value is a list of integer RGB values--(RED GREEN BLUE).\n\
6525These values appear to range from 0 to 65280 or 65535, depending\n\
6526on the system; white is (65280 65280 65280) or (65535 65535 65535).\n\
6527If FRAME is omitted or nil, use the selected frame.")
ee78dc32
GV		 6528 (color, frame)
6529 Lisp_Object color, frame;
6530{
6fc2811b 6531 XColor foo;
ee78dc32
GV		 6532 FRAME_PTR f = check_x_frame (frame);
6533
6534 CHECK_STRING (color, 1);
6535
6fc2811b 6536 if (w32_defined_color (f, XSTRING (color)->data, &foo, 0))
ee78dc32
GV		 6537 {
6538 Lisp_Object rgb[3];
6539
6fc2811b
JR		 6540 rgb[0] = make_number ((GetRValue (foo.pixel) << 8)
6541 | GetRValue (foo.pixel));
6542 rgb[1] = make_number ((GetGValue (foo.pixel) << 8)
6543 | GetGValue (foo.pixel));
6544 rgb[2] = make_number ((GetBValue (foo.pixel) << 8)
6545 | GetBValue (foo.pixel));
ee78dc32
GV		 6546 return Flist (3, rgb);
6547 }
6548 else
6549 return Qnil;
6550}
6551
2d764c78 6552DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0,
ee78dc32
GV		 6553 "Return t if the X display supports color.\n\
6554The optional argument DISPLAY specifies which display to ask about.\n\
6555DISPLAY should be either a frame or a display name (a string).\n\
6556If omitted or nil, that stands for the selected frame's display.")
6557 (display)
6558 Lisp_Object display;
6559{
fbd6baed 6560 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV		 6561
6562 if ((dpyinfo->n_planes * dpyinfo->n_cbits) <= 2)
6563 return Qnil;
6564
6565 return Qt;
6566}
6567
6568DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p, Sx_display_grayscale_p,
6569 0, 1, 0,
6570 "Return t if the X display supports shades of gray.\n\
6571Note that color displays do support shades of gray.\n\
6572The optional argument DISPLAY specifies which display to ask about.\n\
6573DISPLAY should be either a frame or a display name (a string).\n\
6574If omitted or nil, that stands for the selected frame's display.")
6575 (display)
6576 Lisp_Object display;
6577{
fbd6baed 6578 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV		 6579
6580 if ((dpyinfo->n_planes * dpyinfo->n_cbits) <= 1)
6581 return Qnil;
6582
6583 return Qt;
6584}
6585
6586DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width,
6587 0, 1, 0,
6588 "Returns the width in pixels of the X display DISPLAY.\n\
6589The optional argument DISPLAY specifies which display to ask about.\n\
6590DISPLAY should be either a frame or a display name (a string).\n\
6591If omitted or nil, that stands for the selected frame's display.")
6592 (display)
6593 Lisp_Object display;
6594{
fbd6baed 6595 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV		 6596
6597 return make_number (dpyinfo->width);
6598}
6599
6600DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
6601 Sx_display_pixel_height, 0, 1, 0,
6602 "Returns the height in pixels of the X display DISPLAY.\n\
6603The optional argument DISPLAY specifies which display to ask about.\n\
6604DISPLAY should be either a frame or a display name (a string).\n\
6605If omitted or nil, that stands for the selected frame's display.")
6606 (display)
6607 Lisp_Object display;
6608{
fbd6baed 6609 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV		 6610
6611 return make_number (dpyinfo->height);
6612}
6613
6614DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
6615 0, 1, 0,
6616 "Returns the number of bitplanes of the display DISPLAY.\n\
6617The optional argument DISPLAY specifies which display to ask about.\n\
6618DISPLAY should be either a frame or a display name (a string).\n\
6619If omitted or nil, that stands for the selected frame's display.")
6620 (display)
6621 Lisp_Object display;
6622{
fbd6baed 6623 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV		 6624
6625 return make_number (dpyinfo->n_planes * dpyinfo->n_cbits);
6626}
6627
6628DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
6629 0, 1, 0,
6630 "Returns the number of color cells of the display DISPLAY.\n\
6631The optional argument DISPLAY specifies which display to ask about.\n\
6632DISPLAY should be either a frame or a display name (a string).\n\
6633If omitted or nil, that stands for the selected frame's display.")
6634 (display)
6635 Lisp_Object display;
6636{
fbd6baed 6637 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV		 6638 HDC hdc;
6639 int cap;
6640
5ac45f98
GV		 6641 hdc = GetDC (dpyinfo->root_window);
6642 if (dpyinfo->has_palette)
6643 cap = GetDeviceCaps (hdc,SIZEPALETTE);
6644 else
6645 cap = GetDeviceCaps (hdc,NUMCOLORS);
ee78dc32
GV		 6646
6647 ReleaseDC (dpyinfo->root_window, hdc);
6648
6649 return make_number (cap);
6650}
6651
6652DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
6653 Sx_server_max_request_size,
6654 0, 1, 0,
6655 "Returns the maximum request size of the server of display DISPLAY.\n\
6656The optional argument DISPLAY specifies which display to ask about.\n\
6657DISPLAY should be either a frame or a display name (a string).\n\
6658If omitted or nil, that stands for the selected frame's display.")
6659 (display)
6660 Lisp_Object display;
6661{
fbd6baed 6662 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV		 6663
6664 return make_number (1);
6665}
6666
6667DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
fbd6baed 6668 "Returns the vendor ID string of the W32 system (Microsoft).\n\
ee78dc32
GV		 6669The optional argument DISPLAY specifies which display to ask about.\n\
6670DISPLAY should be either a frame or a display name (a string).\n\
6671If omitted or nil, that stands for the selected frame's display.")
6672 (display)
6673 Lisp_Object display;
6674{
fbd6baed 6675 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV		 6676 char *vendor = "Microsoft Corp.";
6677
6678 if (! vendor) vendor = "";
6679 return build_string (vendor);
6680}
6681
6682DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
6683 "Returns the version numbers of the server of display DISPLAY.\n\
6684The value is a list of three integers: the major and minor\n\
6685version numbers, and the vendor-specific release\n\
6686number. See also the function `x-server-vendor'.\n\n\
6687The optional argument DISPLAY specifies which display to ask about.\n\
6688DISPLAY should be either a frame or a display name (a string).\n\
6689If omitted or nil, that stands for the selected frame's display.")
6690 (display)
6691 Lisp_Object display;
6692{
fbd6baed 6693 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32 6694
fbd6baed
GV		 6695 return Fcons (make_number (w32_major_version),
6696 Fcons (make_number (w32_minor_version), Qnil));
ee78dc32
GV		 6697}
6698
6699DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
6700 "Returns the number of screens on the server of display DISPLAY.\n\
6701The optional argument DISPLAY specifies which display to ask about.\n\
6702DISPLAY should be either a frame or a display name (a string).\n\
6703If omitted or nil, that stands for the selected frame's display.")
6704 (display)
6705 Lisp_Object display;
6706{
fbd6baed 6707 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV		 6708
6709 return make_number (1);
6710}
6711
6712DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, 0,
6713 "Returns the height in millimeters of the X display DISPLAY.\n\
6714The optional argument DISPLAY specifies which display to ask about.\n\
6715DISPLAY should be either a frame or a display name (a string).\n\
6716If omitted or nil, that stands for the selected frame's display.")
6717 (display)
6718 Lisp_Object display;
6719{
fbd6baed 6720 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV		 6721 HDC hdc;
6722 int cap;
6723
5ac45f98 6724 hdc = GetDC (dpyinfo->root_window);
3c190163 6725
ee78dc32 6726 cap = GetDeviceCaps (hdc, VERTSIZE);
3c190163 6727
ee78dc32
GV		 6728 ReleaseDC (dpyinfo->root_window, hdc);
6729
6730 return make_number (cap);
6731}
6732
6733DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
6734 "Returns the width in millimeters of the X display DISPLAY.\n\
6735The optional argument DISPLAY specifies which display to ask about.\n\
6736DISPLAY should be either a frame or a display name (a string).\n\
6737If omitted or nil, that stands for the selected frame's display.")
6738 (display)
6739 Lisp_Object display;
6740{
fbd6baed 6741 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV		 6742
6743 HDC hdc;
6744 int cap;
6745
5ac45f98 6746 hdc = GetDC (dpyinfo->root_window);
3c190163 6747
ee78dc32 6748 cap = GetDeviceCaps (hdc, HORZSIZE);
3c190163 6749
ee78dc32
GV		 6750 ReleaseDC (dpyinfo->root_window, hdc);
6751
6752 return make_number (cap);
6753}
6754
6755DEFUN ("x-display-backing-store", Fx_display_backing_store,
6756 Sx_display_backing_store, 0, 1, 0,
6757 "Returns an indication of whether display DISPLAY does backing store.\n\
6758The value may be `always', `when-mapped', or `not-useful'.\n\
6759The optional argument DISPLAY specifies which display to ask about.\n\
6760DISPLAY should be either a frame or a display name (a string).\n\
6761If omitted or nil, that stands for the selected frame's display.")
6762 (display)
6763 Lisp_Object display;
6764{
6765 return intern ("not-useful");
6766}
6767
6768DEFUN ("x-display-visual-class", Fx_display_visual_class,
6769 Sx_display_visual_class, 0, 1, 0,
6770 "Returns the visual class of the display DISPLAY.\n\
6771The value is one of the symbols `static-gray', `gray-scale',\n\
6772`static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
6773The optional argument DISPLAY specifies which display to ask about.\n\
6774DISPLAY should be either a frame or a display name (a string).\n\
6775If omitted or nil, that stands for the selected frame's display.")
6776 (display)
6777 Lisp_Object display;
6778{
fbd6baed 6779 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32
GV		 6780
6781#if 0
6782 switch (dpyinfo->visual->class)
6783 {
6784 case StaticGray: return (intern ("static-gray"));
6785 case GrayScale: return (intern ("gray-scale"));
6786 case StaticColor: return (intern ("static-color"));
6787 case PseudoColor: return (intern ("pseudo-color"));
6788 case TrueColor: return (intern ("true-color"));
6789 case DirectColor: return (intern ("direct-color"));
6790 default:
6791 error ("Display has an unknown visual class");
6792 }
6793#endif
6794
6795 error ("Display has an unknown visual class");
6796}
6797
6798DEFUN ("x-display-save-under", Fx_display_save_under,
6799 Sx_display_save_under, 0, 1, 0,
6800 "Returns t if the display DISPLAY supports the save-under feature.\n\
6801The optional argument DISPLAY specifies which display to ask about.\n\
6802DISPLAY should be either a frame or a display name (a string).\n\
6803If omitted or nil, that stands for the selected frame's display.")
6804 (display)
6805 Lisp_Object display;
6806{
fbd6baed 6807 struct w32_display_info *dpyinfo = check_x_display_info (display);
ee78dc32 6808
6fc2811b
JR		 6809 return Qnil;
6810}
6811\f
6812int
6813x_pixel_width (f)
6814 register struct frame *f;
6815{
6816 return PIXEL_WIDTH (f);
6817}
6818
6819int
6820x_pixel_height (f)
6821 register struct frame *f;
6822{
6823 return PIXEL_HEIGHT (f);
6824}
6825
6826int
6827x_char_width (f)
6828 register struct frame *f;
6829{
6830 return FONT_WIDTH (f->output_data.w32->font);
6831}
6832
6833int
6834x_char_height (f)
6835 register struct frame *f;
6836{
6837 return f->output_data.w32->line_height;
6838}
6839
6840int
6841x_screen_planes (f)
6842 register struct frame *f;
6843{
6844 return FRAME_W32_DISPLAY_INFO (f)->n_planes;
6845}
6846\f
6847/* Return the display structure for the display named NAME.
6848 Open a new connection if necessary. */
6849
6850struct w32_display_info *
6851x_display_info_for_name (name)
6852 Lisp_Object name;
6853{
6854 Lisp_Object names;
6855 struct w32_display_info *dpyinfo;
6856
6857 CHECK_STRING (name, 0);
6858
6859 for (dpyinfo = &one_w32_display_info, names = w32_display_name_list;
6860 dpyinfo;
6861 dpyinfo = dpyinfo->next, names = XCDR (names))
6862 {
6863 Lisp_Object tem;
6864 tem = Fstring_equal (XCAR (XCAR (names)), name);
6865 if (!NILP (tem))
6866 return dpyinfo;
6867 }
6868
6869 /* Use this general default value to start with. */
6870 Vx_resource_name = Vinvocation_name;
6871
6872 validate_x_resource_name ();
6873
6874 dpyinfo = w32_term_init (name, (unsigned char *)0,
6875 (char *) XSTRING (Vx_resource_name)->data);
6876
6877 if (dpyinfo == 0)
6878 error ("Cannot connect to server %s", XSTRING (name)->data);
6879
6880 w32_in_use = 1;
6881 XSETFASTINT (Vwindow_system_version, 3);
6882
6883 return dpyinfo;
6884}
6885
6886DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
6887 1, 3, 0, "Open a connection to a server.\n\
6888DISPLAY is the name of the display to connect to.\n\
6889Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
6890If the optional third arg MUST-SUCCEED is non-nil,\n\
6891terminate Emacs if we can't open the connection.")
6892 (display, xrm_string, must_succeed)
6893 Lisp_Object display, xrm_string, must_succeed;
6894{
6895 unsigned char *xrm_option;
6896 struct w32_display_info *dpyinfo;
6897
6898 CHECK_STRING (display, 0);
6899 if (! NILP (xrm_string))
6900 CHECK_STRING (xrm_string, 1);
6901
6902 if (! EQ (Vwindow_system, intern ("w32")))
6903 error ("Not using Microsoft Windows");
6904
6905 /* Allow color mapping to be defined externally; first look in user's
6906 HOME directory, then in Emacs etc dir for a file called rgb.txt. */
6907 {
6908 Lisp_Object color_file;
6909 struct gcpro gcpro1;
6910
6911 color_file = build_string("~/rgb.txt");
6912
6913 GCPRO1 (color_file);
6914
6915 if (NILP (Ffile_readable_p (color_file)))
6916 color_file =
6917 Fexpand_file_name (build_string ("rgb.txt"),
6918 Fsymbol_value (intern ("data-directory")));
6919
6920 Vw32_color_map = Fw32_load_color_file (color_file);
6921
6922 UNGCPRO;
6923 }
6924 if (NILP (Vw32_color_map))
6925 Vw32_color_map = Fw32_default_color_map ();
6926
6927 if (! NILP (xrm_string))
6928 xrm_option = (unsigned char *) XSTRING (xrm_string)->data;
6929 else
6930 xrm_option = (unsigned char *) 0;
6931
6932 /* Use this general default value to start with. */
6933 /* First remove .exe suffix from invocation-name - it looks ugly. */
6934 {
6935 char basename[ MAX_PATH ], *str;
6936
6937 strcpy (basename, XSTRING (Vinvocation_name)->data);
6938 str = strrchr (basename, '.');
6939 if (str) *str = 0;
6940 Vinvocation_name = build_string (basename);
6941 }
6942 Vx_resource_name = Vinvocation_name;
6943
6944 validate_x_resource_name ();
6945
6946 /* This is what opens the connection and sets x_current_display.
6947 This also initializes many symbols, such as those used for input. */
6948 dpyinfo = w32_term_init (display, xrm_option,
6949 (char *) XSTRING (Vx_resource_name)->data);
6950
6951 if (dpyinfo == 0)
6952 {
6953 if (!NILP (must_succeed))
6954 fatal ("Cannot connect to server %s.\n",
6955 XSTRING (display)->data);
6956 else
6957 error ("Cannot connect to server %s", XSTRING (display)->data);
6958 }
6959
6960 w32_in_use = 1;
6961
6962 XSETFASTINT (Vwindow_system_version, 3);
6963 return Qnil;
6964}
6965
6966DEFUN ("x-close-connection", Fx_close_connection,
6967 Sx_close_connection, 1, 1, 0,
6968 "Close the connection to DISPLAY's server.\n\
6969For DISPLAY, specify either a frame or a display name (a string).\n\
6970If DISPLAY is nil, that stands for the selected frame's display.")
6971 (display)
6972 Lisp_Object display;
6973{
6974 struct w32_display_info *dpyinfo = check_x_display_info (display);
6975 int i;
6976
6977 if (dpyinfo->reference_count > 0)
6978 error ("Display still has frames on it");
6979
6980 BLOCK_INPUT;
6981 /* Free the fonts in the font table. */
6982 for (i = 0; i < dpyinfo->n_fonts; i++)
6983 if (dpyinfo->font_table[i].name)
6984 {
6985 xfree (dpyinfo->font_table[i].name);
6986 /* Don't free the full_name string;
6987 it is always shared with something else. */
6988 w32_unload_font (dpyinfo, dpyinfo->font_table[i].font);
6989 }
6990 x_destroy_all_bitmaps (dpyinfo);
6991
6992 x_delete_display (dpyinfo);
6993 UNBLOCK_INPUT;
6994
6995 return Qnil;
6996}
6997
6998DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0,
6999 "Return the list of display names that Emacs has connections to.")
7000 ()
7001{
7002 Lisp_Object tail, result;
7003
7004 result = Qnil;
7005 for (tail = w32_display_name_list; ! NILP (tail); tail = XCDR (tail))
7006 result = Fcons (XCAR (XCAR (tail)), result);
7007
7008 return result;
7009}
7010
7011DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize, 1, 2, 0,
7012 "If ON is non-nil, report errors as soon as the erring request is made.\n\
7013If ON is nil, allow buffering of requests.\n\
7014This is a noop on W32 systems.\n\
7015The optional second argument DISPLAY specifies which display to act on.\n\
7016DISPLAY should be either a frame or a display name (a string).\n\
7017If DISPLAY is omitted or nil, that stands for the selected frame's display.")
7018 (on, display)
7019 Lisp_Object display, on;
7020{
7021 struct w32_display_info *dpyinfo = check_x_display_info (display);
7022
7023 return Qnil;
7024}
7025
7026\f
7027\f
7028/***********************************************************************
7029 Image types
7030 ***********************************************************************/
7031
7032/* Value is the number of elements of vector VECTOR. */
7033
7034#define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
7035
7036/* List of supported image types. Use define_image_type to add new
7037 types. Use lookup_image_type to find a type for a given symbol. */
7038
7039static struct image_type *image_types;
7040
7041/* A list of symbols, one for each supported image type. */
7042
7043Lisp_Object Vimage_types;
7044
7045/* The symbol `image' which is the car of the lists used to represent
7046 images in Lisp. */
7047
7048extern Lisp_Object Qimage;
7049
7050/* The symbol `xbm' which is used as the type symbol for XBM images. */
7051
7052Lisp_Object Qxbm;
7053
7054/* Keywords. */
7055
7056Lisp_Object QCtype, QCdata, QCascent, QCmargin, QCrelief;
7057extern Lisp_Object QCwidth, QCheight, QCforeground, QCbackground, QCfile;
7058Lisp_Object QCalgorithm, QCcolor_symbols, QCheuristic_mask;
7059extern Lisp_Object QCindex;
7060
7061/* Other symbols. */
7062
7063Lisp_Object Qlaplace;
7064
7065/* Time in seconds after which images should be removed from the cache
7066 if not displayed. */
7067
7068Lisp_Object Vimage_cache_eviction_delay;
7069
7070/* Function prototypes. */
7071
7072static void define_image_type P_ ((struct image_type *type));
7073static struct image_type *lookup_image_type P_ ((Lisp_Object symbol));
7074static void image_error P_ ((char *format, Lisp_Object, Lisp_Object));
7075static void x_laplace P_ ((struct frame *, struct image *));
7076static int x_build_heuristic_mask P_ ((struct frame *, struct image *,
7077 Lisp_Object));
7078
7079/* Define a new image type from TYPE. This adds a copy of TYPE to
7080 image_types and adds the symbol *TYPE->type to Vimage_types. */
7081
7082static void
7083define_image_type (type)
7084 struct image_type *type;
7085{
7086 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
7087 The initialized data segment is read-only. */
7088 struct image_type *p = (struct image_type *) xmalloc (sizeof *p);
7089 bcopy (type, p, sizeof *p);
7090 p->next = image_types;
7091 image_types = p;
7092 Vimage_types = Fcons (*p->type, Vimage_types);
7093}
7094
7095
7096/* Look up image type SYMBOL, and return a pointer to its image_type
7097 structure. Value is null if SYMBOL is not a known image type. */
7098
7099static INLINE struct image_type *
7100lookup_image_type (symbol)
7101 Lisp_Object symbol;
7102{
7103 struct image_type *type;
7104
7105 for (type = image_types; type; type = type->next)
7106 if (EQ (symbol, *type->type))
7107 break;
7108
7109 return type;
7110}
7111
7112
7113/* Value is non-zero if OBJECT is a valid Lisp image specification. A
7114 valid image specification is a list whose car is the symbol
7115 `image', and whose rest is a property list. The property list must
7116 contain a value for key `:type'. That value must be the name of a
7117 supported image type. The rest of the property list depends on the
7118 image type. */
7119
7120int
7121valid_image_p (object)
7122 Lisp_Object object;
7123{
7124 int valid_p = 0;
7125
7126 if (CONSP (object) && EQ (XCAR (object), Qimage))
7127 {
7128 Lisp_Object symbol = Fplist_get (XCDR (object), QCtype);
7129 struct image_type *type = lookup_image_type (symbol);
7130
7131 if (type)
7132 valid_p = type->valid_p (object);
7133 }
7134
7135 return valid_p;
7136}
7137
7138
7139/* Log error message with format string FORMAT and argument ARG.
7140 Signaling an error, e.g. when an image cannot be loaded, is not a
7141 good idea because this would interrupt redisplay, and the error
7142 message display would lead to another redisplay. This function
7143 therefore simply displays a message. */
7144
7145static void
7146image_error (format, arg1, arg2)
7147 char *format;
7148 Lisp_Object arg1, arg2;
7149{
7150 add_to_log (format, arg1, arg2);
7151}
7152
7153
7154\f
7155/***********************************************************************
7156 Image specifications
7157 ***********************************************************************/
7158
7159enum image_value_type
7160{
7161 IMAGE_DONT_CHECK_VALUE_TYPE,
7162 IMAGE_STRING_VALUE,
7163 IMAGE_SYMBOL_VALUE,
7164 IMAGE_POSITIVE_INTEGER_VALUE,
7165 IMAGE_NON_NEGATIVE_INTEGER_VALUE,
7166 IMAGE_INTEGER_VALUE,
7167 IMAGE_FUNCTION_VALUE,
7168 IMAGE_NUMBER_VALUE,
7169 IMAGE_BOOL_VALUE
7170};
7171
7172/* Structure used when parsing image specifications. */
7173
7174struct image_keyword
7175{
7176 /* Name of keyword. */
7177 char *name;
7178
7179 /* The type of value allowed. */
7180 enum image_value_type type;
7181
7182 /* Non-zero means key must be present. */
7183 int mandatory_p;
7184
7185 /* Used to recognize duplicate keywords in a property list. */
7186 int count;
7187
7188 /* The value that was found. */
7189 Lisp_Object value;
7190};
7191
7192
7193static int parse_image_spec P_ ((Lisp_Object, struct image_keyword *,
7194 int, Lisp_Object));
7195static Lisp_Object image_spec_value P_ ((Lisp_Object, Lisp_Object, int *));
7196
7197
7198/* Parse image spec SPEC according to KEYWORDS. A valid image spec
7199 has the format (image KEYWORD VALUE ...). One of the keyword/
7200 value pairs must be `:type TYPE'. KEYWORDS is a vector of
7201 image_keywords structures of size NKEYWORDS describing other
7202 allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
7203
7204static int
7205parse_image_spec (spec, keywords, nkeywords, type)
7206 Lisp_Object spec;
7207 struct image_keyword *keywords;
7208 int nkeywords;
7209 Lisp_Object type;
7210{
7211 int i;
7212 Lisp_Object plist;
7213
7214 if (!CONSP (spec) || !EQ (XCAR (spec), Qimage))
7215 return 0;
7216
7217 plist = XCDR (spec);
7218 while (CONSP (plist))
7219 {
7220 Lisp_Object key, value;
7221
7222 /* First element of a pair must be a symbol. */
7223 key = XCAR (plist);
7224 plist = XCDR (plist);
7225 if (!SYMBOLP (key))
7226 return 0;
7227
7228 /* There must follow a value. */
7229 if (!CONSP (plist))
7230 return 0;
7231 value = XCAR (plist);
7232 plist = XCDR (plist);
7233
7234 /* Find key in KEYWORDS. Error if not found. */
7235 for (i = 0; i < nkeywords; ++i)
7236 if (strcmp (keywords[i].name, XSYMBOL (key)->name->data) == 0)
7237 break;
7238
7239 if (i == nkeywords)
7240 continue;
7241
7242 /* Record that we recognized the keyword. If a keywords
7243 was found more than once, it's an error. */
7244 keywords[i].value = value;
7245 ++keywords[i].count;
7246
7247 if (keywords[i].count > 1)
7248 return 0;
7249
7250 /* Check type of value against allowed type. */
7251 switch (keywords[i].type)
7252 {
7253 case IMAGE_STRING_VALUE:
7254 if (!STRINGP (value))
7255 return 0;
7256 break;
7257
7258 case IMAGE_SYMBOL_VALUE:
7259 if (!SYMBOLP (value))
7260 return 0;
7261 break;
7262
7263 case IMAGE_POSITIVE_INTEGER_VALUE:
7264 if (!INTEGERP (value) || XINT (value) <= 0)
7265 return 0;
7266 break;
7267
7268 case IMAGE_NON_NEGATIVE_INTEGER_VALUE:
7269 if (!INTEGERP (value) || XINT (value) < 0)
7270 return 0;
7271 break;
7272
7273 case IMAGE_DONT_CHECK_VALUE_TYPE:
7274 break;
7275
7276 case IMAGE_FUNCTION_VALUE:
7277 value = indirect_function (value);
7278 if (SUBRP (value)
7279 || COMPILEDP (value)
7280 || (CONSP (value) && EQ (XCAR (value), Qlambda)))
7281 break;
7282 return 0;
7283
7284 case IMAGE_NUMBER_VALUE:
7285 if (!INTEGERP (value) && !FLOATP (value))
7286 return 0;
7287 break;
7288
7289 case IMAGE_INTEGER_VALUE:
7290 if (!INTEGERP (value))
7291 return 0;
7292 break;
7293
7294 case IMAGE_BOOL_VALUE:
7295 if (!NILP (value) && !EQ (value, Qt))
7296 return 0;
7297 break;
7298
7299 default:
7300 abort ();
7301 break;
7302 }
7303
7304 if (EQ (key, QCtype) && !EQ (type, value))
7305 return 0;
7306 }
7307
7308 /* Check that all mandatory fields are present. */
7309 for (i = 0; i < nkeywords; ++i)
7310 if (keywords[i].mandatory_p && keywords[i].count == 0)
7311 return 0;
7312
7313 return NILP (plist);
7314}
7315
7316
7317/* Return the value of KEY in image specification SPEC. Value is nil
7318 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
7319 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
7320
7321static Lisp_Object
7322image_spec_value (spec, key, found)
7323 Lisp_Object spec, key;
7324 int *found;
7325{
7326 Lisp_Object tail;
7327
7328 xassert (valid_image_p (spec));
7329
7330 for (tail = XCDR (spec);
7331 CONSP (tail) && CONSP (XCDR (tail));
7332 tail = XCDR (XCDR (tail)))
7333 {
7334 if (EQ (XCAR (tail), key))
7335 {
7336 if (found)
7337 *found = 1;
7338 return XCAR (XCDR (tail));
7339 }
7340 }
7341
7342 if (found)
7343 *found = 0;
7344 return Qnil;
7345}
7346
7347
7348
7349\f
7350/***********************************************************************
7351 Image type independent image structures
7352 ***********************************************************************/
7353
7354static struct image *make_image P_ ((Lisp_Object spec, unsigned hash));
7355static void free_image P_ ((struct frame *f, struct image *img));
7356
7357
7358/* Allocate and return a new image structure for image specification
7359 SPEC. SPEC has a hash value of HASH. */
7360
7361static struct image *
7362make_image (spec, hash)
7363 Lisp_Object spec;
7364 unsigned hash;
7365{
7366 struct image *img = (struct image *) xmalloc (sizeof *img);
7367
7368 xassert (valid_image_p (spec));
7369 bzero (img, sizeof *img);
7370 img->type = lookup_image_type (image_spec_value (spec, QCtype, NULL));
7371 xassert (img->type != NULL);
7372 img->spec = spec;
7373 img->data.lisp_val = Qnil;
7374 img->ascent = DEFAULT_IMAGE_ASCENT;
7375 img->hash = hash;
7376 return img;
7377}
7378
7379
7380/* Free image IMG which was used on frame F, including its resources. */
7381
7382static void
7383free_image (f, img)
7384 struct frame *f;
7385 struct image *img;
7386{
7387 if (img)
7388 {
7389 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
7390
7391 /* Remove IMG from the hash table of its cache. */
7392 if (img->prev)
7393 img->prev->next = img->next;
7394 else
7395 c->buckets[img->hash % IMAGE_CACHE_BUCKETS_SIZE] = img->next;
7396
7397 if (img->next)
7398 img->next->prev = img->prev;
7399
7400 c->images[img->id] = NULL;
7401
7402 /* Free resources, then free IMG. */
7403 img->type->free (f, img);
7404 xfree (img);
7405 }
7406}
7407
7408
7409/* Prepare image IMG for display on frame F. Must be called before
7410 drawing an image. */
7411
7412void
7413prepare_image_for_display (f, img)
7414 struct frame *f;
7415 struct image *img;
7416{
7417 EMACS_TIME t;
7418
7419 /* We're about to display IMG, so set its timestamp to `now'. */
7420 EMACS_GET_TIME (t);
7421 img->timestamp = EMACS_SECS (t);
7422
7423 /* If IMG doesn't have a pixmap yet, load it now, using the image
7424 type dependent loader function. */
7425 if (img->pixmap == 0 && !img->load_failed_p)
7426 img->load_failed_p = img->type->load (f, img) == 0;
7427}
7428
7429
7430\f
7431/***********************************************************************
7432 Helper functions for X image types
7433 ***********************************************************************/
7434
7435static void x_clear_image P_ ((struct frame *f, struct image *img));
7436static unsigned long x_alloc_image_color P_ ((struct frame *f,
7437 struct image *img,
7438 Lisp_Object color_name,
7439 unsigned long dflt));
7440
7441/* Free X resources of image IMG which is used on frame F. */
7442
7443static void
7444x_clear_image (f, img)
7445 struct frame *f;
7446 struct image *img;
7447{
7448#if 0 /* NTEMACS_TODO: W32 image support */
7449
7450 if (img->pixmap)
7451 {
7452 BLOCK_INPUT;
7453 XFreePixmap (NULL, img->pixmap);
7454 img->pixmap = 0;
7455 UNBLOCK_INPUT;
7456 }
7457
7458 if (img->ncolors)
7459 {
7460 int class = FRAME_W32_DISPLAY_INFO (f)->visual->class;
7461
7462 /* If display has an immutable color map, freeing colors is not
7463 necessary and some servers don't allow it. So don't do it. */
7464 if (class != StaticColor
7465 && class != StaticGray
7466 && class != TrueColor)
7467 {
7468 Colormap cmap;
7469 BLOCK_INPUT;
7470 cmap = DefaultColormapOfScreen (FRAME_W32_DISPLAY_INFO (f)->screen);
7471 XFreeColors (FRAME_W32_DISPLAY (f), cmap, img->colors,
7472 img->ncolors, 0);
7473 UNBLOCK_INPUT;
7474 }
7475
7476 xfree (img->colors);
7477 img->colors = NULL;
7478 img->ncolors = 0;
7479 }
7480#endif
7481}
7482
7483
7484/* Allocate color COLOR_NAME for image IMG on frame F. If color
7485 cannot be allocated, use DFLT. Add a newly allocated color to
7486 IMG->colors, so that it can be freed again. Value is the pixel
7487 color. */
7488
7489static unsigned long
7490x_alloc_image_color (f, img, color_name, dflt)
7491 struct frame *f;
7492 struct image *img;
7493 Lisp_Object color_name;
7494 unsigned long dflt;
7495{
7496#if 0 /* NTEMACS_TODO: allocing colors. */
7497 XColor color;
7498 unsigned long result;
7499
7500 xassert (STRINGP (color_name));
7501
7502 if (w32_defined_color (f, XSTRING (color_name)->data, &color, 1))
7503 {
7504 /* This isn't called frequently so we get away with simply
7505 reallocating the color vector to the needed size, here. */
7506 ++img->ncolors;
7507 img->colors =
7508 (unsigned long *) xrealloc (img->colors,
7509 img->ncolors * sizeof *img->colors);
7510 img->colors[img->ncolors - 1] = color.pixel;
7511 result = color.pixel;
7512 }
7513 else
7514 result = dflt;
7515 return result;
7516#endif
7517 return 0;
7518}
7519
7520
7521\f
7522/***********************************************************************
7523 Image Cache
7524 ***********************************************************************/
7525
7526static void cache_image P_ ((struct frame *f, struct image *img));
7527
7528
7529/* Return a new, initialized image cache that is allocated from the
7530 heap. Call free_image_cache to free an image cache. */
7531
7532struct image_cache *
7533make_image_cache ()
7534{
7535 struct image_cache *c = (struct image_cache *) xmalloc (sizeof *c);
7536 int size;
7537
7538 bzero (c, sizeof *c);
7539 c->size = 50;
7540 c->images = (struct image **) xmalloc (c->size * sizeof *c->images);
7541 size = IMAGE_CACHE_BUCKETS_SIZE * sizeof *c->buckets;
7542 c->buckets = (struct image **) xmalloc (size);
7543 bzero (c->buckets, size);
7544 return c;
7545}
7546
7547
7548/* Free image cache of frame F. Be aware that X frames share images
7549 caches. */
7550
7551void
7552free_image_cache (f)
7553 struct frame *f;
7554{
7555 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
7556 if (c)
7557 {
7558 int i;
7559
7560 /* Cache should not be referenced by any frame when freed. */
7561 xassert (c->refcount == 0);
7562
7563 for (i = 0; i < c->used; ++i)
7564 free_image (f, c->images[i]);
7565 xfree (c->images);
7566 xfree (c);
7567 xfree (c->buckets);
7568 FRAME_X_IMAGE_CACHE (f) = NULL;
7569 }
7570}
7571
7572
7573/* Clear image cache of frame F. FORCE_P non-zero means free all
7574 images. FORCE_P zero means clear only images that haven't been
7575 displayed for some time. Should be called from time to time to
7576 reduce the number of loaded images. If image-cache-eveiction-delay
7577 is non-nil, this frees images in the cache which weren't displayed for
7578 at least that many seconds. */
7579
7580void
7581clear_image_cache (f, force_p)
7582 struct frame *f;
7583 int force_p;
7584{
7585 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
7586
7587 if (c && INTEGERP (Vimage_cache_eviction_delay))
7588 {
7589 EMACS_TIME t;
7590 unsigned long old;
7591 int i, any_freed_p = 0;
7592
7593 EMACS_GET_TIME (t);
7594 old = EMACS_SECS (t) - XFASTINT (Vimage_cache_eviction_delay);
7595
7596 for (i = 0; i < c->used; ++i)
7597 {
7598 struct image *img = c->images[i];
7599 if (img != NULL
7600 && (force_p
7601 || (img->timestamp > old)))
7602 {
7603 free_image (f, img);
7604 any_freed_p = 1;
7605 }
7606 }
7607
7608 /* We may be clearing the image cache because, for example,
7609 Emacs was iconified for a longer period of time. In that
7610 case, current matrices may still contain references to
7611 images freed above. So, clear these matrices. */
7612 if (any_freed_p)
7613 {
7614 clear_current_matrices (f);
7615 ++windows_or_buffers_changed;
7616 }
7617 }
7618}
7619
7620
7621DEFUN ("clear-image-cache", Fclear_image_cache, Sclear_image_cache,
7622 0, 1, 0,
7623 "Clear the image cache of FRAME.\n\
7624FRAME nil or omitted means use the selected frame.\n\
7625FRAME t means clear the image caches of all frames.")
7626 (frame)
7627 Lisp_Object frame;
7628{
7629 if (EQ (frame, Qt))
7630 {
7631 Lisp_Object tail;
7632
7633 FOR_EACH_FRAME (tail, frame)
7634 if (FRAME_W32_P (XFRAME (frame)))
7635 clear_image_cache (XFRAME (frame), 1);
7636 }
7637 else
7638 clear_image_cache (check_x_frame (frame), 1);
7639
7640 return Qnil;
7641}
7642
7643
7644/* Return the id of image with Lisp specification SPEC on frame F.
7645 SPEC must be a valid Lisp image specification (see valid_image_p). */
7646
7647int
7648lookup_image (f, spec)
7649 struct frame *f;
7650 Lisp_Object spec;
7651{
7652 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
7653 struct image *img;
7654 int i;
7655 unsigned hash;
7656 struct gcpro gcpro1;
7657 EMACS_TIME now;
7658
7659 /* F must be a window-system frame, and SPEC must be a valid image
7660 specification. */
7661 xassert (FRAME_WINDOW_P (f));
7662 xassert (valid_image_p (spec));
7663
7664 GCPRO1 (spec);
7665
7666 /* Look up SPEC in the hash table of the image cache. */
7667 hash = sxhash (spec, 0);
7668 i = hash % IMAGE_CACHE_BUCKETS_SIZE;
7669
7670 for (img = c->buckets[i]; img; img = img->next)
7671 if (img->hash == hash && !NILP (Fequal (img->spec, spec)))
7672 break;
7673
7674 /* If not found, create a new image and cache it. */
7675 if (img == NULL)
7676 {
7677 img = make_image (spec, hash);
7678 cache_image (f, img);
7679 img->load_failed_p = img->type->load (f, img) == 0;
7680 xassert (!interrupt_input_blocked);
7681
7682 /* If we can't load the image, and we don't have a width and
7683 height, use some arbitrary width and height so that we can
7684 draw a rectangle for it. */
7685 if (img->load_failed_p)
7686 {
7687 Lisp_Object value;
7688
7689 value = image_spec_value (spec, QCwidth, NULL);
7690 img->width = (INTEGERP (value)
7691 ? XFASTINT (value) : DEFAULT_IMAGE_WIDTH);
7692 value = image_spec_value (spec, QCheight, NULL);
7693 img->height = (INTEGERP (value)
7694 ? XFASTINT (value) : DEFAULT_IMAGE_HEIGHT);
7695 }
7696 else
7697 {
7698 /* Handle image type independent image attributes
7699 `:ascent PERCENT', `:margin MARGIN', `:relief RELIEF'. */
7700 Lisp_Object ascent, margin, relief, algorithm, heuristic_mask;
7701 Lisp_Object file;
7702
7703 ascent = image_spec_value (spec, QCascent, NULL);
7704 if (INTEGERP (ascent))
7705 img->ascent = XFASTINT (ascent);
7706
7707 margin = image_spec_value (spec, QCmargin, NULL);
7708 if (INTEGERP (margin) && XINT (margin) >= 0)
7709 img->margin = XFASTINT (margin);
7710
7711 relief = image_spec_value (spec, QCrelief, NULL);
7712 if (INTEGERP (relief))
7713 {
7714 img->relief = XINT (relief);
7715 img->margin += abs (img->relief);
7716 }
7717
7718 /* Should we apply a Laplace edge-detection algorithm? */
7719 algorithm = image_spec_value (spec, QCalgorithm, NULL);
7720 if (img->pixmap && EQ (algorithm, Qlaplace))
7721 x_laplace (f, img);
7722
7723 /* Should we built a mask heuristically? */
7724 heuristic_mask = image_spec_value (spec, QCheuristic_mask, NULL);
7725 if (img->pixmap && !img->mask && !NILP (heuristic_mask))
7726 x_build_heuristic_mask (f, img, heuristic_mask);
7727 }
7728 }
7729
7730 /* We're using IMG, so set its timestamp to `now'. */
7731 EMACS_GET_TIME (now);
7732 img->timestamp = EMACS_SECS (now);
7733
7734 UNGCPRO;
7735
7736 /* Value is the image id. */
7737 return img->id;
7738}
7739
7740
7741/* Cache image IMG in the image cache of frame F. */
7742
7743static void
7744cache_image (f, img)
7745 struct frame *f;
7746 struct image *img;
7747{
7748 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
7749 int i;
7750
7751 /* Find a free slot in c->images. */
7752 for (i = 0; i < c->used; ++i)
7753 if (c->images[i] == NULL)
7754 break;
7755
7756 /* If no free slot found, maybe enlarge c->images. */
7757 if (i == c->used && c->used == c->size)
7758 {
7759 c->size *= 2;
7760 c->images = (struct image **) xrealloc (c->images,
7761 c->size * sizeof *c->images);
7762 }
7763
7764 /* Add IMG to c->images, and assign IMG an id. */
7765 c->images[i] = img;
7766 img->id = i;
7767 if (i == c->used)
7768 ++c->used;
7769
7770 /* Add IMG to the cache's hash table. */
7771 i = img->hash % IMAGE_CACHE_BUCKETS_SIZE;
7772 img->next = c->buckets[i];
7773 if (img->next)
7774 img->next->prev = img;
7775 img->prev = NULL;
7776 c->buckets[i] = img;
7777}
7778
7779
7780/* Call FN on every image in the image cache of frame F. Used to mark
7781 Lisp Objects in the image cache. */
7782
7783void
7784forall_images_in_image_cache (f, fn)
7785 struct frame *f;
7786 void (*fn) P_ ((struct image *img));
7787{
7788 if (FRAME_LIVE_P (f) && FRAME_W32_P (f))
7789 {
7790 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
7791 if (c)
7792 {
7793 int i;
7794 for (i = 0; i < c->used; ++i)
7795 if (c->images[i])
7796 fn (c->images[i]);
7797 }
7798 }
7799}
7800
7801
7802\f
7803/***********************************************************************
7804 W32 support code
7805 ***********************************************************************/
7806
7807#if 0 /* NTEMACS_TODO: W32 specific image code. */
7808
7809static int x_create_x_image_and_pixmap P_ ((struct frame *, int, int, int,
7810 XImage **, Pixmap *));
7811static void x_destroy_x_image P_ ((XImage *));
7812static void x_put_x_image P_ ((struct frame *, XImage *, Pixmap, int, int));
7813
7814
7815/* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
7816 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
7817 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
7818 via xmalloc. Print error messages via image_error if an error
7819 occurs. Value is non-zero if successful. */
7820
7821static int
7822x_create_x_image_and_pixmap (f, width, height, depth, ximg, pixmap)
7823 struct frame *f;
7824 int width, height, depth;
7825 XImage **ximg;
7826 Pixmap *pixmap;
7827{
7828#if 0 /* NTEMACS_TODO: Image support for W32 */
7829 Display *display = FRAME_W32_DISPLAY (f);
7830 Screen *screen = FRAME_X_SCREEN (f);
7831 Window window = FRAME_W32_WINDOW (f);
7832
7833 xassert (interrupt_input_blocked);
7834
7835 if (depth <= 0)
7836 depth = DefaultDepthOfScreen (screen);
7837 *ximg = XCreateImage (display, DefaultVisualOfScreen (screen),
7838 depth, ZPixmap, 0, NULL, width, height,
7839 depth > 16 ? 32 : depth > 8 ? 16 : 8, 0);
7840 if (*ximg == NULL)
7841 {
7842 image_error ("Unable to allocate X image", Qnil, Qnil);
7843 return 0;
7844 }
7845
7846 /* Allocate image raster. */
7847 (*ximg)->data = (char *) xmalloc ((*ximg)->bytes_per_line * height);
7848
7849 /* Allocate a pixmap of the same size. */
7850 *pixmap = XCreatePixmap (display, window, width, height, depth);
7851 if (*pixmap == 0)
7852 {
7853 x_destroy_x_image (*ximg);
7854 *ximg = NULL;
7855 image_error ("Unable to create X pixmap", Qnil, Qnil);
7856 return 0;
7857 }
7858#endif
7859 return 1;
7860}
7861
7862
7863/* Destroy XImage XIMG. Free XIMG->data. */
7864
7865static void
7866x_destroy_x_image (ximg)
7867 XImage *ximg;
7868{
7869 xassert (interrupt_input_blocked);
7870 if (ximg)
7871 {
7872 xfree (ximg->data);
7873 ximg->data = NULL;
7874 XDestroyImage (ximg);
7875 }
7876}
7877
7878
7879/* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
7880 are width and height of both the image and pixmap. */
7881
7882static void
7883x_put_x_image (f, ximg, pixmap, width, height)
7884 struct frame *f;
7885 XImage *ximg;
7886 Pixmap pixmap;
7887{
7888 GC gc;
7889
7890 xassert (interrupt_input_blocked);
7891 gc = XCreateGC (NULL, pixmap, 0, NULL);
7892 XPutImage (NULL, pixmap, gc, ximg, 0, 0, 0, 0, width, height);
7893 XFreeGC (NULL, gc);
7894}
7895
7896#endif
7897
7898\f
7899/***********************************************************************
7900 Searching files
7901 ***********************************************************************/
7902
7903static Lisp_Object x_find_image_file P_ ((Lisp_Object));
7904
7905/* Find image file FILE. Look in data-directory, then
7906 x-bitmap-file-path. Value is the full name of the file found, or
7907 nil if not found. */
7908
7909static Lisp_Object
7910x_find_image_file (file)
7911 Lisp_Object file;
7912{
7913 Lisp_Object file_found, search_path;
7914 struct gcpro gcpro1, gcpro2;
7915 int fd;
7916
7917 file_found = Qnil;
7918 search_path = Fcons (Vdata_directory, Vx_bitmap_file_path);
7919 GCPRO2 (file_found, search_path);
7920
7921 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
7922 fd = openp (search_path, file, "", &file_found, 0);
7923
7924 if (fd < 0)
7925 file_found = Qnil;
7926 else
7927 close (fd);
7928
7929 UNGCPRO;
7930 return file_found;
7931}
7932
7933
7934\f
7935/***********************************************************************
7936 XBM images
7937 ***********************************************************************/
7938
7939static int xbm_load P_ ((struct frame *f, struct image *img));
7940static int xbm_load_image_from_file P_ ((struct frame *f, struct image *img,
7941 Lisp_Object file));
7942static int xbm_image_p P_ ((Lisp_Object object));
7943static int xbm_read_bitmap_file_data P_ ((char *, int *, int *,
7944 unsigned char **));
7945
7946
7947/* Indices of image specification fields in xbm_format, below. */
7948
7949enum xbm_keyword_index
7950{
7951 XBM_TYPE,
7952 XBM_FILE,
7953 XBM_WIDTH,
7954 XBM_HEIGHT,
7955 XBM_DATA,
7956 XBM_FOREGROUND,
7957 XBM_BACKGROUND,
7958 XBM_ASCENT,
7959 XBM_MARGIN,
7960 XBM_RELIEF,
7961 XBM_ALGORITHM,
7962 XBM_HEURISTIC_MASK,
7963 XBM_LAST
7964};
7965
7966/* Vector of image_keyword structures describing the format
7967 of valid XBM image specifications. */
7968
7969static struct image_keyword xbm_format[XBM_LAST] =
7970{
7971 {":type", IMAGE_SYMBOL_VALUE, 1},
7972 {":file", IMAGE_STRING_VALUE, 0},
7973 {":width", IMAGE_POSITIVE_INTEGER_VALUE, 0},
7974 {":height", IMAGE_POSITIVE_INTEGER_VALUE, 0},
7975 {":data", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
7976 {":foreground", IMAGE_STRING_VALUE, 0},
7977 {":background", IMAGE_STRING_VALUE, 0},
7978 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
7979 {":margin", IMAGE_POSITIVE_INTEGER_VALUE, 0},
7980 {":relief", IMAGE_INTEGER_VALUE, 0},
7981 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
7982 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
7983};
7984
7985/* Structure describing the image type XBM. */
7986
7987static struct image_type xbm_type =
7988{
7989 &Qxbm,
7990 xbm_image_p,
7991 xbm_load,
7992 x_clear_image,
7993 NULL
7994};
7995
7996/* Tokens returned from xbm_scan. */
7997
7998enum xbm_token
7999{
8000 XBM_TK_IDENT = 256,
8001 XBM_TK_NUMBER
8002};
8003
8004
8005/* Return non-zero if OBJECT is a valid XBM-type image specification.
8006 A valid specification is a list starting with the symbol `image'
8007 The rest of the list is a property list which must contain an
8008 entry `:type xbm..
8009
8010 If the specification specifies a file to load, it must contain
8011 an entry `:file FILENAME' where FILENAME is a string.
8012
8013 If the specification is for a bitmap loaded from memory it must
8014 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
8015 WIDTH and HEIGHT are integers > 0. DATA may be:
8016
8017 1. a string large enough to hold the bitmap data, i.e. it must
8018 have a size >= (WIDTH + 7) / 8 * HEIGHT
8019
8020 2. a bool-vector of size >= WIDTH * HEIGHT
8021
8022 3. a vector of strings or bool-vectors, one for each line of the
8023 bitmap.
8024
8025 Both the file and data forms may contain the additional entries
8026 `:background COLOR' and `:foreground COLOR'. If not present,
8027 foreground and background of the frame on which the image is
8028 displayed, is used. */
8029
8030static int
8031xbm_image_p (object)
8032 Lisp_Object object;
8033{
8034 struct image_keyword kw[XBM_LAST];
8035
8036 bcopy (xbm_format, kw, sizeof kw);
8037 if (!parse_image_spec (object, kw, XBM_LAST, Qxbm))
8038 return 0;
8039
8040 xassert (EQ (kw[XBM_TYPE].value, Qxbm));
8041
8042 if (kw[XBM_FILE].count)
8043 {
8044 if (kw[XBM_WIDTH].count || kw[XBM_HEIGHT].count || kw[XBM_DATA].count)
8045 return 0;
8046 }
8047 else
8048 {
8049 Lisp_Object data;
8050 int width, height;
8051
8052 /* Entries for `:width', `:height' and `:data' must be present. */
8053 if (!kw[XBM_WIDTH].count
8054 || !kw[XBM_HEIGHT].count
8055 || !kw[XBM_DATA].count)
8056 return 0;
8057
8058 data = kw[XBM_DATA].value;
8059 width = XFASTINT (kw[XBM_WIDTH].value);
8060 height = XFASTINT (kw[XBM_HEIGHT].value);
8061
8062 /* Check type of data, and width and height against contents of
8063 data. */
8064 if (VECTORP (data))
8065 {
8066 int i;
8067
8068 /* Number of elements of the vector must be >= height. */
8069 if (XVECTOR (data)->size < height)
8070 return 0;
8071
8072 /* Each string or bool-vector in data must be large enough
8073 for one line of the image. */
8074 for (i = 0; i < height; ++i)
8075 {
8076 Lisp_Object elt = XVECTOR (data)->contents[i];
8077
8078 if (STRINGP (elt))
8079 {
8080 if (XSTRING (elt)->size
8081 < (width + BITS_PER_CHAR - 1) / BITS_PER_CHAR)
8082 return 0;
8083 }
8084 else if (BOOL_VECTOR_P (elt))
8085 {
8086 if (XBOOL_VECTOR (elt)->size < width)
8087 return 0;
8088 }
8089 else
8090 return 0;
8091 }
8092 }
8093 else if (STRINGP (data))
8094 {
8095 if (XSTRING (data)->size
8096 < (width + BITS_PER_CHAR - 1) / BITS_PER_CHAR * height)
8097 return 0;
8098 }
8099 else if (BOOL_VECTOR_P (data))
8100 {
8101 if (XBOOL_VECTOR (data)->size < width * height)
8102 return 0;
8103 }
8104 else
8105 return 0;
8106 }
8107
8108 /* Baseline must be a value between 0 and 100 (a percentage). */
8109 if (kw[XBM_ASCENT].count
8110 && XFASTINT (kw[XBM_ASCENT].value) > 100)
8111 return 0;
8112
8113 return 1;
8114}
8115
8116
8117/* Scan a bitmap file. FP is the stream to read from. Value is
8118 either an enumerator from enum xbm_token, or a character for a
8119 single-character token, or 0 at end of file. If scanning an
8120 identifier, store the lexeme of the identifier in SVAL. If
8121 scanning a number, store its value in *IVAL. */
8122
8123static int
8124xbm_scan (fp, sval, ival)
8125 FILE *fp;
8126 char *sval;
8127 int *ival;
8128{
8129 int c;
8130
8131 /* Skip white space. */
8132 while ((c = fgetc (fp)) != EOF && isspace (c))
8133 ;
8134
8135 if (c == EOF)
8136 c = 0;
8137 else if (isdigit (c))
8138 {
8139 int value = 0, digit;
8140
8141 if (c == '0')
8142 {
8143 c = fgetc (fp);
8144 if (c == 'x' || c == 'X')
8145 {
8146 while ((c = fgetc (fp)) != EOF)
8147 {
8148 if (isdigit (c))
8149 digit = c - '0';
8150 else if (c >= 'a' && c <= 'f')
8151 digit = c - 'a' + 10;
8152 else if (c >= 'A' && c <= 'F')
8153 digit = c - 'A' + 10;
8154 else
8155 break;
8156 value = 16 * value + digit;
8157 }
8158 }
8159 else if (isdigit (c))
8160 {
8161 value = c - '0';
8162 while ((c = fgetc (fp)) != EOF
8163 && isdigit (c))
8164 value = 8 * value + c - '0';
8165 }
8166 }
8167 else
8168 {
8169 value = c - '0';
8170 while ((c = fgetc (fp)) != EOF
8171 && isdigit (c))
8172 value = 10 * value + c - '0';
8173 }
8174
8175 if (c != EOF)
8176 ungetc (c, fp);
8177 *ival = value;
8178 c = XBM_TK_NUMBER;
8179 }
8180 else if (isalpha (c) || c == '_')
8181 {
8182 *sval++ = c;
8183 while ((c = fgetc (fp)) != EOF
8184 && (isalnum (c) || c == '_'))
8185 *sval++ = c;
8186 *sval = 0;
8187 if (c != EOF)
8188 ungetc (c, fp);
8189 c = XBM_TK_IDENT;
8190 }
8191
8192 return c;
8193}
8194
8195
8196/* Replacement for XReadBitmapFileData which isn't available under old
8197 X versions. FILE is the name of the bitmap file to read. Set
8198 *WIDTH and *HEIGHT to the width and height of the image. Return in
8199 *DATA the bitmap data allocated with xmalloc. Value is non-zero if
8200 successful. */
8201
8202static int
8203xbm_read_bitmap_file_data (file, width, height, data)
8204 char *file;
8205 int *width, *height;
8206 unsigned char **data;
8207{
8208 FILE *fp;
8209 char buffer[BUFSIZ];
8210 int padding_p = 0;
8211 int v10 = 0;
8212 int bytes_per_line, i, nbytes;
8213 unsigned char *p;
8214 int value;
8215 int LA1;
8216
8217#define match() \
8218 LA1 = xbm_scan (fp, buffer, &value)
8219
8220#define expect(TOKEN) \
8221 if (LA1 != (TOKEN)) \
8222 goto failure; \
8223 else \
8224 match ()
8225
8226#define expect_ident(IDENT) \
8227 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
8228 match (); \
8229 else \
8230 goto failure
8231
8232 fp = fopen (file, "r");
8233 if (fp == NULL)
8234 return 0;
8235
8236 *width = *height = -1;
8237 *data = NULL;
8238 LA1 = xbm_scan (fp, buffer, &value);
8239
8240 /* Parse defines for width, height and hot-spots. */
8241 while (LA1 == '#')
8242 {
8243 match ();
8244 expect_ident ("define");
8245 expect (XBM_TK_IDENT);
8246
8247 if (LA1 == XBM_TK_NUMBER);
8248 {
8249 char *p = strrchr (buffer, '_');
8250 p = p ? p + 1 : buffer;
8251 if (strcmp (p, "width") == 0)
8252 *width = value;
8253 else if (strcmp (p, "height") == 0)
8254 *height = value;
8255 }
8256 expect (XBM_TK_NUMBER);
8257 }
8258
8259 if (*width < 0 || *height < 0)
8260 goto failure;
8261
8262 /* Parse bits. Must start with `static'. */
8263 expect_ident ("static");
8264 if (LA1 == XBM_TK_IDENT)
8265 {
8266 if (strcmp (buffer, "unsigned") == 0)
8267 {
8268 match ();
8269 expect_ident ("char");
8270 }
8271 else if (strcmp (buffer, "short") == 0)
8272 {
8273 match ();
8274 v10 = 1;
8275 if (*width % 16 && *width % 16 < 9)
8276 padding_p = 1;
8277 }
8278 else if (strcmp (buffer, "char") == 0)
8279 match ();
8280 else
8281 goto failure;
8282 }
8283 else
8284 goto failure;
8285
8286 expect (XBM_TK_IDENT);
8287 expect ('[');
8288 expect (']');
8289 expect ('=');
8290 expect ('{');
8291
8292 bytes_per_line = (*width + 7) / 8 + padding_p;
8293 nbytes = bytes_per_line * *height;
8294 p = *data = (char *) xmalloc (nbytes);
8295
8296 if (v10)
8297 {
8298
8299 for (i = 0; i < nbytes; i += 2)
8300 {
8301 int val = value;
8302 expect (XBM_TK_NUMBER);
8303
8304 *p++ = val;
8305 if (!padding_p || ((i + 2) % bytes_per_line))
8306 *p++ = value >> 8;
8307
8308 if (LA1 == ',' || LA1 == '}')
8309 match ();
8310 else
8311 goto failure;
8312 }
8313 }
8314 else
8315 {
8316 for (i = 0; i < nbytes; ++i)
8317 {
8318 int val = value;
8319 expect (XBM_TK_NUMBER);
8320
8321 *p++ = val;
8322
8323 if (LA1 == ',' || LA1 == '}')
8324 match ();
8325 else
8326 goto failure;
8327 }
8328 }
8329
8330 fclose (fp);
8331 return 1;
8332
8333 failure:
8334
8335 fclose (fp);
8336 if (*data)
8337 {
8338 xfree (*data);
8339 *data = NULL;
8340 }
8341 return 0;
8342
8343#undef match
8344#undef expect
8345#undef expect_ident
8346}
8347
8348
8349/* Load XBM image IMG which will be displayed on frame F from file
8350 SPECIFIED_FILE. Value is non-zero if successful. */
8351
8352static int
8353xbm_load_image_from_file (f, img, specified_file)
8354 struct frame *f;
8355 struct image *img;
8356 Lisp_Object specified_file;
8357{
8358 int rc;
8359 unsigned char *data;
8360 int success_p = 0;
8361 Lisp_Object file;
8362 struct gcpro gcpro1;
8363
8364 xassert (STRINGP (specified_file));
8365 file = Qnil;
8366 GCPRO1 (file);
8367
8368 file = x_find_image_file (specified_file);
8369 if (!STRINGP (file))
8370 {
8371 image_error ("Cannot find image file `%s'", specified_file, Qnil);
8372 UNGCPRO;
8373 return 0;
8374 }
8375
8376 rc = xbm_read_bitmap_file_data (XSTRING (file)->data, &img->width,
8377 &img->height, &data);
8378 if (rc)
8379 {
8380 int depth = one_w32_display_info.n_cbits;
8381 unsigned long foreground = FRAME_FOREGROUND_PIXEL (f);
8382 unsigned long background = FRAME_BACKGROUND_PIXEL (f);
8383 Lisp_Object value;
8384
8385 xassert (img->width > 0 && img->height > 0);
8386
8387 /* Get foreground and background colors, maybe allocate colors. */
8388 value = image_spec_value (img->spec, QCforeground, NULL);
8389 if (!NILP (value))
8390 foreground = x_alloc_image_color (f, img, value, foreground);
8391
8392 value = image_spec_value (img->spec, QCbackground, NULL);
8393 if (!NILP (value))
8394 background = x_alloc_image_color (f, img, value, background);
8395
8396#if 0 /* NTEMACS_TODO : Port image display to W32 */
8397 BLOCK_INPUT;
8398 img->pixmap
8399 = XCreatePixmapFromBitmapData (FRAME_W32_DISPLAY (f),
8400 FRAME_W32_WINDOW (f),
8401 data,
8402 img->width, img->height,
8403 foreground, background,
8404 depth);
8405 xfree (data);
8406
8407 if (img->pixmap == 0)
8408 {
8409 x_clear_image (f, img);
8410 image_error ("Unable to create X pixmap for `%s'", file, Qnil);
8411 }
8412 else
8413 success_p = 1;
8414
8415 UNBLOCK_INPUT;
8416#endif
8417 }
8418 else
8419 image_error ("Error loading XBM image `%s'", img->spec, Qnil);
8420
8421 UNGCPRO;
8422 return success_p;
8423}
8424
8425
8426/* Fill image IMG which is used on frame F with pixmap data. Value is
8427 non-zero if successful. */
8428
8429static int
8430xbm_load (f, img)
8431 struct frame *f;
8432 struct image *img;
8433{
8434 int success_p = 0;
8435 Lisp_Object file_name;
8436
8437 xassert (xbm_image_p (img->spec));
8438
8439 /* If IMG->spec specifies a file name, create a non-file spec from it. */
8440 file_name = image_spec_value (img->spec, QCfile, NULL);
8441 if (STRINGP (file_name))
8442 success_p = xbm_load_image_from_file (f, img, file_name);
8443 else
8444 {
8445 struct image_keyword fmt[XBM_LAST];
8446 Lisp_Object data;
8447 int depth;
8448 unsigned long foreground = FRAME_FOREGROUND_PIXEL (f);
8449 unsigned long background = FRAME_BACKGROUND_PIXEL (f);
8450 char *bits;
8451 int parsed_p;
8452
8453 /* Parse the list specification. */
8454 bcopy (xbm_format, fmt, sizeof fmt);
8455 parsed_p = parse_image_spec (img->spec, fmt, XBM_LAST, Qxbm);
8456 xassert (parsed_p);
8457
8458 /* Get specified width, and height. */
8459 img->width = XFASTINT (fmt[XBM_WIDTH].value);
8460 img->height = XFASTINT (fmt[XBM_HEIGHT].value);
8461 xassert (img->width > 0 && img->height > 0);
8462
8463 BLOCK_INPUT;
8464
8465 if (fmt[XBM_ASCENT].count)
8466 img->ascent = XFASTINT (fmt[XBM_ASCENT].value);
8467
8468 /* Get foreground and background colors, maybe allocate colors. */
8469 if (fmt[XBM_FOREGROUND].count)
8470 foreground = x_alloc_image_color (f, img, fmt[XBM_FOREGROUND].value,
8471 foreground);
8472 if (fmt[XBM_BACKGROUND].count)
8473 background = x_alloc_image_color (f, img, fmt[XBM_BACKGROUND].value,
8474 background);
8475
8476 /* Set bits to the bitmap image data. */
8477 data = fmt[XBM_DATA].value;
8478 if (VECTORP (data))
8479 {
8480 int i;
8481 char *p;
8482 int nbytes = (img->width + BITS_PER_CHAR - 1) / BITS_PER_CHAR;
8483
8484 p = bits = (char *) alloca (nbytes * img->height);
8485 for (i = 0; i < img->height; ++i, p += nbytes)
8486 {
8487 Lisp_Object line = XVECTOR (data)->contents[i];
8488 if (STRINGP (line))
8489 bcopy (XSTRING (line)->data, p, nbytes);
8490 else
8491 bcopy (XBOOL_VECTOR (line)->data, p, nbytes);
8492 }
8493 }
8494 else if (STRINGP (data))
8495 bits = XSTRING (data)->data;
8496 else
8497 bits = XBOOL_VECTOR (data)->data;
8498
8499#if 0 /* NTEMACS_TODO : W32 XPM code */
8500 /* Create the pixmap. */
8501 depth = DefaultDepthOfScreen (FRAME_X_SCREEN (f));
8502 img->pixmap
8503 = XCreatePixmapFromBitmapData (FRAME_W32_DISPLAY (f),
8504 FRAME_W32_WINDOW (f),
8505 bits,
8506 img->width, img->height,
8507 foreground, background,
8508 depth);
8509#endif /* NTEMACS_TODO */
8510
8511 if (img->pixmap)
8512 success_p = 1;
8513 else
8514 {
8515 image_error ("Unable to create pixmap for XBM image `%s'",
8516 img->spec, Qnil);
8517 x_clear_image (f, img);
8518 }
8519
8520 UNBLOCK_INPUT;
8521 }
8522
8523 return success_p;
8524}
8525
8526
8527\f
8528/***********************************************************************
8529 XPM images
8530 ***********************************************************************/
8531
8532#if HAVE_XPM
8533
8534static int xpm_image_p P_ ((Lisp_Object object));
8535static int xpm_load P_ ((struct frame *f, struct image *img));
8536static int xpm_valid_color_symbols_p P_ ((Lisp_Object));
8537
8538#include "X11/xpm.h"
8539
8540/* The symbol `xpm' identifying XPM-format images. */
8541
8542Lisp_Object Qxpm;
8543
8544/* Indices of image specification fields in xpm_format, below. */
8545
8546enum xpm_keyword_index
8547{
8548 XPM_TYPE,
8549 XPM_FILE,
8550 XPM_DATA,
8551 XPM_ASCENT,
8552 XPM_MARGIN,
8553 XPM_RELIEF,
8554 XPM_ALGORITHM,
8555 XPM_HEURISTIC_MASK,
8556 XPM_COLOR_SYMBOLS,
8557 XPM_LAST
8558};
8559
8560/* Vector of image_keyword structures describing the format
8561 of valid XPM image specifications. */
8562
8563static struct image_keyword xpm_format[XPM_LAST] =
8564{
8565 {":type", IMAGE_SYMBOL_VALUE, 1},
8566 {":file", IMAGE_STRING_VALUE, 0},
8567 {":data", IMAGE_STRING_VALUE, 0},
8568 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
8569 {":margin", IMAGE_POSITIVE_INTEGER_VALUE, 0},
8570 {":relief", IMAGE_INTEGER_VALUE, 0},
8571 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
8572 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
8573 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
8574};
8575
8576/* Structure describing the image type XBM. */
8577
8578static struct image_type xpm_type =
8579{
8580 &Qxpm,
8581 xpm_image_p,
8582 xpm_load,
8583 x_clear_image,
8584 NULL
8585};
8586
8587
8588/* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
8589 for XPM images. Such a list must consist of conses whose car and
8590 cdr are strings. */
8591
8592static int
8593xpm_valid_color_symbols_p (color_symbols)
8594 Lisp_Object color_symbols;
8595{
8596 while (CONSP (color_symbols))
8597 {
8598 Lisp_Object sym = XCAR (color_symbols);
8599 if (!CONSP (sym)
8600 || !STRINGP (XCAR (sym))
8601 || !STRINGP (XCDR (sym)))
8602 break;
8603 color_symbols = XCDR (color_symbols);
8604 }
8605
8606 return NILP (color_symbols);
8607}
8608
8609
8610/* Value is non-zero if OBJECT is a valid XPM image specification. */
8611
8612static int
8613xpm_image_p (object)
8614 Lisp_Object object;
8615{
8616 struct image_keyword fmt[XPM_LAST];
8617 bcopy (xpm_format, fmt, sizeof fmt);
8618 return (parse_image_spec (object, fmt, XPM_LAST, Qxpm)
8619 /* Either `:file' or `:data' must be present. */
8620 && fmt[XPM_FILE].count + fmt[XPM_DATA].count == 1
8621 /* Either no `:color-symbols' or it's a list of conses
8622 whose car and cdr are strings. */
8623 && (fmt[XPM_COLOR_SYMBOLS].count == 0
8624 || xpm_valid_color_symbols_p (fmt[XPM_COLOR_SYMBOLS].value))
8625 && (fmt[XPM_ASCENT].count == 0
8626 || XFASTINT (fmt[XPM_ASCENT].value) < 100));
8627}
8628
8629
8630/* Load image IMG which will be displayed on frame F. Value is
8631 non-zero if successful. */
8632
8633static int
8634xpm_load (f, img)
8635 struct frame *f;
8636 struct image *img;
8637{
8638 int rc, i;
8639 XpmAttributes attrs;
8640 Lisp_Object specified_file, color_symbols;
8641
8642 /* Configure the XPM lib. Use the visual of frame F. Allocate
8643 close colors. Return colors allocated. */
8644 bzero (&attrs, sizeof attrs);
8645 attrs.visual = FRAME_W32_DISPLAY_INFO (f)->visual;
8646 attrs.valuemask |= XpmVisual;
8647 attrs.valuemask |= XpmReturnAllocPixels;
8648 attrs.alloc_close_colors = 1;
8649 attrs.valuemask |= XpmAllocCloseColors;
8650
8651 /* If image specification contains symbolic color definitions, add
8652 these to `attrs'. */
8653 color_symbols = image_spec_value (img->spec, QCcolor_symbols, NULL);
8654 if (CONSP (color_symbols))
8655 {
8656 Lisp_Object tail;
8657 XpmColorSymbol *xpm_syms;
8658 int i, size;
8659
8660 attrs.valuemask |= XpmColorSymbols;
8661
8662 /* Count number of symbols. */
8663 attrs.numsymbols = 0;
8664 for (tail = color_symbols; CONSP (tail); tail = XCDR (tail))
8665 ++attrs.numsymbols;
8666
8667 /* Allocate an XpmColorSymbol array. */
8668 size = attrs.numsymbols * sizeof *xpm_syms;
8669 xpm_syms = (XpmColorSymbol *) alloca (size);
8670 bzero (xpm_syms, size);
8671 attrs.colorsymbols = xpm_syms;
8672
8673 /* Fill the color symbol array. */
8674 for (tail = color_symbols, i = 0;
8675 CONSP (tail);
8676 ++i, tail = XCDR (tail))
8677 {
8678 Lisp_Object name = XCAR (XCAR (tail));
8679 Lisp_Object color = XCDR (XCAR (tail));
8680 xpm_syms[i].name = (char *) alloca (XSTRING (name)->size + 1);
8681 strcpy (xpm_syms[i].name, XSTRING (name)->data);
8682 xpm_syms[i].value = (char *) alloca (XSTRING (color)->size + 1);
8683 strcpy (xpm_syms[i].value, XSTRING (color)->data);
8684 }
8685 }
8686
8687 /* Create a pixmap for the image, either from a file, or from a
8688 string buffer containing data in the same format as an XPM file. */
8689 BLOCK_INPUT;
8690 specified_file = image_spec_value (img->spec, QCfile, NULL);
8691 if (STRINGP (specified_file))
8692 {
8693 Lisp_Object file = x_find_image_file (specified_file);
8694 if (!STRINGP (file))
8695 {
8696 image_error ("Cannot find image file `%s'", specified_file, Qnil);
8697 UNBLOCK_INPUT;
8698 return 0;
8699 }
8700
8701 rc = XpmReadFileToPixmap (NULL, FRAME_W32_WINDOW (f),
8702 XSTRING (file)->data, &img->pixmap, &img->mask,
8703 &attrs);
8704 }
8705 else
8706 {
8707 Lisp_Object buffer = image_spec_value (img->spec, QCdata, NULL);
8708 rc = XpmCreatePixmapFromBuffer (NULL, FRAME_W32_WINDOW (f),
8709 XSTRING (buffer)->data,
8710 &img->pixmap, &img->mask,
8711 &attrs);
8712 }
8713 UNBLOCK_INPUT;
8714
8715 if (rc == XpmSuccess)
8716 {
8717 /* Remember allocated colors. */
8718 img->ncolors = attrs.nalloc_pixels;
8719 img->colors = (unsigned long *) xmalloc (img->ncolors
8720 * sizeof *img->colors);
8721 for (i = 0; i < attrs.nalloc_pixels; ++i)
8722 img->colors[i] = attrs.alloc_pixels[i];
8723
8724 img->width = attrs.width;
8725 img->height = attrs.height;
8726 xassert (img->width > 0 && img->height > 0);
8727
8728 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
8729 BLOCK_INPUT;
8730 XpmFreeAttributes (&attrs);
8731 UNBLOCK_INPUT;
8732 }
8733 else
8734 {
8735 switch (rc)
8736 {
8737 case XpmOpenFailed:
8738 image_error ("Error opening XPM file (%s)", img->spec, Qnil);
8739 break;
8740
8741 case XpmFileInvalid:
8742 image_error ("Invalid XPM file (%s)", img->spec, Qnil);
8743 break;
8744
8745 case XpmNoMemory:
8746 image_error ("Out of memory (%s)", img->spec, Qnil);
8747 break;
8748
8749 case XpmColorFailed:
8750 image_error ("Color allocation error (%s)", img->spec, Qnil);
8751 break;
8752
8753 default:
8754 image_error ("Unknown error (%s)", img->spec, Qnil);
8755 break;
8756 }
8757 }
8758
8759 return rc == XpmSuccess;
8760}
8761
8762#endif /* HAVE_XPM != 0 */
8763
8764\f
8765#if 0 /* NTEMACS_TODO : Color tables on W32. */
8766/***********************************************************************
8767 Color table
8768 ***********************************************************************/
8769
8770/* An entry in the color table mapping an RGB color to a pixel color. */
8771
8772struct ct_color
8773{
8774 int r, g, b;
8775 unsigned long pixel;
8776
8777 /* Next in color table collision list. */
8778 struct ct_color *next;
8779};
8780
8781/* The bucket vector size to use. Must be prime. */
8782
8783#define CT_SIZE 101
8784
8785/* Value is a hash of the RGB color given by R, G, and B. */
8786
8787#define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
8788
8789/* The color hash table. */
8790
8791struct ct_color **ct_table;
8792
8793/* Number of entries in the color table. */
8794
8795int ct_colors_allocated;
8796
8797/* Function prototypes. */
8798
8799static void init_color_table P_ ((void));
8800static void free_color_table P_ ((void));
8801static unsigned long *colors_in_color_table P_ ((int *n));
8802static unsigned long lookup_rgb_color P_ ((struct frame *f, int r, int g, int b));
8803static unsigned long lookup_pixel_color P_ ((struct frame *f, unsigned long p));
8804
8805
8806/* Initialize the color table. */
8807
8808static void
8809init_color_table ()
8810{
8811 int size = CT_SIZE * sizeof (*ct_table);
8812 ct_table = (struct ct_color **) xmalloc (size);
8813 bzero (ct_table, size);
8814 ct_colors_allocated = 0;
8815}
8816
8817
8818/* Free memory associated with the color table. */
8819
8820static void
8821free_color_table ()
8822{
8823 int i;
8824 struct ct_color *p, *next;
8825
8826 for (i = 0; i < CT_SIZE; ++i)
8827 for (p = ct_table[i]; p; p = next)
8828 {
8829 next = p->next;
8830 xfree (p);
8831 }
8832
8833 xfree (ct_table);
8834 ct_table = NULL;
8835}
8836
8837
8838/* Value is a pixel color for RGB color R, G, B on frame F. If an
8839 entry for that color already is in the color table, return the
8840 pixel color of that entry. Otherwise, allocate a new color for R,
8841 G, B, and make an entry in the color table. */
8842
8843static unsigned long
8844lookup_rgb_color (f, r, g, b)
8845 struct frame *f;
8846 int r, g, b;
8847{
8848 unsigned hash = CT_HASH_RGB (r, g, b);
8849 int i = hash % CT_SIZE;
8850 struct ct_color *p;
8851
8852 for (p = ct_table[i]; p; p = p->next)
8853 if (p->r == r && p->g == g && p->b == b)
8854 break;
8855
8856 if (p == NULL)
8857 {
8858 COLORREF color;
8859 Colormap cmap;
8860 int rc;
8861
8862 color = PALETTERGB (r, g, b);
8863
8864 ++ct_colors_allocated;
8865
8866 p = (struct ct_color *) xmalloc (sizeof *p);
8867 p->r = r;
8868 p->g = g;
8869 p->b = b;
8870 p->pixel = color;
8871 p->next = ct_table[i];
8872 ct_table[i] = p;
8873 }
8874
8875 return p->pixel;
8876}
8877
8878
8879/* Look up pixel color PIXEL which is used on frame F in the color
8880 table. If not already present, allocate it. Value is PIXEL. */
8881
8882static unsigned long
8883lookup_pixel_color (f, pixel)
8884 struct frame *f;
8885 unsigned long pixel;
8886{
8887 int i = pixel % CT_SIZE;
8888 struct ct_color *p;
8889
8890 for (p = ct_table[i]; p; p = p->next)
8891 if (p->pixel == pixel)
8892 break;
8893
8894 if (p == NULL)
8895 {
8896 XColor color;
8897 Colormap cmap;
8898 int rc;
8899
8900 BLOCK_INPUT;
8901
8902 cmap = DefaultColormapOfScreen (FRAME_X_SCREEN (f));
8903 color.pixel = pixel;
8904 XQueryColor (NULL, cmap, &color);
8905 rc = x_alloc_nearest_color (f, cmap, &color);
8906 UNBLOCK_INPUT;
8907
8908 if (rc)
8909 {
8910 ++ct_colors_allocated;
8911
8912 p = (struct ct_color *) xmalloc (sizeof *p);
8913 p->r = color.red;
8914 p->g = color.green;
8915 p->b = color.blue;
8916 p->pixel = pixel;
8917 p->next = ct_table[i];
8918 ct_table[i] = p;
8919 }
8920 else
8921 return FRAME_FOREGROUND_PIXEL (f);
8922 }
8923 return p->pixel;
8924}
8925
8926
8927/* Value is a vector of all pixel colors contained in the color table,
8928 allocated via xmalloc. Set *N to the number of colors. */
8929
8930static unsigned long *
8931colors_in_color_table (n)
8932 int *n;
8933{
8934 int i, j;
8935 struct ct_color *p;
8936 unsigned long *colors;
8937
8938 if (ct_colors_allocated == 0)
8939 {
8940 *n = 0;
8941 colors = NULL;
8942 }
8943 else
8944 {
8945 colors = (unsigned long *) xmalloc (ct_colors_allocated
8946 * sizeof *colors);
8947 *n = ct_colors_allocated;
8948
8949 for (i = j = 0; i < CT_SIZE; ++i)
8950 for (p = ct_table[i]; p; p = p->next)
8951 colors[j++] = p->pixel;
8952 }
8953
8954 return colors;
8955}
8956
8957#endif /* NTEMACS_TODO */
8958
8959\f
8960/***********************************************************************
8961 Algorithms
8962 ***********************************************************************/
8963
8964#if 0 /* NTEMACS_TODO : W32 versions of low level algorithms */
8965static void x_laplace_write_row P_ ((struct frame *, long *,
8966 int, XImage *, int));
8967static void x_laplace_read_row P_ ((struct frame *, Colormap,
8968 XColor *, int, XImage *, int));
8969
8970
8971/* Fill COLORS with RGB colors from row Y of image XIMG. F is the
8972 frame we operate on, CMAP is the color-map in effect, and WIDTH is
8973 the width of one row in the image. */
8974
8975static void
8976x_laplace_read_row (f, cmap, colors, width, ximg, y)
8977 struct frame *f;
8978 Colormap cmap;
8979 XColor *colors;
8980 int width;
8981 XImage *ximg;
8982 int y;
8983{
8984 int x;
8985
8986 for (x = 0; x < width; ++x)
8987 colors[x].pixel = XGetPixel (ximg, x, y);
8988
8989 XQueryColors (NULL, cmap, colors, width);
8990}
8991
8992
8993/* Write row Y of image XIMG. PIXELS is an array of WIDTH longs
8994 containing the pixel colors to write. F is the frame we are
8995 working on. */
8996
8997static void
8998x_laplace_write_row (f, pixels, width, ximg, y)
8999 struct frame *f;
9000 long *pixels;
9001 int width;
9002 XImage *ximg;
9003 int y;
9004{
9005 int x;
9006
9007 for (x = 0; x < width; ++x)
9008 XPutPixel (ximg, x, y, pixels[x]);
9009}
9010#endif
9011
9012/* Transform image IMG which is used on frame F with a Laplace
9013 edge-detection algorithm. The result is an image that can be used
9014 to draw disabled buttons, for example. */
9015
9016static void
9017x_laplace (f, img)
9018 struct frame *f;
9019 struct image *img;
9020{
9021#if 0 /* NTEMACS_TODO : W32 version */
9022 Colormap cmap = DefaultColormapOfScreen (FRAME_X_SCREEN (f));
9023 XImage *ximg, *oimg;
9024 XColor *in[3];
9025 long *out;
9026 Pixmap pixmap;
9027 int x, y, i;
9028 long pixel;
9029 int in_y, out_y, rc;
9030 int mv2 = 45000;
9031
9032 BLOCK_INPUT;
9033
9034 /* Get the X image IMG->pixmap. */
9035 ximg = XGetImage (NULL, img->pixmap,
9036 0, 0, img->width, img->height, ~0, ZPixmap);
9037
9038 /* Allocate 3 input rows, and one output row of colors. */
9039 for (i = 0; i < 3; ++i)
9040 in[i] = (XColor *) alloca (img->width * sizeof (XColor));
9041 out = (long *) alloca (img->width * sizeof (long));
9042
9043 /* Create an X image for output. */
9044 rc = x_create_x_image_and_pixmap (f, img->width, img->height, 0,
9045 &oimg, &pixmap);
9046
9047 /* Fill first two rows. */
9048 x_laplace_read_row (f, cmap, in[0], img->width, ximg, 0);
9049 x_laplace_read_row (f, cmap, in[1], img->width, ximg, 1);
9050 in_y = 2;
9051
9052 /* Write first row, all zeros. */
9053 init_color_table ();
9054 pixel = lookup_rgb_color (f, 0, 0, 0);
9055 for (x = 0; x < img->width; ++x)
9056 out[x] = pixel;
9057 x_laplace_write_row (f, out, img->width, oimg, 0);
9058 out_y = 1;
9059
9060 for (y = 2; y < img->height; ++y)
9061 {
9062 int rowa = y % 3;
9063 int rowb = (y + 2) % 3;
9064
9065 x_laplace_read_row (f, cmap, in[rowa], img->width, ximg, in_y++);
9066
9067 for (x = 0; x < img->width - 2; ++x)
9068 {
9069 int r = in[rowa][x].red + mv2 - in[rowb][x + 2].red;
9070 int g = in[rowa][x].green + mv2 - in[rowb][x + 2].green;
9071 int b = in[rowa][x].blue + mv2 - in[rowb][x + 2].blue;
9072
9073 out[x + 1] = lookup_rgb_color (f, r & 0xffff, g & 0xffff,
9074 b & 0xffff);
9075 }
9076
9077 x_laplace_write_row (f, out, img->width, oimg, out_y++);
9078 }
9079
9080 /* Write last line, all zeros. */
9081 for (x = 0; x < img->width; ++x)
9082 out[x] = pixel;
9083 x_laplace_write_row (f, out, img->width, oimg, out_y);
9084
9085 /* Free the input image, and free resources of IMG. */
9086 XDestroyImage (ximg);
9087 x_clear_image (f, img);
9088
9089 /* Put the output image into pixmap, and destroy it. */
9090 x_put_x_image (f, oimg, pixmap, img->width, img->height);
9091 x_destroy_x_image (oimg);
9092
9093 /* Remember new pixmap and colors in IMG. */
9094 img->pixmap = pixmap;
9095 img->colors = colors_in_color_table (&img->ncolors);
9096 free_color_table ();
9097
9098 UNBLOCK_INPUT;
9099#endif /* NTEMACS_TODO */
9100}
9101
9102
9103/* Build a mask for image IMG which is used on frame F. FILE is the
9104 name of an image file, for error messages. HOW determines how to
9105 determine the background color of IMG. If it is a list '(R G B)',
9106 with R, G, and B being integers >= 0, take that as the color of the
9107 background. Otherwise, determine the background color of IMG
9108 heuristically. Value is non-zero if successful. */
9109
9110static int
9111x_build_heuristic_mask (f, img, how)
9112 struct frame *f;
9113 struct image *img;
9114 Lisp_Object how;
9115{
9116#if 0 /* NTEMACS_TODO : W32 version */
9117 Display *dpy = FRAME_W32_DISPLAY (f);
9118 XImage *ximg, *mask_img;
9119 int x, y, rc, look_at_corners_p;
9120 unsigned long bg;
9121
9122 BLOCK_INPUT;
9123
9124 /* Create an image and pixmap serving as mask. */
9125 rc = x_create_x_image_and_pixmap (f, img->width, img->height, 1,
9126 &mask_img, &img->mask);
9127 if (!rc)
9128 {
9129 UNBLOCK_INPUT;
9130 return 0;
9131 }
9132
9133 /* Get the X image of IMG->pixmap. */
9134 ximg = XGetImage (dpy, img->pixmap, 0, 0, img->width, img->height,
9135 ~0, ZPixmap);
9136
9137 /* Determine the background color of ximg. If HOW is `(R G B)'
9138 take that as color. Otherwise, try to determine the color
9139 heuristically. */
9140 look_at_corners_p = 1;
9141
9142 if (CONSP (how))
9143 {
9144 int rgb[3], i = 0;
9145
9146 while (i < 3
9147 && CONSP (how)
9148 && NATNUMP (XCAR (how)))
9149 {
9150 rgb[i] = XFASTINT (XCAR (how)) & 0xffff;
9151 how = XCDR (how);
9152 }
9153
9154 if (i == 3 && NILP (how))
9155 {
9156 char color_name[30];
9157 XColor exact, color;
9158 Colormap cmap;
9159
9160 sprintf (color_name, "#%04x%04x%04x", rgb[0], rgb[1], rgb[2]);
9161
9162 cmap = DefaultColormapOfScreen (FRAME_X_SCREEN (f));
9163 if (XLookupColor (dpy, cmap, color_name, &exact, &color))
9164 {
9165 bg = color.pixel;
9166 look_at_corners_p = 0;
9167 }
9168 }
9169 }
9170
9171 if (look_at_corners_p)
9172 {
9173 unsigned long corners[4];
9174 int i, best_count;
9175
9176 /* Get the colors at the corners of ximg. */
9177 corners[0] = XGetPixel (ximg, 0, 0);
9178 corners[1] = XGetPixel (ximg, img->width - 1, 0);
9179 corners[2] = XGetPixel (ximg, img->width - 1, img->height - 1);
9180 corners[3] = XGetPixel (ximg, 0, img->height - 1);
9181
9182 /* Choose the most frequently found color as background. */
9183 for (i = best_count = 0; i < 4; ++i)
9184 {
9185 int j, n;
9186
9187 for (j = n = 0; j < 4; ++j)
9188 if (corners[i] == corners[j])
9189 ++n;
9190
9191 if (n > best_count)
9192 bg = corners[i], best_count = n;
9193 }
9194 }
9195
9196 /* Set all bits in mask_img to 1 whose color in ximg is different
9197 from the background color bg. */
9198 for (y = 0; y < img->height; ++y)
9199 for (x = 0; x < img->width; ++x)
9200 XPutPixel (mask_img, x, y, XGetPixel (ximg, x, y) != bg);
9201
9202 /* Put mask_img into img->mask. */
9203 x_put_x_image (f, mask_img, img->mask, img->width, img->height);
9204 x_destroy_x_image (mask_img);
9205 XDestroyImage (ximg);
9206
9207 UNBLOCK_INPUT;
9208#endif /* NTEMACS_TODO */
9209
9210 return 1;
9211}
9212
9213
9214\f
9215/***********************************************************************
9216 PBM (mono, gray, color)
9217 ***********************************************************************/
9218#ifdef HAVE_PBM
9219
9220static int pbm_image_p P_ ((Lisp_Object object));
9221static int pbm_load P_ ((struct frame *f, struct image *img));
9222static int pbm_scan_number P_ ((unsigned char **, unsigned char *));
9223
9224/* The symbol `pbm' identifying images of this type. */
9225
9226Lisp_Object Qpbm;
9227
9228/* Indices of image specification fields in gs_format, below. */
9229
9230enum pbm_keyword_index
9231{
9232 PBM_TYPE,
9233 PBM_FILE,
9234 PBM_DATA,
9235 PBM_ASCENT,
9236 PBM_MARGIN,
9237 PBM_RELIEF,
9238 PBM_ALGORITHM,
9239 PBM_HEURISTIC_MASK,
9240 PBM_LAST
9241};
9242
9243/* Vector of image_keyword structures describing the format
9244 of valid user-defined image specifications. */
9245
9246static struct image_keyword pbm_format[PBM_LAST] =
9247{
9248 {":type", IMAGE_SYMBOL_VALUE, 1},
9249 {":file", IMAGE_STRING_VALUE, 0},
9250 {":data", IMAGE_STRING_VALUE, 0},
9251 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
9252 {":margin", IMAGE_POSITIVE_INTEGER_VALUE, 0},
9253 {":relief", IMAGE_INTEGER_VALUE, 0},
9254 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
9255 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
9256};
9257
9258/* Structure describing the image type `pbm'. */
9259
9260static struct image_type pbm_type =
9261{
9262 &Qpbm,
9263 pbm_image_p,
9264 pbm_load,
9265 x_clear_image,
9266 NULL
9267};
9268
9269
9270/* Return non-zero if OBJECT is a valid PBM image specification. */
9271
9272static int
9273pbm_image_p (object)
9274 Lisp_Object object;
9275{
9276 struct image_keyword fmt[PBM_LAST];
9277
9278 bcopy (pbm_format, fmt, sizeof fmt);
9279
9280 if (!parse_image_spec (object, fmt, PBM_LAST, Qpbm)
9281 || (fmt[PBM_ASCENT].count
9282 && XFASTINT (fmt[PBM_ASCENT].value) > 100))
9283 return 0;
9284
9285 /* Must specify either :data or :file. */
9286 return fmt[PBM_DATA].count + fmt[PBM_FILE].count == 1;
9287}
9288
9289
9290/* Scan a decimal number from *S and return it. Advance *S while
9291 reading the number. END is the end of the string. Value is -1 at
9292 end of input. */
9293
9294static int
9295pbm_scan_number (s, end)
9296 unsigned char **s, *end;
9297{
9298 int c, val = -1;
9299
9300 while (*s < end)
9301 {
9302 /* Skip white-space. */
9303 while (*s < end && (c = *(*s)++, isspace (c)))
9304 ;
9305
9306 if (c == '#')
9307 {
9308 /* Skip comment to end of line. */
9309 while (*s < end && (c = *(*s)++, c != '\n'))
9310 ;
9311 }
9312 else if (isdigit (c))
9313 {
9314 /* Read decimal number. */
9315 val = c - '0';
9316 while (*s < end && (c = *(*s)++, isdigit (c)))
9317 val = 10 * val + c - '0';
9318 break;
9319 }
9320 else
9321 break;
9322 }
9323
9324 return val;
9325}
9326
9327
9328/* Read FILE into memory. Value is a pointer to a buffer allocated
9329 with xmalloc holding FILE's contents. Value is null if an error
9330 occured. *SIZE is set to the size of the file. */
9331
9332static char *
9333pbm_read_file (file, size)
9334 Lisp_Object file;
9335 int *size;
9336{
9337 FILE *fp = NULL;
9338 char *buf = NULL;
9339 struct stat st;
9340
9341 if (stat (XSTRING (file)->data, &st) == 0
9342 && (fp = fopen (XSTRING (file)->data, "r")) != NULL
9343 && (buf = (char *) xmalloc (st.st_size),
9344 fread (buf, 1, st.st_size, fp) == st.st_size))
9345 {
9346 *size = st.st_size;
9347 fclose (fp);
9348 }
9349 else
9350 {
9351 if (fp)
9352 fclose (fp);
9353 if (buf)
9354 {
9355 xfree (buf);
9356 buf = NULL;
9357 }
9358 }
9359
9360 return buf;
9361}
9362
9363
9364/* Load PBM image IMG for use on frame F. */
9365
9366static int
9367pbm_load (f, img)
9368 struct frame *f;
9369 struct image *img;
9370{
9371 int raw_p, x, y;
9372 int width, height, max_color_idx = 0;
9373 XImage *ximg;
9374 Lisp_Object file, specified_file;
9375 enum {PBM_MONO, PBM_GRAY, PBM_COLOR} type;
9376 struct gcpro gcpro1;
9377 unsigned char *contents = NULL;
9378 unsigned char *end, *p;
9379 int size;
9380
9381 specified_file = image_spec_value (img->spec, QCfile, NULL);
9382 file = Qnil;
9383 GCPRO1 (file);
9384
9385 if (STRINGP (specified_file))
9386 {
9387 file = x_find_image_file (specified_file);
9388 if (!STRINGP (file))
9389 {
9390 image_error ("Cannot find image file `%s'", specified_file, Qnil);
9391 UNGCPRO;
9392 return 0;
9393 }
9394
9395 contents = pbm_read_file (file, &size);
9396 if (contents == NULL)
9397 {
9398 image_error ("Error reading `%s'", file, Qnil);
9399 UNGCPRO;
9400 return 0;
9401 }
9402
9403 p = contents;
9404 end = contents + size;
9405 }
9406 else
9407 {
9408 Lisp_Object data;
9409 data = image_spec_value (img->spec, QCdata, NULL);
9410 p = XSTRING (data)->data;
9411 end = p + STRING_BYTES (XSTRING (data));
9412 }
9413
9414 /* Check magic number. */
9415 if (end - p < 2 || *p++ != 'P')
9416 {
9417 image_error ("Not a PBM image: `%s'", img->spec, Qnil);
9418 error:
9419 xfree (contents);
9420 UNGCPRO;
9421 return 0;
9422 }
9423
9424 if (*magic != 'P')
9425 {
9426 fclose (fp);
9427 image_error ("Not a PBM image file: %s", file, Qnil);
9428 UNGCPRO;
9429 return 0;
9430 }
9431
9432 switch (*p++)
9433 {
9434 case '1':
9435 raw_p = 0, type = PBM_MONO;
9436 break;
9437
9438 case '2':
9439 raw_p = 0, type = PBM_GRAY;
9440 break;
9441
9442 case '3':
9443 raw_p = 0, type = PBM_COLOR;
9444 break;
9445
9446 case '4':
9447 raw_p = 1, type = PBM_MONO;
9448 break;
9449
9450 case '5':
9451 raw_p = 1, type = PBM_GRAY;
9452 break;
9453
9454 case '6':
9455 raw_p = 1, type = PBM_COLOR;
9456 break;
9457
9458 default:
9459 image_error ("Not a PBM image: `%s'", img->spec, Qnil);
9460 goto error;
9461 }
9462
9463 /* Read width, height, maximum color-component. Characters
9464 starting with `#' up to the end of a line are ignored. */
9465 width = pbm_scan_number (&p, end);
9466 height = pbm_scan_number (&p, end);
9467
9468 if (type != PBM_MONO)
9469 {
9470 max_color_idx = pbm_scan_number (&p, end);
9471 if (raw_p && max_color_idx > 255)
9472 max_color_idx = 255;
9473 }
9474
9475 if (width < 0
9476 || height < 0
9477 || (type != PBM_MONO && max_color_idx < 0))
9478 goto error;
9479
9480 BLOCK_INPUT;
9481 if (!x_create_x_image_and_pixmap (f, width, height, 0,
9482 &ximg, &img->pixmap))
9483 {
9484 UNBLOCK_INPUT;
9485 goto error;
9486 }
9487
9488 /* Initialize the color hash table. */
9489 init_color_table ();
9490
9491 if (type == PBM_MONO)
9492 {
9493 int c = 0, g;
9494
9495 for (y = 0; y < height; ++y)
9496 for (x = 0; x < width; ++x)
9497 {
9498 if (raw_p)
9499 {
9500 if ((x & 7) == 0)
9501 c = *p++;
9502 g = c & 0x80;
9503 c <<= 1;
9504 }
9505 else
9506 g = pbm_scan_number (&p, end);
9507
9508 XPutPixel (ximg, x, y, (g
9509 ? FRAME_FOREGROUND_PIXEL (f)
9510 : FRAME_BACKGROUND_PIXEL (f)));
9511 }
9512 }
9513 else
9514 {
9515 for (y = 0; y < height; ++y)
9516 for (x = 0; x < width; ++x)
9517 {
9518 int r, g, b;
9519
9520 if (type == PBM_GRAY)
9521 r = g = b = raw_p ? *p++ : pbm_scan_number (&p, end);
9522 else if (raw_p)
9523 {
9524 r = *p++;
9525 g = *p++;
9526 b = *p++;
9527 }
9528 else
9529 {
9530 r = pbm_scan_number (&p, end);
9531 g = pbm_scan_number (&p, end);
9532 b = pbm_scan_number (&p, end);
9533 }
9534
9535 if (r < 0 || g < 0 || b < 0)
9536 {
9537b xfree (ximg->data);
9538 ximg->data = NULL;
9539 XDestroyImage (ximg);
9540 UNBLOCK_INPUT;
9541 image_error ("Invalid pixel value in image `%s'",
9542 img->spec, Qnil);
9543 goto error;
9544 }
9545
9546 /* RGB values are now in the range 0..max_color_idx.
9547 Scale this to the range 0..0xffff supported by X. */
9548 r = (double) r * 65535 / max_color_idx;
9549 g = (double) g * 65535 / max_color_idx;
9550 b = (double) b * 65535 / max_color_idx;
9551 XPutPixel (ximg, x, y, lookup_rgb_color (f, r, g, b));
9552 }
9553 }
9554
9555 /* Store in IMG->colors the colors allocated for the image, and
9556 free the color table. */
9557 img->colors = colors_in_color_table (&img->ncolors);
9558 free_color_table ();
9559
9560 /* Put the image into a pixmap. */
9561 x_put_x_image (f, ximg, img->pixmap, width, height);
9562 x_destroy_x_image (ximg);
9563 UNBLOCK_INPUT;
9564
9565 img->width = width;
9566 img->height = height;
9567
9568 UNGCPRO;
9569 xfree (contents);
9570 return 1;
9571}
9572#endif /* HAVE_PBM */
9573
9574\f
9575/***********************************************************************
9576 PNG
9577 ***********************************************************************/
9578
9579#if HAVE_PNG
9580
9581#include <png.h>
9582
9583/* Function prototypes. */
9584
9585static int png_image_p P_ ((Lisp_Object object));
9586static int png_load P_ ((struct frame *f, struct image *img));
9587
9588/* The symbol `png' identifying images of this type. */
9589
9590Lisp_Object Qpng;
9591
9592/* Indices of image specification fields in png_format, below. */
9593
9594enum png_keyword_index
9595{
9596 PNG_TYPE,
9597 PNG_DATA,
9598 PNG_FILE,
9599 PNG_ASCENT,
9600 PNG_MARGIN,
9601 PNG_RELIEF,
9602 PNG_ALGORITHM,
9603 PNG_HEURISTIC_MASK,
9604 PNG_LAST
9605};
9606
9607/* Vector of image_keyword structures describing the format
9608 of valid user-defined image specifications. */
9609
9610static struct image_keyword png_format[PNG_LAST] =
9611{
9612 {":type", IMAGE_SYMBOL_VALUE, 1},
9613 {":data", IMAGE_STRING_VALUE, 0},
9614 {":file", IMAGE_STRING_VALUE, 0},
9615 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
9616 {":margin", IMAGE_POSITIVE_INTEGER_VALUE, 0},
9617 {":relief", IMAGE_INTEGER_VALUE, 0},
9618 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
9619 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
9620};
9621
9622/* Structure describing the image type `png'. */
9623
9624static struct image_type png_type =
9625{
9626 &Qpng,
9627 png_image_p,
9628 png_load,
9629 x_clear_image,
9630 NULL
9631};
9632
9633
9634/* Return non-zero if OBJECT is a valid PNG image specification. */
9635
9636static int
9637png_image_p (object)
9638 Lisp_Object object;
9639{
9640 struct image_keyword fmt[PNG_LAST];
9641 bcopy (png_format, fmt, sizeof fmt);
9642
9643 if (!parse_image_spec (object, fmt, PNG_LAST, Qpng)
9644 || (fmt[PNG_ASCENT].count
9645 && XFASTINT (fmt[PNG_ASCENT].value) > 100))
9646 return 0;
9647
9648 /* Must specify either the :data or :file keyword. */
9649 return fmt[PNG_FILE].count + fmt[PNG_DATA].count == 1;
9650}
9651
9652
9653/* Error and warning handlers installed when the PNG library
9654 is initialized. */
9655
9656static void
9657my_png_error (png_ptr, msg)
9658 png_struct *png_ptr;
9659 char *msg;
9660{
9661 xassert (png_ptr != NULL);
9662 image_error ("PNG error: %s", build_string (msg), Qnil);
9663 longjmp (png_ptr->jmpbuf, 1);
9664}
9665
9666
9667static void
9668my_png_warning (png_ptr, msg)
9669 png_struct *png_ptr;
9670 char *msg;
9671{
9672 xassert (png_ptr != NULL);
9673 image_error ("PNG warning: %s", build_string (msg), Qnil);
9674}
9675
9676
9677/* Memory source for PNG decoding. */
9678
9679struct png_memory_storage
9680{
9681 unsigned char *bytes; /* The data */
9682 size_t len; /* How big is it? */
9683 int index; /* Where are we? */
9684};
9685
9686
9687/* Function set as reader function when reading PNG image from memory.
9688 PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
9689 bytes from the input to DATA. */
9690
9691static void
9692png_read_from_memory (png_ptr, data, length)
9693 png_structp png_ptr;
9694 png_bytep data;
9695 png_size_t length;
9696{
9697 struct png_memory_storage *tbr
9698 = (struct png_memory_storage *) png_get_io_ptr (png_ptr);
9699
9700 if (length > tbr->len - tbr->index)
9701 png_error (png_ptr, "Read error");
9702
9703 bcopy (tbr->bytes + tbr->index, data, length);
9704 tbr->index = tbr->index + length;
9705}
9706
9707
9708/* Load PNG image IMG for use on frame F. Value is non-zero if
9709 successful. */
9710
9711static int
9712png_load (f, img)
9713 struct frame *f;
9714 struct image *img;
9715{
9716 Lisp_Object file, specified_file;
9717 Lisp_Object specified_data;
9718 int x, y, i;
9719 XImage *ximg, *mask_img = NULL;
9720 struct gcpro gcpro1;
9721 png_struct *png_ptr = NULL;
9722 png_info *info_ptr = NULL, *end_info = NULL;
9723 FILE *fp = NULL;
9724 png_byte sig[8];
9725 png_byte *pixels = NULL;
9726 png_byte **rows = NULL;
9727 png_uint_32 width, height;
9728 int bit_depth, color_type, interlace_type;
9729 png_byte channels;
9730 png_uint_32 row_bytes;
9731 int transparent_p;
9732 char *gamma_str;
9733 double screen_gamma, image_gamma;
9734 int intent;
9735 struct png_memory_storage tbr; /* Data to be read */
9736
9737 /* Find out what file to load. */
9738 specified_file = image_spec_value (img->spec, QCfile, NULL);
9739 specified_data = image_spec_value (img->spec, QCdata, NULL);
9740 file = Qnil;
9741 GCPRO1 (file);
9742
9743 if (NILP (specified_data))
9744 {
9745 file = x_find_image_file (specified_file);
9746 if (!STRINGP (file))
9747 {
9748 image_error ("Cannot find image file `%s'", specified_file, Qnil);
9749 UNGCPRO;
9750 return 0;
9751 }
9752
9753 /* Open the image file. */
9754 fp = fopen (XSTRING (file)->data, "rb");
9755 if (!fp)
9756 {
9757 image_error ("Cannot open image file `%s'", file, Qnil);
9758 UNGCPRO;
9759 fclose (fp);
9760 return 0;
9761 }
9762
9763 /* Check PNG signature. */
9764 if (fread (sig, 1, sizeof sig, fp) != sizeof sig
9765 || !png_check_sig (sig, sizeof sig))
9766 {
9767 image_error ("Not a PNG file:` %s'", file, Qnil);
9768 UNGCPRO;
9769 fclose (fp);
9770 return 0;
9771 }
9772 }
9773 else
9774 {
9775 /* Read from memory. */
9776 tbr.bytes = XSTRING (specified_data)->data;
9777 tbr.len = STRING_BYTES (XSTRING (specified_data));
9778 tbr.index = 0;
9779
9780 /* Check PNG signature. */
9781 if (tbr.len < sizeof sig
9782 || !png_check_sig (tbr.bytes, sizeof sig))
9783 {
9784 image_error ("Not a PNG image: `%s'", img->spec, Qnil);
9785 UNGCPRO;
9786 return 0;
9787 }
9788
9789 /* Need to skip past the signature. */
9790 tbr.bytes += sizeof (sig);
9791 }
9792
9793
9794 /* Initialize read and info structs for PNG lib. */
9795 png_ptr = png_create_read_struct (PNG_LIBPNG_VER_STRING, NULL,
9796 my_png_error, my_png_warning);
9797 if (!png_ptr)
9798 {
9799 if (fp) fclose (fp);
9800 UNGCPRO;
9801 return 0;
9802 }
9803
9804 info_ptr = png_create_info_struct (png_ptr);
9805 if (!info_ptr)
9806 {
9807 png_destroy_read_struct (&png_ptr, NULL, NULL);
9808 if (fp) fclose (fp);
9809 UNGCPRO;
9810 return 0;
9811 }
9812
9813 end_info = png_create_info_struct (png_ptr);
9814 if (!end_info)
9815 {
9816 png_destroy_read_struct (&png_ptr, &info_ptr, NULL);
9817 if (fp) fclose (fp);
9818 UNGCPRO;
9819 return 0;
9820 }
9821
9822 /* Set error jump-back. We come back here when the PNG library
9823 detects an error. */
9824 if (setjmp (png_ptr->jmpbuf))
9825 {
9826 error:
9827 if (png_ptr)
9828 png_destroy_read_struct (&png_ptr, &info_ptr, &end_info);
9829 xfree (pixels);
9830 xfree (rows);
9831 if (fp) fclose (fp);
9832 UNGCPRO;
9833 return 0;
9834 }
9835
9836 /* Read image info. */
9837 if (!NILP (specified_data))
9838 png_set_read_fn (png_ptr, (void *) &tbr, png_read_from_memory);
9839 else
9840 png_init_io (png_ptr, fp);
9841
9842 png_set_sig_bytes (png_ptr, sizeof sig);
9843 png_read_info (png_ptr, info_ptr);
9844 png_get_IHDR (png_ptr, info_ptr, &width, &height, &bit_depth, &color_type,
9845 &interlace_type, NULL, NULL);
9846
9847 /* If image contains simply transparency data, we prefer to
9848 construct a clipping mask. */
9849 if (png_get_valid (png_ptr, info_ptr, PNG_INFO_tRNS))
9850 transparent_p = 1;
9851 else
9852 transparent_p = 0;
9853
9854 /* This function is easier to write if we only have to handle
9855 one data format: RGB or RGBA with 8 bits per channel. Let's
9856 transform other formats into that format. */
9857
9858 /* Strip more than 8 bits per channel. */
9859 if (bit_depth == 16)
9860 png_set_strip_16 (png_ptr);
9861
9862 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
9863 if available. */
9864 png_set_expand (png_ptr);
9865
9866 /* Convert grayscale images to RGB. */
9867 if (color_type == PNG_COLOR_TYPE_GRAY
9868 || color_type == PNG_COLOR_TYPE_GRAY_ALPHA)
9869 png_set_gray_to_rgb (png_ptr);
9870
9871 /* The value 2.2 is a guess for PC monitors from PNG example.c. */
9872 gamma_str = getenv ("SCREEN_GAMMA");
9873 screen_gamma = gamma_str ? atof (gamma_str) : 2.2;
9874
9875 /* Tell the PNG lib to handle gamma correction for us. */
9876
9877#if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
9878 if (png_get_sRGB (png_ptr, info_ptr, &intent))
9879 /* There is a special chunk in the image specifying the gamma. */
9880 png_set_sRGB (png_ptr, info_ptr, intent);
9881 else
9882#endif
9883 if (png_get_gAMA (png_ptr, info_ptr, &image_gamma))
9884 /* Image contains gamma information. */
9885 png_set_gamma (png_ptr, screen_gamma, image_gamma);
9886 else
9887 /* Use a default of 0.5 for the image gamma. */
9888 png_set_gamma (png_ptr, screen_gamma, 0.5);
9889
9890 /* Handle alpha channel by combining the image with a background
9891 color. Do this only if a real alpha channel is supplied. For
9892 simple transparency, we prefer a clipping mask. */
9893 if (!transparent_p)
9894 {
9895 png_color_16 *image_background;
9896
9897 if (png_get_bKGD (png_ptr, info_ptr, &image_background))
9898 /* Image contains a background color with which to
9899 combine the image. */
9900 png_set_background (png_ptr, image_background,
9901 PNG_BACKGROUND_GAMMA_FILE, 1, 1.0);
9902 else
9903 {
9904 /* Image does not contain a background color with which
9905 to combine the image data via an alpha channel. Use
9906 the frame's background instead. */
9907 XColor color;
9908 Colormap cmap;
9909 png_color_16 frame_background;
9910
9911 BLOCK_INPUT;
9912 cmap = DefaultColormapOfScreen (FRAME_X_SCREEN (f));
9913 color.pixel = FRAME_BACKGROUND_PIXEL (f);
9914 XQueryColor (FRAME_W32_DISPLAY (f), cmap, &color);
9915 UNBLOCK_INPUT;
9916
9917 bzero (&frame_background, sizeof frame_background);
9918 frame_background.red = color.red;
9919 frame_background.green = color.green;
9920 frame_background.blue = color.blue;
9921
9922 png_set_background (png_ptr, &frame_background,
9923 PNG_BACKGROUND_GAMMA_SCREEN, 0, 1.0);
9924 }
9925 }
9926
9927 /* Update info structure. */
9928 png_read_update_info (png_ptr, info_ptr);
9929
9930 /* Get number of channels. Valid values are 1 for grayscale images
9931 and images with a palette, 2 for grayscale images with transparency
9932 information (alpha channel), 3 for RGB images, and 4 for RGB
9933 images with alpha channel, i.e. RGBA. If conversions above were
9934 sufficient we should only have 3 or 4 channels here. */
9935 channels = png_get_channels (png_ptr, info_ptr);
9936 xassert (channels == 3 || channels == 4);
9937
9938 /* Number of bytes needed for one row of the image. */
9939 row_bytes = png_get_rowbytes (png_ptr, info_ptr);
9940
9941 /* Allocate memory for the image. */
9942 pixels = (png_byte *) xmalloc (row_bytes * height * sizeof *pixels);
9943 rows = (png_byte **) xmalloc (height * sizeof *rows);
9944 for (i = 0; i < height; ++i)
9945 rows[i] = pixels + i * row_bytes;
9946
9947 /* Read the entire image. */
9948 png_read_image (png_ptr, rows);
9949 png_read_end (png_ptr, info_ptr);
9950 if (fp)
9951 {
9952 fclose (fp);
9953 fp = NULL;
9954 }
9955
9956 BLOCK_INPUT;
9957
9958 /* Create the X image and pixmap. */
9959 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg,
9960 &img->pixmap))
9961 {
9962 UNBLOCK_INPUT;
9963 goto error;
9964 }
9965
9966 /* Create an image and pixmap serving as mask if the PNG image
9967 contains an alpha channel. */
9968 if (channels == 4
9969 && !transparent_p
9970 && !x_create_x_image_and_pixmap (f, width, height, 1,
9971 &mask_img, &img->mask))
9972 {
9973 x_destroy_x_image (ximg);
9974 XFreePixmap (FRAME_W32_DISPLAY (f), img->pixmap);
9975 img->pixmap = 0;
9976 UNBLOCK_INPUT;
9977 goto error;
9978 }
9979
9980 /* Fill the X image and mask from PNG data. */
9981 init_color_table ();
9982
9983 for (y = 0; y < height; ++y)
9984 {
9985 png_byte *p = rows[y];
9986
9987 for (x = 0; x < width; ++x)
9988 {
9989 unsigned r, g, b;
9990
9991 r = *p++ << 8;
9992 g = *p++ << 8;
9993 b = *p++ << 8;
9994 XPutPixel (ximg, x, y, lookup_rgb_color (f, r, g, b));
9995
9996 /* An alpha channel, aka mask channel, associates variable
9997 transparency with an image. Where other image formats
9998 support binary transparency---fully transparent or fully
9999 opaque---PNG allows up to 254 levels of partial transparency.
10000 The PNG library implements partial transparency by combining
10001 the image with a specified background color.
10002
10003 I'm not sure how to handle this here nicely: because the
10004 background on which the image is displayed may change, for
10005 real alpha channel support, it would be necessary to create
10006 a new image for each possible background.
10007
10008 What I'm doing now is that a mask is created if we have
10009 boolean transparency information. Otherwise I'm using
10010 the frame's background color to combine the image with. */
10011
10012 if (channels == 4)
10013 {
10014 if (mask_img)
10015 XPutPixel (mask_img, x, y, *p > 0);
10016 ++p;
10017 }
10018 }
10019 }
10020
10021 /* Remember colors allocated for this image. */
10022 img->colors = colors_in_color_table (&img->ncolors);
10023 free_color_table ();
10024
10025 /* Clean up. */
10026 png_destroy_read_struct (&png_ptr, &info_ptr, &end_info);
10027 xfree (rows);
10028 xfree (pixels);
10029
10030 img->width = width;
10031 img->height = height;
10032
10033 /* Put the image into the pixmap, then free the X image and its buffer. */
10034 x_put_x_image (f, ximg, img->pixmap, width, height);
10035 x_destroy_x_image (ximg);
10036
10037 /* Same for the mask. */
10038 if (mask_img)
10039 {
10040 x_put_x_image (f, mask_img, img->mask, img->width, img->height);
10041 x_destroy_x_image (mask_img);
10042 }
10043
10044 UNBLOCK_INPUT;
10045 UNGCPRO;
10046 return 1;
10047}
10048
10049#endif /* HAVE_PNG != 0 */
10050
10051
10052\f
10053/***********************************************************************
10054 JPEG
10055 ***********************************************************************/
10056
10057#if HAVE_JPEG
10058
10059/* Work around a warning about HAVE_STDLIB_H being redefined in
10060 jconfig.h. */
10061#ifdef HAVE_STDLIB_H
10062#define HAVE_STDLIB_H_1
10063#undef HAVE_STDLIB_H
10064#endif /* HAVE_STLIB_H */
10065
10066#include <jpeglib.h>
10067#include <jerror.h>
10068#include <setjmp.h>
10069
10070#ifdef HAVE_STLIB_H_1
10071#define HAVE_STDLIB_H 1
10072#endif
10073
10074static int jpeg_image_p P_ ((Lisp_Object object));
10075static int jpeg_load P_ ((struct frame *f, struct image *img));
10076
10077/* The symbol `jpeg' identifying images of this type. */
10078
10079Lisp_Object Qjpeg;
10080
10081/* Indices of image specification fields in gs_format, below. */
10082
10083enum jpeg_keyword_index
10084{
10085 JPEG_TYPE,
10086 JPEG_DATA,
10087 JPEG_FILE,
10088 JPEG_ASCENT,
10089 JPEG_MARGIN,
10090 JPEG_RELIEF,
10091 JPEG_ALGORITHM,
10092 JPEG_HEURISTIC_MASK,
10093 JPEG_LAST
10094};
10095
10096/* Vector of image_keyword structures describing the format
10097 of valid user-defined image specifications. */
10098
10099static struct image_keyword jpeg_format[JPEG_LAST] =
10100{
10101 {":type", IMAGE_SYMBOL_VALUE, 1},
10102 {":data", IMAGE_STRING_VALUE, 0},
10103 {":file", IMAGE_STRING_VALUE, 0},
10104 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
10105 {":margin", IMAGE_POSITIVE_INTEGER_VALUE, 0},
10106 {":relief", IMAGE_INTEGER_VALUE, 0},
10107 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
10108 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
10109};
10110
10111/* Structure describing the image type `jpeg'. */
10112
10113static struct image_type jpeg_type =
10114{
10115 &Qjpeg,
10116 jpeg_image_p,
10117 jpeg_load,
10118 x_clear_image,
10119 NULL
10120};
10121
10122
10123/* Return non-zero if OBJECT is a valid JPEG image specification. */
10124
10125static int
10126jpeg_image_p (object)
10127 Lisp_Object object;
10128{
10129 struct image_keyword fmt[JPEG_LAST];
10130
10131 bcopy (jpeg_format, fmt, sizeof fmt);
10132
10133 if (!parse_image_spec (object, fmt, JPEG_LAST, Qjpeg)
10134 || (fmt[JPEG_ASCENT].count
10135 && XFASTINT (fmt[JPEG_ASCENT].value) > 100))
10136 return 0;
10137
10138 /* Must specify either the :data or :file keyword. */
10139 return fmt[JPEG_FILE].count + fmt[JPEG_DATA].count == 1;
10140}
10141
10142
10143struct my_jpeg_error_mgr
10144{
10145 struct jpeg_error_mgr pub;
10146 jmp_buf setjmp_buffer;
10147};
10148
10149static void
10150my_error_exit (cinfo)
10151 j_common_ptr cinfo;
10152{
10153 struct my_jpeg_error_mgr *mgr = (struct my_jpeg_error_mgr *) cinfo->err;
10154 longjmp (mgr->setjmp_buffer, 1);
10155}
10156
10157
10158/* Init source method for JPEG data source manager. Called by
10159 jpeg_read_header() before any data is actually read. See
10160 libjpeg.doc from the JPEG lib distribution. */
10161
10162static void
10163our_init_source (cinfo)
10164 j_decompress_ptr cinfo;
10165{
10166}
10167
10168
10169/* Fill input buffer method for JPEG data source manager. Called
10170 whenever more data is needed. We read the whole image in one step,
10171 so this only adds a fake end of input marker at the end. */
10172
10173static boolean
10174our_fill_input_buffer (cinfo)
10175 j_decompress_ptr cinfo;
10176{
10177 /* Insert a fake EOI marker. */
10178 struct jpeg_source_mgr *src = cinfo->src;
10179 static JOCTET buffer[2];
10180
10181 buffer[0] = (JOCTET) 0xFF;
10182 buffer[1] = (JOCTET) JPEG_EOI;
10183
10184 src->next_input_byte = buffer;
10185 src->bytes_in_buffer = 2;
10186 return TRUE;
10187}
10188
10189
10190/* Method to skip over NUM_BYTES bytes in the image data. CINFO->src
10191 is the JPEG data source manager. */
10192
10193static void
10194our_skip_input_data (cinfo, num_bytes)
10195 j_decompress_ptr cinfo;
10196 long num_bytes;
10197{
10198 struct jpeg_source_mgr *src = (struct jpeg_source_mgr *) cinfo->src;
10199
10200 if (src)
10201 {
10202 if (num_bytes > src->bytes_in_buffer)
10203 ERREXIT (cinfo, JERR_INPUT_EOF);
10204
10205 src->bytes_in_buffer -= num_bytes;
10206 src->next_input_byte += num_bytes;
10207 }
10208}
10209
10210
10211/* Method to terminate data source. Called by
10212 jpeg_finish_decompress() after all data has been processed. */
10213
10214static void
10215our_term_source (cinfo)
10216 j_decompress_ptr cinfo;
10217{
10218}
10219
10220
10221/* Set up the JPEG lib for reading an image from DATA which contains
10222 LEN bytes. CINFO is the decompression info structure created for
10223 reading the image. */
10224
10225static void
10226jpeg_memory_src (cinfo, data, len)
10227 j_decompress_ptr cinfo;
10228 JOCTET *data;
10229 unsigned int len;
10230{
10231 struct jpeg_source_mgr *src;
10232
10233 if (cinfo->src == NULL)
10234 {
10235 /* First time for this JPEG object? */
10236 cinfo->src = (struct jpeg_source_mgr *)
10237 (*cinfo->mem->alloc_small) ((j_common_ptr) cinfo, JPOOL_PERMANENT,
10238 sizeof (struct jpeg_source_mgr));
10239 src = (struct jpeg_source_mgr *) cinfo->src;
10240 src->next_input_byte = data;
10241 }
10242
10243 src = (struct jpeg_source_mgr *) cinfo->src;
10244 src->init_source = our_init_source;
10245 src->fill_input_buffer = our_fill_input_buffer;
10246 src->skip_input_data = our_skip_input_data;
10247 src->resync_to_restart = jpeg_resync_to_restart; /* Use default method. */
10248 src->term_source = our_term_source;
10249 src->bytes_in_buffer = len;
10250 src->next_input_byte = data;
10251}
10252
10253
10254/* Load image IMG for use on frame F. Patterned after example.c
10255 from the JPEG lib. */
10256
10257static int
10258jpeg_load (f, img)
10259 struct frame *f;
10260 struct image *img;
10261{
10262 struct jpeg_decompress_struct cinfo;
10263 struct my_jpeg_error_mgr mgr;
10264 Lisp_Object file, specified_file;
10265 Lisp_Object specified_data;
10266 FILE *fp = NULL;
10267 JSAMPARRAY buffer;
10268 int row_stride, x, y;
10269 XImage *ximg = NULL;
10270 int rc;
10271 unsigned long *colors;
10272 int width, height;
10273 struct gcpro gcpro1;
10274
10275 /* Open the JPEG file. */
10276 specified_file = image_spec_value (img->spec, QCfile, NULL);
10277 specified_data = image_spec_value (img->spec, QCdata, NULL);
10278 file = Qnil;
10279 GCPRO1 (file);
10280
10281
10282 if (NILP (specified_data))
10283 {
10284 file = x_find_image_file (specified_file);
10285 if (!STRINGP (file))
10286 {
10287 image_error ("Cannot find image file `%s'", specified_file, Qnil);
10288 UNGCPRO;
10289 return 0;
10290 }
10291
10292 fp = fopen (XSTRING (file)->data, "r");
10293 if (fp == NULL)
10294 {
10295 image_error ("Cannot open `%s'", file, Qnil);
10296 UNGCPRO;
10297 return 0;
10298 }
10299 }
10300
10301 /* Customize libjpeg's error handling to call my_error_exit when an
10302 error is detected. This function will perform a longjmp. */
10303 mgr.pub.error_exit = my_error_exit;
10304 cinfo.err = jpeg_std_error (&mgr.pub);
10305
10306 if ((rc = setjmp (mgr.setjmp_buffer)) != 0)
10307 {
10308 if (rc == 1)
10309 {
10310 /* Called from my_error_exit. Display a JPEG error. */
10311 char buffer[JMSG_LENGTH_MAX];
10312 cinfo.err->format_message ((j_common_ptr) &cinfo, buffer);
10313 image_error ("Error reading JPEG image `%s': %s", img->spec,
10314 build_string (buffer));
10315 }
10316
10317 /* Close the input file and destroy the JPEG object. */
10318 if (fp)
10319 fclose (fp);
10320 jpeg_destroy_decompress (&cinfo);
10321
10322 BLOCK_INPUT;
10323
10324 /* If we already have an XImage, free that. */
10325 x_destroy_x_image (ximg);
10326
10327 /* Free pixmap and colors. */
10328 x_clear_image (f, img);
10329
10330 UNBLOCK_INPUT;
10331 UNGCPRO;
10332 return 0;
10333 }
10334
10335 /* Create the JPEG decompression object. Let it read from fp.
10336 Read the JPEG image header. */
10337 jpeg_create_decompress (&cinfo);
10338
10339 if (NILP (specified_data))
10340 jpeg_stdio_src (&cinfo, fp);
10341 else
10342 jpeg_memory_src (&cinfo, XSTRING (specified_data)->data,
10343 STRING_BYTES (XSTRING (specified_data)));
10344
10345 jpeg_read_header (&cinfo, TRUE);
10346
10347 /* Customize decompression so that color quantization will be used.
10348 Start decompression. */
10349 cinfo.quantize_colors = TRUE;
10350 jpeg_start_decompress (&cinfo);
10351 width = img->width = cinfo.output_width;
10352 height = img->height = cinfo.output_height;
10353
10354 BLOCK_INPUT;
10355
10356 /* Create X image and pixmap. */
10357 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg,
10358 &img->pixmap))
10359 {
10360 UNBLOCK_INPUT;
10361 longjmp (mgr.setjmp_buffer, 2);
10362 }
10363
10364 /* Allocate colors. When color quantization is used,
10365 cinfo.actual_number_of_colors has been set with the number of
10366 colors generated, and cinfo.colormap is a two-dimensional array
10367 of color indices in the range 0..cinfo.actual_number_of_colors.
10368 No more than 255 colors will be generated. */
10369 {
10370 int i, ir, ig, ib;
10371
10372 if (cinfo.out_color_components > 2)
10373 ir = 0, ig = 1, ib = 2;
10374 else if (cinfo.out_color_components > 1)
10375 ir = 0, ig = 1, ib = 0;
10376 else
10377 ir = 0, ig = 0, ib = 0;
10378
10379 /* Use the color table mechanism because it handles colors that
10380 cannot be allocated nicely. Such colors will be replaced with
10381 a default color, and we don't have to care about which colors
10382 can be freed safely, and which can't. */
10383 init_color_table ();
10384 colors = (unsigned long *) alloca (cinfo.actual_number_of_colors
10385 * sizeof *colors);
10386
10387 for (i = 0; i < cinfo.actual_number_of_colors; ++i)
10388 {
10389 /* Multiply RGB values with 255 because X expects RGB values
10390 in the range 0..0xffff. */
10391 int r = cinfo.colormap[ir][i] << 8;
10392 int g = cinfo.colormap[ig][i] << 8;
10393 int b = cinfo.colormap[ib][i] << 8;
10394 colors[i] = lookup_rgb_color (f, r, g, b);
10395 }
10396
10397 /* Remember those colors actually allocated. */
10398 img->colors = colors_in_color_table (&img->ncolors);
10399 free_color_table ();
10400 }
10401
10402 /* Read pixels. */
10403 row_stride = width * cinfo.output_components;
10404 buffer = cinfo.mem->alloc_sarray ((j_common_ptr) &cinfo, JPOOL_IMAGE,
10405 row_stride, 1);
10406 for (y = 0; y < height; ++y)
10407 {
10408 jpeg_read_scanlines (&cinfo, buffer, 1);
10409 for (x = 0; x < cinfo.output_width; ++x)
10410 XPutPixel (ximg, x, y, colors[buffer[0][x]]);
10411 }
10412
10413 /* Clean up. */
10414 jpeg_finish_decompress (&cinfo);
10415 jpeg_destroy_decompress (&cinfo);
10416 if (fp)
10417 fclose (fp);
10418
10419 /* Put the image into the pixmap. */
10420 x_put_x_image (f, ximg, img->pixmap, width, height);
10421 x_destroy_x_image (ximg);
10422 UNBLOCK_INPUT;
10423 UNGCPRO;
10424 return 1;
10425}
10426
10427#endif /* HAVE_JPEG */
10428
10429
10430\f
10431/***********************************************************************
10432 TIFF
10433 ***********************************************************************/
10434
10435#if HAVE_TIFF
10436
10437#include <tiffio.h>
10438
10439static int tiff_image_p P_ ((Lisp_Object object));
10440static int tiff_load P_ ((struct frame *f, struct image *img));
10441
10442/* The symbol `tiff' identifying images of this type. */
10443
10444Lisp_Object Qtiff;
10445
10446/* Indices of image specification fields in tiff_format, below. */
10447
10448enum tiff_keyword_index
10449{
10450 TIFF_TYPE,
10451 TIFF_DATA,
10452 TIFF_FILE,
10453 TIFF_ASCENT,
10454 TIFF_MARGIN,
10455 TIFF_RELIEF,
10456 TIFF_ALGORITHM,
10457 TIFF_HEURISTIC_MASK,
10458 TIFF_LAST
10459};
10460
10461/* Vector of image_keyword structures describing the format
10462 of valid user-defined image specifications. */
10463
10464static struct image_keyword tiff_format[TIFF_LAST] =
10465{
10466 {":type", IMAGE_SYMBOL_VALUE, 1},
10467 {":data", IMAGE_STRING_VALUE, 0},
10468 {":file", IMAGE_STRING_VALUE, 0},
10469 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
10470 {":margin", IMAGE_POSITIVE_INTEGER_VALUE, 0},
10471 {":relief", IMAGE_INTEGER_VALUE, 0},
10472 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
10473 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
10474};
10475
10476/* Structure describing the image type `tiff'. */
10477
10478static struct image_type tiff_type =
10479{
10480 &Qtiff,
10481 tiff_image_p,
10482 tiff_load,
10483 x_clear_image,
10484 NULL
10485};
10486
10487
10488/* Return non-zero if OBJECT is a valid TIFF image specification. */
10489
10490static int
10491tiff_image_p (object)
10492 Lisp_Object object;
10493{
10494 struct image_keyword fmt[TIFF_LAST];
10495 bcopy (tiff_format, fmt, sizeof fmt);
10496
10497 if (!parse_image_spec (object, fmt, TIFF_LAST, Qtiff)
10498 || (fmt[TIFF_ASCENT].count
10499 && XFASTINT (fmt[TIFF_ASCENT].value) > 100))
10500 return 0;
10501
10502 /* Must specify either the :data or :file keyword. */
10503 return fmt[TIFF_FILE].count + fmt[TIFF_DATA].count == 1;
10504}
10505
10506
10507/* Reading from a memory buffer for TIFF images Based on the PNG
10508 memory source, but we have to provide a lot of extra functions.
10509 Blah.
10510
10511 We really only need to implement read and seek, but I am not
10512 convinced that the TIFF library is smart enough not to destroy
10513 itself if we only hand it the function pointers we need to
10514 override. */
10515
10516typedef struct
10517{
10518 unsigned char *bytes;
10519 size_t len;
10520 int index;
10521}
10522tiff_memory_source;
10523
10524static size_t
10525tiff_read_from_memory (data, buf, size)
10526 thandle_t data;
10527 tdata_t buf;
10528 tsize_t size;
10529{
10530 tiff_memory_source *src = (tiff_memory_source *) data;
10531
10532 if (size > src->len - src->index)
10533 return (size_t) -1;
10534 bcopy (src->bytes + src->index, buf, size);
10535 src->index += size;
10536 return size;
10537}
10538
10539static size_t
10540tiff_write_from_memory (data, buf, size)
10541 thandle_t data;
10542 tdata_t buf;
10543 tsize_t size;
10544{
10545 return (size_t) -1;
10546}
10547
10548static toff_t
10549tiff_seek_in_memory (data, off, whence)
10550 thandle_t data;
10551 toff_t off;
10552 int whence;
10553{
10554 tiff_memory_source *src = (tiff_memory_source *) data;
10555 int idx;
10556
10557 switch (whence)
10558 {
10559 case SEEK_SET: /* Go from beginning of source. */
10560 idx = off;
10561 break;
10562
10563 case SEEK_END: /* Go from end of source. */
10564 idx = src->len + off;
10565 break;
10566
10567 case SEEK_CUR: /* Go from current position. */
10568 idx = src->index + off;
10569 break;
10570
10571 default: /* Invalid `whence'. */
10572 return -1;
10573 }
10574
10575 if (idx > src->len || idx < 0)
10576 return -1;
10577
10578 src->index = idx;
10579 return src->index;
10580}
10581
10582static int
10583tiff_close_memory (data)
10584 thandle_t data;
10585{
10586 /* NOOP */
10587 return 0;
10588}
10589
10590static int
10591tiff_mmap_memory (data, pbase, psize)
10592 thandle_t data;
10593 tdata_t *pbase;
10594 toff_t *psize;
10595{
10596 /* It is already _IN_ memory. */
10597 return 0;
10598}
10599
10600static void
10601tiff_unmap_memory (data, base, size)
10602 thandle_t data;
10603 tdata_t base;
10604 toff_t size;
10605{
10606 /* We don't need to do this. */
10607}
10608
10609static toff_t
10610tiff_size_of_memory (data)
10611 thandle_t data;
10612{
10613 return ((tiff_memory_source *) data)->len;
10614}
10615
10616
10617/* Load TIFF image IMG for use on frame F. Value is non-zero if
10618 successful. */
10619
10620static int
10621tiff_load (f, img)
10622 struct frame *f;
10623 struct image *img;
10624{
10625 Lisp_Object file, specified_file;
10626 Lisp_Object specified_data;
10627 TIFF *tiff;
10628 int width, height, x, y;
10629 uint32 *buf;
10630 int rc;
10631 XImage *ximg;
10632 struct gcpro gcpro1;
10633 tiff_memory_source memsrc;
10634
10635 specified_file = image_spec_value (img->spec, QCfile, NULL);
10636 specified_data = image_spec_value (img->spec, QCdata, NULL);
10637 file = Qnil;
10638 GCPRO1 (file);
10639
10640 if (NILP (specified_data))
10641 {
10642 /* Read from a file */
10643 file = x_find_image_file (specified_file);
10644 if (!STRINGP (file))
10645 {
10646 image_error ("Cannot find image file `%s'", file, Qnil);
10647 UNGCPRO;
10648 return 0;
10649 }
10650
10651 /* Try to open the image file. */
10652 tiff = TIFFOpen (XSTRING (file)->data, "r");
10653 if (tiff == NULL)
10654 {
10655 image_error ("Cannot open `%s'", file, Qnil);
10656 UNGCPRO;
10657 return 0;
10658 }
10659 }
10660 else
10661 {
10662 /* Memory source! */
10663 memsrc.bytes = XSTRING (specified_data)->data;
10664 memsrc.len = STRING_BYTES (XSTRING (specified_data));
10665 memsrc.index = 0;
10666
10667 tiff = TIFFClientOpen ("memory_source", "r", &memsrc,
10668 (TIFFReadWriteProc) tiff_read_from_memory,
10669 (TIFFReadWriteProc) tiff_write_from_memory,
10670 tiff_seek_in_memory,
10671 tiff_close_memory,
10672 tiff_size_of_memory,
10673 tiff_mmap_memory,
10674 tiff_unmap_memory);
10675
10676 if (!tiff)
10677 {
10678 image_error ("Cannot open memory source for `%s'", img->spec, Qnil);
10679 UNGCPRO;
10680 return 0;
10681 }
10682 }
10683
10684 /* Get width and height of the image, and allocate a raster buffer
10685 of width x height 32-bit values. */
10686 TIFFGetField (tiff, TIFFTAG_IMAGEWIDTH, &width);
10687 TIFFGetField (tiff, TIFFTAG_IMAGELENGTH, &height);
10688 buf = (uint32 *) xmalloc (width * height * sizeof *buf);
10689
10690 rc = TIFFReadRGBAImage (tiff, width, height, buf, 0);
10691 TIFFClose (tiff);
10692 if (!rc)
10693 {
10694 image_error ("Error reading TIFF image `%s'", img->spec, Qnil);
10695 xfree (buf);
10696 UNGCPRO;
10697 return 0;
10698 }
10699
10700 BLOCK_INPUT;
10701
10702 /* Create the X image and pixmap. */
10703 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg, &img->pixmap))
10704 {
10705 UNBLOCK_INPUT;
10706 xfree (buf);
10707 UNGCPRO;
10708 return 0;
10709 }
10710
10711 /* Initialize the color table. */
10712 init_color_table ();
10713
10714 /* Process the pixel raster. Origin is in the lower-left corner. */
10715 for (y = 0; y < height; ++y)
10716 {
10717 uint32 *row = buf + y * width;
10718
10719 for (x = 0; x < width; ++x)
10720 {
10721 uint32 abgr = row[x];
10722 int r = TIFFGetR (abgr) << 8;
10723 int g = TIFFGetG (abgr) << 8;
10724 int b = TIFFGetB (abgr) << 8;
10725 XPutPixel (ximg, x, height - 1 - y, lookup_rgb_color (f, r, g, b));
10726 }
10727 }
10728
10729 /* Remember the colors allocated for the image. Free the color table. */
10730 img->colors = colors_in_color_table (&img->ncolors);
10731 free_color_table ();
10732
10733 /* Put the image into the pixmap, then free the X image and its buffer. */
10734 x_put_x_image (f, ximg, img->pixmap, width, height);
10735 x_destroy_x_image (ximg);
10736 xfree (buf);
10737 UNBLOCK_INPUT;
10738
10739 img->width = width;
10740 img->height = height;
10741
10742 UNGCPRO;
10743 return 1;
10744}
10745
10746#endif /* HAVE_TIFF != 0 */
10747
10748
10749\f
10750/***********************************************************************
10751 GIF
10752 ***********************************************************************/
10753
10754#if HAVE_GIF
10755
10756#include <gif_lib.h>
10757
10758static int gif_image_p P_ ((Lisp_Object object));
10759static int gif_load P_ ((struct frame *f, struct image *img));
10760
10761/* The symbol `gif' identifying images of this type. */
10762
10763Lisp_Object Qgif;
10764
10765/* Indices of image specification fields in gif_format, below. */
10766
10767enum gif_keyword_index
10768{
10769 GIF_TYPE,
10770 GIF_DATA,
10771 GIF_FILE,
10772 GIF_ASCENT,
10773 GIF_MARGIN,
10774 GIF_RELIEF,
10775 GIF_ALGORITHM,
10776 GIF_HEURISTIC_MASK,
10777 GIF_IMAGE,
10778 GIF_LAST
10779};
10780
10781/* Vector of image_keyword structures describing the format
10782 of valid user-defined image specifications. */
10783
10784static struct image_keyword gif_format[GIF_LAST] =
10785{
10786 {":type", IMAGE_SYMBOL_VALUE, 1},
10787 {":data", IMAGE_STRING_VALUE, 0},
10788 {":file", IMAGE_STRING_VALUE, 0},
10789 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
10790 {":margin", IMAGE_POSITIVE_INTEGER_VALUE, 0},
10791 {":relief", IMAGE_INTEGER_VALUE, 0},
10792 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
10793 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
10794 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0}
10795};
10796
10797/* Structure describing the image type `gif'. */
10798
10799static struct image_type gif_type =
10800{
10801 &Qgif,
10802 gif_image_p,
10803 gif_load,
10804 x_clear_image,
10805 NULL
10806};
10807
10808/* Return non-zero if OBJECT is a valid GIF image specification. */
10809
10810static int
10811gif_image_p (object)
10812 Lisp_Object object;
10813{
10814 struct image_keyword fmt[GIF_LAST];
10815 bcopy (gif_format, fmt, sizeof fmt);
10816
10817 if (!parse_image_spec (object, fmt, GIF_LAST, Qgif)
10818 || (fmt[GIF_ASCENT].count
10819 && XFASTINT (fmt[GIF_ASCENT].value) > 100))
10820 return 0;
10821
10822 /* Must specify either the :data or :file keyword. */
10823 return fmt[GIF_FILE].count + fmt[GIF_DATA].count == 1;
10824}
10825
10826/* Reading a GIF image from memory
10827 Based on the PNG memory stuff to a certain extent. */
10828
10829typedef struct
10830{
10831 unsigned char *bytes;
10832 size_t len;
10833 int index;
10834}
10835gif_memory_source;
10836
10837/* Make the current memory source available to gif_read_from_memory.
10838 It's done this way because not all versions of libungif support
10839 a UserData field in the GifFileType structure. */
10840static gif_memory_source *current_gif_memory_src;
10841
10842static int
10843gif_read_from_memory (file, buf, len)
10844 GifFileType *file;
10845 GifByteType *buf;
10846 int len;
10847{
10848 gif_memory_source *src = current_gif_memory_src;
10849
10850 if (len > src->len - src->index)
10851 return -1;
10852
10853 bcopy (src->bytes + src->index, buf, len);
10854 src->index += len;
10855 return len;
10856}
10857
10858
10859/* Load GIF image IMG for use on frame F. Value is non-zero if
10860 successful. */
10861
10862static int
10863gif_load (f, img)
10864 struct frame *f;
10865 struct image *img;
10866{
10867 Lisp_Object file, specified_file;
10868 Lisp_Object specified_data;
10869 int rc, width, height, x, y, i;
10870 XImage *ximg;
10871 ColorMapObject *gif_color_map;
10872 unsigned long pixel_colors[256];
10873 GifFileType *gif;
10874 struct gcpro gcpro1;
10875 Lisp_Object image;
10876 int ino, image_left, image_top, image_width, image_height;
10877 gif_memory_source memsrc;
10878 unsigned char *raster;
10879
10880 specified_file = image_spec_value (img->spec, QCfile, NULL);
10881 specified_data = image_spec_value (img->spec, QCdata, NULL);
10882 file = Qnil;
10883
10884 if (NILP (specified_data))
10885 {
10886 file = x_find_image_file (specified_file);
10887 GCPRO1 (file);
10888 if (!STRINGP (file))
10889 {
10890 image_error ("Cannot find image file `%s'", specified_file, Qnil);
10891 UNGCPRO;
10892 return 0;
10893 }
10894
10895 /* Open the GIF file. */
10896 gif = DGifOpenFileName (XSTRING (file)->data);
10897 if (gif == NULL)
10898 {
10899 image_error ("Cannot open `%s'", file, Qnil);
10900 UNGCPRO;
10901 return 0;
10902 }
10903 }
10904 else
10905 {
10906 /* Read from memory! */
10907 current_gif_memory_src = &memsrc;
10908 memsrc.bytes = XSTRING (specified_data)->data;
10909 memsrc.len = STRING_BYTES (XSTRING (specified_data));
10910 memsrc.index = 0;
10911
10912 gif = DGifOpen(&memsrc, gif_read_from_memory);
10913 if (!gif)
10914 {
10915 image_error ("Cannot open memory source `%s'", img->spec, Qnil);
10916 UNGCPRO;
10917 return 0;
10918 }
10919 }
10920
10921 /* Read entire contents. */
10922 rc = DGifSlurp (gif);
10923 if (rc == GIF_ERROR)
10924 {
10925 image_error ("Error reading `%s'", img->spec, Qnil);
10926 DGifCloseFile (gif);
10927 UNGCPRO;
10928 return 0;
10929 }
10930
10931 image = image_spec_value (img->spec, QCindex, NULL);
10932 ino = INTEGERP (image) ? XFASTINT (image) : 0;
10933 if (ino >= gif->ImageCount)
10934 {
10935 image_error ("Invalid image number `%s' in image `%s'",
10936 image, img->spec);
10937 DGifCloseFile (gif);
10938 UNGCPRO;
10939 return 0;
10940 }
10941
10942 width = img->width = gif->SWidth;
10943 height = img->height = gif->SHeight;
10944
10945 BLOCK_INPUT;
10946
10947 /* Create the X image and pixmap. */
10948 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg, &img->pixmap))
10949 {
10950 UNBLOCK_INPUT;
10951 DGifCloseFile (gif);
10952 UNGCPRO;
10953 return 0;
10954 }
10955
10956 /* Allocate colors. */
10957 gif_color_map = gif->SavedImages[ino].ImageDesc.ColorMap;
10958 if (!gif_color_map)
10959 gif_color_map = gif->SColorMap;
10960 init_color_table ();
10961 bzero (pixel_colors, sizeof pixel_colors);
10962
10963 for (i = 0; i < gif_color_map->ColorCount; ++i)
10964 {
10965 int r = gif_color_map->Colors[i].Red << 8;
10966 int g = gif_color_map->Colors[i].Green << 8;
10967 int b = gif_color_map->Colors[i].Blue << 8;
10968 pixel_colors[i] = lookup_rgb_color (f, r, g, b);
10969 }
10970
10971 img->colors = colors_in_color_table (&img->ncolors);
10972 free_color_table ();
10973
10974 /* Clear the part of the screen image that are not covered by
10975 the image from the GIF file. Full animated GIF support
10976 requires more than can be done here (see the gif89 spec,
10977 disposal methods). Let's simply assume that the part
10978 not covered by a sub-image is in the frame's background color. */
10979 image_top = gif->SavedImages[ino].ImageDesc.Top;
10980 image_left = gif->SavedImages[ino].ImageDesc.Left;
10981 image_width = gif->SavedImages[ino].ImageDesc.Width;
10982 image_height = gif->SavedImages[ino].ImageDesc.Height;
10983
10984 for (y = 0; y < image_top; ++y)
10985 for (x = 0; x < width; ++x)
10986 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
10987
10988 for (y = image_top + image_height; y < height; ++y)
10989 for (x = 0; x < width; ++x)
10990 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
10991
10992 for (y = image_top; y < image_top + image_height; ++y)
10993 {
10994 for (x = 0; x < image_left; ++x)
10995 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
10996 for (x = image_left + image_width; x < width; ++x)
10997 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
10998 }
10999
11000 /* Read the GIF image into the X image. We use a local variable
11001 `raster' here because RasterBits below is a char *, and invites
11002 problems with bytes >= 0x80. */
11003 raster = (unsigned char *) gif->SavedImages[ino].RasterBits;
11004
11005 if (gif->SavedImages[ino].ImageDesc.Interlace)
11006 {
11007 static int interlace_start[] = {0, 4, 2, 1};
11008 static int interlace_increment[] = {8, 8, 4, 2};
11009 int pass, inc;
11010 int row = interlace_start[0];
11011
11012 pass = 0;
11013
11014 for (y = 0; y < image_height; y++)
11015 {
11016 if (row >= image_height)
11017 {
11018 row = interlace_start[++pass];
11019 while (row >= image_height)
11020 row = interlace_start[++pass];
11021 }
11022
11023 for (x = 0; x < image_width; x++)
11024 {
11025 int i = raster[(y * image_width) + x];
11026 XPutPixel (ximg, x + image_left, row + image_top,
11027 pixel_colors[i]);
11028 }
11029
11030 row += interlace_increment[pass];
11031 }
11032 }
11033 else
11034 {
11035 for (y = 0; y < image_height; ++y)
11036 for (x = 0; x < image_width; ++x)
11037 {
11038 int i = raster[y* image_width + x];
11039 XPutPixel (ximg, x + image_left, y + image_top, pixel_colors[i]);
11040 }
11041 }
11042
11043 DGifCloseFile (gif);
11044
11045 /* Put the image into the pixmap, then free the X image and its buffer. */
11046 x_put_x_image (f, ximg, img->pixmap, width, height);
11047 x_destroy_x_image (ximg);
11048 UNBLOCK_INPUT;
11049
11050 UNGCPRO;
11051 return 1;
11052}
11053
11054#endif /* HAVE_GIF != 0 */
11055
11056
11057\f
11058/***********************************************************************
11059 Ghostscript
11060 ***********************************************************************/
11061
11062#ifdef HAVE_GHOSTSCRIPT
11063static int gs_image_p P_ ((Lisp_Object object));
11064static int gs_load P_ ((struct frame *f, struct image *img));
11065static void gs_clear_image P_ ((struct frame *f, struct image *img));
11066
11067/* The symbol `postscript' identifying images of this type. */
11068
11069Lisp_Object Qpostscript;
11070
11071/* Keyword symbols. */
11072
11073Lisp_Object QCloader, QCbounding_box, QCpt_width, QCpt_height;
11074
11075/* Indices of image specification fields in gs_format, below. */
11076
11077enum gs_keyword_index
11078{
11079 GS_TYPE,
11080 GS_PT_WIDTH,
11081 GS_PT_HEIGHT,
11082 GS_FILE,
11083 GS_LOADER,
11084 GS_BOUNDING_BOX,
11085 GS_ASCENT,
11086 GS_MARGIN,
11087 GS_RELIEF,
11088 GS_ALGORITHM,
11089 GS_HEURISTIC_MASK,
11090 GS_LAST
11091};
11092
11093/* Vector of image_keyword structures describing the format
11094 of valid user-defined image specifications. */
11095
11096static struct image_keyword gs_format[GS_LAST] =
11097{
11098 {":type", IMAGE_SYMBOL_VALUE, 1},
11099 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE, 1},
11100 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE, 1},
11101 {":file", IMAGE_STRING_VALUE, 1},
11102 {":loader", IMAGE_FUNCTION_VALUE, 0},
11103 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE, 1},
11104 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
11105 {":margin", IMAGE_POSITIVE_INTEGER_VALUE, 0},
11106 {":relief", IMAGE_INTEGER_VALUE, 0},
11107 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
11108 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
11109};
11110
11111/* Structure describing the image type `ghostscript'. */
11112
11113static struct image_type gs_type =
11114{
11115 &Qpostscript,
11116 gs_image_p,
11117 gs_load,
11118 gs_clear_image,
11119 NULL
11120};
11121
11122
11123/* Free X resources of Ghostscript image IMG which is used on frame F. */
11124
11125static void
11126gs_clear_image (f, img)
11127 struct frame *f;
11128 struct image *img;
11129{
11130 /* IMG->data.ptr_val may contain a recorded colormap. */
11131 xfree (img->data.ptr_val);
11132 x_clear_image (f, img);
11133}
11134
11135
11136/* Return non-zero if OBJECT is a valid Ghostscript image
11137 specification. */
11138
11139static int
11140gs_image_p (object)
11141 Lisp_Object object;
11142{
11143 struct image_keyword fmt[GS_LAST];
11144 Lisp_Object tem;
11145 int i;
11146
11147 bcopy (gs_format, fmt, sizeof fmt);
11148
11149 if (!parse_image_spec (object, fmt, GS_LAST, Qpostscript)
11150 || (fmt[GS_ASCENT].count
11151 && XFASTINT (fmt[GS_ASCENT].value) > 100))
11152 return 0;
11153
11154 /* Bounding box must be a list or vector containing 4 integers. */
11155 tem = fmt[GS_BOUNDING_BOX].value;
11156 if (CONSP (tem))
11157 {
11158 for (i = 0; i < 4; ++i, tem = XCDR (tem))
11159 if (!CONSP (tem) || !INTEGERP (XCAR (tem)))
11160 return 0;
11161 if (!NILP (tem))
11162 return 0;
11163 }
11164 else if (VECTORP (tem))
11165 {
11166 if (XVECTOR (tem)->size != 4)
11167 return 0;
11168 for (i = 0; i < 4; ++i)
11169 if (!INTEGERP (XVECTOR (tem)->contents[i]))
11170 return 0;
11171 }
11172 else
11173 return 0;
11174
11175 return 1;
11176}
11177
11178
11179/* Load Ghostscript image IMG for use on frame F. Value is non-zero
11180 if successful. */
11181
11182static int
11183gs_load (f, img)
11184 struct frame *f;
11185 struct image *img;
11186{
11187 char buffer[100];
11188 Lisp_Object window_and_pixmap_id = Qnil, loader, pt_height, pt_width;
11189 struct gcpro gcpro1, gcpro2;
11190 Lisp_Object frame;
11191 double in_width, in_height;
11192 Lisp_Object pixel_colors = Qnil;
11193
11194 /* Compute pixel size of pixmap needed from the given size in the
11195 image specification. Sizes in the specification are in pt. 1 pt
11196 = 1/72 in, xdpi and ydpi are stored in the frame's X display
11197 info. */
11198 pt_width = image_spec_value (img->spec, QCpt_width, NULL);
11199 in_width = XFASTINT (pt_width) / 72.0;
11200 img->width = in_width * FRAME_W32_DISPLAY_INFO (f)->resx;
11201 pt_height = image_spec_value (img->spec, QCpt_height, NULL);
11202 in_height = XFASTINT (pt_height) / 72.0;
11203 img->height = in_height * FRAME_W32_DISPLAY_INFO (f)->resy;
11204
11205 /* Create the pixmap. */
11206 BLOCK_INPUT;
11207 xassert (img->pixmap == 0);
11208 img->pixmap = XCreatePixmap (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
11209 img->width, img->height,
11210 DefaultDepthOfScreen (FRAME_X_SCREEN (f)));
11211 UNBLOCK_INPUT;
11212
11213 if (!img->pixmap)
11214 {
11215 image_error ("Unable to create pixmap for `%s'", img->spec, Qnil);
11216 return 0;
11217 }
11218
11219 /* Call the loader to fill the pixmap. It returns a process object
11220 if successful. We do not record_unwind_protect here because
11221 other places in redisplay like calling window scroll functions
11222 don't either. Let the Lisp loader use `unwind-protect' instead. */
11223 GCPRO2 (window_and_pixmap_id, pixel_colors);
11224
11225 sprintf (buffer, "%lu %lu",
11226 (unsigned long) FRAME_W32_WINDOW (f),
11227 (unsigned long) img->pixmap);
11228 window_and_pixmap_id = build_string (buffer);
11229
11230 sprintf (buffer, "%lu %lu",
11231 FRAME_FOREGROUND_PIXEL (f),
11232 FRAME_BACKGROUND_PIXEL (f));
11233 pixel_colors = build_string (buffer);
11234
11235 XSETFRAME (frame, f);
11236 loader = image_spec_value (img->spec, QCloader, NULL);
11237 if (NILP (loader))
11238 loader = intern ("gs-load-image");
11239
11240 img->data.lisp_val = call6 (loader, frame, img->spec,
11241 make_number (img->width),
11242 make_number (img->height),
11243 window_and_pixmap_id,
11244 pixel_colors);
11245 UNGCPRO;
11246 return PROCESSP (img->data.lisp_val);
11247}
11248
11249
11250/* Kill the Ghostscript process that was started to fill PIXMAP on
11251 frame F. Called from XTread_socket when receiving an event
11252 telling Emacs that Ghostscript has finished drawing. */
11253
11254void
11255x_kill_gs_process (pixmap, f)
11256 Pixmap pixmap;
11257 struct frame *f;
11258{
11259 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
11260 int class, i;
11261 struct image *img;
11262
11263 /* Find the image containing PIXMAP. */
11264 for (i = 0; i < c->used; ++i)
11265 if (c->images[i]->pixmap == pixmap)
11266 break;
11267
11268 /* Kill the GS process. We should have found PIXMAP in the image
11269 cache and its image should contain a process object. */
11270 xassert (i < c->used);
11271 img = c->images[i];
11272 xassert (PROCESSP (img->data.lisp_val));
11273 Fkill_process (img->data.lisp_val, Qnil);
11274 img->data.lisp_val = Qnil;
11275
11276 /* On displays with a mutable colormap, figure out the colors
11277 allocated for the image by looking at the pixels of an XImage for
11278 img->pixmap. */
11279 class = FRAME_W32_DISPLAY_INFO (f)->visual->class;
11280 if (class != StaticColor && class != StaticGray && class != TrueColor)
11281 {
11282 XImage *ximg;
11283
11284 BLOCK_INPUT;
11285
11286 /* Try to get an XImage for img->pixmep. */
11287 ximg = XGetImage (FRAME_W32_DISPLAY (f), img->pixmap,
11288 0, 0, img->width, img->height, ~0, ZPixmap);
11289 if (ximg)
11290 {
11291 int x, y;
11292
11293 /* Initialize the color table. */
11294 init_color_table ();
11295
11296 /* For each pixel of the image, look its color up in the
11297 color table. After having done so, the color table will
11298 contain an entry for each color used by the image. */
11299 for (y = 0; y < img->height; ++y)
11300 for (x = 0; x < img->width; ++x)
11301 {
11302 unsigned long pixel = XGetPixel (ximg, x, y);
11303 lookup_pixel_color (f, pixel);
11304 }
11305
11306 /* Record colors in the image. Free color table and XImage. */
11307 img->colors = colors_in_color_table (&img->ncolors);
11308 free_color_table ();
11309 XDestroyImage (ximg);
11310
11311#if 0 /* This doesn't seem to be the case. If we free the colors
11312 here, we get a BadAccess later in x_clear_image when
11313 freeing the colors. */
11314 /* We have allocated colors once, but Ghostscript has also
11315 allocated colors on behalf of us. So, to get the
11316 reference counts right, free them once. */
11317 if (img->ncolors)
11318 {
11319 Colormap cmap = DefaultColormapOfScreen (FRAME_X_SCREEN (f));
11320 XFreeColors (FRAME_W32_DISPLAY (f), cmap,
11321 img->colors, img->ncolors, 0);
11322 }
11323#endif
11324 }
11325 else
11326 image_error ("Cannot get X image of `%s'; colors will not be freed",
11327 img->spec, Qnil);
11328
11329 UNBLOCK_INPUT;
11330 }
11331}
11332
11333#endif /* HAVE_GHOSTSCRIPT */
11334
11335\f
11336/***********************************************************************
11337 Window properties
11338 ***********************************************************************/
11339
11340DEFUN ("x-change-window-property", Fx_change_window_property,
11341 Sx_change_window_property, 2, 3, 0,
11342 "Change window property PROP to VALUE on the X window of FRAME.\n\
11343PROP and VALUE must be strings. FRAME nil or omitted means use the\n\
11344selected frame. Value is VALUE.")
11345 (prop, value, frame)
11346 Lisp_Object frame, prop, value;
11347{
11348#if 0 /* NTEMACS_TODO : port window properties to W32 */
11349 struct frame *f = check_x_frame (frame);
11350 Atom prop_atom;
11351
11352 CHECK_STRING (prop, 1);
11353 CHECK_STRING (value, 2);
11354
11355 BLOCK_INPUT;
11356 prop_atom = XInternAtom (FRAME_W32_DISPLAY (f), XSTRING (prop)->data, False);
11357 XChangeProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
11358 prop_atom, XA_STRING, 8, PropModeReplace,
11359 XSTRING (value)->data, XSTRING (value)->size);
11360
11361 /* Make sure the property is set when we return. */
11362 XFlush (FRAME_W32_DISPLAY (f));
11363 UNBLOCK_INPUT;
11364
11365#endif /* NTEMACS_TODO */
11366
11367 return value;
11368}
11369
11370
11371DEFUN ("x-delete-window-property", Fx_delete_window_property,
11372 Sx_delete_window_property, 1, 2, 0,
11373 "Remove window property PROP from X window of FRAME.\n\
11374FRAME nil or omitted means use the selected frame. Value is PROP.")
11375 (prop, frame)
11376 Lisp_Object prop, frame;
11377{
11378#if 0 /* NTEMACS_TODO : port window properties to W32 */
11379
11380 struct frame *f = check_x_frame (frame);
11381 Atom prop_atom;
11382
11383 CHECK_STRING (prop, 1);
11384 BLOCK_INPUT;
11385 prop_atom = XInternAtom (FRAME_W32_DISPLAY (f), XSTRING (prop)->data, False);
11386 XDeleteProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f), prop_atom);
11387
11388 /* Make sure the property is removed when we return. */
11389 XFlush (FRAME_W32_DISPLAY (f));
11390 UNBLOCK_INPUT;
11391#endif /* NTEMACS_TODO */
11392
11393 return prop;
11394}
11395
11396
11397DEFUN ("x-window-property", Fx_window_property, Sx_window_property,
11398 1, 2, 0,
11399 "Value is the value of window property PROP on FRAME.\n\
11400If FRAME is nil or omitted, use the selected frame. Value is nil\n\
11401if FRAME hasn't a property with name PROP or if PROP has no string\n\
11402value.")
11403 (prop, frame)
11404 Lisp_Object prop, frame;
11405{
11406#if 0 /* NTEMACS_TODO : port window properties to W32 */
11407
11408 struct frame *f = check_x_frame (frame);
11409 Atom prop_atom;
11410 int rc;
11411 Lisp_Object prop_value = Qnil;
11412 char *tmp_data = NULL;
11413 Atom actual_type;
11414 int actual_format;
11415 unsigned long actual_size, bytes_remaining;
11416
11417 CHECK_STRING (prop, 1);
11418 BLOCK_INPUT;
11419 prop_atom = XInternAtom (FRAME_W32_DISPLAY (f), XSTRING (prop)->data, False);
11420 rc = XGetWindowProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
11421 prop_atom, 0, 0, False, XA_STRING,
11422 &actual_type, &actual_format, &actual_size,
11423 &bytes_remaining, (unsigned char **) &tmp_data);
11424 if (rc == Success)
11425 {
11426 int size = bytes_remaining;
11427
11428 XFree (tmp_data);
11429 tmp_data = NULL;
11430
11431 rc = XGetWindowProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
11432 prop_atom, 0, bytes_remaining,
11433 False, XA_STRING,
11434 &actual_type, &actual_format,
11435 &actual_size, &bytes_remaining,
11436 (unsigned char **) &tmp_data);
11437 if (rc == Success)
11438 prop_value = make_string (tmp_data, size);
11439
11440 XFree (tmp_data);
11441 }
11442
11443 UNBLOCK_INPUT;
11444
11445 return prop_value;
11446
11447#endif /* NTEMACS_TODO */
11448 return Qnil;
11449}
11450
11451
11452\f
11453/***********************************************************************
11454 Busy cursor
11455 ***********************************************************************/
11456
11457/* The implementation partly follows a patch from
11458 F.Pierresteguy@frcl.bull.fr dated 1994. */
11459
11460/* Setting inhibit_busy_cursor to 2 inhibits busy-cursor display until
11461 the next X event is read and we enter XTread_socket again. Setting
11462 it to 1 inhibits busy-cursor display for direct commands. */
11463
11464int inhibit_busy_cursor;
11465
11466/* Incremented with each call to x-display-busy-cursor.
11467 Decremented in x-undisplay-busy-cursor. */
11468
11469static int busy_count;
11470
11471
11472DEFUN ("x-show-busy-cursor", Fx_show_busy_cursor,
11473 Sx_show_busy_cursor, 0, 0, 0,
11474 "Show a busy cursor, if not already shown.\n\
11475Each call to this function must be matched by a call to\n\
11476x-undisplay-busy-cursor to make the busy pointer disappear again.")
11477 ()
11478{
11479 ++busy_count;
11480 if (busy_count == 1)
11481 {
11482 Lisp_Object rest, frame;
11483
11484 FOR_EACH_FRAME (rest, frame)
11485 if (FRAME_X_P (XFRAME (frame)))
11486 {
11487 struct frame *f = XFRAME (frame);
11488#if 0 /* NTEMACS_TODO : busy cursor */
11489
11490 BLOCK_INPUT;
11491 f->output_data.w32->busy_p = 1;
11492
11493 if (!f->output_data.w32->busy_window)
11494 {
11495 unsigned long mask = CWCursor;
11496 XSetWindowAttributes attrs;
11497
11498 attrs.cursor = f->output_data.w32->busy_cursor;
11499 f->output_data.w32->busy_window
11500 = XCreateWindow (FRAME_W32_DISPLAY (f),
11501 FRAME_OUTER_WINDOW (f),
11502 0, 0, 32000, 32000, 0, 0,
11503 InputOnly, CopyFromParent,
11504 mask, &attrs);
11505 }
11506
11507 XMapRaised (FRAME_W32_DISPLAY (f), f->output_data.w32->busy_window);
11508 UNBLOCK_INPUT;
11509#endif
11510 }
11511 }
11512
11513 return Qnil;
11514}
11515
11516
11517DEFUN ("x-hide-busy-cursor", Fx_hide_busy_cursor,
11518 Sx_hide_busy_cursor, 0, 1, 0,
11519 "Hide a busy-cursor.\n\
11520A busy-cursor will actually be undisplayed when a matching\n\
11521`x-undisplay-busy-cursor' is called for each `x-display-busy-cursor'\n\
11522issued. FORCE non-nil means undisplay the busy-cursor forcibly,\n\
11523not counting calls.")
11524 (force)
11525 Lisp_Object force;
11526{
11527 Lisp_Object rest, frame;
11528
11529 if (busy_count == 0)
11530 return Qnil;
11531
11532 if (!NILP (force) && busy_count != 0)
11533 busy_count = 1;
11534
11535 --busy_count;
11536 if (busy_count != 0)
11537 return Qnil;
11538
11539 FOR_EACH_FRAME (rest, frame)
11540 {
11541 struct frame *f = XFRAME (frame);
11542
11543 if (FRAME_X_P (f)
11544 /* Watch out for newly created frames. */
11545 && f->output_data.w32->busy_window)
11546 {
11547#if 0 /* NTEMACS_TODO : busy cursor */
11548 BLOCK_INPUT;
11549 XUnmapWindow (FRAME_W32_DISPLAY (f), f->output_data.w32->busy_window);
11550 /* Sync here because XTread_socket looks at the busy_p flag
11551 that is reset to zero below. */
11552 XSync (FRAME_W32_DISPLAY (f), False);
11553 UNBLOCK_INPUT;
11554 f->output_data.w32->busy_p = 0;
11555#endif
11556 }
11557 }
11558
11559 return Qnil;
11560}
11561
11562
11563\f
11564/***********************************************************************
11565 Tool tips
11566 ***********************************************************************/
11567
11568static Lisp_Object x_create_tip_frame P_ ((struct w32_display_info *,
11569 Lisp_Object));
11570
11571/* The frame of a currently visible tooltip, or null. */
11572
11573struct frame *tip_frame;
11574
11575/* If non-nil, a timer started that hides the last tooltip when it
11576 fires. */
11577
11578Lisp_Object tip_timer;
11579Window tip_window;
11580
11581/* Create a frame for a tooltip on the display described by DPYINFO.
11582 PARMS is a list of frame parameters. Value is the frame. */
11583
11584static Lisp_Object
11585x_create_tip_frame (dpyinfo, parms)
11586 struct w32_display_info *dpyinfo;
11587 Lisp_Object parms;
11588{
11589#if 0 /* NTEMACS_TODO : w32 version */
11590 struct frame *f;
11591 Lisp_Object frame, tem;
11592 Lisp_Object name;
11593 long window_prompting = 0;
11594 int width, height;
11595 int count = specpdl_ptr - specpdl;
11596 struct gcpro gcpro1, gcpro2, gcpro3;
11597 struct kboard *kb;
11598
11599 check_x ();
11600
11601 /* Use this general default value to start with until we know if
11602 this frame has a specified name. */
11603 Vx_resource_name = Vinvocation_name;
11604
11605#ifdef MULTI_KBOARD
11606 kb = dpyinfo->kboard;
11607#else
11608 kb = &the_only_kboard;
11609#endif
11610
11611 /* Get the name of the frame to use for resource lookup. */
11612 name = w32_get_arg (parms, Qname, "name", "Name", RES_TYPE_STRING);
11613 if (!STRINGP (name)
11614 && !EQ (name, Qunbound)
11615 && !NILP (name))
11616 error ("Invalid frame name--not a string or nil");
11617 Vx_resource_name = name;
11618
11619 frame = Qnil;
11620 GCPRO3 (parms, name, frame);
11621 tip_frame = f = make_frame (1);
11622 XSETFRAME (frame, f);
11623 FRAME_CAN_HAVE_SCROLL_BARS (f) = 0;
11624
11625 f->output_method = output_x_window;
11626 f->output_data.w32 =
11627 (struct w32_output *) xmalloc (sizeof (struct w32_output));
11628 bzero (f->output_data.w32, sizeof (struct w32_output));
11629#if 0
11630 f->output_data.w32->icon_bitmap = -1;
11631#endif
11632 f->output_data.w32->fontset = -1;
11633 f->icon_name = Qnil;
11634
11635#ifdef MULTI_KBOARD
11636 FRAME_KBOARD (f) = kb;
11637#endif
11638 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
11639 f->output_data.w32->explicit_parent = 0;
11640
11641 /* Set the name; the functions to which we pass f expect the name to
11642 be set. */
11643 if (EQ (name, Qunbound) || NILP (name))
11644 {
11645 f->name = build_string (dpyinfo->x_id_name);
11646 f->explicit_name = 0;
11647 }
11648 else
11649 {
11650 f->name = name;
11651 f->explicit_name = 1;
11652 /* use the frame's title when getting resources for this frame. */
11653 specbind (Qx_resource_name, name);
11654 }
11655
11656 /* Create fontsets from `global_fontset_alist' before handling fonts. */
11657 for (tem = Vglobal_fontset_alist; CONSP (tem); tem = XCDR (tem))
11658 fs_register_fontset (f, XCAR (tem));
11659
11660 /* Extract the window parameters from the supplied values
11661 that are needed to determine window geometry. */
11662 {
11663 Lisp_Object font;
11664
11665 font = w32_get_arg (parms, Qfont, "font", "Font", RES_TYPE_STRING);
11666
11667 BLOCK_INPUT;
11668 /* First, try whatever font the caller has specified. */
11669 if (STRINGP (font))
11670 {
11671 tem = Fquery_fontset (font, Qnil);
11672 if (STRINGP (tem))
11673 font = x_new_fontset (f, XSTRING (tem)->data);
11674 else
11675 font = x_new_font (f, XSTRING (font)->data);
11676 }
11677
11678 /* Try out a font which we hope has bold and italic variations. */
11679 if (!STRINGP (font))
11680 font = x_new_font (f, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
11681 if (!STRINGP (font))
11682 font = x_new_font (f, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
11683 if (! STRINGP (font))
11684 font = x_new_font (f, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
11685 if (! STRINGP (font))
11686 /* This was formerly the first thing tried, but it finds too many fonts
11687 and takes too long. */
11688 font = x_new_font (f, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
11689 /* If those didn't work, look for something which will at least work. */
11690 if (! STRINGP (font))
11691 font = x_new_font (f, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
11692 UNBLOCK_INPUT;
11693 if (! STRINGP (font))
11694 font = build_string ("fixed");
11695
11696 x_default_parameter (f, parms, Qfont, font,
11697 "font", "Font", RES_TYPE_STRING);
11698 }
11699
11700 x_default_parameter (f, parms, Qborder_width, make_number (2),
11701 "borderWidth", "BorderWidth", RES_TYPE_NUMBER);
11702
11703 /* This defaults to 2 in order to match xterm. We recognize either
11704 internalBorderWidth or internalBorder (which is what xterm calls
11705 it). */
11706 if (NILP (Fassq (Qinternal_border_width, parms)))
11707 {
11708 Lisp_Object value;
11709
11710 value = w32_get_arg (parms, Qinternal_border_width,
11711 "internalBorder", "internalBorder", RES_TYPE_NUMBER);
11712 if (! EQ (value, Qunbound))
11713 parms = Fcons (Fcons (Qinternal_border_width, value),
11714 parms);
11715 }
11716
11717 x_default_parameter (f, parms, Qinternal_border_width, make_number (1),
11718 "internalBorderWidth", "internalBorderWidth",
11719 RES_TYPE_NUMBER);
11720
11721 /* Also do the stuff which must be set before the window exists. */
11722 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
11723 "foreground", "Foreground", RES_TYPE_STRING);
11724 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
11725 "background", "Background", RES_TYPE_STRING);
11726 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
11727 "pointerColor", "Foreground", RES_TYPE_STRING);
11728 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
11729 "cursorColor", "Foreground", RES_TYPE_STRING);
11730 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
11731 "borderColor", "BorderColor", RES_TYPE_STRING);
11732
11733 /* Init faces before x_default_parameter is called for scroll-bar
11734 parameters because that function calls x_set_scroll_bar_width,
11735 which calls change_frame_size, which calls Fset_window_buffer,
11736 which runs hooks, which call Fvertical_motion. At the end, we
11737 end up in init_iterator with a null face cache, which should not
11738 happen. */
11739 init_frame_faces (f);
11740
11741 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
11742 window_prompting = x_figure_window_size (f, parms);
11743
11744 if (window_prompting & XNegative)
11745 {
11746 if (window_prompting & YNegative)
11747 f->output_data.w32->win_gravity = SouthEastGravity;
11748 else
11749 f->output_data.w32->win_gravity = NorthEastGravity;
11750 }
11751 else
11752 {
11753 if (window_prompting & YNegative)
11754 f->output_data.w32->win_gravity = SouthWestGravity;
11755 else
11756 f->output_data.w32->win_gravity = NorthWestGravity;
11757 }
11758
11759 f->output_data.w32->size_hint_flags = window_prompting;
11760 {
11761 XSetWindowAttributes attrs;
11762 unsigned long mask;
11763
11764 BLOCK_INPUT;
11765 mask = CWBackPixel | CWOverrideRedirect | CWSaveUnder | CWEventMask;
11766 /* Window managers looks at the override-redirect flag to
11767 determine whether or net to give windows a decoration (Xlib
11768 3.2.8). */
11769 attrs.override_redirect = True;
11770 attrs.save_under = True;
11771 attrs.background_pixel = FRAME_BACKGROUND_PIXEL (f);
11772 /* Arrange for getting MapNotify and UnmapNotify events. */
11773 attrs.event_mask = StructureNotifyMask;
11774 tip_window
11775 = FRAME_W32_WINDOW (f)
11776 = XCreateWindow (FRAME_W32_DISPLAY (f),
11777 FRAME_W32_DISPLAY_INFO (f)->root_window,
11778 /* x, y, width, height */
11779 0, 0, 1, 1,
11780 /* Border. */
11781 1,
11782 CopyFromParent, InputOutput, CopyFromParent,
11783 mask, &attrs);
11784 UNBLOCK_INPUT;
11785 }
11786
11787 x_make_gc (f);
11788
11789 x_default_parameter (f, parms, Qauto_raise, Qnil,
11790 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
11791 x_default_parameter (f, parms, Qauto_lower, Qnil,
11792 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
11793 x_default_parameter (f, parms, Qcursor_type, Qbox,
11794 "cursorType", "CursorType", RES_TYPE_SYMBOL);
11795
11796 /* Dimensions, especially f->height, must be done via change_frame_size.
11797 Change will not be effected unless different from the current
11798 f->height. */
11799 width = f->width;
11800 height = f->height;
11801 f->height = 0;
11802 SET_FRAME_WIDTH (f, 0);
11803 change_frame_size (f, height, width, 1, 0, 0);
11804
11805 f->no_split = 1;
11806
11807 UNGCPRO;
11808
11809 /* It is now ok to make the frame official even if we get an error
11810 below. And the frame needs to be on Vframe_list or making it
11811 visible won't work. */
11812 Vframe_list = Fcons (frame, Vframe_list);
11813
11814 /* Now that the frame is official, it counts as a reference to
11815 its display. */
11816 FRAME_W32_DISPLAY_INFO (f)->reference_count++;
ee78dc32 11817
6fc2811b
JR		 11818 return unbind_to (count, frame);
11819#endif /* NTEMACS_TODO */
11820 return Qnil;
ee78dc32
GV		 11821}
11822
ee78dc32 11823
6fc2811b
JR		 11824DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 4, 0,
11825 "Show STRING in a \"tooltip\" window on frame FRAME.\n\
11826A tooltip window is a small X window displaying STRING at\n\
11827the current mouse position.\n\
11828FRAME nil or omitted means use the selected frame.\n\
11829PARMS is an optional list of frame parameters which can be\n\
11830used to change the tooltip's appearance.\n\
11831Automatically hide the tooltip after TIMEOUT seconds.\n\
11832TIMEOUT nil means use the default timeout of 5 seconds.")
11833 (string, frame, parms, timeout)
11834 Lisp_Object string, frame, parms, timeout;
ee78dc32 11835{
6fc2811b
JR		 11836 struct frame *f;
11837 struct window *w;
11838 Window root, child;
11839 Lisp_Object buffer;
11840 struct buffer *old_buffer;
11841 struct text_pos pos;
11842 int i, width, height;
11843 int root_x, root_y, win_x, win_y;
11844 unsigned pmask;
11845 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
11846 int old_windows_or_buffers_changed = windows_or_buffers_changed;
11847 int count = specpdl_ptr - specpdl;
11848
11849 specbind (Qinhibit_redisplay, Qt);
ee78dc32 11850
6fc2811b 11851 GCPRO3 (string, parms, frame, timeout);
ee78dc32 11852
6fc2811b
JR		 11853 CHECK_STRING (string, 0);
11854 f = check_x_frame (frame);
11855 if (NILP (timeout))
11856 timeout = make_number (5);
11857 else
11858 CHECK_NATNUM (timeout, 2);
ee78dc32 11859
6fc2811b
JR		 11860 /* Hide a previous tip, if any. */
11861 Fx_hide_tip ();
ee78dc32 11862
6fc2811b
JR		 11863 /* Add default values to frame parameters. */
11864 if (NILP (Fassq (Qname, parms)))
11865 parms = Fcons (Fcons (Qname, build_string ("tooltip")), parms);
11866 if (NILP (Fassq (Qinternal_border_width, parms)))
11867 parms = Fcons (Fcons (Qinternal_border_width, make_number (3)), parms);
11868 if (NILP (Fassq (Qborder_width, parms)))
11869 parms = Fcons (Fcons (Qborder_width, make_number (1)), parms);
11870 if (NILP (Fassq (Qborder_color, parms)))
11871 parms = Fcons (Fcons (Qborder_color, build_string ("lightyellow")), parms);
11872 if (NILP (Fassq (Qbackground_color, parms)))
11873 parms = Fcons (Fcons (Qbackground_color, build_string ("lightyellow")),
11874 parms);
11875
11876 /* Create a frame for the tooltip, and record it in the global
11877 variable tip_frame. */
11878 frame = x_create_tip_frame (FRAME_W32_DISPLAY_INFO (f), parms);
11879 tip_frame = f = XFRAME (frame);
11880
11881 /* Set up the frame's root window. Currently we use a size of 80
11882 columns x 40 lines. If someone wants to show a larger tip, he
11883 will loose. I don't think this is a realistic case. */
11884 w = XWINDOW (FRAME_ROOT_WINDOW (f));
11885 w->left = w->top = make_number (0);
11886 w->width = 80;
11887 w->height = 40;
11888 adjust_glyphs (f);
11889 w->pseudo_window_p = 1;
11890
11891 /* Display the tooltip text in a temporary buffer. */
11892 buffer = Fget_buffer_create (build_string (" *tip*"));
11893 Fset_window_buffer (FRAME_ROOT_WINDOW (f), buffer);
11894 old_buffer = current_buffer;
11895 set_buffer_internal_1 (XBUFFER (buffer));
11896 Ferase_buffer ();
11897 Finsert (make_number (1), &string);
11898 clear_glyph_matrix (w->desired_matrix);
11899 clear_glyph_matrix (w->current_matrix);
11900 SET_TEXT_POS (pos, BEGV, BEGV_BYTE);
11901 try_window (FRAME_ROOT_WINDOW (f), pos);
11902
11903 /* Compute width and height of the tooltip. */
11904 width = height = 0;
11905 for (i = 0; i < w->desired_matrix->nrows; ++i)
ee78dc32 11906 {
6fc2811b
JR		 11907 struct glyph_row *row = &w->desired_matrix->rows[i];
11908 struct glyph *last;
11909 int row_width;
11910
11911 /* Stop at the first empty row at the end. */
11912 if (!row->enabled_p || !row->displays_text_p)
11913 break;
11914
11915 /* Let the row go over the full width of the frame. */
11916 row->full_width_p = 1;
11917
11918 /* There's a glyph at the end of rows that is use to place
11919 the cursor there. Don't include the width of this glyph. */
11920 if (row->used[TEXT_AREA])
11921 {
11922 last = &row->glyphs[TEXT_AREA][row->used[TEXT_AREA] - 1];
11923 row_width = row->pixel_width - last->pixel_width;
11924 }
11925 else
11926 row_width = row->pixel_width;
11927
11928 height += row->height;
11929 width = max (width, row_width);
ee78dc32
GV		 11930 }
11931
6fc2811b
JR		 11932 /* Add the frame's internal border to the width and height the X
11933 window should have. */
11934 height += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
11935 width += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
ee78dc32 11936
6fc2811b
JR		 11937 /* Move the tooltip window where the mouse pointer is. Resize and
11938 show it. */
11939#if 0 /* NTEMACS_TODO : W32 specifics */
11940 BLOCK_INPUT;
11941 XQueryPointer (FRAME_W32_DISPLAY (f), FRAME_W32_DISPLAY_INFO (f)->root_window,
11942 &root, &child, &root_x, &root_y, &win_x, &win_y, &pmask);
11943 XMoveResizeWindow (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
11944 root_x + 5, root_y - height - 5, width, height);
11945 XMapRaised (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f));
11946 UNBLOCK_INPUT;
11947#endif /* NTEMACS_TODO */
ee78dc32 11948
6fc2811b
JR		 11949 /* Draw into the window. */
11950 w->must_be_updated_p = 1;
11951 update_single_window (w, 1);
ee78dc32 11952
6fc2811b
JR		 11953 /* Restore original current buffer. */
11954 set_buffer_internal_1 (old_buffer);
11955 windows_or_buffers_changed = old_windows_or_buffers_changed;
ee78dc32 11956
6fc2811b
JR		 11957 /* Let the tip disappear after timeout seconds. */
11958 tip_timer = call3 (intern ("run-at-time"), timeout, Qnil,
11959 intern ("x-hide-tip"));
11960 UNGCPRO;
ee78dc32 11961
6fc2811b 11962 return unbind_to (count, Qnil);
ee78dc32
GV		 11963}
11964
ee78dc32 11965
6fc2811b
JR		 11966DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0,
11967 "Hide the current tooltip window, if there is any.\n\
11968Value is t is tooltip was open, nil otherwise.")
11969 ()
11970{
11971 int count = specpdl_ptr - specpdl;
11972 int deleted_p = 0;
11973
11974 specbind (Qinhibit_redisplay, Qt);
11975
11976 if (!NILP (tip_timer))
11977 {
11978 call1 (intern ("cancel-timer"), tip_timer);
11979 tip_timer = Qnil;
11980 }
ee78dc32 11981
6fc2811b
JR		 11982 if (tip_frame)
11983 {
11984 Lisp_Object frame;
11985
11986 XSETFRAME (frame, tip_frame);
11987 Fdelete_frame (frame, Qt);
11988 tip_frame = NULL;
11989 deleted_p = 1;
11990 }
1edf84e7 11991
6fc2811b
JR		 11992 return unbind_to (count, deleted_p ? Qt : Qnil);
11993}
5ac45f98 11994
5ac45f98 11995
6fc2811b
JR		 11996\f
11997/***********************************************************************
11998 File selection dialog
11999 ***********************************************************************/
12000
12001extern Lisp_Object Qfile_name_history;
12002
12003DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 4, 0,
12004 "Read file name, prompting with PROMPT in directory DIR.\n\
12005Use a file selection dialog.\n\
12006Select DEFAULT-FILENAME in the dialog's file selection box, if\n\
12007specified. Don't let the user enter a file name in the file\n\
12008selection dialog's entry field, if MUSTMATCH is non-nil.")
12009 (prompt, dir, default_filename, mustmatch)
12010 Lisp_Object prompt, dir, default_filename, mustmatch;
12011{
12012 struct frame *f = SELECTED_FRAME ();
12013 Lisp_Object file = Qnil;
12014 int count = specpdl_ptr - specpdl;
12015 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
12016 char filename[MAX_PATH + 1];
12017 char init_dir[MAX_PATH + 1];
12018 int use_dialog_p = 1;
12019
12020 GCPRO5 (prompt, dir, default_filename, mustmatch, file);
12021 CHECK_STRING (prompt, 0);
12022 CHECK_STRING (dir, 1);
12023
12024 /* Create the dialog with PROMPT as title, using DIR as initial
12025 directory and using "*" as pattern. */
12026 dir = Fexpand_file_name (dir, Qnil);
12027 strncpy (init_dir, XSTRING (dir)->data, MAX_PATH);
12028 init_dir[MAX_PATH] = '\0';
12029 unixtodos_filename (init_dir);
12030
12031 if (STRINGP (default_filename))
12032 {
12033 char *file_name_only;
12034 char *full_path_name = XSTRING (default_filename)->data;
5ac45f98 12035
6fc2811b 12036 unixtodos_filename (full_path_name);
5ac45f98 12037
6fc2811b
JR		 12038 file_name_only = strrchr (full_path_name, '\\');
12039 if (!file_name_only)
12040 file_name_only = full_path_name;
12041 else
12042 {
12043 file_name_only++;
5ac45f98 12044
6fc2811b
JR		 12045 /* If default_file_name is a directory, don't use the open
12046 file dialog, as it does not support selecting
12047 directories. */
12048 if (!(*file_name_only))
12049 use_dialog_p = 0;
12050 }
ee78dc32 12051
6fc2811b
JR		 12052 strncpy (filename, file_name_only, MAX_PATH);
12053 filename[MAX_PATH] = '\0';
12054 }
ee78dc32 12055 else
6fc2811b 12056 filename[0] = '\0';
ee78dc32 12057
6fc2811b
JR		 12058 if (use_dialog_p)
12059 {
12060 OPENFILENAME file_details;
12061 char *filename_file;
5ac45f98 12062
6fc2811b
JR		 12063 /* Prevent redisplay. */
12064 specbind (Qinhibit_redisplay, Qt);
12065 BLOCK_INPUT;
ee78dc32 12066
6fc2811b
JR		 12067 bzero (&file_details, sizeof (file_details));
12068 file_details.lStructSize = sizeof (file_details);
12069 file_details.hwndOwner = FRAME_W32_WINDOW (f);
12070 file_details.lpstrFile = filename;
12071 file_details.nMaxFile = sizeof (filename);
12072 file_details.lpstrInitialDir = init_dir;
12073 file_details.lpstrTitle = XSTRING (prompt)->data;
12074 file_details.Flags = OFN_HIDEREADONLY | OFN_NOCHANGEDIR;
ee78dc32 12075
6fc2811b
JR		 12076 if (!NILP (mustmatch))
12077 file_details.Flags |= OFN_FILEMUSTEXIST | OFN_PATHMUSTEXIST;
ee78dc32 12078
6fc2811b
JR		 12079 if (GetOpenFileName (&file_details))
12080 {
12081 dostounix_filename (filename);
12082 file = build_string (filename);
12083 }
ee78dc32 12084 else
6fc2811b
JR		 12085 file = Qnil;
12086
12087 UNBLOCK_INPUT;
12088 file = unbind_to (count, file);
ee78dc32 12089 }
6fc2811b
JR		 12090 /* Open File dialog will not allow folders to be selected, so resort
12091 to minibuffer completing reads for directories. */
12092 else
12093 file = Fcompleting_read (prompt, intern ("read-file-name-internal"),
12094 dir, mustmatch, dir, Qfile_name_history,
12095 default_filename, Qnil);
ee78dc32 12096
6fc2811b 12097 UNGCPRO;
1edf84e7 12098
6fc2811b
JR		 12099 /* Make "Cancel" equivalent to C-g. */
12100 if (NILP (file))
12101 Fsignal (Qquit, Qnil);
ee78dc32 12102
6fc2811b
JR		 12103 return file;
12104}
ee78dc32 12105
ee78dc32 12106
6fc2811b
JR		 12107\f
12108/***********************************************************************
12109 Tests
12110 ***********************************************************************/
ee78dc32 12111
6fc2811b 12112#if GLYPH_DEBUG
ee78dc32 12113
6fc2811b
JR		 12114DEFUN ("imagep", Fimagep, Simagep, 1, 1, 0,
12115 "Value is non-nil if SPEC is a valid image specification.")
12116 (spec)
12117 Lisp_Object spec;
12118{
12119 return valid_image_p (spec) ? Qt : Qnil;
ee78dc32
GV		 12120}
12121
ee78dc32 12122
6fc2811b
JR		 12123DEFUN ("lookup-image", Flookup_image, Slookup_image, 1, 1, 0, "")
12124 (spec)
12125 Lisp_Object spec;
12126{
12127 int id = -1;
12128
12129 if (valid_image_p (spec))
12130 id = lookup_image (SELECTED_FRAME (), spec);
ee78dc32 12131
6fc2811b
JR		 12132 debug_print (spec);
12133 return make_number (id);
ee78dc32
GV		 12134}
12135
6fc2811b 12136#endif /* GLYPH_DEBUG != 0 */
ee78dc32 12137
ee78dc32
GV		 12138
12139\f
6fc2811b
JR		 12140/***********************************************************************
12141 w32 specialized functions
12142 ***********************************************************************/
ee78dc32 12143
fbd6baed
GV		 12144DEFUN ("w32-select-font", Fw32_select_font, Sw32_select_font, 0, 1, 0,
12145 "This will display the W32 font dialog and return an X font string corresponding to the selection.")
ee78dc32
GV		 12146 (frame)
12147 Lisp_Object frame;
12148{
12149 FRAME_PTR f = check_x_frame (frame);
12150 CHOOSEFONT cf;
12151 LOGFONT lf;
f46e6225
GV		 12152 TEXTMETRIC tm;
12153 HDC hdc;
12154 HANDLE oldobj;
ee78dc32
GV		 12155 char buf[100];
12156
12157 bzero (&cf, sizeof (cf));
f46e6225 12158 bzero (&lf, sizeof (lf));
ee78dc32
GV		 12159
12160 cf.lStructSize = sizeof (cf);
fbd6baed 12161 cf.hwndOwner = FRAME_W32_WINDOW (f);
6fc2811b 12162 cf.Flags = CF_FORCEFONTEXIST | CF_SCREENFONTS;
ee78dc32
GV		 12163 cf.lpLogFont = &lf;
12164
f46e6225
GV		 12165 /* Initialize as much of the font details as we can from the current
12166 default font. */
12167 hdc = GetDC (FRAME_W32_WINDOW (f));
12168 oldobj = SelectObject (hdc, FRAME_FONT (f)->hfont);
12169 GetTextFace (hdc, LF_FACESIZE, lf.lfFaceName);
12170 if (GetTextMetrics (hdc, &tm))
12171 {
12172 lf.lfHeight = tm.tmInternalLeading - tm.tmHeight;
12173 lf.lfWeight = tm.tmWeight;
12174 lf.lfItalic = tm.tmItalic;
12175 lf.lfUnderline = tm.tmUnderlined;
12176 lf.lfStrikeOut = tm.tmStruckOut;
f46e6225
GV		 12177 lf.lfCharSet = tm.tmCharSet;
12178 cf.Flags |= CF_INITTOLOGFONTSTRUCT;
12179 }
12180 SelectObject (hdc, oldobj);
6fc2811b 12181 ReleaseDC (FRAME_W32_WINDOW (f), hdc);
f46e6225 12182
fbd6baed 12183 if (!ChooseFont (&cf) || !w32_to_x_font (&lf, buf, 100))
3c190163 12184 return Qnil;
ee78dc32
GV		 12185
12186 return build_string (buf);
12187}
12188
1edf84e7
GV		 12189DEFUN ("w32-send-sys-command", Fw32_send_sys_command, Sw32_send_sys_command, 1, 2, 0,
12190 "Send frame a Windows WM_SYSCOMMAND message of type COMMAND.\n\
12191Some useful values for command are 0xf030 to maximise frame (0xf020\n\
12192to minimize), 0xf120 to restore frame to original size, and 0xf100\n\
12193to activate the menubar for keyboard access. 0xf140 activates the\n\
12194screen saver if defined.\n\
12195\n\
12196If optional parameter FRAME is not specified, use selected frame.")
12197 (command, frame)
12198 Lisp_Object command, frame;
12199{
12200 WPARAM code;
12201 FRAME_PTR f = check_x_frame (frame);
12202
12203 CHECK_NUMBER (command, 0);
12204
ce6059da 12205 PostMessage (FRAME_W32_WINDOW (f), WM_SYSCOMMAND, XINT (command), 0);
1edf84e7
GV		 12206
12207 return Qnil;
12208}
12209
55dcfc15
AI		 12210DEFUN ("w32-shell-execute", Fw32_shell_execute, Sw32_shell_execute, 2, 4, 0,
12211 "Get Windows to perform OPERATION on DOCUMENT.\n\
12212This is a wrapper around the ShellExecute system function, which\n\
12213invokes the application registered to handle OPERATION for DOCUMENT.\n\
6fc2811b
JR		 12214OPERATION is typically \"open\", \"print\" or \"explore\" (but can be\n\
12215nil for the default action), and DOCUMENT is typically the name of a\n\
12216document file or URL, but can also be a program executable to run or\n\
12217a directory to open in the Windows Explorer.\n\
55dcfc15 12218\n\
6fc2811b
JR		 12219If DOCUMENT is a program executable, PARAMETERS can be a string\n\
12220containing command line parameters, but otherwise should be nil.\n\
55dcfc15
AI		 12221\n\
12222SHOW-FLAG can be used to control whether the invoked application is hidden\n\
6fc2811b 12223or minimized. If SHOW-FLAG is nil, the application is displayed normally,\n\
55dcfc15
AI		 12224otherwise it is an integer representing a ShowWindow flag:\n\
12225\n\
12226 0 - start hidden\n\
12227 1 - start normally\n\
12228 3 - start maximized\n\
12229 6 - start minimized")
12230 (operation, document, parameters, show_flag)
12231 Lisp_Object operation, document, parameters, show_flag;
12232{
12233 Lisp_Object current_dir;
12234
55dcfc15
AI		 12235 CHECK_STRING (document, 0);
12236
12237 /* Encode filename and current directory. */
12238 current_dir = ENCODE_FILE (current_buffer->directory);
12239 document = ENCODE_FILE (document);
12240 if ((int) ShellExecute (NULL,
6fc2811b
JR		 12241 (STRINGP (operation) ?
12242 XSTRING (operation)->data : NULL),
55dcfc15
AI		 12243 XSTRING (document)->data,
12244 (STRINGP (parameters) ?
12245 XSTRING (parameters)->data : NULL),
12246 XSTRING (current_dir)->data,
12247 (INTEGERP (show_flag) ?
12248 XINT (show_flag) : SW_SHOWDEFAULT))
12249 > 32)
12250 return Qt;
12251 error ("ShellExecute failed");
12252}
12253
ccc2d29c
GV		 12254/* Lookup virtual keycode from string representing the name of a
12255 non-ascii keystroke into the corresponding virtual key, using
12256 lispy_function_keys. */
12257static int
12258lookup_vk_code (char *key)
12259{
12260 int i;
12261
12262 for (i = 0; i < 256; i++)
12263 if (lispy_function_keys[i] != 0
12264 && strcmp (lispy_function_keys[i], key) == 0)
12265 return i;
12266
12267 return -1;
12268}
12269
12270/* Convert a one-element vector style key sequence to a hot key
12271 definition. */
12272static int
12273w32_parse_hot_key (key)
12274 Lisp_Object key;
12275{
12276 /* Copied from Fdefine_key and store_in_keymap. */
12277 register Lisp_Object c;
12278 int vk_code;
12279 int lisp_modifiers;
12280 int w32_modifiers;
12281 struct gcpro gcpro1;
12282
12283 CHECK_VECTOR (key, 0);
12284
12285 if (XFASTINT (Flength (key)) != 1)
12286 return Qnil;
12287
12288 GCPRO1 (key);
12289
12290 c = Faref (key, make_number (0));
12291
12292 if (CONSP (c) && lucid_event_type_list_p (c))
12293 c = Fevent_convert_list (c);
12294
12295 UNGCPRO;
12296
12297 if (! INTEGERP (c) && ! SYMBOLP (c))
12298 error ("Key definition is invalid");
12299
12300 /* Work out the base key and the modifiers. */
12301 if (SYMBOLP (c))
12302 {
12303 c = parse_modifiers (c);
12304 lisp_modifiers = Fcar (Fcdr (c));
12305 c = Fcar (c);
12306 if (!SYMBOLP (c))
12307 abort ();
12308 vk_code = lookup_vk_code (XSYMBOL (c)->name->data);
12309 }
12310 else if (INTEGERP (c))
12311 {
12312 lisp_modifiers = XINT (c) & ~CHARACTERBITS;
12313 /* Many ascii characters are their own virtual key code. */
12314 vk_code = XINT (c) & CHARACTERBITS;
12315 }
12316
12317 if (vk_code < 0 || vk_code > 255)
12318 return Qnil;
12319
12320 if ((lisp_modifiers & meta_modifier) != 0
12321 && !NILP (Vw32_alt_is_meta))
12322 lisp_modifiers |= alt_modifier;
12323
12324 /* Convert lisp modifiers to Windows hot-key form. */
12325 w32_modifiers = (lisp_modifiers & hyper_modifier) ? MOD_WIN : 0;
12326 w32_modifiers |= (lisp_modifiers & alt_modifier) ? MOD_ALT : 0;
12327 w32_modifiers |= (lisp_modifiers & ctrl_modifier) ? MOD_CONTROL : 0;
12328 w32_modifiers |= (lisp_modifiers & shift_modifier) ? MOD_SHIFT : 0;
12329
12330 return HOTKEY (vk_code, w32_modifiers);
12331}
12332
12333DEFUN ("w32-register-hot-key", Fw32_register_hot_key, Sw32_register_hot_key, 1, 1, 0,
12334 "Register KEY as a hot-key combination.\n\
12335Certain key combinations like Alt-Tab are reserved for system use on\n\
12336Windows, and therefore are normally intercepted by the system. However,\n\
12337most of these key combinations can be received by registering them as\n\
12338hot-keys, overriding their special meaning.\n\
12339\n\
12340KEY must be a one element key definition in vector form that would be\n\
12341acceptable to `define-key' (e.g. [A-tab] for Alt-Tab). The meta\n\
12342modifier is interpreted as Alt if `w32-alt-is-meta' is t, and hyper\n\
12343is always interpreted as the Windows modifier keys.\n\
12344\n\
12345The return value is the hotkey-id if registered, otherwise nil.")
12346 (key)
12347 Lisp_Object key;
12348{
12349 key = w32_parse_hot_key (key);
12350
12351 if (NILP (Fmemq (key, w32_grabbed_keys)))
12352 {
12353 /* Reuse an empty slot if possible. */
12354 Lisp_Object item = Fmemq (Qnil, w32_grabbed_keys);
12355
12356 /* Safe to add new key to list, even if we have focus. */
12357 if (NILP (item))
12358 w32_grabbed_keys = Fcons (key, w32_grabbed_keys);
12359 else
12360 XCAR (item) = key;
12361
12362 /* Notify input thread about new hot-key definition, so that it
12363 takes effect without needing to switch focus. */
12364 PostThreadMessage (dwWindowsThreadId, WM_EMACS_REGISTER_HOT_KEY,
12365 (WPARAM) key, 0);
12366 }
12367
12368 return key;
12369}
12370
12371DEFUN ("w32-unregister-hot-key", Fw32_unregister_hot_key, Sw32_unregister_hot_key, 1, 1, 0,
12372 "Unregister HOTKEY as a hot-key combination.")
12373 (key)
12374 Lisp_Object key;
12375{
12376 Lisp_Object item;
12377
12378 if (!INTEGERP (key))
12379 key = w32_parse_hot_key (key);
12380
12381 item = Fmemq (key, w32_grabbed_keys);
12382
12383 if (!NILP (item))
12384 {
12385 /* Notify input thread about hot-key definition being removed, so
12386 that it takes effect without needing focus switch. */
12387 if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_UNREGISTER_HOT_KEY,
12388 (WPARAM) XINT (XCAR (item)), (LPARAM) item))
12389 {
12390 MSG msg;
12391 GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
12392 }
12393 return Qt;
12394 }
12395 return Qnil;
12396}
12397
12398DEFUN ("w32-registered-hot-keys", Fw32_registered_hot_keys, Sw32_registered_hot_keys, 0, 0, 0,
12399 "Return list of registered hot-key IDs.")
12400 ()
12401{
12402 return Fcopy_sequence (w32_grabbed_keys);
12403}
12404
12405DEFUN ("w32-reconstruct-hot-key", Fw32_reconstruct_hot_key, Sw32_reconstruct_hot_key, 1, 1, 0,
12406 "Convert hot-key ID to a lisp key combination.")
12407 (hotkeyid)
12408 Lisp_Object hotkeyid;
12409{
12410 int vk_code, w32_modifiers;
12411 Lisp_Object key;
12412
12413 CHECK_NUMBER (hotkeyid, 0);
12414
12415 vk_code = HOTKEY_VK_CODE (hotkeyid);
12416 w32_modifiers = HOTKEY_MODIFIERS (hotkeyid);
12417
12418 if (lispy_function_keys[vk_code])
12419 key = intern (lispy_function_keys[vk_code]);
12420 else
12421 key = make_number (vk_code);
12422
12423 key = Fcons (key, Qnil);
12424 if (w32_modifiers & MOD_SHIFT)
3ef68e6b 12425 key = Fcons (Qshift, key);
ccc2d29c 12426 if (w32_modifiers & MOD_CONTROL)
3ef68e6b 12427 key = Fcons (Qctrl, key);
ccc2d29c 12428 if (w32_modifiers & MOD_ALT)
3ef68e6b 12429 key = Fcons (NILP (Vw32_alt_is_meta) ? Qalt : Qmeta, key);
ccc2d29c 12430 if (w32_modifiers & MOD_WIN)
3ef68e6b 12431 key = Fcons (Qhyper, key);
ccc2d29c
GV		 12432
12433 return key;
12434}
adcc3809
GV		 12435
12436DEFUN ("w32-toggle-lock-key", Fw32_toggle_lock_key, Sw32_toggle_lock_key, 1, 2, 0,
12437 "Toggle the state of the lock key KEY.\n\
12438KEY can be `capslock', `kp-numlock', or `scroll'.\n\
12439If the optional parameter NEW-STATE is a number, then the state of KEY\n\
12440is set to off if the low bit of NEW-STATE is zero, otherwise on.")
12441 (key, new_state)
12442 Lisp_Object key, new_state;
12443{
12444 int vk_code;
12445 int cur_state;
12446
12447 if (EQ (key, intern ("capslock")))
12448 vk_code = VK_CAPITAL;
12449 else if (EQ (key, intern ("kp-numlock")))
12450 vk_code = VK_NUMLOCK;
12451 else if (EQ (key, intern ("scroll")))
12452 vk_code = VK_SCROLL;
12453 else
12454 return Qnil;
12455
12456 if (!dwWindowsThreadId)
12457 return make_number (w32_console_toggle_lock_key (vk_code, new_state));
12458
12459 if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_TOGGLE_LOCK_KEY,
12460 (WPARAM) vk_code, (LPARAM) new_state))
12461 {
12462 MSG msg;
12463 GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE);
12464 return make_number (msg.wParam);
12465 }
12466 return Qnil;
12467}
ee78dc32 12468\f
fbd6baed 12469syms_of_w32fns ()
ee78dc32 12470{
1edf84e7
GV		 12471 /* This is zero if not using MS-Windows. */
12472 w32_in_use = 0;
12473
ee78dc32
GV		 12474 /* The section below is built by the lisp expression at the top of the file,
12475 just above where these variables are declared. */
12476 /*&&& init symbols here &&&*/
12477 Qauto_raise = intern ("auto-raise");
12478 staticpro (&Qauto_raise);
12479 Qauto_lower = intern ("auto-lower");
12480 staticpro (&Qauto_lower);
ee78dc32
GV		 12481 Qbar = intern ("bar");
12482 staticpro (&Qbar);
12483 Qborder_color = intern ("border-color");
12484 staticpro (&Qborder_color);
12485 Qborder_width = intern ("border-width");
12486 staticpro (&Qborder_width);
12487 Qbox = intern ("box");
12488 staticpro (&Qbox);
12489 Qcursor_color = intern ("cursor-color");
12490 staticpro (&Qcursor_color);
12491 Qcursor_type = intern ("cursor-type");
12492 staticpro (&Qcursor_type);
ee78dc32
GV		 12493 Qgeometry = intern ("geometry");
12494 staticpro (&Qgeometry);
12495 Qicon_left = intern ("icon-left");
12496 staticpro (&Qicon_left);
12497 Qicon_top = intern ("icon-top");
12498 staticpro (&Qicon_top);
12499 Qicon_type = intern ("icon-type");
12500 staticpro (&Qicon_type);
12501 Qicon_name = intern ("icon-name");
12502 staticpro (&Qicon_name);
12503 Qinternal_border_width = intern ("internal-border-width");
12504 staticpro (&Qinternal_border_width);
12505 Qleft = intern ("left");
12506 staticpro (&Qleft);
1026b400
RS		 12507 Qright = intern ("right");
12508 staticpro (&Qright);
ee78dc32
GV		 12509 Qmouse_color = intern ("mouse-color");
12510 staticpro (&Qmouse_color);
12511 Qnone = intern ("none");
12512 staticpro (&Qnone);
12513 Qparent_id = intern ("parent-id");
12514 staticpro (&Qparent_id);
12515 Qscroll_bar_width = intern ("scroll-bar-width");
12516 staticpro (&Qscroll_bar_width);
12517 Qsuppress_icon = intern ("suppress-icon");
12518 staticpro (&Qsuppress_icon);
ee78dc32
GV		 12519 Qundefined_color = intern ("undefined-color");
12520 staticpro (&Qundefined_color);
12521 Qvertical_scroll_bars = intern ("vertical-scroll-bars");
12522 staticpro (&Qvertical_scroll_bars);
12523 Qvisibility = intern ("visibility");
12524 staticpro (&Qvisibility);
12525 Qwindow_id = intern ("window-id");
12526 staticpro (&Qwindow_id);
12527 Qx_frame_parameter = intern ("x-frame-parameter");
12528 staticpro (&Qx_frame_parameter);
12529 Qx_resource_name = intern ("x-resource-name");
12530 staticpro (&Qx_resource_name);
12531 Quser_position = intern ("user-position");
12532 staticpro (&Quser_position);
12533 Quser_size = intern ("user-size");
12534 staticpro (&Quser_size);
6fc2811b 12535#if 0 /* Duplicate initialization in xdisp.c */
ee78dc32
GV		 12536 Qdisplay = intern ("display");
12537 staticpro (&Qdisplay);
6fc2811b
JR		 12538#endif
12539 Qscreen_gamma = intern ("screen-gamma");
12540 staticpro (&Qscreen_gamma);
ee78dc32
GV		 12541 /* This is the end of symbol initialization. */
12542
adcc3809
GV		 12543 Qhyper = intern ("hyper");
12544 staticpro (&Qhyper);
12545 Qsuper = intern ("super");
12546 staticpro (&Qsuper);
12547 Qmeta = intern ("meta");
12548 staticpro (&Qmeta);
12549 Qalt = intern ("alt");
12550 staticpro (&Qalt);
12551 Qctrl = intern ("ctrl");
12552 staticpro (&Qctrl);
12553 Qcontrol = intern ("control");
12554 staticpro (&Qcontrol);
12555 Qshift = intern ("shift");
12556 staticpro (&Qshift);
12557
6fc2811b
JR		 12558 /* Text property `display' should be nonsticky by default. */
12559 Vtext_property_default_nonsticky
12560 = Fcons (Fcons (Qdisplay, Qt), Vtext_property_default_nonsticky);
12561
12562
12563 Qlaplace = intern ("laplace");
12564 staticpro (&Qlaplace);
12565
4b817373
RS		 12566 Qface_set_after_frame_default = intern ("face-set-after-frame-default");
12567 staticpro (&Qface_set_after_frame_default);
12568
ee78dc32
GV		 12569 Fput (Qundefined_color, Qerror_conditions,
12570 Fcons (Qundefined_color, Fcons (Qerror, Qnil)));
12571 Fput (Qundefined_color, Qerror_message,
12572 build_string ("Undefined color"));
12573
ccc2d29c
GV		 12574 staticpro (&w32_grabbed_keys);
12575 w32_grabbed_keys = Qnil;
12576
fbd6baed 12577 DEFVAR_LISP ("w32-color-map", &Vw32_color_map,
ccc2d29c 12578 "An array of color name mappings for windows.");
fbd6baed 12579 Vw32_color_map = Qnil;
ee78dc32 12580
fbd6baed 12581 DEFVAR_LISP ("w32-pass-alt-to-system", &Vw32_pass_alt_to_system,
da36a4d6
GV		 12582 "Non-nil if alt key presses are passed on to Windows.\n\
12583When non-nil, for example, alt pressed and released and then space will\n\
12584open the System menu. When nil, Emacs silently swallows alt key events.");
fbd6baed 12585 Vw32_pass_alt_to_system = Qnil;
da36a4d6 12586
fbd6baed 12587 DEFVAR_LISP ("w32-alt-is-meta", &Vw32_alt_is_meta,
8c205c63
RS		 12588 "Non-nil if the alt key is to be considered the same as the meta key.\n\
12589When nil, Emacs will translate the alt key to the Alt modifier, and not Meta.");
fbd6baed 12590 Vw32_alt_is_meta = Qt;
8c205c63 12591
7d081355
AI		 12592 DEFVAR_INT ("w32-quit-key", &Vw32_quit_key,
12593 "If non-zero, the virtual key code for an alternative quit key.");
12594 XSETINT (Vw32_quit_key, 0);
12595
ccc2d29c
GV		 12596 DEFVAR_LISP ("w32-pass-lwindow-to-system",
12597 &Vw32_pass_lwindow_to_system,
12598 "Non-nil if the left \"Windows\" key is passed on to Windows.\n\
12599When non-nil, the Start menu is opened by tapping the key.");
12600 Vw32_pass_lwindow_to_system = Qt;
12601
12602 DEFVAR_LISP ("w32-pass-rwindow-to-system",
12603 &Vw32_pass_rwindow_to_system,
12604 "Non-nil if the right \"Windows\" key is passed on to Windows.\n\
12605When non-nil, the Start menu is opened by tapping the key.");
12606 Vw32_pass_rwindow_to_system = Qt;
12607
adcc3809
GV		 12608 DEFVAR_INT ("w32-phantom-key-code",
12609 &Vw32_phantom_key_code,
12610 "Virtual key code used to generate \"phantom\" key presses.\n\
12611Value is a number between 0 and 255.\n\
12612\n\
12613Phantom key presses are generated in order to stop the system from\n\
12614acting on \"Windows\" key events when `w32-pass-lwindow-to-system' or\n\
12615`w32-pass-rwindow-to-system' is nil.");
ce6059da
AI		 12616 /* Although 255 is technically not a valid key code, it works and
12617 means that this hack won't interfere with any real key code. */
12618 Vw32_phantom_key_code = 255;
adcc3809 12619
ccc2d29c
GV		 12620 DEFVAR_LISP ("w32-enable-num-lock",
12621 &Vw32_enable_num_lock,
12622 "Non-nil if Num Lock should act normally.\n\
12623Set to nil to see Num Lock as the key `kp-numlock'.");
12624 Vw32_enable_num_lock = Qt;
12625
12626 DEFVAR_LISP ("w32-enable-caps-lock",
12627 &Vw32_enable_caps_lock,
12628 "Non-nil if Caps Lock should act normally.\n\
12629Set to nil to see Caps Lock as the key `capslock'.");
12630 Vw32_enable_caps_lock = Qt;
12631
12632 DEFVAR_LISP ("w32-scroll-lock-modifier",
12633 &Vw32_scroll_lock_modifier,
12634 "Modifier to use for the Scroll Lock on state.\n\
12635The value can be hyper, super, meta, alt, control or shift for the\n\
12636respective modifier, or nil to see Scroll Lock as the key `scroll'.\n\
12637Any other value will cause the key to be ignored.");
12638 Vw32_scroll_lock_modifier = Qt;
12639
12640 DEFVAR_LISP ("w32-lwindow-modifier",
12641 &Vw32_lwindow_modifier,
12642 "Modifier to use for the left \"Windows\" key.\n\
12643The value can be hyper, super, meta, alt, control or shift for the\n\
12644respective modifier, or nil to appear as the key `lwindow'.\n\
12645Any other value will cause the key to be ignored.");
12646 Vw32_lwindow_modifier = Qnil;
12647
12648 DEFVAR_LISP ("w32-rwindow-modifier",
12649 &Vw32_rwindow_modifier,
12650 "Modifier to use for the right \"Windows\" key.\n\
12651The value can be hyper, super, meta, alt, control or shift for the\n\
12652respective modifier, or nil to appear as the key `rwindow'.\n\
12653Any other value will cause the key to be ignored.");
12654 Vw32_rwindow_modifier = Qnil;
12655
12656 DEFVAR_LISP ("w32-apps-modifier",
12657 &Vw32_apps_modifier,
12658 "Modifier to use for the \"Apps\" key.\n\
12659The value can be hyper, super, meta, alt, control or shift for the\n\
12660respective modifier, or nil to appear as the key `apps'.\n\
12661Any other value will cause the key to be ignored.");
12662 Vw32_apps_modifier = Qnil;
da36a4d6 12663
6fc2811b
JR		 12664 DEFVAR_LISP ("w32-enable-synthesized_fonts", &Vw32_enable_synthesized_fonts,
12665 "Non-nil enables selection of artificially italicized and bold fonts.");
12666 Vw32_enable_synthesized_fonts = Qnil;
5ac45f98 12667
fbd6baed 12668 DEFVAR_LISP ("w32-enable-palette", &Vw32_enable_palette,
6fc2811b 12669 "Non-nil enables Windows palette management to map colors exactly.");
fbd6baed 12670 Vw32_enable_palette = Qt;
5ac45f98 12671
fbd6baed
GV		 12672 DEFVAR_INT ("w32-mouse-button-tolerance",
12673 &Vw32_mouse_button_tolerance,
6fc2811b 12674 "Analogue of double click interval for faking middle mouse events.\n\
5ac45f98
GV		 12675The value is the minimum time in milliseconds that must elapse between\n\
12676left/right button down events before they are considered distinct events.\n\
12677If both mouse buttons are depressed within this interval, a middle mouse\n\
12678button down event is generated instead.");
fbd6baed 12679 XSETINT (Vw32_mouse_button_tolerance, GetDoubleClickTime () / 2);
5ac45f98 12680
fbd6baed
GV		 12681 DEFVAR_INT ("w32-mouse-move-interval",
12682 &Vw32_mouse_move_interval,
84fb1139
KH		 12683 "Minimum interval between mouse move events.\n\
12684The value is the minimum time in milliseconds that must elapse between\n\
12685successive mouse move (or scroll bar drag) events before they are\n\
12686reported as lisp events.");
247be837 12687 XSETINT (Vw32_mouse_move_interval, 0);
84fb1139 12688
ee78dc32
GV		 12689 init_x_parm_symbols ();
12690
12691 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path,
fbd6baed 12692 "List of directories to search for bitmap files for w32.");
ee78dc32
GV		 12693 Vx_bitmap_file_path = decode_env_path ((char *) 0, "PATH");
12694
12695 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape,
12696 "The shape of the pointer when over text.\n\
12697Changing the value does not affect existing frames\n\
12698unless you set the mouse color.");
12699 Vx_pointer_shape = Qnil;
12700
12701 DEFVAR_LISP ("x-resource-name", &Vx_resource_name,
12702 "The name Emacs uses to look up resources; for internal use only.\n\
12703`x-get-resource' uses this as the first component of the instance name\n\
12704when requesting resource values.\n\
12705Emacs initially sets `x-resource-name' to the name under which Emacs\n\
12706was invoked, or to the value specified with the `-name' or `-rn'\n\
12707switches, if present.");
12708 Vx_resource_name = Qnil;
12709
12710 Vx_nontext_pointer_shape = Qnil;
12711
12712 Vx_mode_pointer_shape = Qnil;
12713
6fc2811b
JR		 12714 DEFVAR_LISP ("x-busy-pointer-shape", &Vx_busy_pointer_shape,
12715 "The shape of the pointer when Emacs is busy.\n\
12716This variable takes effect when you create a new frame\n\
12717or when you set the mouse color.");
12718 Vx_busy_pointer_shape = Qnil;
12719
12720 DEFVAR_BOOL ("display-busy-cursor", &display_busy_cursor_p,
12721 "Non-zero means Emacs displays a busy cursor on window systems.");
12722 display_busy_cursor_p = 1;
12723
12724 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
ee78dc32
GV		 12725 &Vx_sensitive_text_pointer_shape,
12726 "The shape of the pointer when over mouse-sensitive text.\n\
12727This variable takes effect when you create a new frame\n\
12728or when you set the mouse color.");
12729 Vx_sensitive_text_pointer_shape = Qnil;
12730
12731 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel,
12732 "A string indicating the foreground color of the cursor box.");
12733 Vx_cursor_fore_pixel = Qnil;
12734
12735 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager,
12736 "Non-nil if no window manager is in use.\n\
12737Emacs doesn't try to figure this out; this is always nil\n\
12738unless you set it to something else.");
12739 /* We don't have any way to find this out, so set it to nil
12740 and maybe the user would like to set it to t. */
12741 Vx_no_window_manager = Qnil;
12742
4587b026
GV		 12743 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
12744 &Vx_pixel_size_width_font_regexp,
12745 "Regexp matching a font name whose width is the same as `PIXEL_SIZE'.\n\
12746\n\
12747Since Emacs gets width of a font matching with this regexp from\n\
12748PIXEL_SIZE field of the name, font finding mechanism gets faster for\n\
12749such a font. This is especially effective for such large fonts as\n\
12750Chinese, Japanese, and Korean.");
12751 Vx_pixel_size_width_font_regexp = Qnil;
12752
6fc2811b
JR		 12753 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay,
12754 "Time after which cached images are removed from the cache.\n\
12755When an image has not been displayed this many seconds, remove it\n\
12756from the image cache. Value must be an integer or nil with nil\n\
12757meaning don't clear the cache.");
12758 Vimage_cache_eviction_delay = make_number (30 * 60);
12759
12760 DEFVAR_LISP ("image-types", &Vimage_types,
12761 "List of supported image types.\n\
12762Each element of the list is a symbol for a supported image type.");
12763 Vimage_types = Qnil;
12764
33d52f9c
GV		 12765 DEFVAR_LISP ("w32-bdf-filename-alist",
12766 &Vw32_bdf_filename_alist,
12767 "List of bdf fonts and their corresponding filenames.");
12768 Vw32_bdf_filename_alist = Qnil;
12769
1075afa9
GV		 12770 DEFVAR_BOOL ("w32-strict-fontnames",
12771 &w32_strict_fontnames,
12772 "Non-nil means only use fonts that are exact matches for those requested.\n\
12773Default is nil, which allows old fontnames that are not XLFD compliant,\n\
12774and allows third-party CJK display to work by specifying false charset\n\
12775fields to trick Emacs into translating to Big5, SJIS etc.\n\
12776Setting this to t will prevent wrong fonts being selected when\n\
12777fontsets are automatically created.");
12778 w32_strict_fontnames = 0;
12779
c0611964
AI		 12780 DEFVAR_BOOL ("w32-strict-painting",
12781 &w32_strict_painting,
12782 "Non-nil means use strict rules for repainting frames.\n\
12783Set this to nil to get the old behaviour for repainting; this should\n\
12784only be necessary if the default setting causes problems.");
12785 w32_strict_painting = 1;
12786
f46e6225
GV		 12787 DEFVAR_LISP ("w32-system-coding-system",
12788 &Vw32_system_coding_system,
12789 "Coding system used by Windows system functions, such as for font names.");
12790 Vw32_system_coding_system = Qnil;
12791
ee78dc32 12792 defsubr (&Sx_get_resource);
6fc2811b
JR		 12793#if 0 /* NTEMACS_TODO: Port to W32 */
12794 defsubr (&Sx_change_window_property);
12795 defsubr (&Sx_delete_window_property);
12796 defsubr (&Sx_window_property);
12797#endif
2d764c78 12798 defsubr (&Sxw_display_color_p);
ee78dc32 12799 defsubr (&Sx_display_grayscale_p);
2d764c78
EZ		 12800 defsubr (&Sxw_color_defined_p);
12801 defsubr (&Sxw_color_values);
ee78dc32
GV		 12802 defsubr (&Sx_server_max_request_size);
12803 defsubr (&Sx_server_vendor);
12804 defsubr (&Sx_server_version);
12805 defsubr (&Sx_display_pixel_width);
12806 defsubr (&Sx_display_pixel_height);
12807 defsubr (&Sx_display_mm_width);
12808 defsubr (&Sx_display_mm_height);
12809 defsubr (&Sx_display_screens);
12810 defsubr (&Sx_display_planes);
12811 defsubr (&Sx_display_color_cells);
12812 defsubr (&Sx_display_visual_class);
12813 defsubr (&Sx_display_backing_store);
12814 defsubr (&Sx_display_save_under);
12815 defsubr (&Sx_parse_geometry);
12816 defsubr (&Sx_create_frame);
ee78dc32
GV		 12817 defsubr (&Sx_open_connection);
12818 defsubr (&Sx_close_connection);
12819 defsubr (&Sx_display_list);
12820 defsubr (&Sx_synchronize);
12821
fbd6baed 12822 /* W32 specific functions */
ee78dc32 12823
1edf84e7 12824 defsubr (&Sw32_focus_frame);
fbd6baed
GV		 12825 defsubr (&Sw32_select_font);
12826 defsubr (&Sw32_define_rgb_color);
12827 defsubr (&Sw32_default_color_map);
12828 defsubr (&Sw32_load_color_file);
1edf84e7 12829 defsubr (&Sw32_send_sys_command);
55dcfc15 12830 defsubr (&Sw32_shell_execute);
ccc2d29c
GV		 12831 defsubr (&Sw32_register_hot_key);
12832 defsubr (&Sw32_unregister_hot_key);
12833 defsubr (&Sw32_registered_hot_keys);
12834 defsubr (&Sw32_reconstruct_hot_key);
adcc3809 12835 defsubr (&Sw32_toggle_lock_key);
33d52f9c 12836 defsubr (&Sw32_find_bdf_fonts);
4587b026
GV		 12837
12838 /* Setting callback functions for fontset handler. */
12839 get_font_info_func = w32_get_font_info;
6fc2811b
JR		 12840
12841#if 0 /* This function pointer doesn't seem to be used anywhere.
12842 And the pointer assigned has the wrong type, anyway. */
4587b026 12843 list_fonts_func = w32_list_fonts;
6fc2811b
JR		 12844#endif
12845
4587b026
GV		 12846 load_font_func = w32_load_font;
12847 find_ccl_program_func = w32_find_ccl_program;
12848 query_font_func = w32_query_font;
12849 set_frame_fontset_func = x_set_font;
12850 check_window_system_func = check_w32;
6fc2811b
JR		 12851
12852#if 0 /* NTEMACS_TODO Image support for W32 */
12853 /* Images. */
12854 Qxbm = intern ("xbm");
12855 staticpro (&Qxbm);
12856 QCtype = intern (":type");
12857 staticpro (&QCtype);
12858 QCalgorithm = intern (":algorithm");
12859 staticpro (&QCalgorithm);
12860 QCheuristic_mask = intern (":heuristic-mask");
12861 staticpro (&QCheuristic_mask);
12862 QCcolor_symbols = intern (":color-symbols");
12863 staticpro (&QCcolor_symbols);
12864 QCdata = intern (":data");
12865 staticpro (&QCdata);
12866 QCascent = intern (":ascent");
12867 staticpro (&QCascent);
12868 QCmargin = intern (":margin");
12869 staticpro (&QCmargin);
12870 QCrelief = intern (":relief");
12871 staticpro (&QCrelief);
12872 Qpostscript = intern ("postscript");
12873 staticpro (&Qpostscript);
12874 QCloader = intern (":loader");
12875 staticpro (&QCloader);
12876 QCbounding_box = intern (":bounding-box");
12877 staticpro (&QCbounding_box);
12878 QCpt_width = intern (":pt-width");
12879 staticpro (&QCpt_width);
12880 QCpt_height = intern (":pt-height");
12881 staticpro (&QCpt_height);
12882 QCindex = intern (":index");
12883 staticpro (&QCindex);
12884 Qpbm = intern ("pbm");
12885 staticpro (&Qpbm);
12886
12887#if HAVE_XPM
12888 Qxpm = intern ("xpm");
12889 staticpro (&Qxpm);
12890#endif
12891
12892#if HAVE_JPEG
12893 Qjpeg = intern ("jpeg");
12894 staticpro (&Qjpeg);
12895#endif
12896
12897#if HAVE_TIFF
12898 Qtiff = intern ("tiff");
12899 staticpro (&Qtiff);
12900#endif
12901
12902#if HAVE_GIF
12903 Qgif = intern ("gif");
12904 staticpro (&Qgif);
12905#endif
12906
12907#if HAVE_PNG
12908 Qpng = intern ("png");
12909 staticpro (&Qpng);
12910#endif
12911
12912 defsubr (&Sclear_image_cache);
12913
12914#if GLYPH_DEBUG
12915 defsubr (&Simagep);
12916 defsubr (&Slookup_image);
12917#endif
12918#endif /* NTEMACS_TODO */
12919
12920 /* Busy-cursor. */
12921 defsubr (&Sx_show_busy_cursor);
12922 defsubr (&Sx_hide_busy_cursor);
12923 busy_count = 0;
12924 inhibit_busy_cursor = 0;
12925
12926 defsubr (&Sx_show_tip);
12927 defsubr (&Sx_hide_tip);
12928 staticpro (&tip_timer);
12929 tip_timer = Qnil;
12930
12931 defsubr (&Sx_file_dialog);
12932}
12933
12934
12935void
12936init_xfns ()
12937{
12938 image_types = NULL;
12939 Vimage_types = Qnil;
12940
12941#if 0 /* NTEMACS_TODO : Image support for W32 */
12942 define_image_type (&xbm_type);
12943 define_image_type (&gs_type);
12944 define_image_type (&pbm_type);
12945
12946#if HAVE_XPM
12947 define_image_type (&xpm_type);
12948#endif
12949
12950#if HAVE_JPEG
12951 define_image_type (&jpeg_type);
12952#endif
12953
12954#if HAVE_TIFF
12955 define_image_type (&tiff_type);
12956#endif
12957
12958#if HAVE_GIF
12959 define_image_type (&gif_type);
12960#endif
12961
12962#if HAVE_PNG
12963 define_image_type (&png_type);
12964#endif
12965#endif /* NTEMACS_TODO */
ee78dc32
GV		 12966}
12967
12968#undef abort
12969
12970void
fbd6baed 12971w32_abort()
ee78dc32 12972{
5ac45f98
GV		 12973 int button;
12974 button = MessageBox (NULL,
12975 "A fatal error has occurred!\n\n"
12976 "Select Abort to exit, Retry to debug, Ignore to continue",
12977 "Emacs Abort Dialog",
12978 MB_ICONEXCLAMATION | MB_TASKMODAL
12979 | MB_SETFOREGROUND | MB_ABORTRETRYIGNORE);
12980 switch (button)
12981 {
12982 case IDRETRY:
12983 DebugBreak ();
12984 break;
12985 case IDIGNORE:
12986 break;
12987 case IDABORT:
12988 default:
12989 abort ();
12990 break;
12991 }
ee78dc32 12992}
d573caac 12993
83c75055
GV		 12994/* For convenience when debugging. */
12995int
12996w32_last_error()
12997{
12998 return GetLastError ();
12999}
Unnamed repository; edit this file 'description' to name the repository.