aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
authorGerd Moellmann1999-07-21 21:43:52 +0000
committerGerd Moellmann1999-07-21 21:43:52 +0000
commit333b20bbc2c9a559a4cb429d5f3a9106d28b76f2 (patch)
tree11dc041d341b5a13f3b5c790ac502e7fdb33fcac /src
parent3427a3db9f0be08f7a31f6ebb8507d4ecde587e4 (diff)
downloademacs-333b20bbc2c9a559a4cb429d5f3a9106d28b76f2.tar.gz
emacs-333b20bbc2c9a559a4cb429d5f3a9106d28b76f2.zip
(x_real_positions): Don't subtract window borders
from positions returned. (top-level): Added image support, busy cursor, tooltips, file selection box. (x_report_frame_params): Don't report `outer-window-id' if widget not present. (x_set_font): Don't call face-set-after-frame-default if faces haven't been initialized. (Fx_create_frame): Call face-set-after-frame-default after faces have been initialized, and widget has been created. (x_set_scroll_bar_foreground): New. (x_set_scroll_bar_background): New. (x_default_scroll_bar_color_parameter): New. (Fx_create_frame): Call it. (Fx_create_frame): Initialize scroll bar pixel color values in x_output structure. (Qscroll_bar_foreground, Qscroll_bar_background): New. (syms_of_xfns): Initialize these symbols. (x_frame_parms): Add entries for scroll bar colors. (Fx_create_frame): Try 12pt Courier font first. (Fx_create_frame): Add toolbar height to frame height. (x_frame_parms): Add `toolbar-lines'. (x_set_toolbar_lines): New. (x_set_internal_border_width): Correct call to widget_store_internal_border_width. (x_destroy_bitmap): Use xfree instead of free. Return void. (init_x_parm_symbols): Return void. (x_report_frame_params): Ditto. (x_set_border_pixel): Ditto. (syms_of_xfns): Ditto. (x_destroy_all_bitmaps): Use xfree instead of free. (Fx_close_connection): Use xfree instead of free. Only free fonts from filled font table entries. (display_x_get_resource): Make it externally visible. (x_set_font): First store real font name in frame parameters, then call recompute_basic_faces. (Fx_face_fixed_p): Removed. (Fx_list_fonts): Moved to xfaces.c.
Diffstat (limited to 'src')
-rw-r--r--src/xfns.c5613
1 files changed, 5272 insertions, 341 deletions
diff --git a/src/xfns.c b/src/xfns.c
index 5a251612922..251b48dd322 100644
--- a/src/xfns.c
+++ b/src/xfns.c
@@ -1,5 +1,6 @@
1/* Functions for the X window system. 1/* Functions for the X window system.
2 Copyright (C) 1989, 92, 93, 94, 95, 96, 1997 Free Software Foundation. 2 Copyright (C) 1989, 92, 93, 94, 95, 96, 1997, 1998, 1999
3 Free Software Foundation.
3 4
4This file is part of GNU Emacs. 5This file is part of GNU Emacs.
5 6
@@ -18,14 +19,20 @@ along with GNU Emacs; see the file COPYING. If not, write to
18the Free Software Foundation, Inc., 59 Temple Place - Suite 330, 19the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19Boston, MA 02111-1307, USA. */ 20Boston, MA 02111-1307, USA. */
20 21
22/* Image support (XBM, XPM, PBM, JPEG, TIFF, GIF, PNG, GS). tooltips,
23 toolbars, busy-cursor, file selection dialog added by Gerd
24 Moellmann <gerd@gnu.org>. */
25
21/* Completely rewritten by Richard Stallman. */ 26/* Completely rewritten by Richard Stallman. */
22 27
23/* Rewritten for X11 by Joseph Arceneaux */ 28/* Rewritten for X11 by Joseph Arceneaux */
24 29
25#include <signal.h> 30#include <signal.h>
26#include <config.h> 31#include <config.h>
32#include <stdio.h>
27 33
28/* This makes the fields of a Display accessible, in Xlib header files. */ 34/* This makes the fields of a Display accessible, in Xlib header files. */
35
29#define XLIB_ILLEGAL_ACCESS 36#define XLIB_ILLEGAL_ACCESS
30 37
31#include "lisp.h" 38#include "lisp.h"
@@ -39,11 +46,14 @@ Boston, MA 02111-1307, USA. */
39#include <epaths.h> 46#include <epaths.h>
40#include "charset.h" 47#include "charset.h"
41#include "fontset.h" 48#include "fontset.h"
49#include "systime.h"
50#include "termhooks.h"
42 51
43#ifdef HAVE_X_WINDOWS 52#ifdef HAVE_X_WINDOWS
44extern void abort (); 53extern void abort ();
45 54
46/* On some systems, the character-composition stuff is broken in X11R5. */ 55/* On some systems, the character-composition stuff is broken in X11R5. */
56
47#if defined (HAVE_X11R5) && ! defined (HAVE_X11R6) 57#if defined (HAVE_X11R5) && ! defined (HAVE_X11R6)
48#ifdef X11R5_INHIBIT_I18N 58#ifdef X11R5_INHIBIT_I18N
49#define X_I18N_INHIBITED 59#define X_I18N_INHIBITED
@@ -80,15 +90,22 @@ extern void abort ();
80 90
81#include "../lwlib/lwlib.h" 91#include "../lwlib/lwlib.h"
82 92
93#ifdef USE_MOTIF
94#include <Xm/Xm.h>
95#include <Xm/DialogS.h>
96#include <Xm/FileSB.h>
97#endif
98
83/* Do the EDITRES protocol if running X11R5 99/* Do the EDITRES protocol if running X11R5
84 Exception: HP-UX (at least version A.09.05) has X11R5 without EditRes */ 100 Exception: HP-UX (at least version A.09.05) has X11R5 without EditRes */
101
85#if (XtSpecificationRelease >= 5) && !defined(NO_EDITRES) 102#if (XtSpecificationRelease >= 5) && !defined(NO_EDITRES)
86#define HACK_EDITRES 103#define HACK_EDITRES
87extern void _XEditResCheckMessages (); 104extern void _XEditResCheckMessages ();
88#endif /* R5 + Athena */ 105#endif /* R5 + Athena */
89 106
90/* Unique id counter for widgets created by the Lucid Widget 107/* Unique id counter for widgets created by the Lucid Widget Library. */
91 Library. */ 108
92extern LWLIB_ID widget_id_tick; 109extern LWLIB_ID widget_id_tick;
93 110
94#ifdef USE_LUCID 111#ifdef USE_LUCID
@@ -97,6 +114,7 @@ extern XFontStruct *xlwmenu_default_font;
97#endif 114#endif
98 115
99extern void free_frame_menubar (); 116extern void free_frame_menubar ();
117
100#endif /* USE_X_TOOLKIT */ 118#endif /* USE_X_TOOLKIT */
101 119
102#define min(a,b) ((a) < (b) ? (a) : (b)) 120#define min(a,b) ((a) < (b) ? (a) : (b))
@@ -108,32 +126,55 @@ extern void free_frame_menubar ();
108#define MAXREQUEST(dpy) ((dpy)->max_request_size) 126#define MAXREQUEST(dpy) ((dpy)->max_request_size)
109#endif 127#endif
110 128
129/* The gray bitmap `bitmaps/gray'. This is done because xterm.c uses
130 it, and including `bitmaps/gray' more than once is a problem when
131 config.h defines `static' as an empty replacement string. */
132
133int gray_bitmap_width = gray_width;
134int gray_bitmap_height = gray_height;
135unsigned char *gray_bitmap_bits = gray_bits;
136
111/* The name we're using in resource queries. Most often "emacs". */ 137/* The name we're using in resource queries. Most often "emacs". */
138
112Lisp_Object Vx_resource_name; 139Lisp_Object Vx_resource_name;
113 140
114/* The application class we're using in resource queries. 141/* The application class we're using in resource queries.
115 Normally "Emacs". */ 142 Normally "Emacs". */
143
116Lisp_Object Vx_resource_class; 144Lisp_Object Vx_resource_class;
117 145
146/* Non-zero means we're allowed to display a busy cursor. */
147
148int display_busy_cursor_p;
149
118/* The background and shape of the mouse pointer, and shape when not 150/* The background and shape of the mouse pointer, and shape when not
119 over text or in the modeline. */ 151 over text or in the modeline. */
152
120Lisp_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
121/* The shape when over mouse-sensitive text. */ 156/* The shape when over mouse-sensitive text. */
157
122Lisp_Object Vx_sensitive_text_pointer_shape; 158Lisp_Object Vx_sensitive_text_pointer_shape;
123 159
124/* Color of chars displayed in cursor box. */ 160/* Color of chars displayed in cursor box. */
161
125Lisp_Object Vx_cursor_fore_pixel; 162Lisp_Object Vx_cursor_fore_pixel;
126 163
127/* Nonzero if using X. */ 164/* Nonzero if using X. */
165
128static int x_in_use; 166static int x_in_use;
129 167
130/* Non nil if no window manager is in use. */ 168/* Non nil if no window manager is in use. */
169
131Lisp_Object Vx_no_window_manager; 170Lisp_Object Vx_no_window_manager;
132 171
133/* Search path for bitmap files. */ 172/* Search path for bitmap files. */
173
134Lisp_Object Vx_bitmap_file_path; 174Lisp_Object Vx_bitmap_file_path;
135 175
136/* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */ 176/* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
177
137Lisp_Object Vx_pixel_size_width_font_regexp; 178Lisp_Object Vx_pixel_size_width_font_regexp;
138 179
139/* Evaluate this expression to rebuild the section of syms_of_xfns 180/* Evaluate this expression to rebuild the section of syms_of_xfns
@@ -173,14 +214,12 @@ Lisp_Object Vx_pixel_size_width_font_regexp;
173/*&&& symbols declared here &&&*/ 214/*&&& symbols declared here &&&*/
174Lisp_Object Qauto_raise; 215Lisp_Object Qauto_raise;
175Lisp_Object Qauto_lower; 216Lisp_Object Qauto_lower;
176Lisp_Object Qbackground_color;
177Lisp_Object Qbar; 217Lisp_Object Qbar;
178Lisp_Object Qborder_color; 218Lisp_Object Qborder_color;
179Lisp_Object Qborder_width; 219Lisp_Object Qborder_width;
180Lisp_Object Qbox; 220Lisp_Object Qbox;
181Lisp_Object Qcursor_color; 221Lisp_Object Qcursor_color;
182Lisp_Object Qcursor_type; 222Lisp_Object Qcursor_type;
183Lisp_Object Qforeground_color;
184Lisp_Object Qgeometry; 223Lisp_Object Qgeometry;
185Lisp_Object Qicon_left; 224Lisp_Object Qicon_left;
186Lisp_Object Qicon_top; 225Lisp_Object Qicon_top;
@@ -195,7 +234,7 @@ Lisp_Object Qouter_window_id;
195Lisp_Object Qparent_id; 234Lisp_Object Qparent_id;
196Lisp_Object Qscroll_bar_width; 235Lisp_Object Qscroll_bar_width;
197Lisp_Object Qsuppress_icon; 236Lisp_Object Qsuppress_icon;
198Lisp_Object Qtop; 237extern Lisp_Object Qtop;
199Lisp_Object Qundefined_color; 238Lisp_Object Qundefined_color;
200Lisp_Object Qvertical_scroll_bars; 239Lisp_Object Qvertical_scroll_bars;
201Lisp_Object Qvisibility; 240Lisp_Object Qvisibility;
@@ -205,16 +244,21 @@ Lisp_Object Qx_resource_name;
205Lisp_Object Quser_position; 244Lisp_Object Quser_position;
206Lisp_Object Quser_size; 245Lisp_Object Quser_size;
207Lisp_Object Qdisplay; 246Lisp_Object Qdisplay;
247Lisp_Object Qscroll_bar_foreground, Qscroll_bar_background;
208 248
209/* The below are defined in frame.c. */ 249/* The below are defined in frame.c. */
250
210extern Lisp_Object Qheight, Qminibuffer, Qname, Qonly, Qwidth; 251extern Lisp_Object Qheight, Qminibuffer, Qname, Qonly, Qwidth;
211extern Lisp_Object Qunsplittable, Qmenu_bar_lines, Qbuffer_predicate, Qtitle; 252extern Lisp_Object Qunsplittable, Qmenu_bar_lines, Qbuffer_predicate, Qtitle;
253extern Lisp_Object Qtoolbar_lines;
212 254
213extern Lisp_Object Vwindow_system_version; 255extern Lisp_Object Vwindow_system_version;
214 256
215Lisp_Object Qface_set_after_frame_default; 257Lisp_Object Qface_set_after_frame_default;
258
216 259
217/* Error if we are not connected to X. */ 260/* Error if we are not connected to X. */
261
218void 262void
219check_x () 263check_x ()
220{ 264{
@@ -283,6 +327,7 @@ check_x_display_info (frame)
283 return FRAME_X_DISPLAY_INFO (f); 327 return FRAME_X_DISPLAY_INFO (f);
284 } 328 }
285} 329}
330
286 331
287/* Return the Emacs frame-object corresponding to an X window. 332/* Return the Emacs frame-object corresponding to an X window.
288 It could be the frame's main window or an icon window. */ 333 It could be the frame's main window or an icon window. */
@@ -308,6 +353,9 @@ x_window_to_frame (dpyinfo, wdesc)
308#ifdef USE_X_TOOLKIT 353#ifdef USE_X_TOOLKIT
309 if ((f->output_data.x->edit_widget 354 if ((f->output_data.x->edit_widget
310 && XtWindow (f->output_data.x->edit_widget) == wdesc) 355 && XtWindow (f->output_data.x->edit_widget) == wdesc)
356 /* A tooltip frame? */
357 || (!f->output_data.x->edit_widget
358 && FRAME_X_WINDOW (f) == wdesc)
311 || f->output_data.x->icon_desc == wdesc) 359 || f->output_data.x->icon_desc == wdesc)
312 return f; 360 return f;
313#else /* not USE_X_TOOLKIT */ 361#else /* not USE_X_TOOLKIT */
@@ -342,12 +390,18 @@ x_any_window_to_frame (dpyinfo, wdesc)
342 continue; 390 continue;
343 x = f->output_data.x; 391 x = f->output_data.x;
344 /* This frame matches if the window is any of its widgets. */ 392 /* This frame matches if the window is any of its widgets. */
345 if (wdesc == XtWindow (x->widget) 393 if (x->widget)
346 || wdesc == XtWindow (x->column_widget) 394 {
347 || wdesc == XtWindow (x->edit_widget)) 395 if (wdesc == XtWindow (x->widget)
348 return f; 396 || wdesc == XtWindow (x->column_widget)
349 /* Match if the window is this frame's menubar. */ 397 || wdesc == XtWindow (x->edit_widget))
350 if (lw_window_is_in_menubar (wdesc, x->menubar_widget)) 398 return f;
399 /* Match if the window is this frame's menubar. */
400 if (lw_window_is_in_menubar (wdesc, x->menubar_widget))
401 return f;
402 }
403 else if (FRAME_X_WINDOW (f) == wdesc)
404 /* A tooltip frame. */
351 return f; 405 return f;
352 } 406 }
353 return 0; 407 return 0;
@@ -374,9 +428,15 @@ x_non_menubar_window_to_frame (dpyinfo, wdesc)
374 continue; 428 continue;
375 x = f->output_data.x; 429 x = f->output_data.x;
376 /* This frame matches if the window is any of its widgets. */ 430 /* This frame matches if the window is any of its widgets. */
377 if (wdesc == XtWindow (x->widget) 431 if (x->widget)
378 || wdesc == XtWindow (x->column_widget) 432 {
379 || wdesc == XtWindow (x->edit_widget)) 433 if (wdesc == XtWindow (x->widget)
434 || wdesc == XtWindow (x->column_widget)
435 || wdesc == XtWindow (x->edit_widget))
436 return f;
437 }
438 else if (FRAME_X_WINDOW (f) == wdesc)
439 /* A tooltip frame. */
380 return f; 440 return f;
381 } 441 }
382 return 0; 442 return 0;
@@ -403,7 +463,8 @@ x_menubar_window_to_frame (dpyinfo, wdesc)
403 continue; 463 continue;
404 x = f->output_data.x; 464 x = f->output_data.x;
405 /* Match if the window is this frame's menubar. */ 465 /* Match if the window is this frame's menubar. */
406 if (lw_window_is_in_menubar (wdesc, x->menubar_widget)) 466 if (x->menubar_widget
467 && lw_window_is_in_menubar (wdesc, x->menubar_widget))
407 return f; 468 return f;
408 } 469 }
409 return 0; 470 return 0;
@@ -430,17 +491,24 @@ x_top_window_to_frame (dpyinfo, wdesc)
430 if (f->output_data.nothing == 1 || FRAME_X_DISPLAY_INFO (f) != dpyinfo) 491 if (f->output_data.nothing == 1 || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
431 continue; 492 continue;
432 x = f->output_data.x; 493 x = f->output_data.x;
433 /* This frame matches if the window is its topmost widget. */ 494
434 if (wdesc == XtWindow (x->widget)) 495 if (x->widget)
435 return f; 496 {
497 /* This frame matches if the window is its topmost widget. */
498 if (wdesc == XtWindow (x->widget))
499 return f;
436#if 0 /* I don't know why it did this, 500#if 0 /* I don't know why it did this,
437 but it seems logically wrong, 501 but it seems logically wrong,
438 and it causes trouble for MapNotify events. */ 502 and it causes trouble for MapNotify events. */
439 /* Match if the window is this frame's menubar. */ 503 /* Match if the window is this frame's menubar. */
440 if (x->menubar_widget 504 if (x->menubar_widget
441 && wdesc == XtWindow (x->menubar_widget)) 505 && wdesc == XtWindow (x->menubar_widget))
442 return f; 506 return f;
443#endif 507#endif
508 }
509 else if (FRAME_X_WINDOW (f) == wdesc)
510 /* Tooltip frame. */
511 return f;
444 } 512 }
445 return 0; 513 return 0;
446} 514}
@@ -632,7 +700,7 @@ x_destroy_bitmap (f, id)
632 XFreePixmap (FRAME_X_DISPLAY (f), dpyinfo->bitmaps[id - 1].pixmap); 700 XFreePixmap (FRAME_X_DISPLAY (f), dpyinfo->bitmaps[id - 1].pixmap);
633 if (dpyinfo->bitmaps[id - 1].file) 701 if (dpyinfo->bitmaps[id - 1].file)
634 { 702 {
635 free (dpyinfo->bitmaps[id - 1].file); 703 xfree (dpyinfo->bitmaps[id - 1].file);
636 dpyinfo->bitmaps[id - 1].file = NULL; 704 dpyinfo->bitmaps[id - 1].file = NULL;
637 } 705 }
638 UNBLOCK_INPUT; 706 UNBLOCK_INPUT;
@@ -652,7 +720,7 @@ x_destroy_all_bitmaps (dpyinfo)
652 { 720 {
653 XFreePixmap (dpyinfo->display, dpyinfo->bitmaps[i].pixmap); 721 XFreePixmap (dpyinfo->display, dpyinfo->bitmaps[i].pixmap);
654 if (dpyinfo->bitmaps[i].file) 722 if (dpyinfo->bitmaps[i].file)
655 free (dpyinfo->bitmaps[i].file); 723 xfree (dpyinfo->bitmaps[i].file);
656 } 724 }
657 dpyinfo->bitmaps_last = 0; 725 dpyinfo->bitmaps_last = 0;
658} 726}
@@ -690,6 +758,16 @@ void x_set_menu_bar_lines ();
690void x_set_scroll_bar_width (); 758void x_set_scroll_bar_width ();
691void x_set_title (); 759void x_set_title ();
692void x_set_unsplittable (); 760void x_set_unsplittable ();
761void x_set_toolbar_lines P_ ((struct frame *, Lisp_Object, Lisp_Object));
762void x_set_scroll_bar_foreground P_ ((struct frame *, Lisp_Object,
763 Lisp_Object));
764void x_set_scroll_bar_background P_ ((struct frame *, Lisp_Object,
765 Lisp_Object));
766static Lisp_Object x_default_scroll_bar_color_parameter P_ ((struct frame *,
767 Lisp_Object,
768 Lisp_Object,
769 char *, char *,
770 int));
693 771
694static struct x_frame_parm_table x_frame_parms[] = 772static struct x_frame_parm_table x_frame_parms[] =
695{ 773{
@@ -713,6 +791,9 @@ static struct x_frame_parm_table x_frame_parms[] =
713 "unsplittable", x_set_unsplittable, 791 "unsplittable", x_set_unsplittable,
714 "vertical-scroll-bars", x_set_vertical_scroll_bars, 792 "vertical-scroll-bars", x_set_vertical_scroll_bars,
715 "visibility", x_set_visibility, 793 "visibility", x_set_visibility,
794 "toolbar-lines", x_set_toolbar_lines,
795 "scroll-bar-foreground", x_set_scroll_bar_foreground,
796 "scroll-bar-background", x_set_scroll_bar_background,
716}; 797};
717 798
718/* Attach the `x-frame-parameter' properties to 799/* Attach the `x-frame-parameter' properties to
@@ -771,7 +852,7 @@ x_set_frame_parameters (f, alist)
771 i = 0; 852 i = 0;
772 for (tail = alist; CONSP (tail); tail = Fcdr (tail)) 853 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
773 { 854 {
774 Lisp_Object elt, prop, val; 855 Lisp_Object elt;
775 856
776 elt = Fcar (tail); 857 elt = Fcar (tail);
777 parms[i] = Fcar (elt); 858 parms[i] = Fcar (elt);
@@ -978,7 +1059,9 @@ x_real_positions (f, xptr, yptr)
978 the problem that arises when restarting window-managers. */ 1059 the problem that arises when restarting window-managers. */
979 1060
980#ifdef USE_X_TOOLKIT 1061#ifdef USE_X_TOOLKIT
981 Window outer = XtWindow (f->output_data.x->widget); 1062 Window outer = (f->output_data.x->widget
1063 ? XtWindow (f->output_data.x->widget)
1064 : FRAME_X_WINDOW (f));
982#else 1065#else
983 Window outer = f->output_data.x->window_desc; 1066 Window outer = f->output_data.x->window_desc;
984#endif 1067#endif
@@ -1031,8 +1114,8 @@ x_real_positions (f, xptr, yptr)
1031 x_uncatch_errors (FRAME_X_DISPLAY (f), count); 1114 x_uncatch_errors (FRAME_X_DISPLAY (f), count);
1032 } 1115 }
1033 1116
1034 *xptr = win_x - f->output_data.x->border_width; 1117 *xptr = win_x;
1035 *yptr = win_y - f->output_data.x->border_width; 1118 *yptr = win_y;
1036} 1119}
1037 1120
1038/* Insert a description of internally-recorded parameters of frame X 1121/* Insert a description of internally-recorded parameters of frame X
@@ -1070,7 +1153,11 @@ x_report_frame_params (f, alistptr)
1070 sprintf (buf, "%ld", (long) FRAME_X_WINDOW (f)); 1153 sprintf (buf, "%ld", (long) FRAME_X_WINDOW (f));
1071 store_in_alist (alistptr, Qwindow_id, 1154 store_in_alist (alistptr, Qwindow_id,
1072 build_string (buf)); 1155 build_string (buf));
1073 sprintf (buf, "%ld", (long) FRAME_OUTER_WINDOW (f)); 1156#ifdef USE_X_TOOLKIT
1157 /* Tooltip frame may not have this widget. */
1158 if (f->output_data.x->widget)
1159#endif
1160 sprintf (buf, "%ld", (long) FRAME_OUTER_WINDOW (f));
1074 store_in_alist (alistptr, Qouter_window_id, 1161 store_in_alist (alistptr, Qouter_window_id,
1075 build_string (buf)); 1162 build_string (buf));
1076 store_in_alist (alistptr, Qicon_name, f->icon_name); 1163 store_in_alist (alistptr, Qicon_name, f->icon_name);
@@ -1299,6 +1386,7 @@ x_set_mouse_color (f, arg, oldval)
1299 Lisp_Object arg, oldval; 1386 Lisp_Object arg, oldval;
1300{ 1387{
1301 Cursor cursor, nontext_cursor, mode_cursor, cross_cursor; 1388 Cursor cursor, nontext_cursor, mode_cursor, cross_cursor;
1389 Cursor busy_cursor;
1302 int count; 1390 int count;
1303 int mask_color; 1391 int mask_color;
1304 unsigned long pixel = f->output_data.x->mouse_pixel; 1392 unsigned long pixel = f->output_data.x->mouse_pixel;
@@ -1343,6 +1431,17 @@ x_set_mouse_color (f, arg, oldval)
1343 nontext_cursor = XCreateFontCursor (FRAME_X_DISPLAY (f), XC_left_ptr); 1431 nontext_cursor = XCreateFontCursor (FRAME_X_DISPLAY (f), XC_left_ptr);
1344 x_check_errors (FRAME_X_DISPLAY (f), "bad nontext pointer cursor: %s"); 1432 x_check_errors (FRAME_X_DISPLAY (f), "bad nontext pointer cursor: %s");
1345 1433
1434 if (!EQ (Qnil, Vx_busy_pointer_shape))
1435 {
1436 CHECK_NUMBER (Vx_busy_pointer_shape, 0);
1437 busy_cursor = XCreateFontCursor (FRAME_X_DISPLAY (f),
1438 XINT (Vx_busy_pointer_shape));
1439 }
1440 else
1441 busy_cursor = XCreateFontCursor (FRAME_X_DISPLAY (f), XC_watch);
1442 x_check_errors (FRAME_X_DISPLAY (f), "bad busy pointer cursor: %s");
1443
1444 x_check_errors (FRAME_X_DISPLAY (f), "bad nontext pointer cursor: %s");
1346 if (!EQ (Qnil, Vx_mode_pointer_shape)) 1445 if (!EQ (Qnil, Vx_mode_pointer_shape))
1347 { 1446 {
1348 CHECK_NUMBER (Vx_mode_pointer_shape, 0); 1447 CHECK_NUMBER (Vx_mode_pointer_shape, 0);
@@ -1388,12 +1487,12 @@ x_set_mouse_color (f, arg, oldval)
1388 &fore_color, &back_color); 1487 &fore_color, &back_color);
1389 XRecolorCursor (FRAME_X_DISPLAY (f), cross_cursor, 1488 XRecolorCursor (FRAME_X_DISPLAY (f), cross_cursor,
1390 &fore_color, &back_color); 1489 &fore_color, &back_color);
1490 XRecolorCursor (FRAME_X_DISPLAY (f), busy_cursor,
1491 &fore_color, &back_color);
1391 } 1492 }
1392 1493
1393 if (FRAME_X_WINDOW (f) != 0) 1494 if (FRAME_X_WINDOW (f) != 0)
1394 { 1495 XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), cursor);
1395 XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), cursor);
1396 }
1397 1496
1398 if (cursor != f->output_data.x->text_cursor && f->output_data.x->text_cursor != 0) 1497 if (cursor != f->output_data.x->text_cursor && f->output_data.x->text_cursor != 0)
1399 XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->text_cursor); 1498 XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->text_cursor);
@@ -1404,10 +1503,16 @@ x_set_mouse_color (f, arg, oldval)
1404 XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->nontext_cursor); 1503 XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->nontext_cursor);
1405 f->output_data.x->nontext_cursor = nontext_cursor; 1504 f->output_data.x->nontext_cursor = nontext_cursor;
1406 1505
1506 if (busy_cursor != f->output_data.x->busy_cursor
1507 && f->output_data.x->busy_cursor != 0)
1508 XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->busy_cursor);
1509 f->output_data.x->busy_cursor = busy_cursor;
1510
1407 if (mode_cursor != f->output_data.x->modeline_cursor 1511 if (mode_cursor != f->output_data.x->modeline_cursor
1408 && f->output_data.x->modeline_cursor != 0) 1512 && f->output_data.x->modeline_cursor != 0)
1409 XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->modeline_cursor); 1513 XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->modeline_cursor);
1410 f->output_data.x->modeline_cursor = mode_cursor; 1514 f->output_data.x->modeline_cursor = mode_cursor;
1515
1411 if (cross_cursor != f->output_data.x->cross_cursor 1516 if (cross_cursor != f->output_data.x->cross_cursor
1412 && f->output_data.x->cross_cursor != 0) 1517 && f->output_data.x->cross_cursor != 0)
1413 XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->cross_cursor); 1518 XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->cross_cursor);
@@ -1531,20 +1636,20 @@ x_set_cursor_type (f, arg, oldval)
1531{ 1636{
1532 if (EQ (arg, Qbar)) 1637 if (EQ (arg, Qbar))
1533 { 1638 {
1534 FRAME_DESIRED_CURSOR (f) = bar_cursor; 1639 FRAME_DESIRED_CURSOR (f) = BAR_CURSOR;
1535 f->output_data.x->cursor_width = 2; 1640 f->output_data.x->cursor_width = 2;
1536 } 1641 }
1537 else if (CONSP (arg) && EQ (XCONS (arg)->car, Qbar) 1642 else if (CONSP (arg) && EQ (XCONS (arg)->car, Qbar)
1538 && INTEGERP (XCONS (arg)->cdr)) 1643 && INTEGERP (XCONS (arg)->cdr))
1539 { 1644 {
1540 FRAME_DESIRED_CURSOR (f) = bar_cursor; 1645 FRAME_DESIRED_CURSOR (f) = BAR_CURSOR;
1541 f->output_data.x->cursor_width = XINT (XCONS (arg)->cdr); 1646 f->output_data.x->cursor_width = XINT (XCONS (arg)->cdr);
1542 } 1647 }
1543 else 1648 else
1544 /* Treat anything unknown as "box cursor". 1649 /* Treat anything unknown as "box cursor".
1545 It was bad to signal an error; people have trouble fixing 1650 It was bad to signal an error; people have trouble fixing
1546 .Xdefaults with Emacs, when it has something bad in it. */ 1651 .Xdefaults with Emacs, when it has something bad in it. */
1547 FRAME_DESIRED_CURSOR (f) = filled_box_cursor; 1652 FRAME_DESIRED_CURSOR (f) = FILLED_BOX_CURSOR;
1548 1653
1549 /* Make sure the cursor gets redrawn. This is overkill, but how 1654 /* Make sure the cursor gets redrawn. This is overkill, but how
1550 often do people change cursor types? */ 1655 often do people change cursor types? */
@@ -1556,7 +1661,6 @@ x_set_icon_type (f, arg, oldval)
1556 struct frame *f; 1661 struct frame *f;
1557 Lisp_Object arg, oldval; 1662 Lisp_Object arg, oldval;
1558{ 1663{
1559 Lisp_Object tem;
1560 int result; 1664 int result;
1561 1665
1562 if (STRINGP (arg)) 1666 if (STRINGP (arg))
@@ -1606,7 +1710,6 @@ x_set_icon_name (f, arg, oldval)
1606 struct frame *f; 1710 struct frame *f;
1607 Lisp_Object arg, oldval; 1711 Lisp_Object arg, oldval;
1608{ 1712{
1609 Lisp_Object tem;
1610 int result; 1713 int result;
1611 1714
1612 if (STRINGP (arg)) 1715 if (STRINGP (arg))
@@ -1666,14 +1769,22 @@ x_set_font (f, arg, oldval)
1666 error ("The characters of the given font have varying widths"); 1769 error ("The characters of the given font have varying widths");
1667 else if (STRINGP (result)) 1770 else if (STRINGP (result))
1668 { 1771 {
1669 recompute_basic_faces (f);
1670 store_frame_param (f, Qfont, result); 1772 store_frame_param (f, Qfont, result);
1773 recompute_basic_faces (f);
1671 } 1774 }
1672 else 1775 else
1673 abort (); 1776 abort ();
1674 1777
1675 XSETFRAME (frame, f); 1778 /* Don't call `face-set-after-frame-default' when faces haven't been
1676 call1 (Qface_set_after_frame_default, frame); 1779 initialized yet. This is the case when called from
1780 Fx_create_frame. In that case, the X widget or window doesn't
1781 exist either, and we can end up in x_report_frame_params with a
1782 null widget which gives a segfault. */
1783 if (FRAME_FACE_CACHE (f))
1784 {
1785 XSETFRAME (frame, f);
1786 call1 (Qface_set_after_frame_default, frame);
1787 }
1677} 1788}
1678 1789
1679void 1790void
@@ -1697,7 +1808,6 @@ x_set_internal_border_width (f, arg, oldval)
1697 struct frame *f; 1808 struct frame *f;
1698 Lisp_Object arg, oldval; 1809 Lisp_Object arg, oldval;
1699{ 1810{
1700 int mask;
1701 int old = f->output_data.x->internal_border_width; 1811 int old = f->output_data.x->internal_border_width;
1702 1812
1703 CHECK_NUMBER (arg, 0); 1813 CHECK_NUMBER (arg, 0);
@@ -1774,7 +1884,7 @@ x_set_menu_bar_lines (f, value, oldval)
1774 1884
1775 /* Right now, menu bars don't work properly in minibuf-only frames; 1885 /* Right now, menu bars don't work properly in minibuf-only frames;
1776 most of the commands try to apply themselves to the minibuffer 1886 most of the commands try to apply themselves to the minibuffer
1777 frame itslef, and get an error because you can't switch buffers 1887 frame itself, and get an error because you can't switch buffers
1778 in or split the minibuffer window. */ 1888 in or split the minibuffer window. */
1779 if (FRAME_MINIBUF_ONLY_P (f)) 1889 if (FRAME_MINIBUF_ONLY_P (f))
1780 return; 1890 return;
@@ -1808,7 +1918,106 @@ x_set_menu_bar_lines (f, value, oldval)
1808 FRAME_MENU_BAR_LINES (f) = nlines; 1918 FRAME_MENU_BAR_LINES (f) = nlines;
1809 x_set_menu_bar_lines_1 (f->root_window, nlines - olines); 1919 x_set_menu_bar_lines_1 (f->root_window, nlines - olines);
1810#endif /* not USE_X_TOOLKIT */ 1920#endif /* not USE_X_TOOLKIT */
1921 adjust_glyphs (f);
1811} 1922}
1923
1924
1925/* Set the number of lines used for the tool bar of frame F to VALUE.
1926 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
1927 is the old number of tool bar lines. This function changes the
1928 height of all windows on frame F to match the new tool bar height.
1929 The frame's height doesn't change. */
1930
1931void
1932x_set_toolbar_lines (f, value, oldval)
1933 struct frame *f;
1934 Lisp_Object value, oldval;
1935{
1936 int delta, nlines;
1937
1938 /* Use VALUE only if an integer >= 0. */
1939 if (INTEGERP (value) && XINT (value) >= 0)
1940 nlines = XFASTINT (value);
1941 else
1942 nlines = 0;
1943
1944 /* Make sure we redisplay all windows in this frame. */
1945 ++windows_or_buffers_changed;
1946
1947 delta = nlines - FRAME_TOOLBAR_LINES (f);
1948 FRAME_TOOLBAR_LINES (f) = nlines;
1949 x_set_menu_bar_lines_1 (FRAME_ROOT_WINDOW (f), delta);
1950 adjust_glyphs (f);
1951}
1952
1953
1954/* Set the foreground color for scroll bars on frame F to VALUE.
1955 VALUE should be a string, a color name. If it isn't a string or
1956 isn't a valid color name, do nothing. OLDVAL is the old value of
1957 the frame parameter. */
1958
1959void
1960x_set_scroll_bar_foreground (f, value, oldval)
1961 struct frame *f;
1962 Lisp_Object value, oldval;
1963{
1964 unsigned long pixel;
1965
1966 if (STRINGP (value))
1967 pixel = x_decode_color (f, value, BLACK_PIX_DEFAULT (f));
1968 else
1969 pixel = -1;
1970
1971 if (f->output_data.x->scroll_bar_foreground_pixel != -1)
1972 unload_color (f, f->output_data.x->scroll_bar_foreground_pixel);
1973
1974 f->output_data.x->scroll_bar_foreground_pixel = pixel;
1975 if (FRAME_X_WINDOW (f) && FRAME_VISIBLE_P (f))
1976 {
1977 /* Remove all scroll bars because they have wrong colors. */
1978 if (condemn_scroll_bars_hook)
1979 (*condemn_scroll_bars_hook) (f);
1980 if (judge_scroll_bars_hook)
1981 (*judge_scroll_bars_hook) (f);
1982
1983 redraw_frame (f);
1984 }
1985}
1986
1987
1988/* Set the background color for scroll bars on frame F to VALUE VALUE
1989 should be a string, a color name. If it isn't a string or isn't a
1990 valid color name, do nothing. OLDVAL is the old value of the frame
1991 parameter. */
1992
1993void
1994x_set_scroll_bar_background (f, value, oldval)
1995 struct frame *f;
1996 Lisp_Object value, oldval;
1997{
1998 unsigned long pixel;
1999
2000 if (STRINGP (value))
2001 pixel = x_decode_color (f, value, WHITE_PIX_DEFAULT (f));
2002 else
2003 pixel = -1;
2004
2005 if (f->output_data.x->scroll_bar_background_pixel != -1)
2006 unload_color (f, f->output_data.x->scroll_bar_background_pixel);
2007
2008 f->output_data.x->scroll_bar_background_pixel = pixel;
2009 if (FRAME_X_WINDOW (f) && FRAME_VISIBLE_P (f))
2010 {
2011 /* Remove all scroll bars because they have wrong colors. */
2012 if (condemn_scroll_bars_hook)
2013 (*condemn_scroll_bars_hook) (f);
2014 if (judge_scroll_bars_hook)
2015 (*judge_scroll_bars_hook) (f);
2016
2017 redraw_frame (f);
2018 }
2019}
2020
1812 2021
1813/* Change the name of frame F to NAME. If NAME is nil, set F's name to 2022/* Change the name of frame F to NAME. If NAME is nil, set F's name to
1814 x_id_name. 2023 x_id_name.
@@ -2053,12 +2262,20 @@ x_set_scroll_bar_width (f, arg, oldval)
2053 2262
2054 if (NILP (arg)) 2263 if (NILP (arg))
2055 { 2264 {
2056 /* Make the actual width at least 14 pixels 2265#ifdef USE_X_TOOLKIT
2057 and a multiple of a character width. */ 2266 /* A too wide or narrow toolkit scroll bar doesn't look good. */
2267 int width = 16 + 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM;
2268 FRAME_SCROLL_BAR_COLS (f) = (width + wid - 1) / wid;
2269 FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = width;
2270#else
2271 /* Make the actual width at least 14 pixels and a multiple of a
2272 character width. */
2058 FRAME_SCROLL_BAR_COLS (f) = (14 + wid - 1) / wid; 2273 FRAME_SCROLL_BAR_COLS (f) = (14 + wid - 1) / wid;
2059 /* Use all of that space (aside from required margins) 2274
2060 for the scroll bar. */ 2275 /* Use all of that space (aside from required margins) for the
2276 scroll bar. */
2061 FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = 0; 2277 FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = 0;
2278#endif
2062 2279
2063 if (FRAME_X_WINDOW (f)) 2280 if (FRAME_X_WINDOW (f))
2064 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f)); 2281 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
@@ -2076,8 +2293,11 @@ x_set_scroll_bar_width (f, arg, oldval)
2076 } 2293 }
2077 2294
2078 change_frame_size (f, 0, FRAME_WIDTH (f), 0, 0); 2295 change_frame_size (f, 0, FRAME_WIDTH (f), 0, 0);
2079 FRAME_CURSOR_X (f) = FRAME_LEFT_SCROLL_BAR_WIDTH (f); 2296 XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.hpos = 0;
2297 XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.x = 0;
2080} 2298}
2299
2300
2081 2301
2082/* Subroutines of creating an X frame. */ 2302/* Subroutines of creating an X frame. */
2083 2303
@@ -2087,7 +2307,7 @@ x_set_scroll_bar_width (f, arg, oldval)
2087static void 2307static void
2088validate_x_resource_name () 2308validate_x_resource_name ()
2089{ 2309{
2090 int len; 2310 int len = 0;
2091 /* Number of valid characters in the resource name. */ 2311 /* Number of valid characters in the resource name. */
2092 int good_count = 0; 2312 int good_count = 0;
2093 /* Number of invalid characters in the resource name. */ 2313 /* Number of invalid characters in the resource name. */
@@ -2230,7 +2450,7 @@ and the class is `Emacs.CLASS.SUBCLASS'.")
2230 2450
2231/* Get an X resource, like Fx_get_resource, but for display DPYINFO. */ 2451/* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
2232 2452
2233static Lisp_Object 2453Lisp_Object
2234display_x_get_resource (dpyinfo, attribute, class, component, subclass) 2454display_x_get_resource (dpyinfo, attribute, class, component, subclass)
2235 struct x_display_info *dpyinfo; 2455 struct x_display_info *dpyinfo;
2236 Lisp_Object attribute, class, component, subclass; 2456 Lisp_Object attribute, class, component, subclass;
@@ -2301,7 +2521,6 @@ char *
2301x_get_resource_string (attribute, class) 2521x_get_resource_string (attribute, class)
2302 char *attribute, *class; 2522 char *attribute, *class;
2303{ 2523{
2304 register char *value;
2305 char *name_key; 2524 char *name_key;
2306 char *class_key; 2525 char *class_key;
2307 2526
@@ -2323,9 +2542,12 @@ x_get_resource_string (attribute, class)
2323 2542
2324/* Types we might convert a resource string into. */ 2543/* Types we might convert a resource string into. */
2325enum resource_types 2544enum resource_types
2326 { 2545{
2327 number, boolean, string, symbol 2546 RES_TYPE_NUMBER,
2328 }; 2547 RES_TYPE_BOOLEAN,
2548 RES_TYPE_STRING,
2549 RES_TYPE_SYMBOL
2550};
2329 2551
2330/* Return the value of parameter PARAM. 2552/* Return the value of parameter PARAM.
2331 2553
@@ -2366,10 +2588,10 @@ x_get_arg (dpyinfo, alist, param, attribute, class, type)
2366 2588
2367 switch (type) 2589 switch (type)
2368 { 2590 {
2369 case number: 2591 case RES_TYPE_NUMBER:
2370 return make_number (atoi (XSTRING (tem)->data)); 2592 return make_number (atoi (XSTRING (tem)->data));
2371 2593
2372 case boolean: 2594 case RES_TYPE_BOOLEAN:
2373 tem = Fdowncase (tem); 2595 tem = Fdowncase (tem);
2374 if (!strcmp (XSTRING (tem)->data, "on") 2596 if (!strcmp (XSTRING (tem)->data, "on")
2375 || !strcmp (XSTRING (tem)->data, "true")) 2597 || !strcmp (XSTRING (tem)->data, "true"))
@@ -2377,10 +2599,10 @@ x_get_arg (dpyinfo, alist, param, attribute, class, type)
2377 else 2599 else
2378 return Qnil; 2600 return Qnil;
2379 2601
2380 case string: 2602 case RES_TYPE_STRING:
2381 return tem; 2603 return tem;
2382 2604
2383 case symbol: 2605 case RES_TYPE_SYMBOL:
2384 /* As a special case, we map the values `true' and `on' 2606 /* As a special case, we map the values `true' and `on'
2385 to Qt, and `false' and `off' to Qnil. */ 2607 to Qt, and `false' and `off' to Qnil. */
2386 { 2608 {
@@ -2450,6 +2672,62 @@ x_default_parameter (f, alist, prop, deflt, xprop, xclass, type)
2450 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil)); 2672 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
2451 return tem; 2673 return tem;
2452} 2674}
2675
2676
2677/* Record in frame F the specified or default value according to ALIST
2678 of the parameter named PROP (a Lisp symbol). If no value is
2679 specified for PROP, look for an X default for XPROP on the frame
2680 named NAME. If that is not found either, use the value DEFLT. */
2681
2682static Lisp_Object
2683x_default_scroll_bar_color_parameter (f, alist, prop, xprop, xclass,
2684 foreground_p)
2685 struct frame *f;
2686 Lisp_Object alist;
2687 Lisp_Object prop;
2688 char *xprop;
2689 char *xclass;
2690 int foreground_p;
2691{
2692 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
2693 Lisp_Object tem;
2694
2695 tem = x_get_arg (dpyinfo, alist, prop, xprop, xclass, RES_TYPE_STRING);
2696 if (EQ (tem, Qunbound))
2697 {
2698#ifdef USE_TOOLKIT_SCROLL_BARS
2699
2700 /* See if an X resource for the scroll bar color has been
2701 specified. */
2702 tem = display_x_get_resource (dpyinfo,
2703 build_string (foreground_p
2704 ? "foreground"
2705 : "background"),
2706 build_string (""),
2707 build_string ("verticalScrollBar"),
2708 build_string (""));
2709 if (!STRINGP (tem))
2710 {
2711 /* If nothing has been specified, scroll bars will use a
2712 toolkit-dependent default. Because these defaults are
2713 difficult to get at without actually creating a scroll
2714 bar, use nil to indicate that no color has been
2715 specified. */
2716 tem = Qnil;
2717 }
2718
2719#else /* not USE_TOOLKIT_SCROLL_BARS */
2720
2721 tem = Qnil;
2722
2723#endif /* not USE_TOOLKIT_SCROLL_BARS */
2724 }
2725
2726 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
2727 return tem;
2728}
2729
2730
2453 2731
2454DEFUN ("x-parse-geometry", Fx_parse_geometry, Sx_parse_geometry, 1, 1, 0, 2732DEFUN ("x-parse-geometry", Fx_parse_geometry, Sx_parse_geometry, 1, 1, 0,
2455 "Parse an X-style geometry string STRING.\n\ 2733 "Parse an X-style geometry string STRING.\n\
@@ -2539,9 +2817,9 @@ x_figure_window_size (f, parms)
2539 f->output_data.x->top_pos = 0; 2817 f->output_data.x->top_pos = 0;
2540 f->output_data.x->left_pos = 0; 2818 f->output_data.x->left_pos = 0;
2541 2819
2542 tem0 = x_get_arg (dpyinfo, parms, Qheight, 0, 0, number); 2820 tem0 = x_get_arg (dpyinfo, parms, Qheight, 0, 0, RES_TYPE_NUMBER);
2543 tem1 = x_get_arg (dpyinfo, parms, Qwidth, 0, 0, number); 2821 tem1 = x_get_arg (dpyinfo, parms, Qwidth, 0, 0, RES_TYPE_NUMBER);
2544 tem2 = x_get_arg (dpyinfo, parms, Quser_size, 0, 0, number); 2822 tem2 = x_get_arg (dpyinfo, parms, Quser_size, 0, 0, RES_TYPE_NUMBER);
2545 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound)) 2823 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
2546 { 2824 {
2547 if (!EQ (tem0, Qunbound)) 2825 if (!EQ (tem0, Qunbound))
@@ -2563,15 +2841,15 @@ x_figure_window_size (f, parms)
2563 f->output_data.x->vertical_scroll_bar_extra 2841 f->output_data.x->vertical_scroll_bar_extra
2564 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f) 2842 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f)
2565 ? 0 2843 ? 0
2566 : FRAME_SCROLL_BAR_PIXEL_WIDTH (f) > 0
2567 ? FRAME_SCROLL_BAR_PIXEL_WIDTH (f)
2568 : (FRAME_SCROLL_BAR_COLS (f) * FONT_WIDTH (f->output_data.x->font))); 2844 : (FRAME_SCROLL_BAR_COLS (f) * FONT_WIDTH (f->output_data.x->font)));
2845 f->output_data.x->flags_areas_extra
2846 = 2 * FRAME_FLAGS_AREA_WIDTH (f);
2569 f->output_data.x->pixel_width = CHAR_TO_PIXEL_WIDTH (f, f->width); 2847 f->output_data.x->pixel_width = CHAR_TO_PIXEL_WIDTH (f, f->width);
2570 f->output_data.x->pixel_height = CHAR_TO_PIXEL_HEIGHT (f, f->height); 2848 f->output_data.x->pixel_height = CHAR_TO_PIXEL_HEIGHT (f, f->height);
2571 2849
2572 tem0 = x_get_arg (dpyinfo, parms, Qtop, 0, 0, number); 2850 tem0 = x_get_arg (dpyinfo, parms, Qtop, 0, 0, RES_TYPE_NUMBER);
2573 tem1 = x_get_arg (dpyinfo, parms, Qleft, 0, 0, number); 2851 tem1 = x_get_arg (dpyinfo, parms, Qleft, 0, 0, RES_TYPE_NUMBER);
2574 tem2 = x_get_arg (dpyinfo, parms, Quser_position, 0, 0, number); 2852 tem2 = x_get_arg (dpyinfo, parms, Quser_position, 0, 0, RES_TYPE_NUMBER);
2575 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound)) 2853 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
2576 { 2854 {
2577 if (EQ (tem0, Qminus)) 2855 if (EQ (tem0, Qminus))
@@ -2918,7 +3196,7 @@ x_window (f, window_prompting, minibuffer_only)
2918#endif 3196#endif
2919 3197
2920 /* Do a stupid property change to force the server to generate a 3198 /* Do a stupid property change to force the server to generate a
2921 propertyNotify event so that the event_stream server timestamp will 3199 PropertyNotify event so that the event_stream server timestamp will
2922 be initialized to something relevant to the time we created the window. 3200 be initialized to something relevant to the time we created the window.
2923 */ 3201 */
2924 XChangeProperty (XtDisplay (frame_widget), XtWindow (frame_widget), 3202 XChangeProperty (XtDisplay (frame_widget), XtWindow (frame_widget),
@@ -3098,8 +3376,8 @@ x_icon (f, parms)
3098 3376
3099 /* Set the position of the icon. Note that twm groups all 3377 /* Set the position of the icon. Note that twm groups all
3100 icons in an icon window. */ 3378 icons in an icon window. */
3101 icon_x = x_get_and_record_arg (f, parms, Qicon_left, 0, 0, number); 3379 icon_x = x_get_and_record_arg (f, parms, Qicon_left, 0, 0, RES_TYPE_NUMBER);
3102 icon_y = x_get_and_record_arg (f, parms, Qicon_top, 0, 0, number); 3380 icon_y = x_get_and_record_arg (f, parms, Qicon_top, 0, 0, RES_TYPE_NUMBER);
3103 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound)) 3381 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
3104 { 3382 {
3105 CHECK_NUMBER (icon_x, 0); 3383 CHECK_NUMBER (icon_x, 0);
@@ -3115,7 +3393,8 @@ x_icon (f, parms)
3115 3393
3116 /* Start up iconic or window? */ 3394 /* Start up iconic or window? */
3117 x_wm_set_window_state 3395 x_wm_set_window_state
3118 (f, (EQ (x_get_arg (dpyinfo, parms, Qvisibility, 0, 0, symbol), Qicon) 3396 (f, (EQ (x_get_arg (dpyinfo, parms, Qvisibility, 0, 0, RES_TYPE_SYMBOL),
3397 Qicon)
3119 ? IconicState 3398 ? IconicState
3120 : NormalState)); 3399 : NormalState));
3121 3400
@@ -3143,8 +3422,6 @@ x_make_gc (f)
3143 struct frame *f; 3422 struct frame *f;
3144{ 3423{
3145 XGCValues gc_values; 3424 XGCValues gc_values;
3146 GC temp_gc;
3147 XImage tileimage;
3148 3425
3149 BLOCK_INPUT; 3426 BLOCK_INPUT;
3150 3427
@@ -3185,6 +3462,10 @@ x_make_gc (f)
3185 | GCFillStyle /* | GCStipple */ | GCLineWidth), 3462 | GCFillStyle /* | GCStipple */ | GCLineWidth),
3186 &gc_values); 3463 &gc_values);
3187 3464
3465 /* Reliefs. */
3466 f->output_data.x->white_relief.gc = 0;
3467 f->output_data.x->black_relief.gc = 0;
3468
3188 /* Create the gray border tile used when the pointer is not in 3469 /* Create the gray border tile used when the pointer is not in
3189 the frame. Since this depends on the frame's pixel values, 3470 the frame. Since this depends on the frame's pixel values,
3190 this must be done on a per-frame basis. */ 3471 this must be done on a per-frame basis. */
@@ -3223,7 +3504,7 @@ This function is an internal primitive--use `make-frame' instead.")
3223 int count = specpdl_ptr - specpdl; 3504 int count = specpdl_ptr - specpdl;
3224 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; 3505 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3225 Lisp_Object display; 3506 Lisp_Object display;
3226 struct x_display_info *dpyinfo; 3507 struct x_display_info *dpyinfo = NULL;
3227 Lisp_Object parent; 3508 Lisp_Object parent;
3228 struct kboard *kb; 3509 struct kboard *kb;
3229 3510
@@ -3233,7 +3514,7 @@ This function is an internal primitive--use `make-frame' instead.")
3233 until we know if this frame has a specified name. */ 3514 until we know if this frame has a specified name. */
3234 Vx_resource_name = Vinvocation_name; 3515 Vx_resource_name = Vinvocation_name;
3235 3516
3236 display = x_get_arg (dpyinfo, parms, Qdisplay, 0, 0, string); 3517 display = x_get_arg (dpyinfo, parms, Qdisplay, 0, 0, RES_TYPE_STRING);
3237 if (EQ (display, Qunbound)) 3518 if (EQ (display, Qunbound))
3238 display = Qnil; 3519 display = Qnil;
3239 dpyinfo = check_x_display_info (display); 3520 dpyinfo = check_x_display_info (display);
@@ -3243,7 +3524,7 @@ This function is an internal primitive--use `make-frame' instead.")
3243 kb = &the_only_kboard; 3524 kb = &the_only_kboard;
3244#endif 3525#endif
3245 3526
3246 name = x_get_arg (dpyinfo, parms, Qname, "name", "Name", string); 3527 name = x_get_arg (dpyinfo, parms, Qname, "name", "Name", RES_TYPE_STRING);
3247 if (!STRINGP (name) 3528 if (!STRINGP (name)
3248 && ! EQ (name, Qunbound) 3529 && ! EQ (name, Qunbound)
3249 && ! NILP (name)) 3530 && ! NILP (name))
@@ -3253,7 +3534,7 @@ This function is an internal primitive--use `make-frame' instead.")
3253 Vx_resource_name = name; 3534 Vx_resource_name = name;
3254 3535
3255 /* See if parent window is specified. */ 3536 /* See if parent window is specified. */
3256 parent = x_get_arg (dpyinfo, parms, Qparent_id, NULL, NULL, number); 3537 parent = x_get_arg (dpyinfo, parms, Qparent_id, NULL, NULL, RES_TYPE_NUMBER);
3257 if (EQ (parent, Qunbound)) 3538 if (EQ (parent, Qunbound))
3258 parent = Qnil; 3539 parent = Qnil;
3259 if (! NILP (parent)) 3540 if (! NILP (parent))
@@ -3264,7 +3545,8 @@ This function is an internal primitive--use `make-frame' instead.")
3264 it to make_frame_without_minibuffer. */ 3545 it to make_frame_without_minibuffer. */
3265 frame = Qnil; 3546 frame = Qnil;
3266 GCPRO4 (parms, parent, name, frame); 3547 GCPRO4 (parms, parent, name, frame);
3267 tem = x_get_arg (dpyinfo, parms, Qminibuffer, "minibuffer", "Minibuffer", symbol); 3548 tem = x_get_arg (dpyinfo, parms, Qminibuffer, "minibuffer", "Minibuffer",
3549 RES_TYPE_SYMBOL);
3268 if (EQ (tem, Qnone) || NILP (tem)) 3550 if (EQ (tem, Qnone) || NILP (tem))
3269 f = make_frame_without_minibuffer (Qnil, kb, display); 3551 f = make_frame_without_minibuffer (Qnil, kb, display);
3270 else if (EQ (tem, Qonly)) 3552 else if (EQ (tem, Qonly))
@@ -3287,9 +3569,12 @@ This function is an internal primitive--use `make-frame' instead.")
3287 bzero (f->output_data.x, sizeof (struct x_output)); 3569 bzero (f->output_data.x, sizeof (struct x_output));
3288 f->output_data.x->icon_bitmap = -1; 3570 f->output_data.x->icon_bitmap = -1;
3289 f->output_data.x->fontset = -1; 3571 f->output_data.x->fontset = -1;
3572 f->output_data.x->scroll_bar_foreground_pixel = -1;
3573 f->output_data.x->scroll_bar_background_pixel = -1;
3290 3574
3291 f->icon_name 3575 f->icon_name
3292 = x_get_arg (dpyinfo, parms, Qicon_name, "iconName", "Title", string); 3576 = x_get_arg (dpyinfo, parms, Qicon_name, "iconName", "Title",
3577 RES_TYPE_STRING);
3293 if (! STRINGP (f->icon_name)) 3578 if (! STRINGP (f->icon_name))
3294 f->icon_name = Qnil; 3579 f->icon_name = Qnil;
3295 3580
@@ -3311,9 +3596,6 @@ This function is an internal primitive--use `make-frame' instead.")
3311 f->output_data.x->explicit_parent = 0; 3596 f->output_data.x->explicit_parent = 0;
3312 } 3597 }
3313 3598
3314 /* Note that the frame has no physical cursor right now. */
3315 f->phys_cursor_x = -1;
3316
3317 /* Set the name; the functions to which we pass f expect the name to 3599 /* Set the name; the functions to which we pass f expect the name to
3318 be set. */ 3600 be set. */
3319 if (EQ (name, Qunbound) || NILP (name)) 3601 if (EQ (name, Qunbound) || NILP (name))
@@ -3338,7 +3620,7 @@ This function is an internal primitive--use `make-frame' instead.")
3338 { 3620 {
3339 Lisp_Object font; 3621 Lisp_Object font;
3340 3622
3341 font = x_get_arg (dpyinfo, parms, Qfont, "font", "Font", string); 3623 font = x_get_arg (dpyinfo, parms, Qfont, "font", "Font", RES_TYPE_STRING);
3342 3624
3343 BLOCK_INPUT; 3625 BLOCK_INPUT;
3344 /* First, try whatever font the caller has specified. */ 3626 /* First, try whatever font the caller has specified. */
@@ -3350,8 +3632,11 @@ This function is an internal primitive--use `make-frame' instead.")
3350 else 3632 else
3351 font = x_new_font (f, XSTRING (font)->data); 3633 font = x_new_font (f, XSTRING (font)->data);
3352 } 3634 }
3635
3353 /* Try out a font which we hope has bold and italic variations. */ 3636 /* Try out a font which we hope has bold and italic variations. */
3354 if (!STRINGP (font)) 3637 if (!STRINGP (font))
3638 font = x_new_font (f, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
3639 if (!STRINGP (font))
3355 font = x_new_font (f, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1"); 3640 font = x_new_font (f, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3356 if (! STRINGP (font)) 3641 if (! STRINGP (font))
3357 font = x_new_font (f, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1"); 3642 font = x_new_font (f, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
@@ -3367,7 +3652,7 @@ This function is an internal primitive--use `make-frame' instead.")
3367 font = build_string ("fixed"); 3652 font = build_string ("fixed");
3368 3653
3369 x_default_parameter (f, parms, Qfont, font, 3654 x_default_parameter (f, parms, Qfont, font,
3370 "font", "Font", string); 3655 "font", "Font", RES_TYPE_STRING);
3371 } 3656 }
3372 3657
3373#ifdef USE_LUCID 3658#ifdef USE_LUCID
@@ -3377,7 +3662,8 @@ This function is an internal primitive--use `make-frame' instead.")
3377#endif 3662#endif
3378 3663
3379 x_default_parameter (f, parms, Qborder_width, make_number (2), 3664 x_default_parameter (f, parms, Qborder_width, make_number (2),
3380 "borderWidth", "BorderWidth", number); 3665 "borderWidth", "BorderWidth", RES_TYPE_NUMBER);
3666
3381 /* This defaults to 2 in order to match xterm. We recognize either 3667 /* This defaults to 2 in order to match xterm. We recognize either
3382 internalBorderWidth or internalBorder (which is what xterm calls 3668 internalBorderWidth or internalBorder (which is what xterm calls
3383 it). */ 3669 it). */
@@ -3386,36 +3672,57 @@ This function is an internal primitive--use `make-frame' instead.")
3386 Lisp_Object value; 3672 Lisp_Object value;
3387 3673
3388 value = x_get_arg (dpyinfo, parms, Qinternal_border_width, 3674 value = x_get_arg (dpyinfo, parms, Qinternal_border_width,
3389 "internalBorder", "internalBorder", number); 3675 "internalBorder", "internalBorder", RES_TYPE_NUMBER);
3390 if (! EQ (value, Qunbound)) 3676 if (! EQ (value, Qunbound))
3391 parms = Fcons (Fcons (Qinternal_border_width, value), 3677 parms = Fcons (Fcons (Qinternal_border_width, value),
3392 parms); 3678 parms);
3393 } 3679 }
3394 x_default_parameter (f, parms, Qinternal_border_width, make_number (1), 3680 x_default_parameter (f, parms, Qinternal_border_width, make_number (1),
3395 "internalBorderWidth", "internalBorderWidth", number); 3681 "internalBorderWidth", "internalBorderWidth",
3682 RES_TYPE_NUMBER);
3396 x_default_parameter (f, parms, Qvertical_scroll_bars, Qleft, 3683 x_default_parameter (f, parms, Qvertical_scroll_bars, Qleft,
3397 "verticalScrollBars", "ScrollBars", symbol); 3684 "verticalScrollBars", "ScrollBars",
3685 RES_TYPE_SYMBOL);
3398 3686
3399 /* Also do the stuff which must be set before the window exists. */ 3687 /* Also do the stuff which must be set before the window exists. */
3400 x_default_parameter (f, parms, Qforeground_color, build_string ("black"), 3688 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
3401 "foreground", "Foreground", string); 3689 "foreground", "Foreground", RES_TYPE_STRING);
3402 x_default_parameter (f, parms, Qbackground_color, build_string ("white"), 3690 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
3403 "background", "Background", string); 3691 "background", "Background", RES_TYPE_STRING);
3404 x_default_parameter (f, parms, Qmouse_color, build_string ("black"), 3692 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
3405 "pointerColor", "Foreground", string); 3693 "pointerColor", "Foreground", RES_TYPE_STRING);
3406 x_default_parameter (f, parms, Qcursor_color, build_string ("black"), 3694 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
3407 "cursorColor", "Foreground", string); 3695 "cursorColor", "Foreground", RES_TYPE_STRING);
3408 x_default_parameter (f, parms, Qborder_color, build_string ("black"), 3696 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
3409 "borderColor", "BorderColor", string); 3697 "borderColor", "BorderColor", RES_TYPE_STRING);
3410 3698
3699 x_default_scroll_bar_color_parameter (f, parms, Qscroll_bar_foreground,
3700 "scrollBarForeground",
3701 "ScrollBarForeground", 1);
3702 x_default_scroll_bar_color_parameter (f, parms, Qscroll_bar_background,
3703 "scrollBarBackground",
3704 "ScrollBarBackground", 0);
3705
3706 /* Init faces before x_default_parameter is called for scroll-bar
3707 parameters because that function calls x_set_scroll_bar_width,
3708 which calls change_frame_size, which calls Fset_window_buffer,
3709 which runs hooks, which call Fvertical_motion. At the end, we
3710 end up in init_iterator with a null face cache, which should not
3711 happen. */
3712 init_frame_faces (f);
3713
3411 x_default_parameter (f, parms, Qmenu_bar_lines, make_number (1), 3714 x_default_parameter (f, parms, Qmenu_bar_lines, make_number (1),
3412 "menuBar", "MenuBar", number); 3715 "menuBar", "MenuBar", RES_TYPE_NUMBER);
3716 x_default_parameter (f, parms, Qtoolbar_lines, make_number (0),
3717 "toolBar", "ToolBar", RES_TYPE_NUMBER);
3413 x_default_parameter (f, parms, Qscroll_bar_width, Qnil, 3718 x_default_parameter (f, parms, Qscroll_bar_width, Qnil,
3414 "scrollBarWidth", "ScrollBarWidth", number); 3719 "scrollBarWidth", "ScrollBarWidth",
3720 RES_TYPE_NUMBER);
3415 x_default_parameter (f, parms, Qbuffer_predicate, Qnil, 3721 x_default_parameter (f, parms, Qbuffer_predicate, Qnil,
3416 "bufferPredicate", "BufferPredicate", symbol); 3722 "bufferPredicate", "BufferPredicate",
3723 RES_TYPE_SYMBOL);
3417 x_default_parameter (f, parms, Qtitle, Qnil, 3724 x_default_parameter (f, parms, Qtitle, Qnil,
3418 "title", "Title", string); 3725 "title", "Title", RES_TYPE_STRING);
3419 3726
3420 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window; 3727 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
3421 window_prompting = x_figure_window_size (f, parms); 3728 window_prompting = x_figure_window_size (f, parms);
@@ -3437,6 +3744,13 @@ This function is an internal primitive--use `make-frame' instead.")
3437 3744
3438 f->output_data.x->size_hint_flags = window_prompting; 3745 f->output_data.x->size_hint_flags = window_prompting;
3439 3746
3747 /* Create the X widget or window. Add the toolbar height to the
3748 initial frame height so that the user gets a text display area of
3749 the size he specified with -g or via .Xdefaults. Later changes
3750 of the toolbar height don't change the frame size. This is done
3751 so that users can create tall Emacs frames without having to
3752 guess how tall the toolbar will get. */
3753 f->height += FRAME_TOOLBAR_LINES (f);
3440#ifdef USE_X_TOOLKIT 3754#ifdef USE_X_TOOLKIT
3441 x_window (f, window_prompting, minibuffer_only); 3755 x_window (f, window_prompting, minibuffer_only);
3442#else 3756#else
@@ -3444,19 +3758,20 @@ This function is an internal primitive--use `make-frame' instead.")
3444#endif 3758#endif
3445 x_icon (f, parms); 3759 x_icon (f, parms);
3446 x_make_gc (f); 3760 x_make_gc (f);
3447 init_frame_faces (f);
3448 3761
3762 call1 (Qface_set_after_frame_default, frame);
3763
3449 /* We need to do this after creating the X window, so that the 3764 /* We need to do this after creating the X window, so that the
3450 icon-creation functions can say whose icon they're describing. */ 3765 icon-creation functions can say whose icon they're describing. */
3451 x_default_parameter (f, parms, Qicon_type, Qnil, 3766 x_default_parameter (f, parms, Qicon_type, Qnil,
3452 "bitmapIcon", "BitmapIcon", symbol); 3767 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL);
3453 3768
3454 x_default_parameter (f, parms, Qauto_raise, Qnil, 3769 x_default_parameter (f, parms, Qauto_raise, Qnil,
3455 "autoRaise", "AutoRaiseLower", boolean); 3770 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
3456 x_default_parameter (f, parms, Qauto_lower, Qnil, 3771 x_default_parameter (f, parms, Qauto_lower, Qnil,
3457 "autoLower", "AutoRaiseLower", boolean); 3772 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
3458 x_default_parameter (f, parms, Qcursor_type, Qbox, 3773 x_default_parameter (f, parms, Qcursor_type, Qbox,
3459 "cursorType", "CursorType", symbol); 3774 "cursorType", "CursorType", RES_TYPE_SYMBOL);
3460 3775
3461 /* Dimensions, especially f->height, must be done via change_frame_size. 3776 /* Dimensions, especially f->height, must be done via change_frame_size.
3462 Change will not be effected unless different from the current 3777 Change will not be effected unless different from the current
@@ -3473,7 +3788,7 @@ This function is an internal primitive--use `make-frame' instead.")
3473 x_wm_set_size_hint (f, window_prompting, 0); 3788 x_wm_set_size_hint (f, window_prompting, 0);
3474 UNBLOCK_INPUT; 3789 UNBLOCK_INPUT;
3475 3790
3476 tem = x_get_arg (dpyinfo, parms, Qunsplittable, 0, 0, boolean); 3791 tem = x_get_arg (dpyinfo, parms, Qunsplittable, 0, 0, RES_TYPE_BOOLEAN);
3477 f->no_split = minibuffer_only || EQ (tem, Qt); 3792 f->no_split = minibuffer_only || EQ (tem, Qt);
3478 3793
3479 UNGCPRO; 3794 UNGCPRO;
@@ -3495,7 +3810,8 @@ This function is an internal primitive--use `make-frame' instead.")
3495 { 3810 {
3496 Lisp_Object visibility; 3811 Lisp_Object visibility;
3497 3812
3498 visibility = x_get_arg (dpyinfo, parms, Qvisibility, 0, 0, symbol); 3813 visibility = x_get_arg (dpyinfo, parms, Qvisibility, 0, 0,
3814 RES_TYPE_SYMBOL);
3499 if (EQ (visibility, Qunbound)) 3815 if (EQ (visibility, Qunbound))
3500 visibility = Qt; 3816 visibility = Qt;
3501 3817
@@ -3527,220 +3843,6 @@ x_get_focus_frame (frame)
3527 XSETFRAME (xfocus, dpyinfo->x_focus_frame); 3843 XSETFRAME (xfocus, dpyinfo->x_focus_frame);
3528 return xfocus; 3844 return xfocus;
3529} 3845}
3530
3531#if 1
3532#include "x-list-font.c"
3533#else
3534DEFUN ("x-list-fonts", Fx_list_fonts, Sx_list_fonts, 1, 4, 0,
3535 "Return a list of the names of available fonts matching PATTERN.\n\
3536If optional arguments FACE and FRAME are specified, return only fonts\n\
3537the same size as FACE on FRAME.\n\
3538\n\
3539PATTERN is a string, perhaps with wildcard characters;\n\
3540 the * character matches any substring, and\n\
3541 the ? character matches any single character.\n\
3542 PATTERN is case-insensitive.\n\
3543FACE is a face name--a symbol.\n\
3544\n\
3545The return value is a list of strings, suitable as arguments to\n\
3546set-face-font.\n\
3547\n\
3548Fonts Emacs can't use (i.e. proportional fonts) may or may not be excluded\n\
3549even if they match PATTERN and FACE.\n\
3550\n\
3551The optional fourth argument MAXIMUM sets a limit on how many\n\
3552fonts to match. The first MAXIMUM fonts are reported.")
3553 (pattern, face, frame, maximum)
3554 Lisp_Object pattern, face, frame, maximum;
3555{
3556 int num_fonts;
3557 char **names;
3558#ifndef BROKEN_XLISTFONTSWITHINFO
3559 XFontStruct *info;
3560#endif
3561 XFontStruct *size_ref;
3562 Lisp_Object list;
3563 FRAME_PTR f;
3564 Lisp_Object key;
3565 int maxnames;
3566 int count;
3567
3568 check_x ();
3569 CHECK_STRING (pattern, 0);
3570 if (!NILP (face))
3571 CHECK_SYMBOL (face, 1);
3572
3573 if (NILP (maximum))
3574 maxnames = 2000;
3575 else
3576 {
3577 CHECK_NATNUM (maximum, 0);
3578 maxnames = XINT (maximum);
3579 }
3580
3581 f = check_x_frame (frame);
3582
3583 /* Determine the width standard for comparison with the fonts we find. */
3584
3585 if (NILP (face))
3586 size_ref = 0;
3587 else
3588 {
3589 int face_id;
3590
3591 /* Don't die if we get called with a terminal frame. */
3592 if (! FRAME_X_P (f))
3593 error ("Non-X frame used in `x-list-fonts'");
3594
3595 face_id = face_name_id_number (f, face);
3596
3597 if (face_id < 0 || face_id >= FRAME_N_PARAM_FACES (f)
3598 || FRAME_PARAM_FACES (f) [face_id] == 0)
3599 size_ref = f->output_data.x->font;
3600 else
3601 {
3602 size_ref = FRAME_PARAM_FACES (f) [face_id]->font;
3603 if (size_ref == (XFontStruct *) (~0))
3604 size_ref = f->output_data.x->font;
3605 }
3606 }
3607
3608 /* See if we cached the result for this particular query. */
3609 key = Fcons (pattern, maximum);
3610 list = Fassoc (key,
3611 XCONS (FRAME_X_DISPLAY_INFO (f)->name_list_element)->cdr);
3612
3613 /* We have info in the cache for this PATTERN. */
3614 if (!NILP (list))
3615 {
3616 Lisp_Object tem, newlist;
3617
3618 /* We have info about this pattern. */
3619 list = XCONS (list)->cdr;
3620
3621 if (size_ref == 0)
3622 return list;
3623
3624 BLOCK_INPUT;
3625
3626 /* Filter the cached info and return just the fonts that match FACE. */
3627 newlist = Qnil;
3628 for (tem = list; CONSP (tem); tem = XCONS (tem)->cdr)
3629 {
3630 XFontStruct *thisinfo;
3631
3632 count = x_catch_errors (FRAME_X_DISPLAY (f));
3633
3634 thisinfo = XLoadQueryFont (FRAME_X_DISPLAY (f),
3635 XSTRING (XCONS (tem)->car)->data);
3636
3637 x_check_errors (FRAME_X_DISPLAY (f), "XLoadQueryFont failure: %s");
3638 x_uncatch_errors (FRAME_X_DISPLAY (f), count);
3639
3640 if (thisinfo && same_size_fonts (thisinfo, size_ref))
3641 newlist = Fcons (XCONS (tem)->car, newlist);
3642
3643 if (thisinfo != 0)
3644 XFreeFont (FRAME_X_DISPLAY (f), thisinfo);
3645 }
3646
3647 UNBLOCK_INPUT;
3648
3649 return newlist;
3650 }
3651
3652 BLOCK_INPUT;
3653
3654 count = x_catch_errors (FRAME_X_DISPLAY (f));
3655
3656 /* Solaris 2.3 has a bug in XListFontsWithInfo. */
3657#ifndef BROKEN_XLISTFONTSWITHINFO
3658 if (size_ref)
3659 names = XListFontsWithInfo (FRAME_X_DISPLAY (f),
3660 XSTRING (pattern)->data,
3661 maxnames,
3662 &num_fonts, /* count_return */
3663 &info); /* info_return */
3664 else
3665#endif
3666 names = XListFonts (FRAME_X_DISPLAY (f),
3667 XSTRING (pattern)->data,
3668 maxnames,
3669 &num_fonts); /* count_return */
3670
3671 x_check_errors (FRAME_X_DISPLAY (f), "XListFonts failure: %s");
3672 x_uncatch_errors (FRAME_X_DISPLAY (f), count);
3673
3674 UNBLOCK_INPUT;
3675
3676 list = Qnil;
3677
3678 if (names)
3679 {
3680 int i;
3681 Lisp_Object full_list;
3682
3683 /* Make a list of all the fonts we got back.
3684 Store that in the font cache for the display. */
3685 full_list = Qnil;
3686 for (i = 0; i < num_fonts; i++)
3687 full_list = Fcons (build_string (names[i]), full_list);
3688 XCONS (FRAME_X_DISPLAY_INFO (f)->name_list_element)->cdr
3689 = Fcons (Fcons (key, full_list),
3690 XCONS (FRAME_X_DISPLAY_INFO (f)->name_list_element)->cdr);
3691
3692 /* Make a list of the fonts that have the right width. */
3693 list = Qnil;
3694 for (i = 0; i < num_fonts; i++)
3695 {
3696 int keeper;
3697
3698 if (!size_ref)
3699 keeper = 1;
3700 else
3701 {
3702#ifdef BROKEN_XLISTFONTSWITHINFO
3703 XFontStruct *thisinfo;
3704
3705 BLOCK_INPUT;
3706
3707 count = x_catch_errors (FRAME_X_DISPLAY (f));
3708 thisinfo = XLoadQueryFont (FRAME_X_DISPLAY (f), names[i]);
3709 x_check_errors (FRAME_X_DISPLAY (f),
3710 "XLoadQueryFont failure: %s");
3711 x_uncatch_errors (FRAME_X_DISPLAY (f), count);
3712
3713 UNBLOCK_INPUT;
3714
3715 keeper = thisinfo && same_size_fonts (thisinfo, size_ref);
3716 BLOCK_INPUT;
3717 if (thisinfo && ! keeper)
3718 XFreeFont (FRAME_X_DISPLAY (f), thisinfo);
3719 else if (thisinfo)
3720 XFreeFontInfo (NULL, thisinfo, 1);
3721 UNBLOCK_INPUT;
3722#else
3723 keeper = same_size_fonts (&info[i], size_ref);
3724#endif
3725 }
3726 if (keeper)
3727 list = Fcons (build_string (names[i]), list);
3728 }
3729 list = Fnreverse (list);
3730
3731 BLOCK_INPUT;
3732#ifndef BROKEN_XLISTFONTSWITHINFO
3733 if (size_ref)
3734 XFreeFontInfo (names, info, num_fonts);
3735 else
3736#endif
3737 XFreeFontNames (names);
3738 UNBLOCK_INPUT;
3739 }
3740
3741 return list;
3742}
3743#endif
3744 3846
3745 3847
3746DEFUN ("x-color-defined-p", Fx_color_defined_p, Sx_color_defined_p, 1, 2, 0, 3848DEFUN ("x-color-defined-p", Fx_color_defined_p, Sx_color_defined_p, 1, 2, 0,
@@ -4316,6 +4418,7 @@ selected frame.")
4316{ 4418{
4317 register int x0, y0, x1, y1; 4419 register int x0, y0, x1, y1;
4318 register struct frame *f = selected_frame; 4420 register struct frame *f = selected_frame;
4421 struct window *w = XWINDOW (FRAME_SELECTED_WINDOW (f));
4319 register int p1, p2; 4422 register int p1, p2;
4320 4423
4321 CHECK_CONS (event, 0); 4424 CHECK_CONS (event, 0);
@@ -4327,8 +4430,9 @@ selected frame.")
4327 /* If the mouse is past the end of the line, don't that area. */ 4430 /* If the mouse is past the end of the line, don't that area. */
4328 /* ReWrite this... */ 4431 /* ReWrite this... */
4329 4432
4330 x1 = f->cursor_x; 4433 /* Where the cursor is. */
4331 y1 = f->cursor_y; 4434 x1 = WINDOW_TO_FRAME_PIXEL_X (w, w->cursor.x);
4435 y1 = WINDOW_TO_FRAME_PIXEL_Y (w, w->cursor.y);
4332 4436
4333 if (y1 > y0) /* point below mouse */ 4437 if (y1 > y0) /* point below mouse */
4334 outline_region (f, f->output_data.x->cursor_gc, 4438 outline_region (f, f->output_data.x->cursor_gc,
@@ -4360,12 +4464,13 @@ at X, Y on the selected frame.")
4360{ 4464{
4361 register int x0, y0, x1, y1; 4465 register int x0, y0, x1, y1;
4362 register struct frame *f = selected_frame; 4466 register struct frame *f = selected_frame;
4467 struct window *w = XWINDOW (FRAME_SELECTED_WINDOW (f));
4363 4468
4364 BLOCK_INPUT; 4469 BLOCK_INPUT;
4365 x0 = XINT (Fcar (Fcar (event))); 4470 x0 = XINT (Fcar (Fcar (event)));
4366 y0 = XINT (Fcar (Fcdr (Fcar (event)))); 4471 y0 = XINT (Fcar (Fcdr (Fcar (event))));
4367 x1 = f->cursor_x; 4472 x1 = WINDOW_TO_FRAME_PIXEL_X (w, w->cursor.x);
4368 y1 = f->cursor_y; 4473 y1 = WINDOW_TO_FRAME_PIXEL_Y (w, w->cursor.y);
4369 4474
4370 if (y1 > y0) /* point below mouse */ 4475 if (y1 > y0) /* point below mouse */
4371 outline_region (f, f->output_data.x->reverse_gc, 4476 outline_region (f, f->output_data.x->reverse_gc,
@@ -4468,8 +4573,9 @@ DEFUN ("x-select-region", Fx_select_region, Sx_select_region, 1, 1, "e",
4468 Lisp_Object event; 4573 Lisp_Object event;
4469{ 4574{
4470 register struct frame *f = selected_frame; 4575 register struct frame *f = selected_frame;
4471 register int point_x = f->cursor_x; 4576 struct window *w = XWINDOW (FRAME_SELECTED_WINDOW (f));
4472 register int point_y = f->cursor_y; 4577 register int point_x = WINDOW_TO_FRAME_PIXEL_X (w, w->cursor.x);
4578 register int point_y = WINDOW_TO_FRAME_PIXEL_Y (w, w->cursor.y);
4473 register int mouse_below_point; 4579 register int mouse_below_point;
4474 register Lisp_Object obj; 4580 register Lisp_Object obj;
4475 register int x_contour_x, x_contour_y; 4581 register int x_contour_x, x_contour_y;
@@ -5114,7 +5220,6 @@ terminate Emacs if we can't open the connection.")
5114 (display, xrm_string, must_succeed) 5220 (display, xrm_string, must_succeed)
5115 Lisp_Object display, xrm_string, must_succeed; 5221 Lisp_Object display, xrm_string, must_succeed;
5116{ 5222{
5117 unsigned int n_planes;
5118 unsigned char *xrm_option; 5223 unsigned char *xrm_option;
5119 struct x_display_info *dpyinfo; 5224 struct x_display_info *dpyinfo;
5120 5225
@@ -5164,7 +5269,6 @@ If DISPLAY is nil, that stands for the selected frame's display.")
5164 Lisp_Object display; 5269 Lisp_Object display;
5165{ 5270{
5166 struct x_display_info *dpyinfo = check_x_display_info (display); 5271 struct x_display_info *dpyinfo = check_x_display_info (display);
5167 struct x_display_info *tail;
5168 int i; 5272 int i;
5169 5273
5170 if (dpyinfo->reference_count > 0) 5274 if (dpyinfo->reference_count > 0)
@@ -5173,13 +5277,14 @@ If DISPLAY is nil, that stands for the selected frame's display.")
5173 BLOCK_INPUT; 5277 BLOCK_INPUT;
5174 /* Free the fonts in the font table. */ 5278 /* Free the fonts in the font table. */
5175 for (i = 0; i < dpyinfo->n_fonts; i++) 5279 for (i = 0; i < dpyinfo->n_fonts; i++)
5176 { 5280 if (dpyinfo->font_table[i].name)
5177 if (dpyinfo->font_table[i].name) 5281 {
5178 free (dpyinfo->font_table[i].name); 5282 xfree (dpyinfo->font_table[i].name);
5179 /* Don't free the full_name string; 5283 /* Don't free the full_name string;
5180 it is always shared with something else. */ 5284 it is always shared with something else. */
5181 XFreeFont (dpyinfo->display, dpyinfo->font_table[i].font); 5285 XFreeFont (dpyinfo->display, dpyinfo->font_table[i].font);
5182 } 5286 }
5287
5183 x_destroy_all_bitmaps (dpyinfo); 5288 x_destroy_all_bitmaps (dpyinfo);
5184 XSetCloseDownMode (dpyinfo->display, DestroyAll); 5289 XSetCloseDownMode (dpyinfo->display, DestroyAll);
5185 5290
@@ -5237,7 +5342,4687 @@ x_sync (f)
5237 XSync (FRAME_X_DISPLAY (f), False); 5342 XSync (FRAME_X_DISPLAY (f), False);
5238 UNBLOCK_INPUT; 5343 UNBLOCK_INPUT;
5239} 5344}
5345
5346
5347/***********************************************************************
5348 Image types
5349 ***********************************************************************/
5350
5351/* Value is the number of elements of vector VECTOR. */
5352
5353#define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
5354
5355/* List of supported image types. Use define_image_type to add new
5356 types. Use lookup_image_type to find a type for a given symbol. */
5357
5358static struct image_type *image_types;
5359
5360/* A list of symbols, one for each supported image type. */
5361
5362Lisp_Object Vimage_types;
5363
5364/* The symbol `image' which is the car of the lists used to represent
5365 images in Lisp. */
5366
5367extern Lisp_Object Qimage;
5368
5369/* The symbol `xbm' which is used as the type symbol for XBM images. */
5370
5371Lisp_Object Qxbm;
5372
5373/* Keywords. */
5374
5375Lisp_Object QCtype, QCdata, QCfile, QCascent, QCmargin, QCrelief;
5376extern Lisp_Object QCwidth, QCheight, QCforeground, QCbackground;
5377Lisp_Object QCalgorithm, QCcolor_symbols, QCheuristic_mask;
5378extern Lisp_Object QCimage;
5379
5380/* Other symbols. */
5381
5382Lisp_Object Qlaplace;
5383
5384/* Time in seconds after which images should be removed from the cache
5385 if not displayed. */
5386
5387Lisp_Object Vimage_eviction_seconds;
5388
5389/* Function prototypes. */
5390
5391static void define_image_type P_ ((struct image_type *type));
5392static struct image_type *lookup_image_type P_ ((Lisp_Object symbol));
5393static void image_error P_ ((char *format, Lisp_Object, Lisp_Object));
5394static void x_laplace P_ ((struct frame *, struct image *));
5395static int x_build_heuristic_mask P_ ((struct frame *, Lisp_Object,
5396 struct image *, Lisp_Object));
5397
5398
5399/* Define a new image type from TYPE. This adds a copy of TYPE to
5400 image_types and adds the symbol *TYPE->type to Vimage_types. */
5401
5402static void
5403define_image_type (type)
5404 struct image_type *type;
5405{
5406 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
5407 The initialized data segment is read-only. */
5408 struct image_type *p = (struct image_type *) xmalloc (sizeof *p);
5409 bcopy (type, p, sizeof *p);
5410 p->next = image_types;
5411 image_types = p;
5412 Vimage_types = Fcons (*p->type, Vimage_types);
5413}
5414
5415
5416/* Look up image type SYMBOL, and return a pointer to its image_type
5417 structure. Value is null if SYMBOL is not a known image type. */
5418
5419static INLINE struct image_type *
5420lookup_image_type (symbol)
5421 Lisp_Object symbol;
5422{
5423 struct image_type *type;
5424
5425 for (type = image_types; type; type = type->next)
5426 if (EQ (symbol, *type->type))
5427 break;
5428
5429 return type;
5430}
5431
5432
5433/* Value is non-zero if OBJECT is a valid Lisp image specification. A
5434 valid image specification is a list whose car is the symbol
5435 `image', and whose rest is a property list. The property list must
5436 contain a value for key `:type'. That value must be the name of a
5437 supported image type. The rest of the property list depends on the
5438 image type. */
5439
5440int
5441valid_image_p (object)
5442 Lisp_Object object;
5443{
5444 int valid_p = 0;
5445
5446 if (CONSP (object) && EQ (XCAR (object), Qimage))
5447 {
5448 Lisp_Object symbol = Fplist_get (XCDR (object), QCtype);
5449 struct image_type *type = lookup_image_type (symbol);
5450
5451 if (type)
5452 valid_p = type->valid_p (object);
5453 }
5454
5455 return valid_p;
5456}
5457
5458
5459/* Display an error message with format string FORMAT and argument
5460 ARG. Signaling an error, e.g. when an image cannot be loaded,
5461 is not a good idea because this would interrupt redisplay, and
5462 the error message display would lead to another redisplay. This
5463 function therefore simply displays a message. */
5464
5465static void
5466image_error (format, arg1, arg2)
5467 char *format;
5468 Lisp_Object arg1, arg2;
5469{
5470 Lisp_Object args[3];
5471
5472 args[0] = build_string (format);
5473 args[1] = arg1;
5474 args[2] = arg2;
5475 Fmessage (make_number (DIM (args)), args);
5476}
5477
5478
5479
5480/***********************************************************************
5481 Image specifications
5482 ***********************************************************************/
5483
5484enum image_value_type
5485{
5486 IMAGE_DONT_CHECK_VALUE_TYPE,
5487 IMAGE_STRING_VALUE,
5488 IMAGE_SYMBOL_VALUE,
5489 IMAGE_POSITIVE_INTEGER_VALUE,
5490 IMAGE_NON_NEGATIVE_INTEGER_VALUE,
5491 IMAGE_INTEGER_VALUE,
5492 IMAGE_FUNCTION_VALUE,
5493 IMAGE_NUMBER_VALUE,
5494 IMAGE_BOOL_VALUE
5495};
5496
5497/* Structure used when parsing image specifications. */
5498
5499struct image_keyword
5500{
5501 /* Name of keyword. */
5502 char *name;
5503
5504 /* The type of value allowed. */
5505 enum image_value_type type;
5506
5507 /* Non-zero means key must be present. */
5508 int mandatory_p;
5509
5510 /* Used to recognize duplicate keywords in a property list. */
5511 int count;
5512
5513 /* The value that was found. */
5514 Lisp_Object value;
5515};
5516
5517
5518static int parse_image_spec P_ ((Lisp_Object spec,
5519 struct image_keyword *keywords,
5520 int nkeywords, Lisp_Object type,
5521 int allow_other_keys_p));
5522static Lisp_Object image_spec_value P_ ((Lisp_Object, Lisp_Object, int *));
5523
5524
5525/* Parse image spec SPEC according to KEYWORDS. A valid image spec
5526 has the format (image KEYWORD VALUE ...). One of the keyword/
5527 value pairs must be `:type TYPE'. KEYWORDS is a vector of
5528 image_keywords structures of size NKEYWORDS describing other
5529 allowed keyword/value pairs. ALLOW_OTHER_KEYS_P non-zero means
5530 allow KEYWORD/VALUE pairs other than those described by KEYWORDS
5531 without checking them. Value is non-zero if SPEC is valid. */
5532
5533static int
5534parse_image_spec (spec, keywords, nkeywords, type, allow_other_keys_p)
5535 Lisp_Object spec;
5536 struct image_keyword *keywords;
5537 int nkeywords;
5538 Lisp_Object type;
5539 int allow_other_keys_p;
5540{
5541 int i;
5542 Lisp_Object plist;
5543
5544 if (!CONSP (spec) || !EQ (XCAR (spec), Qimage))
5545 return 0;
5546
5547 plist = XCDR (spec);
5548 while (CONSP (plist))
5549 {
5550 Lisp_Object key, value;
5551
5552 /* First element of a pair must be a symbol. */
5553 key = XCAR (plist);
5554 plist = XCDR (plist);
5555 if (!SYMBOLP (key))
5556 return 0;
5557
5558 /* There must follow a value. */
5559 if (!CONSP (plist))
5560 return 0;
5561 value = XCAR (plist);
5562 plist = XCDR (plist);
5563
5564 /* Find key in KEYWORDS. Error if not found. */
5565 for (i = 0; i < nkeywords; ++i)
5566 if (strcmp (keywords[i].name, XSYMBOL (key)->name->data) == 0)
5567 break;
5568
5569 if (i == nkeywords)
5570 {
5571 if (!allow_other_keys_p)
5572 return 0;
5573 continue;
5574 }
5575
5576 /* Record that we recognized the keyword. If a keywords
5577 was found more than once, it's an error. */
5578 keywords[i].value = value;
5579 ++keywords[i].count;
5580
5581 if (keywords[i].count > 1)
5582 return 0;
5583
5584 /* Check type of value against allowed type. */
5585 switch (keywords[i].type)
5586 {
5587 case IMAGE_STRING_VALUE:
5588 if (!STRINGP (value))
5589 return 0;
5590 break;
5591
5592 case IMAGE_SYMBOL_VALUE:
5593 if (!SYMBOLP (value))
5594 return 0;
5595 break;
5596
5597 case IMAGE_POSITIVE_INTEGER_VALUE:
5598 if (!INTEGERP (value) || XINT (value) <= 0)
5599 return 0;
5600 break;
5601
5602 case IMAGE_NON_NEGATIVE_INTEGER_VALUE:
5603 if (!INTEGERP (value) || XINT (value) < 0)
5604 return 0;
5605 break;
5606
5607 case IMAGE_DONT_CHECK_VALUE_TYPE:
5608 break;
5609
5610 case IMAGE_FUNCTION_VALUE:
5611 value = indirect_function (value);
5612 if (SUBRP (value)
5613 || COMPILEDP (value)
5614 || (CONSP (value) && EQ (XCAR (value), Qlambda)))
5615 break;
5616 return 0;
5617
5618 case IMAGE_NUMBER_VALUE:
5619 if (!INTEGERP (value) && !FLOATP (value))
5620 return 0;
5621 break;
5622
5623 case IMAGE_INTEGER_VALUE:
5624 if (!INTEGERP (value))
5625 return 0;
5626 break;
5627
5628 case IMAGE_BOOL_VALUE:
5629 if (!NILP (value) && !EQ (value, Qt))
5630 return 0;
5631 break;
5632
5633 default:
5634 abort ();
5635 break;
5636 }
5637
5638 if (EQ (key, QCtype) && !EQ (type, value))
5639 return 0;
5640 }
5641
5642 /* Check that all mandatory fields are present. */
5643 for (i = 0; i < nkeywords; ++i)
5644 if (keywords[i].mandatory_p && keywords[i].count == 0)
5645 return 0;
5646
5647 return NILP (plist);
5648}
5649
5650
5651/* Return the value of KEY in image specification SPEC. Value is nil
5652 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
5653 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
5654
5655static Lisp_Object
5656image_spec_value (spec, key, found)
5657 Lisp_Object spec, key;
5658 int *found;
5659{
5660 Lisp_Object tail;
5661
5662 xassert (valid_image_p (spec));
5663
5664 for (tail = XCDR (spec);
5665 CONSP (tail) && CONSP (XCDR (tail));
5666 tail = XCDR (XCDR (tail)))
5667 {
5668 if (EQ (XCAR (tail), key))
5669 {
5670 if (found)
5671 *found = 1;
5672 return XCAR (XCDR (tail));
5673 }
5674 }
5675
5676 if (found)
5677 *found = 0;
5678 return Qnil;
5679}
5680
5681
5682
5683
5684/***********************************************************************
5685 Image type independent image structures
5686 ***********************************************************************/
5687
5688static struct image *make_image P_ ((Lisp_Object spec, unsigned hash));
5689static void free_image P_ ((struct frame *f, struct image *img));
5690
5691
5692/* Allocate and return a new image structure for image specification
5693 SPEC. SPEC has a hash value of HASH. */
5694
5695static struct image *
5696make_image (spec, hash)
5697 Lisp_Object spec;
5698 unsigned hash;
5699{
5700 struct image *img = (struct image *) xmalloc (sizeof *img);
5701
5702 xassert (valid_image_p (spec));
5703 bzero (img, sizeof *img);
5704 img->type = lookup_image_type (image_spec_value (spec, QCtype, NULL));
5705 xassert (img->type != NULL);
5706 img->spec = spec;
5707 img->data.lisp_val = Qnil;
5708 img->ascent = DEFAULT_IMAGE_ASCENT;
5709 img->hash = hash;
5710 return img;
5711}
5712
5713
5714/* Free image IMG which was used on frame F, including its resources. */
5715
5716static void
5717free_image (f, img)
5718 struct frame *f;
5719 struct image *img;
5720{
5721 if (img)
5722 {
5723 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
5724
5725 /* Remove IMG from the hash table of its cache. */
5726 if (img->prev)
5727 img->prev->next = img->next;
5728 else
5729 c->buckets[img->hash % IMAGE_CACHE_BUCKETS_SIZE] = img->next;
5730
5731 if (img->next)
5732 img->next->prev = img->prev;
5733
5734 c->images[img->id] = NULL;
5735
5736 /* Free resources, then free IMG. */
5737 img->type->free (f, img);
5738 xfree (img);
5739 }
5740}
5741
5742
5743/* Prepare image IMG for display on frame F. Must be called before
5744 drawing an image. */
5745
5746void
5747prepare_image_for_display (f, img)
5748 struct frame *f;
5749 struct image *img;
5750{
5751 EMACS_TIME t;
5752
5753 /* We're about to display IMG, so set its timestamp to `now'. */
5754 EMACS_GET_TIME (t);
5755 img->timestamp = EMACS_SECS (t);
5756
5757 /* If IMG doesn't have a pixmap yet, load it now, using the image
5758 type dependent loader function. */
5759 if (img->pixmap == 0)
5760 img->type->load (f, img);
5761}
5762
5763
5764
5765/***********************************************************************
5766 Helper functions for X image types
5767 ***********************************************************************/
5768
5769static void x_clear_image P_ ((struct frame *f, struct image *img));
5770static unsigned long x_alloc_image_color P_ ((struct frame *f,
5771 struct image *img,
5772 Lisp_Object color_name,
5773 unsigned long dflt));
5774
5775/* Free X resources of image IMG which is used on frame F. */
5776
5777static void
5778x_clear_image (f, img)
5779 struct frame *f;
5780 struct image *img;
5781{
5782 if (img->pixmap)
5783 {
5784 BLOCK_INPUT;
5785 XFreePixmap (FRAME_X_DISPLAY (f), img->pixmap);
5786 img->pixmap = 0;
5787 UNBLOCK_INPUT;
5788 }
5789
5790 if (img->ncolors)
5791 {
5792 int class = FRAME_X_DISPLAY_INFO (f)->visual->class;
5793
5794 /* If display has an immutable color map, freeing colors is not
5795 necessary and some servers don't allow it. So don't do it. */
5796 if (class != StaticColor
5797 && class != StaticGray
5798 && class != TrueColor)
5799 {
5800 Colormap cmap;
5801 BLOCK_INPUT;
5802 cmap = DefaultColormapOfScreen (FRAME_X_DISPLAY_INFO (f)->screen);
5803 XFreeColors (FRAME_X_DISPLAY (f), cmap, img->colors,
5804 img->ncolors, 0);
5805 UNBLOCK_INPUT;
5806 }
5807
5808 xfree (img->colors);
5809 img->colors = NULL;
5810 img->ncolors = 0;
5811 }
5812}
5813
5814
5815/* Allocate color COLOR_NAME for image IMG on frame F. If color
5816 cannot be allocated, use DFLT. Add a newly allocated color to
5817 IMG->colors, so that it can be freed again. Value is the pixel
5818 color. */
5819
5820static unsigned long
5821x_alloc_image_color (f, img, color_name, dflt)
5822 struct frame *f;
5823 struct image *img;
5824 Lisp_Object color_name;
5825 unsigned long dflt;
5826{
5827 XColor color;
5828 unsigned long result;
5829
5830 xassert (STRINGP (color_name));
5831
5832 if (defined_color (f, XSTRING (color_name)->data, &color, 1))
5833 {
5834 /* This isn't called frequently so we get away with simply
5835 reallocating the color vector to the needed size, here. */
5836 ++img->ncolors;
5837 img->colors =
5838 (unsigned long *) xrealloc (img->colors,
5839 img->ncolors * sizeof *img->colors);
5840 img->colors[img->ncolors - 1] = color.pixel;
5841 result = color.pixel;
5842 }
5843 else
5844 result = dflt;
5845
5846 return result;
5847}
5848
5849
5850
5851/***********************************************************************
5852 Image Cache
5853 ***********************************************************************/
5854
5855static void cache_image P_ ((struct frame *f, struct image *img));
5856
5857
5858/* Return a new, initialized image cache that is allocated from the
5859 heap. Call free_image_cache to free an image cache. */
5860
5861struct image_cache *
5862make_image_cache ()
5863{
5864 struct image_cache *c = (struct image_cache *) xmalloc (sizeof *c);
5865 int size;
5866
5867 bzero (c, sizeof *c);
5868 c->size = 50;
5869 c->images = (struct image **) xmalloc (c->size * sizeof *c->images);
5870 size = IMAGE_CACHE_BUCKETS_SIZE * sizeof *c->buckets;
5871 c->buckets = (struct image **) xmalloc (size);
5872 bzero (c->buckets, size);
5873 return c;
5874}
5875
5876
5877/* Free image cache of frame F. Be aware that X frames share images
5878 caches. */
5879
5880void
5881free_image_cache (f)
5882 struct frame *f;
5883{
5884 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
5885 if (c)
5886 {
5887 int i;
5888
5889 /* Cache should not be referenced by any frame when freed. */
5890 xassert (c->refcount == 0);
5891
5892 for (i = 0; i < c->used; ++i)
5893 free_image (f, c->images[i]);
5894 xfree (c->images);
5895 xfree (c);
5896 xfree (c->buckets);
5897 FRAME_X_IMAGE_CACHE (f) = NULL;
5898 }
5899}
5900
5901
5902/* Clear image cache of frame F. FORCE_P non-zero means free all
5903 images. FORCE_P zero means clear only images that haven't been
5904 displayed for some time. Should be called from time to time to
5905 reduce the number of loaded images. If image-eviction-seconds is
5906 non-nil, this frees images in the cache which weren't displayed for
5907 at least that many seconds. */
5908
5909void
5910clear_image_cache (f, force_p)
5911 struct frame *f;
5912 int force_p;
5913{
5914 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
5915
5916 if (c && INTEGERP (Vimage_eviction_seconds))
5917 {
5918 EMACS_TIME t;
5919 unsigned long old;
5920 int i, any_freed_p = 0;
5921
5922 EMACS_GET_TIME (t);
5923 old = EMACS_SECS (t) - XFASTINT (Vimage_eviction_seconds);
5924
5925 for (i = 0; i < c->used; ++i)
5926 {
5927 struct image *img = c->images[i];
5928 if (img != NULL
5929 && (force_p
5930 || (img->timestamp > old)))
5931 {
5932 free_image (f, img);
5933 any_freed_p = 1;
5934 }
5935 }
5936
5937 /* We may be clearing the image cache because, for example,
5938 Emacs was iconified for a longer period of time. In that
5939 case, current matrices may still contain references to
5940 images freed above. So, clear these matrices. */
5941 if (any_freed_p)
5942 {
5943 clear_current_matrices (f);
5944 ++windows_or_buffers_changed;
5945 }
5946 }
5947}
5948
5949
5950DEFUN ("clear-image-cache", Fclear_image_cache, Sclear_image_cache,
5951 0, 1, 0,
5952 "Clear the image cache of FRAME.\n\
5953FRAME nil or omitted means use the selected frame.\n\
5954FRAME t means clear the image caches of all frames.")
5955 (frame)
5956 Lisp_Object frame;
5957{
5958 if (EQ (frame, Qt))
5959 {
5960 Lisp_Object tail;
5961
5962 FOR_EACH_FRAME (tail, frame)
5963 if (FRAME_X_P (XFRAME (frame)))
5964 clear_image_cache (XFRAME (frame), 1);
5965 }
5966 else
5967 clear_image_cache (check_x_frame (frame), 1);
5968
5969 return Qnil;
5970}
5971
5972
5973/* Return the id of image with Lisp specification SPEC on frame F.
5974 SPEC must be a valid Lisp image specification (see valid_image_p). */
5975
5976int
5977lookup_image (f, spec)
5978 struct frame *f;
5979 Lisp_Object spec;
5980{
5981 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
5982 struct image *img;
5983 int i;
5984 unsigned hash;
5985 struct gcpro gcpro1;
5986
5987 /* F must be a window-system frame, and SPEC must be a valid image
5988 specification. */
5989 xassert (FRAME_WINDOW_P (f));
5990 xassert (valid_image_p (spec));
5991
5992 GCPRO1 (spec);
5993
5994 /* Look up SPEC in the hash table of the image cache. */
5995 hash = sxhash (spec, 0);
5996 i = hash % IMAGE_CACHE_BUCKETS_SIZE;
5997
5998 for (img = c->buckets[i]; img; img = img->next)
5999 if (img->hash == hash && !NILP (Fequal (img->spec, spec)))
6000 break;
6001
6002 /* If not found, create a new image and cache it. */
6003 if (img == NULL)
6004 {
6005 extern Lisp_Object QCenable, QCselect;
6006 Lisp_Object tem;
6007 int loading_failed_p;
6008
6009 img = make_image (spec, hash);
6010 cache_image (f, img);
6011 loading_failed_p = img->type->load (f, img) == 0;
6012
6013 /* If we can't load the image, and we don't have a width and
6014 height, use some arbitrary width and height so that we can
6015 draw a rectangle for it. */
6016 if (loading_failed_p)
6017 {
6018 Lisp_Object value;
6019
6020 value = image_spec_value (spec, QCwidth, NULL);
6021 img->width = (INTEGERP (value)
6022 ? XFASTINT (value) : DEFAULT_IMAGE_WIDTH);
6023 value = image_spec_value (spec, QCheight, NULL);
6024 img->height = (INTEGERP (value)
6025 ? XFASTINT (value) : DEFAULT_IMAGE_HEIGHT);
6026 }
6027 else
6028 {
6029 /* Handle image type independent image attributes
6030 `:ascent PERCENT', `:margin MARGIN', `:relief RELIEF'. */
6031 Lisp_Object ascent, margin, relief, algorithm, heuristic_mask;
6032 Lisp_Object file;
6033
6034 ascent = image_spec_value (spec, QCascent, NULL);
6035 if (INTEGERP (ascent))
6036 img->ascent = XFASTINT (ascent);
6037
6038 margin = image_spec_value (spec, QCmargin, NULL);
6039 if (INTEGERP (margin) && XINT (margin) >= 0)
6040 img->margin = XFASTINT (margin);
6041
6042 relief = image_spec_value (spec, QCrelief, NULL);
6043 if (INTEGERP (relief))
6044 {
6045 img->relief = XINT (relief);
6046 img->margin += abs (img->relief);
6047 }
6048
6049 /* Should we apply a Laplace edge-detection algorithm? */
6050 algorithm = image_spec_value (spec, QCalgorithm, NULL);
6051 if (img->pixmap && EQ (algorithm, Qlaplace))
6052 x_laplace (f, img);
6053
6054 /* Should we built a mask heuristically? */
6055 heuristic_mask = image_spec_value (spec, QCheuristic_mask, NULL);
6056 if (img->pixmap && !img->mask && !NILP (heuristic_mask))
6057 {
6058 file = image_spec_value (spec, QCfile, NULL);
6059 x_build_heuristic_mask (f, file, img, heuristic_mask);
6060 }
6061 }
6062 }
6063
6064 UNGCPRO;
6065
6066 /* Value is the image id. */
6067 return img->id;
6068}
6069
6070
6071/* Cache image IMG in the image cache of frame F. */
6072
6073static void
6074cache_image (f, img)
6075 struct frame *f;
6076 struct image *img;
6077{
6078 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
6079 int i;
6080
6081 /* Find a free slot in c->images. */
6082 for (i = 0; i < c->used; ++i)
6083 if (c->images[i] == NULL)
6084 break;
6085
6086 /* If no free slot found, maybe enlarge c->images. */
6087 if (i == c->used && c->used == c->size)
6088 {
6089 c->size *= 2;
6090 c->images = (struct image **) xrealloc (c->images,
6091 c->size * sizeof *c->images);
6092 }
6093
6094 /* Add IMG to c->images, and assign IMG an id. */
6095 c->images[i] = img;
6096 img->id = i;
6097 if (i == c->used)
6098 ++c->used;
6099
6100 /* Add IMG to the cache's hash table. */
6101 i = img->hash % IMAGE_CACHE_BUCKETS_SIZE;
6102 img->next = c->buckets[i];
6103 if (img->next)
6104 img->next->prev = img;
6105 img->prev = NULL;
6106 c->buckets[i] = img;
6107}
6108
6109
6110/* Call FN on every image in the image cache of frame F. Used to mark
6111 Lisp Objects in the image cache. */
6112
6113void
6114forall_images_in_image_cache (f, fn)
6115 struct frame *f;
6116 void (*fn) P_ ((struct image *img));
6117{
6118 if (FRAME_LIVE_P (f) && FRAME_X_P (f))
6119 {
6120 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
6121 if (c)
6122 {
6123 int i;
6124 for (i = 0; i < c->used; ++i)
6125 if (c->images[i])
6126 fn (c->images[i]);
6127 }
6128 }
6129}
6130
6131
6132
6133/***********************************************************************
6134 X support code
6135 ***********************************************************************/
6136
6137static int x_create_x_image_and_pixmap P_ ((struct frame *, Lisp_Object,
6138 int, int, int, XImage **,
6139 Pixmap *));
6140static void x_destroy_x_image P_ ((XImage *));
6141static void x_put_x_image P_ ((struct frame *, XImage *, Pixmap, int, int));
6142
6143
6144/* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
6145 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
6146 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
6147 via xmalloc. Print error messages via image_error if an error
6148 occurs. FILE is the name of an image file being processed, for
6149 error messages. Value is non-zero if successful. */
6150
6151static int
6152x_create_x_image_and_pixmap (f, file, width, height, depth, ximg, pixmap)
6153 struct frame *f;
6154 Lisp_Object file;
6155 int width, height, depth;
6156 XImage **ximg;
6157 Pixmap *pixmap;
6158{
6159 Display *display = FRAME_X_DISPLAY (f);
6160 Screen *screen = FRAME_X_SCREEN (f);
6161 Window window = FRAME_X_WINDOW (f);
6162
6163 xassert (interrupt_input_blocked);
6164
6165 if (depth <= 0)
6166 depth = DefaultDepthOfScreen (screen);
6167 *ximg = XCreateImage (display, DefaultVisualOfScreen (screen),
6168 depth, ZPixmap, 0, NULL, width, height,
6169 depth > 16 ? 32 : depth > 8 ? 16 : 8, 0);
6170 if (*ximg == NULL)
6171 {
6172 image_error ("Unable to allocate X image for %s", file, Qnil);
6173 return 0;
6174 }
6175
6176 /* Allocate image raster. */
6177 (*ximg)->data = (char *) xmalloc ((*ximg)->bytes_per_line * height);
6178
6179 /* Allocate a pixmap of the same size. */
6180 *pixmap = XCreatePixmap (display, window, width, height, depth);
6181 if (*pixmap == 0)
6182 {
6183 x_destroy_x_image (*ximg);
6184 *ximg = NULL;
6185 image_error ("Unable to create pixmap for `%s'", file, Qnil);
6186 return 0;
6187 }
6188
6189 return 1;
6190}
6191
6192
6193/* Destroy XImage XIMG. Free XIMG->data. */
6194
6195static void
6196x_destroy_x_image (ximg)
6197 XImage *ximg;
6198{
6199 xassert (interrupt_input_blocked);
6200 if (ximg)
6201 {
6202 xfree (ximg->data);
6203 ximg->data = NULL;
6204 XDestroyImage (ximg);
6205 }
6206}
6207
6208
6209/* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
6210 are width and height of both the image and pixmap. */
6211
6212void
6213x_put_x_image (f, ximg, pixmap, width, height)
6214 struct frame *f;
6215 XImage *ximg;
6216 Pixmap pixmap;
6217{
6218 GC gc;
6219
6220 xassert (interrupt_input_blocked);
6221 gc = XCreateGC (FRAME_X_DISPLAY (f), pixmap, 0, NULL);
6222 XPutImage (FRAME_X_DISPLAY (f), pixmap, gc, ximg, 0, 0, 0, 0, width, height);
6223 XFreeGC (FRAME_X_DISPLAY (f), gc);
6224}
6225
6226
6227
6228/***********************************************************************
6229 Searching files
6230 ***********************************************************************/
6231
6232static Lisp_Object x_find_image_file P_ ((Lisp_Object));
6233
6234/* Find image file FILE. Look in data-directory, then
6235 x-bitmap-file-path. Value is the full name of the file found, or
6236 nil if not found. */
6237
6238static Lisp_Object
6239x_find_image_file (file)
6240 Lisp_Object file;
6241{
6242 Lisp_Object file_found, search_path;
6243 struct gcpro gcpro1, gcpro2;
6244 int fd;
6245
6246 file_found = Qnil;
6247 search_path = Fcons (Vdata_directory, Vx_bitmap_file_path);
6248 GCPRO2 (file_found, search_path);
6249
6250 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
6251 fd = openp (search_path, file, "", &file_found, 0);
6252
6253 if (fd < 0)
6254 file_found = Qnil;
6255 else
6256 close (fd);
6257
6258 UNGCPRO;
6259 return file_found;
6260}
6261
6262
6263
6264/***********************************************************************
6265 XBM images
6266 ***********************************************************************/
6267
6268static int xbm_load P_ ((struct frame *f, struct image *img));
6269static int xbm_load_image_from_file P_ ((struct frame *f, struct image *img,
6270 Lisp_Object file));
6271static int xbm_image_p P_ ((Lisp_Object object));
6272static int xbm_read_bitmap_file_data P_ ((char *, int *, int *,
6273 unsigned char **));
6274static int xbm_read_hexint P_ ((FILE *));
6275
6276
6277/* Indices of image specification fields in xbm_format, below. */
6278
6279enum xbm_keyword_index
6280{
6281 XBM_TYPE,
6282 XBM_FILE,
6283 XBM_WIDTH,
6284 XBM_HEIGHT,
6285 XBM_DATA,
6286 XBM_FOREGROUND,
6287 XBM_BACKGROUND,
6288 XBM_ASCENT,
6289 XBM_MARGIN,
6290 XBM_RELIEF,
6291 XBM_ALGORITHM,
6292 XBM_HEURISTIC_MASK,
6293 XBM_LAST
6294};
6295
6296/* Vector of image_keyword structures describing the format
6297 of valid XBM image specifications. */
6298
6299static struct image_keyword xbm_format[XBM_LAST] =
6300{
6301 {":type", IMAGE_SYMBOL_VALUE, 1},
6302 {":file", IMAGE_STRING_VALUE, 0},
6303 {":width", IMAGE_POSITIVE_INTEGER_VALUE, 0},
6304 {":height", IMAGE_POSITIVE_INTEGER_VALUE, 0},
6305 {":data", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6306 {":foreground", IMAGE_STRING_VALUE, 0},
6307 {":background", IMAGE_STRING_VALUE, 0},
6308 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
6309 {":margin", IMAGE_POSITIVE_INTEGER_VALUE, 0},
6310 {":relief", IMAGE_INTEGER_VALUE, 0},
6311 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6312 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
6313};
6314
6315/* Structure describing the image type XBM. */
6316
6317static struct image_type xbm_type =
6318{
6319 &Qxbm,
6320 xbm_image_p,
6321 xbm_load,
6322 x_clear_image,
6323 NULL
6324};
6325
6326/* Tokens returned from xbm_scan. */
6327
6328enum xbm_token
6329{
6330 XBM_TK_IDENT = 256,
6331 XBM_TK_NUMBER
6332};
6333
6334
6335/* Return non-zero if OBJECT is a valid XBM-type image specification.
6336 A valid specification is a list starting with the symbol `image'
6337 The rest of the list is a property list which must contain an
6338 entry `:type xbm..
6339
6340 If the specification specifies a file to load, it must contain
6341 an entry `:file FILENAME' where FILENAME is a string.
6342
6343 If the specification is for a bitmap loaded from memory it must
6344 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
6345 WIDTH and HEIGHT are integers > 0. DATA may be:
6346
6347 1. a string large enough to hold the bitmap data, i.e. it must
6348 have a size >= (WIDTH + 7) / 8 * HEIGHT
6349
6350 2. a bool-vector of size >= WIDTH * HEIGHT
6351
6352 3. a vector of strings or bool-vectors, one for each line of the
6353 bitmap.
6354
6355 Both the file and data forms may contain the additional entries
6356 `:background COLOR' and `:foreground COLOR'. If not present,
6357 foreground and background of the frame on which the image is
6358 displayed, is used. */
6359
6360static int
6361xbm_image_p (object)
6362 Lisp_Object object;
6363{
6364 struct image_keyword kw[XBM_LAST];
6365
6366 bcopy (xbm_format, kw, sizeof kw);
6367 if (!parse_image_spec (object, kw, XBM_LAST, Qxbm, 0))
6368 return 0;
6369
6370 xassert (EQ (kw[XBM_TYPE].value, Qxbm));
6371
6372 if (kw[XBM_FILE].count)
6373 {
6374 if (kw[XBM_WIDTH].count || kw[XBM_HEIGHT].count || kw[XBM_DATA].count)
6375 return 0;
6376 }
6377 else
6378 {
6379 Lisp_Object data;
6380 int width, height;
6381
6382 /* Entries for `:width', `:height' and `:data' must be present. */
6383 if (!kw[XBM_WIDTH].count
6384 || !kw[XBM_HEIGHT].count
6385 || !kw[XBM_DATA].count)
6386 return 0;
6387
6388 data = kw[XBM_DATA].value;
6389 width = XFASTINT (kw[XBM_WIDTH].value);
6390 height = XFASTINT (kw[XBM_HEIGHT].value);
6391
6392 /* Check type of data, and width and height against contents of
6393 data. */
6394 if (VECTORP (data))
6395 {
6396 int i;
6397
6398 /* Number of elements of the vector must be >= height. */
6399 if (XVECTOR (data)->size < height)
6400 return 0;
6401
6402 /* Each string or bool-vector in data must be large enough
6403 for one line of the image. */
6404 for (i = 0; i < height; ++i)
6405 {
6406 Lisp_Object elt = XVECTOR (data)->contents[i];
6407
6408 if (STRINGP (elt))
6409 {
6410 if (XSTRING (elt)->size
6411 < (width + BITS_PER_CHAR - 1) / BITS_PER_CHAR)
6412 return 0;
6413 }
6414 else if (BOOL_VECTOR_P (elt))
6415 {
6416 if (XBOOL_VECTOR (elt)->size < width)
6417 return 0;
6418 }
6419 else
6420 return 0;
6421 }
6422 }
6423 else if (STRINGP (data))
6424 {
6425 if (XSTRING (data)->size
6426 < (width + BITS_PER_CHAR - 1) / BITS_PER_CHAR * height)
6427 return 0;
6428 }
6429 else if (BOOL_VECTOR_P (data))
6430 {
6431 if (XBOOL_VECTOR (data)->size < width * height)
6432 return 0;
6433 }
6434 else
6435 return 0;
6436 }
6437
6438 /* Baseline must be a value between 0 and 100 (a percentage). */
6439 if (kw[XBM_ASCENT].count
6440 && XFASTINT (kw[XBM_ASCENT].value) > 100)
6441 return 0;
6442
6443 return 1;
6444}
6445
6446
6447/* Scan a bitmap file. FP is the stream to read from. Value is
6448 either an enumerator from enum xbm_token, or a character for a
6449 single-character token, or 0 at end of file. If scanning an
6450 identifier, store the lexeme of the identifier in SVAL. If
6451 scanning a number, store its value in *IVAL. */
6452
6453static int
6454xbm_scan (fp, sval, ival)
6455 FILE *fp;
6456 char *sval;
6457 int *ival;
6458{
6459 int c;
6460
6461 /* Skip white space. */
6462 while ((c = fgetc (fp)) != EOF && isspace (c))
6463 ;
6464
6465 if (c == EOF)
6466 c = 0;
6467 else if (isdigit (c))
6468 {
6469 int value = 0, digit;
6470
6471 if (c == '0')
6472 {
6473 c = fgetc (fp);
6474 if (c == 'x' || c == 'X')
6475 {
6476 while ((c = fgetc (fp)) != EOF)
6477 {
6478 if (isdigit (c))
6479 digit = c - '0';
6480 else if (c >= 'a' && c <= 'f')
6481 digit = c - 'a' + 10;
6482 else if (c >= 'A' && c <= 'F')
6483 digit = c - 'A' + 10;
6484 else
6485 break;
6486 value = 16 * value + digit;
6487 }
6488 }
6489 else if (isdigit (c))
6490 {
6491 value = c - '0';
6492 while ((c = fgetc (fp)) != EOF
6493 && isdigit (c))
6494 value = 8 * value + c - '0';
6495 }
6496 }
6497 else
6498 {
6499 value = c - '0';
6500 while ((c = fgetc (fp)) != EOF
6501 && isdigit (c))
6502 value = 10 * value + c - '0';
6503 }
6504
6505 if (c != EOF)
6506 ungetc (c, fp);
6507 *ival = value;
6508 c = XBM_TK_NUMBER;
6509 }
6510 else if (isalpha (c) || c == '_')
6511 {
6512 *sval++ = c;
6513 while ((c = fgetc (fp)) != EOF
6514 && (isalnum (c) || c == '_'))
6515 *sval++ = c;
6516 *sval = 0;
6517 if (c != EOF)
6518 ungetc (c, fp);
6519 c = XBM_TK_IDENT;
6520 }
6521
6522 return c;
6523}
6524
6525
6526/* Replacement for XReadBitmapFileData which isn't available under old
6527 X versions. FILE is the name of the bitmap file to read. Set
6528 *WIDTH and *HEIGHT to the width and height of the image. Return in
6529 *DATA the bitmap data allocated with xmalloc. Value is non-zero if
6530 successful. */
6531
6532static int
6533xbm_read_bitmap_file_data (file, width, height, data)
6534 char *file;
6535 int *width, *height;
6536 unsigned char **data;
6537{
6538 FILE *fp;
6539 char buffer[BUFSIZ];
6540 int padding_p = 0;
6541 int v10 = 0;
6542 int bytes_per_line, i, nbytes;
6543 unsigned char *p;
6544 int value;
6545 int LA1;
6546
6547#define match() \
6548 LA1 = xbm_scan (fp, buffer, &value)
6549
6550#define expect(TOKEN) \
6551 if (LA1 != (TOKEN)) \
6552 goto failure; \
6553 else \
6554 match ()
6555
6556#define expect_ident(IDENT) \
6557 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
6558 match (); \
6559 else \
6560 goto failure
6561
6562 fp = fopen (file, "r");
6563 if (fp == NULL)
6564 return 0;
6565
6566 *width = *height = -1;
6567 *data = NULL;
6568 LA1 = xbm_scan (fp, buffer, &value);
6569
6570 /* Parse defines for width, height and hot-spots. */
6571 while (LA1 == '#')
6572 {
6573 char *p;
6574
6575 match ();
6576 expect_ident ("define");
6577 expect (XBM_TK_IDENT);
6578
6579 if (LA1 == XBM_TK_NUMBER);
6580 {
6581 char *p = strrchr (buffer, '_');
6582 p = p ? p + 1 : buffer;
6583 if (strcmp (p, "width") == 0)
6584 *width = value;
6585 else if (strcmp (p, "height") == 0)
6586 *height = value;
6587 }
6588 expect (XBM_TK_NUMBER);
6589 }
6590
6591 if (*width < 0 || *height < 0)
6592 goto failure;
6593
6594 /* Parse bits. Must start with `static'. */
6595 expect_ident ("static");
6596 if (LA1 == XBM_TK_IDENT)
6597 {
6598 if (strcmp (buffer, "unsigned") == 0)
6599 {
6600 match ();
6601 expect_ident ("char");
6602 }
6603 else if (strcmp (buffer, "short") == 0)
6604 {
6605 match ();
6606 v10 = 1;
6607 if (*width % 16 && *width % 16 < 9)
6608 padding_p = 1;
6609 }
6610 else if (strcmp (buffer, "char") == 0)
6611 match ();
6612 else
6613 goto failure;
6614 }
6615 else
6616 goto failure;
6617
6618 expect (XBM_TK_IDENT);
6619 expect ('[');
6620 expect (']');
6621 expect ('=');
6622 expect ('{');
6623
6624 bytes_per_line = (*width + 7) / 8 + padding_p;
6625 nbytes = bytes_per_line * *height;
6626 p = *data = (char *) xmalloc (nbytes);
6627
6628 if (v10)
6629 {
6630
6631 for (i = 0; i < nbytes; i += 2)
6632 {
6633 int val = value;
6634 expect (XBM_TK_NUMBER);
6635
6636 *p++ = val;
6637 if (!padding_p || ((i + 2) % bytes_per_line))
6638 *p++ = value >> 8;
6639
6640 if (LA1 == ',' || LA1 == '}')
6641 match ();
6642 else
6643 goto failure;
6644 }
6645 }
6646 else
6647 {
6648 for (i = 0; i < nbytes; ++i)
6649 {
6650 int val = value;
6651 expect (XBM_TK_NUMBER);
6652
6653 *p++ = val;
6654
6655 if (LA1 == ',' || LA1 == '}')
6656 match ();
6657 else
6658 goto failure;
6659 }
6660 }
6661
6662 fclose (fp);
6663 return 1;
6664
6665 failure:
6666
6667 fclose (fp);
6668 if (*data)
6669 {
6670 xfree (*data);
6671 *data = NULL;
6672 }
6673 return 0;
6674
6675#undef match
6676#undef expect
6677#undef expect_ident
6678}
6679
6680
6681/* Load XBM image IMG which will be displayed on frame F from file
6682 SPECIFIED_FILE. Value is non-zero if successful. */
6683
6684static int
6685xbm_load_image_from_file (f, img, specified_file)
6686 struct frame *f;
6687 struct image *img;
6688 Lisp_Object specified_file;
6689{
6690 int rc;
6691 unsigned char *data;
6692 int success_p = 0;
6693 Lisp_Object file;
6694 struct gcpro gcpro1;
6695
6696 xassert (STRINGP (specified_file));
6697 file = Qnil;
6698 GCPRO1 (file);
6699
6700 file = x_find_image_file (specified_file);
6701 if (!STRINGP (file))
6702 {
6703 image_error ("Cannot find image file %s", specified_file, Qnil);
6704 UNGCPRO;
6705 return 0;
6706 }
6707
6708 rc = xbm_read_bitmap_file_data (XSTRING (file)->data, &img->width,
6709 &img->height, &data);
6710 if (rc)
6711 {
6712 int depth = DefaultDepthOfScreen (FRAME_X_SCREEN (f));
6713 unsigned long foreground = FRAME_FOREGROUND_PIXEL (f);
6714 unsigned long background = FRAME_BACKGROUND_PIXEL (f);
6715 Lisp_Object value;
6716
6717 xassert (img->width > 0 && img->height > 0);
6718
6719 /* Get foreground and background colors, maybe allocate colors. */
6720 value = image_spec_value (img->spec, QCforeground, NULL);
6721 if (!NILP (value))
6722 foreground = x_alloc_image_color (f, img, value, foreground);
6723
6724 value = image_spec_value (img->spec, QCbackground, NULL);
6725 if (!NILP (value))
6726 background = x_alloc_image_color (f, img, value, background);
6727
6728 BLOCK_INPUT;
6729 img->pixmap
6730 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f),
6731 FRAME_X_WINDOW (f),
6732 data,
6733 img->width, img->height,
6734 foreground, background,
6735 depth);
6736 xfree (data);
6737
6738 if (img->pixmap == 0)
6739 {
6740 x_clear_image (f, img);
6741 image_error ("Unable to create X pixmap for `%s'", file, Qnil);
6742 }
6743 else
6744 success_p = 1;
6745
6746 UNBLOCK_INPUT;
6747 }
6748 else
6749 image_error ("Error loading XBM image %s", img->spec, Qnil);
6750
6751 UNGCPRO;
6752 return success_p;
6753}
6754
6755
6756/* Fill image IMG which is used on frame F with pixmap data. Value is
6757 non-zero if successful. */
6758
6759static int
6760xbm_load (f, img)
6761 struct frame *f;
6762 struct image *img;
6763{
6764 int success_p = 0;
6765 Lisp_Object file_name;
6766
6767 xassert (xbm_image_p (img->spec));
6768
6769 /* If IMG->spec specifies a file name, create a non-file spec from it. */
6770 file_name = image_spec_value (img->spec, QCfile, NULL);
6771 if (STRINGP (file_name))
6772 success_p = xbm_load_image_from_file (f, img, file_name);
6773 else
6774 {
6775 struct image_keyword fmt[XBM_LAST];
6776 Lisp_Object data;
6777 int depth;
6778 unsigned long foreground = FRAME_FOREGROUND_PIXEL (f);
6779 unsigned long background = FRAME_BACKGROUND_PIXEL (f);
6780 char *bits;
6781 int parsed_p;
6782
6783 /* Parse the list specification. */
6784 bcopy (xbm_format, fmt, sizeof fmt);
6785 parsed_p = parse_image_spec (img->spec, fmt, XBM_LAST, Qxbm, 0);
6786 xassert (parsed_p);
6787
6788 /* Get specified width, and height. */
6789 img->width = XFASTINT (fmt[XBM_WIDTH].value);
6790 img->height = XFASTINT (fmt[XBM_HEIGHT].value);
6791 xassert (img->width > 0 && img->height > 0);
6792
6793 BLOCK_INPUT;
6794
6795 if (fmt[XBM_ASCENT].count)
6796 img->ascent = XFASTINT (fmt[XBM_ASCENT].value);
6797
6798 /* Get foreground and background colors, maybe allocate colors. */
6799 if (fmt[XBM_FOREGROUND].count)
6800 foreground = x_alloc_image_color (f, img, fmt[XBM_FOREGROUND].value,
6801 foreground);
6802 if (fmt[XBM_BACKGROUND].count)
6803 background = x_alloc_image_color (f, img, fmt[XBM_BACKGROUND].value,
6804 background);
6805
6806 /* Set bits to the bitmap image data. */
6807 data = fmt[XBM_DATA].value;
6808 if (VECTORP (data))
6809 {
6810 int i;
6811 char *p;
6812 int nbytes = (img->width + BITS_PER_CHAR - 1) / BITS_PER_CHAR;
6813
6814 p = bits = (char *) alloca (nbytes * img->height);
6815 for (i = 0; i < img->height; ++i, p += nbytes)
6816 {
6817 Lisp_Object line = XVECTOR (data)->contents[i];
6818 if (STRINGP (line))
6819 bcopy (XSTRING (line)->data, p, nbytes);
6820 else
6821 bcopy (XBOOL_VECTOR (line)->data, p, nbytes);
6822 }
6823 }
6824 else if (STRINGP (data))
6825 bits = XSTRING (data)->data;
6826 else
6827 bits = XBOOL_VECTOR (data)->data;
6828
6829 /* Create the pixmap. */
6830 depth = DefaultDepthOfScreen (FRAME_X_SCREEN (f));
6831 img->pixmap
6832 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f),
6833 FRAME_X_WINDOW (f),
6834 bits,
6835 img->width, img->height,
6836 foreground, background,
6837 depth);
6838 if (img->pixmap)
6839 success_p = 1;
6840 else
6841 {
6842 image_error ("Unable to create pixmap for XBM image", Qnil, Qnil);
6843 x_clear_image (f, img);
6844 }
6845
6846 UNBLOCK_INPUT;
6847 }
6848
6849 return success_p;
6850}
6851
6852
6853
6854/***********************************************************************
6855 XPM images
6856 ***********************************************************************/
6857
6858#if HAVE_XPM
6859
6860static int xpm_image_p P_ ((Lisp_Object object));
6861static int xpm_load P_ ((struct frame *f, struct image *img));
6862static int xpm_valid_color_symbols_p P_ ((Lisp_Object));
6863
6864#include "X11/xpm.h"
6865
6866/* The symbol `xpm' identifying XPM-format images. */
6867
6868Lisp_Object Qxpm;
6869
6870/* Indices of image specification fields in xpm_format, below. */
6871
6872enum xpm_keyword_index
6873{
6874 XPM_TYPE,
6875 XPM_FILE,
6876 XPM_DATA,
6877 XPM_ASCENT,
6878 XPM_MARGIN,
6879 XPM_RELIEF,
6880 XPM_ALGORITHM,
6881 XPM_HEURISTIC_MASK,
6882 XPM_COLOR_SYMBOLS,
6883 XPM_LAST
6884};
6885
6886/* Vector of image_keyword structures describing the format
6887 of valid XPM image specifications. */
6888
6889static struct image_keyword xpm_format[XPM_LAST] =
6890{
6891 {":type", IMAGE_SYMBOL_VALUE, 1},
6892 {":file", IMAGE_STRING_VALUE, 0},
6893 {":data", IMAGE_STRING_VALUE, 0},
6894 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
6895 {":margin", IMAGE_POSITIVE_INTEGER_VALUE, 0},
6896 {":relief", IMAGE_INTEGER_VALUE, 0},
6897 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6898 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6899 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
6900};
6901
6902/* Structure describing the image type XBM. */
6903
6904static struct image_type xpm_type =
6905{
6906 &Qxpm,
6907 xpm_image_p,
6908 xpm_load,
6909 x_clear_image,
6910 NULL
6911};
6912
6913
6914/* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
6915 for XPM images. Such a list must consist of conses whose car and
6916 cdr are strings. */
6917
6918static int
6919xpm_valid_color_symbols_p (color_symbols)
6920 Lisp_Object color_symbols;
6921{
6922 while (CONSP (color_symbols))
6923 {
6924 Lisp_Object sym = XCAR (color_symbols);
6925 if (!CONSP (sym)
6926 || !STRINGP (XCAR (sym))
6927 || !STRINGP (XCDR (sym)))
6928 break;
6929 color_symbols = XCDR (color_symbols);
6930 }
6931
6932 return NILP (color_symbols);
6933}
6934
6935
6936/* Value is non-zero if OBJECT is a valid XPM image specification. */
6937
6938static int
6939xpm_image_p (object)
6940 Lisp_Object object;
6941{
6942 struct image_keyword fmt[XPM_LAST];
6943 bcopy (xpm_format, fmt, sizeof fmt);
6944 return (parse_image_spec (object, fmt, XPM_LAST, Qxpm, 0)
6945 /* Either `:file' or `:data' must be present. */
6946 && fmt[XPM_FILE].count + fmt[XPM_DATA].count == 1
6947 /* Either no `:color-symbols' or it's a list of conses
6948 whose car and cdr are strings. */
6949 && (fmt[XPM_COLOR_SYMBOLS].count == 0
6950 || xpm_valid_color_symbols_p (fmt[XPM_COLOR_SYMBOLS].value))
6951 && (fmt[XPM_ASCENT].count == 0
6952 || XFASTINT (fmt[XPM_ASCENT].value) < 100));
6953}
6954
6955
6956/* Load image IMG which will be displayed on frame F. Value is
6957 non-zero if successful. */
6958
6959static int
6960xpm_load (f, img)
6961 struct frame *f;
6962 struct image *img;
6963{
6964 int rc, i;
6965 XpmAttributes attrs;
6966 Lisp_Object specified_file, color_symbols;
6967
6968 /* Configure the XPM lib. Use the visual of frame F. Allocate
6969 close colors. Return colors allocated. */
6970 bzero (&attrs, sizeof attrs);
6971 attrs.visual = FRAME_X_DISPLAY_INFO (f)->visual;
6972 attrs.valuemask |= XpmVisual;
6973 attrs.valuemask |= XpmReturnAllocPixels;
6974 attrs.alloc_close_colors = 1;
6975 attrs.valuemask |= XpmAllocCloseColors;
6976
6977 /* If image specification contains symbolic color definitions, add
6978 these to `attrs'. */
6979 color_symbols = image_spec_value (img->spec, QCcolor_symbols, NULL);
6980 if (CONSP (color_symbols))
6981 {
6982 Lisp_Object tail;
6983 XpmColorSymbol *xpm_syms;
6984 int i, size;
6985
6986 attrs.valuemask |= XpmColorSymbols;
6987
6988 /* Count number of symbols. */
6989 attrs.numsymbols = 0;
6990 for (tail = color_symbols; CONSP (tail); tail = XCDR (tail))
6991 ++attrs.numsymbols;
6992
6993 /* Allocate an XpmColorSymbol array. */
6994 size = attrs.numsymbols * sizeof *xpm_syms;
6995 xpm_syms = (XpmColorSymbol *) alloca (size);
6996 bzero (xpm_syms, size);
6997 attrs.colorsymbols = xpm_syms;
6998
6999 /* Fill the color symbol array. */
7000 for (tail = color_symbols, i = 0;
7001 CONSP (tail);
7002 ++i, tail = XCDR (tail))
7003 {
7004 Lisp_Object name = XCAR (XCAR (tail));
7005 Lisp_Object color = XCDR (XCAR (tail));
7006 xpm_syms[i].name = (char *) alloca (XSTRING (name)->size + 1);
7007 strcpy (xpm_syms[i].name, XSTRING (name)->data);
7008 xpm_syms[i].value = (char *) alloca (XSTRING (color)->size + 1);
7009 strcpy (xpm_syms[i].value, XSTRING (color)->data);
7010 }
7011 }
7012
7013 /* Create a pixmap for the image, either from a file, or from a
7014 string buffer containing data in the same format as an XPM file. */
7015 BLOCK_INPUT;
7016 specified_file = image_spec_value (img->spec, QCfile, NULL);
7017 if (STRINGP (specified_file))
7018 {
7019 Lisp_Object file = x_find_image_file (specified_file);
7020 if (!STRINGP (file))
7021 {
7022 image_error ("Cannot find image file %s", specified_file, Qnil);
7023 return 0;
7024 }
7025
7026 rc = XpmReadFileToPixmap (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
7027 XSTRING (file)->data, &img->pixmap, &img->mask,
7028 &attrs);
7029 }
7030 else
7031 {
7032 Lisp_Object buffer = image_spec_value (img->spec, QCdata, NULL);
7033 rc = XpmCreatePixmapFromBuffer (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
7034 XSTRING (buffer)->data,
7035 &img->pixmap, &img->mask,
7036 &attrs);
7037 }
7038 UNBLOCK_INPUT;
7039
7040 if (rc == XpmSuccess)
7041 {
7042 /* Remember allocated colors. */
7043 img->ncolors = attrs.nalloc_pixels;
7044 img->colors = (unsigned long *) xmalloc (img->ncolors
7045 * sizeof *img->colors);
7046 for (i = 0; i < attrs.nalloc_pixels; ++i)
7047 img->colors[i] = attrs.alloc_pixels[i];
7048
7049 img->width = attrs.width;
7050 img->height = attrs.height;
7051 xassert (img->width > 0 && img->height > 0);
7052
7053 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
7054 BLOCK_INPUT;
7055 XpmFreeAttributes (&attrs);
7056 UNBLOCK_INPUT;
7057 }
7058 else
7059 {
7060 switch (rc)
7061 {
7062 case XpmOpenFailed:
7063 image_error ("Error opening XPM file (%s)", img->spec, Qnil);
7064 break;
7065
7066 case XpmFileInvalid:
7067 image_error ("Invalid XPM file (%s)", img->spec, Qnil);
7068 break;
7069
7070 case XpmNoMemory:
7071 image_error ("Out of memory (%s)", img->spec, Qnil);
7072 break;
7073
7074 case XpmColorFailed:
7075 image_error ("Color allocation error (%s)", img->spec, Qnil);
7076 break;
7077
7078 default:
7079 image_error ("Unknown error (%s)", img->spec, Qnil);
7080 break;
7081 }
7082 }
7083
7084 return rc == XpmSuccess;
7085}
7086
7087#endif /* HAVE_XPM != 0 */
7088
7089
7090/***********************************************************************
7091 Color table
7092 ***********************************************************************/
7093
7094/* An entry in the color table mapping an RGB color to a pixel color. */
7095
7096struct ct_color
7097{
7098 int r, g, b;
7099 unsigned long pixel;
7100
7101 /* Next in color table collision list. */
7102 struct ct_color *next;
7103};
7104
7105/* The bucket vector size to use. Must be prime. */
7106
7107#define CT_SIZE 101
7108
7109/* Value is a hash of the RGB color given by R, G, and B. */
7110
7111#define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
7112
7113/* The color hash table. */
7114
7115struct ct_color **ct_table;
7116
7117/* Number of entries in the color table. */
7118
7119int ct_colors_allocated;
7120
7121/* Function prototypes. */
7122
7123static void init_color_table P_ ((void));
7124static void free_color_table P_ ((void));
7125static unsigned long *colors_in_color_table P_ ((int *n));
7126static unsigned long lookup_rgb_color P_ ((struct frame *f, int r, int g, int b));
7127static unsigned long lookup_pixel_color P_ ((struct frame *f, unsigned long p));
7128
7129
7130/* Initialize the color table. */
7131
7132static void
7133init_color_table ()
7134{
7135 int size = CT_SIZE * sizeof (*ct_table);
7136 ct_table = (struct ct_color **) xmalloc (size);
7137 bzero (ct_table, size);
7138 ct_colors_allocated = 0;
7139}
7140
7141
7142/* Free memory associated with the color table. */
7143
7144static void
7145free_color_table ()
7146{
7147 int i;
7148 struct ct_color *p, *next;
7149
7150 for (i = 0; i < CT_SIZE; ++i)
7151 for (p = ct_table[i]; p; p = next)
7152 {
7153 next = p->next;
7154 xfree (p);
7155 }
7156
7157 xfree (ct_table);
7158 ct_table = NULL;
7159}
7160
7161
7162/* Value is a pixel color for RGB color R, G, B on frame F. If an
7163 entry for that color already is in the color table, return the
7164 pixel color of that entry. Otherwise, allocate a new color for R,
7165 G, B, and make an entry in the color table. */
7166
7167static unsigned long
7168lookup_rgb_color (f, r, g, b)
7169 struct frame *f;
7170 int r, g, b;
7171{
7172 unsigned hash = CT_HASH_RGB (r, g, b);
7173 int i = hash % CT_SIZE;
7174 struct ct_color *p;
7175
7176 for (p = ct_table[i]; p; p = p->next)
7177 if (p->r == r && p->g == g && p->b == b)
7178 break;
7179
7180 if (p == NULL)
7181 {
7182 XColor color;
7183 Colormap cmap;
7184 int rc;
7185
7186 color.red = r;
7187 color.green = g;
7188 color.blue = b;
7189
7190 BLOCK_INPUT;
7191 cmap = DefaultColormapOfScreen (FRAME_X_SCREEN (f));
7192 rc = x_alloc_nearest_color (FRAME_X_DISPLAY (f), FRAME_X_SCREEN (f),
7193 cmap, &color);
7194 UNBLOCK_INPUT;
7195
7196 if (rc)
7197 {
7198 ++ct_colors_allocated;
7199
7200 p = (struct ct_color *) xmalloc (sizeof *p);
7201 p->r = r;
7202 p->g = g;
7203 p->b = b;
7204 p->pixel = color.pixel;
7205 p->next = ct_table[i];
7206 ct_table[i] = p;
7207 }
7208 else
7209 return FRAME_FOREGROUND_PIXEL (f);
7210 }
7211
7212 return p->pixel;
7213}
7214
7215
7216/* Look up pixel color PIXEL which is used on frame F in the color
7217 table. If not already present, allocate it. Value is PIXEL. */
7218
7219static unsigned long
7220lookup_pixel_color (f, pixel)
7221 struct frame *f;
7222 unsigned long pixel;
7223{
7224 int i = pixel % CT_SIZE;
7225 struct ct_color *p;
7226
7227 for (p = ct_table[i]; p; p = p->next)
7228 if (p->pixel == pixel)
7229 break;
7230
7231 if (p == NULL)
7232 {
7233 XColor color;
7234 Colormap cmap;
7235 int rc;
7236
7237 BLOCK_INPUT;
7238
7239 cmap = DefaultColormapOfScreen (FRAME_X_SCREEN (f));
7240 color.pixel = pixel;
7241 XQueryColor (FRAME_X_DISPLAY (f), cmap, &color);
7242 rc = x_alloc_nearest_color (FRAME_X_DISPLAY (f), FRAME_X_SCREEN (f),
7243 cmap, &color);
7244 UNBLOCK_INPUT;
7245
7246 if (rc)
7247 {
7248 ++ct_colors_allocated;
7249
7250 p = (struct ct_color *) xmalloc (sizeof *p);
7251 p->r = color.red;
7252 p->g = color.green;
7253 p->b = color.blue;
7254 p->pixel = pixel;
7255 p->next = ct_table[i];
7256 ct_table[i] = p;
7257 }
7258 else
7259 return FRAME_FOREGROUND_PIXEL (f);
7260 }
7261
7262 return p->pixel;
7263}
7264
7265
7266/* Value is a vector of all pixel colors contained in the color table,
7267 allocated via xmalloc. Set *N to the number of colors. */
7268
7269static unsigned long *
7270colors_in_color_table (n)
7271 int *n;
7272{
7273 int i, j;
7274 struct ct_color *p;
7275 unsigned long *colors;
7276
7277 if (ct_colors_allocated == 0)
7278 {
7279 *n = 0;
7280 colors = NULL;
7281 }
7282 else
7283 {
7284 colors = (unsigned long *) xmalloc (ct_colors_allocated
7285 * sizeof *colors);
7286 *n = ct_colors_allocated;
7287
7288 for (i = j = 0; i < CT_SIZE; ++i)
7289 for (p = ct_table[i]; p; p = p->next)
7290 colors[j++] = p->pixel;
7291 }
7292
7293 return colors;
7294}
7295
7296
7297
7298/***********************************************************************
7299 Algorithms
7300 ***********************************************************************/
7301
7302static void x_laplace_write_row P_ ((struct frame *, long *,
7303 int, XImage *, int));
7304static void x_laplace_read_row P_ ((struct frame *, Colormap,
7305 XColor *, int, XImage *, int));
7306
7307
7308/* Fill COLORS with RGB colors from row Y of image XIMG. F is the
7309 frame we operate on, CMAP is the color-map in effect, and WIDTH is
7310 the width of one row in the image. */
7311
7312static void
7313x_laplace_read_row (f, cmap, colors, width, ximg, y)
7314 struct frame *f;
7315 Colormap cmap;
7316 XColor *colors;
7317 int width;
7318 XImage *ximg;
7319 int y;
7320{
7321 int x;
7322
7323 for (x = 0; x < width; ++x)
7324 colors[x].pixel = XGetPixel (ximg, x, y);
7325
7326 XQueryColors (FRAME_X_DISPLAY (f), cmap, colors, width);
7327}
7328
7329
7330/* Write row Y of image XIMG. PIXELS is an array of WIDTH longs
7331 containing the pixel colors to write. F is the frame we are
7332 working on. */
7333
7334static void
7335x_laplace_write_row (f, pixels, width, ximg, y)
7336 struct frame *f;
7337 long *pixels;
7338 int width;
7339 XImage *ximg;
7340 int y;
7341{
7342 int x;
7343
7344 for (x = 0; x < width; ++x)
7345 XPutPixel (ximg, x, y, pixels[x]);
7346}
7347
7348
7349/* Transform image IMG which is used on frame F with a Laplace
7350 edge-detection algorithm. The result is an image that can be used
7351 to draw disabled buttons, for example. */
7352
7353static void
7354x_laplace (f, img)
7355 struct frame *f;
7356 struct image *img;
7357{
7358 Colormap cmap = DefaultColormapOfScreen (FRAME_X_SCREEN (f));
7359 XImage *ximg, *oimg;
7360 XColor *in[3];
7361 long *out;
7362 Pixmap pixmap;
7363 int x, y, i;
7364 long pixel;
7365 int in_y, out_y, rc;
7366 int mv2 = 45000;
7367
7368 BLOCK_INPUT;
7369
7370 /* Get the X image IMG->pixmap. */
7371 ximg = XGetImage (FRAME_X_DISPLAY (f), img->pixmap,
7372 0, 0, img->width, img->height, ~0, ZPixmap);
7373
7374 /* Allocate 3 input rows, and one output row of colors. */
7375 for (i = 0; i < 3; ++i)
7376 in[i] = (XColor *) alloca (img->width * sizeof (XColor));
7377 out = (long *) alloca (img->width * sizeof (long));
7378
7379 /* Create an X image for output. */
7380 rc = x_create_x_image_and_pixmap (f, Qnil, img->width, img->height, 0,
7381 &oimg, &pixmap);
7382
7383 /* Fill first two rows. */
7384 x_laplace_read_row (f, cmap, in[0], img->width, ximg, 0);
7385 x_laplace_read_row (f, cmap, in[1], img->width, ximg, 1);
7386 in_y = 2;
7387
7388 /* Write first row, all zeros. */
7389 init_color_table ();
7390 pixel = lookup_rgb_color (f, 0, 0, 0);
7391 for (x = 0; x < img->width; ++x)
7392 out[x] = pixel;
7393 x_laplace_write_row (f, out, img->width, oimg, 0);
7394 out_y = 1;
7395
7396 for (y = 2; y < img->height; ++y)
7397 {
7398 int rowa = y % 3;
7399 int rowb = (y + 2) % 3;
7400
7401 x_laplace_read_row (f, cmap, in[rowa], img->width, ximg, in_y++);
7402
7403 for (x = 0; x < img->width - 2; ++x)
7404 {
7405 int r = in[rowa][x].red + mv2 - in[rowb][x + 2].red;
7406 int g = in[rowa][x].green + mv2 - in[rowb][x + 2].green;
7407 int b = in[rowa][x].blue + mv2 - in[rowb][x + 2].blue;
7408
7409 out[x + 1] = lookup_rgb_color (f, r & 0xffff, g & 0xffff,
7410 b & 0xffff);
7411 }
7412
7413 x_laplace_write_row (f, out, img->width, oimg, out_y++);
7414 }
7415
7416 /* Write last line, all zeros. */
7417 for (x = 0; x < img->width; ++x)
7418 out[x] = pixel;
7419 x_laplace_write_row (f, out, img->width, oimg, out_y);
7420
7421 /* Free the input image, and free resources of IMG. */
7422 XDestroyImage (ximg);
7423 x_clear_image (f, img);
7424
7425 /* Put the output image into pixmap, and destroy it. */
7426 x_put_x_image (f, oimg, pixmap, img->width, img->height);
7427 x_destroy_x_image (oimg);
7428
7429 /* Remember new pixmap and colors in IMG. */
7430 img->pixmap = pixmap;
7431 img->colors = colors_in_color_table (&img->ncolors);
7432 free_color_table ();
7433
7434 UNBLOCK_INPUT;
7435}
7436
7437
7438/* Build a mask for image IMG which is used on frame F. FILE is the
7439 name of an image file, for error messages. HOW determines how to
7440 determine the background color of IMG. If it is an integer, take
7441 that as the pixel value of the background. Otherwise, determine
7442 the background color of IMG heuristically. Value is non-zero
7443 if successful. */
7444
7445static int
7446x_build_heuristic_mask (f, file, img, how)
7447 struct frame *f;
7448 Lisp_Object file;
7449 struct image *img;
7450 Lisp_Object how;
7451{
7452 Display *dpy = FRAME_X_DISPLAY (f);
7453 Window win = FRAME_X_WINDOW (f);
7454 XImage *ximg, *mask_img;
7455 int x, y, rc;
7456 unsigned long bg;
7457
7458 BLOCK_INPUT;
7459
7460 /* Create an image and pixmap serving as mask. */
7461 rc = x_create_x_image_and_pixmap (f, file, img->width, img->height, 1,
7462 &mask_img, &img->mask);
7463 if (!rc)
7464 {
7465 UNBLOCK_INPUT;
7466 return 0;
7467 }
7468
7469 /* Get the X image of IMG->pixmap. */
7470 ximg = XGetImage (dpy, img->pixmap, 0, 0, img->width, img->height,
7471 ~0, ZPixmap);
7472
7473 /* Determine the background color of ximg. If HOW is an integer,
7474 take that as a pixel color. Otherwise, try to determine the
7475 color heuristically. */
7476 if (NATNUMP (how))
7477 bg = XFASTINT (how);
7478 else
7479 {
7480 unsigned long corners[4];
7481 int i, best_count;
7482
7483 /* Get the colors at the corners of ximg. */
7484 corners[0] = XGetPixel (ximg, 0, 0);
7485 corners[1] = XGetPixel (ximg, img->width - 1, 0);
7486 corners[2] = XGetPixel (ximg, img->width - 1, img->height - 1);
7487 corners[3] = XGetPixel (ximg, 0, img->height - 1);
7488
7489 /* Choose the most frequently found color as background. */
7490 for (i = best_count = 0; i < 4; ++i)
7491 {
7492 int j, n;
7493
7494 for (j = n = 0; j < 4; ++j)
7495 if (corners[i] == corners[j])
7496 ++n;
7497
7498 if (n > best_count)
7499 bg = corners[i], best_count = n;
7500 }
7501 }
7502
7503 /* Set all bits in mask_img to 1 whose color in ximg is different
7504 from the background color bg. */
7505 for (y = 0; y < img->height; ++y)
7506 for (x = 0; x < img->width; ++x)
7507 XPutPixel (mask_img, x, y, XGetPixel (ximg, x, y) != bg);
7508
7509 /* Put mask_img into img->mask. */
7510 x_put_x_image (f, mask_img, img->mask, img->width, img->height);
7511 x_destroy_x_image (mask_img);
7512 XDestroyImage (ximg);
7513
7514 UNBLOCK_INPUT;
7515 return 1;
7516}
7517
7518
7519
7520/***********************************************************************
7521 PBM (mono, gray, color)
7522 ***********************************************************************/
7523
7524static int pbm_image_p P_ ((Lisp_Object object));
7525static int pbm_load P_ ((struct frame *f, struct image *img));
7526static int pbm_scan_number P_ ((FILE *fp));
7527
7528/* The symbol `pbm' identifying images of this type. */
7529
7530Lisp_Object Qpbm;
7531
7532/* Indices of image specification fields in gs_format, below. */
7533
7534enum pbm_keyword_index
7535{
7536 PBM_TYPE,
7537 PBM_FILE,
7538 PBM_ASCENT,
7539 PBM_MARGIN,
7540 PBM_RELIEF,
7541 PBM_ALGORITHM,
7542 PBM_HEURISTIC_MASK,
7543 PBM_LAST
7544};
7545
7546/* Vector of image_keyword structures describing the format
7547 of valid user-defined image specifications. */
7548
7549static struct image_keyword pbm_format[PBM_LAST] =
7550{
7551 {":type", IMAGE_SYMBOL_VALUE, 1},
7552 {":file", IMAGE_STRING_VALUE, 1},
7553 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
7554 {":margin", IMAGE_POSITIVE_INTEGER_VALUE, 0},
7555 {":relief", IMAGE_INTEGER_VALUE, 0},
7556 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
7557 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
7558};
7559
7560/* Structure describing the image type `pbm'. */
7561
7562static struct image_type pbm_type =
7563{
7564 &Qpbm,
7565 pbm_image_p,
7566 pbm_load,
7567 x_clear_image,
7568 NULL
7569};
7570
7571
7572/* Return non-zero if OBJECT is a valid PBM image specification. */
7573
7574static int
7575pbm_image_p (object)
7576 Lisp_Object object;
7577{
7578 struct image_keyword fmt[PBM_LAST];
7579
7580 bcopy (pbm_format, fmt, sizeof fmt);
7581
7582 if (!parse_image_spec (object, fmt, PBM_LAST, Qpbm, 0)
7583 || (fmt[PBM_ASCENT].count
7584 && XFASTINT (fmt[PBM_ASCENT].value) > 100))
7585 return 0;
7586 return 1;
7587}
7588
7589
7590/* Scan a decimal number from PBM input file FP and return it. Value
7591 is -1 at end of file or if an error occurs. */
7592
7593static int
7594pbm_scan_number (fp)
7595 FILE *fp;
7596{
7597 int c, val = -1;
7598
7599 while (!feof (fp))
7600 {
7601 /* Skip white-space. */
7602 while ((c = fgetc (fp)) != EOF && isspace (c))
7603 ;
7604
7605 if (c == '#')
7606 {
7607 /* Skip comment to end of line. */
7608 while ((c = fgetc (fp)) != EOF && c != '\n')
7609 ;
7610 }
7611 else if (isdigit (c))
7612 {
7613 /* Read decimal number. */
7614 val = c - '0';
7615 while ((c = fgetc (fp)) != EOF && isdigit (c))
7616 val = 10 * val + c - '0';
7617 break;
7618 }
7619 else
7620 break;
7621 }
7622
7623 return val;
7624}
7625
7626
7627/* Load PBM image IMG for use on frame F. */
7628
7629static int
7630pbm_load (f, img)
7631 struct frame *f;
7632 struct image *img;
7633{
7634 FILE *fp;
7635 char magic[2];
7636 int raw_p, x, y;
7637 int width, height, max_color_idx = 0, value;
7638 XImage *ximg;
7639 Lisp_Object file, specified_file;
7640 enum {PBM_MONO, PBM_GRAY, PBM_COLOR} type;
7641 struct gcpro gcpro1;
7642
7643 specified_file = image_spec_value (img->spec, QCfile, NULL);
7644 file = x_find_image_file (specified_file);
7645 GCPRO1 (file);
7646 if (!STRINGP (file))
7647 {
7648 image_error ("Cannot find image file %s", specified_file, Qnil);
7649 UNGCPRO;
7650 return 0;
7651 }
7652
7653 fp = fopen (XSTRING (file)->data, "r");
7654 if (fp == NULL)
7655 {
7656 UNGCPRO;
7657 return 0;
7658 }
7659
7660 /* Read first two characters. */
7661 if (fread (magic, sizeof *magic, 2, fp) != 2)
7662 {
7663 fclose (fp);
7664 image_error ("Not a PBM image file: %s", file, Qnil);
7665 UNGCPRO;
7666 return 0;
7667 }
7668
7669 if (*magic != 'P')
7670 {
7671 fclose (fp);
7672 image_error ("Not a PBM image file: %s", file, Qnil);
7673 UNGCPRO;
7674 return 0;
7675 }
7676
7677 switch (magic[1])
7678 {
7679 case '1':
7680 raw_p = 0, type = PBM_MONO;
7681 break;
7682
7683 case '2':
7684 raw_p = 0, type = PBM_GRAY;
7685 break;
7686
7687 case '3':
7688 raw_p = 0, type = PBM_COLOR;
7689 break;
7690
7691 case '4':
7692 raw_p = 1, type = PBM_MONO;
7693 break;
7694
7695 case '5':
7696 raw_p = 1, type = PBM_GRAY;
7697 break;
7698
7699 case '6':
7700 raw_p = 1, type = PBM_COLOR;
7701 break;
7702
7703 default:
7704 fclose (fp);
7705 image_error ("Not a PBM image file: %s", file, Qnil);
7706 UNGCPRO;
7707 return 0;
7708 }
7709
7710 /* Read width, height, maximum color-component. Characters
7711 starting with `#' up to the end of a line are ignored. */
7712 width = pbm_scan_number (fp);
7713 height = pbm_scan_number (fp);
7714
7715 if (type != PBM_MONO)
7716 {
7717 max_color_idx = pbm_scan_number (fp);
7718 if (raw_p && max_color_idx > 255)
7719 max_color_idx = 255;
7720 }
7721
7722 if (width < 0 || height < 0
7723 || (type != PBM_MONO && max_color_idx < 0))
7724 {
7725 fclose (fp);
7726 UNGCPRO;
7727 return 0;
7728 }
7729
7730 BLOCK_INPUT;
7731 if (!x_create_x_image_and_pixmap (f, file, width, height, 0,
7732 &ximg, &img->pixmap))
7733 {
7734 fclose (fp);
7735 UNBLOCK_INPUT;
7736 UNGCPRO;
7737 return 0;
7738 }
7739
7740 /* Initialize the color hash table. */
7741 init_color_table ();
7742
7743 if (type == PBM_MONO)
7744 {
7745 int c = 0, g;
7746
7747 for (y = 0; y < height; ++y)
7748 for (x = 0; x < width; ++x)
7749 {
7750 if (raw_p)
7751 {
7752 if ((x & 7) == 0)
7753 c = fgetc (fp);
7754 g = c & 0x80;
7755 c <<= 1;
7756 }
7757 else
7758 g = pbm_scan_number (fp);
7759
7760 XPutPixel (ximg, x, y, (g
7761 ? FRAME_FOREGROUND_PIXEL (f)
7762 : FRAME_BACKGROUND_PIXEL (f)));
7763 }
7764 }
7765 else
7766 {
7767 for (y = 0; y < height; ++y)
7768 for (x = 0; x < width; ++x)
7769 {
7770 int r, g, b;
7771
7772 if (type == PBM_GRAY)
7773 r = g = b = raw_p ? fgetc (fp) : pbm_scan_number (fp);
7774 else if (raw_p)
7775 {
7776 r = fgetc (fp);
7777 g = fgetc (fp);
7778 b = fgetc (fp);
7779 }
7780 else
7781 {
7782 r = pbm_scan_number (fp);
7783 g = pbm_scan_number (fp);
7784 b = pbm_scan_number (fp);
7785 }
7786
7787 if (r < 0 || g < 0 || b < 0)
7788 {
7789 fclose (fp);
7790 xfree (ximg->data);
7791 ximg->data = NULL;
7792 XDestroyImage (ximg);
7793 UNBLOCK_INPUT;
7794 image_error ("Invalid pixel value in file `%s'",
7795 file, Qnil);
7796 UNGCPRO;
7797 return 0;
7798 }
7799
7800 /* RGB values are now in the range 0..max_color_idx.
7801 Scale this to the range 0..0xffff supported by X. */
7802 r = (double) r * 65535 / max_color_idx;
7803 g = (double) g * 65535 / max_color_idx;
7804 b = (double) b * 65535 / max_color_idx;
7805 XPutPixel (ximg, x, y, lookup_rgb_color (f, r, g, b));
7806 }
7807 }
7808
7809 fclose (fp);
7810
7811 /* Store in IMG->colors the colors allocated for the image, and
7812 free the color table. */
7813 img->colors = colors_in_color_table (&img->ncolors);
7814 free_color_table ();
7815
7816 /* Put the image into a pixmap. */
7817 x_put_x_image (f, ximg, img->pixmap, width, height);
7818 x_destroy_x_image (ximg);
7819 UNBLOCK_INPUT;
7820
7821 img->width = width;
7822 img->height = height;
7823
7824 UNGCPRO;
7825 return 1;
7826}
7827
7828
7829
7830/***********************************************************************
7831 PNG
7832 ***********************************************************************/
7833
7834#if HAVE_PNG
7835
7836#include <png.h>
7837
7838/* Function prototypes. */
7839
7840static int png_image_p P_ ((Lisp_Object object));
7841static int png_load P_ ((struct frame *f, struct image *img));
7842
7843/* The symbol `png' identifying images of this type. */
7844
7845Lisp_Object Qpng;
7846
7847/* Indices of image specification fields in png_format, below. */
7848
7849enum png_keyword_index
7850{
7851 PNG_TYPE,
7852 PNG_FILE,
7853 PNG_ASCENT,
7854 PNG_MARGIN,
7855 PNG_RELIEF,
7856 PNG_ALGORITHM,
7857 PNG_HEURISTIC_MASK,
7858 PNG_LAST
7859};
7860
7861/* Vector of image_keyword structures describing the format
7862 of valid user-defined image specifications. */
7863
7864static struct image_keyword png_format[PNG_LAST] =
7865{
7866 {":type", IMAGE_SYMBOL_VALUE, 1},
7867 {":file", IMAGE_STRING_VALUE, 1},
7868 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
7869 {":margin", IMAGE_POSITIVE_INTEGER_VALUE, 0},
7870 {":relief", IMAGE_INTEGER_VALUE, 0},
7871 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
7872 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
7873};
7874
7875/* Structure describing the image type `gif'. */
7876
7877static struct image_type png_type =
7878{
7879 &Qpng,
7880 png_image_p,
7881 png_load,
7882 x_clear_image,
7883 NULL
7884};
7885
7886
7887/* Return non-zero if OBJECT is a valid PNG image specification. */
7888
7889static int
7890png_image_p (object)
7891 Lisp_Object object;
7892{
7893 struct image_keyword fmt[PNG_LAST];
7894 bcopy (png_format, fmt, sizeof fmt);
7895
7896 if (!parse_image_spec (object, fmt, PNG_LAST, Qpng, 1)
7897 || (fmt[PNG_ASCENT].count
7898 && XFASTINT (fmt[PNG_ASCENT].value) > 100))
7899 return 0;
7900 return 1;
7901}
7902
7903
7904/* Error and warning handlers installed when the PNG library
7905 is initialized. */
7906
7907static void
7908my_png_error (png_ptr, msg)
7909 png_struct *png_ptr;
7910 char *msg;
7911{
7912 xassert (png_ptr != NULL);
7913 image_error ("PNG error: %s", build_string (msg), Qnil);
7914 longjmp (png_ptr->jmpbuf, 1);
7915}
7916
7917
7918static void
7919my_png_warning (png_ptr, msg)
7920 png_struct *png_ptr;
7921 char *msg;
7922{
7923 xassert (png_ptr != NULL);
7924 image_error ("PNG warning: %s", build_string (msg), Qnil);
7925}
7926
7927
7928/* Load PNG image IMG for use on frame F. Value is non-zero if
7929 successful. */
7930
7931static int
7932png_load (f, img)
7933 struct frame *f;
7934 struct image *img;
7935{
7936 Lisp_Object file, specified_file;
7937 int rc, x, y, i;
7938 XImage *ximg, *mask_img = NULL;
7939 struct gcpro gcpro1;
7940 png_struct *png_ptr = NULL;
7941 png_info *info_ptr = NULL, *end_info = NULL;
7942 FILE *fp;
7943 png_byte sig[8];
7944 png_byte *pixels = NULL;
7945 png_byte **rows = NULL;
7946 png_uint_32 width, height;
7947 int bit_depth, color_type, interlace_type;
7948 png_byte channels;
7949 png_uint_32 row_bytes;
7950 int transparent_p;
7951 char *gamma_str;
7952 double screen_gamma, image_gamma;
7953 int intent;
7954
7955 /* Find out what file to load. */
7956 specified_file = image_spec_value (img->spec, QCfile, NULL);
7957 file = x_find_image_file (specified_file);
7958 GCPRO1 (file);
7959 if (!STRINGP (file))
7960 {
7961 image_error ("Cannot find image file %s", specified_file, Qnil);
7962 UNGCPRO;
7963 return 0;
7964 }
7965
7966 /* Open the image file. */
7967 fp = fopen (XSTRING (file)->data, "rb");
7968 if (!fp)
7969 {
7970 image_error ("Cannot open image file %s", file, Qnil);
7971 UNGCPRO;
7972 fclose (fp);
7973 return 0;
7974 }
7975
7976 /* Check PNG signature. */
7977 if (fread (sig, 1, sizeof sig, fp) != sizeof sig
7978 || !png_check_sig (sig, sizeof sig))
7979 {
7980 image_error ("Not a PNG file: %s", file, Qnil);
7981 UNGCPRO;
7982 fclose (fp);
7983 return 0;
7984 }
7985
7986 /* Initialize read and info structs for PNG lib. */
7987 png_ptr = png_create_read_struct (PNG_LIBPNG_VER_STRING, NULL,
7988 my_png_error, my_png_warning);
7989 if (!png_ptr)
7990 {
7991 fclose (fp);
7992 UNGCPRO;
7993 return 0;
7994 }
7995
7996 info_ptr = png_create_info_struct (png_ptr);
7997 if (!info_ptr)
7998 {
7999 png_destroy_read_struct (&png_ptr, NULL, NULL);
8000 fclose (fp);
8001 UNGCPRO;
8002 return 0;
8003 }
8004
8005 end_info = png_create_info_struct (png_ptr);
8006 if (!end_info)
8007 {
8008 png_destroy_read_struct (&png_ptr, &info_ptr, NULL);
8009 fclose (fp);
8010 UNGCPRO;
8011 return 0;
8012 }
8013
8014 /* Set error jump-back. We come back here when the PNG library
8015 detects an error. */
8016 if (setjmp (png_ptr->jmpbuf))
8017 {
8018 error:
8019 if (png_ptr)
8020 png_destroy_read_struct (&png_ptr, &info_ptr, &end_info);
8021 xfree (pixels);
8022 xfree (rows);
8023 if (fp)
8024 fclose (fp);
8025 UNGCPRO;
8026 return 0;
8027 }
8028
8029 /* Read image info. */
8030 png_init_io (png_ptr, fp);
8031 png_set_sig_bytes (png_ptr, sizeof sig);
8032 png_read_info (png_ptr, info_ptr);
8033 png_get_IHDR (png_ptr, info_ptr, &width, &height, &bit_depth, &color_type,
8034 &interlace_type, NULL, NULL);
8035
8036 /* If image contains simply transparency data, we prefer to
8037 construct a clipping mask. */
8038 if (png_get_valid (png_ptr, info_ptr, PNG_INFO_tRNS))
8039 transparent_p = 1;
8040 else
8041 transparent_p = 0;
8042
8043 /* This function is easier to write if we only have to handle
8044 one data format: RGB or RGBA with 8 bits per channel. Let's
8045 transform other formats into that format. */
8046
8047 /* Strip more than 8 bits per channel. */
8048 if (bit_depth == 16)
8049 png_set_strip_16 (png_ptr);
8050
8051 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
8052 if available. */
8053 png_set_expand (png_ptr);
8054
8055 /* Convert grayscale images to RGB. */
8056 if (color_type == PNG_COLOR_TYPE_GRAY
8057 || color_type == PNG_COLOR_TYPE_GRAY_ALPHA)
8058 png_set_gray_to_rgb (png_ptr);
8059
8060 /* The value 2.2 is a guess for PC monitors from PNG example.c. */
8061 gamma_str = getenv ("SCREEN_GAMMA");
8062 screen_gamma = gamma_str ? atof (gamma_str) : 2.2;
8063
8064 /* Tell the PNG lib to handle gamma correction for us. */
8065
8066 if (png_get_sRGB (png_ptr, info_ptr, &intent))
8067 /* There is a special chunk in the image specifying the gamma. */
8068 png_set_sRGB (png_ptr, info_ptr, intent);
8069 else if (png_get_gAMA (png_ptr, info_ptr, &image_gamma))
8070 /* Image contains gamma information. */
8071 png_set_gamma (png_ptr, screen_gamma, image_gamma);
8072 else
8073 /* Use a default of 0.5 for the image gamma. */
8074 png_set_gamma (png_ptr, screen_gamma, 0.5);
8075
8076 /* Handle alpha channel by combining the image with a background
8077 color. Do this only if a real alpha channel is supplied. For
8078 simple transparency, we prefer a clipping mask. */
8079 if (!transparent_p)
8080 {
8081 png_color_16 *image_background;
8082
8083 if (png_get_bKGD (png_ptr, info_ptr, &image_background))
8084 /* Image contains a background color with which to
8085 combine the image. */
8086 png_set_background (png_ptr, image_background,
8087 PNG_BACKGROUND_GAMMA_FILE, 1, 1.0);
8088 else
8089 {
8090 /* Image does not contain a background color with which
8091 to combine the image data via an alpha channel. Use
8092 the frame's background instead. */
8093 XColor color;
8094 Colormap cmap;
8095 png_color_16 frame_background;
8096
8097 BLOCK_INPUT;
8098 cmap = DefaultColormapOfScreen (FRAME_X_SCREEN (f));
8099 color.pixel = FRAME_BACKGROUND_PIXEL (f);
8100 XQueryColor (FRAME_X_DISPLAY (f), cmap, &color);
8101 UNBLOCK_INPUT;
8102
8103 bzero (&frame_background, sizeof frame_background);
8104 frame_background.red = color.red;
8105 frame_background.green = color.green;
8106 frame_background.blue = color.blue;
8107
8108 png_set_background (png_ptr, &frame_background,
8109 PNG_BACKGROUND_GAMMA_SCREEN, 0, 1.0);
8110 }
8111 }
8112
8113 /* Update info structure. */
8114 png_read_update_info (png_ptr, info_ptr);
8115
8116 /* Get number of channels. Valid values are 1 for grayscale images
8117 and images with a palette, 2 for grayscale images with transparency
8118 information (alpha channel), 3 for RGB images, and 4 for RGB
8119 images with alpha channel, i.e. RGBA. If conversions above were
8120 sufficient we should only have 3 or 4 channels here. */
8121 channels = png_get_channels (png_ptr, info_ptr);
8122 xassert (channels == 3 || channels == 4);
8123
8124 /* Number of bytes needed for one row of the image. */
8125 row_bytes = png_get_rowbytes (png_ptr, info_ptr);
8126
8127 /* Allocate memory for the image. */
8128 pixels = (png_byte *) xmalloc (row_bytes * height * sizeof *pixels);
8129 rows = (png_byte **) xmalloc (height * sizeof *rows);
8130 for (i = 0; i < height; ++i)
8131 rows[i] = pixels + i * row_bytes;
8132
8133 /* Read the entire image. */
8134 png_read_image (png_ptr, rows);
8135 png_read_end (png_ptr, info_ptr);
8136 fclose (fp);
8137 fp = NULL;
8138
8139 BLOCK_INPUT;
8140
8141 /* Create the X image and pixmap. */
8142 if (!x_create_x_image_and_pixmap (f, file, width, height, 0, &ximg,
8143 &img->pixmap))
8144 {
8145 UNBLOCK_INPUT;
8146 goto error;
8147 }
8148
8149 /* Create an image and pixmap serving as mask if the PNG image
8150 contains an alpha channel. */
8151 if (channels == 4
8152 && !transparent_p
8153 && !x_create_x_image_and_pixmap (f, file, width, height, 1,
8154 &mask_img, &img->mask))
8155 {
8156 x_destroy_x_image (ximg);
8157 XFreePixmap (FRAME_X_DISPLAY (f), img->pixmap);
8158 img->pixmap = 0;
8159 UNBLOCK_INPUT;
8160 goto error;
8161 }
8162
8163 /* Fill the X image and mask from PNG data. */
8164 init_color_table ();
8165
8166 for (y = 0; y < height; ++y)
8167 {
8168 png_byte *p = rows[y];
8169
8170 for (x = 0; x < width; ++x)
8171 {
8172 unsigned r, g, b;
8173
8174 r = *p++ << 8;
8175 g = *p++ << 8;
8176 b = *p++ << 8;
8177 XPutPixel (ximg, x, y, lookup_rgb_color (f, r, g, b));
8178
8179 /* An alpha channel, aka mask channel, associates variable
8180 transparency with an image. Where other image formats
8181 support binary transparency---fully transparent or fully
8182 opaque---PNG allows up to 254 levels of partial transparency.
8183 The PNG library implements partial transparency by combining
8184 the image with a specified background color.
8185
8186 I'm not sure how to handle this here nicely: because the
8187 background on which the image is displayed may change, for
8188 real alpha channel support, it would be necessary to create
8189 a new image for each possible background.
8190
8191 What I'm doing now is that a mask is created if we have
8192 boolean transparency information. Otherwise I'm using
8193 the frame's background color to combine the image with. */
8194
8195 if (channels == 4)
8196 {
8197 if (mask_img)
8198 XPutPixel (mask_img, x, y, *p > 0);
8199 ++p;
8200 }
8201 }
8202 }
8203
8204 /* Remember colors allocated for this image. */
8205 img->colors = colors_in_color_table (&img->ncolors);
8206 free_color_table ();
8207
8208 /* Clean up. */
8209 png_destroy_read_struct (&png_ptr, &info_ptr, &end_info);
8210 xfree (rows);
8211 xfree (pixels);
8212
8213 img->width = width;
8214 img->height = height;
8215
8216 /* Put the image into the pixmap, then free the X image and its buffer. */
8217 x_put_x_image (f, ximg, img->pixmap, width, height);
8218 x_destroy_x_image (ximg);
8219
8220 /* Same for the mask. */
8221 if (mask_img)
8222 {
8223 x_put_x_image (f, mask_img, img->mask, img->width, img->height);
8224 x_destroy_x_image (mask_img);
8225 }
8226
8227 UNBLOCK_INPUT;
8228 UNGCPRO;
8229 return 1;
8230}
8231
8232#endif /* HAVE_PNG != 0 */
8233
8234
8235
8236/***********************************************************************
8237 JPEG
8238 ***********************************************************************/
8239
8240#if HAVE_JPEG
8241
8242#include <jpeglib.h>
8243#include <jerror.h>
8244#include <setjmp.h>
8245
8246static int jpeg_image_p P_ ((Lisp_Object object));
8247static int jpeg_load P_ ((struct frame *f, struct image *img));
8248
8249/* The symbol `jpeg' identifying images of this type. */
8250
8251Lisp_Object Qjpeg;
8252
8253/* Indices of image specification fields in gs_format, below. */
8254
8255enum jpeg_keyword_index
8256{
8257 JPEG_TYPE,
8258 JPEG_FILE,
8259 JPEG_ASCENT,
8260 JPEG_MARGIN,
8261 JPEG_RELIEF,
8262 JPEG_ALGORITHM,
8263 JPEG_HEURISTIC_MASK,
8264 JPEG_LAST
8265};
8266
8267/* Vector of image_keyword structures describing the format
8268 of valid user-defined image specifications. */
8269
8270static struct image_keyword jpeg_format[JPEG_LAST] =
8271{
8272 {":type", IMAGE_SYMBOL_VALUE, 1},
8273 {":file", IMAGE_STRING_VALUE, 1},
8274 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
8275 {":margin", IMAGE_POSITIVE_INTEGER_VALUE, 0},
8276 {":relief", IMAGE_INTEGER_VALUE, 0},
8277 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
8278 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
8279};
8280
8281/* Structure describing the image type `jpeg'. */
8282
8283static struct image_type jpeg_type =
8284{
8285 &Qjpeg,
8286 jpeg_image_p,
8287 jpeg_load,
8288 x_clear_image,
8289 NULL
8290};
8291
8292
8293/* Return non-zero if OBJECT is a valid JPEG image specification. */
8294
8295static int
8296jpeg_image_p (object)
8297 Lisp_Object object;
8298{
8299 struct image_keyword fmt[JPEG_LAST];
8300
8301 bcopy (jpeg_format, fmt, sizeof fmt);
8302
8303 if (!parse_image_spec (object, fmt, JPEG_LAST, Qjpeg, 0)
8304 || (fmt[JPEG_ASCENT].count
8305 && XFASTINT (fmt[JPEG_ASCENT].value) > 100))
8306 return 0;
8307 return 1;
8308}
8309
8310struct my_jpeg_error_mgr
8311{
8312 struct jpeg_error_mgr pub;
8313 jmp_buf setjmp_buffer;
8314};
8315
8316static void
8317my_error_exit (cinfo)
8318 j_common_ptr cinfo;
8319{
8320 struct my_jpeg_error_mgr *mgr = (struct my_jpeg_error_mgr *) cinfo->err;
8321 longjmp (mgr->setjmp_buffer, 1);
8322}
8323
8324/* Load image IMG for use on frame F. Patterned after example.c
8325 from the JPEG lib. */
8326
8327static int
8328jpeg_load (f, img)
8329 struct frame *f;
8330 struct image *img;
8331{
8332 struct jpeg_decompress_struct cinfo;
8333 struct my_jpeg_error_mgr mgr;
8334 Lisp_Object file, specified_file;
8335 FILE *fp;
8336 JSAMPARRAY buffer;
8337 int row_stride, x, y;
8338 XImage *ximg = NULL;
8339 int rc, value;
8340 unsigned long *colors;
8341 int width, height;
8342 struct gcpro gcpro1;
8343
8344 /* Open the JPEG file. */
8345 specified_file = image_spec_value (img->spec, QCfile, NULL);
8346 file = x_find_image_file (specified_file);
8347 GCPRO1 (file);
8348 if (!STRINGP (file))
8349 {
8350 image_error ("Cannot find image file %s", specified_file, Qnil);
8351 UNGCPRO;
8352 return 0;
8353 }
8354
8355 fp = fopen (XSTRING (file)->data, "r");
8356 if (fp == NULL)
8357 {
8358 image_error ("Cannot open `%s'", file, Qnil);
8359 UNGCPRO;
8360 return 0;
8361 }
8362
8363 /* Customize libjpeg's error handling to call my_error_exit
8364 when an error is detected. This function will perform
8365 a longjmp. */
8366 mgr.pub.error_exit = my_error_exit;
8367 cinfo.err = jpeg_std_error (&mgr.pub);
8368
8369 if ((rc = setjmp (mgr.setjmp_buffer)) != 0)
8370 {
8371 if (rc == 1)
8372 {
8373 /* Called from my_error_exit. Display a JPEG error. */
8374 char buffer[JMSG_LENGTH_MAX];
8375 cinfo.err->format_message ((j_common_ptr) &cinfo, buffer);
8376 image_error ("Error reading JPEG file `%s': %s", file,
8377 build_string (buffer));
8378 }
8379
8380 /* Close the input file and destroy the JPEG object. */
8381 fclose (fp);
8382 jpeg_destroy_decompress (&cinfo);
8383
8384 BLOCK_INPUT;
8385
8386 /* If we already have an XImage, free that. */
8387 x_destroy_x_image (ximg);
8388
8389 /* Free pixmap and colors. */
8390 x_clear_image (f, img);
8391
8392 UNBLOCK_INPUT;
8393 UNGCPRO;
8394 return 0;
8395 }
8396
8397 /* Create the JPEG decompression object. Let it read from fp.
8398 Read the JPEG image header. */
8399 jpeg_create_decompress (&cinfo);
8400 jpeg_stdio_src (&cinfo, fp);
8401 jpeg_read_header (&cinfo, TRUE);
8402
8403 /* Customize decompression so that color quantization will be used.
8404 Start decompression. */
8405 cinfo.quantize_colors = TRUE;
8406 jpeg_start_decompress (&cinfo);
8407 width = img->width = cinfo.output_width;
8408 height = img->height = cinfo.output_height;
8409
8410 BLOCK_INPUT;
8411
8412 /* Create X image and pixmap. */
8413 if (!x_create_x_image_and_pixmap (f, file, width, height, 0, &ximg,
8414 &img->pixmap))
8415 {
8416 UNBLOCK_INPUT;
8417 longjmp (mgr.setjmp_buffer, 2);
8418 }
8419
8420 /* Allocate colors. When color quantization is used,
8421 cinfo.actual_number_of_colors has been set with the number of
8422 colors generated, and cinfo.colormap is a two-dimensional array
8423 of color indices in the range 0..cinfo.actual_number_of_colors.
8424 No more than 255 colors will be generated. */
8425 {
8426 int i, ir, ig, ib;
8427
8428 if (cinfo.out_color_components > 2)
8429 ir = 0, ig = 1, ib = 2;
8430 else if (cinfo.out_color_components > 1)
8431 ir = 0, ig = 1, ib = 0;
8432 else
8433 ir = 0, ig = 0, ib = 0;
8434
8435 /* Use the color table mechanism because it handles colors that
8436 cannot be allocated nicely. Such colors will be replaced with
8437 a default color, and we don't have to care about which colors
8438 can be freed safely, and which can't. */
8439 init_color_table ();
8440 colors = (unsigned long *) alloca (cinfo.actual_number_of_colors
8441 * sizeof *colors);
8442
8443 for (i = 0; i < cinfo.actual_number_of_colors; ++i)
8444 {
8445 /* Multiply RGB values with 255 because X expects RGB values
8446 in the range 0..0xffff. */
8447 int r = cinfo.colormap[ir][i] << 8;
8448 int g = cinfo.colormap[ig][i] << 8;
8449 int b = cinfo.colormap[ib][i] << 8;
8450 colors[i] = lookup_rgb_color (f, r, g, b);
8451 }
8452
8453 /* Remember those colors actually allocated. */
8454 img->colors = colors_in_color_table (&img->ncolors);
8455 free_color_table ();
8456 }
8457
8458 /* Read pixels. */
8459 row_stride = width * cinfo.output_components;
8460 buffer = cinfo.mem->alloc_sarray ((j_common_ptr) &cinfo, JPOOL_IMAGE,
8461 row_stride, 1);
8462 for (y = 0; y < height; ++y)
8463 {
8464 jpeg_read_scanlines (&cinfo, buffer, 1);
8465 for (x = 0; x < cinfo.output_width; ++x)
8466 XPutPixel (ximg, x, y, colors[buffer[0][x]]);
8467 }
8468
8469 /* Clean up. */
8470 jpeg_finish_decompress (&cinfo);
8471 jpeg_destroy_decompress (&cinfo);
8472 fclose (fp);
8473
8474 /* Put the image into the pixmap. */
8475 x_put_x_image (f, ximg, img->pixmap, width, height);
8476 x_destroy_x_image (ximg);
8477 UNBLOCK_INPUT;
8478 UNGCPRO;
8479 return 1;
8480}
8481
8482#endif /* HAVE_JPEG */
8483
8484
8485
8486/***********************************************************************
8487 TIFF
8488 ***********************************************************************/
8489
8490#if HAVE_TIFF
8491
8492#include <tiff34/tiffio.h>
8493
8494static int tiff_image_p P_ ((Lisp_Object object));
8495static int tiff_load P_ ((struct frame *f, struct image *img));
8496
8497/* The symbol `tiff' identifying images of this type. */
8498
8499Lisp_Object Qtiff;
8500
8501/* Indices of image specification fields in tiff_format, below. */
8502
8503enum tiff_keyword_index
8504{
8505 TIFF_TYPE,
8506 TIFF_FILE,
8507 TIFF_ASCENT,
8508 TIFF_MARGIN,
8509 TIFF_RELIEF,
8510 TIFF_ALGORITHM,
8511 TIFF_HEURISTIC_MASK,
8512 TIFF_LAST
8513};
8514
8515/* Vector of image_keyword structures describing the format
8516 of valid user-defined image specifications. */
8517
8518static struct image_keyword tiff_format[TIFF_LAST] =
8519{
8520 {":type", IMAGE_SYMBOL_VALUE, 1},
8521 {":file", IMAGE_STRING_VALUE, 1},
8522 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
8523 {":margin", IMAGE_POSITIVE_INTEGER_VALUE, 0},
8524 {":relief", IMAGE_INTEGER_VALUE, 0},
8525 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
8526 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
8527};
8528
8529/* Structure describing the image type `tiff'. */
8530
8531static struct image_type tiff_type =
8532{
8533 &Qtiff,
8534 tiff_image_p,
8535 tiff_load,
8536 x_clear_image,
8537 NULL
8538};
8539
8540
8541/* Return non-zero if OBJECT is a valid TIFF image specification. */
8542
8543static int
8544tiff_image_p (object)
8545 Lisp_Object object;
8546{
8547 struct image_keyword fmt[TIFF_LAST];
8548 bcopy (tiff_format, fmt, sizeof fmt);
8549
8550 if (!parse_image_spec (object, fmt, TIFF_LAST, Qtiff, 1)
8551 || (fmt[TIFF_ASCENT].count
8552 && XFASTINT (fmt[TIFF_ASCENT].value) > 100))
8553 return 0;
8554 return 1;
8555}
8556
8557
8558/* Load TIFF image IMG for use on frame F. Value is non-zero if
8559 successful. */
8560
8561static int
8562tiff_load (f, img)
8563 struct frame *f;
8564 struct image *img;
8565{
8566 Lisp_Object file, specified_file;
8567 TIFF *tiff;
8568 int width, height, x, y;
8569 uint32 *buf;
8570 int rc;
8571 XImage *ximg;
8572 struct gcpro gcpro1;
8573
8574 specified_file = image_spec_value (img->spec, QCfile, NULL);
8575 file = x_find_image_file (specified_file);
8576 GCPRO1 (file);
8577 if (!STRINGP (file))
8578 {
8579 image_error ("Cannot find image file %s", file, Qnil);
8580 UNGCPRO;
8581 return 0;
8582 }
8583
8584 /* Try to open the image file. */
8585 tiff = TIFFOpen (XSTRING (file)->data, "r");
8586 if (tiff == NULL)
8587 {
8588 image_error ("Cannot open `%s'", file, Qnil);
8589 UNGCPRO;
8590 return 0;
8591 }
8592
8593 /* Get width and height of the image, and allocate a raster buffer
8594 of width x height 32-bit values. */
8595 TIFFGetField (tiff, TIFFTAG_IMAGEWIDTH, &width);
8596 TIFFGetField (tiff, TIFFTAG_IMAGELENGTH, &height);
8597 buf = (uint32 *) xmalloc (width * height * sizeof *buf);
8598
8599 rc = TIFFReadRGBAImage (tiff, width, height, buf, 0);
8600 TIFFClose (tiff);
8601 if (!rc)
8602 {
8603 image_error ("Error reading `%s'", file, Qnil);
8604 xfree (buf);
8605 UNGCPRO;
8606 return 0;
8607 }
8608
8609 BLOCK_INPUT;
8610
8611 /* Create the X image and pixmap. */
8612 if (!x_create_x_image_and_pixmap (f, file, width, height, 0, &ximg,
8613 &img->pixmap))
8614 {
8615 UNBLOCK_INPUT;
8616 xfree (buf);
8617 UNGCPRO;
8618 return 0;
8619 }
8620
8621 /* Initialize the color table. */
8622 init_color_table ();
8623
8624 /* Process the pixel raster. Origin is in the lower-left corner. */
8625 for (y = 0; y < height; ++y)
8626 {
8627 uint32 *row = buf + y * width;
8628
8629 for (x = 0; x < width; ++x)
8630 {
8631 uint32 abgr = row[x];
8632 int r = TIFFGetR (abgr) << 8;
8633 int g = TIFFGetG (abgr) << 8;
8634 int b = TIFFGetB (abgr) << 8;
8635 XPutPixel (ximg, x, height - 1 - y, lookup_rgb_color (f, r, g, b));
8636 }
8637 }
8638
8639 /* Remember the colors allocated for the image. Free the color table. */
8640 img->colors = colors_in_color_table (&img->ncolors);
8641 free_color_table ();
8642
8643 /* Put the image into the pixmap, then free the X image and its buffer. */
8644 x_put_x_image (f, ximg, img->pixmap, width, height);
8645 x_destroy_x_image (ximg);
8646 xfree (buf);
8647 UNBLOCK_INPUT;
8648
8649 img->width = width;
8650 img->height = height;
8651
8652 UNGCPRO;
8653 return 1;
8654}
8655
8656#endif /* HAVE_TIFF != 0 */
8657
8658
8659
8660/***********************************************************************
8661 GIF
8662 ***********************************************************************/
8663
8664#if HAVE_GIF
8665
8666#include <gif_lib.h>
8667
8668static int gif_image_p P_ ((Lisp_Object object));
8669static int gif_load P_ ((struct frame *f, struct image *img));
8670
8671/* The symbol `gif' identifying images of this type. */
8672
8673Lisp_Object Qgif;
8674
8675/* Indices of image specification fields in gif_format, below. */
8676
8677enum gif_keyword_index
8678{
8679 GIF_TYPE,
8680 GIF_FILE,
8681 GIF_ASCENT,
8682 GIF_MARGIN,
8683 GIF_RELIEF,
8684 GIF_ALGORITHM,
8685 GIF_HEURISTIC_MASK,
8686 GIF_IMAGE,
8687 GIF_LAST
8688};
8689
8690/* Vector of image_keyword structures describing the format
8691 of valid user-defined image specifications. */
8692
8693static struct image_keyword gif_format[GIF_LAST] =
8694{
8695 {":type", IMAGE_SYMBOL_VALUE, 1},
8696 {":file", IMAGE_STRING_VALUE, 1},
8697 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
8698 {":margin", IMAGE_POSITIVE_INTEGER_VALUE, 0},
8699 {":relief", IMAGE_INTEGER_VALUE, 0},
8700 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
8701 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
8702 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0}
8703};
8704
8705/* Structure describing the image type `gif'. */
8706
8707static struct image_type gif_type =
8708{
8709 &Qgif,
8710 gif_image_p,
8711 gif_load,
8712 x_clear_image,
8713 NULL
8714};
8715
8716
8717/* Return non-zero if OBJECT is a valid GIF image specification. */
8718
8719static int
8720gif_image_p (object)
8721 Lisp_Object object;
8722{
8723 struct image_keyword fmt[GIF_LAST];
8724 bcopy (gif_format, fmt, sizeof fmt);
8725
8726 if (!parse_image_spec (object, fmt, GIF_LAST, Qgif, 1)
8727 || (fmt[GIF_ASCENT].count
8728 && XFASTINT (fmt[GIF_ASCENT].value) > 100))
8729 return 0;
8730 return 1;
8731}
8732
8733
8734/* Load GIF image IMG for use on frame F. Value is non-zero if
8735 successful. */
8736
8737static int
8738gif_load (f, img)
8739 struct frame *f;
8740 struct image *img;
8741{
8742 Lisp_Object file, specified_file;
8743 int rc, width, height, x, y, i;
8744 XImage *ximg;
8745 ColorMapObject *gif_color_map;
8746 unsigned long pixel_colors[256];
8747 GifFileType *gif;
8748 struct gcpro gcpro1;
8749 Lisp_Object image;
8750 int ino, image_left, image_top, image_width, image_height;
8751 int bg;
8752
8753 specified_file = image_spec_value (img->spec, QCfile, NULL);
8754 file = x_find_image_file (specified_file);
8755 GCPRO1 (file);
8756 if (!STRINGP (file))
8757 {
8758 image_error ("Cannot find image file %s", specified_file, Qnil);
8759 UNGCPRO;
8760 return 0;
8761 }
8762
8763 /* Open the GIF file. */
8764 gif = DGifOpenFileName (XSTRING (file)->data);
8765 if (gif == NULL)
8766 {
8767 image_error ("Cannot open `%s'", file, Qnil);
8768 UNGCPRO;
8769 return 0;
8770 }
8771
8772 /* Read entire contents. */
8773 rc = DGifSlurp (gif);
8774 if (rc == GIF_ERROR)
8775 {
8776 image_error ("Error reading `%s'", file, Qnil);
8777 DGifCloseFile (gif);
8778 UNGCPRO;
8779 return 0;
8780 }
8781
8782 image = image_spec_value (img->spec, QCimage, NULL);
8783 ino = INTEGERP (image) ? XFASTINT (image) : 0;
8784 if (ino >= gif->ImageCount)
8785 {
8786 image_error ("Invalid image number `%s'", image, Qnil);
8787 DGifCloseFile (gif);
8788 UNGCPRO;
8789 return 0;
8790 }
8791
8792 width = img->width = gif->SWidth;
8793 height = img->height = gif->SHeight;
8794
8795 BLOCK_INPUT;
8796
8797 /* Create the X image and pixmap. */
8798 if (!x_create_x_image_and_pixmap (f, file, width, height, 0, &ximg,
8799 &img->pixmap))
8800 {
8801 UNBLOCK_INPUT;
8802 DGifCloseFile (gif);
8803 UNGCPRO;
8804 return 0;
8805 }
8806
8807 /* Allocate colors. */
8808 gif_color_map = gif->SavedImages[ino].ImageDesc.ColorMap;
8809 if (!gif_color_map)
8810 gif_color_map = gif->SColorMap;
8811 init_color_table ();
8812 bzero (pixel_colors, sizeof pixel_colors);
8813
8814 for (i = 0; i < gif_color_map->ColorCount; ++i)
8815 {
8816 int r = gif_color_map->Colors[i].Red << 8;
8817 int g = gif_color_map->Colors[i].Green << 8;
8818 int b = gif_color_map->Colors[i].Blue << 8;
8819 pixel_colors[i] = lookup_rgb_color (f, r, g, b);
8820 }
8821
8822 img->colors = colors_in_color_table (&img->ncolors);
8823 free_color_table ();
8824
8825 /* Clear the part of the screen image that are not covered by
8826 the image from the GIF file. Full animated GIF support
8827 requires more than can be done here (see the gif89 spec,
8828 disposal methods). Let's simply assume that the part
8829 not covered by a sub-image is in the frame's background color. */
8830 image_top = gif->SavedImages[ino].ImageDesc.Top;
8831 image_left = gif->SavedImages[ino].ImageDesc.Left;
8832 image_width = gif->SavedImages[ino].ImageDesc.Width;
8833 image_height = gif->SavedImages[ino].ImageDesc.Height;
8834
8835 for (y = 0; y < image_top; ++y)
8836 for (x = 0; x < width; ++x)
8837 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
8838
8839 for (y = image_top + image_height; y < height; ++y)
8840 for (x = 0; x < width; ++x)
8841 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
8842
8843 for (y = image_top; y < image_top + image_height; ++y)
8844 {
8845 for (x = 0; x < image_left; ++x)
8846 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
8847 for (x = image_left + image_width; x < width; ++x)
8848 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
8849 }
8850
8851 /* Read the GIF image into the X image. */
8852 if (gif->SavedImages[ino].ImageDesc.Interlace)
8853 {
8854 static int interlace_start[] = {0, 4, 2, 1};
8855 static int interlace_increment[] = {8, 8, 4, 2};
8856 int pass, inc;
8857
8858 for (pass = 0; pass < 4; ++pass)
8859 {
8860 inc = interlace_increment[pass];
8861 for (y = interlace_start[pass]; y < image_height; y += inc)
8862 for (x = 0; x < image_width; ++x)
8863 {
8864 unsigned i = gif->SavedImages[ino].RasterBits[y * image_width + x];
8865 XPutPixel (ximg, x + image_left, y + image_top,
8866 pixel_colors[i]);
8867 }
8868 }
8869 }
8870 else
8871 {
8872 for (y = 0; y < image_height; ++y)
8873 for (x = 0; x < image_width; ++x)
8874 {
8875 unsigned i = gif->SavedImages[ino].RasterBits[y * image_width + x];
8876 XPutPixel (ximg, x + image_left, y + image_top, pixel_colors[i]);
8877 }
8878 }
8879
8880 DGifCloseFile (gif);
8881
8882 /* Put the image into the pixmap, then free the X image and its buffer. */
8883 x_put_x_image (f, ximg, img->pixmap, width, height);
8884 x_destroy_x_image (ximg);
8885 UNBLOCK_INPUT;
8886
8887 UNGCPRO;
8888 return 1;
8889}
8890
8891#endif /* HAVE_GIF != 0 */
8892
8893
8894
8895/***********************************************************************
8896 Ghostscript
8897 ***********************************************************************/
8898
8899static int gs_image_p P_ ((Lisp_Object object));
8900static int gs_load P_ ((struct frame *f, struct image *img));
8901static void gs_clear_image P_ ((struct frame *f, struct image *img));
8902
8903/* The symbol `ghostscript' identifying images of this type. */
8904
8905Lisp_Object Qghostscript;
8906
8907/* Keyword symbols. */
8908
8909Lisp_Object QCloader, QCbounding_box, QCpt_width, QCpt_height;
8910
8911/* Indices of image specification fields in gs_format, below. */
8912
8913enum gs_keyword_index
8914{
8915 GS_TYPE,
8916 GS_PT_WIDTH,
8917 GS_PT_HEIGHT,
8918 GS_FILE,
8919 GS_LOADER,
8920 GS_BOUNDING_BOX,
8921 GS_ASCENT,
8922 GS_MARGIN,
8923 GS_RELIEF,
8924 GS_ALGORITHM,
8925 GS_HEURISTIC_MASK,
8926 GS_LAST
8927};
8928
8929/* Vector of image_keyword structures describing the format
8930 of valid user-defined image specifications. */
8931
8932static struct image_keyword gs_format[GS_LAST] =
8933{
8934 {":type", IMAGE_SYMBOL_VALUE, 1},
8935 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE, 1},
8936 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE, 1},
8937 {":file", IMAGE_STRING_VALUE, 1},
8938 {":loader", IMAGE_FUNCTION_VALUE, 0},
8939 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE, 1},
8940 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
8941 {":margin", IMAGE_POSITIVE_INTEGER_VALUE, 0},
8942 {":relief", IMAGE_INTEGER_VALUE, 0},
8943 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
8944 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
8945};
8946
8947/* Structure describing the image type `ghostscript'. */
8948
8949static struct image_type gs_type =
8950{
8951 &Qghostscript,
8952 gs_image_p,
8953 gs_load,
8954 gs_clear_image,
8955 NULL
8956};
8957
8958
8959/* Free X resources of Ghostscript image IMG which is used on frame F. */
8960
8961static void
8962gs_clear_image (f, img)
8963 struct frame *f;
8964 struct image *img;
8965{
8966 /* IMG->data.ptr_val may contain a recorded colormap. */
8967 xfree (img->data.ptr_val);
8968 x_clear_image (f, img);
8969}
8970
8971
8972/* Return non-zero if OBJECT is a valid Ghostscript image
8973 specification. */
8974
8975static int
8976gs_image_p (object)
8977 Lisp_Object object;
8978{
8979 struct image_keyword fmt[GS_LAST];
8980 Lisp_Object tem;
8981 int i;
8982
8983 bcopy (gs_format, fmt, sizeof fmt);
8984
8985 if (!parse_image_spec (object, fmt, GS_LAST, Qghostscript, 1)
8986 || (fmt[GS_ASCENT].count
8987 && XFASTINT (fmt[GS_ASCENT].value) > 100))
8988 return 0;
8989
8990 /* Bounding box must be a list or vector containing 4 integers. */
8991 tem = fmt[GS_BOUNDING_BOX].value;
8992 if (CONSP (tem))
8993 {
8994 for (i = 0; i < 4; ++i, tem = XCDR (tem))
8995 if (!CONSP (tem) || !INTEGERP (XCAR (tem)))
8996 return 0;
8997 if (!NILP (tem))
8998 return 0;
8999 }
9000 else if (VECTORP (tem))
9001 {
9002 if (XVECTOR (tem)->size != 4)
9003 return 0;
9004 for (i = 0; i < 4; ++i)
9005 if (!INTEGERP (XVECTOR (tem)->contents[i]))
9006 return 0;
9007 }
9008 else
9009 return 0;
9010
9011 return 1;
9012}
9013
9014
9015/* Load Ghostscript image IMG for use on frame F. Value is non-zero
9016 if successful. */
9017
9018static int
9019gs_load (f, img)
9020 struct frame *f;
9021 struct image *img;
9022{
9023 char buffer[100];
9024 Lisp_Object window_and_pixmap_id = Qnil, loader, pt_height, pt_width;
9025 struct gcpro gcpro1, gcpro2;
9026 Lisp_Object frame;
9027 double in_width, in_height;
9028 Lisp_Object pixel_colors = Qnil;
9029
9030 /* Compute pixel size of pixmap needed from the given size in the
9031 image specification. Sizes in the specification are in pt. 1 pt
9032 = 1/72 in, xdpi and ydpi are stored in the frame's X display
9033 info. */
9034 pt_width = image_spec_value (img->spec, QCpt_width, NULL);
9035 in_width = XFASTINT (pt_width) / 72.0;
9036 img->width = in_width * FRAME_X_DISPLAY_INFO (f)->resx;
9037 pt_height = image_spec_value (img->spec, QCpt_height, NULL);
9038 in_height = XFASTINT (pt_height) / 72.0;
9039 img->height = in_height * FRAME_X_DISPLAY_INFO (f)->resy;
9040
9041 /* Create the pixmap. */
9042 BLOCK_INPUT;
9043 xassert (img->pixmap == 0);
9044 img->pixmap = XCreatePixmap (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
9045 img->width, img->height,
9046 DefaultDepthOfScreen (FRAME_X_SCREEN (f)));
9047 UNBLOCK_INPUT;
9048
9049 if (!img->pixmap)
9050 {
9051 image_error ("Unable to create pixmap for `%s'",
9052 image_spec_value (img->spec, QCfile, NULL), Qnil);
9053 return 0;
9054 }
9055
9056 /* Call the loader to fill the pixmap. It returns a process object
9057 if successful. We do not record_unwind_protect here because
9058 other places in redisplay like calling window scroll functions
9059 don't either. Let the Lisp loader use `unwind-protect' instead. */
9060 GCPRO2 (window_and_pixmap_id, pixel_colors);
9061
9062 sprintf (buffer, "%lu %lu",
9063 (unsigned long) FRAME_X_WINDOW (f),
9064 (unsigned long) img->pixmap);
9065 window_and_pixmap_id = build_string (buffer);
9066
9067 sprintf (buffer, "%lu %lu",
9068 FRAME_FOREGROUND_PIXEL (f),
9069 FRAME_BACKGROUND_PIXEL (f));
9070 pixel_colors = build_string (buffer);
9071
9072 XSETFRAME (frame, f);
9073 loader = image_spec_value (img->spec, QCloader, NULL);
9074 if (NILP (loader))
9075 loader = intern ("gs-load-image");
9076
9077 img->data.lisp_val = call6 (loader, frame, img->spec,
9078 make_number (img->width),
9079 make_number (img->height),
9080 window_and_pixmap_id,
9081 pixel_colors);
9082 UNGCPRO;
9083 return PROCESSP (img->data.lisp_val);
9084}
9085
9086
9087/* Kill the Ghostscript process that was started to fill PIXMAP on
9088 frame F. Called from XTread_socket when receiving an event
9089 telling Emacs that Ghostscript has finished drawing. */
9090
9091void
9092x_kill_gs_process (pixmap, f)
9093 Pixmap pixmap;
9094 struct frame *f;
9095{
9096 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
9097 int class, i;
9098 struct image *img;
9099
9100 /* Find the image containing PIXMAP. */
9101 for (i = 0; i < c->used; ++i)
9102 if (c->images[i]->pixmap == pixmap)
9103 break;
9104
9105 /* Kill the GS process. We should have found PIXMAP in the image
9106 cache and its image should contain a process object. */
9107 xassert (i < c->used);
9108 img = c->images[i];
9109 xassert (PROCESSP (img->data.lisp_val));
9110 Fkill_process (img->data.lisp_val, Qnil);
9111 img->data.lisp_val = Qnil;
9112
9113 /* On displays with a mutable colormap, figure out the colors
9114 allocated for the image by looking at the pixels of an XImage for
9115 img->pixmap. */
9116 class = FRAME_X_DISPLAY_INFO (f)->visual->class;
9117 if (class != StaticColor && class != StaticGray && class != TrueColor)
9118 {
9119 XImage *ximg;
9120
9121 BLOCK_INPUT;
9122
9123 /* Try to get an XImage for img->pixmep. */
9124 ximg = XGetImage (FRAME_X_DISPLAY (f), img->pixmap,
9125 0, 0, img->width, img->height, ~0, ZPixmap);
9126 if (ximg)
9127 {
9128 int x, y;
9129
9130 /* Initialize the color table. */
9131 init_color_table ();
9132
9133 /* For each pixel of the image, look its color up in the
9134 color table. After having done so, the color table will
9135 contain an entry for each color used by the image. */
9136 for (y = 0; y < img->height; ++y)
9137 for (x = 0; x < img->width; ++x)
9138 {
9139 unsigned long pixel = XGetPixel (ximg, x, y);
9140 lookup_pixel_color (f, pixel);
9141 }
9142
9143 /* Record colors in the image. Free color table and XImage. */
9144 img->colors = colors_in_color_table (&img->ncolors);
9145 free_color_table ();
9146 XDestroyImage (ximg);
9147
9148#if 0 /* This doesn't seem to be the case. If we free the colors
9149 here, we get a BadAccess later in x_clear_image when
9150 freeing the colors. */
9151 /* We have allocated colors once, but Ghostscript has also
9152 allocated colors on behalf of us. So, to get the
9153 reference counts right, free them once. */
9154 if (img->ncolors)
9155 {
9156 Colormap cmap = DefaultColormapOfScreen (FRAME_X_SCREEN (f));
9157 XFreeColors (FRAME_X_DISPLAY (f), cmap,
9158 img->colors, img->ncolors, 0);
9159 }
9160#endif
9161 }
9162 else
9163 image_error ("Cannot get X image of `%s'; colors will not be freed",
9164 image_spec_value (img->spec, QCfile, NULL), Qnil);
9165
9166 UNBLOCK_INPUT;
9167 }
9168}
9169
9170
5240 9171
9172/***********************************************************************
9173 Window properties
9174 ***********************************************************************/
9175
9176DEFUN ("x-change-window-property", Fx_change_window_property,
9177 Sx_change_window_property, 2, 3, 0,
9178 "Change window property PROP to VALUE on the X window of FRAME.\n\
9179PROP and VALUE must be strings. FRAME nil or omitted means use the\n\
9180selected frame. Value is VALUE.")
9181 (prop, value, frame)
9182 Lisp_Object frame, prop, value;
9183{
9184 struct frame *f = check_x_frame (frame);
9185 Atom prop_atom;
9186
9187 CHECK_STRING (prop, 1);
9188 CHECK_STRING (value, 2);
9189
9190 BLOCK_INPUT;
9191 prop_atom = XInternAtom (FRAME_X_DISPLAY (f), XSTRING (prop)->data, False);
9192 XChangeProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
9193 prop_atom, XA_STRING, 8, PropModeReplace,
9194 XSTRING (value)->data, XSTRING (value)->size);
9195
9196 /* Make sure the property is set when we return. */
9197 XFlush (FRAME_X_DISPLAY (f));
9198 UNBLOCK_INPUT;
9199
9200 return value;
9201}
9202
9203
9204DEFUN ("x-delete-window-property", Fx_delete_window_property,
9205 Sx_delete_window_property, 1, 2, 0,
9206 "Remove window property PROP from X window of FRAME.\n\
9207FRAME nil or omitted means use the selected frame. Value is PROP.")
9208 (prop, frame)
9209 Lisp_Object prop, frame;
9210{
9211 struct frame *f = check_x_frame (frame);
9212 Atom prop_atom;
9213
9214 CHECK_STRING (prop, 1);
9215 BLOCK_INPUT;
9216 prop_atom = XInternAtom (FRAME_X_DISPLAY (f), XSTRING (prop)->data, False);
9217 XDeleteProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), prop_atom);
9218
9219 /* Make sure the property is removed when we return. */
9220 XFlush (FRAME_X_DISPLAY (f));
9221 UNBLOCK_INPUT;
9222
9223 return prop;
9224}
9225
9226
9227DEFUN ("x-window-property", Fx_window_property, Sx_window_property,
9228 1, 2, 0,
9229 "Value is the value of window property PROP on FRAME.\n\
9230If FRAME is nil or omitted, use the selected frame. Value is nil\n\
9231if FRAME hasn't a property with name PROP or if PROP has no string\n\
9232value.")
9233 (prop, frame)
9234 Lisp_Object prop, frame;
9235{
9236 struct frame *f = check_x_frame (frame);
9237 Atom prop_atom;
9238 int rc;
9239 Lisp_Object prop_value = Qnil;
9240 char *tmp_data = NULL;
9241 Atom actual_type;
9242 int actual_format;
9243 unsigned long actual_size, bytes_remaining;
9244
9245 CHECK_STRING (prop, 1);
9246 BLOCK_INPUT;
9247 prop_atom = XInternAtom (FRAME_X_DISPLAY (f), XSTRING (prop)->data, False);
9248 rc = XGetWindowProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
9249 prop_atom, 0, 0, False, XA_STRING,
9250 &actual_type, &actual_format, &actual_size,
9251 &bytes_remaining, (unsigned char **) &tmp_data);
9252 if (rc == Success)
9253 {
9254 int size = bytes_remaining;
9255
9256 XFree (tmp_data);
9257 tmp_data = NULL;
9258
9259 rc = XGetWindowProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
9260 prop_atom, 0, bytes_remaining,
9261 False, XA_STRING,
9262 &actual_type, &actual_format,
9263 &actual_size, &bytes_remaining,
9264 (unsigned char **) &tmp_data);
9265 if (rc == Success)
9266 prop_value = make_string (tmp_data, size);
9267
9268 XFree (tmp_data);
9269 }
9270
9271 UNBLOCK_INPUT;
9272 return prop_value;
9273}
9274
9275
9276
9277/***********************************************************************
9278 Busy cursor
9279 ***********************************************************************/
9280
9281/* The implementation partly follows a patch from
9282 F.Pierresteguy@frcl.bull.fr dated 1994. */
9283
9284/* Setting inhibit_busy_cursor to 2 inhibits busy-cursor display until
9285 the next X event is read and we enter XTread_socket again. Setting
9286 it to 1 inhibits busy-cursor display for direct commands. */
9287
9288int inhibit_busy_cursor;
9289
9290/* Incremented with each call to x-display-busy-cursor.
9291 Decremented in x-undisplay-busy-cursor. */
9292
9293static int busy_count;
9294
9295
9296DEFUN ("x-show-busy-cursor", Fx_show_busy_cursor,
9297 Sx_show_busy_cursor, 0, 0, 0,
9298 "Show a busy cursor, if not already shown.\n\
9299Each call to this function must be matched by a call to\n\
9300x-undisplay-busy-cursor to make the busy pointer disappear again.")
9301 ()
9302{
9303 ++busy_count;
9304 if (busy_count == 1)
9305 {
9306 Lisp_Object rest, frame;
9307
9308 FOR_EACH_FRAME (rest, frame)
9309 if (FRAME_X_P (XFRAME (frame)))
9310 {
9311 struct frame *f = XFRAME (frame);
9312
9313 BLOCK_INPUT;
9314 f->output_data.x->busy_p = 1;
9315
9316 if (!f->output_data.x->busy_window)
9317 {
9318 unsigned long mask = CWCursor;
9319 XSetWindowAttributes attrs;
9320
9321 attrs.cursor = f->output_data.x->busy_cursor;
9322 f->output_data.x->busy_window
9323 = XCreateWindow (FRAME_X_DISPLAY (f),
9324 FRAME_OUTER_WINDOW (f),
9325 0, 0, 32000, 32000, 0, 0,
9326 InputOnly, CopyFromParent,
9327 mask, &attrs);
9328 }
9329
9330 XMapRaised (FRAME_X_DISPLAY (f), f->output_data.x->busy_window);
9331 UNBLOCK_INPUT;
9332 }
9333 }
9334
9335 return Qnil;
9336}
9337
9338
9339DEFUN ("x-hide-busy-cursor", Fx_hide_busy_cursor,
9340 Sx_hide_busy_cursor, 0, 1, 0,
9341 "Hide a busy-cursor.\n\
9342A busy-cursor will actually be undisplayed when a matching\n\
9343`x-undisplay-busy-cursor' is called for each `x-display-busy-cursor'\n\
9344issued. FORCE non-nil means undisplay the busy-cursor forcibly,\n\
9345not counting calls.")
9346 (force)
9347 Lisp_Object force;
9348{
9349 Lisp_Object rest, frame;
9350
9351 if (busy_count == 0)
9352 return Qnil;
9353
9354 if (!NILP (force) && busy_count != 0)
9355 busy_count = 1;
9356
9357 --busy_count;
9358 if (busy_count != 0)
9359 return Qnil;
9360
9361 FOR_EACH_FRAME (rest, frame)
9362 {
9363 struct frame *f = XFRAME (frame);
9364
9365 if (FRAME_X_P (f)
9366 /* Watch out for newly created frames. */
9367 && f->output_data.x->busy_window)
9368 {
9369
9370 BLOCK_INPUT;
9371 XUnmapWindow (FRAME_X_DISPLAY (f), f->output_data.x->busy_window);
9372 /* Sync here because XTread_socket looks at the busy_p flag
9373 that is reset to zero below. */
9374 XSync (FRAME_X_DISPLAY (f), False);
9375 UNBLOCK_INPUT;
9376 f->output_data.x->busy_p = 0;
9377 }
9378 }
9379
9380 return Qnil;
9381}
9382
9383
9384
9385/***********************************************************************
9386 Tool tips
9387 ***********************************************************************/
9388
9389static Lisp_Object x_create_tip_frame P_ ((struct x_display_info *,
9390 Lisp_Object));
9391
9392/* The frame of a currently visible tooltip, or null. */
9393
9394struct frame *tip_frame;
9395
9396/* If non-nil, a timer started that hides the last tooltip when it
9397 fires. */
9398
9399Lisp_Object tip_timer;
9400Window tip_window;
9401
9402/* Create a frame for a tooltip on the display described by DPYINFO.
9403 PARMS is a list of frame parameters. Value is the frame. */
9404
9405static Lisp_Object
9406x_create_tip_frame (dpyinfo, parms)
9407 struct x_display_info *dpyinfo;
9408 Lisp_Object parms;
9409{
9410 struct frame *f;
9411 Lisp_Object frame, tem;
9412 Lisp_Object name;
9413 int minibuffer_only = 0;
9414 long window_prompting = 0;
9415 int width, height;
9416 int count = specpdl_ptr - specpdl;
9417 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
9418 struct kboard *kb;
9419
9420 check_x ();
9421
9422 /* Use this general default value to start with until we know if
9423 this frame has a specified name. */
9424 Vx_resource_name = Vinvocation_name;
9425
9426#ifdef MULTI_KBOARD
9427 kb = dpyinfo->kboard;
9428#else
9429 kb = &the_only_kboard;
9430#endif
9431
9432 /* Get the name of the frame to use for resource lookup. */
9433 name = x_get_arg (dpyinfo, parms, Qname, "name", "Name", RES_TYPE_STRING);
9434 if (!STRINGP (name)
9435 && !EQ (name, Qunbound)
9436 && !NILP (name))
9437 error ("Invalid frame name--not a string or nil");
9438 Vx_resource_name = name;
9439
9440 frame = Qnil;
9441 GCPRO3 (parms, name, frame);
9442 tip_frame = f = make_frame (1);
9443 XSETFRAME (frame, f);
9444 FRAME_CAN_HAVE_SCROLL_BARS (f) = 0;
9445
9446 f->output_method = output_x_window;
9447 f->output_data.x = (struct x_output *) xmalloc (sizeof (struct x_output));
9448 bzero (f->output_data.x, sizeof (struct x_output));
9449 f->output_data.x->icon_bitmap = -1;
9450 f->output_data.x->fontset = -1;
9451 f->icon_name = Qnil;
9452 FRAME_X_DISPLAY_INFO (f) = dpyinfo;
9453#ifdef MULTI_KBOARD
9454 FRAME_KBOARD (f) = kb;
9455#endif
9456 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
9457 f->output_data.x->explicit_parent = 0;
9458
9459 /* Set the name; the functions to which we pass f expect the name to
9460 be set. */
9461 if (EQ (name, Qunbound) || NILP (name))
9462 {
9463 f->name = build_string (dpyinfo->x_id_name);
9464 f->explicit_name = 0;
9465 }
9466 else
9467 {
9468 f->name = name;
9469 f->explicit_name = 1;
9470 /* use the frame's title when getting resources for this frame. */
9471 specbind (Qx_resource_name, name);
9472 }
9473
9474 /* Create fontsets from `global_fontset_alist' before handling fonts. */
9475 for (tem = Vglobal_fontset_alist; CONSP (tem); tem = XCONS (tem)->cdr)
9476 fs_register_fontset (f, XCONS (tem)->car);
9477
9478 /* Extract the window parameters from the supplied values
9479 that are needed to determine window geometry. */
9480 {
9481 Lisp_Object font;
9482
9483 font = x_get_arg (dpyinfo, parms, Qfont, "font", "Font", RES_TYPE_STRING);
9484
9485 BLOCK_INPUT;
9486 /* First, try whatever font the caller has specified. */
9487 if (STRINGP (font))
9488 {
9489 tem = Fquery_fontset (font, Qnil);
9490 if (STRINGP (tem))
9491 font = x_new_fontset (f, XSTRING (tem)->data);
9492 else
9493 font = x_new_font (f, XSTRING (font)->data);
9494 }
9495
9496 /* Try out a font which we hope has bold and italic variations. */
9497 if (!STRINGP (font))
9498 font = x_new_font (f, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
9499 if (!STRINGP (font))
9500 font = x_new_font (f, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
9501 if (! STRINGP (font))
9502 font = x_new_font (f, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
9503 if (! STRINGP (font))
9504 /* This was formerly the first thing tried, but it finds too many fonts
9505 and takes too long. */
9506 font = x_new_font (f, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
9507 /* If those didn't work, look for something which will at least work. */
9508 if (! STRINGP (font))
9509 font = x_new_font (f, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
9510 UNBLOCK_INPUT;
9511 if (! STRINGP (font))
9512 font = build_string ("fixed");
9513
9514 x_default_parameter (f, parms, Qfont, font,
9515 "font", "Font", RES_TYPE_STRING);
9516 }
9517
9518 x_default_parameter (f, parms, Qborder_width, make_number (2),
9519 "borderWidth", "BorderWidth", RES_TYPE_NUMBER);
9520
9521 /* This defaults to 2 in order to match xterm. We recognize either
9522 internalBorderWidth or internalBorder (which is what xterm calls
9523 it). */
9524 if (NILP (Fassq (Qinternal_border_width, parms)))
9525 {
9526 Lisp_Object value;
9527
9528 value = x_get_arg (dpyinfo, parms, Qinternal_border_width,
9529 "internalBorder", "internalBorder", RES_TYPE_NUMBER);
9530 if (! EQ (value, Qunbound))
9531 parms = Fcons (Fcons (Qinternal_border_width, value),
9532 parms);
9533 }
9534
9535 x_default_parameter (f, parms, Qinternal_border_width, make_number (1),
9536 "internalBorderWidth", "internalBorderWidth",
9537 RES_TYPE_NUMBER);
9538
9539 /* Also do the stuff which must be set before the window exists. */
9540 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
9541 "foreground", "Foreground", RES_TYPE_STRING);
9542 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
9543 "background", "Background", RES_TYPE_STRING);
9544 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
9545 "pointerColor", "Foreground", RES_TYPE_STRING);
9546 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
9547 "cursorColor", "Foreground", RES_TYPE_STRING);
9548 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
9549 "borderColor", "BorderColor", RES_TYPE_STRING);
9550
9551 /* Init faces before x_default_parameter is called for scroll-bar
9552 parameters because that function calls x_set_scroll_bar_width,
9553 which calls change_frame_size, which calls Fset_window_buffer,
9554 which runs hooks, which call Fvertical_motion. At the end, we
9555 end up in init_iterator with a null face cache, which should not
9556 happen. */
9557 init_frame_faces (f);
9558
9559 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
9560 window_prompting = x_figure_window_size (f, parms);
9561
9562 if (window_prompting & XNegative)
9563 {
9564 if (window_prompting & YNegative)
9565 f->output_data.x->win_gravity = SouthEastGravity;
9566 else
9567 f->output_data.x->win_gravity = NorthEastGravity;
9568 }
9569 else
9570 {
9571 if (window_prompting & YNegative)
9572 f->output_data.x->win_gravity = SouthWestGravity;
9573 else
9574 f->output_data.x->win_gravity = NorthWestGravity;
9575 }
9576
9577 f->output_data.x->size_hint_flags = window_prompting;
9578 {
9579 XSetWindowAttributes attrs;
9580 unsigned long mask;
9581
9582 BLOCK_INPUT;
9583 mask = CWBackPixel | CWOverrideRedirect | CWSaveUnder | CWEventMask;
9584 /* Window managers looks at the override-redirect flag to
9585 determine whether or net to give windows a decoration (Xlib
9586 3.2.8). */
9587 attrs.override_redirect = True;
9588 attrs.save_under = True;
9589 attrs.background_pixel = FRAME_BACKGROUND_PIXEL (f);
9590 /* Arrange for getting MapNotify and UnmapNotify events. */
9591 attrs.event_mask = StructureNotifyMask;
9592 tip_window
9593 = FRAME_X_WINDOW (f)
9594 = XCreateWindow (FRAME_X_DISPLAY (f),
9595 FRAME_X_DISPLAY_INFO (f)->root_window,
9596 /* x, y, width, height */
9597 0, 0, 1, 1,
9598 /* Border. */
9599 1,
9600 CopyFromParent, InputOutput, CopyFromParent,
9601 mask, &attrs);
9602 UNBLOCK_INPUT;
9603 }
9604
9605 x_make_gc (f);
9606
9607 /* We need to do this after creating the X window, so that the
9608 icon-creation functions can say whose icon they're describing. */
9609 x_default_parameter (f, parms, Qicon_type, Qnil,
9610 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL);
9611
9612 x_default_parameter (f, parms, Qauto_raise, Qnil,
9613 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
9614 x_default_parameter (f, parms, Qauto_lower, Qnil,
9615 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
9616 x_default_parameter (f, parms, Qcursor_type, Qbox,
9617 "cursorType", "CursorType", RES_TYPE_SYMBOL);
9618
9619 /* Dimensions, especially f->height, must be done via change_frame_size.
9620 Change will not be effected unless different from the current
9621 f->height. */
9622 width = f->width;
9623 height = f->height;
9624 f->height = 0;
9625 SET_FRAME_WIDTH (f, 0);
9626 change_frame_size (f, height, width, 1, 0);
9627
9628 f->no_split = 1;
9629
9630 UNGCPRO;
9631
9632 /* It is now ok to make the frame official even if we get an error
9633 below. And the frame needs to be on Vframe_list or making it
9634 visible won't work. */
9635 Vframe_list = Fcons (frame, Vframe_list);
9636
9637 /* Now that the frame is official, it counts as a reference to
9638 its display. */
9639 FRAME_X_DISPLAY_INFO (f)->reference_count++;
9640
9641 return unbind_to (count, frame);
9642}
9643
9644
9645DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 4, 0,
9646 "Show tooltip STRING on frame FRAME.\n\
9647FRAME nil or omitted means use the selected frame.\n\
9648PARMS is an optional list of frame parameters which can be\n\
9649used to change the tooltip's appearance.\n\
9650Automatically hide the tooltip after TIMEOUT seconds.\n\
9651TIMEOUT nil means use the default timeout of 5 seconds.")
9652 (string, frame, parms, timeout)
9653 Lisp_Object string, frame, parms;
9654{
9655 struct frame *f;
9656 struct window *w;
9657 Window root, child;
9658 struct it it;
9659 Lisp_Object buffer;
9660 struct buffer *old_buffer;
9661 struct text_pos pos;
9662 int i, width, height;
9663 int root_x, root_y, win_x, win_y;
9664 unsigned pmask;
9665 struct gcpro gcpro1, gcpro2, gcpro3;
9666 int old_windows_or_buffers_changed = windows_or_buffers_changed;
9667 int count = specpdl_ptr - specpdl;
9668
9669 specbind (Qinhibit_redisplay, Qt);
9670
9671 GCPRO3 (string, parms, frame);
9672
9673 CHECK_STRING (string, 0);
9674 f = check_x_frame (frame);
9675 if (NILP (timeout))
9676 timeout = make_number (5);
9677 else
9678 CHECK_NATNUM (timeout, 2);
9679
9680 /* Hide a previous tip, if any. */
9681 Fx_hide_tip ();
9682
9683 /* Add default values to frame parameters. */
9684 if (NILP (Fassq (Qname, parms)))
9685 parms = Fcons (Fcons (Qname, build_string ("tooltip")), parms);
9686 if (NILP (Fassq (Qinternal_border_width, parms)))
9687 parms = Fcons (Fcons (Qinternal_border_width, make_number (3)), parms);
9688 if (NILP (Fassq (Qborder_width, parms)))
9689 parms = Fcons (Fcons (Qborder_width, make_number (1)), parms);
9690 if (NILP (Fassq (Qborder_color, parms)))
9691 parms = Fcons (Fcons (Qborder_color, build_string ("lightyellow")), parms);
9692 if (NILP (Fassq (Qbackground_color, parms)))
9693 parms = Fcons (Fcons (Qbackground_color, build_string ("lightyellow")),
9694 parms);
9695
9696 /* Create a frame for the tooltip, and record it in the global
9697 variable tip_frame. */
9698 frame = x_create_tip_frame (FRAME_X_DISPLAY_INFO (f), parms);
9699 tip_frame = f = XFRAME (frame);
9700
9701 /* Set up the frame's root window. Currently we use a size of 80
9702 columns x 40 lines. If someone wants to show a larger tip, he
9703 will loose. I don't think this is a realistic case. */
9704 w = XWINDOW (FRAME_ROOT_WINDOW (f));
9705 w->left = w->top = make_number (0);
9706 w->width = 80;
9707 w->height = 40;
9708 adjust_glyphs (f);
9709 w->pseudo_window_p = 1;
9710
9711 /* Display the tooltip text in a temporary buffer. */
9712 buffer = Fget_buffer_create (build_string (" *tip*"));
9713 Fset_window_buffer (FRAME_ROOT_WINDOW (f), buffer);
9714 old_buffer = current_buffer;
9715 set_buffer_internal_1 (XBUFFER (buffer));
9716 Ferase_buffer ();
9717 Finsert (make_number (1), &string);
9718 clear_glyph_matrix (w->desired_matrix);
9719 clear_glyph_matrix (w->current_matrix);
9720 SET_TEXT_POS (pos, BEGV, BEGV_BYTE);
9721 try_window (FRAME_ROOT_WINDOW (f), pos);
9722
9723 /* Compute width and height of the tooltip. */
9724 width = height = 0;
9725 for (i = 0; i < w->desired_matrix->nrows; ++i)
9726 {
9727 struct glyph_row *row = &w->desired_matrix->rows[i];
9728 struct glyph *last;
9729 int row_width;
9730
9731 /* Stop at the first empty row at the end. */
9732 if (!row->enabled_p || !row->displays_text_p)
9733 break;
9734
9735 /* Let the row go over the full width of the frame, not
9736 including internal borders. */
9737 row->full_width_p = row->internal_border_p = 1;
9738
9739 /* There's a glyph at the end of rows that is use to place
9740 the cursor there. Don't include the width of this glyph. */
9741 if (row->used[TEXT_AREA])
9742 {
9743 last = &row->glyphs[TEXT_AREA][row->used[TEXT_AREA] - 1];
9744 row_width = row->pixel_width - last->pixel_width;
9745 }
9746 else
9747 row_width = row->pixel_width;
9748
9749 height += row->height;
9750 width = max (width, row_width);
9751 }
9752
9753 /* Add the frame's internal border to the width and height the X
9754 window should have. */
9755 height += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
9756 width += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
9757
9758 /* Move the tooltip window where the mouse pointer is. Resize and
9759 show it. */
9760 BLOCK_INPUT;
9761 XQueryPointer (FRAME_X_DISPLAY (f), FRAME_X_DISPLAY_INFO (f)->root_window,
9762 &root, &child, &root_x, &root_y, &win_x, &win_y, &pmask);
9763 XMoveResizeWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
9764 root_x + 5, root_y - height - 5, width, height);
9765 XMapRaised (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f));
9766 UNBLOCK_INPUT;
9767
9768 /* Draw into the window. */
9769 w->must_be_updated_p = 1;
9770 update_single_window (w, 1);
9771
9772 /* Restore original current buffer. */
9773 set_buffer_internal_1 (old_buffer);
9774 windows_or_buffers_changed = old_windows_or_buffers_changed;
9775
9776 /* Let the tip disappear after timeout seconds. */
9777 tip_timer = call3 (intern ("run-at-time"), timeout, Qnil,
9778 intern ("x-hide-tip"));
9779
9780 return unbind_to (count, Qnil);
9781}
9782
9783
9784DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0,
9785 "Hide the current tooltip, if there is any.\n\
9786Value is t is tooltip was open, nil otherwise.")
9787 ()
9788{
9789 int count = specpdl_ptr - specpdl;
9790 int deleted_p = 0;
9791
9792 specbind (Qinhibit_redisplay, Qt);
9793
9794 if (!NILP (tip_timer))
9795 {
9796 call1 (intern ("cancel-timer"), tip_timer);
9797 tip_timer = Qnil;
9798 }
9799
9800 if (tip_frame)
9801 {
9802 Lisp_Object frame;
9803
9804 XSETFRAME (frame, tip_frame);
9805 Fdelete_frame (frame, Qt);
9806 tip_frame = NULL;
9807 deleted_p = 1;
9808 }
9809
9810 return unbind_to (count, deleted_p ? Qt : Qnil);
9811}
9812
9813
9814
9815/***********************************************************************
9816 File selection dialog
9817 ***********************************************************************/
9818
9819#ifdef USE_MOTIF
9820
9821/* Callback for "OK" and "Cancel" on file selection dialog. */
9822
9823static void
9824file_dialog_cb (widget, client_data, call_data)
9825 Widget widget;
9826 XtPointer call_data, client_data;
9827{
9828 int *result = (int *) client_data;
9829 XmAnyCallbackStruct *cb = (XmAnyCallbackStruct *) call_data;
9830 *result = cb->reason;
9831}
9832
9833
9834DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 4, 0,
9835 "Read file name, prompting with PROMPT in directory DIR.\n\
9836Use a file selection dialog.\n\
9837Select DEFAULT-FILENAME in the dialog's file selection box, if\n\
9838specified. Don't let the user enter a file name in the file\n\
9839selection dialog's entry field, if MUSTMATCH is non-nil.")
9840 (prompt, dir, default_filename, mustmatch)
9841 Lisp_Object prompt, dir, default_filename, mustmatch;
9842{
9843 int result;
9844 struct frame *f = selected_frame;
9845 Lisp_Object file = Qnil;
9846 Widget dialog, text, list, help;
9847 Arg al[10];
9848 int ac = 0;
9849 extern XtAppContext Xt_app_con;
9850 char *title;
9851 XmString dir_xmstring, pattern_xmstring;
9852 int popup_activated_flag;
9853 int count = specpdl_ptr - specpdl;
9854 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
9855
9856 GCPRO5 (prompt, dir, default_filename, mustmatch, file);
9857 CHECK_STRING (prompt, 0);
9858 CHECK_STRING (dir, 1);
9859
9860 /* Prevent redisplay. */
9861 specbind (Qinhibit_redisplay, Qt);
9862
9863 BLOCK_INPUT;
9864
9865 /* Create the dialog with PROMPT as title, using DIR as initial
9866 directory and using "*" as pattern. */
9867 dir = Fexpand_file_name (dir, Qnil);
9868 dir_xmstring = XmStringCreateLocalized (XSTRING (dir)->data);
9869 pattern_xmstring = XmStringCreateLocalized ("*");
9870
9871 XtSetArg (al[ac], XmNtitle, XSTRING (prompt)->data); ++ac;
9872 XtSetArg (al[ac], XmNdirectory, dir_xmstring); ++ac;
9873 XtSetArg (al[ac], XmNpattern, pattern_xmstring); ++ac;
9874 XtSetArg (al[ac], XmNresizePolicy, XmRESIZE_GROW); ++ac;
9875 XtSetArg (al[ac], XmNdialogStyle, XmDIALOG_APPLICATION_MODAL); ++ac;
9876 dialog = XmCreateFileSelectionDialog (f->output_data.x->widget,
9877 "fsb", al, ac);
9878 XmStringFree (dir_xmstring);
9879 XmStringFree (pattern_xmstring);
9880
9881 /* Add callbacks for OK and Cancel. */
9882 XtAddCallback (dialog, XmNokCallback, file_dialog_cb,
9883 (XtPointer) &result);
9884 XtAddCallback (dialog, XmNcancelCallback, file_dialog_cb,
9885 (XtPointer) &result);
9886
9887 /* Disable the help button since we can't display help. */
9888 help = XmFileSelectionBoxGetChild (dialog, XmDIALOG_HELP_BUTTON);
9889 XtSetSensitive (help, False);
9890
9891 /* Mark OK button as default. */
9892 XtVaSetValues (XmFileSelectionBoxGetChild (dialog, XmDIALOG_OK_BUTTON),
9893 XmNshowAsDefault, True, NULL);
9894
9895 /* If MUSTMATCH is non-nil, disable the file entry field of the
9896 dialog, so that the user must select a file from the files list
9897 box. We can't remove it because we wouldn't have a way to get at
9898 the result file name, then. */
9899 text = XmFileSelectionBoxGetChild (dialog, XmDIALOG_TEXT);
9900 if (!NILP (mustmatch))
9901 {
9902 Widget label;
9903 label = XmFileSelectionBoxGetChild (dialog, XmDIALOG_SELECTION_LABEL);
9904 XtSetSensitive (text, False);
9905 XtSetSensitive (label, False);
9906 }
9907
9908 /* Manage the dialog, so that list boxes get filled. */
9909 XtManageChild (dialog);
9910
9911 /* Select DEFAULT_FILENAME in the files list box. DEFAULT_FILENAME
9912 must include the path for this to work. */
9913 list = XmFileSelectionBoxGetChild (dialog, XmDIALOG_LIST);
9914 if (STRINGP (default_filename))
9915 {
9916 XmString default_xmstring;
9917 int item_pos;
9918
9919 default_xmstring
9920 = XmStringCreateLocalized (XSTRING (default_filename)->data);
9921
9922 if (!XmListItemExists (list, default_xmstring))
9923 {
9924 /* Add a new item if DEFAULT_FILENAME is not in the list. */
9925 XmListAddItem (list, default_xmstring, 0);
9926 item_pos = 0;
9927 }
9928 else
9929 item_pos = XmListItemPos (list, default_xmstring);
9930 XmStringFree (default_xmstring);
9931
9932 /* Select the item and scroll it into view. */
9933 XmListSelectPos (list, item_pos, True);
9934 XmListSetPos (list, item_pos);
9935 }
9936
9937 /* Process all events until the user presses Cancel or OK. */
9938 for (result = 0; result == 0;)
9939 {
9940 XEvent event;
9941 Widget widget, parent;
9942
9943 XtAppNextEvent (Xt_app_con, &event);
9944
9945 /* See if the receiver of the event is one of the widgets of
9946 the file selection dialog. If so, dispatch it. If not,
9947 discard it. */
9948 widget = XtWindowToWidget (event.xany.display, event.xany.window);
9949 parent = widget;
9950 while (parent && parent != dialog)
9951 parent = XtParent (parent);
9952
9953 if (parent == dialog
9954 || (event.type == Expose
9955 && !process_expose_from_menu (event)))
9956 XtDispatchEvent (&event);
9957 }
9958
9959 /* Get the result. */
9960 if (result == XmCR_OK)
9961 {
9962 XmString text;
9963 String data;
9964
9965 XtVaGetValues (dialog, XmNtextString, &text, 0);
9966 XmStringGetLtoR (text, XmFONTLIST_DEFAULT_TAG, &data);
9967 XmStringFree (text);
9968 file = build_string (data);
9969 XtFree (data);
9970 }
9971 else
9972 file = Qnil;
9973
9974 /* Clean up. */
9975 XtUnmanageChild (dialog);
9976 XtDestroyWidget (dialog);
9977 UNBLOCK_INPUT;
9978 UNGCPRO;
9979
9980 /* Make "Cancel" equivalent to C-g. */
9981 if (NILP (file))
9982 Fsignal (Qquit, Qnil);
9983
9984 return unbind_to (count, file);
9985}
9986
9987#endif /* USE_MOTIF */
9988
9989
9990/***********************************************************************
9991 Tests
9992 ***********************************************************************/
9993
9994#if GLYPH_DEBUG
9995
9996DEFUN ("imagep", Fimagep, Simagep, 1, 1, 0,
9997 "Value is non-nil if SPEC is a valid image specification.")
9998 (spec)
9999 Lisp_Object spec;
10000{
10001 return valid_image_p (spec) ? Qt : Qnil;
10002}
10003
10004
10005DEFUN ("lookup-image", Flookup_image, Slookup_image, 1, 1, 0, "")
10006 (spec)
10007 Lisp_Object spec;
10008{
10009 int id = -1;
10010
10011 if (valid_image_p (spec))
10012 id = lookup_image (selected_frame, spec);
10013
10014 debug_print (spec);
10015 return make_number (id);
10016}
10017
10018#endif /* GLYPH_DEBUG != 0 */
10019
10020
10021
10022/***********************************************************************
10023 Initialization
10024 ***********************************************************************/
10025
5241void 10026void
5242syms_of_xfns () 10027syms_of_xfns ()
5243{ 10028{
@@ -5251,8 +10036,6 @@ syms_of_xfns ()
5251 staticpro (&Qauto_raise); 10036 staticpro (&Qauto_raise);
5252 Qauto_lower = intern ("auto-lower"); 10037 Qauto_lower = intern ("auto-lower");
5253 staticpro (&Qauto_lower); 10038 staticpro (&Qauto_lower);
5254 Qbackground_color = intern ("background-color");
5255 staticpro (&Qbackground_color);
5256 Qbar = intern ("bar"); 10039 Qbar = intern ("bar");
5257 staticpro (&Qbar); 10040 staticpro (&Qbar);
5258 Qborder_color = intern ("border-color"); 10041 Qborder_color = intern ("border-color");
@@ -5265,8 +10048,6 @@ syms_of_xfns ()
5265 staticpro (&Qcursor_color); 10048 staticpro (&Qcursor_color);
5266 Qcursor_type = intern ("cursor-type"); 10049 Qcursor_type = intern ("cursor-type");
5267 staticpro (&Qcursor_type); 10050 staticpro (&Qcursor_type);
5268 Qforeground_color = intern ("foreground-color");
5269 staticpro (&Qforeground_color);
5270 Qgeometry = intern ("geometry"); 10051 Qgeometry = intern ("geometry");
5271 staticpro (&Qgeometry); 10052 staticpro (&Qgeometry);
5272 Qicon_left = intern ("icon-left"); 10053 Qicon_left = intern ("icon-left");
@@ -5293,8 +10074,6 @@ syms_of_xfns ()
5293 staticpro (&Qscroll_bar_width); 10074 staticpro (&Qscroll_bar_width);
5294 Qsuppress_icon = intern ("suppress-icon"); 10075 Qsuppress_icon = intern ("suppress-icon");
5295 staticpro (&Qsuppress_icon); 10076 staticpro (&Qsuppress_icon);
5296 Qtop = intern ("top");
5297 staticpro (&Qtop);
5298 Qundefined_color = intern ("undefined-color"); 10077 Qundefined_color = intern ("undefined-color");
5299 staticpro (&Qundefined_color); 10078 staticpro (&Qundefined_color);
5300 Qvertical_scroll_bars = intern ("vertical-scroll-bars"); 10079 Qvertical_scroll_bars = intern ("vertical-scroll-bars");
@@ -5315,8 +10094,15 @@ syms_of_xfns ()
5315 staticpro (&Quser_size); 10094 staticpro (&Quser_size);
5316 Qdisplay = intern ("display"); 10095 Qdisplay = intern ("display");
5317 staticpro (&Qdisplay); 10096 staticpro (&Qdisplay);
10097 Qscroll_bar_foreground = intern ("scroll-bar-foreground");
10098 staticpro (&Qscroll_bar_foreground);
10099 Qscroll_bar_background = intern ("scroll-bar-background");
10100 staticpro (&Qscroll_bar_background);
5318 /* This is the end of symbol initialization. */ 10101 /* This is the end of symbol initialization. */
5319 10102
10103 Qlaplace = intern ("laplace");
10104 staticpro (&Qlaplace);
10105
5320 Qface_set_after_frame_default = intern ("face-set-after-frame-default"); 10106 Qface_set_after_frame_default = intern ("face-set-after-frame-default");
5321 staticpro (&Qface_set_after_frame_default); 10107 staticpro (&Qface_set_after_frame_default);
5322 10108
@@ -5357,7 +10143,7 @@ Emacs initially sets `x-resource-class' to \"Emacs\".\n\
5357\n\ 10143\n\
5358Setting this variable permanently is not a reasonable thing to do,\n\ 10144Setting this variable permanently is not a reasonable thing to do,\n\
5359but binding this variable locally around a call to `x-get-resource'\n\ 10145but binding this variable locally around a call to `x-get-resource'\n\
5360is a reasonabvle practice. See also the variable `x-resource-name'."); 10146is a reasonable practice. See also the variable `x-resource-name'.");
5361 Vx_resource_class = build_string (EMACS_CLASS); 10147 Vx_resource_class = build_string (EMACS_CLASS);
5362 10148
5363#if 0 /* This doesn't really do anything. */ 10149#if 0 /* This doesn't really do anything. */
@@ -5368,6 +10154,16 @@ or when you set the mouse color.");
5368#endif 10154#endif
5369 Vx_nontext_pointer_shape = Qnil; 10155 Vx_nontext_pointer_shape = Qnil;
5370 10156
10157 DEFVAR_LISP ("x-busy-pointer-shape", &Vx_busy_pointer_shape,
10158 "The shape of the pointer when Emacs is busy.\n\
10159This variable takes effect when you create a new frame\n\
10160or when you set the mouse color.");
10161 Vx_busy_pointer_shape = Qnil;
10162
10163 DEFVAR_BOOL ("display-busy-cursor", &display_busy_cursor_p,
10164 "Non-zero means Emacs displays a busy cursor on window systems.");
10165 display_busy_cursor_p = 1;
10166
5371#if 0 /* This doesn't really do anything. */ 10167#if 0 /* This doesn't really do anything. */
5372 DEFVAR_LISP ("x-mode-pointer-shape", &Vx_mode_pointer_shape, 10168 DEFVAR_LISP ("x-mode-pointer-shape", &Vx_mode_pointer_shape,
5373 "The shape of the pointer when over the mode line.\n\ 10169 "The shape of the pointer when over the mode line.\n\
@@ -5405,6 +10201,18 @@ such a font. This is especially effective for such large fonts as\n\
5405Chinese, Japanese, and Korean."); 10201Chinese, Japanese, and Korean.");
5406 Vx_pixel_size_width_font_regexp = Qnil; 10202 Vx_pixel_size_width_font_regexp = Qnil;
5407 10203
10204 DEFVAR_LISP ("image-eviction-seconds", &Vimage_eviction_seconds,
10205 "Time after which cached images are removed from the cache.\n\
10206When an image has not been displayed this many seconds, remove it\n\
10207from the image cache. Value must be an integer or nil with nil\n\
10208meaning don't clear the cache.");
10209 Vimage_eviction_seconds = make_number (30 * 60);
10210
10211 DEFVAR_LISP ("image-types", &Vimage_types,
10212 "List of supported image types.\n\
10213Each element of the list is a symbol for a supported image type.");
10214 Vimage_types = Qnil;
10215
5408#ifdef USE_X_TOOLKIT 10216#ifdef USE_X_TOOLKIT
5409 Fprovide (intern ("x-toolkit")); 10217 Fprovide (intern ("x-toolkit"));
5410#endif 10218#endif
@@ -5413,13 +10221,18 @@ Chinese, Japanese, and Korean.");
5413#endif 10221#endif
5414 10222
5415 defsubr (&Sx_get_resource); 10223 defsubr (&Sx_get_resource);
10224
10225 /* X window properties. */
10226 defsubr (&Sx_change_window_property);
10227 defsubr (&Sx_delete_window_property);
10228 defsubr (&Sx_window_property);
10229
5416#if 0 10230#if 0
5417 defsubr (&Sx_draw_rectangle); 10231 defsubr (&Sx_draw_rectangle);
5418 defsubr (&Sx_erase_rectangle); 10232 defsubr (&Sx_erase_rectangle);
5419 defsubr (&Sx_contour_region); 10233 defsubr (&Sx_contour_region);
5420 defsubr (&Sx_uncontour_region); 10234 defsubr (&Sx_uncontour_region);
5421#endif 10235#endif
5422 defsubr (&Sx_list_fonts);
5423 defsubr (&Sx_display_color_p); 10236 defsubr (&Sx_display_color_p);
5424 defsubr (&Sx_display_grayscale_p); 10237 defsubr (&Sx_display_grayscale_p);
5425 defsubr (&Sx_color_defined_p); 10238 defsubr (&Sx_color_defined_p);
@@ -5456,12 +10269,130 @@ Chinese, Japanese, and Korean.");
5456 10269
5457 /* Setting callback functions for fontset handler. */ 10270 /* Setting callback functions for fontset handler. */
5458 get_font_info_func = x_get_font_info; 10271 get_font_info_func = x_get_font_info;
10272
10273#if 0 /* This function pointer doesn't seem to be used anywhere.
10274 And the pointer assigned has the wrong type, anyway. */
5459 list_fonts_func = x_list_fonts; 10275 list_fonts_func = x_list_fonts;
10276#endif
10277
5460 load_font_func = x_load_font; 10278 load_font_func = x_load_font;
5461 find_ccl_program_func = x_find_ccl_program; 10279 find_ccl_program_func = x_find_ccl_program;
5462 query_font_func = x_query_font; 10280 query_font_func = x_query_font;
5463 set_frame_fontset_func = x_set_font; 10281 set_frame_fontset_func = x_set_font;
5464 check_window_system_func = check_x; 10282 check_window_system_func = check_x;
10283
10284 /* Images. */
10285 Qxbm = intern ("xbm");
10286 staticpro (&Qxbm);
10287 QCtype = intern (":type");
10288 staticpro (&QCtype);
10289 QCfile = intern (":file");
10290 staticpro (&QCfile);
10291 QCalgorithm = intern (":algorithm");
10292 staticpro (&QCalgorithm);
10293 QCheuristic_mask = intern (":heuristic-mask");
10294 staticpro (&QCheuristic_mask);
10295 QCcolor_symbols = intern (":color-symbols");
10296 staticpro (&QCcolor_symbols);
10297 QCdata = intern (":data");
10298 staticpro (&QCdata);
10299 QCascent = intern (":ascent");
10300 staticpro (&QCascent);
10301 QCmargin = intern (":margin");
10302 staticpro (&QCmargin);
10303 QCrelief = intern (":relief");
10304 staticpro (&QCrelief);
10305 Qghostscript = intern ("ghostscript");
10306 staticpro (&Qghostscript);
10307 QCloader = intern (":loader");
10308 staticpro (&QCloader);
10309 QCbounding_box = intern (":bounding-box");
10310 staticpro (&QCbounding_box);
10311 QCpt_width = intern (":pt-width");
10312 staticpro (&QCpt_width);
10313 QCpt_height = intern (":pt-height");
10314 staticpro (&QCpt_height);
10315 Qpbm = intern ("pbm");
10316 staticpro (&Qpbm);
10317
10318#if HAVE_XPM
10319 Qxpm = intern ("xpm");
10320 staticpro (&Qxpm);
10321#endif
10322
10323#if HAVE_JPEG
10324 Qjpeg = intern ("jpeg");
10325 staticpro (&Qjpeg);
10326#endif
10327
10328#if HAVE_TIFF
10329 Qtiff = intern ("tiff");
10330 staticpro (&Qtiff);
10331#endif
10332
10333#if HAVE_GIF
10334 Qgif = intern ("gif");
10335 staticpro (&Qgif);
10336#endif
10337
10338#if HAVE_PNG
10339 Qpng = intern ("png");
10340 staticpro (&Qpng);
10341#endif
10342
10343 defsubr (&Sclear_image_cache);
10344
10345#if GLYPH_DEBUG
10346 defsubr (&Simagep);
10347 defsubr (&Slookup_image);
10348#endif
10349
10350 /* Busy-cursor. */
10351 defsubr (&Sx_show_busy_cursor);
10352 defsubr (&Sx_hide_busy_cursor);
10353 busy_count = 0;
10354 inhibit_busy_cursor = 0;
10355
10356 defsubr (&Sx_show_tip);
10357 defsubr (&Sx_hide_tip);
10358 staticpro (&tip_timer);
10359 tip_timer = Qnil;
10360
10361#ifdef USE_MOTIF
10362 defsubr (&Sx_file_dialog);
10363#endif
10364}
10365
10366
10367void
10368init_xfns ()
10369{
10370 image_types = NULL;
10371 Vimage_types = Qnil;
10372
10373 define_image_type (&xbm_type);
10374 define_image_type (&gs_type);
10375 define_image_type (&pbm_type);
10376
10377#if HAVE_XPM
10378 define_image_type (&xpm_type);
10379#endif
10380
10381#if HAVE_JPEG
10382 define_image_type (&jpeg_type);
10383#endif
10384
10385#if HAVE_TIFF
10386 define_image_type (&tiff_type);
10387#endif
10388
10389#if HAVE_GIF
10390 define_image_type (&gif_type);
10391#endif
10392
10393#if HAVE_PNG
10394 define_image_type (&png_type);
10395#endif
5465} 10396}
5466 10397
5467#endif /* HAVE_X_WINDOWS */ 10398#endif /* HAVE_X_WINDOWS */
generated by cgit v1.2.1 (git 2.18.0) at 2026-01-19 04:58:14 +0000