aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
authorJason Rumney2000-01-23 03:18:25 +0000
committerJason Rumney2000-01-23 03:18:25 +0000
commit6fc2811b20860e2e2cbd9d7c079c484c4f4c67f6 (patch)
treea9243ef13f3c3323e0f13778d3d3d7f8c29a1b60 /src
parentf6e15a141af6df6e131192649af6bbbb98f4761a (diff)
downloademacs-6fc2811b20860e2e2cbd9d7c079c484c4f4c67f6.tar.gz
emacs-6fc2811b20860e2e2cbd9d7c079c484c4f4c67f6.zip
Substantial rewrite for new redisplay. Major changes:
Skeleton support for images, toolbars, tooltips from xfns.c. (Fx_create_frame): Use system default for default scroll bar width. (w32_get_arg): Renamed from x_get_arg. (Fx_file_dialog): New function. (w32_list_fonts): Check cache before asking system. (Vw32_enable_synthesized_fonts): New variable. (Vw32_enable_italics): Obsolete, removed.
Diffstat (limited to 'src')
-rw-r--r--src/w32fns.c6332
1 files changed, 5828 insertions, 504 deletions
diff --git a/src/w32fns.c b/src/w32fns.c
index 5c8e78c42b7..5b6c9d3d3b1 100644
--- a/src/w32fns.c
+++ b/src/w32fns.c
@@ -1,5 +1,6 @@
1/* Graphical user interface functions for the Microsoft W32 API. 1/* Graphical user interface functions for the Microsoft W32 API.
2 Copyright (C) 1989, 92, 93, 94, 95, 1996 Free Software Foundation, Inc. 2 Copyright (C) 1989, 92, 93, 94, 95, 1996, 1997, 1998, 1999
3 Free Software Foundation, Inc.
3 4
4This file is part of GNU Emacs. 5This file is part of GNU Emacs.
5 6
@@ -35,6 +36,7 @@ Boston, MA 02111-1307, USA. */
35#include "window.h" 36#include "window.h"
36#include "buffer.h" 37#include "buffer.h"
37#include "dispextern.h" 38#include "dispextern.h"
39#include "intervals.h"
38#include "keyboard.h" 40#include "keyboard.h"
39#include "blockinput.h" 41#include "blockinput.h"
40#include "epaths.h" 42#include "epaths.h"
@@ -42,18 +44,40 @@ Boston, MA 02111-1307, USA. */
42#include "termhooks.h" 44#include "termhooks.h"
43#include "coding.h" 45#include "coding.h"
44#include "ccl.h" 46#include "ccl.h"
47#include "systime.h"
48
49#include "bitmaps/gray.xbm"
45 50
46#include <commdlg.h> 51#include <commdlg.h>
47#include <shellapi.h> 52#include <shellapi.h>
53#include <ctype.h>
48 54
49extern void abort ();
50extern void free_frame_menubar (); 55extern void free_frame_menubar ();
56extern double atof ();
51extern struct scroll_bar *x_window_to_scroll_bar (); 57extern struct scroll_bar *x_window_to_scroll_bar ();
52extern int w32_console_toggle_lock_key (int vk_code, Lisp_Object new_state); 58extern int w32_console_toggle_lock_key (int vk_code, Lisp_Object new_state);
53extern int quit_char; 59extern int quit_char;
54 60
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
55extern char *lispy_function_keys[]; 71extern char *lispy_function_keys[];
56 72
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
57/* The colormap for converting color names to RGB values */ 81/* The colormap for converting color names to RGB values */
58Lisp_Object Vw32_color_map; 82Lisp_Object Vw32_color_map;
59 83
@@ -100,9 +124,9 @@ Lisp_Object Vw32_enable_caps_lock;
100/* Modifier associated with Scroll Lock, or nil to act as a normal key. */ 124/* Modifier associated with Scroll Lock, or nil to act as a normal key. */
101Lisp_Object Vw32_scroll_lock_modifier; 125Lisp_Object Vw32_scroll_lock_modifier;
102 126
103/* Switch to control whether we inhibit requests for italicised fonts (which 127/* Switch to control whether we inhibit requests for synthesyzed bold
104 are synthesized, look ugly, and are trashed by cursor movement under NT). */ 128 and italic versions of fonts. */
105Lisp_Object Vw32_enable_italics; 129Lisp_Object Vw32_enable_synthesized_fonts;
106 130
107/* Enable palette management. */ 131/* Enable palette management. */
108Lisp_Object Vw32_enable_palette; 132Lisp_Object Vw32_enable_palette;
@@ -121,9 +145,14 @@ Lisp_Object Vx_resource_name;
121/* Non nil if no window manager is in use. */ 145/* Non nil if no window manager is in use. */
122Lisp_Object Vx_no_window_manager; 146Lisp_Object Vx_no_window_manager;
123 147
148/* Non-zero means we're allowed to display a busy cursor. */
149int display_busy_cursor_p;
150
124/* The background and shape of the mouse pointer, and shape when not 151/* The background and shape of the mouse pointer, and shape when not
125 over text or in the modeline. */ 152 over text or in the modeline. */
126Lisp_Object Vx_pointer_shape, Vx_nontext_pointer_shape, Vx_mode_pointer_shape; 153Lisp_Object Vx_pointer_shape, Vx_nontext_pointer_shape, Vx_mode_pointer_shape;
154Lisp_Object Vx_busy_pointer_shape;
155
127/* The shape when over mouse-sensitive text. */ 156/* The shape when over mouse-sensitive text. */
128Lisp_Object Vx_sensitive_text_pointer_shape; 157Lisp_Object Vx_sensitive_text_pointer_shape;
129 158
@@ -188,14 +217,12 @@ int w32_strict_painting;
188/*&&& symbols declared here &&&*/ 217/*&&& symbols declared here &&&*/
189Lisp_Object Qauto_raise; 218Lisp_Object Qauto_raise;
190Lisp_Object Qauto_lower; 219Lisp_Object Qauto_lower;
191Lisp_Object Qbackground_color;
192Lisp_Object Qbar; 220Lisp_Object Qbar;
193Lisp_Object Qborder_color; 221Lisp_Object Qborder_color;
194Lisp_Object Qborder_width; 222Lisp_Object Qborder_width;
195Lisp_Object Qbox; 223Lisp_Object Qbox;
196Lisp_Object Qcursor_color; 224Lisp_Object Qcursor_color;
197Lisp_Object Qcursor_type; 225Lisp_Object Qcursor_type;
198Lisp_Object Qforeground_color;
199Lisp_Object Qgeometry; 226Lisp_Object Qgeometry;
200Lisp_Object Qicon_left; 227Lisp_Object Qicon_left;
201Lisp_Object Qicon_top; 228Lisp_Object Qicon_top;
@@ -209,7 +236,6 @@ Lisp_Object Qnone;
209Lisp_Object Qparent_id; 236Lisp_Object Qparent_id;
210Lisp_Object Qscroll_bar_width; 237Lisp_Object Qscroll_bar_width;
211Lisp_Object Qsuppress_icon; 238Lisp_Object Qsuppress_icon;
212Lisp_Object Qtop;
213Lisp_Object Qundefined_color; 239Lisp_Object Qundefined_color;
214Lisp_Object Qvertical_scroll_bars; 240Lisp_Object Qvertical_scroll_bars;
215Lisp_Object Qvisibility; 241Lisp_Object Qvisibility;
@@ -218,8 +244,7 @@ Lisp_Object Qx_frame_parameter;
218Lisp_Object Qx_resource_name; 244Lisp_Object Qx_resource_name;
219Lisp_Object Quser_position; 245Lisp_Object Quser_position;
220Lisp_Object Quser_size; 246Lisp_Object Quser_size;
221Lisp_Object Qdisplay; 247Lisp_Object Qscreen_gamma;
222
223Lisp_Object Qhyper; 248Lisp_Object Qhyper;
224Lisp_Object Qsuper; 249Lisp_Object Qsuper;
225Lisp_Object Qmeta; 250Lisp_Object Qmeta;
@@ -228,6 +253,10 @@ Lisp_Object Qctrl;
228Lisp_Object Qcontrol; 253Lisp_Object Qcontrol;
229Lisp_Object Qshift; 254Lisp_Object Qshift;
230 255
256extern Lisp_Object Qtop;
257extern Lisp_Object Qdisplay;
258extern Lisp_Object Qtool_bar_lines;
259
231/* State variables for emulating a three button mouse. */ 260/* State variables for emulating a three button mouse. */
232#define LMOUSE 1 261#define LMOUSE 1
233#define MMOUSE 2 262#define MMOUSE 2
@@ -248,6 +277,7 @@ unsigned int msh_mousewheel = 0;
248/* The below are defined in frame.c. */ 277/* The below are defined in frame.c. */
249extern Lisp_Object Qheight, Qminibuffer, Qname, Qonly, Qwidth; 278extern Lisp_Object Qheight, Qminibuffer, Qname, Qonly, Qwidth;
250extern Lisp_Object Qunsplittable, Qmenu_bar_lines, Qbuffer_predicate, Qtitle; 279extern Lisp_Object Qunsplittable, Qmenu_bar_lines, Qbuffer_predicate, Qtitle;
280extern Lisp_Object Qtool_bar_lines;
251 281
252extern Lisp_Object Vwindow_system_version; 282extern Lisp_Object Vwindow_system_version;
253 283
@@ -288,12 +318,9 @@ check_x_frame (frame)
288 FRAME_PTR f; 318 FRAME_PTR f;
289 319
290 if (NILP (frame)) 320 if (NILP (frame))
291 f = selected_frame; 321 frame = selected_frame;
292 else 322 CHECK_LIVE_FRAME (frame, 0);
293 { 323 f = XFRAME (frame);
294 CHECK_LIVE_FRAME (frame, 0);
295 f = XFRAME (frame);
296 }
297 if (! FRAME_W32_P (f)) 324 if (! FRAME_W32_P (f))
298 error ("non-w32 frame used"); 325 error ("non-w32 frame used");
299 return f; 326 return f;
@@ -309,8 +336,10 @@ check_x_display_info (frame)
309{ 336{
310 if (NILP (frame)) 337 if (NILP (frame))
311 { 338 {
312 if (FRAME_W32_P (selected_frame)) 339 struct frame *sf = XFRAME (selected_frame);
313 return FRAME_W32_DISPLAY_INFO (selected_frame); 340
341 if (FRAME_W32_P (sf) && FRAME_LIVE_P (sf))
342 return FRAME_W32_DISPLAY_INFO (sf);
314 else 343 else
315 return &one_w32_display_info; 344 return &one_w32_display_info;
316 } 345 }
@@ -478,10 +507,10 @@ x_create_bitmap_from_file (f, file)
478 Lisp_Object file; 507 Lisp_Object file;
479{ 508{
480 return -1; 509 return -1;
481#if 0 510#if 0 /* NTEMACS_TODO : bitmap support */
482 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f); 511 struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
483 unsigned int width, height; 512 unsigned int width, height;
484 Pixmap bitmap; 513 HBITMAP bitmap;
485 int xhot, yhot, result, id; 514 int xhot, yhot, result, id;
486 Lisp_Object found; 515 Lisp_Object found;
487 int fd; 516 int fd;
@@ -507,7 +536,7 @@ x_create_bitmap_from_file (f, file)
507 /* LoadLibraryEx won't handle special files handled by Emacs handler. */ 536 /* LoadLibraryEx won't handle special files handled by Emacs handler. */
508 if (fd == 0) 537 if (fd == 0)
509 return -1; 538 return -1;
510 close (fd); 539 emacs_close (fd);
511 540
512 filename = (char *) XSTRING (found)->data; 541 filename = (char *) XSTRING (found)->data;
513 542
@@ -532,7 +561,7 @@ x_create_bitmap_from_file (f, file)
532 strcpy (dpyinfo->bitmaps[id - 1].file, XSTRING (file)->data); 561 strcpy (dpyinfo->bitmaps[id - 1].file, XSTRING (file)->data);
533 562
534 return id; 563 return id;
535#endif 564#endif /* NTEMACS_TODO */
536} 565}
537 566
538/* Remove reference to bitmap with id number ID. */ 567/* Remove reference to bitmap with id number ID. */
@@ -553,7 +582,7 @@ x_destroy_bitmap (f, id)
553 DeleteObject (dpyinfo->bitmaps[id - 1].pixmap); 582 DeleteObject (dpyinfo->bitmaps[id - 1].pixmap);
554 if (dpyinfo->bitmaps[id - 1].file) 583 if (dpyinfo->bitmaps[id - 1].file)
555 { 584 {
556 free (dpyinfo->bitmaps[id - 1].file); 585 xfree (dpyinfo->bitmaps[id - 1].file);
557 dpyinfo->bitmaps[id - 1].file = NULL; 586 dpyinfo->bitmaps[id - 1].file = NULL;
558 } 587 }
559 UNBLOCK_INPUT; 588 UNBLOCK_INPUT;
@@ -573,7 +602,7 @@ x_destroy_all_bitmaps (dpyinfo)
573 { 602 {
574 DeleteObject (dpyinfo->bitmaps[i].pixmap); 603 DeleteObject (dpyinfo->bitmaps[i].pixmap);
575 if (dpyinfo->bitmaps[i].file) 604 if (dpyinfo->bitmaps[i].file)
576 free (dpyinfo->bitmaps[i].file); 605 xfree (dpyinfo->bitmaps[i].file);
577 } 606 }
578 dpyinfo->bitmaps_last = 0; 607 dpyinfo->bitmaps_last = 0;
579} 608}
@@ -608,29 +637,34 @@ enum x_frame_parm
608struct x_frame_parm_table 637struct x_frame_parm_table
609{ 638{
610 char *name; 639 char *name;
611 void (*setter)( /* struct frame *frame, Lisp_Object val, oldval */ ); 640 void (*setter) P_ ((struct frame *, Lisp_Object, Lisp_Object));
612}; 641};
613 642
614void x_set_foreground_color (); 643/* NTEMACS_TODO: Native Input Method support; see x_create_im. */
615void x_set_background_color (); 644void x_set_foreground_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
616void x_set_mouse_color (); 645void x_set_background_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
617void x_set_cursor_color (); 646void x_set_mouse_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
618void x_set_border_color (); 647void x_set_cursor_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
619void x_set_cursor_type (); 648void x_set_border_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
620void x_set_icon_type (); 649void x_set_cursor_type P_ ((struct frame *, Lisp_Object, Lisp_Object));
621void x_set_icon_name (); 650void x_set_icon_type P_ ((struct frame *, Lisp_Object, Lisp_Object));
622void x_set_font (); 651void x_set_icon_name P_ ((struct frame *, Lisp_Object, Lisp_Object));
623void x_set_border_width (); 652void x_set_font P_ ((struct frame *, Lisp_Object, Lisp_Object));
624void x_set_internal_border_width (); 653void x_set_border_width P_ ((struct frame *, Lisp_Object, Lisp_Object));
625void x_explicitly_set_name (); 654void x_set_internal_border_width P_ ((struct frame *, Lisp_Object,
626void x_set_autoraise (); 655 Lisp_Object));
627void x_set_autolower (); 656void x_explicitly_set_name P_ ((struct frame *, Lisp_Object, Lisp_Object));
628void x_set_vertical_scroll_bars (); 657void x_set_autoraise P_ ((struct frame *, Lisp_Object, Lisp_Object));
629void x_set_visibility (); 658void x_set_autolower P_ ((struct frame *, Lisp_Object, Lisp_Object));
630void x_set_menu_bar_lines (); 659void x_set_vertical_scroll_bars P_ ((struct frame *, Lisp_Object,
631void x_set_scroll_bar_width (); 660 Lisp_Object));
632void x_set_title (); 661void x_set_visibility P_ ((struct frame *, Lisp_Object, Lisp_Object));
633void x_set_unsplittable (); 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));
634 668
635static struct x_frame_parm_table x_frame_parms[] = 669static struct x_frame_parm_table x_frame_parms[] =
636{ 670{
@@ -654,6 +688,8 @@ static struct x_frame_parm_table x_frame_parms[] =
654 "unsplittable", x_set_unsplittable, 688 "unsplittable", x_set_unsplittable,
655 "vertical-scroll-bars", x_set_vertical_scroll_bars, 689 "vertical-scroll-bars", x_set_vertical_scroll_bars,
656 "visibility", x_set_visibility, 690 "visibility", x_set_visibility,
691 "tool-bar-lines", x_set_tool_bar_lines,
692 "screen-gamma", x_set_screen_gamma
657}; 693};
658 694
659/* Attach the `x-frame-parameter' properties to 695/* Attach the `x-frame-parameter' properties to
@@ -711,7 +747,7 @@ x_set_frame_parameters (f, alist)
711 i = 0; 747 i = 0;
712 for (tail = alist; CONSP (tail); tail = Fcdr (tail)) 748 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
713 { 749 {
714 Lisp_Object elt, prop, val; 750 Lisp_Object elt;
715 751
716 elt = Fcar (tail); 752 elt = Fcar (tail);
717 parms[i] = Fcar (elt); 753 parms[i] = Fcar (elt);
@@ -1709,18 +1745,37 @@ w32_unmap_color (FRAME_PTR f, COLORREF color)
1709} 1745}
1710#endif 1746#endif
1711 1747
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
1712/* Decide if color named COLOR is valid for the display associated with 1766/* Decide if color named COLOR is valid for the display associated with
1713 the selected frame; if so, return the rgb values in COLOR_DEF. 1767 the selected frame; if so, return the rgb values in COLOR_DEF.
1714 If ALLOC is nonzero, allocate a new colormap cell. */ 1768 If ALLOC is nonzero, allocate a new colormap cell. */
1715 1769
1716int 1770int
1717defined_color (f, color, color_def, alloc) 1771w32_defined_color (f, color, color_def, alloc)
1718 FRAME_PTR f; 1772 FRAME_PTR f;
1719 char *color; 1773 char *color;
1720 COLORREF *color_def; 1774 XColor *color_def;
1721 int alloc; 1775 int alloc;
1722{ 1776{
1723 register Lisp_Object tem; 1777 register Lisp_Object tem;
1778 COLORREF w32_color_ref;
1724 1779
1725 tem = x_to_w32_color (color); 1780 tem = x_to_w32_color (color);
1726 1781
@@ -1759,7 +1814,19 @@ defined_color (f, color, color_def, alloc)
1759 /* Ensure COLORREF value is snapped to nearest color in (default) 1814 /* Ensure COLORREF value is snapped to nearest color in (default)
1760 palette by simulating the PALETTERGB macro. This works whether 1815 palette by simulating the PALETTERGB macro. This works whether
1761 or not the display device has a palette. */ 1816 or not the display device has a palette. */
1762 *color_def = XUINT (tem) | 0x2000000; 1817 w32_color_ref = XUINT (tem) | 0x2000000;
1818
1819 /* NTEMACS_TODO: Palette mapping should come after gamma
1820 correction. */
1821 /* Apply gamma correction. */
1822 if (f)
1823 gamma_correct (f, &w32_color_ref);
1824
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
1763 return 1; 1830 return 1;
1764 } 1831 }
1765 else 1832 else
@@ -1779,7 +1846,7 @@ x_decode_color (f, arg, def)
1779 Lisp_Object arg; 1846 Lisp_Object arg;
1780 int def; 1847 int def;
1781{ 1848{
1782 COLORREF cdef; 1849 XColor cdef;
1783 1850
1784 CHECK_STRING (arg, 0); 1851 CHECK_STRING (arg, 0);
1785 1852
@@ -1791,15 +1858,36 @@ x_decode_color (f, arg, def)
1791 if ((FRAME_W32_DISPLAY_INFO (f)->n_planes * FRAME_W32_DISPLAY_INFO (f)->n_cbits) == 1) 1858 if ((FRAME_W32_DISPLAY_INFO (f)->n_planes * FRAME_W32_DISPLAY_INFO (f)->n_cbits) == 1)
1792 return def; 1859 return def;
1793 1860
1794 /* defined_color is responsible for coping with failures 1861 /* w32_defined_color is responsible for coping with failures
1795 by looking for a near-miss. */ 1862 by looking for a near-miss. */
1796 if (defined_color (f, XSTRING (arg)->data, &cdef, 1)) 1863 if (w32_defined_color (f, XSTRING (arg)->data, &cdef, 1))
1797 return cdef; 1864 return cdef.pixel;
1798 1865
1799 /* defined_color failed; return an ultimate default. */ 1866 /* defined_color failed; return an ultimate default. */
1800 return def; 1867 return def;
1801} 1868}
1802 1869
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
1803/* Functions called only from `x_set_frame_param' 1891/* Functions called only from `x_set_frame_param'
1804 to set individual parameters. 1892 to set individual parameters.
1805 1893
@@ -1813,12 +1901,12 @@ x_set_foreground_color (f, arg, oldval)
1813 struct frame *f; 1901 struct frame *f;
1814 Lisp_Object arg, oldval; 1902 Lisp_Object arg, oldval;
1815{ 1903{
1816 f->output_data.w32->foreground_pixel 1904 FRAME_FOREGROUND_PIXEL (f)
1817 = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f)); 1905 = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1818 1906
1819 if (FRAME_W32_WINDOW (f) != 0) 1907 if (FRAME_W32_WINDOW (f) != 0)
1820 { 1908 {
1821 recompute_basic_faces (f); 1909 update_face_from_frame_parameter (f, Qforeground_color, arg);
1822 if (FRAME_VISIBLE_P (f)) 1910 if (FRAME_VISIBLE_P (f))
1823 redraw_frame (f); 1911 redraw_frame (f);
1824 } 1912 }
@@ -1829,17 +1917,15 @@ x_set_background_color (f, arg, oldval)
1829 struct frame *f; 1917 struct frame *f;
1830 Lisp_Object arg, oldval; 1918 Lisp_Object arg, oldval;
1831{ 1919{
1832 Pixmap temp; 1920 FRAME_BACKGROUND_PIXEL (f)
1833 int mask;
1834
1835 f->output_data.w32->background_pixel
1836 = x_decode_color (f, arg, WHITE_PIX_DEFAULT (f)); 1921 = x_decode_color (f, arg, WHITE_PIX_DEFAULT (f));
1837 1922
1838 if (FRAME_W32_WINDOW (f) != 0) 1923 if (FRAME_W32_WINDOW (f) != 0)
1839 { 1924 {
1840 SetWindowLong (FRAME_W32_WINDOW (f), WND_BACKGROUND_INDEX, f->output_data.w32->background_pixel); 1925 SetWindowLong (FRAME_W32_WINDOW (f), WND_BACKGROUND_INDEX,
1926 FRAME_BACKGROUND_PIXEL (f));
1841 1927
1842 recompute_basic_faces (f); 1928 update_face_from_frame_parameter (f, Qbackground_color, arg);
1843 1929
1844 if (FRAME_VISIBLE_P (f)) 1930 if (FRAME_VISIBLE_P (f))
1845 redraw_frame (f); 1931 redraw_frame (f);
@@ -1851,22 +1937,22 @@ x_set_mouse_color (f, arg, oldval)
1851 struct frame *f; 1937 struct frame *f;
1852 Lisp_Object arg, oldval; 1938 Lisp_Object arg, oldval;
1853{ 1939{
1854#if 0 1940
1855 Cursor cursor, nontext_cursor, mode_cursor, cross_cursor; 1941 Cursor cursor, nontext_cursor, mode_cursor, cross_cursor;
1856#endif
1857 int count; 1942 int count;
1858 int mask_color; 1943 int mask_color;
1859 1944
1860 if (!EQ (Qnil, arg)) 1945 if (!EQ (Qnil, arg))
1861 f->output_data.w32->mouse_pixel 1946 f->output_data.w32->mouse_pixel
1862 = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f)); 1947 = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1863 mask_color = f->output_data.w32->background_pixel; 1948 mask_color = FRAME_BACKGROUND_PIXEL (f);
1864 /* No invisible pointers. */ 1949
1950 /* Don't let pointers be invisible. */
1865 if (mask_color == f->output_data.w32->mouse_pixel 1951 if (mask_color == f->output_data.w32->mouse_pixel
1866 && mask_color == f->output_data.w32->background_pixel) 1952 && mask_color == FRAME_BACKGROUND_PIXEL (f))
1867 f->output_data.w32->mouse_pixel = f->output_data.w32->foreground_pixel; 1953 f->output_data.w32->mouse_pixel = FRAME_FOREGROUND_PIXEL (f);
1868 1954
1869#if 0 1955#if 0 /* NTEMACS_TODO : cursor changes */
1870 BLOCK_INPUT; 1956 BLOCK_INPUT;
1871 1957
1872 /* It's not okay to crash if the user selects a screwy cursor. */ 1958 /* It's not okay to crash if the user selects a screwy cursor. */
@@ -1891,6 +1977,17 @@ x_set_mouse_color (f, arg, oldval)
1891 nontext_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_left_ptr); 1977 nontext_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_left_ptr);
1892 x_check_errors (FRAME_W32_DISPLAY (f), "bad nontext pointer cursor: %s"); 1978 x_check_errors (FRAME_W32_DISPLAY (f), "bad nontext pointer cursor: %s");
1893 1979
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");
1894 if (!EQ (Qnil, Vx_mode_pointer_shape)) 1991 if (!EQ (Qnil, Vx_mode_pointer_shape))
1895 { 1992 {
1896 CHECK_NUMBER (Vx_mode_pointer_shape, 0); 1993 CHECK_NUMBER (Vx_mode_pointer_shape, 0);
@@ -1936,12 +2033,12 @@ x_set_mouse_color (f, arg, oldval)
1936 &fore_color, &back_color); 2033 &fore_color, &back_color);
1937 XRecolorCursor (FRAME_W32_DISPLAY (f), cross_cursor, 2034 XRecolorCursor (FRAME_W32_DISPLAY (f), cross_cursor,
1938 &fore_color, &back_color); 2035 &fore_color, &back_color);
2036 XRecolorCursor (FRAME_W32_DISPLAY (f), busy_cursor,
2037 &fore_color, &back_color);
1939 } 2038 }
1940 2039
1941 if (FRAME_W32_WINDOW (f) != 0) 2040 if (FRAME_W32_WINDOW (f) != 0)
1942 { 2041 XDefineCursor (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f), cursor);
1943 XDefineCursor (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f), cursor);
1944 }
1945 2042
1946 if (cursor != f->output_data.w32->text_cursor && f->output_data.w32->text_cursor != 0) 2043 if (cursor != f->output_data.w32->text_cursor && f->output_data.w32->text_cursor != 0)
1947 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->text_cursor); 2044 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->text_cursor);
@@ -1952,10 +2049,16 @@ x_set_mouse_color (f, arg, oldval)
1952 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->nontext_cursor); 2049 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->nontext_cursor);
1953 f->output_data.w32->nontext_cursor = nontext_cursor; 2050 f->output_data.w32->nontext_cursor = nontext_cursor;
1954 2051
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
1955 if (mode_cursor != f->output_data.w32->modeline_cursor 2057 if (mode_cursor != f->output_data.w32->modeline_cursor
1956 && f->output_data.w32->modeline_cursor != 0) 2058 && f->output_data.w32->modeline_cursor != 0)
1957 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->modeline_cursor); 2059 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->modeline_cursor);
1958 f->output_data.w32->modeline_cursor = mode_cursor; 2060 f->output_data.w32->modeline_cursor = mode_cursor;
2061
1959 if (cross_cursor != f->output_data.w32->cross_cursor 2062 if (cross_cursor != f->output_data.w32->cross_cursor
1960 && f->output_data.w32->cross_cursor != 0) 2063 && f->output_data.w32->cross_cursor != 0)
1961 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->cross_cursor); 2064 XFreeCursor (FRAME_W32_DISPLAY (f), f->output_data.w32->cross_cursor);
@@ -1963,7 +2066,9 @@ x_set_mouse_color (f, arg, oldval)
1963 2066
1964 XFlush (FRAME_W32_DISPLAY (f)); 2067 XFlush (FRAME_W32_DISPLAY (f));
1965 UNBLOCK_INPUT; 2068 UNBLOCK_INPUT;
1966#endif 2069
2070 update_face_from_frame_parameter (f, Qmouse_color, arg);
2071#endif /* NTEMACS_TODO */
1967} 2072}
1968 2073
1969void 2074void
@@ -1977,17 +2082,17 @@ x_set_cursor_color (f, arg, oldval)
1977 fore_pixel = x_decode_color (f, Vx_cursor_fore_pixel, 2082 fore_pixel = x_decode_color (f, Vx_cursor_fore_pixel,
1978 WHITE_PIX_DEFAULT (f)); 2083 WHITE_PIX_DEFAULT (f));
1979 else 2084 else
1980 fore_pixel = f->output_data.w32->background_pixel; 2085 fore_pixel = FRAME_BACKGROUND_PIXEL (f);
1981 f->output_data.w32->cursor_pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f)); 2086 f->output_data.w32->cursor_pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1982 2087
1983 /* Make sure that the cursor color differs from the background color. */ 2088 /* Make sure that the cursor color differs from the background color. */
1984 if (f->output_data.w32->cursor_pixel == f->output_data.w32->background_pixel) 2089 if (f->output_data.w32->cursor_pixel == FRAME_BACKGROUND_PIXEL (f))
1985 { 2090 {
1986 f->output_data.w32->cursor_pixel = f->output_data.w32->mouse_pixel; 2091 f->output_data.w32->cursor_pixel = f->output_data.w32->mouse_pixel;
1987 if (f->output_data.w32->cursor_pixel == fore_pixel) 2092 if (f->output_data.w32->cursor_pixel == fore_pixel)
1988 fore_pixel = f->output_data.w32->background_pixel; 2093 fore_pixel = FRAME_BACKGROUND_PIXEL (f);
1989 } 2094 }
1990 f->output_data.w32->cursor_foreground_pixel = fore_pixel; 2095 FRAME_FOREGROUND_PIXEL (f) = fore_pixel;
1991 2096
1992 if (FRAME_W32_WINDOW (f) != 0) 2097 if (FRAME_W32_WINDOW (f) != 0)
1993 { 2098 {
@@ -1997,6 +2102,8 @@ x_set_cursor_color (f, arg, oldval)
1997 x_display_cursor (f, 1); 2102 x_display_cursor (f, 1);
1998 } 2103 }
1999 } 2104 }
2105
2106 update_face_from_frame_parameter (f, Qcursor_color, arg);
2000} 2107}
2001 2108
2002/* Set the border-color of frame F to pixel value PIX. 2109/* Set the border-color of frame F to pixel value PIX.
@@ -2027,15 +2134,12 @@ x_set_border_color (f, arg, oldval)
2027 struct frame *f; 2134 struct frame *f;
2028 Lisp_Object arg, oldval; 2135 Lisp_Object arg, oldval;
2029{ 2136{
2030 unsigned char *str;
2031 int pix; 2137 int pix;
2032 2138
2033 CHECK_STRING (arg, 0); 2139 CHECK_STRING (arg, 0);
2034 str = XSTRING (arg)->data;
2035
2036 pix = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f)); 2140 pix = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
2037
2038 x_set_border_pixel (f, pix); 2141 x_set_border_pixel (f, pix);
2142 update_face_from_frame_parameter (f, Qborder_color, arg);
2039} 2143}
2040 2144
2041void 2145void
@@ -2045,20 +2149,20 @@ x_set_cursor_type (f, arg, oldval)
2045{ 2149{
2046 if (EQ (arg, Qbar)) 2150 if (EQ (arg, Qbar))
2047 { 2151 {
2048 FRAME_DESIRED_CURSOR (f) = bar_cursor; 2152 FRAME_DESIRED_CURSOR (f) = BAR_CURSOR;
2049 f->output_data.w32->cursor_width = 2; 2153 f->output_data.w32->cursor_width = 2;
2050 } 2154 }
2051 else if (CONSP (arg) && EQ (XCAR (arg), Qbar) 2155 else if (CONSP (arg) && EQ (XCAR (arg), Qbar)
2052 && INTEGERP (XCDR (arg))) 2156 && INTEGERP (XCDR (arg)))
2053 { 2157 {
2054 FRAME_DESIRED_CURSOR (f) = bar_cursor; 2158 FRAME_DESIRED_CURSOR (f) = BAR_CURSOR;
2055 f->output_data.w32->cursor_width = XINT (XCDR (arg)); 2159 f->output_data.w32->cursor_width = XINT (XCDR (arg));
2056 } 2160 }
2057 else 2161 else
2058 /* Treat anything unknown as "box cursor". 2162 /* Treat anything unknown as "box cursor".
2059 It was bad to signal an error; people have trouble fixing 2163 It was bad to signal an error; people have trouble fixing
2060 .Xdefaults with Emacs, when it has something bad in it. */ 2164 .Xdefaults with Emacs, when it has something bad in it. */
2061 FRAME_DESIRED_CURSOR (f) = filled_box_cursor; 2165 FRAME_DESIRED_CURSOR (f) = FILLED_BOX_CURSOR;
2062 2166
2063 /* Make sure the cursor gets redrawn. This is overkill, but how 2167 /* Make sure the cursor gets redrawn. This is overkill, but how
2064 often do people change cursor types? */ 2168 often do people change cursor types? */
@@ -2114,7 +2218,6 @@ x_set_icon_name (f, arg, oldval)
2114 struct frame *f; 2218 struct frame *f;
2115 Lisp_Object arg, oldval; 2219 Lisp_Object arg, oldval;
2116{ 2220{
2117 Lisp_Object tem;
2118 int result; 2221 int result;
2119 2222
2120 if (STRINGP (arg)) 2223 if (STRINGP (arg))
@@ -2189,14 +2292,24 @@ x_set_font (f, arg, oldval)
2189 error ("the characters of the given font have varying widths"); 2292 error ("the characters of the given font have varying widths");
2190 else if (STRINGP (result)) 2293 else if (STRINGP (result))
2191 { 2294 {
2192 recompute_basic_faces (f);
2193 store_frame_param (f, Qfont, result); 2295 store_frame_param (f, Qfont, result);
2296 recompute_basic_faces (f);
2194 } 2297 }
2195 else 2298 else
2196 abort (); 2299 abort ();
2197 2300
2198 XSETFRAME (frame, f); 2301 do_pending_window_change (0);
2199 call1 (Qface_set_after_frame_default, frame); 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 }
2200} 2313}
2201 2314
2202void 2315void
@@ -2220,7 +2333,6 @@ x_set_internal_border_width (f, arg, oldval)
2220 struct frame *f; 2333 struct frame *f;
2221 Lisp_Object arg, oldval; 2334 Lisp_Object arg, oldval;
2222{ 2335{
2223 int mask;
2224 int old = f->output_data.w32->internal_border_width; 2336 int old = f->output_data.w32->internal_border_width;
2225 2337
2226 CHECK_NUMBER (arg, 0); 2338 CHECK_NUMBER (arg, 0);
@@ -2233,10 +2345,9 @@ x_set_internal_border_width (f, arg, oldval)
2233 2345
2234 if (FRAME_W32_WINDOW (f) != 0) 2346 if (FRAME_W32_WINDOW (f) != 0)
2235 { 2347 {
2236 BLOCK_INPUT;
2237 x_set_window_size (f, 0, f->width, f->height); 2348 x_set_window_size (f, 0, f->width, f->height);
2238 UNBLOCK_INPUT;
2239 SET_FRAME_GARBAGED (f); 2349 SET_FRAME_GARBAGED (f);
2350 do_pending_window_change (0);
2240 } 2351 }
2241} 2352}
2242 2353
@@ -2266,7 +2377,7 @@ x_set_menu_bar_lines (f, value, oldval)
2266 2377
2267 /* Right now, menu bars don't work properly in minibuf-only frames; 2378 /* Right now, menu bars don't work properly in minibuf-only frames;
2268 most of the commands try to apply themselves to the minibuffer 2379 most of the commands try to apply themselves to the minibuffer
2269 frame itslef, and get an error because you can't switch buffers 2380 frame itself, and get an error because you can't switch buffers
2270 in or split the minibuffer window. */ 2381 in or split the minibuffer window. */
2271 if (FRAME_MINIBUF_ONLY_P (f)) 2382 if (FRAME_MINIBUF_ONLY_P (f))
2272 return; 2383 return;
@@ -2289,9 +2400,42 @@ x_set_menu_bar_lines (f, value, oldval)
2289 remain the same. This depends on FRAME_EXTERNAL_MENU_BAR being 2400 remain the same. This depends on FRAME_EXTERNAL_MENU_BAR being
2290 set correctly. */ 2401 set correctly. */
2291 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f)); 2402 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
2403 do_pending_window_change (0);
2292 } 2404 }
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);
2293} 2436}
2294 2437
2438
2295/* Change the name of frame F to NAME. If NAME is nil, set F's name to 2439/* Change the name of frame F to NAME. If NAME is nil, set F's name to
2296 w32_id_name. 2440 w32_id_name.
2297 2441
@@ -2349,6 +2493,9 @@ x_set_name (f, name, explicit)
2349 2493
2350 if (FRAME_W32_WINDOW (f)) 2494 if (FRAME_W32_WINDOW (f))
2351 { 2495 {
2496 if (STRING_MULTIBYTE (name))
2497 name = string_make_unibyte (name);
2498
2352 BLOCK_INPUT; 2499 BLOCK_INPUT;
2353 SetWindowText(FRAME_W32_WINDOW (f), XSTRING (name)->data); 2500 SetWindowText(FRAME_W32_WINDOW (f), XSTRING (name)->data);
2354 UNBLOCK_INPUT; 2501 UNBLOCK_INPUT;
@@ -2389,9 +2536,9 @@ x_implicitly_set_name (f, arg, oldval)
2389 F->explicit_name is set, ignore the new name; otherwise, set it. */ 2536 F->explicit_name is set, ignore the new name; otherwise, set it. */
2390 2537
2391void 2538void
2392x_set_title (f, name) 2539x_set_title (f, name, old_name)
2393 struct frame *f; 2540 struct frame *f;
2394 Lisp_Object name; 2541 Lisp_Object name, old_name;
2395{ 2542{
2396 /* Don't change the title if it's already NAME. */ 2543 /* Don't change the title if it's already NAME. */
2397 if (EQ (name, f->title)) 2544 if (EQ (name, f->title))
@@ -2406,6 +2553,9 @@ x_set_title (f, name)
2406 2553
2407 if (FRAME_W32_WINDOW (f)) 2554 if (FRAME_W32_WINDOW (f))
2408 { 2555 {
2556 if (STRING_MULTIBYTE (name))
2557 name = string_make_unibyte (name);
2558
2409 BLOCK_INPUT; 2559 BLOCK_INPUT;
2410 SetWindowText(FRAME_W32_WINDOW (f), XSTRING (name)->data); 2560 SetWindowText(FRAME_W32_WINDOW (f), XSTRING (name)->data);
2411 UNBLOCK_INPUT; 2561 UNBLOCK_INPUT;
@@ -2460,6 +2610,7 @@ x_set_vertical_scroll_bars (f, arg, oldval)
2460 call x_set_window_size. */ 2610 call x_set_window_size. */
2461 if (FRAME_W32_WINDOW (f)) 2611 if (FRAME_W32_WINDOW (f))
2462 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f)); 2612 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
2613 do_pending_window_change (0);
2463 } 2614 }
2464} 2615}
2465 2616
@@ -2468,20 +2619,30 @@ x_set_scroll_bar_width (f, arg, oldval)
2468 struct frame *f; 2619 struct frame *f;
2469 Lisp_Object arg, oldval; 2620 Lisp_Object arg, oldval;
2470{ 2621{
2622 int wid = FONT_WIDTH (f->output_data.w32->font);
2623
2471 if (NILP (arg)) 2624 if (NILP (arg))
2472 { 2625 {
2473 FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = 0; 2626 FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = GetSystemMetrics (SM_CXVSCROLL);
2474 FRAME_SCROLL_BAR_COLS (f) = 2; 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);
2475 } 2632 }
2476 else if (INTEGERP (arg) && XINT (arg) > 0 2633 else if (INTEGERP (arg) && XINT (arg) > 0
2477 && XFASTINT (arg) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f)) 2634 && XFASTINT (arg) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f))
2478 { 2635 {
2479 int wid = FONT_WIDTH (f->output_data.w32->font);
2480 FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = XFASTINT (arg); 2636 FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = XFASTINT (arg);
2481 FRAME_SCROLL_BAR_COLS (f) = (XFASTINT (arg) + wid-1) / wid; 2637 FRAME_SCROLL_BAR_COLS (f) = (FRAME_SCROLL_BAR_PIXEL_WIDTH (f)
2638 + wid-1) / wid;
2482 if (FRAME_W32_WINDOW (f)) 2639 if (FRAME_W32_WINDOW (f))
2483 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f)); 2640 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
2641 do_pending_window_change (0);
2484 } 2642 }
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;
2485} 2646}
2486 2647
2487/* Subroutines of creating an frame. */ 2648/* Subroutines of creating an frame. */
@@ -2492,7 +2653,7 @@ x_set_scroll_bar_width (f, arg, oldval)
2492static void 2653static void
2493validate_x_resource_name () 2654validate_x_resource_name ()
2494{ 2655{
2495 int len; 2656 int len = 0;
2496 /* Number of valid characters in the resource name. */ 2657 /* Number of valid characters in the resource name. */
2497 int good_count = 0; 2658 int good_count = 0;
2498 /* Number of invalid characters in the resource name. */ 2659 /* Number of invalid characters in the resource name. */
@@ -2634,9 +2795,9 @@ char *
2634x_get_resource_string (attribute, class) 2795x_get_resource_string (attribute, class)
2635 char *attribute, *class; 2796 char *attribute, *class;
2636{ 2797{
2637 register char *value;
2638 char *name_key; 2798 char *name_key;
2639 char *class_key; 2799 char *class_key;
2800 struct frame *sf = SELECTED_FRAME ();
2640 2801
2641 /* Allocate space for the components, the dots which separate them, 2802 /* Allocate space for the components, the dots which separate them,
2642 and the final '\0'. */ 2803 and the final '\0'. */
@@ -2650,15 +2811,18 @@ x_get_resource_string (attribute, class)
2650 attribute); 2811 attribute);
2651 sprintf (class_key, "%s.%s", EMACS_CLASS, class); 2812 sprintf (class_key, "%s.%s", EMACS_CLASS, class);
2652 2813
2653 return x_get_string_resource (selected_frame, 2814 return x_get_string_resource (sf, name_key, class_key);
2654 name_key, class_key);
2655} 2815}
2656 2816
2657/* Types we might convert a resource string into. */ 2817/* Types we might convert a resource string into. */
2658enum resource_types 2818enum resource_types
2659 { 2819{
2660 number, boolean, string, symbol 2820 RES_TYPE_NUMBER,
2661 }; 2821 RES_TYPE_FLOAT,
2822 RES_TYPE_BOOLEAN,
2823 RES_TYPE_STRING,
2824 RES_TYPE_SYMBOL
2825};
2662 2826
2663/* Return the value of parameter PARAM. 2827/* Return the value of parameter PARAM.
2664 2828
@@ -2668,11 +2832,11 @@ enum resource_types
2668 Convert the resource to the type specified by desired_type. 2832 Convert the resource to the type specified by desired_type.
2669 2833
2670 If no default is specified, return Qunbound. If you call 2834 If no default is specified, return Qunbound. If you call
2671 x_get_arg, make sure you deal with Qunbound in a reasonable way, 2835 w32_get_arg, make sure you deal with Qunbound in a reasonable way,
2672 and don't let it get stored in any Lisp-visible variables! */ 2836 and don't let it get stored in any Lisp-visible variables! */
2673 2837
2674static Lisp_Object 2838static Lisp_Object
2675x_get_arg (alist, param, attribute, class, type) 2839w32_get_arg (alist, param, attribute, class, type)
2676 Lisp_Object alist, param; 2840 Lisp_Object alist, param;
2677 char *attribute; 2841 char *attribute;
2678 char *class; 2842 char *class;
@@ -2697,10 +2861,13 @@ x_get_arg (alist, param, attribute, class, type)
2697 2861
2698 switch (type) 2862 switch (type)
2699 { 2863 {
2700 case number: 2864 case RES_TYPE_NUMBER:
2701 return make_number (atoi (XSTRING (tem)->data)); 2865 return make_number (atoi (XSTRING (tem)->data));
2702 2866
2703 case boolean: 2867 case RES_TYPE_FLOAT:
2868 return make_float (atof (XSTRING (tem)->data));
2869
2870 case RES_TYPE_BOOLEAN:
2704 tem = Fdowncase (tem); 2871 tem = Fdowncase (tem);
2705 if (!strcmp (XSTRING (tem)->data, "on") 2872 if (!strcmp (XSTRING (tem)->data, "on")
2706 || !strcmp (XSTRING (tem)->data, "true")) 2873 || !strcmp (XSTRING (tem)->data, "true"))
@@ -2708,10 +2875,10 @@ x_get_arg (alist, param, attribute, class, type)
2708 else 2875 else
2709 return Qnil; 2876 return Qnil;
2710 2877
2711 case string: 2878 case RES_TYPE_STRING:
2712 return tem; 2879 return tem;
2713 2880
2714 case symbol: 2881 case RES_TYPE_SYMBOL:
2715 /* As a special case, we map the values `true' and `on' 2882 /* As a special case, we map the values `true' and `on'
2716 to Qt, and `false' and `off' to Qnil. */ 2883 to Qt, and `false' and `off' to Qnil. */
2717 { 2884 {
@@ -2755,7 +2922,7 @@ x_default_parameter (f, alist, prop, deflt, xprop, xclass, type)
2755{ 2922{
2756 Lisp_Object tem; 2923 Lisp_Object tem;
2757 2924
2758 tem = x_get_arg (alist, prop, xprop, xclass, type); 2925 tem = w32_get_arg (alist, prop, xprop, xclass, type);
2759 if (EQ (tem, Qunbound)) 2926 if (EQ (tem, Qunbound))
2760 tem = deflt; 2927 tem = deflt;
2761 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil)); 2928 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
@@ -2830,8 +2997,6 @@ x_figure_window_size (f, parms)
2830 Lisp_Object parms; 2997 Lisp_Object parms;
2831{ 2998{
2832 register Lisp_Object tem0, tem1, tem2; 2999 register Lisp_Object tem0, tem1, tem2;
2833 int height, width, left, top;
2834 register int geometry;
2835 long window_prompting = 0; 3000 long window_prompting = 0;
2836 3001
2837 /* Default values if we fall through. 3002 /* Default values if we fall through.
@@ -2844,9 +3009,9 @@ x_figure_window_size (f, parms)
2844 f->output_data.w32->top_pos = 0; 3009 f->output_data.w32->top_pos = 0;
2845 f->output_data.w32->left_pos = 0; 3010 f->output_data.w32->left_pos = 0;
2846 3011
2847 tem0 = x_get_arg (parms, Qheight, 0, 0, number); 3012 tem0 = w32_get_arg (parms, Qheight, 0, 0, RES_TYPE_NUMBER);
2848 tem1 = x_get_arg (parms, Qwidth, 0, 0, number); 3013 tem1 = w32_get_arg (parms, Qwidth, 0, 0, RES_TYPE_NUMBER);
2849 tem2 = x_get_arg (parms, Quser_size, 0, 0, number); 3014 tem2 = w32_get_arg (parms, Quser_size, 0, 0, RES_TYPE_NUMBER);
2850 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound)) 3015 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
2851 { 3016 {
2852 if (!EQ (tem0, Qunbound)) 3017 if (!EQ (tem0, Qunbound))
@@ -2871,12 +3036,14 @@ x_figure_window_size (f, parms)
2871 : FRAME_SCROLL_BAR_PIXEL_WIDTH (f) > 0 3036 : FRAME_SCROLL_BAR_PIXEL_WIDTH (f) > 0
2872 ? FRAME_SCROLL_BAR_PIXEL_WIDTH (f) 3037 ? FRAME_SCROLL_BAR_PIXEL_WIDTH (f)
2873 : (FRAME_SCROLL_BAR_COLS (f) * FONT_WIDTH (f->output_data.w32->font))); 3038 : (FRAME_SCROLL_BAR_COLS (f) * FONT_WIDTH (f->output_data.w32->font)));
3039 f->output_data.w32->flags_areas_extra
3040 = FRAME_FLAGS_AREA_WIDTH (f);
2874 f->output_data.w32->pixel_width = CHAR_TO_PIXEL_WIDTH (f, f->width); 3041 f->output_data.w32->pixel_width = CHAR_TO_PIXEL_WIDTH (f, f->width);
2875 f->output_data.w32->pixel_height = CHAR_TO_PIXEL_HEIGHT (f, f->height); 3042 f->output_data.w32->pixel_height = CHAR_TO_PIXEL_HEIGHT (f, f->height);
2876 3043
2877 tem0 = x_get_arg (parms, Qtop, 0, 0, number); 3044 tem0 = w32_get_arg (parms, Qtop, 0, 0, RES_TYPE_NUMBER);
2878 tem1 = x_get_arg (parms, Qleft, 0, 0, number); 3045 tem1 = w32_get_arg (parms, Qleft, 0, 0, RES_TYPE_NUMBER);
2879 tem2 = x_get_arg (parms, Quser_position, 0, 0, number); 3046 tem2 = w32_get_arg (parms, Quser_position, 0, 0, RES_TYPE_NUMBER);
2880 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound)) 3047 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
2881 { 3048 {
2882 if (EQ (tem0, Qminus)) 3049 if (EQ (tem0, Qminus))
@@ -2975,8 +3142,10 @@ w32_createscrollbar (f, bar)
2975{ 3142{
2976 return (CreateWindow ("SCROLLBAR", "", SBS_VERT | WS_CHILD | WS_VISIBLE, 3143 return (CreateWindow ("SCROLLBAR", "", SBS_VERT | WS_CHILD | WS_VISIBLE,
2977 /* Position and size of scroll bar. */ 3144 /* Position and size of scroll bar. */
2978 XINT(bar->left), XINT(bar->top), 3145 XINT(bar->left) + VERTICAL_SCROLL_BAR_WIDTH_TRIM,
2979 XINT(bar->width), XINT(bar->height), 3146 XINT(bar->top),
3147 XINT(bar->width) - VERTICAL_SCROLL_BAR_WIDTH_TRIM * 2,
3148 XINT(bar->height),
2980 FRAME_W32_WINDOW (f), 3149 FRAME_W32_WINDOW (f),
2981 NULL, 3150 NULL,
2982 hinst, 3151 hinst,
@@ -3023,7 +3192,7 @@ w32_createwindow (f)
3023 SetWindowLong (hwnd, WND_LINEHEIGHT_INDEX, f->output_data.w32->line_height); 3192 SetWindowLong (hwnd, WND_LINEHEIGHT_INDEX, f->output_data.w32->line_height);
3024 SetWindowLong (hwnd, WND_BORDER_INDEX, f->output_data.w32->internal_border_width); 3193 SetWindowLong (hwnd, WND_BORDER_INDEX, f->output_data.w32->internal_border_width);
3025 SetWindowLong (hwnd, WND_SCROLLBAR_INDEX, f->output_data.w32->vertical_scroll_bar_extra); 3194 SetWindowLong (hwnd, WND_SCROLLBAR_INDEX, f->output_data.w32->vertical_scroll_bar_extra);
3026 SetWindowLong (hwnd, WND_BACKGROUND_INDEX, f->output_data.w32->background_pixel); 3195 SetWindowLong (hwnd, WND_BACKGROUND_INDEX, FRAME_BACKGROUND_PIXEL (f));
3027 3196
3028 /* Enable drag-n-drop. */ 3197 /* Enable drag-n-drop. */
3029 DragAcceptFiles (hwnd, TRUE); 3198 DragAcceptFiles (hwnd, TRUE);
@@ -4670,8 +4839,8 @@ x_icon (f, parms)
4670 4839
4671 /* Set the position of the icon. Note that Windows 95 groups all 4840 /* Set the position of the icon. Note that Windows 95 groups all
4672 icons in the tray. */ 4841 icons in the tray. */
4673 icon_x = x_get_arg (parms, Qicon_left, 0, 0, number); 4842 icon_x = w32_get_arg (parms, Qicon_left, 0, 0, RES_TYPE_NUMBER);
4674 icon_y = x_get_arg (parms, Qicon_top, 0, 0, number); 4843 icon_y = w32_get_arg (parms, Qicon_top, 0, 0, RES_TYPE_NUMBER);
4675 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound)) 4844 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
4676 { 4845 {
4677 CHECK_NUMBER (icon_x, 0); 4846 CHECK_NUMBER (icon_x, 0);
@@ -4688,7 +4857,7 @@ x_icon (f, parms)
4688#if 0 /* TODO */ 4857#if 0 /* TODO */
4689 /* Start up iconic or window? */ 4858 /* Start up iconic or window? */
4690 x_wm_set_window_state 4859 x_wm_set_window_state
4691 (f, (EQ (x_get_arg (parms, Qvisibility, 0, 0, symbol), Qicon) 4860 (f, (EQ (w32_get_arg (parms, Qvisibility, 0, 0, RES_TYPE_SYMBOL), Qicon)
4692 ? IconicState 4861 ? IconicState
4693 : NormalState)); 4862 : NormalState));
4694 4863
@@ -4700,6 +4869,37 @@ x_icon (f, parms)
4700 UNBLOCK_INPUT; 4869 UNBLOCK_INPUT;
4701} 4870}
4702 4871
4872
4873static void
4874x_make_gc (f)
4875 struct frame *f;
4876{
4877 XGCValues gc_values;
4878
4879 BLOCK_INPUT;
4880
4881 /* Create the GC's of this frame.
4882 Note that many default values are used. */
4883
4884 /* Normal video */
4885 gc_values.font = f->output_data.w32->font;
4886
4887 /* Cursor has cursor-color background, background-color foreground. */
4888 gc_values.foreground = FRAME_BACKGROUND_PIXEL (f);
4889 gc_values.background = f->output_data.w32->cursor_pixel;
4890 f->output_data.w32->cursor_gc
4891 = XCreateGC (NULL, FRAME_W32_WINDOW (f),
4892 (GCFont | GCForeground | GCBackground),
4893 &gc_values);
4894
4895 /* Reliefs. */
4896 f->output_data.w32->white_relief.gc = 0;
4897 f->output_data.w32->black_relief.gc = 0;
4898
4899 UNBLOCK_INPUT;
4900}
4901
4902
4703DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame, 4903DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
4704 1, 1, 0, 4904 1, 1, 0,
4705 "Make a new window, which is called a \"frame\" in Emacs terms.\n\ 4905 "Make a new window, which is called a \"frame\" in Emacs terms.\n\
@@ -4723,7 +4923,7 @@ This function is an internal primitive--use `make-frame' instead.")
4723 int count = specpdl_ptr - specpdl; 4923 int count = specpdl_ptr - specpdl;
4724 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; 4924 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
4725 Lisp_Object display; 4925 Lisp_Object display;
4726 struct w32_display_info *dpyinfo; 4926 struct w32_display_info *dpyinfo = NULL;
4727 Lisp_Object parent; 4927 Lisp_Object parent;
4728 struct kboard *kb; 4928 struct kboard *kb;
4729 4929
@@ -4733,7 +4933,7 @@ This function is an internal primitive--use `make-frame' instead.")
4733 until we know if this frame has a specified name. */ 4933 until we know if this frame has a specified name. */
4734 Vx_resource_name = Vinvocation_name; 4934 Vx_resource_name = Vinvocation_name;
4735 4935
4736 display = x_get_arg (parms, Qdisplay, 0, 0, string); 4936 display = w32_get_arg (parms, Qdisplay, 0, 0, RES_TYPE_STRING);
4737 if (EQ (display, Qunbound)) 4937 if (EQ (display, Qunbound))
4738 display = Qnil; 4938 display = Qnil;
4739 dpyinfo = check_x_display_info (display); 4939 dpyinfo = check_x_display_info (display);
@@ -4743,7 +4943,7 @@ This function is an internal primitive--use `make-frame' instead.")
4743 kb = &the_only_kboard; 4943 kb = &the_only_kboard;
4744#endif 4944#endif
4745 4945
4746 name = x_get_arg (parms, Qname, "name", "Name", string); 4946 name = w32_get_arg (parms, Qname, "name", "Name", RES_TYPE_STRING);
4747 if (!STRINGP (name) 4947 if (!STRINGP (name)
4748 && ! EQ (name, Qunbound) 4948 && ! EQ (name, Qunbound)
4749 && ! NILP (name)) 4949 && ! NILP (name))
@@ -4753,7 +4953,7 @@ This function is an internal primitive--use `make-frame' instead.")
4753 Vx_resource_name = name; 4953 Vx_resource_name = name;
4754 4954
4755 /* See if parent window is specified. */ 4955 /* See if parent window is specified. */
4756 parent = x_get_arg (parms, Qparent_id, NULL, NULL, number); 4956 parent = w32_get_arg (parms, Qparent_id, NULL, NULL, RES_TYPE_NUMBER);
4757 if (EQ (parent, Qunbound)) 4957 if (EQ (parent, Qunbound))
4758 parent = Qnil; 4958 parent = Qnil;
4759 if (! NILP (parent)) 4959 if (! NILP (parent))
@@ -4764,7 +4964,7 @@ This function is an internal primitive--use `make-frame' instead.")
4764 it to make_frame_without_minibuffer. */ 4964 it to make_frame_without_minibuffer. */
4765 frame = Qnil; 4965 frame = Qnil;
4766 GCPRO4 (parms, parent, name, frame); 4966 GCPRO4 (parms, parent, name, frame);
4767 tem = x_get_arg (parms, Qminibuffer, 0, 0, symbol); 4967 tem = w32_get_arg (parms, Qminibuffer, 0, 0, RES_TYPE_SYMBOL);
4768 if (EQ (tem, Qnone) || NILP (tem)) 4968 if (EQ (tem, Qnone) || NILP (tem))
4769 f = make_frame_without_minibuffer (Qnil, kb, display); 4969 f = make_frame_without_minibuffer (Qnil, kb, display);
4770 else if (EQ (tem, Qonly)) 4970 else if (EQ (tem, Qonly))
@@ -4785,13 +4985,14 @@ This function is an internal primitive--use `make-frame' instead.")
4785 f->scroll_bar_pixel_width = GetSystemMetrics (SM_CXVSCROLL); 4985 f->scroll_bar_pixel_width = GetSystemMetrics (SM_CXVSCROLL);
4786 4986
4787 f->output_method = output_w32; 4987 f->output_method = output_w32;
4788 f->output_data.w32 = (struct w32_output *) xmalloc (sizeof (struct w32_output)); 4988 f->output_data.w32 =
4989 (struct w32_output *) xmalloc (sizeof (struct w32_output));
4789 bzero (f->output_data.w32, sizeof (struct w32_output)); 4990 bzero (f->output_data.w32, sizeof (struct w32_output));
4790 4991
4791 FRAME_FONTSET (f) = -1; 4992 FRAME_FONTSET (f) = -1;
4792 4993
4793 f->icon_name 4994 f->icon_name
4794 = x_get_arg (parms, Qicon_name, "iconName", "Title", string); 4995 = w32_get_arg (parms, Qicon_name, "iconName", "Title", RES_TYPE_STRING);
4795 if (! STRINGP (f->icon_name)) 4996 if (! STRINGP (f->icon_name))
4796 f->icon_name = Qnil; 4997 f->icon_name = Qnil;
4797 4998
@@ -4813,9 +5014,6 @@ This function is an internal primitive--use `make-frame' instead.")
4813 f->output_data.w32->explicit_parent = 0; 5014 f->output_data.w32->explicit_parent = 0;
4814 } 5015 }
4815 5016
4816 /* Note that the frame has no physical cursor right now. */
4817 f->phys_cursor_x = -1;
4818
4819 /* Set the name; the functions to which we pass f expect the name to 5017 /* Set the name; the functions to which we pass f expect the name to
4820 be set. */ 5018 be set. */
4821 if (EQ (name, Qunbound) || NILP (name)) 5019 if (EQ (name, Qunbound) || NILP (name))
@@ -4840,7 +5038,8 @@ This function is an internal primitive--use `make-frame' instead.")
4840 { 5038 {
4841 Lisp_Object font; 5039 Lisp_Object font;
4842 5040
4843 font = x_get_arg (parms, Qfont, "font", "Font", string); 5041 font = w32_get_arg (parms, Qfont, "font", "Font", RES_TYPE_STRING);
5042
4844 BLOCK_INPUT; 5043 BLOCK_INPUT;
4845 /* First, try whatever font the caller has specified. */ 5044 /* First, try whatever font the caller has specified. */
4846 if (STRINGP (font)) 5045 if (STRINGP (font))
@@ -4855,20 +5054,20 @@ This function is an internal primitive--use `make-frame' instead.")
4855 if (!STRINGP (font)) 5054 if (!STRINGP (font))
4856 font = x_new_font (f, "-*-Courier New-normal-r-*-*-13-*-*-*-c-*-iso8859-1"); 5055 font = x_new_font (f, "-*-Courier New-normal-r-*-*-13-*-*-*-c-*-iso8859-1");
4857 if (! STRINGP (font)) 5056 if (! STRINGP (font))
4858 font = x_new_font (f, "-*-Courier-normal-r-*-*-*-97-*-*-c-*-iso8859-1"); 5057 font = x_new_font (f, "-*-Courier-normal-r-*-*-13-*-*-*-c-*-iso8859-1");
4859 /* If those didn't work, look for something which will at least work. */ 5058 /* If those didn't work, look for something which will at least work. */
4860 if (! STRINGP (font)) 5059 if (! STRINGP (font))
4861 font = x_new_font (f, "-*-Fixedsys-normal-r-*-*-*-*-90-*-c-*-iso8859-1"); 5060 font = x_new_font (f, "-*-Fixedsys-normal-r-*-*-12-*-*-*-c-*-iso8859-1");
4862 UNBLOCK_INPUT; 5061 UNBLOCK_INPUT;
4863 if (! STRINGP (font)) 5062 if (! STRINGP (font))
4864 font = build_string ("Fixedsys"); 5063 font = build_string ("Fixedsys");
4865 5064
4866 x_default_parameter (f, parms, Qfont, font, 5065 x_default_parameter (f, parms, Qfont, font,
4867 "font", "Font", string); 5066 "font", "Font", RES_TYPE_STRING);
4868 } 5067 }
4869 5068
4870 x_default_parameter (f, parms, Qborder_width, make_number (2), 5069 x_default_parameter (f, parms, Qborder_width, make_number (2),
4871 "borderwidth", "BorderWidth", number); 5070 "borderwidth", "BorderWidth", RES_TYPE_NUMBER);
4872 /* This defaults to 2 in order to match xterm. We recognize either 5071 /* This defaults to 2 in order to match xterm. We recognize either
4873 internalBorderWidth or internalBorder (which is what xterm calls 5072 internalBorderWidth or internalBorder (which is what xterm calls
4874 it). */ 5073 it). */
@@ -4876,38 +5075,49 @@ This function is an internal primitive--use `make-frame' instead.")
4876 { 5075 {
4877 Lisp_Object value; 5076 Lisp_Object value;
4878 5077
4879 value = x_get_arg (parms, Qinternal_border_width, 5078 value = w32_get_arg (parms, Qinternal_border_width,
4880 "internalBorder", "BorderWidth", number); 5079 "internalBorder", "BorderWidth", RES_TYPE_NUMBER);
4881 if (! EQ (value, Qunbound)) 5080 if (! EQ (value, Qunbound))
4882 parms = Fcons (Fcons (Qinternal_border_width, value), 5081 parms = Fcons (Fcons (Qinternal_border_width, value),
4883 parms); 5082 parms);
4884 } 5083 }
4885 /* Default internalBorderWidth to 0 on Windows to match other programs. */ 5084 /* Default internalBorderWidth to 0 on Windows to match other programs. */
4886 x_default_parameter (f, parms, Qinternal_border_width, make_number (0), 5085 x_default_parameter (f, parms, Qinternal_border_width, make_number (0),
4887 "internalBorderWidth", "BorderWidth", number); 5086 "internalBorderWidth", "BorderWidth", RES_TYPE_NUMBER);
4888 x_default_parameter (f, parms, Qvertical_scroll_bars, Qt, 5087 x_default_parameter (f, parms, Qvertical_scroll_bars, Qt,
4889 "verticalScrollBars", "ScrollBars", boolean); 5088 "verticalScrollBars", "ScrollBars", RES_TYPE_BOOLEAN);
4890 5089
4891 /* Also do the stuff which must be set before the window exists. */ 5090 /* Also do the stuff which must be set before the window exists. */
4892 x_default_parameter (f, parms, Qforeground_color, build_string ("black"), 5091 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
4893 "foreground", "Foreground", string); 5092 "foreground", "Foreground", RES_TYPE_STRING);
4894 x_default_parameter (f, parms, Qbackground_color, build_string ("white"), 5093 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
4895 "background", "Background", string); 5094 "background", "Background", RES_TYPE_STRING);
4896 x_default_parameter (f, parms, Qmouse_color, build_string ("black"), 5095 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
4897 "pointerColor", "Foreground", string); 5096 "pointerColor", "Foreground", RES_TYPE_STRING);
4898 x_default_parameter (f, parms, Qcursor_color, build_string ("black"), 5097 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
4899 "cursorColor", "Foreground", string); 5098 "cursorColor", "Foreground", RES_TYPE_STRING);
4900 x_default_parameter (f, parms, Qborder_color, build_string ("black"), 5099 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
4901 "borderColor", "BorderColor", string); 5100 "borderColor", "BorderColor", RES_TYPE_STRING);
5101 x_default_parameter (f, parms, Qscreen_gamma, Qnil,
5102 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT);
4902 5103
5104
5105 /* Init faces before x_default_parameter is called for scroll-bar
5106 parameters because that function calls x_set_scroll_bar_width,
5107 which calls change_frame_size, which calls Fset_window_buffer,
5108 which runs hooks, which call Fvertical_motion. At the end, we
5109 end up in init_iterator with a null face cache, which should not
5110 happen. */
5111 init_frame_faces (f);
5112
4903 x_default_parameter (f, parms, Qmenu_bar_lines, make_number (1), 5113 x_default_parameter (f, parms, Qmenu_bar_lines, make_number (1),
4904 "menuBar", "MenuBar", number); 5114 "menuBar", "MenuBar", RES_TYPE_NUMBER);
4905 x_default_parameter (f, parms, Qscroll_bar_width, Qnil, 5115 x_default_parameter (f, parms, Qtool_bar_lines, make_number (0),
4906 "scrollBarWidth", "ScrollBarWidth", number); 5116 "toolBar", "ToolBar", RES_TYPE_NUMBER);
4907 x_default_parameter (f, parms, Qbuffer_predicate, Qnil, 5117 x_default_parameter (f, parms, Qbuffer_predicate, Qnil,
4908 "bufferPredicate", "BufferPredicate", symbol); 5118 "bufferPredicate", "BufferPredicate", RES_TYPE_SYMBOL);
4909 x_default_parameter (f, parms, Qtitle, Qnil, 5119 x_default_parameter (f, parms, Qtitle, Qnil,
4910 "title", "Title", string); 5120 "title", "Title", RES_TYPE_STRING);
4911 5121
4912 f->output_data.w32->dwStyle = WS_OVERLAPPEDWINDOW; 5122 f->output_data.w32->dwStyle = WS_OVERLAPPEDWINDOW;
4913 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window; 5123 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
@@ -4930,21 +5140,38 @@ This function is an internal primitive--use `make-frame' instead.")
4930 5140
4931 f->output_data.w32->size_hint_flags = window_prompting; 5141 f->output_data.w32->size_hint_flags = window_prompting;
4932 5142
5143 tem = w32_get_arg (parms, Qunsplittable, 0, 0, RES_TYPE_BOOLEAN);
5144 f->no_split = minibuffer_only || EQ (tem, Qt);
5145
5146 /* Create the window. Add the tool-bar height to the initial frame
5147 height so that the user gets a text display area of the size he
5148 specified with -g or via the registry. Later changes of the
5149 tool-bar height don't change the frame size. This is done so that
5150 users can create tall Emacs frames without having to guess how
5151 tall the tool-bar will get. */
5152 f->height += FRAME_TOOL_BAR_LINES (f);
4933 w32_window (f, window_prompting, minibuffer_only); 5153 w32_window (f, window_prompting, minibuffer_only);
4934 x_icon (f, parms); 5154 x_icon (f, parms);
4935 init_frame_faces (f); 5155
5156 x_make_gc (f);
5157
5158 /* Now consider the frame official. */
5159 FRAME_W32_DISPLAY_INFO (f)->reference_count++;
5160 Vframe_list = Fcons (frame, Vframe_list);
4936 5161
4937 /* We need to do this after creating the window, so that the 5162 /* We need to do this after creating the window, so that the
4938 icon-creation functions can say whose icon they're describing. */ 5163 icon-creation functions can say whose icon they're describing. */
4939 x_default_parameter (f, parms, Qicon_type, Qnil, 5164 x_default_parameter (f, parms, Qicon_type, Qnil,
4940 "bitmapIcon", "BitmapIcon", symbol); 5165 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL);
4941 5166
4942 x_default_parameter (f, parms, Qauto_raise, Qnil, 5167 x_default_parameter (f, parms, Qauto_raise, Qnil,
4943 "autoRaise", "AutoRaiseLower", boolean); 5168 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
4944 x_default_parameter (f, parms, Qauto_lower, Qnil, 5169 x_default_parameter (f, parms, Qauto_lower, Qnil,
4945 "autoLower", "AutoRaiseLower", boolean); 5170 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
4946 x_default_parameter (f, parms, Qcursor_type, Qbox, 5171 x_default_parameter (f, parms, Qcursor_type, Qbox,
4947 "cursorType", "CursorType", symbol); 5172 "cursorType", "CursorType", RES_TYPE_SYMBOL);
5173 x_default_parameter (f, parms, Qscroll_bar_width, Qnil,
5174 "scrollBarWidth", "ScrollBarWidth", RES_TYPE_NUMBER);
4948 5175
4949 /* Dimensions, especially f->height, must be done via change_frame_size. 5176 /* Dimensions, especially f->height, must be done via change_frame_size.
4950 Change will not be effected unless different from the current 5177 Change will not be effected unless different from the current
@@ -4953,37 +5180,26 @@ This function is an internal primitive--use `make-frame' instead.")
4953 height = f->height; 5180 height = f->height;
4954 f->height = 0; 5181 f->height = 0;
4955 SET_FRAME_WIDTH (f, 0); 5182 SET_FRAME_WIDTH (f, 0);
4956 change_frame_size (f, height, width, 1, 0); 5183 change_frame_size (f, height, width, 1, 0, 0);
5184
5185 /* Set up faces after all frame parameters are known. */
5186 call1 (Qface_set_after_frame_default, frame);
4957 5187
4958 /* Tell the server what size and position, etc, we want, 5188 /* Tell the server what size and position, etc, we want, and how
4959 and how badly we want them. */ 5189 badly we want them. This should be done after we have the menu
5190 bar so that its size can be taken into account. */
4960 BLOCK_INPUT; 5191 BLOCK_INPUT;
4961 x_wm_set_size_hint (f, window_prompting, 0); 5192 x_wm_set_size_hint (f, window_prompting, 0);
4962 UNBLOCK_INPUT; 5193 UNBLOCK_INPUT;
4963 5194
4964 tem = x_get_arg (parms, Qunsplittable, 0, 0, boolean); 5195 /* Make the window appear on the frame and enable display, unless
4965 f->no_split = minibuffer_only || EQ (tem, Qt); 5196 the caller says not to. However, with explicit parent, Emacs
4966 5197 cannot control visibility, so don't try. */
4967 UNGCPRO;
4968
4969 /* It is now ok to make the frame official
4970 even if we get an error below.
4971 And the frame needs to be on Vframe_list
4972 or making it visible won't work. */
4973 Vframe_list = Fcons (frame, Vframe_list);
4974
4975 /* Now that the frame is official, it counts as a reference to
4976 its display. */
4977 FRAME_W32_DISPLAY_INFO (f)->reference_count++;
4978
4979 /* Make the window appear on the frame and enable display,
4980 unless the caller says not to. However, with explicit parent,
4981 Emacs cannot control visibility, so don't try. */
4982 if (! f->output_data.w32->explicit_parent) 5198 if (! f->output_data.w32->explicit_parent)
4983 { 5199 {
4984 Lisp_Object visibility; 5200 Lisp_Object visibility;
4985 5201
4986 visibility = x_get_arg (parms, Qvisibility, 0, 0, symbol); 5202 visibility = w32_get_arg (parms, Qvisibility, 0, 0, RES_TYPE_SYMBOL);
4987 if (EQ (visibility, Qunbound)) 5203 if (EQ (visibility, Qunbound))
4988 visibility = Qt; 5204 visibility = Qt;
4989 5205
@@ -4995,7 +5211,7 @@ This function is an internal primitive--use `make-frame' instead.")
4995 /* Must have been Qnil. */ 5211 /* Must have been Qnil. */
4996 ; 5212 ;
4997 } 5213 }
4998 5214 UNGCPRO;
4999 return unbind_to (count, frame); 5215 return unbind_to (count, frame);
5000} 5216}
5001 5217
@@ -5046,18 +5262,18 @@ w32_load_system_font (f,fontname,size)
5046 { 5262 {
5047 Lisp_Object tail; 5263 Lisp_Object tail;
5048 int i; 5264 int i;
5049#if 0 /* This code has nasty side effects that cause Emacs to crash. */
5050 5265
5051 /* First check if any are already loaded, as that is cheaper 5266 /* First check if any are already loaded, as that is cheaper
5052 than loading another one. */ 5267 than loading another one. */
5053 for (i = 0; i < dpyinfo->n_fonts; i++) 5268 for (i = 0; i < dpyinfo->n_fonts; i++)
5054 for (tail = font_names; CONSP (tail); tail = XCDR (tail)) 5269 for (tail = font_names; CONSP (tail); tail = XCDR (tail))
5055 if (!strcmp (dpyinfo->font_table[i].name, 5270 if (dpyinfo->font_table[i].name
5056 XSTRING (XCAR (tail))->data) 5271 && (!strcmp (dpyinfo->font_table[i].name,
5057 || !strcmp (dpyinfo->font_table[i].full_name, 5272 XSTRING (XCAR (tail))->data)
5058 XSTRING (XCAR (tail))->data)) 5273 || !strcmp (dpyinfo->font_table[i].full_name,
5274 XSTRING (XCAR (tail))->data)))
5059 return (dpyinfo->font_table + i); 5275 return (dpyinfo->font_table + i);
5060#endif 5276
5061 fontname = (char *) XSTRING (XCAR (font_names))->data; 5277 fontname = (char *) XSTRING (XCAR (font_names))->data;
5062 } 5278 }
5063 else if (w32_strict_fontnames) 5279 else if (w32_strict_fontnames)
@@ -5081,6 +5297,7 @@ w32_load_system_font (f,fontname,size)
5081 struct font_info *fontp; 5297 struct font_info *fontp;
5082 LOGFONT lf; 5298 LOGFONT lf;
5083 BOOL ok; 5299 BOOL ok;
5300 int i;
5084 5301
5085 if (!fontname || !x_to_w32_font (fontname, &lf)) 5302 if (!fontname || !x_to_w32_font (fontname, &lf))
5086 return (NULL); 5303 return (NULL);
@@ -5116,21 +5333,17 @@ w32_load_system_font (f,fontname,size)
5116 ok = GetTextMetrics (hdc, &font->tm); 5333 ok = GetTextMetrics (hdc, &font->tm);
5117 SelectObject (hdc, oldobj); 5334 SelectObject (hdc, oldobj);
5118 ReleaseDC (dpyinfo->root_window, hdc); 5335 ReleaseDC (dpyinfo->root_window, hdc);
5119 5336 /* Fill out details in lf according to the font that was
5120 /* [andrewi, 25-Apr-99] A number of fixed pitch fonts, 5337 actually loaded. */
5121 eg. Courier New and perhaps others, report a max width which 5338 lf.lfHeight = font->tm.tmInternalLeading - font->tm.tmHeight;
5122 is larger than the average character width, at least on some 5339 lf.lfWidth = font->tm.tmAveCharWidth;
5123 NT systems (I don't understand why - my best guess is that it 5340 lf.lfWeight = font->tm.tmWeight;
5124 results from installing the CJK language packs for NT4). 5341 lf.lfItalic = font->tm.tmItalic;
5125 Unfortunately, this forces the redisplay code in dumpglyphs 5342 lf.lfCharSet = font->tm.tmCharSet;
5126 to draw text character by character. 5343 lf.lfPitchAndFamily = ((font->tm.tmPitchAndFamily & TMPF_FIXED_PITCH)
5127 5344 ? FIXED_PITCH : VARIABLE_PITCH);
5128 I don't like this hack, but it seems better to force the max 5345 lf.lfOutPrecision = ((font->tm.tmPitchAndFamily & TMPF_VECTOR)
5129 width to match the average width if the font is marked as 5346 ? OUT_STROKE_PRECIS : OUT_STRING_PRECIS);
5130 fixed pitch, for the sake of redisplay performance. */
5131
5132 if ((font->tm.tmPitchAndFamily & TMPF_FIXED_PITCH) == 0)
5133 font->tm.tmMaxCharWidth = font->tm.tmAveCharWidth;
5134 } 5347 }
5135 5348
5136 UNBLOCK_INPUT; 5349 UNBLOCK_INPUT;
@@ -5141,31 +5354,30 @@ w32_load_system_font (f,fontname,size)
5141 return (NULL); 5354 return (NULL);
5142 } 5355 }
5143 5356
5144 /* Do we need to create the table? */ 5357 /* Find a free slot in the font table. */
5145 if (dpyinfo->font_table_size == 0) 5358 for (i = 0; i < dpyinfo->n_fonts; ++i)
5146 { 5359 if (dpyinfo->font_table[i].name == NULL)
5147 dpyinfo->font_table_size = 16; 5360 break;
5148 dpyinfo->font_table 5361
5149 = (struct font_info *) xmalloc (dpyinfo->font_table_size 5362 /* If no free slot found, maybe enlarge the font table. */
5150 * sizeof (struct font_info)); 5363 if (i == dpyinfo->n_fonts
5151 } 5364 && dpyinfo->n_fonts == dpyinfo->font_table_size)
5152 /* Do we need to grow the table? */
5153 else if (dpyinfo->n_fonts
5154 >= dpyinfo->font_table_size)
5155 { 5365 {
5156 dpyinfo->font_table_size *= 2; 5366 int sz;
5367 dpyinfo->font_table_size = max (16, 2 * dpyinfo->font_table_size);
5368 sz = dpyinfo->font_table_size * sizeof *dpyinfo->font_table;
5157 dpyinfo->font_table 5369 dpyinfo->font_table
5158 = (struct font_info *) xrealloc (dpyinfo->font_table, 5370 = (struct font_info *) xrealloc (dpyinfo->font_table, sz);
5159 (dpyinfo->font_table_size
5160 * sizeof (struct font_info)));
5161 } 5371 }
5162 5372
5163 fontp = dpyinfo->font_table + dpyinfo->n_fonts; 5373 fontp = dpyinfo->font_table + i;
5374 if (i == dpyinfo->n_fonts)
5375 ++dpyinfo->n_fonts;
5164 5376
5165 /* Now fill in the slots of *FONTP. */ 5377 /* Now fill in the slots of *FONTP. */
5166 BLOCK_INPUT; 5378 BLOCK_INPUT;
5167 fontp->font = font; 5379 fontp->font = font;
5168 fontp->font_idx = dpyinfo->n_fonts; 5380 fontp->font_idx = i;
5169 fontp->name = (char *) xmalloc (strlen (fontname) + 1); 5381 fontp->name = (char *) xmalloc (strlen (fontname) + 1);
5170 bcopy (fontname, fontp->name, strlen (fontname) + 1); 5382 bcopy (fontname, fontp->name, strlen (fontname) + 1);
5171 5383
@@ -5189,7 +5401,7 @@ w32_load_system_font (f,fontname,size)
5189 the font code-points (0:0x20..0x7F, 1:0xA0..0xFF, 5401 the font code-points (0:0x20..0x7F, 1:0xA0..0xFF,
5190 0:0x2020..0x7F7F, 1:0xA0A0..0xFFFF, 3:0x20A0..0x7FFF, or 5402 0:0x2020..0x7F7F, 1:0xA0A0..0xFFFF, 3:0x20A0..0x7FFF, or
5191 2:0xA020..0xFF7F). For the moment, we don't know which charset 5403 2:0xA020..0xFF7F). For the moment, we don't know which charset
5192 uses this font. So, we set informatoin in fontp->encoding[1] 5404 uses this font. So, we set information in fontp->encoding[1]
5193 which is never used by any charset. If mapping can't be 5405 which is never used by any charset. If mapping can't be
5194 decided, set FONT_ENCODING_NOT_DECIDED. */ 5406 decided, set FONT_ENCODING_NOT_DECIDED. */
5195 5407
@@ -5207,9 +5419,13 @@ w32_load_system_font (f,fontname,size)
5207 fontp->relative_compose = 0; 5419 fontp->relative_compose = 0;
5208 fontp->default_ascent = 0; 5420 fontp->default_ascent = 0;
5209 5421
5422 /* Set global flag fonts_changed_p to non-zero if the font loaded
5423 has a character with a smaller width than any other character
5424 before, or if the font loaded has a smalle>r height than any
5425 other font loaded before. If this happens, it will make a
5426 glyph matrix reallocation necessary. */
5427 fonts_changed_p = x_compute_min_glyph_bounds (f);
5210 UNBLOCK_INPUT; 5428 UNBLOCK_INPUT;
5211 dpyinfo->n_fonts++;
5212
5213 return fontp; 5429 return fontp;
5214 } 5430 }
5215} 5431}
@@ -5485,6 +5701,7 @@ w32_to_x_font (lplogfont, lpxstr, len)
5485 char * lpxstr; 5701 char * lpxstr;
5486 int len; 5702 int len;
5487{ 5703{
5704 char* fonttype;
5488 char *fontname; 5705 char *fontname;
5489 char height_pixels[8]; 5706 char height_pixels[8];
5490 char height_dpi[8]; 5707 char height_dpi[8];
@@ -5500,6 +5717,13 @@ w32_to_x_font (lplogfont, lpxstr, len)
5500 if (!lplogfont) 5717 if (!lplogfont)
5501 return FALSE; 5718 return FALSE;
5502 5719
5720 if (lplogfont->lfOutPrecision == OUT_STRING_PRECIS)
5721 fonttype = "raster";
5722 else if (lplogfont->lfOutPrecision == OUT_STROKE_PRECIS)
5723 fonttype = "outline";
5724 else
5725 fonttype = "unknown";
5726
5503 setup_coding_system (Fcheck_coding_system (Vw32_system_coding_system), 5727 setup_coding_system (Fcheck_coding_system (Vw32_system_coding_system),
5504 &coding); 5728 &coding);
5505 coding.mode |= CODING_MODE_LAST_BLOCK; 5729 coding.mode |= CODING_MODE_LAST_BLOCK;
@@ -5533,8 +5757,8 @@ w32_to_x_font (lplogfont, lpxstr, len)
5533 strcpy (width_pixels, "*"); 5757 strcpy (width_pixels, "*");
5534 5758
5535 _snprintf (lpxstr, len - 1, 5759 _snprintf (lpxstr, len - 1,
5536 "-*-%s-%s-%c-*-*-%s-%s-%d-%d-%c-%s-%s", 5760 "-%s-%s-%s-%c-normal-normal-%s-%s-%d-%d-%c-%s-%s",
5537 /* foundry */ 5761 fonttype, /* foundry */
5538 fontname, /* family */ 5762 fontname, /* family */
5539 w32_to_x_weight (lplogfont->lfWeight), /* weight */ 5763 w32_to_x_weight (lplogfont->lfWeight), /* weight */
5540 lplogfont->lfItalic?'i':'r', /* slant */ 5764 lplogfont->lfItalic?'i':'r', /* slant */
@@ -5604,6 +5828,12 @@ x_to_w32_font (lpxstr, lplogfont)
5604 name, weight, &slant, pixels, height, resy, &pitch, width, remainder); 5828 name, weight, &slant, pixels, height, resy, &pitch, width, remainder);
5605 if (fields == EOF) return (FALSE); 5829 if (fields == EOF) return (FALSE);
5606 5830
5831 /* If wildcards cover more than one field, we don't know which
5832 field is which, so don't fill any in. */
5833
5834 if (fields < 9)
5835 fields = 0;
5836
5607 if (fields > 0 && name[0] != '*') 5837 if (fields > 0 && name[0] != '*')
5608 { 5838 {
5609 int bufsize; 5839 int bufsize;
@@ -5622,7 +5852,7 @@ x_to_w32_font (lpxstr, lplogfont)
5622 } 5852 }
5623 else 5853 else
5624 { 5854 {
5625 lplogfont->lfFaceName[0] = 0; 5855 lplogfont->lfFaceName[0] = '\0';
5626 } 5856 }
5627 5857
5628 fields--; 5858 fields--;
@@ -5631,7 +5861,7 @@ x_to_w32_font (lpxstr, lplogfont)
5631 5861
5632 fields--; 5862 fields--;
5633 5863
5634 if (!NILP (Vw32_enable_italics)) 5864 if (!NILP (Vw32_enable_synthesized_fonts))
5635 lplogfont->lfItalic = (fields > 0 && slant == 'i'); 5865 lplogfont->lfItalic = (fields > 0 && slant == 'i');
5636 5866
5637 fields--; 5867 fields--;
@@ -5643,7 +5873,7 @@ x_to_w32_font (lpxstr, lplogfont)
5643 fields--; 5873 fields--;
5644 if (fields > 0 && resy[0] != '*') 5874 if (fields > 0 && resy[0] != '*')
5645 { 5875 {
5646 tem = atoi (pixels); 5876 tem = atoi (resy);
5647 if (tem > 0) dpi = tem; 5877 if (tem > 0) dpi = tem;
5648 } 5878 }
5649 5879
@@ -5711,60 +5941,40 @@ x_to_w32_font (lpxstr, lplogfont)
5711 5941
5712 /* This makes TrueType fonts work better. */ 5942 /* This makes TrueType fonts work better. */
5713 lplogfont->lfHeight = - abs (lplogfont->lfHeight); 5943 lplogfont->lfHeight = - abs (lplogfont->lfHeight);
5714 5944
5715 return (TRUE); 5945 return (TRUE);
5716} 5946}
5717 5947
5948/* Assume parameter 1 is fully qualified, no wildcards. */
5718BOOL 5949BOOL
5719w32_font_match (lpszfont1, lpszfont2) 5950w32_font_match (fontname, pattern)
5720 char * lpszfont1; 5951 char * fontname;
5721 char * lpszfont2; 5952 char * pattern;
5722{ 5953{
5723 char * s1 = lpszfont1, *e1, *w1; 5954 char *regex = alloca (strlen (pattern) * 2);
5724 char * s2 = lpszfont2, *e2, *w2; 5955 char *ptr;
5725
5726 if (s1 == NULL || s2 == NULL) return (FALSE);
5727
5728 if (*s1 == '-') s1++;
5729 if (*s2 == '-') s2++;
5730
5731 while (1)
5732 {
5733 int len1, len2, len3=0;
5734 5956
5735 e1 = strchr (s1, '-'); 5957 ptr = regex;
5736 e2 = strchr (s2, '-'); 5958 *ptr++ = '^';
5737 w1 = strchr (s1, '*');
5738 w2 = strchr (s2, '*');
5739 5959
5740 if (e1 == NULL) 5960 /* Turn pattern into a regexp and do a regexp match. */
5741 len1 = strlen (s1); 5961 for (; *pattern; pattern++)
5742 else 5962 {
5743 len1 = e1 - s1; 5963 if (*pattern == '?')
5744 if (e2 == NULL) 5964 *ptr++ = '.';
5745 len2 = strlen (s1); 5965 else if (*pattern == '*')
5966 {
5967 *ptr++ = '.';
5968 *ptr++ = '*';
5969 }
5746 else 5970 else
5747 len2 = e2 - s2; 5971 *ptr++ = *pattern;
5748
5749 if (w1 && w1 < e1)
5750 len3 = w1 - s1;
5751 if (w2 && w2 < e2 && ( len3 == 0 || (w2 - s2) < len3))
5752 len3 = w2 - s2;
5753
5754 /* Whole field is not a wildcard, and ...*/
5755 if (*s1 != '*' && *s2 != '*' && *s1 != '-' && *s2 != '-'
5756 /* Lengths are different and there are no wildcards, or ... */
5757 && ((len1 != len2 && len3 == 0) ||
5758 /* strings don't match up until first wildcard or end. */
5759 strnicmp (s1, s2, len3 > 0 ? len3 : len1) != 0))
5760 return (FALSE);
5761
5762 if (e1 == NULL || e2 == NULL)
5763 return (TRUE);
5764
5765 s1 = e1 + 1;
5766 s2 = e2 + 1;
5767 } 5972 }
5973 *ptr = '$';
5974 *(ptr + 1) = '\0';
5975
5976 return (fast_c_string_match_ignore_case (build_string (regex),
5977 fontname) >= 0);
5768} 5978}
5769 5979
5770/* Callback functions, and a structure holding info they need, for 5980/* Callback functions, and a structure holding info they need, for
@@ -5802,26 +6012,37 @@ enum_font_cb2 (lplf, lptm, FontType, lpef)
5802 lplf->elfLogFont.lfCharSet != lpef->logfont.lfCharSet) 6012 lplf->elfLogFont.lfCharSet != lpef->logfont.lfCharSet)
5803 return (1); 6013 return (1);
5804 6014
5805 /* We want all fonts cached, so don't compare sizes just yet */
5806 /* if (!lpef->size_ref || lptm->tmMaxCharWidth == FONT_WIDTH (lpef->size_ref)) */
5807 { 6015 {
5808 char buf[100]; 6016 char buf[100];
5809 Lisp_Object width = Qnil; 6017 Lisp_Object width = Qnil;
5810 6018
5811 if (!NILP (*(lpef->pattern)) && FontType != RASTER_FONTTYPE) 6019 /* Truetype fonts do not report their true metrics until loaded */
6020 if (FontType != RASTER_FONTTYPE)
5812 { 6021 {
5813 /* Scalable fonts are as big as you want them to be. */ 6022 if (!NILP (*(lpef->pattern)))
5814 lplf->elfLogFont.lfHeight = lpef->logfont.lfHeight; 6023 {
5815 lplf->elfLogFont.lfWidth = lpef->logfont.lfWidth; 6024 /* Scalable fonts are as big as you want them to be. */
6025 lplf->elfLogFont.lfHeight = lpef->logfont.lfHeight;
6026 lplf->elfLogFont.lfWidth = lpef->logfont.lfWidth;
6027 width = make_number (lpef->logfont.lfWidth);
6028 }
6029 else
6030 {
6031 lplf->elfLogFont.lfHeight = 0;
6032 lplf->elfLogFont.lfWidth = 0;
6033 }
5816 } 6034 }
6035
5817 /* Make sure the height used here is the same as everywhere 6036 /* Make sure the height used here is the same as everywhere
5818 else (ie character height, not cell height). */ 6037 else (ie character height, not cell height). */
5819 else if (lplf->elfLogFont.lfHeight > 0) 6038 if (lplf->elfLogFont.lfHeight > 0)
5820 lplf->elfLogFont.lfHeight = lptm->tmInternalLeading - lptm->tmHeight; 6039 {
5821 6040 /* lptm can be trusted for RASTER fonts, but not scalable ones. */
5822 /* The MaxCharWidth is not valid at this stage for scalable fonts. */ 6041 if (FontType == RASTER_FONTTYPE)
5823 if (FontType == RASTER_FONTTYPE) 6042 lplf->elfLogFont.lfHeight = lptm->tmInternalLeading - lptm->tmHeight;
5824 width = make_number (lptm->tmMaxCharWidth); 6043 else
6044 lplf->elfLogFont.lfHeight = -lplf->elfLogFont.lfHeight;
6045 }
5825 6046
5826 if (!w32_to_x_font (&(lplf->elfLogFont), buf, 100)) 6047 if (!w32_to_x_font (&(lplf->elfLogFont), buf, 100))
5827 return (0); 6048 return (0);
@@ -5834,7 +6055,7 @@ enum_font_cb2 (lplf, lptm, FontType, lpef)
5834 lpef->numFonts++; 6055 lpef->numFonts++;
5835 } 6056 }
5836 } 6057 }
5837 6058
5838 return (1); 6059 return (1);
5839} 6060}
5840 6061
@@ -5933,7 +6154,7 @@ Lisp_Object w32_list_synthesized_fonts (FRAME_PTR f, Lisp_Object pattern,
5933Lisp_Object 6154Lisp_Object
5934w32_list_fonts (FRAME_PTR f, Lisp_Object pattern, int size, int maxnames ) 6155w32_list_fonts (FRAME_PTR f, Lisp_Object pattern, int size, int maxnames )
5935{ 6156{
5936 Lisp_Object patterns, key, tem, tpat; 6157 Lisp_Object patterns, key = Qnil, tem, tpat;
5937 Lisp_Object list = Qnil, newlist = Qnil, second_best = Qnil; 6158 Lisp_Object list = Qnil, newlist = Qnil, second_best = Qnil;
5938 struct w32_display_info *dpyinfo = &one_w32_display_info; 6159 struct w32_display_info *dpyinfo = &one_w32_display_info;
5939 int n_fonts = 0; 6160 int n_fonts = 0;
@@ -6111,7 +6332,7 @@ w32_list_fonts (FRAME_PTR f, Lisp_Object pattern, int size, int maxnames )
6111 6332
6112 /* If we can't find a font that matches, check if Windows would be 6333 /* If we can't find a font that matches, check if Windows would be
6113 able to synthesize it from a different style. */ 6334 able to synthesize it from a different style. */
6114 if (NILP (newlist) && !NILP (Vw32_enable_italics)) 6335 if (NILP (newlist) && !NILP (Vw32_enable_synthesized_fonts))
6115 newlist = w32_list_synthesized_fonts (f, pattern, size, maxnames); 6336 newlist = w32_list_synthesized_fonts (f, pattern, size, maxnames);
6116 6337
6117 return newlist; 6338 return newlist;
@@ -6229,175 +6450,6 @@ w32_find_ccl_program (fontp)
6229} 6450}
6230 6451
6231 6452
6232#if 1
6233#include "x-list-font.c"
6234#else
6235DEFUN ("x-list-fonts", Fx_list_fonts, Sx_list_fonts, 1, 4, 0,
6236 "Return a list of the names of available fonts matching PATTERN.\n\
6237If optional arguments FACE and FRAME are specified, return only fonts\n\
6238the same size as FACE on FRAME.\n\
6239\n\
6240PATTERN is a string, perhaps with wildcard characters;\n\
6241 the * character matches any substring, and\n\
6242 the ? character matches any single character.\n\
6243 PATTERN is case-insensitive.\n\
6244FACE is a face name--a symbol.\n\
6245\n\
6246The return value is a list of strings, suitable as arguments to\n\
6247set-face-font.\n\
6248\n\
6249Fonts Emacs can't use (i.e. proportional fonts) may or may not be excluded\n\
6250even if they match PATTERN and FACE.\n\
6251\n\
6252The optional fourth argument MAXIMUM sets a limit on how many\n\
6253fonts to match. The first MAXIMUM fonts are reported.")
6254 (pattern, face, frame, maximum)
6255 Lisp_Object pattern, face, frame, maximum;
6256{
6257 int num_fonts;
6258 char **names;
6259 XFontStruct *info;
6260 XFontStruct *size_ref;
6261 Lisp_Object namelist;
6262 Lisp_Object list;
6263 FRAME_PTR f;
6264 enumfont_t ef;
6265
6266 CHECK_STRING (pattern, 0);
6267 if (!NILP (face))
6268 CHECK_SYMBOL (face, 1);
6269
6270 f = check_x_frame (frame);
6271
6272 /* Determine the width standard for comparison with the fonts we find. */
6273
6274 if (NILP (face))
6275 size_ref = 0;
6276 else
6277 {
6278 int face_id;
6279
6280 /* Don't die if we get called with a terminal frame. */
6281 if (! FRAME_W32_P (f))
6282 error ("non-w32 frame used in `x-list-fonts'");
6283
6284 face_id = face_name_id_number (f, face);
6285
6286 if (face_id < 0 || face_id >= FRAME_N_PARAM_FACES (f)
6287 || FRAME_PARAM_FACES (f) [face_id] == 0)
6288 size_ref = f->output_data.w32->font;
6289 else
6290 {
6291 size_ref = FRAME_PARAM_FACES (f) [face_id]->font;
6292 if (size_ref == (XFontStruct *) (~0))
6293 size_ref = f->output_data.w32->font;
6294 }
6295 }
6296
6297 /* See if we cached the result for this particular query. */
6298 list = Fassoc (pattern,
6299 XCDR (FRAME_W32_DISPLAY_INFO (f)->name_list_element));
6300
6301 /* We have info in the cache for this PATTERN. */
6302 if (!NILP (list))
6303 {
6304 Lisp_Object tem, newlist;
6305
6306 /* We have info about this pattern. */
6307 list = XCDR (list);
6308
6309 if (size_ref == 0)
6310 return list;
6311
6312 BLOCK_INPUT;
6313
6314 /* Filter the cached info and return just the fonts that match FACE. */
6315 newlist = Qnil;
6316 for (tem = list; CONSP (tem); tem = XCDR (tem))
6317 {
6318 struct font_info *fontinf;
6319 XFontStruct *thisinfo = NULL;
6320
6321 fontinf = w32_load_font (f, XSTRING (XCAR (tem))->data, 0);
6322 if (fontinf)
6323 thisinfo = (XFontStruct *)fontinf->font;
6324 if (thisinfo && same_size_fonts (thisinfo, size_ref))
6325 newlist = Fcons (XCAR (tem), newlist);
6326
6327 w32_unload_font (FRAME_W32_DISPLAY_INFO (f), thisinfo);
6328 }
6329
6330 UNBLOCK_INPUT;
6331
6332 return newlist;
6333 }
6334
6335 BLOCK_INPUT;
6336
6337 namelist = Qnil;
6338 ef.pattern = &pattern;
6339 ef.tail &namelist;
6340 ef.numFonts = 0;
6341 x_to_w32_font (STRINGP (pattern) ? XSTRING (pattern)->data : NULL, &ef.logfont);
6342
6343 {
6344 ef.hdc = GetDC (FRAME_W32_WINDOW (f));
6345
6346 EnumFontFamilies (ef.hdc, NULL, (FONTENUMPROC) enum_font_cb1, (LPARAM)&ef);
6347
6348 ReleaseDC (FRAME_W32_WINDOW (f), ef.hdc);
6349 }
6350
6351 UNBLOCK_INPUT;
6352
6353 if (ef.numFonts)
6354 {
6355 int i;
6356 Lisp_Object cur;
6357
6358 /* Make a list of all the fonts we got back.
6359 Store that in the font cache for the display. */
6360 XCDR (FRAME_W32_DISPLAY_INFO (f)->name_list_element)
6361 = Fcons (Fcons (pattern, namelist),
6362 XCDR (FRAME_W32_DISPLAY_INFO (f)->name_list_element));
6363
6364 /* Make a list of the fonts that have the right width. */
6365 list = Qnil;
6366 cur=namelist;
6367 for (i = 0; i < ef.numFonts; i++)
6368 {
6369 int keeper;
6370
6371 if (!size_ref)
6372 keeper = 1;
6373 else
6374 {
6375 struct font_info *fontinf;
6376 XFontStruct *thisinfo = NULL;
6377
6378 BLOCK_INPUT;
6379 fontinf = w32_load_font (f, XSTRING (Fcar (cur))->data, 0);
6380 if (fontinf)
6381 thisinfo = (XFontStruct *)fontinf->font;
6382
6383 keeper = thisinfo && same_size_fonts (thisinfo, size_ref);
6384
6385 w32_unload_font (FRAME_W32_DISPLAY_INFO (f), thisinfo);
6386
6387 UNBLOCK_INPUT;
6388 }
6389 if (keeper)
6390 list = Fcons (build_string (XSTRING (Fcar (cur))->data), list);
6391
6392 cur = Fcdr (cur);
6393 }
6394 list = Fnreverse (list);
6395 }
6396
6397 return list;
6398}
6399#endif
6400
6401DEFUN ("w32-find-bdf-fonts", Fw32_find_bdf_fonts, Sw32_find_bdf_fonts, 6453DEFUN ("w32-find-bdf-fonts", Fw32_find_bdf_fonts, Sw32_find_bdf_fonts,
6402 1, 1, 0, 6454 1, 1, 0,
6403 "Return a list of BDF fonts in DIR, suitable for appending to\n\ 6455 "Return a list of BDF fonts in DIR, suitable for appending to\n\
@@ -6449,38 +6501,46 @@ Lisp_Object w32_find_bdf_fonts_in_dir( Lisp_Object directory )
6449 6501
6450 6502
6451DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0, 6503DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0,
6452 "Internal function called by `color-defined-p', which see.") 6504 "Return non-nil if color COLOR is supported on frame FRAME.\n\
6505If FRAME is omitted or nil, use the selected frame.")
6453 (color, frame) 6506 (color, frame)
6454 Lisp_Object color, frame; 6507 Lisp_Object color, frame;
6455{ 6508{
6456 COLORREF foo; 6509 XColor foo;
6457 FRAME_PTR f = check_x_frame (frame); 6510 FRAME_PTR f = check_x_frame (frame);
6458 6511
6459 CHECK_STRING (color, 1); 6512 CHECK_STRING (color, 1);
6460 6513
6461 if (defined_color (f, XSTRING (color)->data, &foo, 0)) 6514 if (w32_defined_color (f, XSTRING (color)->data, &foo, 0))
6462 return Qt; 6515 return Qt;
6463 else 6516 else
6464 return Qnil; 6517 return Qnil;
6465} 6518}
6466 6519
6467DEFUN ("xw-color-values", Fxw_color_values, Sxw_color_values, 1, 2, 0, 6520DEFUN ("xw-color-values", Fxw_color_values, Sxw_color_values, 1, 2, 0,
6468 "Internal function called by `color-values', which see.") 6521 "Return a description of the color named COLOR on frame FRAME.\n\
6522The value is a list of integer RGB values--(RED GREEN BLUE).\n\
6523These values appear to range from 0 to 65280 or 65535, depending\n\
6524on the system; white is (65280 65280 65280) or (65535 65535 65535).\n\
6525If FRAME is omitted or nil, use the selected frame.")
6469 (color, frame) 6526 (color, frame)
6470 Lisp_Object color, frame; 6527 Lisp_Object color, frame;
6471{ 6528{
6472 COLORREF foo; 6529 XColor foo;
6473 FRAME_PTR f = check_x_frame (frame); 6530 FRAME_PTR f = check_x_frame (frame);
6474 6531
6475 CHECK_STRING (color, 1); 6532 CHECK_STRING (color, 1);
6476 6533
6477 if (defined_color (f, XSTRING (color)->data, &foo, 0)) 6534 if (w32_defined_color (f, XSTRING (color)->data, &foo, 0))
6478 { 6535 {
6479 Lisp_Object rgb[3]; 6536 Lisp_Object rgb[3];
6480 6537
6481 rgb[0] = make_number ((GetRValue (foo) << 8) | GetRValue (foo)); 6538 rgb[0] = make_number ((GetRValue (foo.pixel) << 8)
6482 rgb[1] = make_number ((GetGValue (foo) << 8) | GetGValue (foo)); 6539 | GetRValue (foo.pixel));
6483 rgb[2] = make_number ((GetBValue (foo) << 8) | GetBValue (foo)); 6540 rgb[1] = make_number ((GetGValue (foo.pixel) << 8)
6541 | GetGValue (foo.pixel));
6542 rgb[2] = make_number ((GetBValue (foo.pixel) << 8)
6543 | GetBValue (foo.pixel));
6484 return Flist (3, rgb); 6544 return Flist (3, rgb);
6485 } 6545 }
6486 else 6546 else
@@ -6776,11 +6836,10 @@ x_char_height (f)
6776} 6836}
6777 6837
6778int 6838int
6779x_screen_planes (frame) 6839x_screen_planes (f)
6780 Lisp_Object frame; 6840 register struct frame *f;
6781{ 6841{
6782 return (FRAME_W32_DISPLAY_INFO (XFRAME (frame))->n_planes * 6842 return FRAME_W32_DISPLAY_INFO (f)->n_planes;
6783 FRAME_W32_DISPLAY_INFO (XFRAME (frame))->n_cbits);
6784} 6843}
6785 6844
6786/* Return the display structure for the display named NAME. 6845/* Return the display structure for the display named NAME.
@@ -6831,7 +6890,6 @@ terminate Emacs if we can't open the connection.")
6831 (display, xrm_string, must_succeed) 6890 (display, xrm_string, must_succeed)
6832 Lisp_Object display, xrm_string, must_succeed; 6891 Lisp_Object display, xrm_string, must_succeed;
6833{ 6892{
6834 unsigned int n_planes;
6835 unsigned char *xrm_option; 6893 unsigned char *xrm_option;
6836 struct w32_display_info *dpyinfo; 6894 struct w32_display_info *dpyinfo;
6837 6895
@@ -6912,7 +6970,6 @@ If DISPLAY is nil, that stands for the selected frame's display.")
6912 Lisp_Object display; 6970 Lisp_Object display;
6913{ 6971{
6914 struct w32_display_info *dpyinfo = check_x_display_info (display); 6972 struct w32_display_info *dpyinfo = check_x_display_info (display);
6915 struct w32_display_info *tail;
6916 int i; 6973 int i;
6917 6974
6918 if (dpyinfo->reference_count > 0) 6975 if (dpyinfo->reference_count > 0)
@@ -6921,13 +6978,13 @@ If DISPLAY is nil, that stands for the selected frame's display.")
6921 BLOCK_INPUT; 6978 BLOCK_INPUT;
6922 /* Free the fonts in the font table. */ 6979 /* Free the fonts in the font table. */
6923 for (i = 0; i < dpyinfo->n_fonts; i++) 6980 for (i = 0; i < dpyinfo->n_fonts; i++)
6924 { 6981 if (dpyinfo->font_table[i].name)
6925 if (dpyinfo->font_table[i].name) 6982 {
6926 free (dpyinfo->font_table[i].name); 6983 xfree (dpyinfo->font_table[i].name);
6927 /* Don't free the full_name string; 6984 /* Don't free the full_name string;
6928 it is always shared with something else. */ 6985 it is always shared with something else. */
6929 w32_unload_font (dpyinfo, dpyinfo->font_table[i].font); 6986 w32_unload_font (dpyinfo, dpyinfo->font_table[i].font);
6930 } 6987 }
6931 x_destroy_all_bitmaps (dpyinfo); 6988 x_destroy_all_bitmaps (dpyinfo);
6932 6989
6933 x_delete_display (dpyinfo); 6990 x_delete_display (dpyinfo);
@@ -6965,7 +7022,5122 @@ If DISPLAY is omitted or nil, that stands for the selected frame's display.")
6965} 7022}
6966 7023
6967 7024
6968/* These are the w32 specialized functions */ 7025
7026/***********************************************************************
7027 Image types
7028 ***********************************************************************/
7029
7030/* Value is the number of elements of vector VECTOR. */
7031
7032#define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
7033
7034/* List of supported image types. Use define_image_type to add new
7035 types. Use lookup_image_type to find a type for a given symbol. */
7036
7037static struct image_type *image_types;
7038
7039/* A list of symbols, one for each supported image type. */
7040
7041Lisp_Object Vimage_types;
7042
7043/* The symbol `image' which is the car of the lists used to represent
7044 images in Lisp. */
7045
7046extern Lisp_Object Qimage;
7047
7048/* The symbol `xbm' which is used as the type symbol for XBM images. */
7049
7050Lisp_Object Qxbm;
7051
7052/* Keywords. */
7053
7054Lisp_Object QCtype, QCdata, QCascent, QCmargin, QCrelief;
7055extern Lisp_Object QCwidth, QCheight, QCforeground, QCbackground, QCfile;
7056Lisp_Object QCalgorithm, QCcolor_symbols, QCheuristic_mask;
7057extern Lisp_Object QCindex;
7058
7059/* Other symbols. */
7060
7061Lisp_Object Qlaplace;
7062
7063/* Time in seconds after which images should be removed from the cache
7064 if not displayed. */
7065
7066Lisp_Object Vimage_cache_eviction_delay;
7067
7068/* Function prototypes. */
7069
7070static void define_image_type P_ ((struct image_type *type));
7071static struct image_type *lookup_image_type P_ ((Lisp_Object symbol));
7072static void image_error P_ ((char *format, Lisp_Object, Lisp_Object));
7073static void x_laplace P_ ((struct frame *, struct image *));
7074static int x_build_heuristic_mask P_ ((struct frame *, struct image *,
7075 Lisp_Object));
7076
7077/* Define a new image type from TYPE. This adds a copy of TYPE to
7078 image_types and adds the symbol *TYPE->type to Vimage_types. */
7079
7080static void
7081define_image_type (type)
7082 struct image_type *type;
7083{
7084 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
7085 The initialized data segment is read-only. */
7086 struct image_type *p = (struct image_type *) xmalloc (sizeof *p);
7087 bcopy (type, p, sizeof *p);
7088 p->next = image_types;
7089 image_types = p;
7090 Vimage_types = Fcons (*p->type, Vimage_types);
7091}
7092
7093
7094/* Look up image type SYMBOL, and return a pointer to its image_type
7095 structure. Value is null if SYMBOL is not a known image type. */
7096
7097static INLINE struct image_type *
7098lookup_image_type (symbol)
7099 Lisp_Object symbol;
7100{
7101 struct image_type *type;
7102
7103 for (type = image_types; type; type = type->next)
7104 if (EQ (symbol, *type->type))
7105 break;
7106
7107 return type;
7108}
7109
7110
7111/* Value is non-zero if OBJECT is a valid Lisp image specification. A
7112 valid image specification is a list whose car is the symbol
7113 `image', and whose rest is a property list. The property list must
7114 contain a value for key `:type'. That value must be the name of a
7115 supported image type. The rest of the property list depends on the
7116 image type. */
7117
7118int
7119valid_image_p (object)
7120 Lisp_Object object;
7121{
7122 int valid_p = 0;
7123
7124 if (CONSP (object) && EQ (XCAR (object), Qimage))
7125 {
7126 Lisp_Object symbol = Fplist_get (XCDR (object), QCtype);
7127 struct image_type *type = lookup_image_type (symbol);
7128
7129 if (type)
7130 valid_p = type->valid_p (object);
7131 }
7132
7133 return valid_p;
7134}
7135
7136
7137/* Log error message with format string FORMAT and argument ARG.
7138 Signaling an error, e.g. when an image cannot be loaded, is not a
7139 good idea because this would interrupt redisplay, and the error
7140 message display would lead to another redisplay. This function
7141 therefore simply displays a message. */
7142
7143static void
7144image_error (format, arg1, arg2)
7145 char *format;
7146 Lisp_Object arg1, arg2;
7147{
7148 add_to_log (format, arg1, arg2);
7149}
7150
7151
7152
7153/***********************************************************************
7154 Image specifications
7155 ***********************************************************************/
7156
7157enum image_value_type
7158{
7159 IMAGE_DONT_CHECK_VALUE_TYPE,
7160 IMAGE_STRING_VALUE,
7161 IMAGE_SYMBOL_VALUE,
7162 IMAGE_POSITIVE_INTEGER_VALUE,
7163 IMAGE_NON_NEGATIVE_INTEGER_VALUE,
7164 IMAGE_INTEGER_VALUE,
7165 IMAGE_FUNCTION_VALUE,
7166 IMAGE_NUMBER_VALUE,
7167 IMAGE_BOOL_VALUE
7168};
7169
7170/* Structure used when parsing image specifications. */
7171
7172struct image_keyword
7173{
7174 /* Name of keyword. */
7175 char *name;
7176
7177 /* The type of value allowed. */
7178 enum image_value_type type;
7179
7180 /* Non-zero means key must be present. */
7181 int mandatory_p;
7182
7183 /* Used to recognize duplicate keywords in a property list. */
7184 int count;
7185
7186 /* The value that was found. */
7187 Lisp_Object value;
7188};
7189
7190
7191static int parse_image_spec P_ ((Lisp_Object, struct image_keyword *,
7192 int, Lisp_Object));
7193static Lisp_Object image_spec_value P_ ((Lisp_Object, Lisp_Object, int *));
7194
7195
7196/* Parse image spec SPEC according to KEYWORDS. A valid image spec
7197 has the format (image KEYWORD VALUE ...). One of the keyword/
7198 value pairs must be `:type TYPE'. KEYWORDS is a vector of
7199 image_keywords structures of size NKEYWORDS describing other
7200 allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
7201
7202static int
7203parse_image_spec (spec, keywords, nkeywords, type)
7204 Lisp_Object spec;
7205 struct image_keyword *keywords;
7206 int nkeywords;
7207 Lisp_Object type;
7208{
7209 int i;
7210 Lisp_Object plist;
7211
7212 if (!CONSP (spec) || !EQ (XCAR (spec), Qimage))
7213 return 0;
7214
7215 plist = XCDR (spec);
7216 while (CONSP (plist))
7217 {
7218 Lisp_Object key, value;
7219
7220 /* First element of a pair must be a symbol. */
7221 key = XCAR (plist);
7222 plist = XCDR (plist);
7223 if (!SYMBOLP (key))
7224 return 0;
7225
7226 /* There must follow a value. */
7227 if (!CONSP (plist))
7228 return 0;
7229 value = XCAR (plist);
7230 plist = XCDR (plist);
7231
7232 /* Find key in KEYWORDS. Error if not found. */
7233 for (i = 0; i < nkeywords; ++i)
7234 if (strcmp (keywords[i].name, XSYMBOL (key)->name->data) == 0)
7235 break;
7236
7237 if (i == nkeywords)
7238 continue;
7239
7240 /* Record that we recognized the keyword. If a keywords
7241 was found more than once, it's an error. */
7242 keywords[i].value = value;
7243 ++keywords[i].count;
7244
7245 if (keywords[i].count > 1)
7246 return 0;
7247
7248 /* Check type of value against allowed type. */
7249 switch (keywords[i].type)
7250 {
7251 case IMAGE_STRING_VALUE:
7252 if (!STRINGP (value))
7253 return 0;
7254 break;
7255
7256 case IMAGE_SYMBOL_VALUE:
7257 if (!SYMBOLP (value))
7258 return 0;
7259 break;
7260
7261 case IMAGE_POSITIVE_INTEGER_VALUE:
7262 if (!INTEGERP (value) || XINT (value) <= 0)
7263 return 0;
7264 break;
7265
7266 case IMAGE_NON_NEGATIVE_INTEGER_VALUE:
7267 if (!INTEGERP (value) || XINT (value) < 0)
7268 return 0;
7269 break;
7270
7271 case IMAGE_DONT_CHECK_VALUE_TYPE:
7272 break;
7273
7274 case IMAGE_FUNCTION_VALUE:
7275 value = indirect_function (value);
7276 if (SUBRP (value)
7277 || COMPILEDP (value)
7278 || (CONSP (value) && EQ (XCAR (value), Qlambda)))
7279 break;
7280 return 0;
7281
7282 case IMAGE_NUMBER_VALUE:
7283 if (!INTEGERP (value) && !FLOATP (value))
7284 return 0;
7285 break;
7286
7287 case IMAGE_INTEGER_VALUE:
7288 if (!INTEGERP (value))
7289 return 0;
7290 break;
7291
7292 case IMAGE_BOOL_VALUE:
7293 if (!NILP (value) && !EQ (value, Qt))
7294 return 0;
7295 break;
7296
7297 default:
7298 abort ();
7299 break;
7300 }
7301
7302 if (EQ (key, QCtype) && !EQ (type, value))
7303 return 0;
7304 }
7305
7306 /* Check that all mandatory fields are present. */
7307 for (i = 0; i < nkeywords; ++i)
7308 if (keywords[i].mandatory_p && keywords[i].count == 0)
7309 return 0;
7310
7311 return NILP (plist);
7312}
7313
7314
7315/* Return the value of KEY in image specification SPEC. Value is nil
7316 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
7317 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
7318
7319static Lisp_Object
7320image_spec_value (spec, key, found)
7321 Lisp_Object spec, key;
7322 int *found;
7323{
7324 Lisp_Object tail;
7325
7326 xassert (valid_image_p (spec));
7327
7328 for (tail = XCDR (spec);
7329 CONSP (tail) && CONSP (XCDR (tail));
7330 tail = XCDR (XCDR (tail)))
7331 {
7332 if (EQ (XCAR (tail), key))
7333 {
7334 if (found)
7335 *found = 1;
7336 return XCAR (XCDR (tail));
7337 }
7338 }
7339
7340 if (found)
7341 *found = 0;
7342 return Qnil;
7343}
7344
7345
7346
7347
7348/***********************************************************************
7349 Image type independent image structures
7350 ***********************************************************************/
7351
7352static struct image *make_image P_ ((Lisp_Object spec, unsigned hash));
7353static void free_image P_ ((struct frame *f, struct image *img));
7354
7355
7356/* Allocate and return a new image structure for image specification
7357 SPEC. SPEC has a hash value of HASH. */
7358
7359static struct image *
7360make_image (spec, hash)
7361 Lisp_Object spec;
7362 unsigned hash;
7363{
7364 struct image *img = (struct image *) xmalloc (sizeof *img);
7365
7366 xassert (valid_image_p (spec));
7367 bzero (img, sizeof *img);
7368 img->type = lookup_image_type (image_spec_value (spec, QCtype, NULL));
7369 xassert (img->type != NULL);
7370 img->spec = spec;
7371 img->data.lisp_val = Qnil;
7372 img->ascent = DEFAULT_IMAGE_ASCENT;
7373 img->hash = hash;
7374 return img;
7375}
7376
7377
7378/* Free image IMG which was used on frame F, including its resources. */
7379
7380static void
7381free_image (f, img)
7382 struct frame *f;
7383 struct image *img;
7384{
7385 if (img)
7386 {
7387 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
7388
7389 /* Remove IMG from the hash table of its cache. */
7390 if (img->prev)
7391 img->prev->next = img->next;
7392 else
7393 c->buckets[img->hash % IMAGE_CACHE_BUCKETS_SIZE] = img->next;
7394
7395 if (img->next)
7396 img->next->prev = img->prev;
7397
7398 c->images[img->id] = NULL;
7399
7400 /* Free resources, then free IMG. */
7401 img->type->free (f, img);
7402 xfree (img);
7403 }
7404}
7405
7406
7407/* Prepare image IMG for display on frame F. Must be called before
7408 drawing an image. */
7409
7410void
7411prepare_image_for_display (f, img)
7412 struct frame *f;
7413 struct image *img;
7414{
7415 EMACS_TIME t;
7416
7417 /* We're about to display IMG, so set its timestamp to `now'. */
7418 EMACS_GET_TIME (t);
7419 img->timestamp = EMACS_SECS (t);
7420
7421 /* If IMG doesn't have a pixmap yet, load it now, using the image
7422 type dependent loader function. */
7423 if (img->pixmap == 0 && !img->load_failed_p)
7424 img->load_failed_p = img->type->load (f, img) == 0;
7425}
7426
7427
7428
7429/***********************************************************************
7430 Helper functions for X image types
7431 ***********************************************************************/
7432
7433static void x_clear_image P_ ((struct frame *f, struct image *img));
7434static unsigned long x_alloc_image_color P_ ((struct frame *f,
7435 struct image *img,
7436 Lisp_Object color_name,
7437 unsigned long dflt));
7438
7439/* Free X resources of image IMG which is used on frame F. */
7440
7441static void
7442x_clear_image (f, img)
7443 struct frame *f;
7444 struct image *img;
7445{
7446#if 0 /* NTEMACS_TODO: W32 image support */
7447
7448 if (img->pixmap)
7449 {
7450 BLOCK_INPUT;
7451 XFreePixmap (NULL, img->pixmap);
7452 img->pixmap = 0;
7453 UNBLOCK_INPUT;
7454 }
7455
7456 if (img->ncolors)
7457 {
7458 int class = FRAME_W32_DISPLAY_INFO (f)->visual->class;
7459
7460 /* If display has an immutable color map, freeing colors is not
7461 necessary and some servers don't allow it. So don't do it. */
7462 if (class != StaticColor
7463 && class != StaticGray
7464 && class != TrueColor)
7465 {
7466 Colormap cmap;
7467 BLOCK_INPUT;
7468 cmap = DefaultColormapOfScreen (FRAME_W32_DISPLAY_INFO (f)->screen);
7469 XFreeColors (FRAME_W32_DISPLAY (f), cmap, img->colors,
7470 img->ncolors, 0);
7471 UNBLOCK_INPUT;
7472 }
7473
7474 xfree (img->colors);
7475 img->colors = NULL;
7476 img->ncolors = 0;
7477 }
7478#endif
7479}
7480
7481
7482/* Allocate color COLOR_NAME for image IMG on frame F. If color
7483 cannot be allocated, use DFLT. Add a newly allocated color to
7484 IMG->colors, so that it can be freed again. Value is the pixel
7485 color. */
7486
7487static unsigned long
7488x_alloc_image_color (f, img, color_name, dflt)
7489 struct frame *f;
7490 struct image *img;
7491 Lisp_Object color_name;
7492 unsigned long dflt;
7493{
7494#if 0 /* NTEMACS_TODO: allocing colors. */
7495 XColor color;
7496 unsigned long result;
7497
7498 xassert (STRINGP (color_name));
7499
7500 if (w32_defined_color (f, XSTRING (color_name)->data, &color, 1))
7501 {
7502 /* This isn't called frequently so we get away with simply
7503 reallocating the color vector to the needed size, here. */
7504 ++img->ncolors;
7505 img->colors =
7506 (unsigned long *) xrealloc (img->colors,
7507 img->ncolors * sizeof *img->colors);
7508 img->colors[img->ncolors - 1] = color.pixel;
7509 result = color.pixel;
7510 }
7511 else
7512 result = dflt;
7513 return result;
7514#endif
7515 return 0;
7516}
7517
7518
7519
7520/***********************************************************************
7521 Image Cache
7522 ***********************************************************************/
7523
7524static void cache_image P_ ((struct frame *f, struct image *img));
7525
7526
7527/* Return a new, initialized image cache that is allocated from the
7528 heap. Call free_image_cache to free an image cache. */
7529
7530struct image_cache *
7531make_image_cache ()
7532{
7533 struct image_cache *c = (struct image_cache *) xmalloc (sizeof *c);
7534 int size;
7535
7536 bzero (c, sizeof *c);
7537 c->size = 50;
7538 c->images = (struct image **) xmalloc (c->size * sizeof *c->images);
7539 size = IMAGE_CACHE_BUCKETS_SIZE * sizeof *c->buckets;
7540 c->buckets = (struct image **) xmalloc (size);
7541 bzero (c->buckets, size);
7542 return c;
7543}
7544
7545
7546/* Free image cache of frame F. Be aware that X frames share images
7547 caches. */
7548
7549void
7550free_image_cache (f)
7551 struct frame *f;
7552{
7553 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
7554 if (c)
7555 {
7556 int i;
7557
7558 /* Cache should not be referenced by any frame when freed. */
7559 xassert (c->refcount == 0);
7560
7561 for (i = 0; i < c->used; ++i)
7562 free_image (f, c->images[i]);
7563 xfree (c->images);
7564 xfree (c);
7565 xfree (c->buckets);
7566 FRAME_X_IMAGE_CACHE (f) = NULL;
7567 }
7568}
7569
7570
7571/* Clear image cache of frame F. FORCE_P non-zero means free all
7572 images. FORCE_P zero means clear only images that haven't been
7573 displayed for some time. Should be called from time to time to
7574 reduce the number of loaded images. If image-cache-eveiction-delay
7575 is non-nil, this frees images in the cache which weren't displayed for
7576 at least that many seconds. */
7577
7578void
7579clear_image_cache (f, force_p)
7580 struct frame *f;
7581 int force_p;
7582{
7583 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
7584
7585 if (c && INTEGERP (Vimage_cache_eviction_delay))
7586 {
7587 EMACS_TIME t;
7588 unsigned long old;
7589 int i, any_freed_p = 0;
7590
7591 EMACS_GET_TIME (t);
7592 old = EMACS_SECS (t) - XFASTINT (Vimage_cache_eviction_delay);
7593
7594 for (i = 0; i < c->used; ++i)
7595 {
7596 struct image *img = c->images[i];
7597 if (img != NULL
7598 && (force_p
7599 || (img->timestamp > old)))
7600 {
7601 free_image (f, img);
7602 any_freed_p = 1;
7603 }
7604 }
7605
7606 /* We may be clearing the image cache because, for example,
7607 Emacs was iconified for a longer period of time. In that
7608 case, current matrices may still contain references to
7609 images freed above. So, clear these matrices. */
7610 if (any_freed_p)
7611 {
7612 clear_current_matrices (f);
7613 ++windows_or_buffers_changed;
7614 }
7615 }
7616}
7617
7618
7619DEFUN ("clear-image-cache", Fclear_image_cache, Sclear_image_cache,
7620 0, 1, 0,
7621 "Clear the image cache of FRAME.\n\
7622FRAME nil or omitted means use the selected frame.\n\
7623FRAME t means clear the image caches of all frames.")
7624 (frame)
7625 Lisp_Object frame;
7626{
7627 if (EQ (frame, Qt))
7628 {
7629 Lisp_Object tail;
7630
7631 FOR_EACH_FRAME (tail, frame)
7632 if (FRAME_W32_P (XFRAME (frame)))
7633 clear_image_cache (XFRAME (frame), 1);
7634 }
7635 else
7636 clear_image_cache (check_x_frame (frame), 1);
7637
7638 return Qnil;
7639}
7640
7641
7642/* Return the id of image with Lisp specification SPEC on frame F.
7643 SPEC must be a valid Lisp image specification (see valid_image_p). */
7644
7645int
7646lookup_image (f, spec)
7647 struct frame *f;
7648 Lisp_Object spec;
7649{
7650 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
7651 struct image *img;
7652 int i;
7653 unsigned hash;
7654 struct gcpro gcpro1;
7655 EMACS_TIME now;
7656
7657 /* F must be a window-system frame, and SPEC must be a valid image
7658 specification. */
7659 xassert (FRAME_WINDOW_P (f));
7660 xassert (valid_image_p (spec));
7661
7662 GCPRO1 (spec);
7663
7664 /* Look up SPEC in the hash table of the image cache. */
7665 hash = sxhash (spec, 0);
7666 i = hash % IMAGE_CACHE_BUCKETS_SIZE;
7667
7668 for (img = c->buckets[i]; img; img = img->next)
7669 if (img->hash == hash && !NILP (Fequal (img->spec, spec)))
7670 break;
7671
7672 /* If not found, create a new image and cache it. */
7673 if (img == NULL)
7674 {
7675 img = make_image (spec, hash);
7676 cache_image (f, img);
7677 img->load_failed_p = img->type->load (f, img) == 0;
7678 xassert (!interrupt_input_blocked);
7679
7680 /* If we can't load the image, and we don't have a width and
7681 height, use some arbitrary width and height so that we can
7682 draw a rectangle for it. */
7683 if (img->load_failed_p)
7684 {
7685 Lisp_Object value;
7686
7687 value = image_spec_value (spec, QCwidth, NULL);
7688 img->width = (INTEGERP (value)
7689 ? XFASTINT (value) : DEFAULT_IMAGE_WIDTH);
7690 value = image_spec_value (spec, QCheight, NULL);
7691 img->height = (INTEGERP (value)
7692 ? XFASTINT (value) : DEFAULT_IMAGE_HEIGHT);
7693 }
7694 else
7695 {
7696 /* Handle image type independent image attributes
7697 `:ascent PERCENT', `:margin MARGIN', `:relief RELIEF'. */
7698 Lisp_Object ascent, margin, relief, algorithm, heuristic_mask;
7699 Lisp_Object file;
7700
7701 ascent = image_spec_value (spec, QCascent, NULL);
7702 if (INTEGERP (ascent))
7703 img->ascent = XFASTINT (ascent);
7704
7705 margin = image_spec_value (spec, QCmargin, NULL);
7706 if (INTEGERP (margin) && XINT (margin) >= 0)
7707 img->margin = XFASTINT (margin);
7708
7709 relief = image_spec_value (spec, QCrelief, NULL);
7710 if (INTEGERP (relief))
7711 {
7712 img->relief = XINT (relief);
7713 img->margin += abs (img->relief);
7714 }
7715
7716 /* Should we apply a Laplace edge-detection algorithm? */
7717 algorithm = image_spec_value (spec, QCalgorithm, NULL);
7718 if (img->pixmap && EQ (algorithm, Qlaplace))
7719 x_laplace (f, img);
7720
7721 /* Should we built a mask heuristically? */
7722 heuristic_mask = image_spec_value (spec, QCheuristic_mask, NULL);
7723 if (img->pixmap && !img->mask && !NILP (heuristic_mask))
7724 x_build_heuristic_mask (f, img, heuristic_mask);
7725 }
7726 }
7727
7728 /* We're using IMG, so set its timestamp to `now'. */
7729 EMACS_GET_TIME (now);
7730 img->timestamp = EMACS_SECS (now);
7731
7732 UNGCPRO;
7733
7734 /* Value is the image id. */
7735 return img->id;
7736}
7737
7738
7739/* Cache image IMG in the image cache of frame F. */
7740
7741static void
7742cache_image (f, img)
7743 struct frame *f;
7744 struct image *img;
7745{
7746 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
7747 int i;
7748
7749 /* Find a free slot in c->images. */
7750 for (i = 0; i < c->used; ++i)
7751 if (c->images[i] == NULL)
7752 break;
7753
7754 /* If no free slot found, maybe enlarge c->images. */
7755 if (i == c->used && c->used == c->size)
7756 {
7757 c->size *= 2;
7758 c->images = (struct image **) xrealloc (c->images,
7759 c->size * sizeof *c->images);
7760 }
7761
7762 /* Add IMG to c->images, and assign IMG an id. */
7763 c->images[i] = img;
7764 img->id = i;
7765 if (i == c->used)
7766 ++c->used;
7767
7768 /* Add IMG to the cache's hash table. */
7769 i = img->hash % IMAGE_CACHE_BUCKETS_SIZE;
7770 img->next = c->buckets[i];
7771 if (img->next)
7772 img->next->prev = img;
7773 img->prev = NULL;
7774 c->buckets[i] = img;
7775}
7776
7777
7778/* Call FN on every image in the image cache of frame F. Used to mark
7779 Lisp Objects in the image cache. */
7780
7781void
7782forall_images_in_image_cache (f, fn)
7783 struct frame *f;
7784 void (*fn) P_ ((struct image *img));
7785{
7786 if (FRAME_LIVE_P (f) && FRAME_W32_P (f))
7787 {
7788 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
7789 if (c)
7790 {
7791 int i;
7792 for (i = 0; i < c->used; ++i)
7793 if (c->images[i])
7794 fn (c->images[i]);
7795 }
7796 }
7797}
7798
7799
7800
7801/***********************************************************************
7802 W32 support code
7803 ***********************************************************************/
7804
7805#if 0 /* NTEMACS_TODO: W32 specific image code. */
7806
7807static int x_create_x_image_and_pixmap P_ ((struct frame *, int, int, int,
7808 XImage **, Pixmap *));
7809static void x_destroy_x_image P_ ((XImage *));
7810static void x_put_x_image P_ ((struct frame *, XImage *, Pixmap, int, int));
7811
7812
7813/* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
7814 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
7815 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
7816 via xmalloc. Print error messages via image_error if an error
7817 occurs. Value is non-zero if successful. */
7818
7819static int
7820x_create_x_image_and_pixmap (f, width, height, depth, ximg, pixmap)
7821 struct frame *f;
7822 int width, height, depth;
7823 XImage **ximg;
7824 Pixmap *pixmap;
7825{
7826#if 0 /* NTEMACS_TODO: Image support for W32 */
7827 Display *display = FRAME_W32_DISPLAY (f);
7828 Screen *screen = FRAME_X_SCREEN (f);
7829 Window window = FRAME_W32_WINDOW (f);
7830
7831 xassert (interrupt_input_blocked);
7832
7833 if (depth <= 0)
7834 depth = DefaultDepthOfScreen (screen);
7835 *ximg = XCreateImage (display, DefaultVisualOfScreen (screen),
7836 depth, ZPixmap, 0, NULL, width, height,
7837 depth > 16 ? 32 : depth > 8 ? 16 : 8, 0);
7838 if (*ximg == NULL)
7839 {
7840 image_error ("Unable to allocate X image", Qnil, Qnil);
7841 return 0;
7842 }
7843
7844 /* Allocate image raster. */
7845 (*ximg)->data = (char *) xmalloc ((*ximg)->bytes_per_line * height);
7846
7847 /* Allocate a pixmap of the same size. */
7848 *pixmap = XCreatePixmap (display, window, width, height, depth);
7849 if (*pixmap == 0)
7850 {
7851 x_destroy_x_image (*ximg);
7852 *ximg = NULL;
7853 image_error ("Unable to create X pixmap", Qnil, Qnil);
7854 return 0;
7855 }
7856#endif
7857 return 1;
7858}
7859
7860
7861/* Destroy XImage XIMG. Free XIMG->data. */
7862
7863static void
7864x_destroy_x_image (ximg)
7865 XImage *ximg;
7866{
7867 xassert (interrupt_input_blocked);
7868 if (ximg)
7869 {
7870 xfree (ximg->data);
7871 ximg->data = NULL;
7872 XDestroyImage (ximg);
7873 }
7874}
7875
7876
7877/* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
7878 are width and height of both the image and pixmap. */
7879
7880static void
7881x_put_x_image (f, ximg, pixmap, width, height)
7882 struct frame *f;
7883 XImage *ximg;
7884 Pixmap pixmap;
7885{
7886 GC gc;
7887
7888 xassert (interrupt_input_blocked);
7889 gc = XCreateGC (NULL, pixmap, 0, NULL);
7890 XPutImage (NULL, pixmap, gc, ximg, 0, 0, 0, 0, width, height);
7891 XFreeGC (NULL, gc);
7892}
7893
7894#endif
7895
7896
7897/***********************************************************************
7898 Searching files
7899 ***********************************************************************/
7900
7901static Lisp_Object x_find_image_file P_ ((Lisp_Object));
7902
7903/* Find image file FILE. Look in data-directory, then
7904 x-bitmap-file-path. Value is the full name of the file found, or
7905 nil if not found. */
7906
7907static Lisp_Object
7908x_find_image_file (file)
7909 Lisp_Object file;
7910{
7911 Lisp_Object file_found, search_path;
7912 struct gcpro gcpro1, gcpro2;
7913 int fd;
7914
7915 file_found = Qnil;
7916 search_path = Fcons (Vdata_directory, Vx_bitmap_file_path);
7917 GCPRO2 (file_found, search_path);
7918
7919 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
7920 fd = openp (search_path, file, "", &file_found, 0);
7921
7922 if (fd < 0)
7923 file_found = Qnil;
7924 else
7925 close (fd);
7926
7927 UNGCPRO;
7928 return file_found;
7929}
7930
7931
7932
7933/***********************************************************************
7934 XBM images
7935 ***********************************************************************/
7936
7937static int xbm_load P_ ((struct frame *f, struct image *img));
7938static int xbm_load_image_from_file P_ ((struct frame *f, struct image *img,
7939 Lisp_Object file));
7940static int xbm_image_p P_ ((Lisp_Object object));
7941static int xbm_read_bitmap_file_data P_ ((char *, int *, int *,
7942 unsigned char **));
7943
7944
7945/* Indices of image specification fields in xbm_format, below. */
7946
7947enum xbm_keyword_index
7948{
7949 XBM_TYPE,
7950 XBM_FILE,
7951 XBM_WIDTH,
7952 XBM_HEIGHT,
7953 XBM_DATA,
7954 XBM_FOREGROUND,
7955 XBM_BACKGROUND,
7956 XBM_ASCENT,
7957 XBM_MARGIN,
7958 XBM_RELIEF,
7959 XBM_ALGORITHM,
7960 XBM_HEURISTIC_MASK,
7961 XBM_LAST
7962};
7963
7964/* Vector of image_keyword structures describing the format
7965 of valid XBM image specifications. */
7966
7967static struct image_keyword xbm_format[XBM_LAST] =
7968{
7969 {":type", IMAGE_SYMBOL_VALUE, 1},
7970 {":file", IMAGE_STRING_VALUE, 0},
7971 {":width", IMAGE_POSITIVE_INTEGER_VALUE, 0},
7972 {":height", IMAGE_POSITIVE_INTEGER_VALUE, 0},
7973 {":data", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
7974 {":foreground", IMAGE_STRING_VALUE, 0},
7975 {":background", IMAGE_STRING_VALUE, 0},
7976 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
7977 {":margin", IMAGE_POSITIVE_INTEGER_VALUE, 0},
7978 {":relief", IMAGE_INTEGER_VALUE, 0},
7979 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
7980 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
7981};
7982
7983/* Structure describing the image type XBM. */
7984
7985static struct image_type xbm_type =
7986{
7987 &Qxbm,
7988 xbm_image_p,
7989 xbm_load,
7990 x_clear_image,
7991 NULL
7992};
7993
7994/* Tokens returned from xbm_scan. */
7995
7996enum xbm_token
7997{
7998 XBM_TK_IDENT = 256,
7999 XBM_TK_NUMBER
8000};
8001
8002
8003/* Return non-zero if OBJECT is a valid XBM-type image specification.
8004 A valid specification is a list starting with the symbol `image'
8005 The rest of the list is a property list which must contain an
8006 entry `:type xbm..
8007
8008 If the specification specifies a file to load, it must contain
8009 an entry `:file FILENAME' where FILENAME is a string.
8010
8011 If the specification is for a bitmap loaded from memory it must
8012 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
8013 WIDTH and HEIGHT are integers > 0. DATA may be:
8014
8015 1. a string large enough to hold the bitmap data, i.e. it must
8016 have a size >= (WIDTH + 7) / 8 * HEIGHT
8017
8018 2. a bool-vector of size >= WIDTH * HEIGHT
8019
8020 3. a vector of strings or bool-vectors, one for each line of the
8021 bitmap.
8022
8023 Both the file and data forms may contain the additional entries
8024 `:background COLOR' and `:foreground COLOR'. If not present,
8025 foreground and background of the frame on which the image is
8026 displayed, is used. */
8027
8028static int
8029xbm_image_p (object)
8030 Lisp_Object object;
8031{
8032 struct image_keyword kw[XBM_LAST];
8033
8034 bcopy (xbm_format, kw, sizeof kw);
8035 if (!parse_image_spec (object, kw, XBM_LAST, Qxbm))
8036 return 0;
8037
8038 xassert (EQ (kw[XBM_TYPE].value, Qxbm));
8039
8040 if (kw[XBM_FILE].count)
8041 {
8042 if (kw[XBM_WIDTH].count || kw[XBM_HEIGHT].count || kw[XBM_DATA].count)
8043 return 0;
8044 }
8045 else
8046 {
8047 Lisp_Object data;
8048 int width, height;
8049
8050 /* Entries for `:width', `:height' and `:data' must be present. */
8051 if (!kw[XBM_WIDTH].count
8052 || !kw[XBM_HEIGHT].count
8053 || !kw[XBM_DATA].count)
8054 return 0;
8055
8056 data = kw[XBM_DATA].value;
8057 width = XFASTINT (kw[XBM_WIDTH].value);
8058 height = XFASTINT (kw[XBM_HEIGHT].value);
8059
8060 /* Check type of data, and width and height against contents of
8061 data. */
8062 if (VECTORP (data))
8063 {
8064 int i;
8065
8066 /* Number of elements of the vector must be >= height. */
8067 if (XVECTOR (data)->size < height)
8068 return 0;
8069
8070 /* Each string or bool-vector in data must be large enough
8071 for one line of the image. */
8072 for (i = 0; i < height; ++i)
8073 {
8074 Lisp_Object elt = XVECTOR (data)->contents[i];
8075
8076 if (STRINGP (elt))
8077 {
8078 if (XSTRING (elt)->size
8079 < (width + BITS_PER_CHAR - 1) / BITS_PER_CHAR)
8080 return 0;
8081 }
8082 else if (BOOL_VECTOR_P (elt))
8083 {
8084 if (XBOOL_VECTOR (elt)->size < width)
8085 return 0;
8086 }
8087 else
8088 return 0;
8089 }
8090 }
8091 else if (STRINGP (data))
8092 {
8093 if (XSTRING (data)->size
8094 < (width + BITS_PER_CHAR - 1) / BITS_PER_CHAR * height)
8095 return 0;
8096 }
8097 else if (BOOL_VECTOR_P (data))
8098 {
8099 if (XBOOL_VECTOR (data)->size < width * height)
8100 return 0;
8101 }
8102 else
8103 return 0;
8104 }
8105
8106 /* Baseline must be a value between 0 and 100 (a percentage). */
8107 if (kw[XBM_ASCENT].count
8108 && XFASTINT (kw[XBM_ASCENT].value) > 100)
8109 return 0;
8110
8111 return 1;
8112}
8113
8114
8115/* Scan a bitmap file. FP is the stream to read from. Value is
8116 either an enumerator from enum xbm_token, or a character for a
8117 single-character token, or 0 at end of file. If scanning an
8118 identifier, store the lexeme of the identifier in SVAL. If
8119 scanning a number, store its value in *IVAL. */
8120
8121static int
8122xbm_scan (fp, sval, ival)
8123 FILE *fp;
8124 char *sval;
8125 int *ival;
8126{
8127 int c;
8128
8129 /* Skip white space. */
8130 while ((c = fgetc (fp)) != EOF && isspace (c))
8131 ;
8132
8133 if (c == EOF)
8134 c = 0;
8135 else if (isdigit (c))
8136 {
8137 int value = 0, digit;
8138
8139 if (c == '0')
8140 {
8141 c = fgetc (fp);
8142 if (c == 'x' || c == 'X')
8143 {
8144 while ((c = fgetc (fp)) != EOF)
8145 {
8146 if (isdigit (c))
8147 digit = c - '0';
8148 else if (c >= 'a' && c <= 'f')
8149 digit = c - 'a' + 10;
8150 else if (c >= 'A' && c <= 'F')
8151 digit = c - 'A' + 10;
8152 else
8153 break;
8154 value = 16 * value + digit;
8155 }
8156 }
8157 else if (isdigit (c))
8158 {
8159 value = c - '0';
8160 while ((c = fgetc (fp)) != EOF
8161 && isdigit (c))
8162 value = 8 * value + c - '0';
8163 }
8164 }
8165 else
8166 {
8167 value = c - '0';
8168 while ((c = fgetc (fp)) != EOF
8169 && isdigit (c))
8170 value = 10 * value + c - '0';
8171 }
8172
8173 if (c != EOF)
8174 ungetc (c, fp);
8175 *ival = value;
8176 c = XBM_TK_NUMBER;
8177 }
8178 else if (isalpha (c) || c == '_')
8179 {
8180 *sval++ = c;
8181 while ((c = fgetc (fp)) != EOF
8182 && (isalnum (c) || c == '_'))
8183 *sval++ = c;
8184 *sval = 0;
8185 if (c != EOF)
8186 ungetc (c, fp);
8187 c = XBM_TK_IDENT;
8188 }
8189
8190 return c;
8191}
8192
8193
8194/* Replacement for XReadBitmapFileData which isn't available under old
8195 X versions. FILE is the name of the bitmap file to read. Set
8196 *WIDTH and *HEIGHT to the width and height of the image. Return in
8197 *DATA the bitmap data allocated with xmalloc. Value is non-zero if
8198 successful. */
8199
8200static int
8201xbm_read_bitmap_file_data (file, width, height, data)
8202 char *file;
8203 int *width, *height;
8204 unsigned char **data;
8205{
8206 FILE *fp;
8207 char buffer[BUFSIZ];
8208 int padding_p = 0;
8209 int v10 = 0;
8210 int bytes_per_line, i, nbytes;
8211 unsigned char *p;
8212 int value;
8213 int LA1;
8214
8215#define match() \
8216 LA1 = xbm_scan (fp, buffer, &value)
8217
8218#define expect(TOKEN) \
8219 if (LA1 != (TOKEN)) \
8220 goto failure; \
8221 else \
8222 match ()
8223
8224#define expect_ident(IDENT) \
8225 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
8226 match (); \
8227 else \
8228 goto failure
8229
8230 fp = fopen (file, "r");
8231 if (fp == NULL)
8232 return 0;
8233
8234 *width = *height = -1;
8235 *data = NULL;
8236 LA1 = xbm_scan (fp, buffer, &value);
8237
8238 /* Parse defines for width, height and hot-spots. */
8239 while (LA1 == '#')
8240 {
8241 match ();
8242 expect_ident ("define");
8243 expect (XBM_TK_IDENT);
8244
8245 if (LA1 == XBM_TK_NUMBER);
8246 {
8247 char *p = strrchr (buffer, '_');
8248 p = p ? p + 1 : buffer;
8249 if (strcmp (p, "width") == 0)
8250 *width = value;
8251 else if (strcmp (p, "height") == 0)
8252 *height = value;
8253 }
8254 expect (XBM_TK_NUMBER);
8255 }
8256
8257 if (*width < 0 || *height < 0)
8258 goto failure;
8259
8260 /* Parse bits. Must start with `static'. */
8261 expect_ident ("static");
8262 if (LA1 == XBM_TK_IDENT)
8263 {
8264 if (strcmp (buffer, "unsigned") == 0)
8265 {
8266 match ();
8267 expect_ident ("char");
8268 }
8269 else if (strcmp (buffer, "short") == 0)
8270 {
8271 match ();
8272 v10 = 1;
8273 if (*width % 16 && *width % 16 < 9)
8274 padding_p = 1;
8275 }
8276 else if (strcmp (buffer, "char") == 0)
8277 match ();
8278 else
8279 goto failure;
8280 }
8281 else
8282 goto failure;
8283
8284 expect (XBM_TK_IDENT);
8285 expect ('[');
8286 expect (']');
8287 expect ('=');
8288 expect ('{');
8289
8290 bytes_per_line = (*width + 7) / 8 + padding_p;
8291 nbytes = bytes_per_line * *height;
8292 p = *data = (char *) xmalloc (nbytes);
8293
8294 if (v10)
8295 {
8296
8297 for (i = 0; i < nbytes; i += 2)
8298 {
8299 int val = value;
8300 expect (XBM_TK_NUMBER);
8301
8302 *p++ = val;
8303 if (!padding_p || ((i + 2) % bytes_per_line))
8304 *p++ = value >> 8;
8305
8306 if (LA1 == ',' || LA1 == '}')
8307 match ();
8308 else
8309 goto failure;
8310 }
8311 }
8312 else
8313 {
8314 for (i = 0; i < nbytes; ++i)
8315 {
8316 int val = value;
8317 expect (XBM_TK_NUMBER);
8318
8319 *p++ = val;
8320
8321 if (LA1 == ',' || LA1 == '}')
8322 match ();
8323 else
8324 goto failure;
8325 }
8326 }
8327
8328 fclose (fp);
8329 return 1;
8330
8331 failure:
8332
8333 fclose (fp);
8334 if (*data)
8335 {
8336 xfree (*data);
8337 *data = NULL;
8338 }
8339 return 0;
8340
8341#undef match
8342#undef expect
8343#undef expect_ident
8344}
8345
8346
8347/* Load XBM image IMG which will be displayed on frame F from file
8348 SPECIFIED_FILE. Value is non-zero if successful. */
8349
8350static int
8351xbm_load_image_from_file (f, img, specified_file)
8352 struct frame *f;
8353 struct image *img;
8354 Lisp_Object specified_file;
8355{
8356 int rc;
8357 unsigned char *data;
8358 int success_p = 0;
8359 Lisp_Object file;
8360 struct gcpro gcpro1;
8361
8362 xassert (STRINGP (specified_file));
8363 file = Qnil;
8364 GCPRO1 (file);
8365
8366 file = x_find_image_file (specified_file);
8367 if (!STRINGP (file))
8368 {
8369 image_error ("Cannot find image file `%s'", specified_file, Qnil);
8370 UNGCPRO;
8371 return 0;
8372 }
8373
8374 rc = xbm_read_bitmap_file_data (XSTRING (file)->data, &img->width,
8375 &img->height, &data);
8376 if (rc)
8377 {
8378 int depth = one_w32_display_info.n_cbits;
8379 unsigned long foreground = FRAME_FOREGROUND_PIXEL (f);
8380 unsigned long background = FRAME_BACKGROUND_PIXEL (f);
8381 Lisp_Object value;
8382
8383 xassert (img->width > 0 && img->height > 0);
8384
8385 /* Get foreground and background colors, maybe allocate colors. */
8386 value = image_spec_value (img->spec, QCforeground, NULL);
8387 if (!NILP (value))
8388 foreground = x_alloc_image_color (f, img, value, foreground);
8389
8390 value = image_spec_value (img->spec, QCbackground, NULL);
8391 if (!NILP (value))
8392 background = x_alloc_image_color (f, img, value, background);
8393
8394#if 0 /* NTEMACS_TODO : Port image display to W32 */
8395 BLOCK_INPUT;
8396 img->pixmap
8397 = XCreatePixmapFromBitmapData (FRAME_W32_DISPLAY (f),
8398 FRAME_W32_WINDOW (f),
8399 data,
8400 img->width, img->height,
8401 foreground, background,
8402 depth);
8403 xfree (data);
8404
8405 if (img->pixmap == 0)
8406 {
8407 x_clear_image (f, img);
8408 image_error ("Unable to create X pixmap for `%s'", file, Qnil);
8409 }
8410 else
8411 success_p = 1;
8412
8413 UNBLOCK_INPUT;
8414#endif
8415 }
8416 else
8417 image_error ("Error loading XBM image `%s'", img->spec, Qnil);
8418
8419 UNGCPRO;
8420 return success_p;
8421}
8422
8423
8424/* Fill image IMG which is used on frame F with pixmap data. Value is
8425 non-zero if successful. */
8426
8427static int
8428xbm_load (f, img)
8429 struct frame *f;
8430 struct image *img;
8431{
8432 int success_p = 0;
8433 Lisp_Object file_name;
8434
8435 xassert (xbm_image_p (img->spec));
8436
8437 /* If IMG->spec specifies a file name, create a non-file spec from it. */
8438 file_name = image_spec_value (img->spec, QCfile, NULL);
8439 if (STRINGP (file_name))
8440 success_p = xbm_load_image_from_file (f, img, file_name);
8441 else
8442 {
8443 struct image_keyword fmt[XBM_LAST];
8444 Lisp_Object data;
8445 int depth;
8446 unsigned long foreground = FRAME_FOREGROUND_PIXEL (f);
8447 unsigned long background = FRAME_BACKGROUND_PIXEL (f);
8448 char *bits;
8449 int parsed_p;
8450
8451 /* Parse the list specification. */
8452 bcopy (xbm_format, fmt, sizeof fmt);
8453 parsed_p = parse_image_spec (img->spec, fmt, XBM_LAST, Qxbm);
8454 xassert (parsed_p);
8455
8456 /* Get specified width, and height. */
8457 img->width = XFASTINT (fmt[XBM_WIDTH].value);
8458 img->height = XFASTINT (fmt[XBM_HEIGHT].value);
8459 xassert (img->width > 0 && img->height > 0);
8460
8461 BLOCK_INPUT;
8462
8463 if (fmt[XBM_ASCENT].count)
8464 img->ascent = XFASTINT (fmt[XBM_ASCENT].value);
8465
8466 /* Get foreground and background colors, maybe allocate colors. */
8467 if (fmt[XBM_FOREGROUND].count)
8468 foreground = x_alloc_image_color (f, img, fmt[XBM_FOREGROUND].value,
8469 foreground);
8470 if (fmt[XBM_BACKGROUND].count)
8471 background = x_alloc_image_color (f, img, fmt[XBM_BACKGROUND].value,
8472 background);
8473
8474 /* Set bits to the bitmap image data. */
8475 data = fmt[XBM_DATA].value;
8476 if (VECTORP (data))
8477 {
8478 int i;
8479 char *p;
8480 int nbytes = (img->width + BITS_PER_CHAR - 1) / BITS_PER_CHAR;
8481
8482 p = bits = (char *) alloca (nbytes * img->height);
8483 for (i = 0; i < img->height; ++i, p += nbytes)
8484 {
8485 Lisp_Object line = XVECTOR (data)->contents[i];
8486 if (STRINGP (line))
8487 bcopy (XSTRING (line)->data, p, nbytes);
8488 else
8489 bcopy (XBOOL_VECTOR (line)->data, p, nbytes);
8490 }
8491 }
8492 else if (STRINGP (data))
8493 bits = XSTRING (data)->data;
8494 else
8495 bits = XBOOL_VECTOR (data)->data;
8496
8497#if 0 /* NTEMACS_TODO : W32 XPM code */
8498 /* Create the pixmap. */
8499 depth = DefaultDepthOfScreen (FRAME_X_SCREEN (f));
8500 img->pixmap
8501 = XCreatePixmapFromBitmapData (FRAME_W32_DISPLAY (f),
8502 FRAME_W32_WINDOW (f),
8503 bits,
8504 img->width, img->height,
8505 foreground, background,
8506 depth);
8507#endif /* NTEMACS_TODO */
8508
8509 if (img->pixmap)
8510 success_p = 1;
8511 else
8512 {
8513 image_error ("Unable to create pixmap for XBM image `%s'",
8514 img->spec, Qnil);
8515 x_clear_image (f, img);
8516 }
8517
8518 UNBLOCK_INPUT;
8519 }
8520
8521 return success_p;
8522}
8523
8524
8525
8526/***********************************************************************
8527 XPM images
8528 ***********************************************************************/
8529
8530#if HAVE_XPM
8531
8532static int xpm_image_p P_ ((Lisp_Object object));
8533static int xpm_load P_ ((struct frame *f, struct image *img));
8534static int xpm_valid_color_symbols_p P_ ((Lisp_Object));
8535
8536#include "X11/xpm.h"
8537
8538/* The symbol `xpm' identifying XPM-format images. */
8539
8540Lisp_Object Qxpm;
8541
8542/* Indices of image specification fields in xpm_format, below. */
8543
8544enum xpm_keyword_index
8545{
8546 XPM_TYPE,
8547 XPM_FILE,
8548 XPM_DATA,
8549 XPM_ASCENT,
8550 XPM_MARGIN,
8551 XPM_RELIEF,
8552 XPM_ALGORITHM,
8553 XPM_HEURISTIC_MASK,
8554 XPM_COLOR_SYMBOLS,
8555 XPM_LAST
8556};
8557
8558/* Vector of image_keyword structures describing the format
8559 of valid XPM image specifications. */
8560
8561static struct image_keyword xpm_format[XPM_LAST] =
8562{
8563 {":type", IMAGE_SYMBOL_VALUE, 1},
8564 {":file", IMAGE_STRING_VALUE, 0},
8565 {":data", IMAGE_STRING_VALUE, 0},
8566 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
8567 {":margin", IMAGE_POSITIVE_INTEGER_VALUE, 0},
8568 {":relief", IMAGE_INTEGER_VALUE, 0},
8569 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
8570 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
8571 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
8572};
8573
8574/* Structure describing the image type XBM. */
8575
8576static struct image_type xpm_type =
8577{
8578 &Qxpm,
8579 xpm_image_p,
8580 xpm_load,
8581 x_clear_image,
8582 NULL
8583};
8584
8585
8586/* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
8587 for XPM images. Such a list must consist of conses whose car and
8588 cdr are strings. */
8589
8590static int
8591xpm_valid_color_symbols_p (color_symbols)
8592 Lisp_Object color_symbols;
8593{
8594 while (CONSP (color_symbols))
8595 {
8596 Lisp_Object sym = XCAR (color_symbols);
8597 if (!CONSP (sym)
8598 || !STRINGP (XCAR (sym))
8599 || !STRINGP (XCDR (sym)))
8600 break;
8601 color_symbols = XCDR (color_symbols);
8602 }
8603
8604 return NILP (color_symbols);
8605}
8606
8607
8608/* Value is non-zero if OBJECT is a valid XPM image specification. */
8609
8610static int
8611xpm_image_p (object)
8612 Lisp_Object object;
8613{
8614 struct image_keyword fmt[XPM_LAST];
8615 bcopy (xpm_format, fmt, sizeof fmt);
8616 return (parse_image_spec (object, fmt, XPM_LAST, Qxpm)
8617 /* Either `:file' or `:data' must be present. */
8618 && fmt[XPM_FILE].count + fmt[XPM_DATA].count == 1
8619 /* Either no `:color-symbols' or it's a list of conses
8620 whose car and cdr are strings. */
8621 && (fmt[XPM_COLOR_SYMBOLS].count == 0
8622 || xpm_valid_color_symbols_p (fmt[XPM_COLOR_SYMBOLS].value))
8623 && (fmt[XPM_ASCENT].count == 0
8624 || XFASTINT (fmt[XPM_ASCENT].value) < 100));
8625}
8626
8627
8628/* Load image IMG which will be displayed on frame F. Value is
8629 non-zero if successful. */
8630
8631static int
8632xpm_load (f, img)
8633 struct frame *f;
8634 struct image *img;
8635{
8636 int rc, i;
8637 XpmAttributes attrs;
8638 Lisp_Object specified_file, color_symbols;
8639
8640 /* Configure the XPM lib. Use the visual of frame F. Allocate
8641 close colors. Return colors allocated. */
8642 bzero (&attrs, sizeof attrs);
8643 attrs.visual = FRAME_W32_DISPLAY_INFO (f)->visual;
8644 attrs.valuemask |= XpmVisual;
8645 attrs.valuemask |= XpmReturnAllocPixels;
8646 attrs.alloc_close_colors = 1;
8647 attrs.valuemask |= XpmAllocCloseColors;
8648
8649 /* If image specification contains symbolic color definitions, add
8650 these to `attrs'. */
8651 color_symbols = image_spec_value (img->spec, QCcolor_symbols, NULL);
8652 if (CONSP (color_symbols))
8653 {
8654 Lisp_Object tail;
8655 XpmColorSymbol *xpm_syms;
8656 int i, size;
8657
8658 attrs.valuemask |= XpmColorSymbols;
8659
8660 /* Count number of symbols. */
8661 attrs.numsymbols = 0;
8662 for (tail = color_symbols; CONSP (tail); tail = XCDR (tail))
8663 ++attrs.numsymbols;
8664
8665 /* Allocate an XpmColorSymbol array. */
8666 size = attrs.numsymbols * sizeof *xpm_syms;
8667 xpm_syms = (XpmColorSymbol *) alloca (size);
8668 bzero (xpm_syms, size);
8669 attrs.colorsymbols = xpm_syms;
8670
8671 /* Fill the color symbol array. */
8672 for (tail = color_symbols, i = 0;
8673 CONSP (tail);
8674 ++i, tail = XCDR (tail))
8675 {
8676 Lisp_Object name = XCAR (XCAR (tail));
8677 Lisp_Object color = XCDR (XCAR (tail));
8678 xpm_syms[i].name = (char *) alloca (XSTRING (name)->size + 1);
8679 strcpy (xpm_syms[i].name, XSTRING (name)->data);
8680 xpm_syms[i].value = (char *) alloca (XSTRING (color)->size + 1);
8681 strcpy (xpm_syms[i].value, XSTRING (color)->data);
8682 }
8683 }
8684
8685 /* Create a pixmap for the image, either from a file, or from a
8686 string buffer containing data in the same format as an XPM file. */
8687 BLOCK_INPUT;
8688 specified_file = image_spec_value (img->spec, QCfile, NULL);
8689 if (STRINGP (specified_file))
8690 {
8691 Lisp_Object file = x_find_image_file (specified_file);
8692 if (!STRINGP (file))
8693 {
8694 image_error ("Cannot find image file `%s'", specified_file, Qnil);
8695 UNBLOCK_INPUT;
8696 return 0;
8697 }
8698
8699 rc = XpmReadFileToPixmap (NULL, FRAME_W32_WINDOW (f),
8700 XSTRING (file)->data, &img->pixmap, &img->mask,
8701 &attrs);
8702 }
8703 else
8704 {
8705 Lisp_Object buffer = image_spec_value (img->spec, QCdata, NULL);
8706 rc = XpmCreatePixmapFromBuffer (NULL, FRAME_W32_WINDOW (f),
8707 XSTRING (buffer)->data,
8708 &img->pixmap, &img->mask,
8709 &attrs);
8710 }
8711 UNBLOCK_INPUT;
8712
8713 if (rc == XpmSuccess)
8714 {
8715 /* Remember allocated colors. */
8716 img->ncolors = attrs.nalloc_pixels;
8717 img->colors = (unsigned long *) xmalloc (img->ncolors
8718 * sizeof *img->colors);
8719 for (i = 0; i < attrs.nalloc_pixels; ++i)
8720 img->colors[i] = attrs.alloc_pixels[i];
8721
8722 img->width = attrs.width;
8723 img->height = attrs.height;
8724 xassert (img->width > 0 && img->height > 0);
8725
8726 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
8727 BLOCK_INPUT;
8728 XpmFreeAttributes (&attrs);
8729 UNBLOCK_INPUT;
8730 }
8731 else
8732 {
8733 switch (rc)
8734 {
8735 case XpmOpenFailed:
8736 image_error ("Error opening XPM file (%s)", img->spec, Qnil);
8737 break;
8738
8739 case XpmFileInvalid:
8740 image_error ("Invalid XPM file (%s)", img->spec, Qnil);
8741 break;
8742
8743 case XpmNoMemory:
8744 image_error ("Out of memory (%s)", img->spec, Qnil);
8745 break;
8746
8747 case XpmColorFailed:
8748 image_error ("Color allocation error (%s)", img->spec, Qnil);
8749 break;
8750
8751 default:
8752 image_error ("Unknown error (%s)", img->spec, Qnil);
8753 break;
8754 }
8755 }
8756
8757 return rc == XpmSuccess;
8758}
8759
8760#endif /* HAVE_XPM != 0 */
8761
8762
8763#if 0 /* NTEMACS_TODO : Color tables on W32. */
8764/***********************************************************************
8765 Color table
8766 ***********************************************************************/
8767
8768/* An entry in the color table mapping an RGB color to a pixel color. */
8769
8770struct ct_color
8771{
8772 int r, g, b;
8773 unsigned long pixel;
8774
8775 /* Next in color table collision list. */
8776 struct ct_color *next;
8777};
8778
8779/* The bucket vector size to use. Must be prime. */
8780
8781#define CT_SIZE 101
8782
8783/* Value is a hash of the RGB color given by R, G, and B. */
8784
8785#define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
8786
8787/* The color hash table. */
8788
8789struct ct_color **ct_table;
8790
8791/* Number of entries in the color table. */
8792
8793int ct_colors_allocated;
8794
8795/* Function prototypes. */
8796
8797static void init_color_table P_ ((void));
8798static void free_color_table P_ ((void));
8799static unsigned long *colors_in_color_table P_ ((int *n));
8800static unsigned long lookup_rgb_color P_ ((struct frame *f, int r, int g, int b));
8801static unsigned long lookup_pixel_color P_ ((struct frame *f, unsigned long p));
8802
8803
8804/* Initialize the color table. */
8805
8806static void
8807init_color_table ()
8808{
8809 int size = CT_SIZE * sizeof (*ct_table);
8810 ct_table = (struct ct_color **) xmalloc (size);
8811 bzero (ct_table, size);
8812 ct_colors_allocated = 0;
8813}
8814
8815
8816/* Free memory associated with the color table. */
8817
8818static void
8819free_color_table ()
8820{
8821 int i;
8822 struct ct_color *p, *next;
8823
8824 for (i = 0; i < CT_SIZE; ++i)
8825 for (p = ct_table[i]; p; p = next)
8826 {
8827 next = p->next;
8828 xfree (p);
8829 }
8830
8831 xfree (ct_table);
8832 ct_table = NULL;
8833}
8834
8835
8836/* Value is a pixel color for RGB color R, G, B on frame F. If an
8837 entry for that color already is in the color table, return the
8838 pixel color of that entry. Otherwise, allocate a new color for R,
8839 G, B, and make an entry in the color table. */
8840
8841static unsigned long
8842lookup_rgb_color (f, r, g, b)
8843 struct frame *f;
8844 int r, g, b;
8845{
8846 unsigned hash = CT_HASH_RGB (r, g, b);
8847 int i = hash % CT_SIZE;
8848 struct ct_color *p;
8849
8850 for (p = ct_table[i]; p; p = p->next)
8851 if (p->r == r && p->g == g && p->b == b)
8852 break;
8853
8854 if (p == NULL)
8855 {
8856 COLORREF color;
8857 Colormap cmap;
8858 int rc;
8859
8860 color = PALETTERGB (r, g, b);
8861
8862 ++ct_colors_allocated;
8863
8864 p = (struct ct_color *) xmalloc (sizeof *p);
8865 p->r = r;
8866 p->g = g;
8867 p->b = b;
8868 p->pixel = color;
8869 p->next = ct_table[i];
8870 ct_table[i] = p;
8871 }
8872
8873 return p->pixel;
8874}
8875
8876
8877/* Look up pixel color PIXEL which is used on frame F in the color
8878 table. If not already present, allocate it. Value is PIXEL. */
8879
8880static unsigned long
8881lookup_pixel_color (f, pixel)
8882 struct frame *f;
8883 unsigned long pixel;
8884{
8885 int i = pixel % CT_SIZE;
8886 struct ct_color *p;
8887
8888 for (p = ct_table[i]; p; p = p->next)
8889 if (p->pixel == pixel)
8890 break;
8891
8892 if (p == NULL)
8893 {
8894 XColor color;
8895 Colormap cmap;
8896 int rc;
8897
8898 BLOCK_INPUT;
8899
8900 cmap = DefaultColormapOfScreen (FRAME_X_SCREEN (f));
8901 color.pixel = pixel;
8902 XQueryColor (NULL, cmap, &color);
8903 rc = x_alloc_nearest_color (f, cmap, &color);
8904 UNBLOCK_INPUT;
8905
8906 if (rc)
8907 {
8908 ++ct_colors_allocated;
8909
8910 p = (struct ct_color *) xmalloc (sizeof *p);
8911 p->r = color.red;
8912 p->g = color.green;
8913 p->b = color.blue;
8914 p->pixel = pixel;
8915 p->next = ct_table[i];
8916 ct_table[i] = p;
8917 }
8918 else
8919 return FRAME_FOREGROUND_PIXEL (f);
8920 }
8921 return p->pixel;
8922}
8923
8924
8925/* Value is a vector of all pixel colors contained in the color table,
8926 allocated via xmalloc. Set *N to the number of colors. */
8927
8928static unsigned long *
8929colors_in_color_table (n)
8930 int *n;
8931{
8932 int i, j;
8933 struct ct_color *p;
8934 unsigned long *colors;
8935
8936 if (ct_colors_allocated == 0)
8937 {
8938 *n = 0;
8939 colors = NULL;
8940 }
8941 else
8942 {
8943 colors = (unsigned long *) xmalloc (ct_colors_allocated
8944 * sizeof *colors);
8945 *n = ct_colors_allocated;
8946
8947 for (i = j = 0; i < CT_SIZE; ++i)
8948 for (p = ct_table[i]; p; p = p->next)
8949 colors[j++] = p->pixel;
8950 }
8951
8952 return colors;
8953}
8954
8955#endif /* NTEMACS_TODO */
8956
8957
8958/***********************************************************************
8959 Algorithms
8960 ***********************************************************************/
8961
8962#if 0 /* NTEMACS_TODO : W32 versions of low level algorithms */
8963static void x_laplace_write_row P_ ((struct frame *, long *,
8964 int, XImage *, int));
8965static void x_laplace_read_row P_ ((struct frame *, Colormap,
8966 XColor *, int, XImage *, int));
8967
8968
8969/* Fill COLORS with RGB colors from row Y of image XIMG. F is the
8970 frame we operate on, CMAP is the color-map in effect, and WIDTH is
8971 the width of one row in the image. */
8972
8973static void
8974x_laplace_read_row (f, cmap, colors, width, ximg, y)
8975 struct frame *f;
8976 Colormap cmap;
8977 XColor *colors;
8978 int width;
8979 XImage *ximg;
8980 int y;
8981{
8982 int x;
8983
8984 for (x = 0; x < width; ++x)
8985 colors[x].pixel = XGetPixel (ximg, x, y);
8986
8987 XQueryColors (NULL, cmap, colors, width);
8988}
8989
8990
8991/* Write row Y of image XIMG. PIXELS is an array of WIDTH longs
8992 containing the pixel colors to write. F is the frame we are
8993 working on. */
8994
8995static void
8996x_laplace_write_row (f, pixels, width, ximg, y)
8997 struct frame *f;
8998 long *pixels;
8999 int width;
9000 XImage *ximg;
9001 int y;
9002{
9003 int x;
9004
9005 for (x = 0; x < width; ++x)
9006 XPutPixel (ximg, x, y, pixels[x]);
9007}
9008#endif
9009
9010/* Transform image IMG which is used on frame F with a Laplace
9011 edge-detection algorithm. The result is an image that can be used
9012 to draw disabled buttons, for example. */
9013
9014static void
9015x_laplace (f, img)
9016 struct frame *f;
9017 struct image *img;
9018{
9019#if 0 /* NTEMACS_TODO : W32 version */
9020 Colormap cmap = DefaultColormapOfScreen (FRAME_X_SCREEN (f));
9021 XImage *ximg, *oimg;
9022 XColor *in[3];
9023 long *out;
9024 Pixmap pixmap;
9025 int x, y, i;
9026 long pixel;
9027 int in_y, out_y, rc;
9028 int mv2 = 45000;
9029
9030 BLOCK_INPUT;
9031
9032 /* Get the X image IMG->pixmap. */
9033 ximg = XGetImage (NULL, img->pixmap,
9034 0, 0, img->width, img->height, ~0, ZPixmap);
9035
9036 /* Allocate 3 input rows, and one output row of colors. */
9037 for (i = 0; i < 3; ++i)
9038 in[i] = (XColor *) alloca (img->width * sizeof (XColor));
9039 out = (long *) alloca (img->width * sizeof (long));
9040
9041 /* Create an X image for output. */
9042 rc = x_create_x_image_and_pixmap (f, img->width, img->height, 0,
9043 &oimg, &pixmap);
9044
9045 /* Fill first two rows. */
9046 x_laplace_read_row (f, cmap, in[0], img->width, ximg, 0);
9047 x_laplace_read_row (f, cmap, in[1], img->width, ximg, 1);
9048 in_y = 2;
9049
9050 /* Write first row, all zeros. */
9051 init_color_table ();
9052 pixel = lookup_rgb_color (f, 0, 0, 0);
9053 for (x = 0; x < img->width; ++x)
9054 out[x] = pixel;
9055 x_laplace_write_row (f, out, img->width, oimg, 0);
9056 out_y = 1;
9057
9058 for (y = 2; y < img->height; ++y)
9059 {
9060 int rowa = y % 3;
9061 int rowb = (y + 2) % 3;
9062
9063 x_laplace_read_row (f, cmap, in[rowa], img->width, ximg, in_y++);
9064
9065 for (x = 0; x < img->width - 2; ++x)
9066 {
9067 int r = in[rowa][x].red + mv2 - in[rowb][x + 2].red;
9068 int g = in[rowa][x].green + mv2 - in[rowb][x + 2].green;
9069 int b = in[rowa][x].blue + mv2 - in[rowb][x + 2].blue;
9070
9071 out[x + 1] = lookup_rgb_color (f, r & 0xffff, g & 0xffff,
9072 b & 0xffff);
9073 }
9074
9075 x_laplace_write_row (f, out, img->width, oimg, out_y++);
9076 }
9077
9078 /* Write last line, all zeros. */
9079 for (x = 0; x < img->width; ++x)
9080 out[x] = pixel;
9081 x_laplace_write_row (f, out, img->width, oimg, out_y);
9082
9083 /* Free the input image, and free resources of IMG. */
9084 XDestroyImage (ximg);
9085 x_clear_image (f, img);
9086
9087 /* Put the output image into pixmap, and destroy it. */
9088 x_put_x_image (f, oimg, pixmap, img->width, img->height);
9089 x_destroy_x_image (oimg);
9090
9091 /* Remember new pixmap and colors in IMG. */
9092 img->pixmap = pixmap;
9093 img->colors = colors_in_color_table (&img->ncolors);
9094 free_color_table ();
9095
9096 UNBLOCK_INPUT;
9097#endif /* NTEMACS_TODO */
9098}
9099
9100
9101/* Build a mask for image IMG which is used on frame F. FILE is the
9102 name of an image file, for error messages. HOW determines how to
9103 determine the background color of IMG. If it is a list '(R G B)',
9104 with R, G, and B being integers >= 0, take that as the color of the
9105 background. Otherwise, determine the background color of IMG
9106 heuristically. Value is non-zero if successful. */
9107
9108static int
9109x_build_heuristic_mask (f, img, how)
9110 struct frame *f;
9111 struct image *img;
9112 Lisp_Object how;
9113{
9114#if 0 /* NTEMACS_TODO : W32 version */
9115 Display *dpy = FRAME_W32_DISPLAY (f);
9116 XImage *ximg, *mask_img;
9117 int x, y, rc, look_at_corners_p;
9118 unsigned long bg;
9119
9120 BLOCK_INPUT;
9121
9122 /* Create an image and pixmap serving as mask. */
9123 rc = x_create_x_image_and_pixmap (f, img->width, img->height, 1,
9124 &mask_img, &img->mask);
9125 if (!rc)
9126 {
9127 UNBLOCK_INPUT;
9128 return 0;
9129 }
9130
9131 /* Get the X image of IMG->pixmap. */
9132 ximg = XGetImage (dpy, img->pixmap, 0, 0, img->width, img->height,
9133 ~0, ZPixmap);
9134
9135 /* Determine the background color of ximg. If HOW is `(R G B)'
9136 take that as color. Otherwise, try to determine the color
9137 heuristically. */
9138 look_at_corners_p = 1;
9139
9140 if (CONSP (how))
9141 {
9142 int rgb[3], i = 0;
9143
9144 while (i < 3
9145 && CONSP (how)
9146 && NATNUMP (XCAR (how)))
9147 {
9148 rgb[i] = XFASTINT (XCAR (how)) & 0xffff;
9149 how = XCDR (how);
9150 }
9151
9152 if (i == 3 && NILP (how))
9153 {
9154 char color_name[30];
9155 XColor exact, color;
9156 Colormap cmap;
9157
9158 sprintf (color_name, "#%04x%04x%04x", rgb[0], rgb[1], rgb[2]);
9159
9160 cmap = DefaultColormapOfScreen (FRAME_X_SCREEN (f));
9161 if (XLookupColor (dpy, cmap, color_name, &exact, &color))
9162 {
9163 bg = color.pixel;
9164 look_at_corners_p = 0;
9165 }
9166 }
9167 }
9168
9169 if (look_at_corners_p)
9170 {
9171 unsigned long corners[4];
9172 int i, best_count;
9173
9174 /* Get the colors at the corners of ximg. */
9175 corners[0] = XGetPixel (ximg, 0, 0);
9176 corners[1] = XGetPixel (ximg, img->width - 1, 0);
9177 corners[2] = XGetPixel (ximg, img->width - 1, img->height - 1);
9178 corners[3] = XGetPixel (ximg, 0, img->height - 1);
9179
9180 /* Choose the most frequently found color as background. */
9181 for (i = best_count = 0; i < 4; ++i)
9182 {
9183 int j, n;
9184
9185 for (j = n = 0; j < 4; ++j)
9186 if (corners[i] == corners[j])
9187 ++n;
9188
9189 if (n > best_count)
9190 bg = corners[i], best_count = n;
9191 }
9192 }
9193
9194 /* Set all bits in mask_img to 1 whose color in ximg is different
9195 from the background color bg. */
9196 for (y = 0; y < img->height; ++y)
9197 for (x = 0; x < img->width; ++x)
9198 XPutPixel (mask_img, x, y, XGetPixel (ximg, x, y) != bg);
9199
9200 /* Put mask_img into img->mask. */
9201 x_put_x_image (f, mask_img, img->mask, img->width, img->height);
9202 x_destroy_x_image (mask_img);
9203 XDestroyImage (ximg);
9204
9205 UNBLOCK_INPUT;
9206#endif /* NTEMACS_TODO */
9207
9208 return 1;
9209}
9210
9211
9212
9213/***********************************************************************
9214 PBM (mono, gray, color)
9215 ***********************************************************************/
9216#ifdef HAVE_PBM
9217
9218static int pbm_image_p P_ ((Lisp_Object object));
9219static int pbm_load P_ ((struct frame *f, struct image *img));
9220static int pbm_scan_number P_ ((unsigned char **, unsigned char *));
9221
9222/* The symbol `pbm' identifying images of this type. */
9223
9224Lisp_Object Qpbm;
9225
9226/* Indices of image specification fields in gs_format, below. */
9227
9228enum pbm_keyword_index
9229{
9230 PBM_TYPE,
9231 PBM_FILE,
9232 PBM_DATA,
9233 PBM_ASCENT,
9234 PBM_MARGIN,
9235 PBM_RELIEF,
9236 PBM_ALGORITHM,
9237 PBM_HEURISTIC_MASK,
9238 PBM_LAST
9239};
9240
9241/* Vector of image_keyword structures describing the format
9242 of valid user-defined image specifications. */
9243
9244static struct image_keyword pbm_format[PBM_LAST] =
9245{
9246 {":type", IMAGE_SYMBOL_VALUE, 1},
9247 {":file", IMAGE_STRING_VALUE, 0},
9248 {":data", IMAGE_STRING_VALUE, 0},
9249 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
9250 {":margin", IMAGE_POSITIVE_INTEGER_VALUE, 0},
9251 {":relief", IMAGE_INTEGER_VALUE, 0},
9252 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
9253 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
9254};
9255
9256/* Structure describing the image type `pbm'. */
9257
9258static struct image_type pbm_type =
9259{
9260 &Qpbm,
9261 pbm_image_p,
9262 pbm_load,
9263 x_clear_image,
9264 NULL
9265};
9266
9267
9268/* Return non-zero if OBJECT is a valid PBM image specification. */
9269
9270static int
9271pbm_image_p (object)
9272 Lisp_Object object;
9273{
9274 struct image_keyword fmt[PBM_LAST];
9275
9276 bcopy (pbm_format, fmt, sizeof fmt);
9277
9278 if (!parse_image_spec (object, fmt, PBM_LAST, Qpbm)
9279 || (fmt[PBM_ASCENT].count
9280 && XFASTINT (fmt[PBM_ASCENT].value) > 100))
9281 return 0;
9282
9283 /* Must specify either :data or :file. */
9284 return fmt[PBM_DATA].count + fmt[PBM_FILE].count == 1;
9285}
9286
9287
9288/* Scan a decimal number from *S and return it. Advance *S while
9289 reading the number. END is the end of the string. Value is -1 at
9290 end of input. */
9291
9292static int
9293pbm_scan_number (s, end)
9294 unsigned char **s, *end;
9295{
9296 int c, val = -1;
9297
9298 while (*s < end)
9299 {
9300 /* Skip white-space. */
9301 while (*s < end && (c = *(*s)++, isspace (c)))
9302 ;
9303
9304 if (c == '#')
9305 {
9306 /* Skip comment to end of line. */
9307 while (*s < end && (c = *(*s)++, c != '\n'))
9308 ;
9309 }
9310 else if (isdigit (c))
9311 {
9312 /* Read decimal number. */
9313 val = c - '0';
9314 while (*s < end && (c = *(*s)++, isdigit (c)))
9315 val = 10 * val + c - '0';
9316 break;
9317 }
9318 else
9319 break;
9320 }
9321
9322 return val;
9323}
9324
9325
9326/* Read FILE into memory. Value is a pointer to a buffer allocated
9327 with xmalloc holding FILE's contents. Value is null if an error
9328 occured. *SIZE is set to the size of the file. */
9329
9330static char *
9331pbm_read_file (file, size)
9332 Lisp_Object file;
9333 int *size;
9334{
9335 FILE *fp = NULL;
9336 char *buf = NULL;
9337 struct stat st;
9338
9339 if (stat (XSTRING (file)->data, &st) == 0
9340 && (fp = fopen (XSTRING (file)->data, "r")) != NULL
9341 && (buf = (char *) xmalloc (st.st_size),
9342 fread (buf, 1, st.st_size, fp) == st.st_size))
9343 {
9344 *size = st.st_size;
9345 fclose (fp);
9346 }
9347 else
9348 {
9349 if (fp)
9350 fclose (fp);
9351 if (buf)
9352 {
9353 xfree (buf);
9354 buf = NULL;
9355 }
9356 }
9357
9358 return buf;
9359}
9360
9361
9362/* Load PBM image IMG for use on frame F. */
9363
9364static int
9365pbm_load (f, img)
9366 struct frame *f;
9367 struct image *img;
9368{
9369 int raw_p, x, y;
9370 int width, height, max_color_idx = 0;
9371 XImage *ximg;
9372 Lisp_Object file, specified_file;
9373 enum {PBM_MONO, PBM_GRAY, PBM_COLOR} type;
9374 struct gcpro gcpro1;
9375 unsigned char *contents = NULL;
9376 unsigned char *end, *p;
9377 int size;
9378
9379 specified_file = image_spec_value (img->spec, QCfile, NULL);
9380 file = Qnil;
9381 GCPRO1 (file);
9382
9383 if (STRINGP (specified_file))
9384 {
9385 file = x_find_image_file (specified_file);
9386 if (!STRINGP (file))
9387 {
9388 image_error ("Cannot find image file `%s'", specified_file, Qnil);
9389 UNGCPRO;
9390 return 0;
9391 }
9392
9393 contents = pbm_read_file (file, &size);
9394 if (contents == NULL)
9395 {
9396 image_error ("Error reading `%s'", file, Qnil);
9397 UNGCPRO;
9398 return 0;
9399 }
9400
9401 p = contents;
9402 end = contents + size;
9403 }
9404 else
9405 {
9406 Lisp_Object data;
9407 data = image_spec_value (img->spec, QCdata, NULL);
9408 p = XSTRING (data)->data;
9409 end = p + STRING_BYTES (XSTRING (data));
9410 }
9411
9412 /* Check magic number. */
9413 if (end - p < 2 || *p++ != 'P')
9414 {
9415 image_error ("Not a PBM image: `%s'", img->spec, Qnil);
9416 error:
9417 xfree (contents);
9418 UNGCPRO;
9419 return 0;
9420 }
9421
9422 if (*magic != 'P')
9423 {
9424 fclose (fp);
9425 image_error ("Not a PBM image file: %s", file, Qnil);
9426 UNGCPRO;
9427 return 0;
9428 }
9429
9430 switch (*p++)
9431 {
9432 case '1':
9433 raw_p = 0, type = PBM_MONO;
9434 break;
9435
9436 case '2':
9437 raw_p = 0, type = PBM_GRAY;
9438 break;
9439
9440 case '3':
9441 raw_p = 0, type = PBM_COLOR;
9442 break;
9443
9444 case '4':
9445 raw_p = 1, type = PBM_MONO;
9446 break;
9447
9448 case '5':
9449 raw_p = 1, type = PBM_GRAY;
9450 break;
9451
9452 case '6':
9453 raw_p = 1, type = PBM_COLOR;
9454 break;
9455
9456 default:
9457 image_error ("Not a PBM image: `%s'", img->spec, Qnil);
9458 goto error;
9459 }
9460
9461 /* Read width, height, maximum color-component. Characters
9462 starting with `#' up to the end of a line are ignored. */
9463 width = pbm_scan_number (&p, end);
9464 height = pbm_scan_number (&p, end);
9465
9466 if (type != PBM_MONO)
9467 {
9468 max_color_idx = pbm_scan_number (&p, end);
9469 if (raw_p && max_color_idx > 255)
9470 max_color_idx = 255;
9471 }
9472
9473 if (width < 0
9474 || height < 0
9475 || (type != PBM_MONO && max_color_idx < 0))
9476 goto error;
9477
9478 BLOCK_INPUT;
9479 if (!x_create_x_image_and_pixmap (f, width, height, 0,
9480 &ximg, &img->pixmap))
9481 {
9482 UNBLOCK_INPUT;
9483 goto error;
9484 }
9485
9486 /* Initialize the color hash table. */
9487 init_color_table ();
9488
9489 if (type == PBM_MONO)
9490 {
9491 int c = 0, g;
9492
9493 for (y = 0; y < height; ++y)
9494 for (x = 0; x < width; ++x)
9495 {
9496 if (raw_p)
9497 {
9498 if ((x & 7) == 0)
9499 c = *p++;
9500 g = c & 0x80;
9501 c <<= 1;
9502 }
9503 else
9504 g = pbm_scan_number (&p, end);
9505
9506 XPutPixel (ximg, x, y, (g
9507 ? FRAME_FOREGROUND_PIXEL (f)
9508 : FRAME_BACKGROUND_PIXEL (f)));
9509 }
9510 }
9511 else
9512 {
9513 for (y = 0; y < height; ++y)
9514 for (x = 0; x < width; ++x)
9515 {
9516 int r, g, b;
9517
9518 if (type == PBM_GRAY)
9519 r = g = b = raw_p ? *p++ : pbm_scan_number (&p, end);
9520 else if (raw_p)
9521 {
9522 r = *p++;
9523 g = *p++;
9524 b = *p++;
9525 }
9526 else
9527 {
9528 r = pbm_scan_number (&p, end);
9529 g = pbm_scan_number (&p, end);
9530 b = pbm_scan_number (&p, end);
9531 }
9532
9533 if (r < 0 || g < 0 || b < 0)
9534 {
9535b xfree (ximg->data);
9536 ximg->data = NULL;
9537 XDestroyImage (ximg);
9538 UNBLOCK_INPUT;
9539 image_error ("Invalid pixel value in image `%s'",
9540 img->spec, Qnil);
9541 goto error;
9542 }
9543
9544 /* RGB values are now in the range 0..max_color_idx.
9545 Scale this to the range 0..0xffff supported by X. */
9546 r = (double) r * 65535 / max_color_idx;
9547 g = (double) g * 65535 / max_color_idx;
9548 b = (double) b * 65535 / max_color_idx;
9549 XPutPixel (ximg, x, y, lookup_rgb_color (f, r, g, b));
9550 }
9551 }
9552
9553 /* Store in IMG->colors the colors allocated for the image, and
9554 free the color table. */
9555 img->colors = colors_in_color_table (&img->ncolors);
9556 free_color_table ();
9557
9558 /* Put the image into a pixmap. */
9559 x_put_x_image (f, ximg, img->pixmap, width, height);
9560 x_destroy_x_image (ximg);
9561 UNBLOCK_INPUT;
9562
9563 img->width = width;
9564 img->height = height;
9565
9566 UNGCPRO;
9567 xfree (contents);
9568 return 1;
9569}
9570#endif /* HAVE_PBM */
9571
9572
9573/***********************************************************************
9574 PNG
9575 ***********************************************************************/
9576
9577#if HAVE_PNG
9578
9579#include <png.h>
9580
9581/* Function prototypes. */
9582
9583static int png_image_p P_ ((Lisp_Object object));
9584static int png_load P_ ((struct frame *f, struct image *img));
9585
9586/* The symbol `png' identifying images of this type. */
9587
9588Lisp_Object Qpng;
9589
9590/* Indices of image specification fields in png_format, below. */
9591
9592enum png_keyword_index
9593{
9594 PNG_TYPE,
9595 PNG_DATA,
9596 PNG_FILE,
9597 PNG_ASCENT,
9598 PNG_MARGIN,
9599 PNG_RELIEF,
9600 PNG_ALGORITHM,
9601 PNG_HEURISTIC_MASK,
9602 PNG_LAST
9603};
9604
9605/* Vector of image_keyword structures describing the format
9606 of valid user-defined image specifications. */
9607
9608static struct image_keyword png_format[PNG_LAST] =
9609{
9610 {":type", IMAGE_SYMBOL_VALUE, 1},
9611 {":data", IMAGE_STRING_VALUE, 0},
9612 {":file", IMAGE_STRING_VALUE, 0},
9613 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
9614 {":margin", IMAGE_POSITIVE_INTEGER_VALUE, 0},
9615 {":relief", IMAGE_INTEGER_VALUE, 0},
9616 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
9617 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
9618};
9619
9620/* Structure describing the image type `png'. */
9621
9622static struct image_type png_type =
9623{
9624 &Qpng,
9625 png_image_p,
9626 png_load,
9627 x_clear_image,
9628 NULL
9629};
9630
9631
9632/* Return non-zero if OBJECT is a valid PNG image specification. */
9633
9634static int
9635png_image_p (object)
9636 Lisp_Object object;
9637{
9638 struct image_keyword fmt[PNG_LAST];
9639 bcopy (png_format, fmt, sizeof fmt);
9640
9641 if (!parse_image_spec (object, fmt, PNG_LAST, Qpng)
9642 || (fmt[PNG_ASCENT].count
9643 && XFASTINT (fmt[PNG_ASCENT].value) > 100))
9644 return 0;
9645
9646 /* Must specify either the :data or :file keyword. */
9647 return fmt[PNG_FILE].count + fmt[PNG_DATA].count == 1;
9648}
9649
9650
9651/* Error and warning handlers installed when the PNG library
9652 is initialized. */
9653
9654static void
9655my_png_error (png_ptr, msg)
9656 png_struct *png_ptr;
9657 char *msg;
9658{
9659 xassert (png_ptr != NULL);
9660 image_error ("PNG error: %s", build_string (msg), Qnil);
9661 longjmp (png_ptr->jmpbuf, 1);
9662}
9663
9664
9665static void
9666my_png_warning (png_ptr, msg)
9667 png_struct *png_ptr;
9668 char *msg;
9669{
9670 xassert (png_ptr != NULL);
9671 image_error ("PNG warning: %s", build_string (msg), Qnil);
9672}
9673
9674
9675/* Memory source for PNG decoding. */
9676
9677struct png_memory_storage
9678{
9679 unsigned char *bytes; /* The data */
9680 size_t len; /* How big is it? */
9681 int index; /* Where are we? */
9682};
9683
9684
9685/* Function set as reader function when reading PNG image from memory.
9686 PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
9687 bytes from the input to DATA. */
9688
9689static void
9690png_read_from_memory (png_ptr, data, length)
9691 png_structp png_ptr;
9692 png_bytep data;
9693 png_size_t length;
9694{
9695 struct png_memory_storage *tbr
9696 = (struct png_memory_storage *) png_get_io_ptr (png_ptr);
9697
9698 if (length > tbr->len - tbr->index)
9699 png_error (png_ptr, "Read error");
9700
9701 bcopy (tbr->bytes + tbr->index, data, length);
9702 tbr->index = tbr->index + length;
9703}
9704
9705
9706/* Load PNG image IMG for use on frame F. Value is non-zero if
9707 successful. */
9708
9709static int
9710png_load (f, img)
9711 struct frame *f;
9712 struct image *img;
9713{
9714 Lisp_Object file, specified_file;
9715 Lisp_Object specified_data;
9716 int x, y, i;
9717 XImage *ximg, *mask_img = NULL;
9718 struct gcpro gcpro1;
9719 png_struct *png_ptr = NULL;
9720 png_info *info_ptr = NULL, *end_info = NULL;
9721 FILE *fp = NULL;
9722 png_byte sig[8];
9723 png_byte *pixels = NULL;
9724 png_byte **rows = NULL;
9725 png_uint_32 width, height;
9726 int bit_depth, color_type, interlace_type;
9727 png_byte channels;
9728 png_uint_32 row_bytes;
9729 int transparent_p;
9730 char *gamma_str;
9731 double screen_gamma, image_gamma;
9732 int intent;
9733 struct png_memory_storage tbr; /* Data to be read */
9734
9735 /* Find out what file to load. */
9736 specified_file = image_spec_value (img->spec, QCfile, NULL);
9737 specified_data = image_spec_value (img->spec, QCdata, NULL);
9738 file = Qnil;
9739 GCPRO1 (file);
9740
9741 if (NILP (specified_data))
9742 {
9743 file = x_find_image_file (specified_file);
9744 if (!STRINGP (file))
9745 {
9746 image_error ("Cannot find image file `%s'", specified_file, Qnil);
9747 UNGCPRO;
9748 return 0;
9749 }
9750
9751 /* Open the image file. */
9752 fp = fopen (XSTRING (file)->data, "rb");
9753 if (!fp)
9754 {
9755 image_error ("Cannot open image file `%s'", file, Qnil);
9756 UNGCPRO;
9757 fclose (fp);
9758 return 0;
9759 }
9760
9761 /* Check PNG signature. */
9762 if (fread (sig, 1, sizeof sig, fp) != sizeof sig
9763 || !png_check_sig (sig, sizeof sig))
9764 {
9765 image_error ("Not a PNG file:` %s'", file, Qnil);
9766 UNGCPRO;
9767 fclose (fp);
9768 return 0;
9769 }
9770 }
9771 else
9772 {
9773 /* Read from memory. */
9774 tbr.bytes = XSTRING (specified_data)->data;
9775 tbr.len = STRING_BYTES (XSTRING (specified_data));
9776 tbr.index = 0;
9777
9778 /* Check PNG signature. */
9779 if (tbr.len < sizeof sig
9780 || !png_check_sig (tbr.bytes, sizeof sig))
9781 {
9782 image_error ("Not a PNG image: `%s'", img->spec, Qnil);
9783 UNGCPRO;
9784 return 0;
9785 }
9786
9787 /* Need to skip past the signature. */
9788 tbr.bytes += sizeof (sig);
9789 }
9790
9791
9792 /* Initialize read and info structs for PNG lib. */
9793 png_ptr = png_create_read_struct (PNG_LIBPNG_VER_STRING, NULL,
9794 my_png_error, my_png_warning);
9795 if (!png_ptr)
9796 {
9797 if (fp) fclose (fp);
9798 UNGCPRO;
9799 return 0;
9800 }
9801
9802 info_ptr = png_create_info_struct (png_ptr);
9803 if (!info_ptr)
9804 {
9805 png_destroy_read_struct (&png_ptr, NULL, NULL);
9806 if (fp) fclose (fp);
9807 UNGCPRO;
9808 return 0;
9809 }
9810
9811 end_info = png_create_info_struct (png_ptr);
9812 if (!end_info)
9813 {
9814 png_destroy_read_struct (&png_ptr, &info_ptr, NULL);
9815 if (fp) fclose (fp);
9816 UNGCPRO;
9817 return 0;
9818 }
9819
9820 /* Set error jump-back. We come back here when the PNG library
9821 detects an error. */
9822 if (setjmp (png_ptr->jmpbuf))
9823 {
9824 error:
9825 if (png_ptr)
9826 png_destroy_read_struct (&png_ptr, &info_ptr, &end_info);
9827 xfree (pixels);
9828 xfree (rows);
9829 if (fp) fclose (fp);
9830 UNGCPRO;
9831 return 0;
9832 }
9833
9834 /* Read image info. */
9835 if (!NILP (specified_data))
9836 png_set_read_fn (png_ptr, (void *) &tbr, png_read_from_memory);
9837 else
9838 png_init_io (png_ptr, fp);
9839
9840 png_set_sig_bytes (png_ptr, sizeof sig);
9841 png_read_info (png_ptr, info_ptr);
9842 png_get_IHDR (png_ptr, info_ptr, &width, &height, &bit_depth, &color_type,
9843 &interlace_type, NULL, NULL);
9844
9845 /* If image contains simply transparency data, we prefer to
9846 construct a clipping mask. */
9847 if (png_get_valid (png_ptr, info_ptr, PNG_INFO_tRNS))
9848 transparent_p = 1;
9849 else
9850 transparent_p = 0;
9851
9852 /* This function is easier to write if we only have to handle
9853 one data format: RGB or RGBA with 8 bits per channel. Let's
9854 transform other formats into that format. */
9855
9856 /* Strip more than 8 bits per channel. */
9857 if (bit_depth == 16)
9858 png_set_strip_16 (png_ptr);
9859
9860 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
9861 if available. */
9862 png_set_expand (png_ptr);
9863
9864 /* Convert grayscale images to RGB. */
9865 if (color_type == PNG_COLOR_TYPE_GRAY
9866 || color_type == PNG_COLOR_TYPE_GRAY_ALPHA)
9867 png_set_gray_to_rgb (png_ptr);
9868
9869 /* The value 2.2 is a guess for PC monitors from PNG example.c. */
9870 gamma_str = getenv ("SCREEN_GAMMA");
9871 screen_gamma = gamma_str ? atof (gamma_str) : 2.2;
9872
9873 /* Tell the PNG lib to handle gamma correction for us. */
9874
9875#if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
9876 if (png_get_sRGB (png_ptr, info_ptr, &intent))
9877 /* There is a special chunk in the image specifying the gamma. */
9878 png_set_sRGB (png_ptr, info_ptr, intent);
9879 else
9880#endif
9881 if (png_get_gAMA (png_ptr, info_ptr, &image_gamma))
9882 /* Image contains gamma information. */
9883 png_set_gamma (png_ptr, screen_gamma, image_gamma);
9884 else
9885 /* Use a default of 0.5 for the image gamma. */
9886 png_set_gamma (png_ptr, screen_gamma, 0.5);
9887
9888 /* Handle alpha channel by combining the image with a background
9889 color. Do this only if a real alpha channel is supplied. For
9890 simple transparency, we prefer a clipping mask. */
9891 if (!transparent_p)
9892 {
9893 png_color_16 *image_background;
9894
9895 if (png_get_bKGD (png_ptr, info_ptr, &image_background))
9896 /* Image contains a background color with which to
9897 combine the image. */
9898 png_set_background (png_ptr, image_background,
9899 PNG_BACKGROUND_GAMMA_FILE, 1, 1.0);
9900 else
9901 {
9902 /* Image does not contain a background color with which
9903 to combine the image data via an alpha channel. Use
9904 the frame's background instead. */
9905 XColor color;
9906 Colormap cmap;
9907 png_color_16 frame_background;
9908
9909 BLOCK_INPUT;
9910 cmap = DefaultColormapOfScreen (FRAME_X_SCREEN (f));
9911 color.pixel = FRAME_BACKGROUND_PIXEL (f);
9912 XQueryColor (FRAME_W32_DISPLAY (f), cmap, &color);
9913 UNBLOCK_INPUT;
9914
9915 bzero (&frame_background, sizeof frame_background);
9916 frame_background.red = color.red;
9917 frame_background.green = color.green;
9918 frame_background.blue = color.blue;
9919
9920 png_set_background (png_ptr, &frame_background,
9921 PNG_BACKGROUND_GAMMA_SCREEN, 0, 1.0);
9922 }
9923 }
9924
9925 /* Update info structure. */
9926 png_read_update_info (png_ptr, info_ptr);
9927
9928 /* Get number of channels. Valid values are 1 for grayscale images
9929 and images with a palette, 2 for grayscale images with transparency
9930 information (alpha channel), 3 for RGB images, and 4 for RGB
9931 images with alpha channel, i.e. RGBA. If conversions above were
9932 sufficient we should only have 3 or 4 channels here. */
9933 channels = png_get_channels (png_ptr, info_ptr);
9934 xassert (channels == 3 || channels == 4);
9935
9936 /* Number of bytes needed for one row of the image. */
9937 row_bytes = png_get_rowbytes (png_ptr, info_ptr);
9938
9939 /* Allocate memory for the image. */
9940 pixels = (png_byte *) xmalloc (row_bytes * height * sizeof *pixels);
9941 rows = (png_byte **) xmalloc (height * sizeof *rows);
9942 for (i = 0; i < height; ++i)
9943 rows[i] = pixels + i * row_bytes;
9944
9945 /* Read the entire image. */
9946 png_read_image (png_ptr, rows);
9947 png_read_end (png_ptr, info_ptr);
9948 if (fp)
9949 {
9950 fclose (fp);
9951 fp = NULL;
9952 }
9953
9954 BLOCK_INPUT;
9955
9956 /* Create the X image and pixmap. */
9957 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg,
9958 &img->pixmap))
9959 {
9960 UNBLOCK_INPUT;
9961 goto error;
9962 }
9963
9964 /* Create an image and pixmap serving as mask if the PNG image
9965 contains an alpha channel. */
9966 if (channels == 4
9967 && !transparent_p
9968 && !x_create_x_image_and_pixmap (f, width, height, 1,
9969 &mask_img, &img->mask))
9970 {
9971 x_destroy_x_image (ximg);
9972 XFreePixmap (FRAME_W32_DISPLAY (f), img->pixmap);
9973 img->pixmap = 0;
9974 UNBLOCK_INPUT;
9975 goto error;
9976 }
9977
9978 /* Fill the X image and mask from PNG data. */
9979 init_color_table ();
9980
9981 for (y = 0; y < height; ++y)
9982 {
9983 png_byte *p = rows[y];
9984
9985 for (x = 0; x < width; ++x)
9986 {
9987 unsigned r, g, b;
9988
9989 r = *p++ << 8;
9990 g = *p++ << 8;
9991 b = *p++ << 8;
9992 XPutPixel (ximg, x, y, lookup_rgb_color (f, r, g, b));
9993
9994 /* An alpha channel, aka mask channel, associates variable
9995 transparency with an image. Where other image formats
9996 support binary transparency---fully transparent or fully
9997 opaque---PNG allows up to 254 levels of partial transparency.
9998 The PNG library implements partial transparency by combining
9999 the image with a specified background color.
10000
10001 I'm not sure how to handle this here nicely: because the
10002 background on which the image is displayed may change, for
10003 real alpha channel support, it would be necessary to create
10004 a new image for each possible background.
10005
10006 What I'm doing now is that a mask is created if we have
10007 boolean transparency information. Otherwise I'm using
10008 the frame's background color to combine the image with. */
10009
10010 if (channels == 4)
10011 {
10012 if (mask_img)
10013 XPutPixel (mask_img, x, y, *p > 0);
10014 ++p;
10015 }
10016 }
10017 }
10018
10019 /* Remember colors allocated for this image. */
10020 img->colors = colors_in_color_table (&img->ncolors);
10021 free_color_table ();
10022
10023 /* Clean up. */
10024 png_destroy_read_struct (&png_ptr, &info_ptr, &end_info);
10025 xfree (rows);
10026 xfree (pixels);
10027
10028 img->width = width;
10029 img->height = height;
10030
10031 /* Put the image into the pixmap, then free the X image and its buffer. */
10032 x_put_x_image (f, ximg, img->pixmap, width, height);
10033 x_destroy_x_image (ximg);
10034
10035 /* Same for the mask. */
10036 if (mask_img)
10037 {
10038 x_put_x_image (f, mask_img, img->mask, img->width, img->height);
10039 x_destroy_x_image (mask_img);
10040 }
10041
10042 UNBLOCK_INPUT;
10043 UNGCPRO;
10044 return 1;
10045}
10046
10047#endif /* HAVE_PNG != 0 */
10048
10049
10050
10051/***********************************************************************
10052 JPEG
10053 ***********************************************************************/
10054
10055#if HAVE_JPEG
10056
10057/* Work around a warning about HAVE_STDLIB_H being redefined in
10058 jconfig.h. */
10059#ifdef HAVE_STDLIB_H
10060#define HAVE_STDLIB_H_1
10061#undef HAVE_STDLIB_H
10062#endif /* HAVE_STLIB_H */
10063
10064#include <jpeglib.h>
10065#include <jerror.h>
10066#include <setjmp.h>
10067
10068#ifdef HAVE_STLIB_H_1
10069#define HAVE_STDLIB_H 1
10070#endif
10071
10072static int jpeg_image_p P_ ((Lisp_Object object));
10073static int jpeg_load P_ ((struct frame *f, struct image *img));
10074
10075/* The symbol `jpeg' identifying images of this type. */
10076
10077Lisp_Object Qjpeg;
10078
10079/* Indices of image specification fields in gs_format, below. */
10080
10081enum jpeg_keyword_index
10082{
10083 JPEG_TYPE,
10084 JPEG_DATA,
10085 JPEG_FILE,
10086 JPEG_ASCENT,
10087 JPEG_MARGIN,
10088 JPEG_RELIEF,
10089 JPEG_ALGORITHM,
10090 JPEG_HEURISTIC_MASK,
10091 JPEG_LAST
10092};
10093
10094/* Vector of image_keyword structures describing the format
10095 of valid user-defined image specifications. */
10096
10097static struct image_keyword jpeg_format[JPEG_LAST] =
10098{
10099 {":type", IMAGE_SYMBOL_VALUE, 1},
10100 {":data", IMAGE_STRING_VALUE, 0},
10101 {":file", IMAGE_STRING_VALUE, 0},
10102 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
10103 {":margin", IMAGE_POSITIVE_INTEGER_VALUE, 0},
10104 {":relief", IMAGE_INTEGER_VALUE, 0},
10105 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
10106 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
10107};
10108
10109/* Structure describing the image type `jpeg'. */
10110
10111static struct image_type jpeg_type =
10112{
10113 &Qjpeg,
10114 jpeg_image_p,
10115 jpeg_load,
10116 x_clear_image,
10117 NULL
10118};
10119
10120
10121/* Return non-zero if OBJECT is a valid JPEG image specification. */
10122
10123static int
10124jpeg_image_p (object)
10125 Lisp_Object object;
10126{
10127 struct image_keyword fmt[JPEG_LAST];
10128
10129 bcopy (jpeg_format, fmt, sizeof fmt);
10130
10131 if (!parse_image_spec (object, fmt, JPEG_LAST, Qjpeg)
10132 || (fmt[JPEG_ASCENT].count
10133 && XFASTINT (fmt[JPEG_ASCENT].value) > 100))
10134 return 0;
10135
10136 /* Must specify either the :data or :file keyword. */
10137 return fmt[JPEG_FILE].count + fmt[JPEG_DATA].count == 1;
10138}
10139
10140
10141struct my_jpeg_error_mgr
10142{
10143 struct jpeg_error_mgr pub;
10144 jmp_buf setjmp_buffer;
10145};
10146
10147static void
10148my_error_exit (cinfo)
10149 j_common_ptr cinfo;
10150{
10151 struct my_jpeg_error_mgr *mgr = (struct my_jpeg_error_mgr *) cinfo->err;
10152 longjmp (mgr->setjmp_buffer, 1);
10153}
10154
10155
10156/* Init source method for JPEG data source manager. Called by
10157 jpeg_read_header() before any data is actually read. See
10158 libjpeg.doc from the JPEG lib distribution. */
10159
10160static void
10161our_init_source (cinfo)
10162 j_decompress_ptr cinfo;
10163{
10164}
10165
10166
10167/* Fill input buffer method for JPEG data source manager. Called
10168 whenever more data is needed. We read the whole image in one step,
10169 so this only adds a fake end of input marker at the end. */
10170
10171static boolean
10172our_fill_input_buffer (cinfo)
10173 j_decompress_ptr cinfo;
10174{
10175 /* Insert a fake EOI marker. */
10176 struct jpeg_source_mgr *src = cinfo->src;
10177 static JOCTET buffer[2];
10178
10179 buffer[0] = (JOCTET) 0xFF;
10180 buffer[1] = (JOCTET) JPEG_EOI;
10181
10182 src->next_input_byte = buffer;
10183 src->bytes_in_buffer = 2;
10184 return TRUE;
10185}
10186
10187
10188/* Method to skip over NUM_BYTES bytes in the image data. CINFO->src
10189 is the JPEG data source manager. */
10190
10191static void
10192our_skip_input_data (cinfo, num_bytes)
10193 j_decompress_ptr cinfo;
10194 long num_bytes;
10195{
10196 struct jpeg_source_mgr *src = (struct jpeg_source_mgr *) cinfo->src;
10197
10198 if (src)
10199 {
10200 if (num_bytes > src->bytes_in_buffer)
10201 ERREXIT (cinfo, JERR_INPUT_EOF);
10202
10203 src->bytes_in_buffer -= num_bytes;
10204 src->next_input_byte += num_bytes;
10205 }
10206}
10207
10208
10209/* Method to terminate data source. Called by
10210 jpeg_finish_decompress() after all data has been processed. */
10211
10212static void
10213our_term_source (cinfo)
10214 j_decompress_ptr cinfo;
10215{
10216}
10217
10218
10219/* Set up the JPEG lib for reading an image from DATA which contains
10220 LEN bytes. CINFO is the decompression info structure created for
10221 reading the image. */
10222
10223static void
10224jpeg_memory_src (cinfo, data, len)
10225 j_decompress_ptr cinfo;
10226 JOCTET *data;
10227 unsigned int len;
10228{
10229 struct jpeg_source_mgr *src;
10230
10231 if (cinfo->src == NULL)
10232 {
10233 /* First time for this JPEG object? */
10234 cinfo->src = (struct jpeg_source_mgr *)
10235 (*cinfo->mem->alloc_small) ((j_common_ptr) cinfo, JPOOL_PERMANENT,
10236 sizeof (struct jpeg_source_mgr));
10237 src = (struct jpeg_source_mgr *) cinfo->src;
10238 src->next_input_byte = data;
10239 }
10240
10241 src = (struct jpeg_source_mgr *) cinfo->src;
10242 src->init_source = our_init_source;
10243 src->fill_input_buffer = our_fill_input_buffer;
10244 src->skip_input_data = our_skip_input_data;
10245 src->resync_to_restart = jpeg_resync_to_restart; /* Use default method. */
10246 src->term_source = our_term_source;
10247 src->bytes_in_buffer = len;
10248 src->next_input_byte = data;
10249}
10250
10251
10252/* Load image IMG for use on frame F. Patterned after example.c
10253 from the JPEG lib. */
10254
10255static int
10256jpeg_load (f, img)
10257 struct frame *f;
10258 struct image *img;
10259{
10260 struct jpeg_decompress_struct cinfo;
10261 struct my_jpeg_error_mgr mgr;
10262 Lisp_Object file, specified_file;
10263 Lisp_Object specified_data;
10264 FILE *fp = NULL;
10265 JSAMPARRAY buffer;
10266 int row_stride, x, y;
10267 XImage *ximg = NULL;
10268 int rc;
10269 unsigned long *colors;
10270 int width, height;
10271 struct gcpro gcpro1;
10272
10273 /* Open the JPEG file. */
10274 specified_file = image_spec_value (img->spec, QCfile, NULL);
10275 specified_data = image_spec_value (img->spec, QCdata, NULL);
10276 file = Qnil;
10277 GCPRO1 (file);
10278
10279
10280 if (NILP (specified_data))
10281 {
10282 file = x_find_image_file (specified_file);
10283 if (!STRINGP (file))
10284 {
10285 image_error ("Cannot find image file `%s'", specified_file, Qnil);
10286 UNGCPRO;
10287 return 0;
10288 }
10289
10290 fp = fopen (XSTRING (file)->data, "r");
10291 if (fp == NULL)
10292 {
10293 image_error ("Cannot open `%s'", file, Qnil);
10294 UNGCPRO;
10295 return 0;
10296 }
10297 }
10298
10299 /* Customize libjpeg's error handling to call my_error_exit when an
10300 error is detected. This function will perform a longjmp. */
10301 mgr.pub.error_exit = my_error_exit;
10302 cinfo.err = jpeg_std_error (&mgr.pub);
10303
10304 if ((rc = setjmp (mgr.setjmp_buffer)) != 0)
10305 {
10306 if (rc == 1)
10307 {
10308 /* Called from my_error_exit. Display a JPEG error. */
10309 char buffer[JMSG_LENGTH_MAX];
10310 cinfo.err->format_message ((j_common_ptr) &cinfo, buffer);
10311 image_error ("Error reading JPEG image `%s': %s", img->spec,
10312 build_string (buffer));
10313 }
10314
10315 /* Close the input file and destroy the JPEG object. */
10316 if (fp)
10317 fclose (fp);
10318 jpeg_destroy_decompress (&cinfo);
10319
10320 BLOCK_INPUT;
10321
10322 /* If we already have an XImage, free that. */
10323 x_destroy_x_image (ximg);
10324
10325 /* Free pixmap and colors. */
10326 x_clear_image (f, img);
10327
10328 UNBLOCK_INPUT;
10329 UNGCPRO;
10330 return 0;
10331 }
10332
10333 /* Create the JPEG decompression object. Let it read from fp.
10334 Read the JPEG image header. */
10335 jpeg_create_decompress (&cinfo);
10336
10337 if (NILP (specified_data))
10338 jpeg_stdio_src (&cinfo, fp);
10339 else
10340 jpeg_memory_src (&cinfo, XSTRING (specified_data)->data,
10341 STRING_BYTES (XSTRING (specified_data)));
10342
10343 jpeg_read_header (&cinfo, TRUE);
10344
10345 /* Customize decompression so that color quantization will be used.
10346 Start decompression. */
10347 cinfo.quantize_colors = TRUE;
10348 jpeg_start_decompress (&cinfo);
10349 width = img->width = cinfo.output_width;
10350 height = img->height = cinfo.output_height;
10351
10352 BLOCK_INPUT;
10353
10354 /* Create X image and pixmap. */
10355 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg,
10356 &img->pixmap))
10357 {
10358 UNBLOCK_INPUT;
10359 longjmp (mgr.setjmp_buffer, 2);
10360 }
10361
10362 /* Allocate colors. When color quantization is used,
10363 cinfo.actual_number_of_colors has been set with the number of
10364 colors generated, and cinfo.colormap is a two-dimensional array
10365 of color indices in the range 0..cinfo.actual_number_of_colors.
10366 No more than 255 colors will be generated. */
10367 {
10368 int i, ir, ig, ib;
10369
10370 if (cinfo.out_color_components > 2)
10371 ir = 0, ig = 1, ib = 2;
10372 else if (cinfo.out_color_components > 1)
10373 ir = 0, ig = 1, ib = 0;
10374 else
10375 ir = 0, ig = 0, ib = 0;
10376
10377 /* Use the color table mechanism because it handles colors that
10378 cannot be allocated nicely. Such colors will be replaced with
10379 a default color, and we don't have to care about which colors
10380 can be freed safely, and which can't. */
10381 init_color_table ();
10382 colors = (unsigned long *) alloca (cinfo.actual_number_of_colors
10383 * sizeof *colors);
10384
10385 for (i = 0; i < cinfo.actual_number_of_colors; ++i)
10386 {
10387 /* Multiply RGB values with 255 because X expects RGB values
10388 in the range 0..0xffff. */
10389 int r = cinfo.colormap[ir][i] << 8;
10390 int g = cinfo.colormap[ig][i] << 8;
10391 int b = cinfo.colormap[ib][i] << 8;
10392 colors[i] = lookup_rgb_color (f, r, g, b);
10393 }
10394
10395 /* Remember those colors actually allocated. */
10396 img->colors = colors_in_color_table (&img->ncolors);
10397 free_color_table ();
10398 }
10399
10400 /* Read pixels. */
10401 row_stride = width * cinfo.output_components;
10402 buffer = cinfo.mem->alloc_sarray ((j_common_ptr) &cinfo, JPOOL_IMAGE,
10403 row_stride, 1);
10404 for (y = 0; y < height; ++y)
10405 {
10406 jpeg_read_scanlines (&cinfo, buffer, 1);
10407 for (x = 0; x < cinfo.output_width; ++x)
10408 XPutPixel (ximg, x, y, colors[buffer[0][x]]);
10409 }
10410
10411 /* Clean up. */
10412 jpeg_finish_decompress (&cinfo);
10413 jpeg_destroy_decompress (&cinfo);
10414 if (fp)
10415 fclose (fp);
10416
10417 /* Put the image into the pixmap. */
10418 x_put_x_image (f, ximg, img->pixmap, width, height);
10419 x_destroy_x_image (ximg);
10420 UNBLOCK_INPUT;
10421 UNGCPRO;
10422 return 1;
10423}
10424
10425#endif /* HAVE_JPEG */
10426
10427
10428
10429/***********************************************************************
10430 TIFF
10431 ***********************************************************************/
10432
10433#if HAVE_TIFF
10434
10435#include <tiffio.h>
10436
10437static int tiff_image_p P_ ((Lisp_Object object));
10438static int tiff_load P_ ((struct frame *f, struct image *img));
10439
10440/* The symbol `tiff' identifying images of this type. */
10441
10442Lisp_Object Qtiff;
10443
10444/* Indices of image specification fields in tiff_format, below. */
10445
10446enum tiff_keyword_index
10447{
10448 TIFF_TYPE,
10449 TIFF_DATA,
10450 TIFF_FILE,
10451 TIFF_ASCENT,
10452 TIFF_MARGIN,
10453 TIFF_RELIEF,
10454 TIFF_ALGORITHM,
10455 TIFF_HEURISTIC_MASK,
10456 TIFF_LAST
10457};
10458
10459/* Vector of image_keyword structures describing the format
10460 of valid user-defined image specifications. */
10461
10462static struct image_keyword tiff_format[TIFF_LAST] =
10463{
10464 {":type", IMAGE_SYMBOL_VALUE, 1},
10465 {":data", IMAGE_STRING_VALUE, 0},
10466 {":file", IMAGE_STRING_VALUE, 0},
10467 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
10468 {":margin", IMAGE_POSITIVE_INTEGER_VALUE, 0},
10469 {":relief", IMAGE_INTEGER_VALUE, 0},
10470 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
10471 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
10472};
10473
10474/* Structure describing the image type `tiff'. */
10475
10476static struct image_type tiff_type =
10477{
10478 &Qtiff,
10479 tiff_image_p,
10480 tiff_load,
10481 x_clear_image,
10482 NULL
10483};
10484
10485
10486/* Return non-zero if OBJECT is a valid TIFF image specification. */
10487
10488static int
10489tiff_image_p (object)
10490 Lisp_Object object;
10491{
10492 struct image_keyword fmt[TIFF_LAST];
10493 bcopy (tiff_format, fmt, sizeof fmt);
10494
10495 if (!parse_image_spec (object, fmt, TIFF_LAST, Qtiff)
10496 || (fmt[TIFF_ASCENT].count
10497 && XFASTINT (fmt[TIFF_ASCENT].value) > 100))
10498 return 0;
10499
10500 /* Must specify either the :data or :file keyword. */
10501 return fmt[TIFF_FILE].count + fmt[TIFF_DATA].count == 1;
10502}
10503
10504
10505/* Reading from a memory buffer for TIFF images Based on the PNG
10506 memory source, but we have to provide a lot of extra functions.
10507 Blah.
10508
10509 We really only need to implement read and seek, but I am not
10510 convinced that the TIFF library is smart enough not to destroy
10511 itself if we only hand it the function pointers we need to
10512 override. */
10513
10514typedef struct
10515{
10516 unsigned char *bytes;
10517 size_t len;
10518 int index;
10519}
10520tiff_memory_source;
10521
10522static size_t
10523tiff_read_from_memory (data, buf, size)
10524 thandle_t data;
10525 tdata_t buf;
10526 tsize_t size;
10527{
10528 tiff_memory_source *src = (tiff_memory_source *) data;
10529
10530 if (size > src->len - src->index)
10531 return (size_t) -1;
10532 bcopy (src->bytes + src->index, buf, size);
10533 src->index += size;
10534 return size;
10535}
10536
10537static size_t
10538tiff_write_from_memory (data, buf, size)
10539 thandle_t data;
10540 tdata_t buf;
10541 tsize_t size;
10542{
10543 return (size_t) -1;
10544}
10545
10546static toff_t
10547tiff_seek_in_memory (data, off, whence)
10548 thandle_t data;
10549 toff_t off;
10550 int whence;
10551{
10552 tiff_memory_source *src = (tiff_memory_source *) data;
10553 int idx;
10554
10555 switch (whence)
10556 {
10557 case SEEK_SET: /* Go from beginning of source. */
10558 idx = off;
10559 break;
10560
10561 case SEEK_END: /* Go from end of source. */
10562 idx = src->len + off;
10563 break;
10564
10565 case SEEK_CUR: /* Go from current position. */
10566 idx = src->index + off;
10567 break;
10568
10569 default: /* Invalid `whence'. */
10570 return -1;
10571 }
10572
10573 if (idx > src->len || idx < 0)
10574 return -1;
10575
10576 src->index = idx;
10577 return src->index;
10578}
10579
10580static int
10581tiff_close_memory (data)
10582 thandle_t data;
10583{
10584 /* NOOP */
10585 return 0;
10586}
10587
10588static int
10589tiff_mmap_memory (data, pbase, psize)
10590 thandle_t data;
10591 tdata_t *pbase;
10592 toff_t *psize;
10593{
10594 /* It is already _IN_ memory. */
10595 return 0;
10596}
10597
10598static void
10599tiff_unmap_memory (data, base, size)
10600 thandle_t data;
10601 tdata_t base;
10602 toff_t size;
10603{
10604 /* We don't need to do this. */
10605}
10606
10607static toff_t
10608tiff_size_of_memory (data)
10609 thandle_t data;
10610{
10611 return ((tiff_memory_source *) data)->len;
10612}
10613
10614
10615/* Load TIFF image IMG for use on frame F. Value is non-zero if
10616 successful. */
10617
10618static int
10619tiff_load (f, img)
10620 struct frame *f;
10621 struct image *img;
10622{
10623 Lisp_Object file, specified_file;
10624 Lisp_Object specified_data;
10625 TIFF *tiff;
10626 int width, height, x, y;
10627 uint32 *buf;
10628 int rc;
10629 XImage *ximg;
10630 struct gcpro gcpro1;
10631 tiff_memory_source memsrc;
10632
10633 specified_file = image_spec_value (img->spec, QCfile, NULL);
10634 specified_data = image_spec_value (img->spec, QCdata, NULL);
10635 file = Qnil;
10636 GCPRO1 (file);
10637
10638 if (NILP (specified_data))
10639 {
10640 /* Read from a file */
10641 file = x_find_image_file (specified_file);
10642 if (!STRINGP (file))
10643 {
10644 image_error ("Cannot find image file `%s'", file, Qnil);
10645 UNGCPRO;
10646 return 0;
10647 }
10648
10649 /* Try to open the image file. */
10650 tiff = TIFFOpen (XSTRING (file)->data, "r");
10651 if (tiff == NULL)
10652 {
10653 image_error ("Cannot open `%s'", file, Qnil);
10654 UNGCPRO;
10655 return 0;
10656 }
10657 }
10658 else
10659 {
10660 /* Memory source! */
10661 memsrc.bytes = XSTRING (specified_data)->data;
10662 memsrc.len = STRING_BYTES (XSTRING (specified_data));
10663 memsrc.index = 0;
10664
10665 tiff = TIFFClientOpen ("memory_source", "r", &memsrc,
10666 (TIFFReadWriteProc) tiff_read_from_memory,
10667 (TIFFReadWriteProc) tiff_write_from_memory,
10668 tiff_seek_in_memory,
10669 tiff_close_memory,
10670 tiff_size_of_memory,
10671 tiff_mmap_memory,
10672 tiff_unmap_memory);
10673
10674 if (!tiff)
10675 {
10676 image_error ("Cannot open memory source for `%s'", img->spec, Qnil);
10677 UNGCPRO;
10678 return 0;
10679 }
10680 }
10681
10682 /* Get width and height of the image, and allocate a raster buffer
10683 of width x height 32-bit values. */
10684 TIFFGetField (tiff, TIFFTAG_IMAGEWIDTH, &width);
10685 TIFFGetField (tiff, TIFFTAG_IMAGELENGTH, &height);
10686 buf = (uint32 *) xmalloc (width * height * sizeof *buf);
10687
10688 rc = TIFFReadRGBAImage (tiff, width, height, buf, 0);
10689 TIFFClose (tiff);
10690 if (!rc)
10691 {
10692 image_error ("Error reading TIFF image `%s'", img->spec, Qnil);
10693 xfree (buf);
10694 UNGCPRO;
10695 return 0;
10696 }
10697
10698 BLOCK_INPUT;
10699
10700 /* Create the X image and pixmap. */
10701 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg, &img->pixmap))
10702 {
10703 UNBLOCK_INPUT;
10704 xfree (buf);
10705 UNGCPRO;
10706 return 0;
10707 }
10708
10709 /* Initialize the color table. */
10710 init_color_table ();
10711
10712 /* Process the pixel raster. Origin is in the lower-left corner. */
10713 for (y = 0; y < height; ++y)
10714 {
10715 uint32 *row = buf + y * width;
10716
10717 for (x = 0; x < width; ++x)
10718 {
10719 uint32 abgr = row[x];
10720 int r = TIFFGetR (abgr) << 8;
10721 int g = TIFFGetG (abgr) << 8;
10722 int b = TIFFGetB (abgr) << 8;
10723 XPutPixel (ximg, x, height - 1 - y, lookup_rgb_color (f, r, g, b));
10724 }
10725 }
10726
10727 /* Remember the colors allocated for the image. Free the color table. */
10728 img->colors = colors_in_color_table (&img->ncolors);
10729 free_color_table ();
10730
10731 /* Put the image into the pixmap, then free the X image and its buffer. */
10732 x_put_x_image (f, ximg, img->pixmap, width, height);
10733 x_destroy_x_image (ximg);
10734 xfree (buf);
10735 UNBLOCK_INPUT;
10736
10737 img->width = width;
10738 img->height = height;
10739
10740 UNGCPRO;
10741 return 1;
10742}
10743
10744#endif /* HAVE_TIFF != 0 */
10745
10746
10747
10748/***********************************************************************
10749 GIF
10750 ***********************************************************************/
10751
10752#if HAVE_GIF
10753
10754#include <gif_lib.h>
10755
10756static int gif_image_p P_ ((Lisp_Object object));
10757static int gif_load P_ ((struct frame *f, struct image *img));
10758
10759/* The symbol `gif' identifying images of this type. */
10760
10761Lisp_Object Qgif;
10762
10763/* Indices of image specification fields in gif_format, below. */
10764
10765enum gif_keyword_index
10766{
10767 GIF_TYPE,
10768 GIF_DATA,
10769 GIF_FILE,
10770 GIF_ASCENT,
10771 GIF_MARGIN,
10772 GIF_RELIEF,
10773 GIF_ALGORITHM,
10774 GIF_HEURISTIC_MASK,
10775 GIF_IMAGE,
10776 GIF_LAST
10777};
10778
10779/* Vector of image_keyword structures describing the format
10780 of valid user-defined image specifications. */
10781
10782static struct image_keyword gif_format[GIF_LAST] =
10783{
10784 {":type", IMAGE_SYMBOL_VALUE, 1},
10785 {":data", IMAGE_STRING_VALUE, 0},
10786 {":file", IMAGE_STRING_VALUE, 0},
10787 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
10788 {":margin", IMAGE_POSITIVE_INTEGER_VALUE, 0},
10789 {":relief", IMAGE_INTEGER_VALUE, 0},
10790 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
10791 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
10792 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0}
10793};
10794
10795/* Structure describing the image type `gif'. */
10796
10797static struct image_type gif_type =
10798{
10799 &Qgif,
10800 gif_image_p,
10801 gif_load,
10802 x_clear_image,
10803 NULL
10804};
10805
10806/* Return non-zero if OBJECT is a valid GIF image specification. */
10807
10808static int
10809gif_image_p (object)
10810 Lisp_Object object;
10811{
10812 struct image_keyword fmt[GIF_LAST];
10813 bcopy (gif_format, fmt, sizeof fmt);
10814
10815 if (!parse_image_spec (object, fmt, GIF_LAST, Qgif)
10816 || (fmt[GIF_ASCENT].count
10817 && XFASTINT (fmt[GIF_ASCENT].value) > 100))
10818 return 0;
10819
10820 /* Must specify either the :data or :file keyword. */
10821 return fmt[GIF_FILE].count + fmt[GIF_DATA].count == 1;
10822}
10823
10824/* Reading a GIF image from memory
10825 Based on the PNG memory stuff to a certain extent. */
10826
10827typedef struct
10828{
10829 unsigned char *bytes;
10830 size_t len;
10831 int index;
10832}
10833gif_memory_source;
10834
10835/* Make the current memory source available to gif_read_from_memory.
10836 It's done this way because not all versions of libungif support
10837 a UserData field in the GifFileType structure. */
10838static gif_memory_source *current_gif_memory_src;
10839
10840static int
10841gif_read_from_memory (file, buf, len)
10842 GifFileType *file;
10843 GifByteType *buf;
10844 int len;
10845{
10846 gif_memory_source *src = current_gif_memory_src;
10847
10848 if (len > src->len - src->index)
10849 return -1;
10850
10851 bcopy (src->bytes + src->index, buf, len);
10852 src->index += len;
10853 return len;
10854}
10855
10856
10857/* Load GIF image IMG for use on frame F. Value is non-zero if
10858 successful. */
10859
10860static int
10861gif_load (f, img)
10862 struct frame *f;
10863 struct image *img;
10864{
10865 Lisp_Object file, specified_file;
10866 Lisp_Object specified_data;
10867 int rc, width, height, x, y, i;
10868 XImage *ximg;
10869 ColorMapObject *gif_color_map;
10870 unsigned long pixel_colors[256];
10871 GifFileType *gif;
10872 struct gcpro gcpro1;
10873 Lisp_Object image;
10874 int ino, image_left, image_top, image_width, image_height;
10875 gif_memory_source memsrc;
10876 unsigned char *raster;
10877
10878 specified_file = image_spec_value (img->spec, QCfile, NULL);
10879 specified_data = image_spec_value (img->spec, QCdata, NULL);
10880 file = Qnil;
10881
10882 if (NILP (specified_data))
10883 {
10884 file = x_find_image_file (specified_file);
10885 GCPRO1 (file);
10886 if (!STRINGP (file))
10887 {
10888 image_error ("Cannot find image file `%s'", specified_file, Qnil);
10889 UNGCPRO;
10890 return 0;
10891 }
10892
10893 /* Open the GIF file. */
10894 gif = DGifOpenFileName (XSTRING (file)->data);
10895 if (gif == NULL)
10896 {
10897 image_error ("Cannot open `%s'", file, Qnil);
10898 UNGCPRO;
10899 return 0;
10900 }
10901 }
10902 else
10903 {
10904 /* Read from memory! */
10905 current_gif_memory_src = &memsrc;
10906 memsrc.bytes = XSTRING (specified_data)->data;
10907 memsrc.len = STRING_BYTES (XSTRING (specified_data));
10908 memsrc.index = 0;
10909
10910 gif = DGifOpen(&memsrc, gif_read_from_memory);
10911 if (!gif)
10912 {
10913 image_error ("Cannot open memory source `%s'", img->spec, Qnil);
10914 UNGCPRO;
10915 return 0;
10916 }
10917 }
10918
10919 /* Read entire contents. */
10920 rc = DGifSlurp (gif);
10921 if (rc == GIF_ERROR)
10922 {
10923 image_error ("Error reading `%s'", img->spec, Qnil);
10924 DGifCloseFile (gif);
10925 UNGCPRO;
10926 return 0;
10927 }
10928
10929 image = image_spec_value (img->spec, QCindex, NULL);
10930 ino = INTEGERP (image) ? XFASTINT (image) : 0;
10931 if (ino >= gif->ImageCount)
10932 {
10933 image_error ("Invalid image number `%s' in image `%s'",
10934 image, img->spec);
10935 DGifCloseFile (gif);
10936 UNGCPRO;
10937 return 0;
10938 }
10939
10940 width = img->width = gif->SWidth;
10941 height = img->height = gif->SHeight;
10942
10943 BLOCK_INPUT;
10944
10945 /* Create the X image and pixmap. */
10946 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg, &img->pixmap))
10947 {
10948 UNBLOCK_INPUT;
10949 DGifCloseFile (gif);
10950 UNGCPRO;
10951 return 0;
10952 }
10953
10954 /* Allocate colors. */
10955 gif_color_map = gif->SavedImages[ino].ImageDesc.ColorMap;
10956 if (!gif_color_map)
10957 gif_color_map = gif->SColorMap;
10958 init_color_table ();
10959 bzero (pixel_colors, sizeof pixel_colors);
10960
10961 for (i = 0; i < gif_color_map->ColorCount; ++i)
10962 {
10963 int r = gif_color_map->Colors[i].Red << 8;
10964 int g = gif_color_map->Colors[i].Green << 8;
10965 int b = gif_color_map->Colors[i].Blue << 8;
10966 pixel_colors[i] = lookup_rgb_color (f, r, g, b);
10967 }
10968
10969 img->colors = colors_in_color_table (&img->ncolors);
10970 free_color_table ();
10971
10972 /* Clear the part of the screen image that are not covered by
10973 the image from the GIF file. Full animated GIF support
10974 requires more than can be done here (see the gif89 spec,
10975 disposal methods). Let's simply assume that the part
10976 not covered by a sub-image is in the frame's background color. */
10977 image_top = gif->SavedImages[ino].ImageDesc.Top;
10978 image_left = gif->SavedImages[ino].ImageDesc.Left;
10979 image_width = gif->SavedImages[ino].ImageDesc.Width;
10980 image_height = gif->SavedImages[ino].ImageDesc.Height;
10981
10982 for (y = 0; y < image_top; ++y)
10983 for (x = 0; x < width; ++x)
10984 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
10985
10986 for (y = image_top + image_height; y < height; ++y)
10987 for (x = 0; x < width; ++x)
10988 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
10989
10990 for (y = image_top; y < image_top + image_height; ++y)
10991 {
10992 for (x = 0; x < image_left; ++x)
10993 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
10994 for (x = image_left + image_width; x < width; ++x)
10995 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
10996 }
10997
10998 /* Read the GIF image into the X image. We use a local variable
10999 `raster' here because RasterBits below is a char *, and invites
11000 problems with bytes >= 0x80. */
11001 raster = (unsigned char *) gif->SavedImages[ino].RasterBits;
11002
11003 if (gif->SavedImages[ino].ImageDesc.Interlace)
11004 {
11005 static int interlace_start[] = {0, 4, 2, 1};
11006 static int interlace_increment[] = {8, 8, 4, 2};
11007 int pass, inc;
11008 int row = interlace_start[0];
11009
11010 pass = 0;
11011
11012 for (y = 0; y < image_height; y++)
11013 {
11014 if (row >= image_height)
11015 {
11016 row = interlace_start[++pass];
11017 while (row >= image_height)
11018 row = interlace_start[++pass];
11019 }
11020
11021 for (x = 0; x < image_width; x++)
11022 {
11023 int i = raster[(y * image_width) + x];
11024 XPutPixel (ximg, x + image_left, row + image_top,
11025 pixel_colors[i]);
11026 }
11027
11028 row += interlace_increment[pass];
11029 }
11030 }
11031 else
11032 {
11033 for (y = 0; y < image_height; ++y)
11034 for (x = 0; x < image_width; ++x)
11035 {
11036 int i = raster[y* image_width + x];
11037 XPutPixel (ximg, x + image_left, y + image_top, pixel_colors[i]);
11038 }
11039 }
11040
11041 DGifCloseFile (gif);
11042
11043 /* Put the image into the pixmap, then free the X image and its buffer. */
11044 x_put_x_image (f, ximg, img->pixmap, width, height);
11045 x_destroy_x_image (ximg);
11046 UNBLOCK_INPUT;
11047
11048 UNGCPRO;
11049 return 1;
11050}
11051
11052#endif /* HAVE_GIF != 0 */
11053
11054
11055
11056/***********************************************************************
11057 Ghostscript
11058 ***********************************************************************/
11059
11060#ifdef HAVE_GHOSTSCRIPT
11061static int gs_image_p P_ ((Lisp_Object object));
11062static int gs_load P_ ((struct frame *f, struct image *img));
11063static void gs_clear_image P_ ((struct frame *f, struct image *img));
11064
11065/* The symbol `postscript' identifying images of this type. */
11066
11067Lisp_Object Qpostscript;
11068
11069/* Keyword symbols. */
11070
11071Lisp_Object QCloader, QCbounding_box, QCpt_width, QCpt_height;
11072
11073/* Indices of image specification fields in gs_format, below. */
11074
11075enum gs_keyword_index
11076{
11077 GS_TYPE,
11078 GS_PT_WIDTH,
11079 GS_PT_HEIGHT,
11080 GS_FILE,
11081 GS_LOADER,
11082 GS_BOUNDING_BOX,
11083 GS_ASCENT,
11084 GS_MARGIN,
11085 GS_RELIEF,
11086 GS_ALGORITHM,
11087 GS_HEURISTIC_MASK,
11088 GS_LAST
11089};
11090
11091/* Vector of image_keyword structures describing the format
11092 of valid user-defined image specifications. */
11093
11094static struct image_keyword gs_format[GS_LAST] =
11095{
11096 {":type", IMAGE_SYMBOL_VALUE, 1},
11097 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE, 1},
11098 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE, 1},
11099 {":file", IMAGE_STRING_VALUE, 1},
11100 {":loader", IMAGE_FUNCTION_VALUE, 0},
11101 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE, 1},
11102 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
11103 {":margin", IMAGE_POSITIVE_INTEGER_VALUE, 0},
11104 {":relief", IMAGE_INTEGER_VALUE, 0},
11105 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
11106 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
11107};
11108
11109/* Structure describing the image type `ghostscript'. */
11110
11111static struct image_type gs_type =
11112{
11113 &Qpostscript,
11114 gs_image_p,
11115 gs_load,
11116 gs_clear_image,
11117 NULL
11118};
11119
11120
11121/* Free X resources of Ghostscript image IMG which is used on frame F. */
11122
11123static void
11124gs_clear_image (f, img)
11125 struct frame *f;
11126 struct image *img;
11127{
11128 /* IMG->data.ptr_val may contain a recorded colormap. */
11129 xfree (img->data.ptr_val);
11130 x_clear_image (f, img);
11131}
11132
11133
11134/* Return non-zero if OBJECT is a valid Ghostscript image
11135 specification. */
11136
11137static int
11138gs_image_p (object)
11139 Lisp_Object object;
11140{
11141 struct image_keyword fmt[GS_LAST];
11142 Lisp_Object tem;
11143 int i;
11144
11145 bcopy (gs_format, fmt, sizeof fmt);
11146
11147 if (!parse_image_spec (object, fmt, GS_LAST, Qpostscript)
11148 || (fmt[GS_ASCENT].count
11149 && XFASTINT (fmt[GS_ASCENT].value) > 100))
11150 return 0;
11151
11152 /* Bounding box must be a list or vector containing 4 integers. */
11153 tem = fmt[GS_BOUNDING_BOX].value;
11154 if (CONSP (tem))
11155 {
11156 for (i = 0; i < 4; ++i, tem = XCDR (tem))
11157 if (!CONSP (tem) || !INTEGERP (XCAR (tem)))
11158 return 0;
11159 if (!NILP (tem))
11160 return 0;
11161 }
11162 else if (VECTORP (tem))
11163 {
11164 if (XVECTOR (tem)->size != 4)
11165 return 0;
11166 for (i = 0; i < 4; ++i)
11167 if (!INTEGERP (XVECTOR (tem)->contents[i]))
11168 return 0;
11169 }
11170 else
11171 return 0;
11172
11173 return 1;
11174}
11175
11176
11177/* Load Ghostscript image IMG for use on frame F. Value is non-zero
11178 if successful. */
11179
11180static int
11181gs_load (f, img)
11182 struct frame *f;
11183 struct image *img;
11184{
11185 char buffer[100];
11186 Lisp_Object window_and_pixmap_id = Qnil, loader, pt_height, pt_width;
11187 struct gcpro gcpro1, gcpro2;
11188 Lisp_Object frame;
11189 double in_width, in_height;
11190 Lisp_Object pixel_colors = Qnil;
11191
11192 /* Compute pixel size of pixmap needed from the given size in the
11193 image specification. Sizes in the specification are in pt. 1 pt
11194 = 1/72 in, xdpi and ydpi are stored in the frame's X display
11195 info. */
11196 pt_width = image_spec_value (img->spec, QCpt_width, NULL);
11197 in_width = XFASTINT (pt_width) / 72.0;
11198 img->width = in_width * FRAME_W32_DISPLAY_INFO (f)->resx;
11199 pt_height = image_spec_value (img->spec, QCpt_height, NULL);
11200 in_height = XFASTINT (pt_height) / 72.0;
11201 img->height = in_height * FRAME_W32_DISPLAY_INFO (f)->resy;
11202
11203 /* Create the pixmap. */
11204 BLOCK_INPUT;
11205 xassert (img->pixmap == 0);
11206 img->pixmap = XCreatePixmap (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
11207 img->width, img->height,
11208 DefaultDepthOfScreen (FRAME_X_SCREEN (f)));
11209 UNBLOCK_INPUT;
11210
11211 if (!img->pixmap)
11212 {
11213 image_error ("Unable to create pixmap for `%s'", img->spec, Qnil);
11214 return 0;
11215 }
11216
11217 /* Call the loader to fill the pixmap. It returns a process object
11218 if successful. We do not record_unwind_protect here because
11219 other places in redisplay like calling window scroll functions
11220 don't either. Let the Lisp loader use `unwind-protect' instead. */
11221 GCPRO2 (window_and_pixmap_id, pixel_colors);
11222
11223 sprintf (buffer, "%lu %lu",
11224 (unsigned long) FRAME_W32_WINDOW (f),
11225 (unsigned long) img->pixmap);
11226 window_and_pixmap_id = build_string (buffer);
11227
11228 sprintf (buffer, "%lu %lu",
11229 FRAME_FOREGROUND_PIXEL (f),
11230 FRAME_BACKGROUND_PIXEL (f));
11231 pixel_colors = build_string (buffer);
11232
11233 XSETFRAME (frame, f);
11234 loader = image_spec_value (img->spec, QCloader, NULL);
11235 if (NILP (loader))
11236 loader = intern ("gs-load-image");
11237
11238 img->data.lisp_val = call6 (loader, frame, img->spec,
11239 make_number (img->width),
11240 make_number (img->height),
11241 window_and_pixmap_id,
11242 pixel_colors);
11243 UNGCPRO;
11244 return PROCESSP (img->data.lisp_val);
11245}
11246
11247
11248/* Kill the Ghostscript process that was started to fill PIXMAP on
11249 frame F. Called from XTread_socket when receiving an event
11250 telling Emacs that Ghostscript has finished drawing. */
11251
11252void
11253x_kill_gs_process (pixmap, f)
11254 Pixmap pixmap;
11255 struct frame *f;
11256{
11257 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
11258 int class, i;
11259 struct image *img;
11260
11261 /* Find the image containing PIXMAP. */
11262 for (i = 0; i < c->used; ++i)
11263 if (c->images[i]->pixmap == pixmap)
11264 break;
11265
11266 /* Kill the GS process. We should have found PIXMAP in the image
11267 cache and its image should contain a process object. */
11268 xassert (i < c->used);
11269 img = c->images[i];
11270 xassert (PROCESSP (img->data.lisp_val));
11271 Fkill_process (img->data.lisp_val, Qnil);
11272 img->data.lisp_val = Qnil;
11273
11274 /* On displays with a mutable colormap, figure out the colors
11275 allocated for the image by looking at the pixels of an XImage for
11276 img->pixmap. */
11277 class = FRAME_W32_DISPLAY_INFO (f)->visual->class;
11278 if (class != StaticColor && class != StaticGray && class != TrueColor)
11279 {
11280 XImage *ximg;
11281
11282 BLOCK_INPUT;
11283
11284 /* Try to get an XImage for img->pixmep. */
11285 ximg = XGetImage (FRAME_W32_DISPLAY (f), img->pixmap,
11286 0, 0, img->width, img->height, ~0, ZPixmap);
11287 if (ximg)
11288 {
11289 int x, y;
11290
11291 /* Initialize the color table. */
11292 init_color_table ();
11293
11294 /* For each pixel of the image, look its color up in the
11295 color table. After having done so, the color table will
11296 contain an entry for each color used by the image. */
11297 for (y = 0; y < img->height; ++y)
11298 for (x = 0; x < img->width; ++x)
11299 {
11300 unsigned long pixel = XGetPixel (ximg, x, y);
11301 lookup_pixel_color (f, pixel);
11302 }
11303
11304 /* Record colors in the image. Free color table and XImage. */
11305 img->colors = colors_in_color_table (&img->ncolors);
11306 free_color_table ();
11307 XDestroyImage (ximg);
11308
11309#if 0 /* This doesn't seem to be the case. If we free the colors
11310 here, we get a BadAccess later in x_clear_image when
11311 freeing the colors. */
11312 /* We have allocated colors once, but Ghostscript has also
11313 allocated colors on behalf of us. So, to get the
11314 reference counts right, free them once. */
11315 if (img->ncolors)
11316 {
11317 Colormap cmap = DefaultColormapOfScreen (FRAME_X_SCREEN (f));
11318 XFreeColors (FRAME_W32_DISPLAY (f), cmap,
11319 img->colors, img->ncolors, 0);
11320 }
11321#endif
11322 }
11323 else
11324 image_error ("Cannot get X image of `%s'; colors will not be freed",
11325 img->spec, Qnil);
11326
11327 UNBLOCK_INPUT;
11328 }
11329}
11330
11331#endif /* HAVE_GHOSTSCRIPT */
11332
11333
11334/***********************************************************************
11335 Window properties
11336 ***********************************************************************/
11337
11338DEFUN ("x-change-window-property", Fx_change_window_property,
11339 Sx_change_window_property, 2, 3, 0,
11340 "Change window property PROP to VALUE on the X window of FRAME.\n\
11341PROP and VALUE must be strings. FRAME nil or omitted means use the\n\
11342selected frame. Value is VALUE.")
11343 (prop, value, frame)
11344 Lisp_Object frame, prop, value;
11345{
11346#if 0 /* NTEMACS_TODO : port window properties to W32 */
11347 struct frame *f = check_x_frame (frame);
11348 Atom prop_atom;
11349
11350 CHECK_STRING (prop, 1);
11351 CHECK_STRING (value, 2);
11352
11353 BLOCK_INPUT;
11354 prop_atom = XInternAtom (FRAME_W32_DISPLAY (f), XSTRING (prop)->data, False);
11355 XChangeProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
11356 prop_atom, XA_STRING, 8, PropModeReplace,
11357 XSTRING (value)->data, XSTRING (value)->size);
11358
11359 /* Make sure the property is set when we return. */
11360 XFlush (FRAME_W32_DISPLAY (f));
11361 UNBLOCK_INPUT;
11362
11363#endif /* NTEMACS_TODO */
11364
11365 return value;
11366}
11367
11368
11369DEFUN ("x-delete-window-property", Fx_delete_window_property,
11370 Sx_delete_window_property, 1, 2, 0,
11371 "Remove window property PROP from X window of FRAME.\n\
11372FRAME nil or omitted means use the selected frame. Value is PROP.")
11373 (prop, frame)
11374 Lisp_Object prop, frame;
11375{
11376#if 0 /* NTEMACS_TODO : port window properties to W32 */
11377
11378 struct frame *f = check_x_frame (frame);
11379 Atom prop_atom;
11380
11381 CHECK_STRING (prop, 1);
11382 BLOCK_INPUT;
11383 prop_atom = XInternAtom (FRAME_W32_DISPLAY (f), XSTRING (prop)->data, False);
11384 XDeleteProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f), prop_atom);
11385
11386 /* Make sure the property is removed when we return. */
11387 XFlush (FRAME_W32_DISPLAY (f));
11388 UNBLOCK_INPUT;
11389#endif /* NTEMACS_TODO */
11390
11391 return prop;
11392}
11393
11394
11395DEFUN ("x-window-property", Fx_window_property, Sx_window_property,
11396 1, 2, 0,
11397 "Value is the value of window property PROP on FRAME.\n\
11398If FRAME is nil or omitted, use the selected frame. Value is nil\n\
11399if FRAME hasn't a property with name PROP or if PROP has no string\n\
11400value.")
11401 (prop, frame)
11402 Lisp_Object prop, frame;
11403{
11404#if 0 /* NTEMACS_TODO : port window properties to W32 */
11405
11406 struct frame *f = check_x_frame (frame);
11407 Atom prop_atom;
11408 int rc;
11409 Lisp_Object prop_value = Qnil;
11410 char *tmp_data = NULL;
11411 Atom actual_type;
11412 int actual_format;
11413 unsigned long actual_size, bytes_remaining;
11414
11415 CHECK_STRING (prop, 1);
11416 BLOCK_INPUT;
11417 prop_atom = XInternAtom (FRAME_W32_DISPLAY (f), XSTRING (prop)->data, False);
11418 rc = XGetWindowProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
11419 prop_atom, 0, 0, False, XA_STRING,
11420 &actual_type, &actual_format, &actual_size,
11421 &bytes_remaining, (unsigned char **) &tmp_data);
11422 if (rc == Success)
11423 {
11424 int size = bytes_remaining;
11425
11426 XFree (tmp_data);
11427 tmp_data = NULL;
11428
11429 rc = XGetWindowProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
11430 prop_atom, 0, bytes_remaining,
11431 False, XA_STRING,
11432 &actual_type, &actual_format,
11433 &actual_size, &bytes_remaining,
11434 (unsigned char **) &tmp_data);
11435 if (rc == Success)
11436 prop_value = make_string (tmp_data, size);
11437
11438 XFree (tmp_data);
11439 }
11440
11441 UNBLOCK_INPUT;
11442
11443 return prop_value;
11444
11445#endif /* NTEMACS_TODO */
11446 return Qnil;
11447}
11448
11449
11450
11451/***********************************************************************
11452 Busy cursor
11453 ***********************************************************************/
11454
11455/* The implementation partly follows a patch from
11456 F.Pierresteguy@frcl.bull.fr dated 1994. */
11457
11458/* Setting inhibit_busy_cursor to 2 inhibits busy-cursor display until
11459 the next X event is read and we enter XTread_socket again. Setting
11460 it to 1 inhibits busy-cursor display for direct commands. */
11461
11462int inhibit_busy_cursor;
11463
11464/* Incremented with each call to x-display-busy-cursor.
11465 Decremented in x-undisplay-busy-cursor. */
11466
11467static int busy_count;
11468
11469
11470DEFUN ("x-show-busy-cursor", Fx_show_busy_cursor,
11471 Sx_show_busy_cursor, 0, 0, 0,
11472 "Show a busy cursor, if not already shown.\n\
11473Each call to this function must be matched by a call to\n\
11474x-undisplay-busy-cursor to make the busy pointer disappear again.")
11475 ()
11476{
11477 ++busy_count;
11478 if (busy_count == 1)
11479 {
11480 Lisp_Object rest, frame;
11481
11482 FOR_EACH_FRAME (rest, frame)
11483 if (FRAME_X_P (XFRAME (frame)))
11484 {
11485 struct frame *f = XFRAME (frame);
11486#if 0 /* NTEMACS_TODO : busy cursor */
11487
11488 BLOCK_INPUT;
11489 f->output_data.w32->busy_p = 1;
11490
11491 if (!f->output_data.w32->busy_window)
11492 {
11493 unsigned long mask = CWCursor;
11494 XSetWindowAttributes attrs;
11495
11496 attrs.cursor = f->output_data.w32->busy_cursor;
11497 f->output_data.w32->busy_window
11498 = XCreateWindow (FRAME_W32_DISPLAY (f),
11499 FRAME_OUTER_WINDOW (f),
11500 0, 0, 32000, 32000, 0, 0,
11501 InputOnly, CopyFromParent,
11502 mask, &attrs);
11503 }
11504
11505 XMapRaised (FRAME_W32_DISPLAY (f), f->output_data.w32->busy_window);
11506 UNBLOCK_INPUT;
11507#endif
11508 }
11509 }
11510
11511 return Qnil;
11512}
11513
11514
11515DEFUN ("x-hide-busy-cursor", Fx_hide_busy_cursor,
11516 Sx_hide_busy_cursor, 0, 1, 0,
11517 "Hide a busy-cursor.\n\
11518A busy-cursor will actually be undisplayed when a matching\n\
11519`x-undisplay-busy-cursor' is called for each `x-display-busy-cursor'\n\
11520issued. FORCE non-nil means undisplay the busy-cursor forcibly,\n\
11521not counting calls.")
11522 (force)
11523 Lisp_Object force;
11524{
11525 Lisp_Object rest, frame;
11526
11527 if (busy_count == 0)
11528 return Qnil;
11529
11530 if (!NILP (force) && busy_count != 0)
11531 busy_count = 1;
11532
11533 --busy_count;
11534 if (busy_count != 0)
11535 return Qnil;
11536
11537 FOR_EACH_FRAME (rest, frame)
11538 {
11539 struct frame *f = XFRAME (frame);
11540
11541 if (FRAME_X_P (f)
11542 /* Watch out for newly created frames. */
11543 && f->output_data.w32->busy_window)
11544 {
11545#if 0 /* NTEMACS_TODO : busy cursor */
11546 BLOCK_INPUT;
11547 XUnmapWindow (FRAME_W32_DISPLAY (f), f->output_data.w32->busy_window);
11548 /* Sync here because XTread_socket looks at the busy_p flag
11549 that is reset to zero below. */
11550 XSync (FRAME_W32_DISPLAY (f), False);
11551 UNBLOCK_INPUT;
11552 f->output_data.w32->busy_p = 0;
11553#endif
11554 }
11555 }
11556
11557 return Qnil;
11558}
11559
11560
11561
11562/***********************************************************************
11563 Tool tips
11564 ***********************************************************************/
11565
11566static Lisp_Object x_create_tip_frame P_ ((struct w32_display_info *,
11567 Lisp_Object));
11568
11569/* The frame of a currently visible tooltip, or null. */
11570
11571struct frame *tip_frame;
11572
11573/* If non-nil, a timer started that hides the last tooltip when it
11574 fires. */
11575
11576Lisp_Object tip_timer;
11577Window tip_window;
11578
11579/* Create a frame for a tooltip on the display described by DPYINFO.
11580 PARMS is a list of frame parameters. Value is the frame. */
11581
11582static Lisp_Object
11583x_create_tip_frame (dpyinfo, parms)
11584 struct w32_display_info *dpyinfo;
11585 Lisp_Object parms;
11586{
11587#if 0 /* NTEMACS_TODO : w32 version */
11588 struct frame *f;
11589 Lisp_Object frame, tem;
11590 Lisp_Object name;
11591 long window_prompting = 0;
11592 int width, height;
11593 int count = specpdl_ptr - specpdl;
11594 struct gcpro gcpro1, gcpro2, gcpro3;
11595 struct kboard *kb;
11596
11597 check_x ();
11598
11599 /* Use this general default value to start with until we know if
11600 this frame has a specified name. */
11601 Vx_resource_name = Vinvocation_name;
11602
11603#ifdef MULTI_KBOARD
11604 kb = dpyinfo->kboard;
11605#else
11606 kb = &the_only_kboard;
11607#endif
11608
11609 /* Get the name of the frame to use for resource lookup. */
11610 name = w32_get_arg (parms, Qname, "name", "Name", RES_TYPE_STRING);
11611 if (!STRINGP (name)
11612 && !EQ (name, Qunbound)
11613 && !NILP (name))
11614 error ("Invalid frame name--not a string or nil");
11615 Vx_resource_name = name;
11616
11617 frame = Qnil;
11618 GCPRO3 (parms, name, frame);
11619 tip_frame = f = make_frame (1);
11620 XSETFRAME (frame, f);
11621 FRAME_CAN_HAVE_SCROLL_BARS (f) = 0;
11622
11623 f->output_method = output_x_window;
11624 f->output_data.w32 =
11625 (struct w32_output *) xmalloc (sizeof (struct w32_output));
11626 bzero (f->output_data.w32, sizeof (struct w32_output));
11627#if 0
11628 f->output_data.w32->icon_bitmap = -1;
11629#endif
11630 f->output_data.w32->fontset = -1;
11631 f->icon_name = Qnil;
11632
11633#ifdef MULTI_KBOARD
11634 FRAME_KBOARD (f) = kb;
11635#endif
11636 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
11637 f->output_data.w32->explicit_parent = 0;
11638
11639 /* Set the name; the functions to which we pass f expect the name to
11640 be set. */
11641 if (EQ (name, Qunbound) || NILP (name))
11642 {
11643 f->name = build_string (dpyinfo->x_id_name);
11644 f->explicit_name = 0;
11645 }
11646 else
11647 {
11648 f->name = name;
11649 f->explicit_name = 1;
11650 /* use the frame's title when getting resources for this frame. */
11651 specbind (Qx_resource_name, name);
11652 }
11653
11654 /* Create fontsets from `global_fontset_alist' before handling fonts. */
11655 for (tem = Vglobal_fontset_alist; CONSP (tem); tem = XCDR (tem))
11656 fs_register_fontset (f, XCAR (tem));
11657
11658 /* Extract the window parameters from the supplied values
11659 that are needed to determine window geometry. */
11660 {
11661 Lisp_Object font;
11662
11663 font = w32_get_arg (parms, Qfont, "font", "Font", RES_TYPE_STRING);
11664
11665 BLOCK_INPUT;
11666 /* First, try whatever font the caller has specified. */
11667 if (STRINGP (font))
11668 {
11669 tem = Fquery_fontset (font, Qnil);
11670 if (STRINGP (tem))
11671 font = x_new_fontset (f, XSTRING (tem)->data);
11672 else
11673 font = x_new_font (f, XSTRING (font)->data);
11674 }
11675
11676 /* Try out a font which we hope has bold and italic variations. */
11677 if (!STRINGP (font))
11678 font = x_new_font (f, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
11679 if (!STRINGP (font))
11680 font = x_new_font (f, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
11681 if (! STRINGP (font))
11682 font = x_new_font (f, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
11683 if (! STRINGP (font))
11684 /* This was formerly the first thing tried, but it finds too many fonts
11685 and takes too long. */
11686 font = x_new_font (f, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
11687 /* If those didn't work, look for something which will at least work. */
11688 if (! STRINGP (font))
11689 font = x_new_font (f, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
11690 UNBLOCK_INPUT;
11691 if (! STRINGP (font))
11692 font = build_string ("fixed");
11693
11694 x_default_parameter (f, parms, Qfont, font,
11695 "font", "Font", RES_TYPE_STRING);
11696 }
11697
11698 x_default_parameter (f, parms, Qborder_width, make_number (2),
11699 "borderWidth", "BorderWidth", RES_TYPE_NUMBER);
11700
11701 /* This defaults to 2 in order to match xterm. We recognize either
11702 internalBorderWidth or internalBorder (which is what xterm calls
11703 it). */
11704 if (NILP (Fassq (Qinternal_border_width, parms)))
11705 {
11706 Lisp_Object value;
11707
11708 value = w32_get_arg (parms, Qinternal_border_width,
11709 "internalBorder", "internalBorder", RES_TYPE_NUMBER);
11710 if (! EQ (value, Qunbound))
11711 parms = Fcons (Fcons (Qinternal_border_width, value),
11712 parms);
11713 }
11714
11715 x_default_parameter (f, parms, Qinternal_border_width, make_number (1),
11716 "internalBorderWidth", "internalBorderWidth",
11717 RES_TYPE_NUMBER);
11718
11719 /* Also do the stuff which must be set before the window exists. */
11720 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
11721 "foreground", "Foreground", RES_TYPE_STRING);
11722 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
11723 "background", "Background", RES_TYPE_STRING);
11724 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
11725 "pointerColor", "Foreground", RES_TYPE_STRING);
11726 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
11727 "cursorColor", "Foreground", RES_TYPE_STRING);
11728 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
11729 "borderColor", "BorderColor", RES_TYPE_STRING);
11730
11731 /* Init faces before x_default_parameter is called for scroll-bar
11732 parameters because that function calls x_set_scroll_bar_width,
11733 which calls change_frame_size, which calls Fset_window_buffer,
11734 which runs hooks, which call Fvertical_motion. At the end, we
11735 end up in init_iterator with a null face cache, which should not
11736 happen. */
11737 init_frame_faces (f);
11738
11739 f->output_data.w32->parent_desc = FRAME_W32_DISPLAY_INFO (f)->root_window;
11740 window_prompting = x_figure_window_size (f, parms);
11741
11742 if (window_prompting & XNegative)
11743 {
11744 if (window_prompting & YNegative)
11745 f->output_data.w32->win_gravity = SouthEastGravity;
11746 else
11747 f->output_data.w32->win_gravity = NorthEastGravity;
11748 }
11749 else
11750 {
11751 if (window_prompting & YNegative)
11752 f->output_data.w32->win_gravity = SouthWestGravity;
11753 else
11754 f->output_data.w32->win_gravity = NorthWestGravity;
11755 }
11756
11757 f->output_data.w32->size_hint_flags = window_prompting;
11758 {
11759 XSetWindowAttributes attrs;
11760 unsigned long mask;
11761
11762 BLOCK_INPUT;
11763 mask = CWBackPixel | CWOverrideRedirect | CWSaveUnder | CWEventMask;
11764 /* Window managers looks at the override-redirect flag to
11765 determine whether or net to give windows a decoration (Xlib
11766 3.2.8). */
11767 attrs.override_redirect = True;
11768 attrs.save_under = True;
11769 attrs.background_pixel = FRAME_BACKGROUND_PIXEL (f);
11770 /* Arrange for getting MapNotify and UnmapNotify events. */
11771 attrs.event_mask = StructureNotifyMask;
11772 tip_window
11773 = FRAME_W32_WINDOW (f)
11774 = XCreateWindow (FRAME_W32_DISPLAY (f),
11775 FRAME_W32_DISPLAY_INFO (f)->root_window,
11776 /* x, y, width, height */
11777 0, 0, 1, 1,
11778 /* Border. */
11779 1,
11780 CopyFromParent, InputOutput, CopyFromParent,
11781 mask, &attrs);
11782 UNBLOCK_INPUT;
11783 }
11784
11785 x_make_gc (f);
11786
11787 x_default_parameter (f, parms, Qauto_raise, Qnil,
11788 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
11789 x_default_parameter (f, parms, Qauto_lower, Qnil,
11790 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
11791 x_default_parameter (f, parms, Qcursor_type, Qbox,
11792 "cursorType", "CursorType", RES_TYPE_SYMBOL);
11793
11794 /* Dimensions, especially f->height, must be done via change_frame_size.
11795 Change will not be effected unless different from the current
11796 f->height. */
11797 width = f->width;
11798 height = f->height;
11799 f->height = 0;
11800 SET_FRAME_WIDTH (f, 0);
11801 change_frame_size (f, height, width, 1, 0, 0);
11802
11803 f->no_split = 1;
11804
11805 UNGCPRO;
11806
11807 /* It is now ok to make the frame official even if we get an error
11808 below. And the frame needs to be on Vframe_list or making it
11809 visible won't work. */
11810 Vframe_list = Fcons (frame, Vframe_list);
11811
11812 /* Now that the frame is official, it counts as a reference to
11813 its display. */
11814 FRAME_W32_DISPLAY_INFO (f)->reference_count++;
11815
11816 return unbind_to (count, frame);
11817#endif /* NTEMACS_TODO */
11818 return Qnil;
11819}
11820
11821
11822DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 4, 0,
11823 "Show STRING in a \"tooltip\" window on frame FRAME.\n\
11824A tooltip window is a small X window displaying STRING at\n\
11825the current mouse position.\n\
11826FRAME nil or omitted means use the selected frame.\n\
11827PARMS is an optional list of frame parameters which can be\n\
11828used to change the tooltip's appearance.\n\
11829Automatically hide the tooltip after TIMEOUT seconds.\n\
11830TIMEOUT nil means use the default timeout of 5 seconds.")
11831 (string, frame, parms, timeout)
11832 Lisp_Object string, frame, parms, timeout;
11833{
11834 struct frame *f;
11835 struct window *w;
11836 Window root, child;
11837 Lisp_Object buffer;
11838 struct buffer *old_buffer;
11839 struct text_pos pos;
11840 int i, width, height;
11841 int root_x, root_y, win_x, win_y;
11842 unsigned pmask;
11843 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
11844 int old_windows_or_buffers_changed = windows_or_buffers_changed;
11845 int count = specpdl_ptr - specpdl;
11846
11847 specbind (Qinhibit_redisplay, Qt);
11848
11849 GCPRO3 (string, parms, frame, timeout);
11850
11851 CHECK_STRING (string, 0);
11852 f = check_x_frame (frame);
11853 if (NILP (timeout))
11854 timeout = make_number (5);
11855 else
11856 CHECK_NATNUM (timeout, 2);
11857
11858 /* Hide a previous tip, if any. */
11859 Fx_hide_tip ();
11860
11861 /* Add default values to frame parameters. */
11862 if (NILP (Fassq (Qname, parms)))
11863 parms = Fcons (Fcons (Qname, build_string ("tooltip")), parms);
11864 if (NILP (Fassq (Qinternal_border_width, parms)))
11865 parms = Fcons (Fcons (Qinternal_border_width, make_number (3)), parms);
11866 if (NILP (Fassq (Qborder_width, parms)))
11867 parms = Fcons (Fcons (Qborder_width, make_number (1)), parms);
11868 if (NILP (Fassq (Qborder_color, parms)))
11869 parms = Fcons (Fcons (Qborder_color, build_string ("lightyellow")), parms);
11870 if (NILP (Fassq (Qbackground_color, parms)))
11871 parms = Fcons (Fcons (Qbackground_color, build_string ("lightyellow")),
11872 parms);
11873
11874 /* Create a frame for the tooltip, and record it in the global
11875 variable tip_frame. */
11876 frame = x_create_tip_frame (FRAME_W32_DISPLAY_INFO (f), parms);
11877 tip_frame = f = XFRAME (frame);
11878
11879 /* Set up the frame's root window. Currently we use a size of 80
11880 columns x 40 lines. If someone wants to show a larger tip, he
11881 will loose. I don't think this is a realistic case. */
11882 w = XWINDOW (FRAME_ROOT_WINDOW (f));
11883 w->left = w->top = make_number (0);
11884 w->width = 80;
11885 w->height = 40;
11886 adjust_glyphs (f);
11887 w->pseudo_window_p = 1;
11888
11889 /* Display the tooltip text in a temporary buffer. */
11890 buffer = Fget_buffer_create (build_string (" *tip*"));
11891 Fset_window_buffer (FRAME_ROOT_WINDOW (f), buffer);
11892 old_buffer = current_buffer;
11893 set_buffer_internal_1 (XBUFFER (buffer));
11894 Ferase_buffer ();
11895 Finsert (make_number (1), &string);
11896 clear_glyph_matrix (w->desired_matrix);
11897 clear_glyph_matrix (w->current_matrix);
11898 SET_TEXT_POS (pos, BEGV, BEGV_BYTE);
11899 try_window (FRAME_ROOT_WINDOW (f), pos);
11900
11901 /* Compute width and height of the tooltip. */
11902 width = height = 0;
11903 for (i = 0; i < w->desired_matrix->nrows; ++i)
11904 {
11905 struct glyph_row *row = &w->desired_matrix->rows[i];
11906 struct glyph *last;
11907 int row_width;
11908
11909 /* Stop at the first empty row at the end. */
11910 if (!row->enabled_p || !row->displays_text_p)
11911 break;
11912
11913 /* Let the row go over the full width of the frame. */
11914 row->full_width_p = 1;
11915
11916 /* There's a glyph at the end of rows that is use to place
11917 the cursor there. Don't include the width of this glyph. */
11918 if (row->used[TEXT_AREA])
11919 {
11920 last = &row->glyphs[TEXT_AREA][row->used[TEXT_AREA] - 1];
11921 row_width = row->pixel_width - last->pixel_width;
11922 }
11923 else
11924 row_width = row->pixel_width;
11925
11926 height += row->height;
11927 width = max (width, row_width);
11928 }
11929
11930 /* Add the frame's internal border to the width and height the X
11931 window should have. */
11932 height += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
11933 width += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
11934
11935 /* Move the tooltip window where the mouse pointer is. Resize and
11936 show it. */
11937#if 0 /* NTEMACS_TODO : W32 specifics */
11938 BLOCK_INPUT;
11939 XQueryPointer (FRAME_W32_DISPLAY (f), FRAME_W32_DISPLAY_INFO (f)->root_window,
11940 &root, &child, &root_x, &root_y, &win_x, &win_y, &pmask);
11941 XMoveResizeWindow (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f),
11942 root_x + 5, root_y - height - 5, width, height);
11943 XMapRaised (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f));
11944 UNBLOCK_INPUT;
11945#endif /* NTEMACS_TODO */
11946
11947 /* Draw into the window. */
11948 w->must_be_updated_p = 1;
11949 update_single_window (w, 1);
11950
11951 /* Restore original current buffer. */
11952 set_buffer_internal_1 (old_buffer);
11953 windows_or_buffers_changed = old_windows_or_buffers_changed;
11954
11955 /* Let the tip disappear after timeout seconds. */
11956 tip_timer = call3 (intern ("run-at-time"), timeout, Qnil,
11957 intern ("x-hide-tip"));
11958 UNGCPRO;
11959
11960 return unbind_to (count, Qnil);
11961}
11962
11963
11964DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0,
11965 "Hide the current tooltip window, if there is any.\n\
11966Value is t is tooltip was open, nil otherwise.")
11967 ()
11968{
11969 int count = specpdl_ptr - specpdl;
11970 int deleted_p = 0;
11971
11972 specbind (Qinhibit_redisplay, Qt);
11973
11974 if (!NILP (tip_timer))
11975 {
11976 call1 (intern ("cancel-timer"), tip_timer);
11977 tip_timer = Qnil;
11978 }
11979
11980 if (tip_frame)
11981 {
11982 Lisp_Object frame;
11983
11984 XSETFRAME (frame, tip_frame);
11985 Fdelete_frame (frame, Qt);
11986 tip_frame = NULL;
11987 deleted_p = 1;
11988 }
11989
11990 return unbind_to (count, deleted_p ? Qt : Qnil);
11991}
11992
11993
11994
11995/***********************************************************************
11996 File selection dialog
11997 ***********************************************************************/
11998
11999extern Lisp_Object Qfile_name_history;
12000
12001DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 4, 0,
12002 "Read file name, prompting with PROMPT in directory DIR.\n\
12003Use a file selection dialog.\n\
12004Select DEFAULT-FILENAME in the dialog's file selection box, if\n\
12005specified. Don't let the user enter a file name in the file\n\
12006selection dialog's entry field, if MUSTMATCH is non-nil.")
12007 (prompt, dir, default_filename, mustmatch)
12008 Lisp_Object prompt, dir, default_filename, mustmatch;
12009{
12010 struct frame *f = SELECTED_FRAME ();
12011 Lisp_Object file = Qnil;
12012 int count = specpdl_ptr - specpdl;
12013 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
12014 char filename[MAX_PATH + 1];
12015 char init_dir[MAX_PATH + 1];
12016 int use_dialog_p = 1;
12017
12018 GCPRO5 (prompt, dir, default_filename, mustmatch, file);
12019 CHECK_STRING (prompt, 0);
12020 CHECK_STRING (dir, 1);
12021
12022 /* Create the dialog with PROMPT as title, using DIR as initial
12023 directory and using "*" as pattern. */
12024 dir = Fexpand_file_name (dir, Qnil);
12025 strncpy (init_dir, XSTRING (dir)->data, MAX_PATH);
12026 init_dir[MAX_PATH] = '\0';
12027 unixtodos_filename (init_dir);
12028
12029 if (STRINGP (default_filename))
12030 {
12031 char *file_name_only;
12032 char *full_path_name = XSTRING (default_filename)->data;
12033
12034 unixtodos_filename (full_path_name);
12035
12036 file_name_only = strrchr (full_path_name, '\\');
12037 if (!file_name_only)
12038 file_name_only = full_path_name;
12039 else
12040 {
12041 file_name_only++;
12042
12043 /* If default_file_name is a directory, don't use the open
12044 file dialog, as it does not support selecting
12045 directories. */
12046 if (!(*file_name_only))
12047 use_dialog_p = 0;
12048 }
12049
12050 strncpy (filename, file_name_only, MAX_PATH);
12051 filename[MAX_PATH] = '\0';
12052 }
12053 else
12054 filename[0] = '\0';
12055
12056 if (use_dialog_p)
12057 {
12058 OPENFILENAME file_details;
12059 char *filename_file;
12060
12061 /* Prevent redisplay. */
12062 specbind (Qinhibit_redisplay, Qt);
12063 BLOCK_INPUT;
12064
12065 bzero (&file_details, sizeof (file_details));
12066 file_details.lStructSize = sizeof (file_details);
12067 file_details.hwndOwner = FRAME_W32_WINDOW (f);
12068 file_details.lpstrFile = filename;
12069 file_details.nMaxFile = sizeof (filename);
12070 file_details.lpstrInitialDir = init_dir;
12071 file_details.lpstrTitle = XSTRING (prompt)->data;
12072 file_details.Flags = OFN_HIDEREADONLY | OFN_NOCHANGEDIR;
12073
12074 if (!NILP (mustmatch))
12075 file_details.Flags |= OFN_FILEMUSTEXIST | OFN_PATHMUSTEXIST;
12076
12077 if (GetOpenFileName (&file_details))
12078 {
12079 dostounix_filename (filename);
12080 file = build_string (filename);
12081 }
12082 else
12083 file = Qnil;
12084
12085 UNBLOCK_INPUT;
12086 file = unbind_to (count, file);
12087 }
12088 /* Open File dialog will not allow folders to be selected, so resort
12089 to minibuffer completing reads for directories. */
12090 else
12091 file = Fcompleting_read (prompt, intern ("read-file-name-internal"),
12092 dir, mustmatch, dir, Qfile_name_history,
12093 default_filename, Qnil);
12094
12095 UNGCPRO;
12096
12097 /* Make "Cancel" equivalent to C-g. */
12098 if (NILP (file))
12099 Fsignal (Qquit, Qnil);
12100
12101 return file;
12102}
12103
12104
12105
12106/***********************************************************************
12107 Tests
12108 ***********************************************************************/
12109
12110#if GLYPH_DEBUG
12111
12112DEFUN ("imagep", Fimagep, Simagep, 1, 1, 0,
12113 "Value is non-nil if SPEC is a valid image specification.")
12114 (spec)
12115 Lisp_Object spec;
12116{
12117 return valid_image_p (spec) ? Qt : Qnil;
12118}
12119
12120
12121DEFUN ("lookup-image", Flookup_image, Slookup_image, 1, 1, 0, "")
12122 (spec)
12123 Lisp_Object spec;
12124{
12125 int id = -1;
12126
12127 if (valid_image_p (spec))
12128 id = lookup_image (SELECTED_FRAME (), spec);
12129
12130 debug_print (spec);
12131 return make_number (id);
12132}
12133
12134#endif /* GLYPH_DEBUG != 0 */
12135
12136
12137
12138/***********************************************************************
12139 w32 specialized functions
12140 ***********************************************************************/
6969 12141
6970DEFUN ("w32-select-font", Fw32_select_font, Sw32_select_font, 0, 1, 0, 12142DEFUN ("w32-select-font", Fw32_select_font, Sw32_select_font, 0, 1, 0,
6971 "This will display the W32 font dialog and return an X font string corresponding to the selection.") 12143 "This will display the W32 font dialog and return an X font string corresponding to the selection.")
@@ -6985,7 +12157,7 @@ DEFUN ("w32-select-font", Fw32_select_font, Sw32_select_font, 0, 1, 0,
6985 12157
6986 cf.lStructSize = sizeof (cf); 12158 cf.lStructSize = sizeof (cf);
6987 cf.hwndOwner = FRAME_W32_WINDOW (f); 12159 cf.hwndOwner = FRAME_W32_WINDOW (f);
6988 cf.Flags = CF_FIXEDPITCHONLY | CF_FORCEFONTEXIST | CF_SCREENFONTS; 12160 cf.Flags = CF_FORCEFONTEXIST | CF_SCREENFONTS;
6989 cf.lpLogFont = &lf; 12161 cf.lpLogFont = &lf;
6990 12162
6991 /* Initialize as much of the font details as we can from the current 12163 /* Initialize as much of the font details as we can from the current
@@ -7000,12 +12172,11 @@ DEFUN ("w32-select-font", Fw32_select_font, Sw32_select_font, 0, 1, 0,
7000 lf.lfItalic = tm.tmItalic; 12172 lf.lfItalic = tm.tmItalic;
7001 lf.lfUnderline = tm.tmUnderlined; 12173 lf.lfUnderline = tm.tmUnderlined;
7002 lf.lfStrikeOut = tm.tmStruckOut; 12174 lf.lfStrikeOut = tm.tmStruckOut;
7003 lf.lfPitchAndFamily = tm.tmPitchAndFamily;
7004 lf.lfCharSet = tm.tmCharSet; 12175 lf.lfCharSet = tm.tmCharSet;
7005 cf.Flags |= CF_INITTOLOGFONTSTRUCT; 12176 cf.Flags |= CF_INITTOLOGFONTSTRUCT;
7006 } 12177 }
7007 SelectObject (hdc, oldobj); 12178 SelectObject (hdc, oldobj);
7008 ReleaseDC (FRAME_W32_WINDOW(f), hdc); 12179 ReleaseDC (FRAME_W32_WINDOW (f), hdc);
7009 12180
7010 if (!ChooseFont (&cf) || !w32_to_x_font (&lf, buf, 100)) 12181 if (!ChooseFont (&cf) || !w32_to_x_font (&lf, buf, 100))
7011 return Qnil; 12182 return Qnil;
@@ -7038,15 +12209,16 @@ DEFUN ("w32-shell-execute", Fw32_shell_execute, Sw32_shell_execute, 2, 4, 0,
7038 "Get Windows to perform OPERATION on DOCUMENT.\n\ 12209 "Get Windows to perform OPERATION on DOCUMENT.\n\
7039This is a wrapper around the ShellExecute system function, which\n\ 12210This is a wrapper around the ShellExecute system function, which\n\
7040invokes the application registered to handle OPERATION for DOCUMENT.\n\ 12211invokes the application registered to handle OPERATION for DOCUMENT.\n\
7041OPERATION is typically \"open\", \"print\" or \"explore\", and DOCUMENT\n\ 12212OPERATION is typically \"open\", \"print\" or \"explore\" (but can be\n\
7042is typically the name of a document file or URL, but can also be a\n\ 12213nil for the default action), and DOCUMENT is typically the name of a\n\
7043program executable to run or a directory to open in the Windows Explorer.\n\ 12214document file or URL, but can also be a program executable to run or\n\
12215a directory to open in the Windows Explorer.\n\
7044\n\ 12216\n\
7045If DOCUMENT is a program executable, PARAMETERS can be a list of command\n\ 12217If DOCUMENT is a program executable, PARAMETERS can be a string\n\
7046line parameters, but otherwise should be nil.\n\ 12218containing command line parameters, but otherwise should be nil.\n\
7047\n\ 12219\n\
7048SHOW-FLAG can be used to control whether the invoked application is hidden\n\ 12220SHOW-FLAG can be used to control whether the invoked application is hidden\n\
7049or minimized. If SHOw-FLAG is nil, the application is displayed normally,\n\ 12221or minimized. If SHOW-FLAG is nil, the application is displayed normally,\n\
7050otherwise it is an integer representing a ShowWindow flag:\n\ 12222otherwise it is an integer representing a ShowWindow flag:\n\
7051\n\ 12223\n\
7052 0 - start hidden\n\ 12224 0 - start hidden\n\
@@ -7058,14 +12230,14 @@ otherwise it is an integer representing a ShowWindow flag:\n\
7058{ 12230{
7059 Lisp_Object current_dir; 12231 Lisp_Object current_dir;
7060 12232
7061 CHECK_STRING (operation, 0);
7062 CHECK_STRING (document, 0); 12233 CHECK_STRING (document, 0);
7063 12234
7064 /* Encode filename and current directory. */ 12235 /* Encode filename and current directory. */
7065 current_dir = ENCODE_FILE (current_buffer->directory); 12236 current_dir = ENCODE_FILE (current_buffer->directory);
7066 document = ENCODE_FILE (document); 12237 document = ENCODE_FILE (document);
7067 if ((int) ShellExecute (NULL, 12238 if ((int) ShellExecute (NULL,
7068 XSTRING (operation)->data, 12239 (STRINGP (operation) ?
12240 XSTRING (operation)->data : NULL),
7069 XSTRING (document)->data, 12241 XSTRING (document)->data,
7070 (STRINGP (parameters) ? 12242 (STRINGP (parameters) ?
7071 XSTRING (parameters)->data : NULL), 12243 XSTRING (parameters)->data : NULL),
@@ -7304,8 +12476,6 @@ syms_of_w32fns ()
7304 staticpro (&Qauto_raise); 12476 staticpro (&Qauto_raise);
7305 Qauto_lower = intern ("auto-lower"); 12477 Qauto_lower = intern ("auto-lower");
7306 staticpro (&Qauto_lower); 12478 staticpro (&Qauto_lower);
7307 Qbackground_color = intern ("background-color");
7308 staticpro (&Qbackground_color);
7309 Qbar = intern ("bar"); 12479 Qbar = intern ("bar");
7310 staticpro (&Qbar); 12480 staticpro (&Qbar);
7311 Qborder_color = intern ("border-color"); 12481 Qborder_color = intern ("border-color");
@@ -7318,8 +12488,6 @@ syms_of_w32fns ()
7318 staticpro (&Qcursor_color); 12488 staticpro (&Qcursor_color);
7319 Qcursor_type = intern ("cursor-type"); 12489 Qcursor_type = intern ("cursor-type");
7320 staticpro (&Qcursor_type); 12490 staticpro (&Qcursor_type);
7321 Qforeground_color = intern ("foreground-color");
7322 staticpro (&Qforeground_color);
7323 Qgeometry = intern ("geometry"); 12491 Qgeometry = intern ("geometry");
7324 staticpro (&Qgeometry); 12492 staticpro (&Qgeometry);
7325 Qicon_left = intern ("icon-left"); 12493 Qicon_left = intern ("icon-left");
@@ -7346,8 +12514,6 @@ syms_of_w32fns ()
7346 staticpro (&Qscroll_bar_width); 12514 staticpro (&Qscroll_bar_width);
7347 Qsuppress_icon = intern ("suppress-icon"); 12515 Qsuppress_icon = intern ("suppress-icon");
7348 staticpro (&Qsuppress_icon); 12516 staticpro (&Qsuppress_icon);
7349 Qtop = intern ("top");
7350 staticpro (&Qtop);
7351 Qundefined_color = intern ("undefined-color"); 12517 Qundefined_color = intern ("undefined-color");
7352 staticpro (&Qundefined_color); 12518 staticpro (&Qundefined_color);
7353 Qvertical_scroll_bars = intern ("vertical-scroll-bars"); 12519 Qvertical_scroll_bars = intern ("vertical-scroll-bars");
@@ -7364,8 +12530,12 @@ syms_of_w32fns ()
7364 staticpro (&Quser_position); 12530 staticpro (&Quser_position);
7365 Quser_size = intern ("user-size"); 12531 Quser_size = intern ("user-size");
7366 staticpro (&Quser_size); 12532 staticpro (&Quser_size);
12533#if 0 /* Duplicate initialization in xdisp.c */
7367 Qdisplay = intern ("display"); 12534 Qdisplay = intern ("display");
7368 staticpro (&Qdisplay); 12535 staticpro (&Qdisplay);
12536#endif
12537 Qscreen_gamma = intern ("screen-gamma");
12538 staticpro (&Qscreen_gamma);
7369 /* This is the end of symbol initialization. */ 12539 /* This is the end of symbol initialization. */
7370 12540
7371 Qhyper = intern ("hyper"); 12541 Qhyper = intern ("hyper");
@@ -7383,6 +12553,14 @@ syms_of_w32fns ()
7383 Qshift = intern ("shift"); 12553 Qshift = intern ("shift");
7384 staticpro (&Qshift); 12554 staticpro (&Qshift);
7385 12555
12556 /* Text property `display' should be nonsticky by default. */
12557 Vtext_property_default_nonsticky
12558 = Fcons (Fcons (Qdisplay, Qt), Vtext_property_default_nonsticky);
12559
12560
12561 Qlaplace = intern ("laplace");
12562 staticpro (&Qlaplace);
12563
7386 Qface_set_after_frame_default = intern ("face-set-after-frame-default"); 12564 Qface_set_after_frame_default = intern ("face-set-after-frame-default");
7387 staticpro (&Qface_set_after_frame_default); 12565 staticpro (&Qface_set_after_frame_default);
7388 12566
@@ -7481,17 +12659,17 @@ respective modifier, or nil to appear as the key `apps'.\n\
7481Any other value will cause the key to be ignored."); 12659Any other value will cause the key to be ignored.");
7482 Vw32_apps_modifier = Qnil; 12660 Vw32_apps_modifier = Qnil;
7483 12661
7484 DEFVAR_LISP ("w32-enable-italics", &Vw32_enable_italics, 12662 DEFVAR_LISP ("w32-enable-synthesized_fonts", &Vw32_enable_synthesized_fonts,
7485 "Non-nil enables selection of artificially italicized fonts."); 12663 "Non-nil enables selection of artificially italicized and bold fonts.");
7486 Vw32_enable_italics = Qnil; 12664 Vw32_enable_synthesized_fonts = Qnil;
7487 12665
7488 DEFVAR_LISP ("w32-enable-palette", &Vw32_enable_palette, 12666 DEFVAR_LISP ("w32-enable-palette", &Vw32_enable_palette,
7489 "Non-nil enables Windows palette management to map colors exactly."); 12667 "Non-nil enables Windows palette management to map colors exactly.");
7490 Vw32_enable_palette = Qt; 12668 Vw32_enable_palette = Qt;
7491 12669
7492 DEFVAR_INT ("w32-mouse-button-tolerance", 12670 DEFVAR_INT ("w32-mouse-button-tolerance",
7493 &Vw32_mouse_button_tolerance, 12671 &Vw32_mouse_button_tolerance,
7494 "Analogue of double click interval for faking middle mouse events.\n\ 12672 "Analogue of double click interval for faking middle mouse events.\n\
7495The value is the minimum time in milliseconds that must elapse between\n\ 12673The value is the minimum time in milliseconds that must elapse between\n\
7496left/right button down events before they are considered distinct events.\n\ 12674left/right button down events before they are considered distinct events.\n\
7497If both mouse buttons are depressed within this interval, a middle mouse\n\ 12675If both mouse buttons are depressed within this interval, a middle mouse\n\
@@ -7531,7 +12709,17 @@ switches, if present.");
7531 12709
7532 Vx_mode_pointer_shape = Qnil; 12710 Vx_mode_pointer_shape = Qnil;
7533 12711
7534 DEFVAR_INT ("x-sensitive-text-pointer-shape", 12712 DEFVAR_LISP ("x-busy-pointer-shape", &Vx_busy_pointer_shape,
12713 "The shape of the pointer when Emacs is busy.\n\
12714This variable takes effect when you create a new frame\n\
12715or when you set the mouse color.");
12716 Vx_busy_pointer_shape = Qnil;
12717
12718 DEFVAR_BOOL ("display-busy-cursor", &display_busy_cursor_p,
12719 "Non-zero means Emacs displays a busy cursor on window systems.");
12720 display_busy_cursor_p = 1;
12721
12722 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
7535 &Vx_sensitive_text_pointer_shape, 12723 &Vx_sensitive_text_pointer_shape,
7536 "The shape of the pointer when over mouse-sensitive text.\n\ 12724 "The shape of the pointer when over mouse-sensitive text.\n\
7537This variable takes effect when you create a new frame\n\ 12725This variable takes effect when you create a new frame\n\
@@ -7560,6 +12748,18 @@ such a font. This is especially effective for such large fonts as\n\
7560Chinese, Japanese, and Korean."); 12748Chinese, Japanese, and Korean.");
7561 Vx_pixel_size_width_font_regexp = Qnil; 12749 Vx_pixel_size_width_font_regexp = Qnil;
7562 12750
12751 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay,
12752 "Time after which cached images are removed from the cache.\n\
12753When an image has not been displayed this many seconds, remove it\n\
12754from the image cache. Value must be an integer or nil with nil\n\
12755meaning don't clear the cache.");
12756 Vimage_cache_eviction_delay = make_number (30 * 60);
12757
12758 DEFVAR_LISP ("image-types", &Vimage_types,
12759 "List of supported image types.\n\
12760Each element of the list is a symbol for a supported image type.");
12761 Vimage_types = Qnil;
12762
7563 DEFVAR_LISP ("w32-bdf-filename-alist", 12763 DEFVAR_LISP ("w32-bdf-filename-alist",
7564 &Vw32_bdf_filename_alist, 12764 &Vw32_bdf_filename_alist,
7565 "List of bdf fonts and their corresponding filenames."); 12765 "List of bdf fonts and their corresponding filenames.");
@@ -7588,7 +12788,11 @@ only be necessary if the default setting causes problems.");
7588 Vw32_system_coding_system = Qnil; 12788 Vw32_system_coding_system = Qnil;
7589 12789
7590 defsubr (&Sx_get_resource); 12790 defsubr (&Sx_get_resource);
7591 defsubr (&Sx_list_fonts); 12791#if 0 /* NTEMACS_TODO: Port to W32 */
12792 defsubr (&Sx_change_window_property);
12793 defsubr (&Sx_delete_window_property);
12794 defsubr (&Sx_window_property);
12795#endif
7592 defsubr (&Sxw_display_color_p); 12796 defsubr (&Sxw_display_color_p);
7593 defsubr (&Sx_display_grayscale_p); 12797 defsubr (&Sx_display_grayscale_p);
7594 defsubr (&Sxw_color_defined_p); 12798 defsubr (&Sxw_color_defined_p);
@@ -7631,12 +12835,132 @@ only be necessary if the default setting causes problems.");
7631 12835
7632 /* Setting callback functions for fontset handler. */ 12836 /* Setting callback functions for fontset handler. */
7633 get_font_info_func = w32_get_font_info; 12837 get_font_info_func = w32_get_font_info;
12838
12839#if 0 /* This function pointer doesn't seem to be used anywhere.
12840 And the pointer assigned has the wrong type, anyway. */
7634 list_fonts_func = w32_list_fonts; 12841 list_fonts_func = w32_list_fonts;
12842#endif
12843
7635 load_font_func = w32_load_font; 12844 load_font_func = w32_load_font;
7636 find_ccl_program_func = w32_find_ccl_program; 12845 find_ccl_program_func = w32_find_ccl_program;
7637 query_font_func = w32_query_font; 12846 query_font_func = w32_query_font;
7638 set_frame_fontset_func = x_set_font; 12847 set_frame_fontset_func = x_set_font;
7639 check_window_system_func = check_w32; 12848 check_window_system_func = check_w32;
12849
12850#if 0 /* NTEMACS_TODO Image support for W32 */
12851 /* Images. */
12852 Qxbm = intern ("xbm");
12853 staticpro (&Qxbm);
12854 QCtype = intern (":type");
12855 staticpro (&QCtype);
12856 QCalgorithm = intern (":algorithm");
12857 staticpro (&QCalgorithm);
12858 QCheuristic_mask = intern (":heuristic-mask");
12859 staticpro (&QCheuristic_mask);
12860 QCcolor_symbols = intern (":color-symbols");
12861 staticpro (&QCcolor_symbols);
12862 QCdata = intern (":data");
12863 staticpro (&QCdata);
12864 QCascent = intern (":ascent");
12865 staticpro (&QCascent);
12866 QCmargin = intern (":margin");
12867 staticpro (&QCmargin);
12868 QCrelief = intern (":relief");
12869 staticpro (&QCrelief);
12870 Qpostscript = intern ("postscript");
12871 staticpro (&Qpostscript);
12872 QCloader = intern (":loader");
12873 staticpro (&QCloader);
12874 QCbounding_box = intern (":bounding-box");
12875 staticpro (&QCbounding_box);
12876 QCpt_width = intern (":pt-width");
12877 staticpro (&QCpt_width);
12878 QCpt_height = intern (":pt-height");
12879 staticpro (&QCpt_height);
12880 QCindex = intern (":index");
12881 staticpro (&QCindex);
12882 Qpbm = intern ("pbm");
12883 staticpro (&Qpbm);
12884
12885#if HAVE_XPM
12886 Qxpm = intern ("xpm");
12887 staticpro (&Qxpm);
12888#endif
12889
12890#if HAVE_JPEG
12891 Qjpeg = intern ("jpeg");
12892 staticpro (&Qjpeg);
12893#endif
12894
12895#if HAVE_TIFF
12896 Qtiff = intern ("tiff");
12897 staticpro (&Qtiff);
12898#endif
12899
12900#if HAVE_GIF
12901 Qgif = intern ("gif");
12902 staticpro (&Qgif);
12903#endif
12904
12905#if HAVE_PNG
12906 Qpng = intern ("png");
12907 staticpro (&Qpng);
12908#endif
12909
12910 defsubr (&Sclear_image_cache);
12911
12912#if GLYPH_DEBUG
12913 defsubr (&Simagep);
12914 defsubr (&Slookup_image);
12915#endif
12916#endif /* NTEMACS_TODO */
12917
12918 /* Busy-cursor. */
12919 defsubr (&Sx_show_busy_cursor);
12920 defsubr (&Sx_hide_busy_cursor);
12921 busy_count = 0;
12922 inhibit_busy_cursor = 0;
12923
12924 defsubr (&Sx_show_tip);
12925 defsubr (&Sx_hide_tip);
12926 staticpro (&tip_timer);
12927 tip_timer = Qnil;
12928
12929 defsubr (&Sx_file_dialog);
12930}
12931
12932
12933void
12934init_xfns ()
12935{
12936 image_types = NULL;
12937 Vimage_types = Qnil;
12938
12939#if 0 /* NTEMACS_TODO : Image support for W32 */
12940 define_image_type (&xbm_type);
12941 define_image_type (&gs_type);
12942 define_image_type (&pbm_type);
12943
12944#if HAVE_XPM
12945 define_image_type (&xpm_type);
12946#endif
12947
12948#if HAVE_JPEG
12949 define_image_type (&jpeg_type);
12950#endif
12951
12952#if HAVE_TIFF
12953 define_image_type (&tiff_type);
12954#endif
12955
12956#if HAVE_GIF
12957 define_image_type (&gif_type);
12958#endif
12959
12960#if HAVE_PNG
12961 define_image_type (&png_type);
12962#endif
12963#endif /* NTEMACS_TODO */
7640} 12964}
7641 12965
7642#undef abort 12966#undef abort
generated by cgit v1.2.1 (git 2.18.0) at 2026-01-19 22:22:13 +0000