*** empty log message ***
[bpt/emacs.git] / src / xfns.c
CommitLineData
01f1ba30 1/* Functions for the X window system.
edf36fe6 2 Copyright (C) 1989, 92, 93, 94, 95, 96, 1997, 1998, 1999, 2000, 2001
333b20bb 3 Free Software Foundation.
01f1ba30
JB
4
5This file is part of GNU Emacs.
6
7GNU Emacs is free software; you can redistribute it and/or modify
8it under the terms of the GNU General Public License as published by
1113d9db 9the Free Software Foundation; either version 2, or (at your option)
01f1ba30
JB
10any later version.
11
12GNU Emacs is distributed in the hope that it will be useful,
13but WITHOUT ANY WARRANTY; without even the implied warranty of
14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15GNU General Public License for more details.
16
17You should have received a copy of the GNU General Public License
18along with GNU Emacs; see the file COPYING. If not, write to
3b7ad313
EN
19the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20Boston, MA 02111-1307, USA. */
01f1ba30 21
c389a86d 22#include <config.h>
68c45bf0 23#include <signal.h>
333b20bb 24#include <stdio.h>
d62c8769 25#include <math.h>
c389a86d 26
40e6f148 27/* This makes the fields of a Display accessible, in Xlib header files. */
333b20bb 28
40e6f148
RS
29#define XLIB_ILLEGAL_ACCESS
30
01f1ba30
JB
31#include "lisp.h"
32#include "xterm.h"
f676886a 33#include "frame.h"
01f1ba30
JB
34#include "window.h"
35#include "buffer.h"
58cad5ed 36#include "intervals.h"
01f1ba30 37#include "dispextern.h"
1f98fa48 38#include "keyboard.h"
9ac0d9e0 39#include "blockinput.h"
57bda87a 40#include <epaths.h>
942ea06d 41#include "charset.h"
96db09e4 42#include "coding.h"
942ea06d 43#include "fontset.h"
333b20bb
GM
44#include "systime.h"
45#include "termhooks.h"
4ae9a85e 46#include "atimer.h"
01f1ba30
JB
47
48#ifdef HAVE_X_WINDOWS
67ba84d1 49
67ba84d1 50#include <ctype.h>
63cec32f
GM
51#include <sys/types.h>
52#include <sys/stat.h>
01f1ba30 53
0a93081c 54#ifndef VMS
0505a740 55#if 1 /* Used to be #ifdef EMACS_BITMAP_FILES, but this should always work. */
ef493a27
RS
56#include "bitmaps/gray.xbm"
57#else
dbc4e1c1 58#include <X11/bitmaps/gray>
ef493a27 59#endif
0a93081c
JB
60#else
61#include "[.bitmaps]gray.xbm"
62#endif
dbc4e1c1 63
9ef48a9d
RS
64#ifdef USE_X_TOOLKIT
65#include <X11/Shell.h>
66
398ffa92 67#ifndef USE_MOTIF
9ef48a9d
RS
68#include <X11/Xaw/Paned.h>
69#include <X11/Xaw/Label.h>
398ffa92 70#endif /* USE_MOTIF */
9ef48a9d
RS
71
72#ifdef USG
73#undef USG /* ####KLUDGE for Solaris 2.2 and up */
74#include <X11/Xos.h>
75#define USG
76#else
77#include <X11/Xos.h>
78#endif
79
80#include "widget.h"
81
82#include "../lwlib/lwlib.h"
83
333b20bb
GM
84#ifdef USE_MOTIF
85#include <Xm/Xm.h>
86#include <Xm/DialogS.h>
87#include <Xm/FileSB.h>
88#endif
89
3b882b1d
RS
90/* Do the EDITRES protocol if running X11R5
91 Exception: HP-UX (at least version A.09.05) has X11R5 without EditRes */
333b20bb 92
3b882b1d 93#if (XtSpecificationRelease >= 5) && !defined(NO_EDITRES)
6c32dd68 94#define HACK_EDITRES
b9dc4443 95extern void _XEditResCheckMessages ();
6c32dd68
PR
96#endif /* R5 + Athena */
97
333b20bb
GM
98/* Unique id counter for widgets created by the Lucid Widget Library. */
99
6c32dd68
PR
100extern LWLIB_ID widget_id_tick;
101
e3881aa0 102#ifdef USE_LUCID
82c90203 103/* This is part of a kludge--see lwlib/xlwmenu.c. */
03e2c340 104extern XFontStruct *xlwmenu_default_font;
e3881aa0 105#endif
9ef48a9d 106
6bc20398 107extern void free_frame_menubar ();
d62c8769 108extern double atof ();
333b20bb 109
fc2cdd9a
GM
110#ifdef USE_MOTIF
111
112/* LessTif/Motif version info. */
113
114static Lisp_Object Vmotif_version_string;
115
116#endif /* USE_MOTIF */
117
9ef48a9d
RS
118#endif /* USE_X_TOOLKIT */
119
01f1ba30
JB
120#define min(a,b) ((a) < (b) ? (a) : (b))
121#define max(a,b) ((a) > (b) ? (a) : (b))
122
9d317b2c
RS
123#ifdef HAVE_X11R4
124#define MAXREQUEST(dpy) (XMaxRequestSize (dpy))
125#else
126#define MAXREQUEST(dpy) ((dpy)->max_request_size)
127#endif
128
333b20bb
GM
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;
62906360 135char *gray_bitmap_bits = gray_bits;
333b20bb 136
498e9ac3 137/* The name we're using in resource queries. Most often "emacs". */
333b20bb 138
d387c960 139Lisp_Object Vx_resource_name;
ac63d3d6 140
498e9ac3
RS
141/* The application class we're using in resource queries.
142 Normally "Emacs". */
333b20bb 143
498e9ac3
RS
144Lisp_Object Vx_resource_class;
145
0af913d7 146/* Non-zero means we're allowed to display an hourglass cursor. */
333b20bb 147
0af913d7 148int display_hourglass_p;
333b20bb 149
01f1ba30 150/* The background and shape of the mouse pointer, and shape when not
b9dc4443 151 over text or in the modeline. */
333b20bb 152
01f1ba30 153Lisp_Object Vx_pointer_shape, Vx_nontext_pointer_shape, Vx_mode_pointer_shape;
0af913d7 154Lisp_Object Vx_hourglass_pointer_shape;
333b20bb 155
ca0ecbf5 156/* The shape when over mouse-sensitive text. */
333b20bb 157
ca0ecbf5 158Lisp_Object Vx_sensitive_text_pointer_shape;
01f1ba30 159
8fb4ec9c
GM
160/* If non-nil, the pointer shape to indicate that windows can be
161 dragged horizontally. */
162
163Lisp_Object Vx_window_horizontal_drag_shape;
164
b9dc4443 165/* Color of chars displayed in cursor box. */
333b20bb 166
01f1ba30
JB
167Lisp_Object Vx_cursor_fore_pixel;
168
b9dc4443 169/* Nonzero if using X. */
333b20bb 170
b9dc4443 171static int x_in_use;
01f1ba30 172
b9dc4443 173/* Non nil if no window manager is in use. */
333b20bb 174
01f1ba30
JB
175Lisp_Object Vx_no_window_manager;
176
f1c7b5a6 177/* Search path for bitmap files. */
333b20bb 178
f1c7b5a6
RS
179Lisp_Object Vx_bitmap_file_path;
180
942ea06d 181/* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
333b20bb 182
942ea06d
KH
183Lisp_Object Vx_pixel_size_width_font_regexp;
184
f9942c9e
JB
185Lisp_Object Qauto_raise;
186Lisp_Object Qauto_lower;
dbc4e1c1 187Lisp_Object Qbar;
f9942c9e
JB
188Lisp_Object Qborder_color;
189Lisp_Object Qborder_width;
dbc4e1c1 190Lisp_Object Qbox;
f9942c9e 191Lisp_Object Qcursor_color;
dbc4e1c1 192Lisp_Object Qcursor_type;
f9942c9e 193Lisp_Object Qgeometry;
f9942c9e
JB
194Lisp_Object Qicon_left;
195Lisp_Object Qicon_top;
196Lisp_Object Qicon_type;
80534dd6 197Lisp_Object Qicon_name;
f9942c9e
JB
198Lisp_Object Qinternal_border_width;
199Lisp_Object Qleft;
1ab3d87e 200Lisp_Object Qright;
f9942c9e 201Lisp_Object Qmouse_color;
baaed68e 202Lisp_Object Qnone;
2cbebefb 203Lisp_Object Qouter_window_id;
f9942c9e 204Lisp_Object Qparent_id;
4701395c 205Lisp_Object Qscroll_bar_width;
8af1d7ca 206Lisp_Object Qsuppress_icon;
333b20bb 207extern Lisp_Object Qtop;
01f1ba30 208Lisp_Object Qundefined_color;
a3c87d4e 209Lisp_Object Qvertical_scroll_bars;
49795535 210Lisp_Object Qvisibility;
f9942c9e 211Lisp_Object Qwindow_id;
f676886a 212Lisp_Object Qx_frame_parameter;
9ef48a9d 213Lisp_Object Qx_resource_name;
4fe1de12
RS
214Lisp_Object Quser_position;
215Lisp_Object Quser_size;
0cafb359 216extern Lisp_Object Qdisplay;
333b20bb 217Lisp_Object Qscroll_bar_foreground, Qscroll_bar_background;
7c7ff7f5 218Lisp_Object Qscreen_gamma, Qline_spacing, Qcenter;
ae782866 219Lisp_Object Qcompound_text, Qcancel_timer;
ea0a1f53 220Lisp_Object Qwait_for_wm;
01f1ba30 221
b9dc4443 222/* The below are defined in frame.c. */
333b20bb 223
baaed68e 224extern Lisp_Object Qheight, Qminibuffer, Qname, Qonly, Qwidth;
c2304e02 225extern Lisp_Object Qunsplittable, Qmenu_bar_lines, Qbuffer_predicate, Qtitle;
9ea173e8 226extern Lisp_Object Qtool_bar_lines;
f9942c9e 227
01f1ba30
JB
228extern Lisp_Object Vwindow_system_version;
229
a367641f 230Lisp_Object Qface_set_after_frame_default;
333b20bb 231
f1d2ce7f 232#if GLYPH_DEBUG
eaf1eea9
GM
233int image_cache_refcount, dpyinfo_refcount;
234#endif
235
236
01f1ba30 237\f
11ae94fe 238/* Error if we are not connected to X. */
333b20bb 239
7fc9de26 240void
11ae94fe
RS
241check_x ()
242{
b9dc4443 243 if (! x_in_use)
11ae94fe
RS
244 error ("X windows are not in use or not initialized");
245}
246
1c59f5df
RS
247/* Nonzero if we can use mouse menus.
248 You should not call this unless HAVE_MENUS is defined. */
75cc8ee5
RS
249
250int
1c59f5df 251have_menus_p ()
75cc8ee5 252{
b9dc4443
RS
253 return x_in_use;
254}
255
256/* Extract a frame as a FRAME_PTR, defaulting to the selected frame
257 and checking validity for X. */
258
259FRAME_PTR
260check_x_frame (frame)
261 Lisp_Object frame;
262{
263 FRAME_PTR f;
264
265 if (NILP (frame))
0fe92f72
GM
266 frame = selected_frame;
267 CHECK_LIVE_FRAME (frame, 0);
268 f = XFRAME (frame);
b9dc4443 269 if (! FRAME_X_P (f))
1c59f5df 270 error ("Non-X frame used");
b9dc4443 271 return f;
75cc8ee5
RS
272}
273
b9dc4443
RS
274/* Let the user specify an X display with a frame.
275 nil stands for the selected frame--or, if that is not an X frame,
276 the first X display on the list. */
277
278static struct x_display_info *
279check_x_display_info (frame)
280 Lisp_Object frame;
281{
8ec8a5ec
GM
282 struct x_display_info *dpyinfo = NULL;
283
b9dc4443
RS
284 if (NILP (frame))
285 {
0fe92f72
GM
286 struct frame *sf = XFRAME (selected_frame);
287
288 if (FRAME_X_P (sf) && FRAME_LIVE_P (sf))
8ec8a5ec 289 dpyinfo = FRAME_X_DISPLAY_INFO (sf);
b9dc4443 290 else if (x_display_list != 0)
8ec8a5ec 291 dpyinfo = x_display_list;
b9dc4443
RS
292 else
293 error ("X windows are not in use or not initialized");
294 }
295 else if (STRINGP (frame))
8ec8a5ec 296 dpyinfo = x_display_info_for_name (frame);
b9dc4443
RS
297 else
298 {
299 FRAME_PTR f;
300
301 CHECK_LIVE_FRAME (frame, 0);
302 f = XFRAME (frame);
303 if (! FRAME_X_P (f))
1c59f5df 304 error ("Non-X frame used");
8ec8a5ec 305 dpyinfo = FRAME_X_DISPLAY_INFO (f);
b9dc4443 306 }
8ec8a5ec
GM
307
308 return dpyinfo;
b9dc4443 309}
333b20bb 310
b9dc4443 311\f
f676886a
JB
312/* Return the Emacs frame-object corresponding to an X window.
313 It could be the frame's main window or an icon window. */
01f1ba30 314
34ca5317 315/* This function can be called during GC, so use GC_xxx type test macros. */
bcb2db92 316
f676886a 317struct frame *
2d271e2e
KH
318x_window_to_frame (dpyinfo, wdesc)
319 struct x_display_info *dpyinfo;
01f1ba30
JB
320 int wdesc;
321{
f676886a
JB
322 Lisp_Object tail, frame;
323 struct frame *f;
01f1ba30 324
8e713be6 325 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
01f1ba30 326 {
8e713be6 327 frame = XCAR (tail);
34ca5317 328 if (!GC_FRAMEP (frame))
01f1ba30 329 continue;
f676886a 330 f = XFRAME (frame);
2d764c78 331 if (!FRAME_X_P (f) || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
2d271e2e 332 continue;
0af913d7 333 if (f->output_data.x->hourglass_window == wdesc)
17cbbf95 334 return f;
9ef48a9d 335#ifdef USE_X_TOOLKIT
7556890b
RS
336 if ((f->output_data.x->edit_widget
337 && XtWindow (f->output_data.x->edit_widget) == wdesc)
333b20bb
GM
338 /* A tooltip frame? */
339 || (!f->output_data.x->edit_widget
340 && FRAME_X_WINDOW (f) == wdesc)
7556890b 341 || f->output_data.x->icon_desc == wdesc)
9ef48a9d
RS
342 return f;
343#else /* not USE_X_TOOLKIT */
fe24a618 344 if (FRAME_X_WINDOW (f) == wdesc
7556890b 345 || f->output_data.x->icon_desc == wdesc)
f676886a 346 return f;
9ef48a9d
RS
347#endif /* not USE_X_TOOLKIT */
348 }
349 return 0;
350}
351
352#ifdef USE_X_TOOLKIT
353/* Like x_window_to_frame but also compares the window with the widget's
354 windows. */
355
356struct frame *
2d271e2e
KH
357x_any_window_to_frame (dpyinfo, wdesc)
358 struct x_display_info *dpyinfo;
9ef48a9d
RS
359 int wdesc;
360{
361 Lisp_Object tail, frame;
17cbbf95 362 struct frame *f, *found;
7556890b 363 struct x_output *x;
9ef48a9d 364
17cbbf95
GM
365 found = NULL;
366 for (tail = Vframe_list; GC_CONSP (tail) && !found; tail = XCDR (tail))
9ef48a9d 367 {
8e713be6 368 frame = XCAR (tail);
34ca5317 369 if (!GC_FRAMEP (frame))
9ef48a9d 370 continue;
17cbbf95 371
9ef48a9d 372 f = XFRAME (frame);
17cbbf95 373 if (FRAME_X_P (f) && FRAME_X_DISPLAY_INFO (f) == dpyinfo)
333b20bb 374 {
17cbbf95
GM
375 /* This frame matches if the window is any of its widgets. */
376 x = f->output_data.x;
0af913d7 377 if (x->hourglass_window == wdesc)
17cbbf95
GM
378 found = f;
379 else if (x->widget)
380 {
381 if (wdesc == XtWindow (x->widget)
382 || wdesc == XtWindow (x->column_widget)
383 || wdesc == XtWindow (x->edit_widget))
384 found = f;
385 /* Match if the window is this frame's menubar. */
386 else if (lw_window_is_in_menubar (wdesc, x->menubar_widget))
387 found = f;
388 }
389 else if (FRAME_X_WINDOW (f) == wdesc)
390 /* A tooltip frame. */
391 found = f;
333b20bb 392 }
01f1ba30 393 }
17cbbf95
GM
394
395 return found;
01f1ba30 396}
5e65b9ab 397
5fbc3f3a
KH
398/* Likewise, but exclude the menu bar widget. */
399
400struct frame *
401x_non_menubar_window_to_frame (dpyinfo, wdesc)
402 struct x_display_info *dpyinfo;
403 int wdesc;
404{
405 Lisp_Object tail, frame;
406 struct frame *f;
7556890b 407 struct x_output *x;
5fbc3f3a 408
8e713be6 409 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
5fbc3f3a 410 {
8e713be6 411 frame = XCAR (tail);
5fbc3f3a
KH
412 if (!GC_FRAMEP (frame))
413 continue;
414 f = XFRAME (frame);
2d764c78 415 if (!FRAME_X_P (f) || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
5fbc3f3a 416 continue;
7556890b 417 x = f->output_data.x;
5fbc3f3a 418 /* This frame matches if the window is any of its widgets. */
0af913d7 419 if (x->hourglass_window == wdesc)
17cbbf95
GM
420 return f;
421 else if (x->widget)
333b20bb
GM
422 {
423 if (wdesc == XtWindow (x->widget)
424 || wdesc == XtWindow (x->column_widget)
425 || wdesc == XtWindow (x->edit_widget))
426 return f;
427 }
428 else if (FRAME_X_WINDOW (f) == wdesc)
429 /* A tooltip frame. */
5fbc3f3a
KH
430 return f;
431 }
432 return 0;
433}
434
fd3a3022
RS
435/* Likewise, but consider only the menu bar widget. */
436
437struct frame *
438x_menubar_window_to_frame (dpyinfo, wdesc)
439 struct x_display_info *dpyinfo;
440 int wdesc;
441{
442 Lisp_Object tail, frame;
443 struct frame *f;
7556890b 444 struct x_output *x;
fd3a3022 445
8e713be6 446 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
fd3a3022 447 {
8e713be6 448 frame = XCAR (tail);
fd3a3022
RS
449 if (!GC_FRAMEP (frame))
450 continue;
451 f = XFRAME (frame);
2d764c78 452 if (!FRAME_X_P (f) || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
fd3a3022 453 continue;
7556890b 454 x = f->output_data.x;
fd3a3022 455 /* Match if the window is this frame's menubar. */
333b20bb
GM
456 if (x->menubar_widget
457 && lw_window_is_in_menubar (wdesc, x->menubar_widget))
fd3a3022
RS
458 return f;
459 }
460 return 0;
461}
462
5e65b9ab
RS
463/* Return the frame whose principal (outermost) window is WDESC.
464 If WDESC is some other (smaller) window, we return 0. */
465
466struct frame *
2d271e2e
KH
467x_top_window_to_frame (dpyinfo, wdesc)
468 struct x_display_info *dpyinfo;
5e65b9ab
RS
469 int wdesc;
470{
471 Lisp_Object tail, frame;
472 struct frame *f;
7556890b 473 struct x_output *x;
5e65b9ab 474
8e713be6 475 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
5e65b9ab 476 {
8e713be6 477 frame = XCAR (tail);
34ca5317 478 if (!GC_FRAMEP (frame))
5e65b9ab
RS
479 continue;
480 f = XFRAME (frame);
2d764c78 481 if (!FRAME_X_P (f) || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
2d271e2e 482 continue;
7556890b 483 x = f->output_data.x;
333b20bb
GM
484
485 if (x->widget)
486 {
487 /* This frame matches if the window is its topmost widget. */
488 if (wdesc == XtWindow (x->widget))
489 return f;
7a994728
KH
490#if 0 /* I don't know why it did this,
491 but it seems logically wrong,
492 and it causes trouble for MapNotify events. */
333b20bb
GM
493 /* Match if the window is this frame's menubar. */
494 if (x->menubar_widget
495 && wdesc == XtWindow (x->menubar_widget))
496 return f;
7a994728 497#endif
333b20bb
GM
498 }
499 else if (FRAME_X_WINDOW (f) == wdesc)
500 /* Tooltip frame. */
501 return f;
5e65b9ab
RS
502 }
503 return 0;
504}
9ef48a9d 505#endif /* USE_X_TOOLKIT */
01f1ba30 506
01f1ba30 507\f
203c1d73
RS
508
509/* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
510 id, which is just an int that this section returns. Bitmaps are
511 reference counted so they can be shared among frames.
512
513 Bitmap indices are guaranteed to be > 0, so a negative number can
514 be used to indicate no bitmap.
515
516 If you use x_create_bitmap_from_data, then you must keep track of
517 the bitmaps yourself. That is, creating a bitmap from the same
b9dc4443 518 data more than once will not be caught. */
203c1d73
RS
519
520
f1c7b5a6
RS
521/* Functions to access the contents of a bitmap, given an id. */
522
523int
524x_bitmap_height (f, id)
525 FRAME_PTR f;
526 int id;
527{
08a90d6a 528 return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].height;
f1c7b5a6
RS
529}
530
531int
532x_bitmap_width (f, id)
533 FRAME_PTR f;
534 int id;
535{
08a90d6a 536 return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].width;
f1c7b5a6
RS
537}
538
539int
540x_bitmap_pixmap (f, id)
541 FRAME_PTR f;
542 int id;
543{
08a90d6a 544 return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].pixmap;
f1c7b5a6
RS
545}
546
547
203c1d73
RS
548/* Allocate a new bitmap record. Returns index of new record. */
549
550static int
08a90d6a
RS
551x_allocate_bitmap_record (f)
552 FRAME_PTR f;
203c1d73 553{
08a90d6a
RS
554 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
555 int i;
556
557 if (dpyinfo->bitmaps == NULL)
203c1d73 558 {
08a90d6a
RS
559 dpyinfo->bitmaps_size = 10;
560 dpyinfo->bitmaps
561 = (struct x_bitmap_record *) xmalloc (dpyinfo->bitmaps_size * sizeof (struct x_bitmap_record));
562 dpyinfo->bitmaps_last = 1;
203c1d73
RS
563 return 1;
564 }
565
08a90d6a
RS
566 if (dpyinfo->bitmaps_last < dpyinfo->bitmaps_size)
567 return ++dpyinfo->bitmaps_last;
203c1d73 568
08a90d6a
RS
569 for (i = 0; i < dpyinfo->bitmaps_size; ++i)
570 if (dpyinfo->bitmaps[i].refcount == 0)
571 return i + 1;
203c1d73 572
08a90d6a
RS
573 dpyinfo->bitmaps_size *= 2;
574 dpyinfo->bitmaps
575 = (struct x_bitmap_record *) xrealloc (dpyinfo->bitmaps,
576 dpyinfo->bitmaps_size * sizeof (struct x_bitmap_record));
577 return ++dpyinfo->bitmaps_last;
203c1d73
RS
578}
579
580/* Add one reference to the reference count of the bitmap with id ID. */
581
582void
f1c7b5a6
RS
583x_reference_bitmap (f, id)
584 FRAME_PTR f;
203c1d73
RS
585 int id;
586{
08a90d6a 587 ++FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].refcount;
203c1d73
RS
588}
589
590/* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
591
592int
593x_create_bitmap_from_data (f, bits, width, height)
594 struct frame *f;
595 char *bits;
596 unsigned int width, height;
597{
08a90d6a 598 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
203c1d73
RS
599 Pixmap bitmap;
600 int id;
601
b9dc4443 602 bitmap = XCreateBitmapFromData (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
203c1d73
RS
603 bits, width, height);
604
605 if (! bitmap)
606 return -1;
607
08a90d6a
RS
608 id = x_allocate_bitmap_record (f);
609 dpyinfo->bitmaps[id - 1].pixmap = bitmap;
610 dpyinfo->bitmaps[id - 1].file = NULL;
611 dpyinfo->bitmaps[id - 1].refcount = 1;
612 dpyinfo->bitmaps[id - 1].depth = 1;
613 dpyinfo->bitmaps[id - 1].height = height;
614 dpyinfo->bitmaps[id - 1].width = width;
203c1d73
RS
615
616 return id;
617}
618
619/* Create bitmap from file FILE for frame F. */
620
621int
622x_create_bitmap_from_file (f, file)
623 struct frame *f;
f1c7b5a6 624 Lisp_Object file;
203c1d73 625{
08a90d6a 626 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
203c1d73
RS
627 unsigned int width, height;
628 Pixmap bitmap;
629 int xhot, yhot, result, id;
f1c7b5a6
RS
630 Lisp_Object found;
631 int fd;
632 char *filename;
203c1d73
RS
633
634 /* Look for an existing bitmap with the same name. */
08a90d6a 635 for (id = 0; id < dpyinfo->bitmaps_last; ++id)
203c1d73 636 {
08a90d6a
RS
637 if (dpyinfo->bitmaps[id].refcount
638 && dpyinfo->bitmaps[id].file
639 && !strcmp (dpyinfo->bitmaps[id].file, (char *) XSTRING (file)->data))
203c1d73 640 {
08a90d6a 641 ++dpyinfo->bitmaps[id].refcount;
203c1d73
RS
642 return id + 1;
643 }
644 }
645
f1c7b5a6
RS
646 /* Search bitmap-file-path for the file, if appropriate. */
647 fd = openp (Vx_bitmap_file_path, file, "", &found, 0);
648 if (fd < 0)
649 return -1;
68c45bf0 650 emacs_close (fd);
f1c7b5a6
RS
651
652 filename = (char *) XSTRING (found)->data;
653
b9dc4443 654 result = XReadBitmapFile (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
f1c7b5a6 655 filename, &width, &height, &bitmap, &xhot, &yhot);
203c1d73
RS
656 if (result != BitmapSuccess)
657 return -1;
658
08a90d6a
RS
659 id = x_allocate_bitmap_record (f);
660 dpyinfo->bitmaps[id - 1].pixmap = bitmap;
661 dpyinfo->bitmaps[id - 1].refcount = 1;
9f2a85b2 662 dpyinfo->bitmaps[id - 1].file
fc932ac6 663 = (char *) xmalloc (STRING_BYTES (XSTRING (file)) + 1);
08a90d6a
RS
664 dpyinfo->bitmaps[id - 1].depth = 1;
665 dpyinfo->bitmaps[id - 1].height = height;
666 dpyinfo->bitmaps[id - 1].width = width;
667 strcpy (dpyinfo->bitmaps[id - 1].file, XSTRING (file)->data);
203c1d73
RS
668
669 return id;
670}
671
672/* Remove reference to bitmap with id number ID. */
673
968b1234 674void
f1c7b5a6
RS
675x_destroy_bitmap (f, id)
676 FRAME_PTR f;
203c1d73
RS
677 int id;
678{
08a90d6a
RS
679 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
680
203c1d73
RS
681 if (id > 0)
682 {
08a90d6a
RS
683 --dpyinfo->bitmaps[id - 1].refcount;
684 if (dpyinfo->bitmaps[id - 1].refcount == 0)
203c1d73 685 {
ed662bdd 686 BLOCK_INPUT;
08a90d6a
RS
687 XFreePixmap (FRAME_X_DISPLAY (f), dpyinfo->bitmaps[id - 1].pixmap);
688 if (dpyinfo->bitmaps[id - 1].file)
203c1d73 689 {
333b20bb 690 xfree (dpyinfo->bitmaps[id - 1].file);
08a90d6a 691 dpyinfo->bitmaps[id - 1].file = NULL;
203c1d73 692 }
ed662bdd 693 UNBLOCK_INPUT;
203c1d73
RS
694 }
695 }
696}
697
08a90d6a 698/* Free all the bitmaps for the display specified by DPYINFO. */
203c1d73 699
08a90d6a
RS
700static void
701x_destroy_all_bitmaps (dpyinfo)
702 struct x_display_info *dpyinfo;
203c1d73 703{
08a90d6a
RS
704 int i;
705 for (i = 0; i < dpyinfo->bitmaps_last; i++)
706 if (dpyinfo->bitmaps[i].refcount > 0)
707 {
708 XFreePixmap (dpyinfo->display, dpyinfo->bitmaps[i].pixmap);
709 if (dpyinfo->bitmaps[i].file)
333b20bb 710 xfree (dpyinfo->bitmaps[i].file);
08a90d6a
RS
711 }
712 dpyinfo->bitmaps_last = 0;
203c1d73
RS
713}
714\f
f676886a 715/* Connect the frame-parameter names for X frames
01f1ba30
JB
716 to the ways of passing the parameter values to the window system.
717
718 The name of a parameter, as a Lisp symbol,
f676886a 719 has an `x-frame-parameter' property which is an integer in Lisp
9fb026ab 720 that is an index in this table. */
01f1ba30 721
f676886a 722struct x_frame_parm_table
01f1ba30
JB
723{
724 char *name;
d62c8769 725 void (*setter) P_ ((struct frame *, Lisp_Object, Lisp_Object));
01f1ba30
JB
726};
727
eaf1eea9
GM
728static Lisp_Object unwind_create_frame P_ ((Lisp_Object));
729static Lisp_Object unwind_create_tip_frame P_ ((Lisp_Object));
52de7ce9 730static void x_change_window_heights P_ ((Lisp_Object, int));
14819cb3 731static void x_disable_image P_ ((struct frame *, struct image *));
d62c8769 732void x_set_foreground_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
563b67aa 733static void x_set_line_spacing P_ ((struct frame *, Lisp_Object, Lisp_Object));
ea0a1f53 734static void x_set_wait_for_wm P_ ((struct frame *, Lisp_Object, Lisp_Object));
d62c8769
GM
735void x_set_background_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
736void x_set_mouse_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
737void x_set_cursor_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
738void x_set_border_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
739void x_set_cursor_type P_ ((struct frame *, Lisp_Object, Lisp_Object));
740void x_set_icon_type P_ ((struct frame *, Lisp_Object, Lisp_Object));
741void x_set_icon_name P_ ((struct frame *, Lisp_Object, Lisp_Object));
742void x_set_font P_ ((struct frame *, Lisp_Object, Lisp_Object));
743void x_set_border_width P_ ((struct frame *, Lisp_Object, Lisp_Object));
744void x_set_internal_border_width P_ ((struct frame *, Lisp_Object,
745 Lisp_Object));
746void x_explicitly_set_name P_ ((struct frame *, Lisp_Object, Lisp_Object));
747void x_set_autoraise P_ ((struct frame *, Lisp_Object, Lisp_Object));
748void x_set_autolower P_ ((struct frame *, Lisp_Object, Lisp_Object));
749void x_set_vertical_scroll_bars P_ ((struct frame *, Lisp_Object,
750 Lisp_Object));
751void x_set_visibility P_ ((struct frame *, Lisp_Object, Lisp_Object));
752void x_set_menu_bar_lines P_ ((struct frame *, Lisp_Object, Lisp_Object));
753void x_set_scroll_bar_width P_ ((struct frame *, Lisp_Object, Lisp_Object));
754void x_set_title P_ ((struct frame *, Lisp_Object, Lisp_Object));
755void x_set_unsplittable P_ ((struct frame *, Lisp_Object, Lisp_Object));
9ea173e8 756void x_set_tool_bar_lines P_ ((struct frame *, Lisp_Object, Lisp_Object));
333b20bb
GM
757void x_set_scroll_bar_foreground P_ ((struct frame *, Lisp_Object,
758 Lisp_Object));
759void x_set_scroll_bar_background P_ ((struct frame *, Lisp_Object,
760 Lisp_Object));
761static Lisp_Object x_default_scroll_bar_color_parameter P_ ((struct frame *,
762 Lisp_Object,
763 Lisp_Object,
764 char *, char *,
765 int));
d62c8769 766static void x_set_screen_gamma P_ ((struct frame *, Lisp_Object, Lisp_Object));
4a8e312c
GM
767static void x_edge_detection P_ ((struct frame *, struct image *, Lisp_Object,
768 Lisp_Object));
b243755a
GM
769static void init_color_table P_ ((void));
770static void free_color_table P_ ((void));
771static unsigned long *colors_in_color_table P_ ((int *n));
772static unsigned long lookup_rgb_color P_ ((struct frame *f, int r, int g, int b));
773static unsigned long lookup_pixel_color P_ ((struct frame *f, unsigned long p));
774
775
01f1ba30 776
f676886a 777static struct x_frame_parm_table x_frame_parms[] =
01f1ba30 778{
563b67aa
GM
779 "auto-raise", x_set_autoraise,
780 "auto-lower", x_set_autolower,
781 "background-color", x_set_background_color,
782 "border-color", x_set_border_color,
783 "border-width", x_set_border_width,
784 "cursor-color", x_set_cursor_color,
785 "cursor-type", x_set_cursor_type,
786 "font", x_set_font,
787 "foreground-color", x_set_foreground_color,
788 "icon-name", x_set_icon_name,
789 "icon-type", x_set_icon_type,
790 "internal-border-width", x_set_internal_border_width,
791 "menu-bar-lines", x_set_menu_bar_lines,
792 "mouse-color", x_set_mouse_color,
793 "name", x_explicitly_set_name,
794 "scroll-bar-width", x_set_scroll_bar_width,
795 "title", x_set_title,
796 "unsplittable", x_set_unsplittable,
797 "vertical-scroll-bars", x_set_vertical_scroll_bars,
798 "visibility", x_set_visibility,
799 "tool-bar-lines", x_set_tool_bar_lines,
800 "scroll-bar-foreground", x_set_scroll_bar_foreground,
801 "scroll-bar-background", x_set_scroll_bar_background,
802 "screen-gamma", x_set_screen_gamma,
ea0a1f53
GM
803 "line-spacing", x_set_line_spacing,
804 "wait-for-wm", x_set_wait_for_wm
01f1ba30
JB
805};
806
f676886a 807/* Attach the `x-frame-parameter' properties to
01f1ba30
JB
808 the Lisp symbol names of parameters relevant to X. */
809
201d8c78 810void
01f1ba30
JB
811init_x_parm_symbols ()
812{
813 int i;
814
d043f1a4 815 for (i = 0; i < sizeof (x_frame_parms) / sizeof (x_frame_parms[0]); i++)
f676886a 816 Fput (intern (x_frame_parms[i].name), Qx_frame_parameter,
01f1ba30
JB
817 make_number (i));
818}
819\f
e8cc313b 820/* Change the parameters of frame F as specified by ALIST.
64362cd4
GM
821 If a parameter is not specially recognized, do nothing special;
822 otherwise call the `x_set_...' function for that parameter.
823 Except for certain geometry properties, always call store_frame_param
824 to store the new value in the parameter alist. */
d043f1a4 825
f9942c9e
JB
826void
827x_set_frame_parameters (f, alist)
828 FRAME_PTR f;
829 Lisp_Object alist;
830{
831 Lisp_Object tail;
832
833 /* If both of these parameters are present, it's more efficient to
834 set them both at once. So we wait until we've looked at the
835 entire list before we set them. */
e4f79258 836 int width, height;
f9942c9e
JB
837
838 /* Same here. */
839 Lisp_Object left, top;
f9942c9e 840
a59e4f3d
RS
841 /* Same with these. */
842 Lisp_Object icon_left, icon_top;
843
f5e70acd
RS
844 /* Record in these vectors all the parms specified. */
845 Lisp_Object *parms;
846 Lisp_Object *values;
a797a73d 847 int i, p;
e1d962d7 848 int left_no_change = 0, top_no_change = 0;
a59e4f3d 849 int icon_left_no_change = 0, icon_top_no_change = 0;
203c1d73 850
7589a1d9
RS
851 struct gcpro gcpro1, gcpro2;
852
f5e70acd
RS
853 i = 0;
854 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
855 i++;
856
857 parms = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
858 values = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
f9942c9e 859
f5e70acd
RS
860 /* Extract parm names and values into those vectors. */
861
862 i = 0;
f9942c9e
JB
863 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
864 {
333b20bb 865 Lisp_Object elt;
f9942c9e
JB
866
867 elt = Fcar (tail);
f5e70acd
RS
868 parms[i] = Fcar (elt);
869 values[i] = Fcdr (elt);
870 i++;
871 }
7589a1d9
RS
872 /* TAIL and ALIST are not used again below here. */
873 alist = tail = Qnil;
874
875 GCPRO2 (*parms, *values);
876 gcpro1.nvars = i;
877 gcpro2.nvars = i;
f5e70acd 878
7589a1d9
RS
879 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
880 because their values appear in VALUES and strings are not valid. */
e4f79258 881 top = left = Qunbound;
a59e4f3d 882 icon_left = icon_top = Qunbound;
f9942c9e 883
e4f79258
RS
884 /* Provide default values for HEIGHT and WIDTH. */
885 if (FRAME_NEW_WIDTH (f))
886 width = FRAME_NEW_WIDTH (f);
887 else
888 width = FRAME_WIDTH (f);
889
890 if (FRAME_NEW_HEIGHT (f))
891 height = FRAME_NEW_HEIGHT (f);
892 else
893 height = FRAME_HEIGHT (f);
894
a797a73d
GV
895 /* Process foreground_color and background_color before anything else.
896 They are independent of other properties, but other properties (e.g.,
897 cursor_color) are dependent upon them. */
898 for (p = 0; p < i; p++)
899 {
900 Lisp_Object prop, val;
901
902 prop = parms[p];
903 val = values[p];
904 if (EQ (prop, Qforeground_color) || EQ (prop, Qbackground_color))
905 {
906 register Lisp_Object param_index, old_value;
907
908 param_index = Fget (prop, Qx_frame_parameter);
909 old_value = get_frame_param (f, prop);
910 store_frame_param (f, prop, val);
911 if (NATNUMP (param_index)
912 && (XFASTINT (param_index)
913 < sizeof (x_frame_parms)/sizeof (x_frame_parms[0])))
914 (*x_frame_parms[XINT (param_index)].setter)(f, val, old_value);
915 }
916 }
917
f5e70acd
RS
918 /* Now process them in reverse of specified order. */
919 for (i--; i >= 0; i--)
920 {
921 Lisp_Object prop, val;
922
923 prop = parms[i];
924 val = values[i];
925
e4f79258
RS
926 if (EQ (prop, Qwidth) && NUMBERP (val))
927 width = XFASTINT (val);
928 else if (EQ (prop, Qheight) && NUMBERP (val))
929 height = XFASTINT (val);
f5e70acd 930 else if (EQ (prop, Qtop))
f9942c9e 931 top = val;
f5e70acd 932 else if (EQ (prop, Qleft))
f9942c9e 933 left = val;
a59e4f3d
RS
934 else if (EQ (prop, Qicon_top))
935 icon_top = val;
936 else if (EQ (prop, Qicon_left))
937 icon_left = val;
a797a73d
GV
938 else if (EQ (prop, Qforeground_color) || EQ (prop, Qbackground_color))
939 /* Processed above. */
940 continue;
f9942c9e
JB
941 else
942 {
98381190 943 register Lisp_Object param_index, old_value;
ea96210c 944
98381190
KH
945 param_index = Fget (prop, Qx_frame_parameter);
946 old_value = get_frame_param (f, prop);
f9942c9e 947 store_frame_param (f, prop, val);
40c03e12
KH
948 if (NATNUMP (param_index)
949 && (XFASTINT (param_index)
ea96210c
JB
950 < sizeof (x_frame_parms)/sizeof (x_frame_parms[0])))
951 (*x_frame_parms[XINT (param_index)].setter)(f, val, old_value);
f9942c9e
JB
952 }
953 }
954
11378c41
RS
955 /* Don't die if just one of these was set. */
956 if (EQ (left, Qunbound))
e1d962d7
RS
957 {
958 left_no_change = 1;
7556890b
RS
959 if (f->output_data.x->left_pos < 0)
960 left = Fcons (Qplus, Fcons (make_number (f->output_data.x->left_pos), Qnil));
e1d962d7 961 else
7556890b 962 XSETINT (left, f->output_data.x->left_pos);
e1d962d7 963 }
11378c41 964 if (EQ (top, Qunbound))
e1d962d7
RS
965 {
966 top_no_change = 1;
7556890b
RS
967 if (f->output_data.x->top_pos < 0)
968 top = Fcons (Qplus, Fcons (make_number (f->output_data.x->top_pos), Qnil));
e1d962d7 969 else
7556890b 970 XSETINT (top, f->output_data.x->top_pos);
e1d962d7 971 }
11378c41 972
a59e4f3d
RS
973 /* If one of the icon positions was not set, preserve or default it. */
974 if (EQ (icon_left, Qunbound) || ! INTEGERP (icon_left))
975 {
976 icon_left_no_change = 1;
977 icon_left = Fcdr (Fassq (Qicon_left, f->param_alist));
978 if (NILP (icon_left))
979 XSETINT (icon_left, 0);
980 }
981 if (EQ (icon_top, Qunbound) || ! INTEGERP (icon_top))
982 {
983 icon_top_no_change = 1;
984 icon_top = Fcdr (Fassq (Qicon_top, f->param_alist));
985 if (NILP (icon_top))
986 XSETINT (icon_top, 0);
987 }
988
499ea23b 989 /* Don't set these parameters unless they've been explicitly
d387c960
JB
990 specified. The window might be mapped or resized while we're in
991 this function, and we don't want to override that unless the lisp
992 code has asked for it.
993
994 Don't set these parameters unless they actually differ from the
995 window's current parameters; the window may not actually exist
996 yet. */
f9942c9e
JB
997 {
998 Lisp_Object frame;
999
1f11a5ca
RS
1000 check_frame_size (f, &height, &width);
1001
191ed777 1002 XSETFRAME (frame, f);
11378c41 1003
e4f79258
RS
1004 if (width != FRAME_WIDTH (f)
1005 || height != FRAME_HEIGHT (f)
d6f80ae9 1006 || FRAME_NEW_HEIGHT (f) || FRAME_NEW_WIDTH (f))
e4f79258 1007 Fset_frame_size (frame, make_number (width), make_number (height));
f10f0b79
RS
1008
1009 if ((!NILP (left) || !NILP (top))
e1d962d7 1010 && ! (left_no_change && top_no_change)
7556890b
RS
1011 && ! (NUMBERP (left) && XINT (left) == f->output_data.x->left_pos
1012 && NUMBERP (top) && XINT (top) == f->output_data.x->top_pos))
f10f0b79 1013 {
e1d962d7
RS
1014 int leftpos = 0;
1015 int toppos = 0;
f10f0b79
RS
1016
1017 /* Record the signs. */
7556890b 1018 f->output_data.x->size_hint_flags &= ~ (XNegative | YNegative);
e1d962d7 1019 if (EQ (left, Qminus))
7556890b 1020 f->output_data.x->size_hint_flags |= XNegative;
e1d962d7
RS
1021 else if (INTEGERP (left))
1022 {
1023 leftpos = XINT (left);
1024 if (leftpos < 0)
7556890b 1025 f->output_data.x->size_hint_flags |= XNegative;
e1d962d7 1026 }
8e713be6
KR
1027 else if (CONSP (left) && EQ (XCAR (left), Qminus)
1028 && CONSP (XCDR (left))
1029 && INTEGERP (XCAR (XCDR (left))))
e1d962d7 1030 {
8e713be6 1031 leftpos = - XINT (XCAR (XCDR (left)));
7556890b 1032 f->output_data.x->size_hint_flags |= XNegative;
e1d962d7 1033 }
8e713be6
KR
1034 else if (CONSP (left) && EQ (XCAR (left), Qplus)
1035 && CONSP (XCDR (left))
1036 && INTEGERP (XCAR (XCDR (left))))
e1d962d7 1037 {
8e713be6 1038 leftpos = XINT (XCAR (XCDR (left)));
e1d962d7
RS
1039 }
1040
1041 if (EQ (top, Qminus))
7556890b 1042 f->output_data.x->size_hint_flags |= YNegative;
e1d962d7
RS
1043 else if (INTEGERP (top))
1044 {
1045 toppos = XINT (top);
1046 if (toppos < 0)
7556890b 1047 f->output_data.x->size_hint_flags |= YNegative;
e1d962d7 1048 }
8e713be6
KR
1049 else if (CONSP (top) && EQ (XCAR (top), Qminus)
1050 && CONSP (XCDR (top))
1051 && INTEGERP (XCAR (XCDR (top))))
e1d962d7 1052 {
8e713be6 1053 toppos = - XINT (XCAR (XCDR (top)));
7556890b 1054 f->output_data.x->size_hint_flags |= YNegative;
e1d962d7 1055 }
8e713be6
KR
1056 else if (CONSP (top) && EQ (XCAR (top), Qplus)
1057 && CONSP (XCDR (top))
1058 && INTEGERP (XCAR (XCDR (top))))
e1d962d7 1059 {
8e713be6 1060 toppos = XINT (XCAR (XCDR (top)));
e1d962d7
RS
1061 }
1062
1063
1064 /* Store the numeric value of the position. */
7556890b
RS
1065 f->output_data.x->top_pos = toppos;
1066 f->output_data.x->left_pos = leftpos;
e1d962d7 1067
7556890b 1068 f->output_data.x->win_gravity = NorthWestGravity;
f10f0b79
RS
1069
1070 /* Actually set that position, and convert to absolute. */
f0e72e79 1071 x_set_offset (f, leftpos, toppos, -1);
f10f0b79 1072 }
a59e4f3d
RS
1073
1074 if ((!NILP (icon_left) || !NILP (icon_top))
1075 && ! (icon_left_no_change && icon_top_no_change))
1076 x_wm_set_icon_position (f, XINT (icon_left), XINT (icon_top));
f9942c9e 1077 }
7589a1d9
RS
1078
1079 UNGCPRO;
f9942c9e 1080}
01f1ba30 1081
08a90d6a 1082/* Store the screen positions of frame F into XPTR and YPTR.
e9445337
RS
1083 These are the positions of the containing window manager window,
1084 not Emacs's own window. */
1085
1086void
1087x_real_positions (f, xptr, yptr)
1088 FRAME_PTR f;
1089 int *xptr, *yptr;
1090{
08a90d6a 1091 int win_x, win_y;
e9445337
RS
1092 Window child;
1093
043835a3
RS
1094 /* This is pretty gross, but seems to be the easiest way out of
1095 the problem that arises when restarting window-managers. */
1096
1097#ifdef USE_X_TOOLKIT
333b20bb
GM
1098 Window outer = (f->output_data.x->widget
1099 ? XtWindow (f->output_data.x->widget)
1100 : FRAME_X_WINDOW (f));
043835a3 1101#else
7556890b 1102 Window outer = f->output_data.x->window_desc;
043835a3
RS
1103#endif
1104 Window tmp_root_window;
1105 Window *tmp_children;
4848ef23 1106 unsigned int tmp_nchildren;
043835a3 1107
08a90d6a 1108 while (1)
e9445337 1109 {
1dc6cfa6 1110 int count = x_catch_errors (FRAME_X_DISPLAY (f));
8a07bba0 1111 Window outer_window;
ca7bac79 1112
08a90d6a 1113 XQueryTree (FRAME_X_DISPLAY (f), outer, &tmp_root_window,
7556890b 1114 &f->output_data.x->parent_desc,
08a90d6a 1115 &tmp_children, &tmp_nchildren);
72dc3bc7 1116 XFree ((char *) tmp_children);
08a90d6a
RS
1117
1118 win_x = win_y = 0;
1119
1120 /* Find the position of the outside upper-left corner of
1121 the inner window, with respect to the outer window. */
7556890b 1122 if (f->output_data.x->parent_desc != FRAME_X_DISPLAY_INFO (f)->root_window)
8a07bba0
RS
1123 outer_window = f->output_data.x->parent_desc;
1124 else
1125 outer_window = outer;
08a90d6a 1126
8a07bba0 1127 XTranslateCoordinates (FRAME_X_DISPLAY (f),
e9445337 1128
8a07bba0
RS
1129 /* From-window, to-window. */
1130 outer_window,
1131 FRAME_X_DISPLAY_INFO (f)->root_window,
e9445337 1132
8a07bba0
RS
1133 /* From-position, to-position. */
1134 0, 0, &win_x, &win_y,
08a90d6a 1135
8a07bba0
RS
1136 /* Child of win. */
1137 &child);
e9445337 1138
08a90d6a
RS
1139 /* It is possible for the window returned by the XQueryNotify
1140 to become invalid by the time we call XTranslateCoordinates.
1141 That can happen when you restart some window managers.
1142 If so, we get an error in XTranslateCoordinates.
1143 Detect that and try the whole thing over. */
c4ec904f 1144 if (! x_had_errors_p (FRAME_X_DISPLAY (f)))
845e9d85 1145 {
1dc6cfa6 1146 x_uncatch_errors (FRAME_X_DISPLAY (f), count);
845e9d85
RS
1147 break;
1148 }
ca7bac79 1149
1dc6cfa6 1150 x_uncatch_errors (FRAME_X_DISPLAY (f), count);
e9445337 1151 }
08a90d6a 1152
333b20bb
GM
1153 *xptr = win_x;
1154 *yptr = win_y;
e9445337
RS
1155}
1156
f676886a 1157/* Insert a description of internally-recorded parameters of frame X
01f1ba30
JB
1158 into the parameter alist *ALISTPTR that is to be given to the user.
1159 Only parameters that are specific to the X window system
f676886a 1160 and whose values are not correctly recorded in the frame's
01f1ba30
JB
1161 param_alist need to be considered here. */
1162
968b1234 1163void
f676886a
JB
1164x_report_frame_params (f, alistptr)
1165 struct frame *f;
01f1ba30
JB
1166 Lisp_Object *alistptr;
1167{
1168 char buf[16];
9b002b8d
KH
1169 Lisp_Object tem;
1170
1171 /* Represent negative positions (off the top or left screen edge)
1172 in a way that Fmodify_frame_parameters will understand correctly. */
7556890b
RS
1173 XSETINT (tem, f->output_data.x->left_pos);
1174 if (f->output_data.x->left_pos >= 0)
9b002b8d
KH
1175 store_in_alist (alistptr, Qleft, tem);
1176 else
1177 store_in_alist (alistptr, Qleft, Fcons (Qplus, Fcons (tem, Qnil)));
1178
7556890b
RS
1179 XSETINT (tem, f->output_data.x->top_pos);
1180 if (f->output_data.x->top_pos >= 0)
9b002b8d
KH
1181 store_in_alist (alistptr, Qtop, tem);
1182 else
1183 store_in_alist (alistptr, Qtop, Fcons (Qplus, Fcons (tem, Qnil)));
01f1ba30 1184
f9942c9e 1185 store_in_alist (alistptr, Qborder_width,
7556890b 1186 make_number (f->output_data.x->border_width));
f9942c9e 1187 store_in_alist (alistptr, Qinternal_border_width,
7556890b 1188 make_number (f->output_data.x->internal_border_width));
7c118b57 1189 sprintf (buf, "%ld", (long) FRAME_X_WINDOW (f));
f9942c9e 1190 store_in_alist (alistptr, Qwindow_id,
01f1ba30 1191 build_string (buf));
333b20bb
GM
1192#ifdef USE_X_TOOLKIT
1193 /* Tooltip frame may not have this widget. */
1194 if (f->output_data.x->widget)
1195#endif
1196 sprintf (buf, "%ld", (long) FRAME_OUTER_WINDOW (f));
2cbebefb
RS
1197 store_in_alist (alistptr, Qouter_window_id,
1198 build_string (buf));
f468da95 1199 store_in_alist (alistptr, Qicon_name, f->icon_name);
a8ccd803 1200 FRAME_SAMPLE_VISIBILITY (f);
d043f1a4
RS
1201 store_in_alist (alistptr, Qvisibility,
1202 (FRAME_VISIBLE_P (f) ? Qt
1203 : FRAME_ICONIFIED_P (f) ? Qicon : Qnil));
34ae77b5 1204 store_in_alist (alistptr, Qdisplay,
8e713be6 1205 XCAR (FRAME_X_DISPLAY_INFO (f)->name_list_element));
e4f79258 1206
8c239ac3
RS
1207 if (f->output_data.x->parent_desc == FRAME_X_DISPLAY_INFO (f)->root_window)
1208 tem = Qnil;
1209 else
1210 XSETFASTINT (tem, f->output_data.x->parent_desc);
1211 store_in_alist (alistptr, Qparent_id, tem);
01f1ba30
JB
1212}
1213\f
82978295 1214
d62c8769
GM
1215
1216/* Gamma-correct COLOR on frame F. */
1217
1218void
1219gamma_correct (f, color)
1220 struct frame *f;
1221 XColor *color;
1222{
1223 if (f->gamma)
1224 {
1225 color->red = pow (color->red / 65535.0, f->gamma) * 65535.0 + 0.5;
1226 color->green = pow (color->green / 65535.0, f->gamma) * 65535.0 + 0.5;
1227 color->blue = pow (color->blue / 65535.0, f->gamma) * 65535.0 + 0.5;
1228 }
1229}
1230
1231
7b746c38
GM
1232/* Decide if color named COLOR_NAME is valid for use on frame F. If
1233 so, return the RGB values in COLOR. If ALLOC_P is non-zero,
1234 allocate the color. Value is zero if COLOR_NAME is invalid, or
1235 no color could be allocated. */
e12d55b2 1236
01f1ba30 1237int
7b746c38
GM
1238x_defined_color (f, color_name, color, alloc_p)
1239 struct frame *f;
1240 char *color_name;
1241 XColor *color;
1242 int alloc_p;
01f1ba30 1243{
7b746c38
GM
1244 int success_p;
1245 Display *dpy = FRAME_X_DISPLAY (f);
1246 Colormap cmap = FRAME_X_COLORMAP (f);
01f1ba30
JB
1247
1248 BLOCK_INPUT;
7b746c38
GM
1249 success_p = XParseColor (dpy, cmap, color_name, color);
1250 if (success_p && alloc_p)
1251 success_p = x_alloc_nearest_color (f, cmap, color);
01f1ba30
JB
1252 UNBLOCK_INPUT;
1253
7b746c38 1254 return success_p;
01f1ba30
JB
1255}
1256
9b2956e2
GM
1257
1258/* Return the pixel color value for color COLOR_NAME on frame F. If F
1259 is a monochrome frame, return MONO_COLOR regardless of what ARG says.
1260 Signal an error if color can't be allocated. */
01f1ba30
JB
1261
1262int
9b2956e2 1263x_decode_color (f, color_name, mono_color)
b9dc4443 1264 FRAME_PTR f;
9b2956e2
GM
1265 Lisp_Object color_name;
1266 int mono_color;
01f1ba30 1267{
b9dc4443 1268 XColor cdef;
01f1ba30 1269
9b2956e2 1270 CHECK_STRING (color_name, 0);
01f1ba30 1271
9b2956e2
GM
1272#if 0 /* Don't do this. It's wrong when we're not using the default
1273 colormap, it makes freeing difficult, and it's probably not
1274 an important optimization. */
1275 if (strcmp (XSTRING (color_name)->data, "black") == 0)
b9dc4443 1276 return BLACK_PIX_DEFAULT (f);
9b2956e2 1277 else if (strcmp (XSTRING (color_name)->data, "white") == 0)
b9dc4443 1278 return WHITE_PIX_DEFAULT (f);
9b2956e2 1279#endif
01f1ba30 1280
9b2956e2 1281 /* Return MONO_COLOR for monochrome frames. */
b9dc4443 1282 if (FRAME_X_DISPLAY_INFO (f)->n_planes == 1)
9b2956e2 1283 return mono_color;
01f1ba30 1284
2d764c78 1285 /* x_defined_color is responsible for coping with failures
95626e11 1286 by looking for a near-miss. */
9b2956e2 1287 if (x_defined_color (f, XSTRING (color_name)->data, &cdef, 1))
95626e11
RS
1288 return cdef.pixel;
1289
c301be26
GM
1290 Fsignal (Qerror, Fcons (build_string ("Undefined color"),
1291 Fcons (color_name, Qnil)));
1292 return 0;
01f1ba30 1293}
9b2956e2
GM
1294
1295
01f1ba30 1296\f
563b67aa
GM
1297/* Change the `line-spacing' frame parameter of frame F. OLD_VALUE is
1298 the previous value of that parameter, NEW_VALUE is the new value. */
1299
1300static void
1301x_set_line_spacing (f, new_value, old_value)
1302 struct frame *f;
1303 Lisp_Object new_value, old_value;
1304{
1305 if (NILP (new_value))
1306 f->extra_line_spacing = 0;
1307 else if (NATNUMP (new_value))
1308 f->extra_line_spacing = XFASTINT (new_value);
1309 else
1a948b17 1310 Fsignal (Qerror, Fcons (build_string ("Invalid line-spacing"),
563b67aa
GM
1311 Fcons (new_value, Qnil)));
1312 if (FRAME_VISIBLE_P (f))
1313 redraw_frame (f);
1314}
1315
1316
ea0a1f53
GM
1317/* Change the `wait-for-wm' frame parameter of frame F. OLD_VALUE is
1318 the previous value of that parameter, NEW_VALUE is the new value.
1319 See also the comment of wait_for_wm in struct x_output. */
1320
1321static void
1322x_set_wait_for_wm (f, new_value, old_value)
1323 struct frame *f;
1324 Lisp_Object new_value, old_value;
1325{
1326 f->output_data.x->wait_for_wm = !NILP (new_value);
1327}
1328
1329
d62c8769 1330/* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
ea0a1f53
GM
1331 the previous value of that parameter, NEW_VALUE is the new
1332 value. */
d62c8769
GM
1333
1334static void
1335x_set_screen_gamma (f, new_value, old_value)
1336 struct frame *f;
1337 Lisp_Object new_value, old_value;
1338{
1339 if (NILP (new_value))
1340 f->gamma = 0;
1341 else if (NUMBERP (new_value) && XFLOATINT (new_value) > 0)
1342 /* The value 0.4545 is the normal viewing gamma. */
1343 f->gamma = 1.0 / (0.4545 * XFLOATINT (new_value));
1344 else
1a948b17 1345 Fsignal (Qerror, Fcons (build_string ("Invalid screen-gamma"),
d62c8769
GM
1346 Fcons (new_value, Qnil)));
1347
1348 clear_face_cache (0);
1349}
1350
1351
f676886a 1352/* Functions called only from `x_set_frame_param'
01f1ba30
JB
1353 to set individual parameters.
1354
fe24a618 1355 If FRAME_X_WINDOW (f) is 0,
f676886a 1356 the frame is being created and its X-window does not exist yet.
01f1ba30
JB
1357 In that case, just record the parameter's new value
1358 in the standard place; do not attempt to change the window. */
1359
1360void
f676886a
JB
1361x_set_foreground_color (f, arg, oldval)
1362 struct frame *f;
01f1ba30
JB
1363 Lisp_Object arg, oldval;
1364{
09393d07
GM
1365 struct x_output *x = f->output_data.x;
1366 unsigned long fg, old_fg;
a76206dc 1367
09393d07
GM
1368 fg = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1369 old_fg = x->foreground_pixel;
1370 x->foreground_pixel = fg;
a76206dc 1371
fe24a618 1372 if (FRAME_X_WINDOW (f) != 0)
01f1ba30 1373 {
09393d07 1374 Display *dpy = FRAME_X_DISPLAY (f);
36d42089 1375
09393d07
GM
1376 BLOCK_INPUT;
1377 XSetForeground (dpy, x->normal_gc, fg);
1378 XSetBackground (dpy, x->reverse_gc, fg);
36d42089 1379
09393d07
GM
1380 if (x->cursor_pixel == old_fg)
1381 {
1382 unload_color (f, x->cursor_pixel);
1383 x->cursor_pixel = x_copy_color (f, fg);
1384 XSetBackground (dpy, x->cursor_gc, x->cursor_pixel);
1385 }
1386
01f1ba30 1387 UNBLOCK_INPUT;
09393d07 1388
05c8abbe 1389 update_face_from_frame_parameter (f, Qforeground_color, arg);
09393d07 1390
179956b9 1391 if (FRAME_VISIBLE_P (f))
f676886a 1392 redraw_frame (f);
01f1ba30 1393 }
09393d07
GM
1394
1395 unload_color (f, old_fg);
01f1ba30
JB
1396}
1397
1398void
f676886a
JB
1399x_set_background_color (f, arg, oldval)
1400 struct frame *f;
01f1ba30
JB
1401 Lisp_Object arg, oldval;
1402{
09393d07
GM
1403 struct x_output *x = f->output_data.x;
1404 unsigned long bg;
01f1ba30 1405
09393d07
GM
1406 bg = x_decode_color (f, arg, WHITE_PIX_DEFAULT (f));
1407 unload_color (f, x->background_pixel);
1408 x->background_pixel = bg;
a76206dc 1409
fe24a618 1410 if (FRAME_X_WINDOW (f) != 0)
01f1ba30 1411 {
09393d07 1412 Display *dpy = FRAME_X_DISPLAY (f);
36d42089 1413
09393d07
GM
1414 BLOCK_INPUT;
1415 XSetBackground (dpy, x->normal_gc, bg);
1416 XSetForeground (dpy, x->reverse_gc, bg);
1417 XSetWindowBackground (dpy, FRAME_X_WINDOW (f), bg);
1418 XSetForeground (dpy, x->cursor_gc, bg);
1419
f76e0368
GM
1420#ifndef USE_TOOLKIT_SCROLL_BARS /* Turns out to be annoying with
1421 toolkit scroll bars. */
1422 {
1423 Lisp_Object bar;
1424 for (bar = FRAME_SCROLL_BARS (f);
1425 !NILP (bar);
1426 bar = XSCROLL_BAR (bar)->next)
1427 {
1428 Window window = SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar));
1429 XSetWindowBackground (dpy, window, bg);
1430 }
1431 }
1432#endif /* USE_TOOLKIT_SCROLL_BARS */
01f1ba30 1433
09393d07 1434 UNBLOCK_INPUT;
05c8abbe 1435 update_face_from_frame_parameter (f, Qbackground_color, arg);
ea96210c 1436
179956b9 1437 if (FRAME_VISIBLE_P (f))
f676886a 1438 redraw_frame (f);
01f1ba30
JB
1439 }
1440}
1441
1442void
f676886a
JB
1443x_set_mouse_color (f, arg, oldval)
1444 struct frame *f;
01f1ba30
JB
1445 Lisp_Object arg, oldval;
1446{
09393d07
GM
1447 struct x_output *x = f->output_data.x;
1448 Display *dpy = FRAME_X_DISPLAY (f);
95f80c78 1449 Cursor cursor, nontext_cursor, mode_cursor, cross_cursor;
0af913d7 1450 Cursor hourglass_cursor, horizontal_drag_cursor;
1dc6cfa6 1451 int count;
51a1d2d8 1452 unsigned long pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
09393d07 1453 unsigned long mask_color = x->background_pixel;
a76206dc 1454
51a1d2d8 1455 /* Don't let pointers be invisible. */
09393d07 1456 if (mask_color == pixel)
bcf26b38
GM
1457 {
1458 x_free_colors (f, &pixel, 1);
09393d07 1459 pixel = x_copy_color (f, x->foreground_pixel);
bcf26b38 1460 }
a76206dc 1461
09393d07
GM
1462 unload_color (f, x->mouse_pixel);
1463 x->mouse_pixel = pixel;
01f1ba30
JB
1464
1465 BLOCK_INPUT;
fe24a618 1466
eb8c3be9 1467 /* It's not okay to crash if the user selects a screwy cursor. */
09393d07 1468 count = x_catch_errors (dpy);
fe24a618 1469
09393d07 1470 if (!NILP (Vx_pointer_shape))
01f1ba30
JB
1471 {
1472 CHECK_NUMBER (Vx_pointer_shape, 0);
09393d07 1473 cursor = XCreateFontCursor (dpy, XINT (Vx_pointer_shape));
01f1ba30
JB
1474 }
1475 else
09393d07
GM
1476 cursor = XCreateFontCursor (dpy, XC_xterm);
1477 x_check_errors (dpy, "bad text pointer cursor: %s");
01f1ba30 1478
09393d07 1479 if (!NILP (Vx_nontext_pointer_shape))
01f1ba30
JB
1480 {
1481 CHECK_NUMBER (Vx_nontext_pointer_shape, 0);
09393d07
GM
1482 nontext_cursor
1483 = XCreateFontCursor (dpy, XINT (Vx_nontext_pointer_shape));
01f1ba30
JB
1484 }
1485 else
09393d07
GM
1486 nontext_cursor = XCreateFontCursor (dpy, XC_left_ptr);
1487 x_check_errors (dpy, "bad nontext pointer cursor: %s");
01f1ba30 1488
09393d07 1489 if (!NILP (Vx_hourglass_pointer_shape))
333b20bb 1490 {
0af913d7 1491 CHECK_NUMBER (Vx_hourglass_pointer_shape, 0);
09393d07
GM
1492 hourglass_cursor
1493 = XCreateFontCursor (dpy, XINT (Vx_hourglass_pointer_shape));
333b20bb
GM
1494 }
1495 else
09393d07
GM
1496 hourglass_cursor = XCreateFontCursor (dpy, XC_watch);
1497 x_check_errors (dpy, "bad hourglass pointer cursor: %s");
333b20bb 1498
09393d07
GM
1499 x_check_errors (dpy, "bad nontext pointer cursor: %s");
1500 if (!NILP (Vx_mode_pointer_shape))
01f1ba30
JB
1501 {
1502 CHECK_NUMBER (Vx_mode_pointer_shape, 0);
09393d07 1503 mode_cursor = XCreateFontCursor (dpy, XINT (Vx_mode_pointer_shape));
01f1ba30
JB
1504 }
1505 else
09393d07
GM
1506 mode_cursor = XCreateFontCursor (dpy, XC_xterm);
1507 x_check_errors (dpy, "bad modeline pointer cursor: %s");
95f80c78 1508
09393d07 1509 if (!NILP (Vx_sensitive_text_pointer_shape))
95f80c78 1510 {
ca0ecbf5
RS
1511 CHECK_NUMBER (Vx_sensitive_text_pointer_shape, 0);
1512 cross_cursor
09393d07 1513 = XCreateFontCursor (dpy, XINT (Vx_sensitive_text_pointer_shape));
95f80c78
FP
1514 }
1515 else
09393d07 1516 cross_cursor = XCreateFontCursor (dpy, XC_crosshair);
01f1ba30 1517
8fb4ec9c
GM
1518 if (!NILP (Vx_window_horizontal_drag_shape))
1519 {
1520 CHECK_NUMBER (Vx_window_horizontal_drag_shape, 0);
1521 horizontal_drag_cursor
09393d07 1522 = XCreateFontCursor (dpy, XINT (Vx_window_horizontal_drag_shape));
8fb4ec9c
GM
1523 }
1524 else
1525 horizontal_drag_cursor
09393d07 1526 = XCreateFontCursor (dpy, XC_sb_h_double_arrow);
8fb4ec9c 1527
fe24a618 1528 /* Check and report errors with the above calls. */
09393d07
GM
1529 x_check_errors (dpy, "can't set cursor shape: %s");
1530 x_uncatch_errors (dpy, count);
fe24a618 1531
01f1ba30
JB
1532 {
1533 XColor fore_color, back_color;
1534
09393d07 1535 fore_color.pixel = x->mouse_pixel;
a31fedb7 1536 x_query_color (f, &fore_color);
01f1ba30 1537 back_color.pixel = mask_color;
a31fedb7
GM
1538 x_query_color (f, &back_color);
1539
09393d07
GM
1540 XRecolorCursor (dpy, cursor, &fore_color, &back_color);
1541 XRecolorCursor (dpy, nontext_cursor, &fore_color, &back_color);
1542 XRecolorCursor (dpy, mode_cursor, &fore_color, &back_color);
1543 XRecolorCursor (dpy, cross_cursor, &fore_color, &back_color);
1544 XRecolorCursor (dpy, hourglass_cursor, &fore_color, &back_color);
1545 XRecolorCursor (dpy, horizontal_drag_cursor, &fore_color, &back_color);
01f1ba30 1546 }
01f1ba30 1547
fe24a618 1548 if (FRAME_X_WINDOW (f) != 0)
09393d07
GM
1549 XDefineCursor (dpy, FRAME_X_WINDOW (f), cursor);
1550
1551 if (cursor != x->text_cursor
1552 && x->text_cursor != 0)
1553 XFreeCursor (dpy, x->text_cursor);
1554 x->text_cursor = cursor;
1555
1556 if (nontext_cursor != x->nontext_cursor
1557 && x->nontext_cursor != 0)
1558 XFreeCursor (dpy, x->nontext_cursor);
1559 x->nontext_cursor = nontext_cursor;
1560
1561 if (hourglass_cursor != x->hourglass_cursor
1562 && x->hourglass_cursor != 0)
1563 XFreeCursor (dpy, x->hourglass_cursor);
1564 x->hourglass_cursor = hourglass_cursor;
1565
1566 if (mode_cursor != x->modeline_cursor
1567 && x->modeline_cursor != 0)
1568 XFreeCursor (dpy, f->output_data.x->modeline_cursor);
1569 x->modeline_cursor = mode_cursor;
333b20bb 1570
09393d07
GM
1571 if (cross_cursor != x->cross_cursor
1572 && x->cross_cursor != 0)
1573 XFreeCursor (dpy, x->cross_cursor);
1574 x->cross_cursor = cross_cursor;
01f1ba30 1575
09393d07
GM
1576 if (horizontal_drag_cursor != x->horizontal_drag_cursor
1577 && x->horizontal_drag_cursor != 0)
1578 XFreeCursor (dpy, x->horizontal_drag_cursor);
1579 x->horizontal_drag_cursor = horizontal_drag_cursor;
8fb4ec9c 1580
09393d07 1581 XFlush (dpy);
01f1ba30 1582 UNBLOCK_INPUT;
05c8abbe
GM
1583
1584 update_face_from_frame_parameter (f, Qmouse_color, arg);
01f1ba30
JB
1585}
1586
1587void
f676886a
JB
1588x_set_cursor_color (f, arg, oldval)
1589 struct frame *f;
01f1ba30
JB
1590 Lisp_Object arg, oldval;
1591{
a76206dc 1592 unsigned long fore_pixel, pixel;
10168ebb 1593 int fore_pixel_allocated_p = 0, pixel_allocated_p = 0;
09393d07 1594 struct x_output *x = f->output_data.x;
01f1ba30 1595
10168ebb
GM
1596 if (!NILP (Vx_cursor_fore_pixel))
1597 {
1598 fore_pixel = x_decode_color (f, Vx_cursor_fore_pixel,
1599 WHITE_PIX_DEFAULT (f));
1600 fore_pixel_allocated_p = 1;
1601 }
01f1ba30 1602 else
09393d07 1603 fore_pixel = x->background_pixel;
10168ebb 1604
a76206dc 1605 pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
10168ebb 1606 pixel_allocated_p = 1;
a76206dc 1607
f9942c9e 1608 /* Make sure that the cursor color differs from the background color. */
09393d07 1609 if (pixel == x->background_pixel)
01f1ba30 1610 {
10168ebb
GM
1611 if (pixel_allocated_p)
1612 {
1613 x_free_colors (f, &pixel, 1);
1614 pixel_allocated_p = 0;
1615 }
1616
09393d07 1617 pixel = x->mouse_pixel;
a76206dc 1618 if (pixel == fore_pixel)
10168ebb
GM
1619 {
1620 if (fore_pixel_allocated_p)
1621 {
1622 x_free_colors (f, &fore_pixel, 1);
1623 fore_pixel_allocated_p = 0;
1624 }
09393d07 1625 fore_pixel = x->background_pixel;
10168ebb 1626 }
01f1ba30 1627 }
a76206dc 1628
09393d07 1629 unload_color (f, x->cursor_foreground_pixel);
10168ebb
GM
1630 if (!fore_pixel_allocated_p)
1631 fore_pixel = x_copy_color (f, fore_pixel);
09393d07 1632 x->cursor_foreground_pixel = fore_pixel;
01f1ba30 1633
09393d07 1634 unload_color (f, x->cursor_pixel);
10168ebb
GM
1635 if (!pixel_allocated_p)
1636 pixel = x_copy_color (f, pixel);
09393d07 1637 x->cursor_pixel = pixel;
a76206dc 1638
fe24a618 1639 if (FRAME_X_WINDOW (f) != 0)
01f1ba30 1640 {
01f1ba30 1641 BLOCK_INPUT;
09393d07
GM
1642 XSetBackground (FRAME_X_DISPLAY (f), x->cursor_gc, x->cursor_pixel);
1643 XSetForeground (FRAME_X_DISPLAY (f), x->cursor_gc, fore_pixel);
01f1ba30 1644 UNBLOCK_INPUT;
01f1ba30 1645
179956b9 1646 if (FRAME_VISIBLE_P (f))
01f1ba30 1647 {
cedadcfa
RS
1648 x_update_cursor (f, 0);
1649 x_update_cursor (f, 1);
01f1ba30
JB
1650 }
1651 }
05c8abbe
GM
1652
1653 update_face_from_frame_parameter (f, Qcursor_color, arg);
01f1ba30 1654}
943b580d 1655\f
f676886a 1656/* Set the border-color of frame F to value described by ARG.
01f1ba30
JB
1657 ARG can be a string naming a color.
1658 The border-color is used for the border that is drawn by the X server.
1659 Note that this does not fully take effect if done before
f676886a 1660 F has an x-window; it must be redone when the window is created.
01f1ba30
JB
1661
1662 Note: this is done in two routines because of the way X10 works.
1663
1664 Note: under X11, this is normally the province of the window manager,
b9dc4443 1665 and so emacs' border colors may be overridden. */
01f1ba30
JB
1666
1667void
f676886a
JB
1668x_set_border_color (f, arg, oldval)
1669 struct frame *f;
01f1ba30
JB
1670 Lisp_Object arg, oldval;
1671{
01f1ba30
JB
1672 int pix;
1673
1674 CHECK_STRING (arg, 0);
b9dc4443 1675 pix = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
f676886a 1676 x_set_border_pixel (f, pix);
05c8abbe 1677 update_face_from_frame_parameter (f, Qborder_color, arg);
01f1ba30
JB
1678}
1679
f676886a 1680/* Set the border-color of frame F to pixel value PIX.
01f1ba30 1681 Note that this does not fully take effect if done before
f676886a 1682 F has an x-window. */
01f1ba30 1683
968b1234 1684void
f676886a
JB
1685x_set_border_pixel (f, pix)
1686 struct frame *f;
01f1ba30
JB
1687 int pix;
1688{
a76206dc 1689 unload_color (f, f->output_data.x->border_pixel);
7556890b 1690 f->output_data.x->border_pixel = pix;
01f1ba30 1691
7556890b 1692 if (FRAME_X_WINDOW (f) != 0 && f->output_data.x->border_width > 0)
01f1ba30 1693 {
01f1ba30 1694 BLOCK_INPUT;
b9dc4443 1695 XSetWindowBorder (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
270958e8 1696 (unsigned long)pix);
01f1ba30
JB
1697 UNBLOCK_INPUT;
1698
179956b9 1699 if (FRAME_VISIBLE_P (f))
f676886a 1700 redraw_frame (f);
01f1ba30
JB
1701 }
1702}
1703
0d1469d6
GM
1704
1705/* Value is the internal representation of the specified cursor type
1706 ARG. If type is BAR_CURSOR, return in *WIDTH the specified width
1707 of the bar cursor. */
1708
1709enum text_cursor_kinds
1710x_specified_cursor_type (arg, width)
1711 Lisp_Object arg;
1712 int *width;
dbc4e1c1 1713{
0d1469d6
GM
1714 enum text_cursor_kinds type;
1715
dbc4e1c1 1716 if (EQ (arg, Qbar))
c3211206 1717 {
0d1469d6
GM
1718 type = BAR_CURSOR;
1719 *width = 2;
c3211206 1720 }
08ac8554
GM
1721 else if (CONSP (arg)
1722 && EQ (XCAR (arg), Qbar)
1723 && INTEGERP (XCDR (arg))
1724 && XINT (XCDR (arg)) >= 0)
c3211206 1725 {
0d1469d6
GM
1726 type = BAR_CURSOR;
1727 *width = XINT (XCDR (arg));
c3211206 1728 }
08ac8554 1729 else if (NILP (arg))
0d1469d6 1730 type = NO_CURSOR;
dbc4e1c1 1731 else
c3211206
RS
1732 /* Treat anything unknown as "box cursor".
1733 It was bad to signal an error; people have trouble fixing
1734 .Xdefaults with Emacs, when it has something bad in it. */
0d1469d6
GM
1735 type = FILLED_BOX_CURSOR;
1736
1737 return type;
1738}
1739
1740void
1741x_set_cursor_type (f, arg, oldval)
1742 FRAME_PTR f;
1743 Lisp_Object arg, oldval;
1744{
1745 int width;
1746
1747 FRAME_DESIRED_CURSOR (f) = x_specified_cursor_type (arg, &width);
1748 f->output_data.x->cursor_width = width;
dbc4e1c1
JB
1749
1750 /* Make sure the cursor gets redrawn. This is overkill, but how
1751 often do people change cursor types? */
1752 update_mode_lines++;
1753}
943b580d 1754\f
01f1ba30 1755void
f676886a
JB
1756x_set_icon_type (f, arg, oldval)
1757 struct frame *f;
01f1ba30
JB
1758 Lisp_Object arg, oldval;
1759{
01f1ba30
JB
1760 int result;
1761
203c1d73
RS
1762 if (STRINGP (arg))
1763 {
1764 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
1765 return;
1766 }
1767 else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
01f1ba30
JB
1768 return;
1769
1770 BLOCK_INPUT;
265a9e55 1771 if (NILP (arg))
80534dd6 1772 result = x_text_icon (f,
f468da95
RS
1773 (char *) XSTRING ((!NILP (f->icon_name)
1774 ? f->icon_name
80534dd6 1775 : f->name))->data);
f1c7b5a6
RS
1776 else
1777 result = x_bitmap_icon (f, arg);
01f1ba30
JB
1778
1779 if (result)
1780 {
01f1ba30 1781 UNBLOCK_INPUT;
0fb53770 1782 error ("No icon window available");
01f1ba30
JB
1783 }
1784
b9dc4443 1785 XFlush (FRAME_X_DISPLAY (f));
01f1ba30
JB
1786 UNBLOCK_INPUT;
1787}
1788
f1c7b5a6 1789/* Return non-nil if frame F wants a bitmap icon. */
0fb53770 1790
f1c7b5a6 1791Lisp_Object
0fb53770
RS
1792x_icon_type (f)
1793 FRAME_PTR f;
1794{
1795 Lisp_Object tem;
1796
1797 tem = assq_no_quit (Qicon_type, f->param_alist);
f1c7b5a6 1798 if (CONSP (tem))
8e713be6 1799 return XCDR (tem);
f1c7b5a6
RS
1800 else
1801 return Qnil;
0fb53770
RS
1802}
1803
80534dd6
KH
1804void
1805x_set_icon_name (f, arg, oldval)
1806 struct frame *f;
1807 Lisp_Object arg, oldval;
1808{
80534dd6
KH
1809 int result;
1810
1811 if (STRINGP (arg))
1812 {
1813 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
1814 return;
1815 }
1816 else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
1817 return;
1818
f468da95 1819 f->icon_name = arg;
80534dd6 1820
7556890b 1821 if (f->output_data.x->icon_bitmap != 0)
80534dd6
KH
1822 return;
1823
1824 BLOCK_INPUT;
1825
1826 result = x_text_icon (f,
f468da95
RS
1827 (char *) XSTRING ((!NILP (f->icon_name)
1828 ? f->icon_name
943b580d
RS
1829 : !NILP (f->title)
1830 ? f->title
80534dd6
KH
1831 : f->name))->data);
1832
1833 if (result)
1834 {
1835 UNBLOCK_INPUT;
1836 error ("No icon window available");
1837 }
1838
80534dd6
KH
1839 XFlush (FRAME_X_DISPLAY (f));
1840 UNBLOCK_INPUT;
1841}
943b580d 1842\f
01f1ba30 1843void
f676886a
JB
1844x_set_font (f, arg, oldval)
1845 struct frame *f;
01f1ba30
JB
1846 Lisp_Object arg, oldval;
1847{
ea96210c 1848 Lisp_Object result;
942ea06d 1849 Lisp_Object fontset_name;
a367641f 1850 Lisp_Object frame;
57c5889c 1851 int old_fontset = f->output_data.x->fontset;
01f1ba30
JB
1852
1853 CHECK_STRING (arg, 1);
01f1ba30 1854
49965a29 1855 fontset_name = Fquery_fontset (arg, Qnil);
942ea06d 1856
01f1ba30 1857 BLOCK_INPUT;
942ea06d
KH
1858 result = (STRINGP (fontset_name)
1859 ? x_new_fontset (f, XSTRING (fontset_name)->data)
1860 : x_new_font (f, XSTRING (arg)->data));
01f1ba30
JB
1861 UNBLOCK_INPUT;
1862
ea96210c 1863 if (EQ (result, Qnil))
1c59f5df 1864 error ("Font `%s' is not defined", XSTRING (arg)->data);
ea96210c 1865 else if (EQ (result, Qt))
26e18ed9 1866 error ("The characters of the given font have varying widths");
ea96210c
JB
1867 else if (STRINGP (result))
1868 {
57c5889c
GM
1869 if (STRINGP (fontset_name))
1870 {
1871 /* Fontset names are built from ASCII font names, so the
1872 names may be equal despite there was a change. */
1873 if (old_fontset == f->output_data.x->fontset)
1874 return;
1875 }
1876 else if (!NILP (Fequal (result, oldval)))
1d090605 1877 return;
57c5889c 1878
ea96210c 1879 store_frame_param (f, Qfont, result);
333b20bb 1880 recompute_basic_faces (f);
ea96210c
JB
1881 }
1882 else
1883 abort ();
a367641f 1884
8938a4fb 1885 do_pending_window_change (0);
95aa0336 1886
333b20bb
GM
1887 /* Don't call `face-set-after-frame-default' when faces haven't been
1888 initialized yet. This is the case when called from
1889 Fx_create_frame. In that case, the X widget or window doesn't
1890 exist either, and we can end up in x_report_frame_params with a
1891 null widget which gives a segfault. */
1892 if (FRAME_FACE_CACHE (f))
1893 {
1894 XSETFRAME (frame, f);
1895 call1 (Qface_set_after_frame_default, frame);
1896 }
01f1ba30
JB
1897}
1898
1899void
f676886a
JB
1900x_set_border_width (f, arg, oldval)
1901 struct frame *f;
01f1ba30
JB
1902 Lisp_Object arg, oldval;
1903{
1904 CHECK_NUMBER (arg, 0);
1905
7556890b 1906 if (XINT (arg) == f->output_data.x->border_width)
01f1ba30
JB
1907 return;
1908
fe24a618 1909 if (FRAME_X_WINDOW (f) != 0)
01f1ba30
JB
1910 error ("Cannot change the border width of a window");
1911
7556890b 1912 f->output_data.x->border_width = XINT (arg);
01f1ba30
JB
1913}
1914
1915void
f676886a
JB
1916x_set_internal_border_width (f, arg, oldval)
1917 struct frame *f;
01f1ba30
JB
1918 Lisp_Object arg, oldval;
1919{
7556890b 1920 int old = f->output_data.x->internal_border_width;
01f1ba30
JB
1921
1922 CHECK_NUMBER (arg, 0);
7556890b
RS
1923 f->output_data.x->internal_border_width = XINT (arg);
1924 if (f->output_data.x->internal_border_width < 0)
1925 f->output_data.x->internal_border_width = 0;
01f1ba30 1926
d3b06468 1927#ifdef USE_X_TOOLKIT
2a8a07d4 1928 if (f->output_data.x->edit_widget)
968b1234 1929 widget_store_internal_border (f->output_data.x->edit_widget);
d3b06468 1930#endif
2a8a07d4 1931
7556890b 1932 if (f->output_data.x->internal_border_width == old)
01f1ba30
JB
1933 return;
1934
fe24a618 1935 if (FRAME_X_WINDOW (f) != 0)
01f1ba30 1936 {
363f7e15 1937 x_set_window_size (f, 0, f->width, f->height);
f676886a 1938 SET_FRAME_GARBAGED (f);
8938a4fb 1939 do_pending_window_change (0);
01f1ba30
JB
1940 }
1941}
1942
d043f1a4
RS
1943void
1944x_set_visibility (f, value, oldval)
1945 struct frame *f;
1946 Lisp_Object value, oldval;
1947{
1948 Lisp_Object frame;
191ed777 1949 XSETFRAME (frame, f);
d043f1a4
RS
1950
1951 if (NILP (value))
363f7e15 1952 Fmake_frame_invisible (frame, Qt);
49795535 1953 else if (EQ (value, Qicon))
d043f1a4 1954 Ficonify_frame (frame);
49795535
JB
1955 else
1956 Fmake_frame_visible (frame);
d043f1a4 1957}
52de7ce9 1958
943b580d 1959\f
52de7ce9
GM
1960/* Change window heights in windows rooted in WINDOW by N lines. */
1961
d043f1a4 1962static void
52de7ce9 1963x_change_window_heights (window, n)
d043f1a4
RS
1964 Lisp_Object window;
1965 int n;
1966{
47c0f58b 1967 struct window *w = XWINDOW (window);
d043f1a4 1968
e33f7330
KH
1969 XSETFASTINT (w->top, XFASTINT (w->top) + n);
1970 XSETFASTINT (w->height, XFASTINT (w->height) - n);
d043f1a4 1971
4336c705
GM
1972 if (INTEGERP (w->orig_top))
1973 XSETFASTINT (w->orig_top, XFASTINT (w->orig_top) + n);
1974 if (INTEGERP (w->orig_height))
1975 XSETFASTINT (w->orig_height, XFASTINT (w->orig_height) - n);
1976
47c0f58b
RS
1977 /* Handle just the top child in a vertical split. */
1978 if (!NILP (w->vchild))
52de7ce9 1979 x_change_window_heights (w->vchild, n);
d043f1a4 1980
47c0f58b
RS
1981 /* Adjust all children in a horizontal split. */
1982 for (window = w->hchild; !NILP (window); window = w->next)
1983 {
1984 w = XWINDOW (window);
52de7ce9 1985 x_change_window_heights (window, n);
d043f1a4
RS
1986 }
1987}
1988
1989void
1990x_set_menu_bar_lines (f, value, oldval)
1991 struct frame *f;
1992 Lisp_Object value, oldval;
1993{
1994 int nlines;
b6d7acec 1995#ifndef USE_X_TOOLKIT
d043f1a4 1996 int olines = FRAME_MENU_BAR_LINES (f);
b6d7acec 1997#endif
d043f1a4 1998
f64ba6ea
JB
1999 /* Right now, menu bars don't work properly in minibuf-only frames;
2000 most of the commands try to apply themselves to the minibuffer
333b20bb 2001 frame itself, and get an error because you can't switch buffers
f64ba6ea 2002 in or split the minibuffer window. */
519066d2 2003 if (FRAME_MINIBUF_ONLY_P (f))
f64ba6ea
JB
2004 return;
2005
6a5e54e2 2006 if (INTEGERP (value))
d043f1a4
RS
2007 nlines = XINT (value);
2008 else
2009 nlines = 0;
2010
3d09b6be
RS
2011 /* Make sure we redisplay all windows in this frame. */
2012 windows_or_buffers_changed++;
2013
9ef48a9d
RS
2014#ifdef USE_X_TOOLKIT
2015 FRAME_MENU_BAR_LINES (f) = 0;
2016 if (nlines)
0d8ef3f4
RS
2017 {
2018 FRAME_EXTERNAL_MENU_BAR (f) = 1;
97a1ff91 2019 if (FRAME_X_P (f) && f->output_data.x->menubar_widget == 0)
0d8ef3f4
RS
2020 /* Make sure next redisplay shows the menu bar. */
2021 XWINDOW (FRAME_SELECTED_WINDOW (f))->update_mode_line = Qt;
2022 }
9ef48a9d
RS
2023 else
2024 {
6bc20398
FP
2025 if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
2026 free_frame_menubar (f);
9ef48a9d 2027 FRAME_EXTERNAL_MENU_BAR (f) = 0;
97a1ff91
RS
2028 if (FRAME_X_P (f))
2029 f->output_data.x->menubar_widget = 0;
9ef48a9d
RS
2030 }
2031#else /* not USE_X_TOOLKIT */
d043f1a4 2032 FRAME_MENU_BAR_LINES (f) = nlines;
52de7ce9 2033 x_change_window_heights (f->root_window, nlines - olines);
9ef48a9d 2034#endif /* not USE_X_TOOLKIT */
333b20bb
GM
2035 adjust_glyphs (f);
2036}
2037
2038
2039/* Set the number of lines used for the tool bar of frame F to VALUE.
2040 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
2041 is the old number of tool bar lines. This function changes the
2042 height of all windows on frame F to match the new tool bar height.
2043 The frame's height doesn't change. */
2044
2045void
9ea173e8 2046x_set_tool_bar_lines (f, value, oldval)
333b20bb
GM
2047 struct frame *f;
2048 Lisp_Object value, oldval;
2049{
52de7ce9
GM
2050 int delta, nlines, root_height;
2051 Lisp_Object root_window;
333b20bb 2052
e870b7ba
GM
2053 /* Treat tool bars like menu bars. */
2054 if (FRAME_MINIBUF_ONLY_P (f))
2055 return;
2056
333b20bb
GM
2057 /* Use VALUE only if an integer >= 0. */
2058 if (INTEGERP (value) && XINT (value) >= 0)
2059 nlines = XFASTINT (value);
2060 else
2061 nlines = 0;
2062
2063 /* Make sure we redisplay all windows in this frame. */
2064 ++windows_or_buffers_changed;
2065
9ea173e8 2066 delta = nlines - FRAME_TOOL_BAR_LINES (f);
52de7ce9
GM
2067
2068 /* Don't resize the tool-bar to more than we have room for. */
2069 root_window = FRAME_ROOT_WINDOW (f);
2070 root_height = XINT (XWINDOW (root_window)->height);
2071 if (root_height - delta < 1)
2072 {
2073 delta = root_height - 1;
2074 nlines = FRAME_TOOL_BAR_LINES (f) + delta;
2075 }
2076
9ea173e8 2077 FRAME_TOOL_BAR_LINES (f) = nlines;
52de7ce9 2078 x_change_window_heights (root_window, delta);
333b20bb 2079 adjust_glyphs (f);
ccba751c
GM
2080
2081 /* We also have to make sure that the internal border at the top of
2082 the frame, below the menu bar or tool bar, is redrawn when the
2083 tool bar disappears. This is so because the internal border is
2084 below the tool bar if one is displayed, but is below the menu bar
2085 if there isn't a tool bar. The tool bar draws into the area
2086 below the menu bar. */
2087 if (FRAME_X_WINDOW (f) && FRAME_TOOL_BAR_LINES (f) == 0)
2088 {
2089 updating_frame = f;
2090 clear_frame ();
fb3cd89b 2091 clear_current_matrices (f);
ccba751c
GM
2092 updating_frame = NULL;
2093 }
b6f91066
GM
2094
2095 /* If the tool bar gets smaller, the internal border below it
2096 has to be cleared. It was formerly part of the display
2097 of the larger tool bar, and updating windows won't clear it. */
2098 if (delta < 0)
2099 {
2100 int height = FRAME_INTERNAL_BORDER_WIDTH (f);
2101 int width = PIXEL_WIDTH (f);
2102 int y = nlines * CANON_Y_UNIT (f);
2103
2104 BLOCK_INPUT;
161d30fd
GM
2105 x_clear_area (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2106 0, y, width, height, False);
b6f91066 2107 UNBLOCK_INPUT;
ddc24747
GM
2108
2109 if (WINDOWP (f->tool_bar_window))
2110 clear_glyph_matrix (XWINDOW (f->tool_bar_window)->current_matrix);
b6f91066 2111 }
333b20bb
GM
2112}
2113
2114
2115/* Set the foreground color for scroll bars on frame F to VALUE.
2116 VALUE should be a string, a color name. If it isn't a string or
2117 isn't a valid color name, do nothing. OLDVAL is the old value of
2118 the frame parameter. */
2119
2120void
2121x_set_scroll_bar_foreground (f, value, oldval)
2122 struct frame *f;
2123 Lisp_Object value, oldval;
2124{
2125 unsigned long pixel;
2126
2127 if (STRINGP (value))
2128 pixel = x_decode_color (f, value, BLACK_PIX_DEFAULT (f));
2129 else
2130 pixel = -1;
2131
2132 if (f->output_data.x->scroll_bar_foreground_pixel != -1)
2133 unload_color (f, f->output_data.x->scroll_bar_foreground_pixel);
2134
2135 f->output_data.x->scroll_bar_foreground_pixel = pixel;
2136 if (FRAME_X_WINDOW (f) && FRAME_VISIBLE_P (f))
2137 {
2138 /* Remove all scroll bars because they have wrong colors. */
2139 if (condemn_scroll_bars_hook)
2140 (*condemn_scroll_bars_hook) (f);
2141 if (judge_scroll_bars_hook)
2142 (*judge_scroll_bars_hook) (f);
05c8abbe
GM
2143
2144 update_face_from_frame_parameter (f, Qscroll_bar_foreground, value);
333b20bb
GM
2145 redraw_frame (f);
2146 }
2147}
2148
2149
2150/* Set the background color for scroll bars on frame F to VALUE VALUE
2151 should be a string, a color name. If it isn't a string or isn't a
2152 valid color name, do nothing. OLDVAL is the old value of the frame
2153 parameter. */
2154
2155void
2156x_set_scroll_bar_background (f, value, oldval)
2157 struct frame *f;
2158 Lisp_Object value, oldval;
2159{
2160 unsigned long pixel;
2161
2162 if (STRINGP (value))
2163 pixel = x_decode_color (f, value, WHITE_PIX_DEFAULT (f));
2164 else
2165 pixel = -1;
2166
2167 if (f->output_data.x->scroll_bar_background_pixel != -1)
2168 unload_color (f, f->output_data.x->scroll_bar_background_pixel);
2169
2170 f->output_data.x->scroll_bar_background_pixel = pixel;
2171 if (FRAME_X_WINDOW (f) && FRAME_VISIBLE_P (f))
2172 {
2173 /* Remove all scroll bars because they have wrong colors. */
2174 if (condemn_scroll_bars_hook)
2175 (*condemn_scroll_bars_hook) (f);
2176 if (judge_scroll_bars_hook)
2177 (*judge_scroll_bars_hook) (f);
2178
05c8abbe 2179 update_face_from_frame_parameter (f, Qscroll_bar_background, value);
333b20bb
GM
2180 redraw_frame (f);
2181 }
d043f1a4 2182}
333b20bb 2183
943b580d 2184\f
3a258507 2185/* Encode Lisp string STRING as a text in a format appropriate for
96db09e4
KH
2186 XICCC (X Inter Client Communication Conventions).
2187
2188 If STRING contains only ASCII characters, do no conversion and
2189 return the string data of STRING. Otherwise, encode the text by
2190 CODING_SYSTEM, and return a newly allocated memory area which
2191 should be freed by `xfree' by a caller.
2192
2193 Store the byte length of resulting text in *TEXT_BYTES.
2194
d60660d6 2195 If the text contains only ASCII and Latin-1, store 1 in *STRING_P,
96db09e4 2196 which means that the `encoding' of the result can be `STRING'.
d60660d6 2197 Otherwise store 0 in *STRINGP, which means that the `encoding' of
96db09e4
KH
2198 the result should be `COMPOUND_TEXT'. */
2199
2200unsigned char *
d60660d6 2201x_encode_text (string, coding_system, text_bytes, stringp)
96db09e4 2202 Lisp_Object string, coding_system;
d60660d6 2203 int *text_bytes, *stringp;
96db09e4
KH
2204{
2205 unsigned char *str = XSTRING (string)->data;
2206 int chars = XSTRING (string)->size;
2207 int bytes = STRING_BYTES (XSTRING (string));
2208 int charset_info;
2209 int bufsize;
2210 unsigned char *buf;
2211 struct coding_system coding;
2212
2213 charset_info = find_charset_in_text (str, chars, bytes, NULL, Qnil);
2214 if (charset_info == 0)
2215 {
2216 /* No multibyte character in OBJ. We need not encode it. */
2217 *text_bytes = bytes;
d60660d6 2218 *stringp = 1;
96db09e4
KH
2219 return str;
2220 }
2221
2222 setup_coding_system (coding_system, &coding);
2223 coding.src_multibyte = 1;
2224 coding.dst_multibyte = 0;
2225 coding.mode |= CODING_MODE_LAST_BLOCK;
d60660d6
KH
2226 if (coding.type == coding_type_iso2022)
2227 coding.flags |= CODING_FLAG_ISO_SAFE;
35bc5887
KH
2228 /* We suppress producing escape sequences for composition. */
2229 coding.composing = COMPOSITION_DISABLED;
96db09e4
KH
2230 bufsize = encoding_buffer_size (&coding, bytes);
2231 buf = (unsigned char *) xmalloc (bufsize);
2232 encode_coding (&coding, str, buf, bytes, bufsize);
2233 *text_bytes = coding.produced;
d60660d6 2234 *stringp = (charset_info == 1 || !EQ (coding_system, Qcompound_text));
96db09e4
KH
2235 return buf;
2236}
2237
2238\f
75f9d625 2239/* Change the name of frame F to NAME. If NAME is nil, set F's name to
f945b920
JB
2240 x_id_name.
2241
2242 If EXPLICIT is non-zero, that indicates that lisp code is setting the
75f9d625
DM
2243 name; if NAME is a string, set F's name to NAME and set
2244 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
f945b920
JB
2245
2246 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2247 suggesting a new name, which lisp code should override; if
2248 F->explicit_name is set, ignore the new name; otherwise, set it. */
2249
2250void
2251x_set_name (f, name, explicit)
2252 struct frame *f;
2253 Lisp_Object name;
2254 int explicit;
2255{
2256 /* Make sure that requests from lisp code override requests from
2257 Emacs redisplay code. */
2258 if (explicit)
2259 {
2260 /* If we're switching from explicit to implicit, we had better
2261 update the mode lines and thereby update the title. */
2262 if (f->explicit_name && NILP (name))
cf177271 2263 update_mode_lines = 1;
f945b920
JB
2264
2265 f->explicit_name = ! NILP (name);
2266 }
2267 else if (f->explicit_name)
2268 return;
2269
2270 /* If NAME is nil, set the name to the x_id_name. */
2271 if (NILP (name))
f10f0b79
RS
2272 {
2273 /* Check for no change needed in this very common case
2274 before we do any consing. */
08a90d6a
RS
2275 if (!strcmp (FRAME_X_DISPLAY_INFO (f)->x_id_name,
2276 XSTRING (f->name)->data))
f10f0b79 2277 return;
08a90d6a 2278 name = build_string (FRAME_X_DISPLAY_INFO (f)->x_id_name);
f10f0b79 2279 }
62265f1c 2280 else
f945b920 2281 CHECK_STRING (name, 0);
01f1ba30 2282
f945b920
JB
2283 /* Don't change the name if it's already NAME. */
2284 if (! NILP (Fstring_equal (name, f->name)))
daa37602
JB
2285 return;
2286
943b580d
RS
2287 f->name = name;
2288
2289 /* For setting the frame title, the title parameter should override
2290 the name parameter. */
2291 if (! NILP (f->title))
2292 name = f->title;
2293
fe24a618 2294 if (FRAME_X_WINDOW (f))
01f1ba30 2295 {
01f1ba30 2296 BLOCK_INPUT;
fe24a618
JB
2297#ifdef HAVE_X11R4
2298 {
80534dd6 2299 XTextProperty text, icon;
d60660d6 2300 int bytes, stringp;
11270583 2301 Lisp_Object coding_system;
80534dd6 2302
11270583
KH
2303 coding_system = Vlocale_coding_system;
2304 if (NILP (coding_system))
2305 coding_system = Qcompound_text;
2306 text.value = x_encode_text (name, coding_system, &bytes, &stringp);
d60660d6 2307 text.encoding = (stringp ? XA_STRING
96db09e4 2308 : FRAME_X_DISPLAY_INFO (f)->Xatom_COMPOUND_TEXT);
fe24a618 2309 text.format = 8;
96db09e4 2310 text.nitems = bytes;
80534dd6 2311
96db09e4
KH
2312 if (NILP (f->icon_name))
2313 {
2314 icon = text;
2315 }
2316 else
2317 {
11270583 2318 icon.value = x_encode_text (f->icon_name, coding_system,
d60660d6
KH
2319 &bytes, &stringp);
2320 icon.encoding = (stringp ? XA_STRING
96db09e4
KH
2321 : FRAME_X_DISPLAY_INFO (f)->Xatom_COMPOUND_TEXT);
2322 icon.format = 8;
2323 icon.nitems = bytes;
2324 }
9ef48a9d 2325#ifdef USE_X_TOOLKIT
b9dc4443 2326 XSetWMName (FRAME_X_DISPLAY (f),
7556890b
RS
2327 XtWindow (f->output_data.x->widget), &text);
2328 XSetWMIconName (FRAME_X_DISPLAY (f), XtWindow (f->output_data.x->widget),
80534dd6 2329 &icon);
9ef48a9d 2330#else /* not USE_X_TOOLKIT */
b9dc4443 2331 XSetWMName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &text);
80534dd6 2332 XSetWMIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &icon);
9ef48a9d 2333#endif /* not USE_X_TOOLKIT */
96db09e4
KH
2334 if (!NILP (f->icon_name)
2335 && icon.value != XSTRING (f->icon_name)->data)
2336 xfree (icon.value);
2337 if (text.value != XSTRING (name)->data)
2338 xfree (text.value);
fe24a618 2339 }
9ef48a9d 2340#else /* not HAVE_X11R4 */
b9dc4443 2341 XSetIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
fe24a618 2342 XSTRING (name)->data);
b9dc4443 2343 XStoreName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
fe24a618 2344 XSTRING (name)->data);
9ef48a9d 2345#endif /* not HAVE_X11R4 */
01f1ba30
JB
2346 UNBLOCK_INPUT;
2347 }
f945b920
JB
2348}
2349
2350/* This function should be called when the user's lisp code has
2351 specified a name for the frame; the name will override any set by the
2352 redisplay code. */
2353void
2354x_explicitly_set_name (f, arg, oldval)
2355 FRAME_PTR f;
2356 Lisp_Object arg, oldval;
2357{
2358 x_set_name (f, arg, 1);
2359}
2360
2361/* This function should be called by Emacs redisplay code to set the
2362 name; names set this way will never override names set by the user's
2363 lisp code. */
25250031 2364void
f945b920
JB
2365x_implicitly_set_name (f, arg, oldval)
2366 FRAME_PTR f;
2367 Lisp_Object arg, oldval;
2368{
2369 x_set_name (f, arg, 0);
01f1ba30 2370}
943b580d
RS
2371\f
2372/* Change the title of frame F to NAME.
2373 If NAME is nil, use the frame name as the title.
01f1ba30 2374
943b580d
RS
2375 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2376 name; if NAME is a string, set F's name to NAME and set
2377 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2378
2379 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2380 suggesting a new name, which lisp code should override; if
2381 F->explicit_name is set, ignore the new name; otherwise, set it. */
2382
2383void
d62c8769 2384x_set_title (f, name, old_name)
943b580d 2385 struct frame *f;
d62c8769 2386 Lisp_Object name, old_name;
943b580d
RS
2387{
2388 /* Don't change the title if it's already NAME. */
2389 if (EQ (name, f->title))
2390 return;
2391
2392 update_mode_lines = 1;
2393
2394 f->title = name;
2395
2396 if (NILP (name))
2397 name = f->name;
beb403b3
RS
2398 else
2399 CHECK_STRING (name, 0);
943b580d
RS
2400
2401 if (FRAME_X_WINDOW (f))
2402 {
2403 BLOCK_INPUT;
2404#ifdef HAVE_X11R4
2405 {
2406 XTextProperty text, icon;
d60660d6 2407 int bytes, stringp;
11270583 2408 Lisp_Object coding_system;
943b580d 2409
11270583
KH
2410 coding_system = Vlocale_coding_system;
2411 if (NILP (coding_system))
2412 coding_system = Qcompound_text;
2413 text.value = x_encode_text (name, coding_system, &bytes, &stringp);
d60660d6 2414 text.encoding = (stringp ? XA_STRING
96db09e4 2415 : FRAME_X_DISPLAY_INFO (f)->Xatom_COMPOUND_TEXT);
943b580d 2416 text.format = 8;
96db09e4 2417 text.nitems = bytes;
943b580d 2418
96db09e4
KH
2419 if (NILP (f->icon_name))
2420 {
2421 icon = text;
2422 }
2423 else
2424 {
11270583 2425 icon.value = x_encode_text (f->icon_name, coding_system,
d60660d6
KH
2426 &bytes, &stringp);
2427 icon.encoding = (stringp ? XA_STRING
96db09e4
KH
2428 : FRAME_X_DISPLAY_INFO (f)->Xatom_COMPOUND_TEXT);
2429 icon.format = 8;
2430 icon.nitems = bytes;
2431 }
943b580d
RS
2432#ifdef USE_X_TOOLKIT
2433 XSetWMName (FRAME_X_DISPLAY (f),
2434 XtWindow (f->output_data.x->widget), &text);
2435 XSetWMIconName (FRAME_X_DISPLAY (f), XtWindow (f->output_data.x->widget),
2436 &icon);
2437#else /* not USE_X_TOOLKIT */
2438 XSetWMName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &text);
2439 XSetWMIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &icon);
2440#endif /* not USE_X_TOOLKIT */
96db09e4
KH
2441 if (!NILP (f->icon_name)
2442 && icon.value != XSTRING (f->icon_name)->data)
2443 xfree (icon.value);
2444 if (text.value != XSTRING (name)->data)
2445 xfree (text.value);
943b580d
RS
2446 }
2447#else /* not HAVE_X11R4 */
2448 XSetIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2449 XSTRING (name)->data);
2450 XStoreName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2451 XSTRING (name)->data);
2452#endif /* not HAVE_X11R4 */
2453 UNBLOCK_INPUT;
2454 }
2455}
2456\f
01f1ba30 2457void
f676886a
JB
2458x_set_autoraise (f, arg, oldval)
2459 struct frame *f;
01f1ba30
JB
2460 Lisp_Object arg, oldval;
2461{
f676886a 2462 f->auto_raise = !EQ (Qnil, arg);
01f1ba30
JB
2463}
2464
2465void
f676886a
JB
2466x_set_autolower (f, arg, oldval)
2467 struct frame *f;
01f1ba30
JB
2468 Lisp_Object arg, oldval;
2469{
f676886a 2470 f->auto_lower = !EQ (Qnil, arg);
01f1ba30 2471}
179956b9 2472
eac358ef
KH
2473void
2474x_set_unsplittable (f, arg, oldval)
2475 struct frame *f;
2476 Lisp_Object arg, oldval;
2477{
2478 f->no_split = !NILP (arg);
2479}
2480
179956b9 2481void
a3c87d4e 2482x_set_vertical_scroll_bars (f, arg, oldval)
179956b9
JB
2483 struct frame *f;
2484 Lisp_Object arg, oldval;
2485{
1ab3d87e
RS
2486 if ((EQ (arg, Qleft) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f))
2487 || (EQ (arg, Qright) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f))
2488 || (NILP (arg) && FRAME_HAS_VERTICAL_SCROLL_BARS (f))
2489 || (!NILP (arg) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f)))
179956b9 2490 {
1ab3d87e
RS
2491 FRAME_VERTICAL_SCROLL_BAR_TYPE (f)
2492 = (NILP (arg)
2493 ? vertical_scroll_bar_none
2494 : EQ (Qright, arg)
2495 ? vertical_scroll_bar_right
2496 : vertical_scroll_bar_left);
179956b9 2497
cf177271
JB
2498 /* We set this parameter before creating the X window for the
2499 frame, so we can get the geometry right from the start.
2500 However, if the window hasn't been created yet, we shouldn't
2501 call x_set_window_size. */
2502 if (FRAME_X_WINDOW (f))
363f7e15 2503 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
8938a4fb 2504 do_pending_window_change (0);
179956b9
JB
2505 }
2506}
4701395c
KH
2507
2508void
2509x_set_scroll_bar_width (f, arg, oldval)
2510 struct frame *f;
2511 Lisp_Object arg, oldval;
2512{
a672c74d
RS
2513 int wid = FONT_WIDTH (f->output_data.x->font);
2514
dff9a538
KH
2515 if (NILP (arg))
2516 {
c6e9d03b
GM
2517#ifdef USE_TOOLKIT_SCROLL_BARS
2518 /* A minimum width of 14 doesn't look good for toolkit scroll bars. */
333b20bb
GM
2519 int width = 16 + 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM;
2520 FRAME_SCROLL_BAR_COLS (f) = (width + wid - 1) / wid;
2521 FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = width;
2522#else
2523 /* Make the actual width at least 14 pixels and a multiple of a
2524 character width. */
a672c74d 2525 FRAME_SCROLL_BAR_COLS (f) = (14 + wid - 1) / wid;
333b20bb
GM
2526
2527 /* Use all of that space (aside from required margins) for the
2528 scroll bar. */
dff9a538 2529 FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = 0;
333b20bb 2530#endif
a672c74d 2531
a90ab372
RS
2532 if (FRAME_X_WINDOW (f))
2533 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
8938a4fb 2534 do_pending_window_change (0);
dff9a538
KH
2535 }
2536 else if (INTEGERP (arg) && XINT (arg) > 0
2537 && XFASTINT (arg) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f))
4701395c 2538 {
09d8c7ac
RS
2539 if (XFASTINT (arg) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM)
2540 XSETINT (arg, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM + 1);
0a26b136 2541
4701395c
KH
2542 FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = XFASTINT (arg);
2543 FRAME_SCROLL_BAR_COLS (f) = (XFASTINT (arg) + wid-1) / wid;
2544 if (FRAME_X_WINDOW (f))
2545 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
2546 }
dca97592 2547
8938a4fb 2548 change_frame_size (f, 0, FRAME_WIDTH (f), 0, 0, 0);
333b20bb
GM
2549 XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.hpos = 0;
2550 XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.x = 0;
4701395c 2551}
333b20bb
GM
2552
2553
01f1ba30 2554\f
f676886a 2555/* Subroutines of creating an X frame. */
01f1ba30 2556
b7975ee4
KH
2557/* Make sure that Vx_resource_name is set to a reasonable value.
2558 Fix it up, or set it to `emacs' if it is too hopeless. */
2559
d387c960
JB
2560static void
2561validate_x_resource_name ()
2562{
333b20bb 2563 int len = 0;
0e78b377
RS
2564 /* Number of valid characters in the resource name. */
2565 int good_count = 0;
2566 /* Number of invalid characters in the resource name. */
2567 int bad_count = 0;
2568 Lisp_Object new;
2569 int i;
2570
498e9ac3
RS
2571 if (!STRINGP (Vx_resource_class))
2572 Vx_resource_class = build_string (EMACS_CLASS);
2573
cf204347
RS
2574 if (STRINGP (Vx_resource_name))
2575 {
cf204347
RS
2576 unsigned char *p = XSTRING (Vx_resource_name)->data;
2577 int i;
2578
fc932ac6 2579 len = STRING_BYTES (XSTRING (Vx_resource_name));
0e78b377
RS
2580
2581 /* Only letters, digits, - and _ are valid in resource names.
2582 Count the valid characters and count the invalid ones. */
cf204347
RS
2583 for (i = 0; i < len; i++)
2584 {
2585 int c = p[i];
2586 if (! ((c >= 'a' && c <= 'z')
2587 || (c >= 'A' && c <= 'Z')
2588 || (c >= '0' && c <= '9')
2589 || c == '-' || c == '_'))
0e78b377
RS
2590 bad_count++;
2591 else
2592 good_count++;
cf204347
RS
2593 }
2594 }
2595 else
0e78b377
RS
2596 /* Not a string => completely invalid. */
2597 bad_count = 5, good_count = 0;
2598
2599 /* If name is valid already, return. */
2600 if (bad_count == 0)
2601 return;
2602
2603 /* If name is entirely invalid, or nearly so, use `emacs'. */
2604 if (good_count == 0
2605 || (good_count == 1 && bad_count > 0))
2606 {
b7975ee4 2607 Vx_resource_name = build_string ("emacs");
0e78b377
RS
2608 return;
2609 }
2610
2611 /* Name is partly valid. Copy it and replace the invalid characters
2612 with underscores. */
2613
2614 Vx_resource_name = new = Fcopy_sequence (Vx_resource_name);
2615
2616 for (i = 0; i < len; i++)
2617 {
2618 int c = XSTRING (new)->data[i];
2619 if (! ((c >= 'a' && c <= 'z')
2620 || (c >= 'A' && c <= 'Z')
2621 || (c >= '0' && c <= '9')
2622 || c == '-' || c == '_'))
2623 XSTRING (new)->data[i] = '_';
2624 }
d387c960
JB
2625}
2626
2627
01f1ba30 2628extern char *x_get_string_resource ();
01f1ba30 2629
cf177271
JB
2630DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 2, 4, 0,
2631 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
287e500d 2632This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
d387c960
JB
2633class, where INSTANCE is the name under which Emacs was invoked, or\n\
2634the name specified by the `-name' or `-rn' command-line arguments.\n\
01f1ba30 2635\n\
8fabe6f4
RS
2636The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
2637class, respectively. You must specify both of them or neither.\n\
287e500d
RS
2638If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
2639and the class is `Emacs.CLASS.SUBCLASS'.")
cf177271
JB
2640 (attribute, class, component, subclass)
2641 Lisp_Object attribute, class, component, subclass;
01f1ba30
JB
2642{
2643 register char *value;
2644 char *name_key;
2645 char *class_key;
2646
11ae94fe
RS
2647 check_x ();
2648
01f1ba30 2649 CHECK_STRING (attribute, 0);
cf177271
JB
2650 CHECK_STRING (class, 0);
2651
8fabe6f4
RS
2652 if (!NILP (component))
2653 CHECK_STRING (component, 1);
2654 if (!NILP (subclass))
2655 CHECK_STRING (subclass, 2);
2656 if (NILP (component) != NILP (subclass))
2657 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2658
d387c960
JB
2659 validate_x_resource_name ();
2660
b7975ee4
KH
2661 /* Allocate space for the components, the dots which separate them,
2662 and the final '\0'. Make them big enough for the worst case. */
fc932ac6 2663 name_key = (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name))
b7975ee4 2664 + (STRINGP (component)
fc932ac6
RS
2665 ? STRING_BYTES (XSTRING (component)) : 0)
2666 + STRING_BYTES (XSTRING (attribute))
b7975ee4
KH
2667 + 3);
2668
fc932ac6
RS
2669 class_key = (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class))
2670 + STRING_BYTES (XSTRING (class))
b7975ee4 2671 + (STRINGP (subclass)
fc932ac6 2672 ? STRING_BYTES (XSTRING (subclass)) : 0)
b7975ee4
KH
2673 + 3);
2674
2675 /* Start with emacs.FRAMENAME for the name (the specific one)
2676 and with `Emacs' for the class key (the general one). */
2677 strcpy (name_key, XSTRING (Vx_resource_name)->data);
498e9ac3 2678 strcpy (class_key, XSTRING (Vx_resource_class)->data);
b7975ee4
KH
2679
2680 strcat (class_key, ".");
2681 strcat (class_key, XSTRING (class)->data);
2682
2683 if (!NILP (component))
01f1ba30 2684 {
b7975ee4
KH
2685 strcat (class_key, ".");
2686 strcat (class_key, XSTRING (subclass)->data);
2687
2688 strcat (name_key, ".");
2689 strcat (name_key, XSTRING (component)->data);
01f1ba30
JB
2690 }
2691
b7975ee4
KH
2692 strcat (name_key, ".");
2693 strcat (name_key, XSTRING (attribute)->data);
2694
b9dc4443
RS
2695 value = x_get_string_resource (check_x_display_info (Qnil)->xrdb,
2696 name_key, class_key);
01f1ba30
JB
2697
2698 if (value != (char *) 0)
2699 return build_string (value);
2700 else
2701 return Qnil;
2702}
2703
abb4b7ec
RS
2704/* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
2705
333b20bb 2706Lisp_Object
abb4b7ec
RS
2707display_x_get_resource (dpyinfo, attribute, class, component, subclass)
2708 struct x_display_info *dpyinfo;
2709 Lisp_Object attribute, class, component, subclass;
2710{
2711 register char *value;
2712 char *name_key;
2713 char *class_key;
2714
abb4b7ec
RS
2715 CHECK_STRING (attribute, 0);
2716 CHECK_STRING (class, 0);
2717
2718 if (!NILP (component))
2719 CHECK_STRING (component, 1);
2720 if (!NILP (subclass))
2721 CHECK_STRING (subclass, 2);
2722 if (NILP (component) != NILP (subclass))
2723 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2724
2725 validate_x_resource_name ();
2726
2727 /* Allocate space for the components, the dots which separate them,
2728 and the final '\0'. Make them big enough for the worst case. */
fc932ac6 2729 name_key = (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name))
abb4b7ec 2730 + (STRINGP (component)
fc932ac6
RS
2731 ? STRING_BYTES (XSTRING (component)) : 0)
2732 + STRING_BYTES (XSTRING (attribute))
abb4b7ec
RS
2733 + 3);
2734
fc932ac6
RS
2735 class_key = (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class))
2736 + STRING_BYTES (XSTRING (class))
abb4b7ec 2737 + (STRINGP (subclass)
fc932ac6 2738 ? STRING_BYTES (XSTRING (subclass)) : 0)
abb4b7ec
RS
2739 + 3);
2740
2741 /* Start with emacs.FRAMENAME for the name (the specific one)
2742 and with `Emacs' for the class key (the general one). */
2743 strcpy (name_key, XSTRING (Vx_resource_name)->data);
2744 strcpy (class_key, XSTRING (Vx_resource_class)->data);
2745
2746 strcat (class_key, ".");
2747 strcat (class_key, XSTRING (class)->data);
2748
2749 if (!NILP (component))
2750 {
2751 strcat (class_key, ".");
2752 strcat (class_key, XSTRING (subclass)->data);
2753
2754 strcat (name_key, ".");
2755 strcat (name_key, XSTRING (component)->data);
2756 }
2757
2758 strcat (name_key, ".");
2759 strcat (name_key, XSTRING (attribute)->data);
2760
2761 value = x_get_string_resource (dpyinfo->xrdb, name_key, class_key);
2762
2763 if (value != (char *) 0)
2764 return build_string (value);
2765 else
2766 return Qnil;
2767}
2768
3402e1a4
RS
2769/* Used when C code wants a resource value. */
2770
2771char *
2772x_get_resource_string (attribute, class)
2773 char *attribute, *class;
2774{
3402e1a4
RS
2775 char *name_key;
2776 char *class_key;
0fe92f72 2777 struct frame *sf = SELECTED_FRAME ();
3402e1a4
RS
2778
2779 /* Allocate space for the components, the dots which separate them,
2780 and the final '\0'. */
fc932ac6 2781 name_key = (char *) alloca (STRING_BYTES (XSTRING (Vinvocation_name))
3402e1a4
RS
2782 + strlen (attribute) + 2);
2783 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
2784 + strlen (class) + 2);
2785
2786 sprintf (name_key, "%s.%s",
2787 XSTRING (Vinvocation_name)->data,
2788 attribute);
2789 sprintf (class_key, "%s.%s", EMACS_CLASS, class);
2790
0fe92f72 2791 return x_get_string_resource (FRAME_X_DISPLAY_INFO (sf)->xrdb,
b9dc4443 2792 name_key, class_key);
3402e1a4
RS
2793}
2794
60fb3ee1
JB
2795/* Types we might convert a resource string into. */
2796enum resource_types
333b20bb
GM
2797{
2798 RES_TYPE_NUMBER,
d62c8769 2799 RES_TYPE_FLOAT,
333b20bb
GM
2800 RES_TYPE_BOOLEAN,
2801 RES_TYPE_STRING,
2802 RES_TYPE_SYMBOL
2803};
60fb3ee1 2804
01f1ba30 2805/* Return the value of parameter PARAM.
60fb3ee1 2806
f676886a 2807 First search ALIST, then Vdefault_frame_alist, then the X defaults
cf177271 2808 database, using ATTRIBUTE as the attribute name and CLASS as its class.
60fb3ee1
JB
2809
2810 Convert the resource to the type specified by desired_type.
2811
f9942c9e
JB
2812 If no default is specified, return Qunbound. If you call
2813 x_get_arg, make sure you deal with Qunbound in a reasonable way,
a59e4f3d 2814 and don't let it get stored in any Lisp-visible variables! */
01f1ba30
JB
2815
2816static Lisp_Object
abb4b7ec
RS
2817x_get_arg (dpyinfo, alist, param, attribute, class, type)
2818 struct x_display_info *dpyinfo;
3c254570 2819 Lisp_Object alist, param;
60fb3ee1 2820 char *attribute;
cf177271 2821 char *class;
60fb3ee1 2822 enum resource_types type;
01f1ba30
JB
2823{
2824 register Lisp_Object tem;
2825
2826 tem = Fassq (param, alist);
2827 if (EQ (tem, Qnil))
f676886a 2828 tem = Fassq (param, Vdefault_frame_alist);
f9942c9e 2829 if (EQ (tem, Qnil))
01f1ba30 2830 {
60fb3ee1 2831
f9942c9e 2832 if (attribute)
60fb3ee1 2833 {
abb4b7ec
RS
2834 tem = display_x_get_resource (dpyinfo,
2835 build_string (attribute),
2836 build_string (class),
2837 Qnil, Qnil);
f9942c9e
JB
2838
2839 if (NILP (tem))
2840 return Qunbound;
2841
2842 switch (type)
2843 {
333b20bb 2844 case RES_TYPE_NUMBER:
f9942c9e
JB
2845 return make_number (atoi (XSTRING (tem)->data));
2846
d62c8769
GM
2847 case RES_TYPE_FLOAT:
2848 return make_float (atof (XSTRING (tem)->data));
2849
333b20bb 2850 case RES_TYPE_BOOLEAN:
f9942c9e
JB
2851 tem = Fdowncase (tem);
2852 if (!strcmp (XSTRING (tem)->data, "on")
2853 || !strcmp (XSTRING (tem)->data, "true"))
2854 return Qt;
2855 else
2856 return Qnil;
2857
333b20bb 2858 case RES_TYPE_STRING:
f9942c9e
JB
2859 return tem;
2860
333b20bb 2861 case RES_TYPE_SYMBOL:
49795535
JB
2862 /* As a special case, we map the values `true' and `on'
2863 to Qt, and `false' and `off' to Qnil. */
2864 {
98381190
KH
2865 Lisp_Object lower;
2866 lower = Fdowncase (tem);
26ae6b61
KH
2867 if (!strcmp (XSTRING (lower)->data, "on")
2868 || !strcmp (XSTRING (lower)->data, "true"))
49795535 2869 return Qt;
26ae6b61
KH
2870 else if (!strcmp (XSTRING (lower)->data, "off")
2871 || !strcmp (XSTRING (lower)->data, "false"))
49795535
JB
2872 return Qnil;
2873 else
89032215 2874 return Fintern (tem, Qnil);
49795535 2875 }
f945b920 2876
f9942c9e
JB
2877 default:
2878 abort ();
2879 }
60fb3ee1 2880 }
f9942c9e
JB
2881 else
2882 return Qunbound;
01f1ba30
JB
2883 }
2884 return Fcdr (tem);
2885}
2886
e4f79258
RS
2887/* Like x_get_arg, but also record the value in f->param_alist. */
2888
2889static Lisp_Object
2890x_get_and_record_arg (f, alist, param, attribute, class, type)
2891 struct frame *f;
2892 Lisp_Object alist, param;
2893 char *attribute;
2894 char *class;
2895 enum resource_types type;
2896{
2897 Lisp_Object value;
2898
abb4b7ec
RS
2899 value = x_get_arg (FRAME_X_DISPLAY_INFO (f), alist, param,
2900 attribute, class, type);
e4f79258
RS
2901 if (! NILP (value))
2902 store_frame_param (f, param, value);
2903
2904 return value;
2905}
2906
f676886a 2907/* Record in frame F the specified or default value according to ALIST
e8cc313b
KH
2908 of the parameter named PROP (a Lisp symbol).
2909 If no value is specified for PROP, look for an X default for XPROP
f676886a 2910 on the frame named NAME.
01f1ba30
JB
2911 If that is not found either, use the value DEFLT. */
2912
2913static Lisp_Object
cf177271 2914x_default_parameter (f, alist, prop, deflt, xprop, xclass, type)
f676886a 2915 struct frame *f;
01f1ba30 2916 Lisp_Object alist;
f9942c9e 2917 Lisp_Object prop;
01f1ba30
JB
2918 Lisp_Object deflt;
2919 char *xprop;
cf177271 2920 char *xclass;
60fb3ee1 2921 enum resource_types type;
01f1ba30 2922{
01f1ba30
JB
2923 Lisp_Object tem;
2924
abb4b7ec 2925 tem = x_get_arg (FRAME_X_DISPLAY_INFO (f), alist, prop, xprop, xclass, type);
f9942c9e 2926 if (EQ (tem, Qunbound))
01f1ba30 2927 tem = deflt;
f9942c9e 2928 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
01f1ba30
JB
2929 return tem;
2930}
333b20bb
GM
2931
2932
2933/* Record in frame F the specified or default value according to ALIST
2934 of the parameter named PROP (a Lisp symbol). If no value is
2935 specified for PROP, look for an X default for XPROP on the frame
2936 named NAME. If that is not found either, use the value DEFLT. */
2937
2938static Lisp_Object
2939x_default_scroll_bar_color_parameter (f, alist, prop, xprop, xclass,
2940 foreground_p)
2941 struct frame *f;
2942 Lisp_Object alist;
2943 Lisp_Object prop;
2944 char *xprop;
2945 char *xclass;
2946 int foreground_p;
2947{
2948 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
2949 Lisp_Object tem;
2950
2951 tem = x_get_arg (dpyinfo, alist, prop, xprop, xclass, RES_TYPE_STRING);
2952 if (EQ (tem, Qunbound))
2953 {
2954#ifdef USE_TOOLKIT_SCROLL_BARS
2955
2956 /* See if an X resource for the scroll bar color has been
2957 specified. */
2958 tem = display_x_get_resource (dpyinfo,
2959 build_string (foreground_p
2960 ? "foreground"
2961 : "background"),
2962 build_string (""),
2963 build_string ("verticalScrollBar"),
2964 build_string (""));
2965 if (!STRINGP (tem))
2966 {
2967 /* If nothing has been specified, scroll bars will use a
2968 toolkit-dependent default. Because these defaults are
2969 difficult to get at without actually creating a scroll
2970 bar, use nil to indicate that no color has been
2971 specified. */
2972 tem = Qnil;
2973 }
2974
2975#else /* not USE_TOOLKIT_SCROLL_BARS */
2976
2977 tem = Qnil;
2978
2979#endif /* not USE_TOOLKIT_SCROLL_BARS */
2980 }
2981
2982 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
2983 return tem;
2984}
2985
2986
01f1ba30 2987\f
8af1d7ca 2988DEFUN ("x-parse-geometry", Fx_parse_geometry, Sx_parse_geometry, 1, 1, 0,
01f1ba30 2989 "Parse an X-style geometry string STRING.\n\
f83f10ba
RS
2990Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
2991The properties returned may include `top', `left', `height', and `width'.\n\
e1d962d7
RS
2992The value of `left' or `top' may be an integer,\n\
2993or a list (+ N) meaning N pixels relative to top/left corner,\n\
2994or a list (- N) meaning -N pixels relative to bottom/right corner.")
01f1ba30 2995 (string)
a6605e5c 2996 Lisp_Object string;
01f1ba30
JB
2997{
2998 int geometry, x, y;
2999 unsigned int width, height;
f83f10ba 3000 Lisp_Object result;
01f1ba30
JB
3001
3002 CHECK_STRING (string, 0);
3003
3004 geometry = XParseGeometry ((char *) XSTRING (string)->data,
3005 &x, &y, &width, &height);
3006
f83f10ba
RS
3007#if 0
3008 if (!!(geometry & XValue) != !!(geometry & YValue))
3009 error ("Must specify both x and y position, or neither");
3010#endif
3011
3012 result = Qnil;
3013 if (geometry & XValue)
01f1ba30 3014 {
f83f10ba
RS
3015 Lisp_Object element;
3016
e1d962d7
RS
3017 if (x >= 0 && (geometry & XNegative))
3018 element = Fcons (Qleft, Fcons (Qminus, Fcons (make_number (-x), Qnil)));
3019 else if (x < 0 && ! (geometry & XNegative))
3020 element = Fcons (Qleft, Fcons (Qplus, Fcons (make_number (x), Qnil)));
f83f10ba
RS
3021 else
3022 element = Fcons (Qleft, make_number (x));
3023 result = Fcons (element, result);
3024 }
3025
3026 if (geometry & YValue)
3027 {
3028 Lisp_Object element;
3029
e1d962d7
RS
3030 if (y >= 0 && (geometry & YNegative))
3031 element = Fcons (Qtop, Fcons (Qminus, Fcons (make_number (-y), Qnil)));
3032 else if (y < 0 && ! (geometry & YNegative))
3033 element = Fcons (Qtop, Fcons (Qplus, Fcons (make_number (y), Qnil)));
f83f10ba
RS
3034 else
3035 element = Fcons (Qtop, make_number (y));
3036 result = Fcons (element, result);
01f1ba30 3037 }
f83f10ba
RS
3038
3039 if (geometry & WidthValue)
3040 result = Fcons (Fcons (Qwidth, make_number (width)), result);
3041 if (geometry & HeightValue)
3042 result = Fcons (Fcons (Qheight, make_number (height)), result);
3043
3044 return result;
01f1ba30
JB
3045}
3046
01f1ba30 3047/* Calculate the desired size and position of this window,
f83f10ba 3048 and return the flags saying which aspects were specified.
8fc2766b
RS
3049
3050 This function does not make the coordinates positive. */
01f1ba30
JB
3051
3052#define DEFAULT_ROWS 40
3053#define DEFAULT_COLS 80
3054
f9942c9e 3055static int
f676886a
JB
3056x_figure_window_size (f, parms)
3057 struct frame *f;
01f1ba30
JB
3058 Lisp_Object parms;
3059{
4fe1de12 3060 register Lisp_Object tem0, tem1, tem2;
01f1ba30 3061 long window_prompting = 0;
abb4b7ec 3062 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
01f1ba30
JB
3063
3064 /* Default values if we fall through.
3065 Actually, if that happens we should get
b9dc4443 3066 window manager prompting. */
1ab3d87e 3067 SET_FRAME_WIDTH (f, DEFAULT_COLS);
f676886a 3068 f->height = DEFAULT_ROWS;
bd0b85c3
RS
3069 /* Window managers expect that if program-specified
3070 positions are not (0,0), they're intentional, not defaults. */
7556890b
RS
3071 f->output_data.x->top_pos = 0;
3072 f->output_data.x->left_pos = 0;
01f1ba30 3073
333b20bb
GM
3074 tem0 = x_get_arg (dpyinfo, parms, Qheight, 0, 0, RES_TYPE_NUMBER);
3075 tem1 = x_get_arg (dpyinfo, parms, Qwidth, 0, 0, RES_TYPE_NUMBER);
3076 tem2 = x_get_arg (dpyinfo, parms, Quser_size, 0, 0, RES_TYPE_NUMBER);
f83f10ba 3077 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
01f1ba30 3078 {
f83f10ba
RS
3079 if (!EQ (tem0, Qunbound))
3080 {
3081 CHECK_NUMBER (tem0, 0);
3082 f->height = XINT (tem0);
3083 }
3084 if (!EQ (tem1, Qunbound))
3085 {
3086 CHECK_NUMBER (tem1, 0);
1ab3d87e 3087 SET_FRAME_WIDTH (f, XINT (tem1));
f83f10ba
RS
3088 }
3089 if (!NILP (tem2) && !EQ (tem2, Qunbound))
4fe1de12
RS
3090 window_prompting |= USSize;
3091 else
3092 window_prompting |= PSize;
01f1ba30 3093 }
01f1ba30 3094
7556890b 3095 f->output_data.x->vertical_scroll_bar_extra
a444c70b
KH
3096 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f)
3097 ? 0
7556890b 3098 : (FRAME_SCROLL_BAR_COLS (f) * FONT_WIDTH (f->output_data.x->font)));
333b20bb 3099 f->output_data.x->flags_areas_extra
fb5ec9ce 3100 = FRAME_FLAGS_AREA_WIDTH (f);
7556890b
RS
3101 f->output_data.x->pixel_width = CHAR_TO_PIXEL_WIDTH (f, f->width);
3102 f->output_data.x->pixel_height = CHAR_TO_PIXEL_HEIGHT (f, f->height);
01f1ba30 3103
333b20bb
GM
3104 tem0 = x_get_arg (dpyinfo, parms, Qtop, 0, 0, RES_TYPE_NUMBER);
3105 tem1 = x_get_arg (dpyinfo, parms, Qleft, 0, 0, RES_TYPE_NUMBER);
3106 tem2 = x_get_arg (dpyinfo, parms, Quser_position, 0, 0, RES_TYPE_NUMBER);
f83f10ba 3107 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
01f1ba30 3108 {
f83f10ba
RS
3109 if (EQ (tem0, Qminus))
3110 {
7556890b 3111 f->output_data.x->top_pos = 0;
f83f10ba
RS
3112 window_prompting |= YNegative;
3113 }
8e713be6
KR
3114 else if (CONSP (tem0) && EQ (XCAR (tem0), Qminus)
3115 && CONSP (XCDR (tem0))
3116 && INTEGERP (XCAR (XCDR (tem0))))
e1d962d7 3117 {
8e713be6 3118 f->output_data.x->top_pos = - XINT (XCAR (XCDR (tem0)));
e1d962d7
RS
3119 window_prompting |= YNegative;
3120 }
8e713be6
KR
3121 else if (CONSP (tem0) && EQ (XCAR (tem0), Qplus)
3122 && CONSP (XCDR (tem0))
3123 && INTEGERP (XCAR (XCDR (tem0))))
e1d962d7 3124 {
8e713be6 3125 f->output_data.x->top_pos = XINT (XCAR (XCDR (tem0)));
e1d962d7 3126 }
f83f10ba 3127 else if (EQ (tem0, Qunbound))
7556890b 3128 f->output_data.x->top_pos = 0;
f83f10ba
RS
3129 else
3130 {
3131 CHECK_NUMBER (tem0, 0);
7556890b
RS
3132 f->output_data.x->top_pos = XINT (tem0);
3133 if (f->output_data.x->top_pos < 0)
f83f10ba
RS
3134 window_prompting |= YNegative;
3135 }
3136
3137 if (EQ (tem1, Qminus))
3138 {
7556890b 3139 f->output_data.x->left_pos = 0;
f83f10ba
RS
3140 window_prompting |= XNegative;
3141 }
8e713be6
KR
3142 else if (CONSP (tem1) && EQ (XCAR (tem1), Qminus)
3143 && CONSP (XCDR (tem1))
3144 && INTEGERP (XCAR (XCDR (tem1))))
e1d962d7 3145 {
8e713be6 3146 f->output_data.x->left_pos = - XINT (XCAR (XCDR (tem1)));
e1d962d7
RS
3147 window_prompting |= XNegative;
3148 }
8e713be6
KR
3149 else if (CONSP (tem1) && EQ (XCAR (tem1), Qplus)
3150 && CONSP (XCDR (tem1))
3151 && INTEGERP (XCAR (XCDR (tem1))))
e1d962d7 3152 {
8e713be6 3153 f->output_data.x->left_pos = XINT (XCAR (XCDR (tem1)));
e1d962d7 3154 }
f83f10ba 3155 else if (EQ (tem1, Qunbound))
7556890b 3156 f->output_data.x->left_pos = 0;
f83f10ba
RS
3157 else
3158 {
3159 CHECK_NUMBER (tem1, 0);
7556890b
RS
3160 f->output_data.x->left_pos = XINT (tem1);
3161 if (f->output_data.x->left_pos < 0)
f83f10ba
RS
3162 window_prompting |= XNegative;
3163 }
3164
c3724dc2 3165 if (!NILP (tem2) && ! EQ (tem2, Qunbound))
4fe1de12
RS
3166 window_prompting |= USPosition;
3167 else
3168 window_prompting |= PPosition;
01f1ba30 3169 }
f83f10ba 3170
739f2f53 3171 return window_prompting;
01f1ba30
JB
3172}
3173
f58534a3
RS
3174#if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
3175
3176Status
3177XSetWMProtocols (dpy, w, protocols, count)
3178 Display *dpy;
3179 Window w;
3180 Atom *protocols;
3181 int count;
3182{
3183 Atom prop;
3184 prop = XInternAtom (dpy, "WM_PROTOCOLS", False);
3185 if (prop == None) return False;
3186 XChangeProperty (dpy, w, prop, XA_ATOM, 32, PropModeReplace,
3187 (unsigned char *) protocols, count);
3188 return True;
3189}
9ef48a9d
RS
3190#endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
3191\f
3192#ifdef USE_X_TOOLKIT
3193
8e3d10a9
RS
3194/* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS,
3195 WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
59aa6c90
RS
3196 already be present because of the toolkit (Motif adds some of them,
3197 for example, but Xt doesn't). */
9ef48a9d
RS
3198
3199static void
b9dc4443
RS
3200hack_wm_protocols (f, widget)
3201 FRAME_PTR f;
9ef48a9d
RS
3202 Widget widget;
3203{
3204 Display *dpy = XtDisplay (widget);
3205 Window w = XtWindow (widget);
3206 int need_delete = 1;
3207 int need_focus = 1;
59aa6c90 3208 int need_save = 1;
9ef48a9d
RS
3209
3210 BLOCK_INPUT;
3211 {
3212 Atom type, *atoms = 0;
3213 int format = 0;
3214 unsigned long nitems = 0;
3215 unsigned long bytes_after;
3216
270958e8
KH
3217 if ((XGetWindowProperty (dpy, w,
3218 FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
34d5ae1e 3219 (long)0, (long)100, False, XA_ATOM,
270958e8
KH
3220 &type, &format, &nitems, &bytes_after,
3221 (unsigned char **) &atoms)
3222 == Success)
9ef48a9d
RS
3223 && format == 32 && type == XA_ATOM)
3224 while (nitems > 0)
3225 {
3226 nitems--;
b9dc4443
RS
3227 if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window)
3228 need_delete = 0;
3229 else if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_take_focus)
3230 need_focus = 0;
3231 else if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself)
3232 need_save = 0;
9ef48a9d
RS
3233 }
3234 if (atoms) XFree ((char *) atoms);
3235 }
3236 {
3237 Atom props [10];
3238 int count = 0;
b9dc4443
RS
3239 if (need_delete)
3240 props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window;
3241 if (need_focus)
3242 props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_take_focus;
3243 if (need_save)
3244 props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself;
9ef48a9d 3245 if (count)
b9dc4443
RS
3246 XChangeProperty (dpy, w, FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
3247 XA_ATOM, 32, PropModeAppend,
9ef48a9d
RS
3248 (unsigned char *) props, count);
3249 }
3250 UNBLOCK_INPUT;
3251}
3252#endif
86779fac
GM
3253
3254
5a7df7d7
GM
3255\f
3256/* Support routines for XIC (X Input Context). */
86779fac 3257
5a7df7d7
GM
3258#ifdef HAVE_X_I18N
3259
3260static XFontSet xic_create_xfontset P_ ((struct frame *, char *));
3261static XIMStyle best_xim_style P_ ((XIMStyles *, XIMStyles *));
3262
3263
3264/* Supported XIM styles, ordered by preferenc. */
3265
3266static XIMStyle supported_xim_styles[] =
3267{
3268 XIMPreeditPosition | XIMStatusArea,
3269 XIMPreeditPosition | XIMStatusNothing,
3270 XIMPreeditPosition | XIMStatusNone,
3271 XIMPreeditNothing | XIMStatusArea,
3272 XIMPreeditNothing | XIMStatusNothing,
3273 XIMPreeditNothing | XIMStatusNone,
3274 XIMPreeditNone | XIMStatusArea,
3275 XIMPreeditNone | XIMStatusNothing,
3276 XIMPreeditNone | XIMStatusNone,
3277 0,
3278};
3279
3280
3281/* Create an X fontset on frame F with base font name
3282 BASE_FONTNAME.. */
3283
3284static XFontSet
3285xic_create_xfontset (f, base_fontname)
86779fac 3286 struct frame *f;
5a7df7d7 3287 char *base_fontname;
86779fac 3288{
5a7df7d7
GM
3289 XFontSet xfs;
3290 char **missing_list;
3291 int missing_count;
3292 char *def_string;
86779fac 3293
5a7df7d7
GM
3294 xfs = XCreateFontSet (FRAME_X_DISPLAY (f),
3295 base_fontname, &missing_list,
3296 &missing_count, &def_string);
3297 if (missing_list)
3298 XFreeStringList (missing_list);
3299
3300 /* No need to free def_string. */
3301 return xfs;
3302}
3303
3304
3305/* Value is the best input style, given user preferences USER (already
3306 checked to be supported by Emacs), and styles supported by the
3307 input method XIM. */
3308
3309static XIMStyle
3310best_xim_style (user, xim)
3311 XIMStyles *user;
3312 XIMStyles *xim;
3313{
3314 int i, j;
3315
3316 for (i = 0; i < user->count_styles; ++i)
3317 for (j = 0; j < xim->count_styles; ++j)
3318 if (user->supported_styles[i] == xim->supported_styles[j])
3319 return user->supported_styles[i];
3320
3321 /* Return the default style. */
3322 return XIMPreeditNothing | XIMStatusNothing;
3323}
3324
3325/* Create XIC for frame F. */
3326
5df79d3d
GM
3327static XIMStyle xic_style;
3328
5a7df7d7
GM
3329void
3330create_frame_xic (f)
3331 struct frame *f;
3332{
5a7df7d7
GM
3333 XIM xim;
3334 XIC xic = NULL;
3335 XFontSet xfs = NULL;
86779fac 3336
5a7df7d7
GM
3337 if (FRAME_XIC (f))
3338 return;
3339
3340 xim = FRAME_X_XIM (f);
3341 if (xim)
3342 {
d9d57cb2
DL
3343 XRectangle s_area;
3344 XPoint spot;
5a7df7d7
GM
3345 XVaNestedList preedit_attr;
3346 XVaNestedList status_attr;
3347 char *base_fontname;
3348 int fontset;
3349
d9d57cb2
DL
3350 s_area.x = 0; s_area.y = 0; s_area.width = 1; s_area.height = 1;
3351 spot.x = 0; spot.y = 1;
5a7df7d7
GM
3352 /* Create X fontset. */
3353 fontset = FRAME_FONTSET (f);
3354 if (fontset < 0)
3355 base_fontname = "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
3356 else
3357 {
6ecb43ce
KH
3358 /* Determine the base fontname from the ASCII font name of
3359 FONTSET. */
3360 char *ascii_font = (char *) XSTRING (fontset_ascii (fontset))->data;
3361 char *p = ascii_font;
5a7df7d7 3362 int i;
6ecb43ce
KH
3363
3364 for (i = 0; *p; p++)
3365 if (*p == '-') i++;
3366 if (i != 14)
3367 /* As the font name doesn't conform to XLFD, we can't
3368 modify it to get a suitable base fontname for the
3369 frame. */
3370 base_fontname = "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
3371 else
3372 {
3373 int len = strlen (ascii_font) + 1;
8ec8a5ec 3374 char *p1 = NULL;
6ecb43ce
KH
3375
3376 for (i = 0, p = ascii_font; i < 8; p++)
3377 {
3378 if (*p == '-')
3379 {
3380 i++;
3381 if (i == 3)
3382 p1 = p + 1;
3383 }
3384 }
3385 base_fontname = (char *) alloca (len);
3386 bzero (base_fontname, len);
3387 strcpy (base_fontname, "-*-*-");
3388 bcopy (p1, base_fontname + 5, p - p1);
3389 strcat (base_fontname, "*-*-*-*-*-*-*");
3390 }
5a7df7d7
GM
3391 }
3392 xfs = xic_create_xfontset (f, base_fontname);
86779fac 3393
5a7df7d7
GM
3394 /* Determine XIC style. */
3395 if (xic_style == 0)
3396 {
3397 XIMStyles supported_list;
3398 supported_list.count_styles = (sizeof supported_xim_styles
3399 / sizeof supported_xim_styles[0]);
3400 supported_list.supported_styles = supported_xim_styles;
3401 xic_style = best_xim_style (&supported_list,
3402 FRAME_X_XIM_STYLES (f));
3403 }
86779fac 3404
5a7df7d7
GM
3405 preedit_attr = XVaCreateNestedList (0,
3406 XNFontSet, xfs,
3407 XNForeground,
3408 FRAME_FOREGROUND_PIXEL (f),
3409 XNBackground,
3410 FRAME_BACKGROUND_PIXEL (f),
3411 (xic_style & XIMPreeditPosition
3412 ? XNSpotLocation
3413 : NULL),
3414 &spot,
3415 NULL);
3416 status_attr = XVaCreateNestedList (0,
3417 XNArea,
3418 &s_area,
3419 XNFontSet,
3420 xfs,
3421 XNForeground,
3422 FRAME_FOREGROUND_PIXEL (f),
3423 XNBackground,
3424 FRAME_BACKGROUND_PIXEL (f),
3425 NULL);
3426
3427 xic = XCreateIC (xim,
3428 XNInputStyle, xic_style,
3429 XNClientWindow, FRAME_X_WINDOW(f),
3430 XNFocusWindow, FRAME_X_WINDOW(f),
3431 XNStatusAttributes, status_attr,
3432 XNPreeditAttributes, preedit_attr,
3433 NULL);
3434 XFree (preedit_attr);
3435 XFree (status_attr);
3436 }
3437
3438 FRAME_XIC (f) = xic;
3439 FRAME_XIC_STYLE (f) = xic_style;
3440 FRAME_XIC_FONTSET (f) = xfs;
86779fac
GM
3441}
3442
5a7df7d7
GM
3443
3444/* Destroy XIC and free XIC fontset of frame F, if any. */
3445
3446void
3447free_frame_xic (f)
3448 struct frame *f;
3449{
3450 if (FRAME_XIC (f) == NULL)
3451 return;
3452
3453 XDestroyIC (FRAME_XIC (f));
3454 if (FRAME_XIC_FONTSET (f))
3455 XFreeFontSet (FRAME_X_DISPLAY (f), FRAME_XIC_FONTSET (f));
3456
3457 FRAME_XIC (f) = NULL;
3458 FRAME_XIC_FONTSET (f) = NULL;
3459}
3460
3461
3462/* Place preedit area for XIC of window W's frame to specified
3463 pixel position X/Y. X and Y are relative to window W. */
3464
3465void
3466xic_set_preeditarea (w, x, y)
3467 struct window *w;
3468 int x, y;
3469{
3470 struct frame *f = XFRAME (w->frame);
3471 XVaNestedList attr;
3472 XPoint spot;
3473
3474 spot.x = WINDOW_TO_FRAME_PIXEL_X (w, x);
3475 spot.y = WINDOW_TO_FRAME_PIXEL_Y (w, y) + FONT_BASE (FRAME_FONT (f));
3476 attr = XVaCreateNestedList (0, XNSpotLocation, &spot, NULL);
3477 XSetICValues (FRAME_XIC (f), XNPreeditAttributes, attr, NULL);
3478 XFree (attr);
3479}
3480
3481
3482/* Place status area for XIC in bottom right corner of frame F.. */
3483
3484void
3485xic_set_statusarea (f)
3486 struct frame *f;
3487{
3488 XIC xic = FRAME_XIC (f);
3489 XVaNestedList attr;
3490 XRectangle area;
3491 XRectangle *needed;
3492
3493 /* Negotiate geometry of status area. If input method has existing
3494 status area, use its current size. */
3495 area.x = area.y = area.width = area.height = 0;
3496 attr = XVaCreateNestedList (0, XNAreaNeeded, &area, NULL);
3497 XSetICValues (xic, XNStatusAttributes, attr, NULL);
3498 XFree (attr);
3499
3500 attr = XVaCreateNestedList (0, XNAreaNeeded, &needed, NULL);
3501 XGetICValues (xic, XNStatusAttributes, attr, NULL);
3502 XFree (attr);
3503
3504 if (needed->width == 0) /* Use XNArea instead of XNAreaNeeded */
3505 {
3506 attr = XVaCreateNestedList (0, XNArea, &needed, NULL);
3507 XGetICValues (xic, XNStatusAttributes, attr, NULL);
3508 XFree (attr);
3509 }
3510
3511 area.width = needed->width;
3512 area.height = needed->height;
3513 area.x = PIXEL_WIDTH (f) - area.width - FRAME_INTERNAL_BORDER_WIDTH (f);
3514 area.y = (PIXEL_HEIGHT (f) - area.height
3515 - FRAME_MENUBAR_HEIGHT (f) - FRAME_INTERNAL_BORDER_WIDTH (f));
3516 XFree (needed);
3517
3518 attr = XVaCreateNestedList (0, XNArea, &area, NULL);
3519 XSetICValues(xic, XNStatusAttributes, attr, NULL);
3520 XFree (attr);
3521}
3522
3523
3524/* Set X fontset for XIC of frame F, using base font name
3525 BASE_FONTNAME. Called when a new Emacs fontset is chosen. */
3526
3527void
3528xic_set_xfontset (f, base_fontname)
3529 struct frame *f;
3530 char *base_fontname;
3531{
3532 XVaNestedList attr;
3533 XFontSet xfs;
3534
3535 xfs = xic_create_xfontset (f, base_fontname);
3536
3537 attr = XVaCreateNestedList (0, XNFontSet, xfs, NULL);
3538 if (FRAME_XIC_STYLE (f) & XIMPreeditPosition)
3539 XSetICValues (FRAME_XIC (f), XNPreeditAttributes, attr, NULL);
3540 if (FRAME_XIC_STYLE (f) & XIMStatusArea)
3541 XSetICValues (FRAME_XIC (f), XNStatusAttributes, attr, NULL);
3542 XFree (attr);
3543
3544 if (FRAME_XIC_FONTSET (f))
3545 XFreeFontSet (FRAME_X_DISPLAY (f), FRAME_XIC_FONTSET (f));
3546 FRAME_XIC_FONTSET (f) = xfs;
3547}
3548
3549#endif /* HAVE_X_I18N */
3550
3551
9ef48a9d 3552\f
8fc2766b
RS
3553#ifdef USE_X_TOOLKIT
3554
3555/* Create and set up the X widget for frame F. */
f58534a3 3556
01f1ba30 3557static void
a7f7d550
FP
3558x_window (f, window_prompting, minibuffer_only)
3559 struct frame *f;
3560 long window_prompting;
3561 int minibuffer_only;
01f1ba30 3562{
9ef48a9d 3563 XClassHint class_hints;
31ac8d8c
FP
3564 XSetWindowAttributes attributes;
3565 unsigned long attribute_mask;
9ef48a9d
RS
3566 Widget shell_widget;
3567 Widget pane_widget;
6c32dd68 3568 Widget frame_widget;
9ef48a9d
RS
3569 Arg al [25];
3570 int ac;
3571
3572 BLOCK_INPUT;
3573
b7975ee4
KH
3574 /* Use the resource name as the top-level widget name
3575 for looking up resources. Make a non-Lisp copy
3576 for the window manager, so GC relocation won't bother it.
3577
3578 Elsewhere we specify the window name for the window manager. */
3579
cca176a0 3580 {
b7975ee4
KH
3581 char *str = (char *) XSTRING (Vx_resource_name)->data;
3582 f->namebuf = (char *) xmalloc (strlen (str) + 1);
cca176a0
KH
3583 strcpy (f->namebuf, str);
3584 }
9ef48a9d
RS
3585
3586 ac = 0;
3587 XtSetArg (al[ac], XtNallowShellResize, 1); ac++;
3588 XtSetArg (al[ac], XtNinput, 1); ac++;
97787173 3589 XtSetArg (al[ac], XtNmappedWhenManaged, 0); ac++;
7556890b 3590 XtSetArg (al[ac], XtNborderWidth, f->output_data.x->border_width); ac++;
9b2956e2
GM
3591 XtSetArg (al[ac], XtNvisual, FRAME_X_VISUAL (f)); ac++;
3592 XtSetArg (al[ac], XtNdepth, FRAME_X_DISPLAY_INFO (f)->n_planes); ac++;
3593 XtSetArg (al[ac], XtNcolormap, FRAME_X_COLORMAP (f)); ac++;
cca176a0 3594 shell_widget = XtAppCreateShell (f->namebuf, EMACS_CLASS,
7a994728 3595 applicationShellWidgetClass,
82c90203 3596 FRAME_X_DISPLAY (f), al, ac);
9ef48a9d 3597
7556890b 3598 f->output_data.x->widget = shell_widget;
9ef48a9d
RS
3599 /* maybe_set_screen_title_format (shell_widget); */
3600
6c32dd68
PR
3601 pane_widget = lw_create_widget ("main", "pane", widget_id_tick++,
3602 (widget_value *) NULL,
3603 shell_widget, False,
3604 (lw_callback) NULL,
3605 (lw_callback) NULL,
b6e11efd 3606 (lw_callback) NULL,
6c32dd68 3607 (lw_callback) NULL);
9ef48a9d 3608
9b2956e2
GM
3609 ac = 0;
3610 XtSetArg (al[ac], XtNvisual, FRAME_X_VISUAL (f)); ac++;
3611 XtSetArg (al[ac], XtNdepth, FRAME_X_DISPLAY_INFO (f)->n_planes); ac++;
3612 XtSetArg (al[ac], XtNcolormap, FRAME_X_COLORMAP (f)); ac++;
3613 XtSetValues (pane_widget, al, ac);
7556890b 3614 f->output_data.x->column_widget = pane_widget;
a7f7d550 3615
9ef48a9d 3616 /* mappedWhenManaged to false tells to the paned window to not map/unmap
5e65b9ab 3617 the emacs screen when changing menubar. This reduces flickering. */
9ef48a9d
RS
3618
3619 ac = 0;
3620 XtSetArg (al[ac], XtNmappedWhenManaged, 0); ac++;
3621 XtSetArg (al[ac], XtNshowGrip, 0); ac++;
3622 XtSetArg (al[ac], XtNallowResize, 1); ac++;
3623 XtSetArg (al[ac], XtNresizeToPreferred, 1); ac++;
3624 XtSetArg (al[ac], XtNemacsFrame, f); ac++;
9b2956e2
GM
3625 XtSetArg (al[ac], XtNvisual, FRAME_X_VISUAL (f)); ac++;
3626 XtSetArg (al[ac], XtNdepth, FRAME_X_DISPLAY_INFO (f)->n_planes); ac++;
3627 XtSetArg (al[ac], XtNcolormap, FRAME_X_COLORMAP (f)); ac++;
3628 frame_widget = XtCreateWidget (f->namebuf, emacsFrameClass, pane_widget,
3629 al, ac);
9ef48a9d 3630
7556890b 3631 f->output_data.x->edit_widget = frame_widget;
9ef48a9d 3632
6c32dd68 3633 XtManageChild (frame_widget);
a7f7d550
FP
3634
3635 /* Do some needed geometry management. */
3636 {
3637 int len;
3638 char *tem, shell_position[32];
3639 Arg al[2];
3640 int ac = 0;
5031cc10 3641 int extra_borders = 0;
8fc2766b 3642 int menubar_size
7556890b
RS
3643 = (f->output_data.x->menubar_widget
3644 ? (f->output_data.x->menubar_widget->core.height
3645 + f->output_data.x->menubar_widget->core.border_width)
8fc2766b 3646 : 0);
a7f7d550 3647
f7008aff
RS
3648#if 0 /* Experimentally, we now get the right results
3649 for -geometry -0-0 without this. 24 Aug 96, rms. */
01cbdba5
RS
3650 if (FRAME_EXTERNAL_MENU_BAR (f))
3651 {
dd254b21 3652 Dimension ibw = 0;
01cbdba5
RS
3653 XtVaGetValues (pane_widget, XtNinternalBorderWidth, &ibw, NULL);
3654 menubar_size += ibw;
3655 }
f7008aff 3656#endif
01cbdba5 3657
7556890b 3658 f->output_data.x->menubar_height = menubar_size;
00983aba 3659
440b0bfd 3660#ifndef USE_LUCID
5031cc10
KH
3661 /* Motif seems to need this amount added to the sizes
3662 specified for the shell widget. The Athena/Lucid widgets don't.
3663 Both conclusions reached experimentally. -- rms. */
440b0bfd
RS
3664 XtVaGetValues (f->output_data.x->edit_widget, XtNinternalBorderWidth,
3665 &extra_borders, NULL);
3666 extra_borders *= 2;
3667#endif
5031cc10 3668
97787173
RS
3669 /* Convert our geometry parameters into a geometry string
3670 and specify it.
3671 Note that we do not specify here whether the position
3672 is a user-specified or program-specified one.
3673 We pass that information later, in x_wm_set_size_hints. */
3674 {
7556890b 3675 int left = f->output_data.x->left_pos;
97787173 3676 int xneg = window_prompting & XNegative;
7556890b 3677 int top = f->output_data.x->top_pos;
97787173
RS
3678 int yneg = window_prompting & YNegative;
3679 if (xneg)
3680 left = -left;
3681 if (yneg)
3682 top = -top;
c760f47e
KH
3683
3684 if (window_prompting & USPosition)
5031cc10
KH
3685 sprintf (shell_position, "=%dx%d%c%d%c%d",
3686 PIXEL_WIDTH (f) + extra_borders,
3687 PIXEL_HEIGHT (f) + menubar_size + extra_borders,
c760f47e
KH
3688 (xneg ? '-' : '+'), left,
3689 (yneg ? '-' : '+'), top);
3690 else
5031cc10
KH
3691 sprintf (shell_position, "=%dx%d",
3692 PIXEL_WIDTH (f) + extra_borders,
3693 PIXEL_HEIGHT (f) + menubar_size + extra_borders);
97787173
RS
3694 }
3695
a7f7d550 3696 len = strlen (shell_position) + 1;
77110caa
RS
3697 /* We don't free this because we don't know whether
3698 it is safe to free it while the frame exists.
3699 It isn't worth the trouble of arranging to free it
3700 when the frame is deleted. */
a7f7d550
FP
3701 tem = (char *) xmalloc (len);
3702 strncpy (tem, shell_position, len);
3703 XtSetArg (al[ac], XtNgeometry, tem); ac++;
3704 XtSetValues (shell_widget, al, ac);
3705 }
3706
9ef48a9d
RS
3707 XtManageChild (pane_widget);
3708 XtRealizeWidget (shell_widget);
3709
6c32dd68 3710 FRAME_X_WINDOW (f) = XtWindow (frame_widget);
9ef48a9d
RS
3711
3712 validate_x_resource_name ();
b7975ee4 3713
9ef48a9d 3714 class_hints.res_name = (char *) XSTRING (Vx_resource_name)->data;
498e9ac3 3715 class_hints.res_class = (char *) XSTRING (Vx_resource_class)->data;
b9dc4443 3716 XSetClassHint (FRAME_X_DISPLAY (f), XtWindow (shell_widget), &class_hints);
5a7df7d7
GM
3717
3718#ifdef HAVE_X_I18N
3719 FRAME_XIC (f) = NULL;
4bd777b8 3720#ifdef USE_XIM
5a7df7d7 3721 create_frame_xic (f);
4bd777b8 3722#endif
5a7df7d7 3723#endif
64d16748 3724
7556890b
RS
3725 f->output_data.x->wm_hints.input = True;
3726 f->output_data.x->wm_hints.flags |= InputHint;
b9dc4443 3727 XSetWMHints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
7556890b 3728 &f->output_data.x->wm_hints);
b8228beb 3729
c4ec904f 3730 hack_wm_protocols (f, shell_widget);
9ef48a9d 3731
6c32dd68
PR
3732#ifdef HACK_EDITRES
3733 XtAddEventHandler (shell_widget, 0, True, _XEditResCheckMessages, 0);
3734#endif
3735
9ef48a9d 3736 /* Do a stupid property change to force the server to generate a
333b20bb 3737 PropertyNotify event so that the event_stream server timestamp will
9ef48a9d
RS
3738 be initialized to something relevant to the time we created the window.
3739 */
6c32dd68 3740 XChangeProperty (XtDisplay (frame_widget), XtWindow (frame_widget),
b9dc4443
RS
3741 FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
3742 XA_ATOM, 32, PropModeAppend,
9ef48a9d
RS
3743 (unsigned char*) NULL, 0);
3744
5a7df7d7 3745 /* Make all the standard events reach the Emacs frame. */
31ac8d8c 3746 attributes.event_mask = STANDARD_EVENT_SET;
5a7df7d7
GM
3747
3748#ifdef HAVE_X_I18N
3749 if (FRAME_XIC (f))
3750 {
3751 /* XIM server might require some X events. */
3752 unsigned long fevent = NoEventMask;
3753 XGetICValues(FRAME_XIC (f), XNFilterEvents, &fevent, NULL);
3754 attributes.event_mask |= fevent;
3755 }
3756#endif /* HAVE_X_I18N */
3757
31ac8d8c
FP
3758 attribute_mask = CWEventMask;
3759 XChangeWindowAttributes (XtDisplay (shell_widget), XtWindow (shell_widget),
3760 attribute_mask, &attributes);
3761
6c32dd68 3762 XtMapWidget (frame_widget);
9ef48a9d 3763
8fc2766b
RS
3764 /* x_set_name normally ignores requests to set the name if the
3765 requested name is the same as the current name. This is the one
3766 place where that assumption isn't correct; f->name is set, but
3767 the X server hasn't been told. */
3768 {
3769 Lisp_Object name;
3770 int explicit = f->explicit_name;
3771
3772 f->explicit_name = 0;
3773 name = f->name;
3774 f->name = Qnil;
3775 x_set_name (f, name, explicit);
3776 }
3777
b9dc4443 3778 XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
7556890b 3779 f->output_data.x->text_cursor);
8fc2766b
RS
3780
3781 UNBLOCK_INPUT;
3782
495fa05e
GM
3783 /* This is a no-op, except under Motif. Make sure main areas are
3784 set to something reasonable, in case we get an error later. */
3785 lw_set_main_areas (pane_widget, 0, frame_widget);
8fc2766b
RS
3786}
3787
9ef48a9d
RS
3788#else /* not USE_X_TOOLKIT */
3789
8fc2766b
RS
3790/* Create and set up the X window for frame F. */
3791
201d8c78 3792void
8fc2766b
RS
3793x_window (f)
3794 struct frame *f;
3795
3796{
3797 XClassHint class_hints;
3798 XSetWindowAttributes attributes;
3799 unsigned long attribute_mask;
3800
7556890b
RS
3801 attributes.background_pixel = f->output_data.x->background_pixel;
3802 attributes.border_pixel = f->output_data.x->border_pixel;
01f1ba30
JB
3803 attributes.bit_gravity = StaticGravity;
3804 attributes.backing_store = NotUseful;
3805 attributes.save_under = True;
3806 attributes.event_mask = STANDARD_EVENT_SET;
9b2956e2
GM
3807 attributes.colormap = FRAME_X_COLORMAP (f);
3808 attribute_mask = (CWBackPixel | CWBorderPixel | CWBitGravity | CWEventMask
3809 | CWColormap);
01f1ba30
JB
3810
3811 BLOCK_INPUT;
fe24a618 3812 FRAME_X_WINDOW (f)
b9dc4443 3813 = XCreateWindow (FRAME_X_DISPLAY (f),
7556890b
RS
3814 f->output_data.x->parent_desc,
3815 f->output_data.x->left_pos,
3816 f->output_data.x->top_pos,
f676886a 3817 PIXEL_WIDTH (f), PIXEL_HEIGHT (f),
7556890b 3818 f->output_data.x->border_width,
01f1ba30
JB
3819 CopyFromParent, /* depth */
3820 InputOutput, /* class */
383d6ffc 3821 FRAME_X_VISUAL (f),
01f1ba30 3822 attribute_mask, &attributes);
5a7df7d7
GM
3823
3824#ifdef HAVE_X_I18N
4bd777b8 3825#ifdef USE_XIM
5a7df7d7
GM
3826 create_frame_xic (f);
3827 if (FRAME_XIC (f))
3828 {
3829 /* XIM server might require some X events. */
3830 unsigned long fevent = NoEventMask;
3831 XGetICValues(FRAME_XIC (f), XNFilterEvents, &fevent, NULL);
3832 attributes.event_mask |= fevent;
3833 attribute_mask = CWEventMask;
3834 XChangeWindowAttributes (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
3835 attribute_mask, &attributes);
3836 }
4bd777b8 3837#endif
5a7df7d7
GM
3838#endif /* HAVE_X_I18N */
3839
d387c960 3840 validate_x_resource_name ();
b7975ee4 3841
d387c960 3842 class_hints.res_name = (char *) XSTRING (Vx_resource_name)->data;
498e9ac3 3843 class_hints.res_class = (char *) XSTRING (Vx_resource_class)->data;
b9dc4443 3844 XSetClassHint (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &class_hints);
01f1ba30 3845
00983aba
KH
3846 /* The menubar is part of the ordinary display;
3847 it does not count in addition to the height of the window. */
7556890b 3848 f->output_data.x->menubar_height = 0;
00983aba 3849
179956b9
JB
3850 /* This indicates that we use the "Passive Input" input model.
3851 Unless we do this, we don't get the Focus{In,Out} events that we
3852 need to draw the cursor correctly. Accursed bureaucrats.
b9dc4443 3853 XWhipsAndChains (FRAME_X_DISPLAY (f), IronMaiden, &TheRack); */
179956b9 3854
7556890b
RS
3855 f->output_data.x->wm_hints.input = True;
3856 f->output_data.x->wm_hints.flags |= InputHint;
b9dc4443 3857 XSetWMHints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
7556890b 3858 &f->output_data.x->wm_hints);
6d078211 3859 f->output_data.x->wm_hints.icon_pixmap = None;
179956b9 3860
032e4ebe
RS
3861 /* Request "save yourself" and "delete window" commands from wm. */
3862 {
3863 Atom protocols[2];
b9dc4443
RS
3864 protocols[0] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window;
3865 protocols[1] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself;
3866 XSetWMProtocols (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), protocols, 2);
032e4ebe 3867 }
9ef48a9d 3868
e373f201
JB
3869 /* x_set_name normally ignores requests to set the name if the
3870 requested name is the same as the current name. This is the one
3871 place where that assumption isn't correct; f->name is set, but
3872 the X server hasn't been told. */
3873 {
98381190 3874 Lisp_Object name;
cf177271 3875 int explicit = f->explicit_name;
e373f201 3876
cf177271 3877 f->explicit_name = 0;
98381190
KH
3878 name = f->name;
3879 f->name = Qnil;
cf177271 3880 x_set_name (f, name, explicit);
e373f201
JB
3881 }
3882
b9dc4443 3883 XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
7556890b 3884 f->output_data.x->text_cursor);
9ef48a9d 3885
01f1ba30
JB
3886 UNBLOCK_INPUT;
3887
fe24a618 3888 if (FRAME_X_WINDOW (f) == 0)
9ef48a9d 3889 error ("Unable to create window");
01f1ba30
JB
3890}
3891
8fc2766b
RS
3892#endif /* not USE_X_TOOLKIT */
3893
01f1ba30
JB
3894/* Handle the icon stuff for this window. Perhaps later we might
3895 want an x_set_icon_position which can be called interactively as
b9dc4443 3896 well. */
01f1ba30
JB
3897
3898static void
f676886a
JB
3899x_icon (f, parms)
3900 struct frame *f;
01f1ba30
JB
3901 Lisp_Object parms;
3902{
f9942c9e 3903 Lisp_Object icon_x, icon_y;
abb4b7ec 3904 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
01f1ba30
JB
3905
3906 /* Set the position of the icon. Note that twm groups all
b9dc4443 3907 icons in an icon window. */
333b20bb
GM
3908 icon_x = x_get_and_record_arg (f, parms, Qicon_left, 0, 0, RES_TYPE_NUMBER);
3909 icon_y = x_get_and_record_arg (f, parms, Qicon_top, 0, 0, RES_TYPE_NUMBER);
f9942c9e 3910 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
01f1ba30 3911 {
f9942c9e
JB
3912 CHECK_NUMBER (icon_x, 0);
3913 CHECK_NUMBER (icon_y, 0);
01f1ba30 3914 }
f9942c9e 3915 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
01f1ba30 3916 error ("Both left and top icon corners of icon must be specified");
01f1ba30 3917
f9942c9e
JB
3918 BLOCK_INPUT;
3919
fe24a618
JB
3920 if (! EQ (icon_x, Qunbound))
3921 x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y));
f9942c9e 3922
01f1ba30 3923 /* Start up iconic or window? */
49795535 3924 x_wm_set_window_state
333b20bb
GM
3925 (f, (EQ (x_get_arg (dpyinfo, parms, Qvisibility, 0, 0, RES_TYPE_SYMBOL),
3926 Qicon)
49795535
JB
3927 ? IconicState
3928 : NormalState));
01f1ba30 3929
f468da95
RS
3930 x_text_icon (f, (char *) XSTRING ((!NILP (f->icon_name)
3931 ? f->icon_name
3932 : f->name))->data);
80534dd6 3933
01f1ba30
JB
3934 UNBLOCK_INPUT;
3935}
3936
b243755a 3937/* Make the GCs needed for this window, setting the
01f1ba30
JB
3938 background, border and mouse colors; also create the
3939 mouse cursor and the gray border tile. */
3940
f945b920
JB
3941static char cursor_bits[] =
3942 {
3943 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3944 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3945 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3946 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
3947 };
3948
01f1ba30 3949static void
f676886a
JB
3950x_make_gc (f)
3951 struct frame *f;
01f1ba30
JB
3952{
3953 XGCValues gc_values;
01f1ba30 3954
6afb1d07
JB
3955 BLOCK_INPUT;
3956
b243755a 3957 /* Create the GCs of this frame.
9ef48a9d 3958 Note that many default values are used. */
01f1ba30
JB
3959
3960 /* Normal video */
7556890b
RS
3961 gc_values.font = f->output_data.x->font->fid;
3962 gc_values.foreground = f->output_data.x->foreground_pixel;
3963 gc_values.background = f->output_data.x->background_pixel;
9ef48a9d 3964 gc_values.line_width = 0; /* Means 1 using fast algorithm. */
959e647d
GM
3965 f->output_data.x->normal_gc
3966 = XCreateGC (FRAME_X_DISPLAY (f),
3967 FRAME_X_WINDOW (f),
3968 GCLineWidth | GCFont | GCForeground | GCBackground,
3969 &gc_values);
01f1ba30 3970
b9dc4443 3971 /* Reverse video style. */
7556890b
RS
3972 gc_values.foreground = f->output_data.x->background_pixel;
3973 gc_values.background = f->output_data.x->foreground_pixel;
959e647d
GM
3974 f->output_data.x->reverse_gc
3975 = XCreateGC (FRAME_X_DISPLAY (f),
3976 FRAME_X_WINDOW (f),
3977 GCFont | GCForeground | GCBackground | GCLineWidth,
3978 &gc_values);
01f1ba30 3979
9ef48a9d 3980 /* Cursor has cursor-color background, background-color foreground. */
7556890b
RS
3981 gc_values.foreground = f->output_data.x->background_pixel;
3982 gc_values.background = f->output_data.x->cursor_pixel;
01f1ba30
JB
3983 gc_values.fill_style = FillOpaqueStippled;
3984 gc_values.stipple
b9dc4443
RS
3985 = XCreateBitmapFromData (FRAME_X_DISPLAY (f),
3986 FRAME_X_DISPLAY_INFO (f)->root_window,
01f1ba30 3987 cursor_bits, 16, 16);
7556890b 3988 f->output_data.x->cursor_gc
b9dc4443 3989 = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
01f1ba30 3990 (GCFont | GCForeground | GCBackground
ac1f48a4 3991 | GCFillStyle /* | GCStipple */ | GCLineWidth),
01f1ba30
JB
3992 &gc_values);
3993
333b20bb
GM
3994 /* Reliefs. */
3995 f->output_data.x->white_relief.gc = 0;
3996 f->output_data.x->black_relief.gc = 0;
3997
01f1ba30 3998 /* Create the gray border tile used when the pointer is not in
f676886a 3999 the frame. Since this depends on the frame's pixel values,
9ef48a9d 4000 this must be done on a per-frame basis. */
7556890b 4001 f->output_data.x->border_tile
d043f1a4 4002 = (XCreatePixmapFromBitmapData
b9dc4443 4003 (FRAME_X_DISPLAY (f), FRAME_X_DISPLAY_INFO (f)->root_window,
d043f1a4 4004 gray_bits, gray_width, gray_height,
7556890b
RS
4005 f->output_data.x->foreground_pixel,
4006 f->output_data.x->background_pixel,
ab452f99 4007 DefaultDepth (FRAME_X_DISPLAY (f), FRAME_X_SCREEN_NUMBER (f))));
6afb1d07
JB
4008
4009 UNBLOCK_INPUT;
01f1ba30 4010}
01f1ba30 4011
959e647d
GM
4012
4013/* Free what was was allocated in x_make_gc. */
4014
4015void
4016x_free_gcs (f)
4017 struct frame *f;
4018{
4019 Display *dpy = FRAME_X_DISPLAY (f);
4020
4021 BLOCK_INPUT;
4022
4023 if (f->output_data.x->normal_gc)
4024 {
4025 XFreeGC (dpy, f->output_data.x->normal_gc);
4026 f->output_data.x->normal_gc = 0;
4027 }
4028
4029 if (f->output_data.x->reverse_gc)
4030 {
4031 XFreeGC (dpy, f->output_data.x->reverse_gc);
4032 f->output_data.x->reverse_gc = 0;
4033 }
4034
4035 if (f->output_data.x->cursor_gc)
4036 {
4037 XFreeGC (dpy, f->output_data.x->cursor_gc);
4038 f->output_data.x->cursor_gc = 0;
4039 }
4040
4041 if (f->output_data.x->border_tile)
4042 {
4043 XFreePixmap (dpy, f->output_data.x->border_tile);
4044 f->output_data.x->border_tile = 0;
4045 }
4046
4047 UNBLOCK_INPUT;
4048}
4049
4050
eaf1eea9
GM
4051/* Handler for signals raised during x_create_frame and
4052 x_create_top_frame. FRAME is the frame which is partially
4053 constructed. */
4054
4055static Lisp_Object
4056unwind_create_frame (frame)
4057 Lisp_Object frame;
4058{
4059 struct frame *f = XFRAME (frame);
4060
4061 /* If frame is ``official'', nothing to do. */
4062 if (!CONSP (Vframe_list) || !EQ (XCAR (Vframe_list), frame))
4063 {
f1d2ce7f 4064#if GLYPH_DEBUG
eaf1eea9
GM
4065 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
4066#endif
4067
4068 x_free_frame_resources (f);
4069
4070 /* Check that reference counts are indeed correct. */
4071 xassert (dpyinfo->reference_count == dpyinfo_refcount);
4072 xassert (dpyinfo->image_cache->refcount == image_cache_refcount);
c844a81a 4073 return Qt;
eaf1eea9
GM
4074 }
4075
4076 return Qnil;
4077}
4078
4079
f676886a 4080DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
01f1ba30 4081 1, 1, 0,
f676886a 4082 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
08a90d6a 4083Returns an Emacs frame object.\n\
f676886a
JB
4084ALIST is an alist of frame parameters.\n\
4085If the parameters specify that the frame should not have a minibuffer,\n\
e22d6b02 4086and do not specify a specific minibuffer window to use,\n\
f676886a 4087then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
08a90d6a
RS
4088be shared by the new frame.\n\
4089\n\
4090This function is an internal primitive--use `make-frame' instead.")
01f1ba30
JB
4091 (parms)
4092 Lisp_Object parms;
4093{
f676886a 4094 struct frame *f;
2365c027 4095 Lisp_Object frame, tem;
01f1ba30
JB
4096 Lisp_Object name;
4097 int minibuffer_only = 0;
4098 long window_prompting = 0;
4099 int width, height;
eaf1eea9 4100 int count = BINDING_STACK_SIZE ();
ecaca587 4101 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
b9dc4443 4102 Lisp_Object display;
333b20bb 4103 struct x_display_info *dpyinfo = NULL;
a59e4f3d 4104 Lisp_Object parent;
e557f19d 4105 struct kboard *kb;
01f1ba30 4106
11ae94fe 4107 check_x ();
01f1ba30 4108
b7975ee4
KH
4109 /* Use this general default value to start with
4110 until we know if this frame has a specified name. */
4111 Vx_resource_name = Vinvocation_name;
4112
333b20bb 4113 display = x_get_arg (dpyinfo, parms, Qdisplay, 0, 0, RES_TYPE_STRING);
b9dc4443
RS
4114 if (EQ (display, Qunbound))
4115 display = Qnil;
4116 dpyinfo = check_x_display_info (display);
e557f19d
KH
4117#ifdef MULTI_KBOARD
4118 kb = dpyinfo->kboard;
4119#else
4120 kb = &the_only_kboard;
4121#endif
b9dc4443 4122
333b20bb 4123 name = x_get_arg (dpyinfo, parms, Qname, "name", "Name", RES_TYPE_STRING);
6a5e54e2 4124 if (!STRINGP (name)
cf177271
JB
4125 && ! EQ (name, Qunbound)
4126 && ! NILP (name))
08a90d6a 4127 error ("Invalid frame name--not a string or nil");
01f1ba30 4128
b7975ee4
KH
4129 if (STRINGP (name))
4130 Vx_resource_name = name;
4131
a59e4f3d 4132 /* See if parent window is specified. */
333b20bb 4133 parent = x_get_arg (dpyinfo, parms, Qparent_id, NULL, NULL, RES_TYPE_NUMBER);
a59e4f3d
RS
4134 if (EQ (parent, Qunbound))
4135 parent = Qnil;
4136 if (! NILP (parent))
4137 CHECK_NUMBER (parent, 0);
4138
ecaca587
RS
4139 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
4140 /* No need to protect DISPLAY because that's not used after passing
4141 it to make_frame_without_minibuffer. */
4142 frame = Qnil;
4143 GCPRO4 (parms, parent, name, frame);
333b20bb
GM
4144 tem = x_get_arg (dpyinfo, parms, Qminibuffer, "minibuffer", "Minibuffer",
4145 RES_TYPE_SYMBOL);
f9942c9e 4146 if (EQ (tem, Qnone) || NILP (tem))
2526c290 4147 f = make_frame_without_minibuffer (Qnil, kb, display);
f9942c9e 4148 else if (EQ (tem, Qonly))
01f1ba30 4149 {
f676886a 4150 f = make_minibuffer_frame ();
01f1ba30
JB
4151 minibuffer_only = 1;
4152 }
6a5e54e2 4153 else if (WINDOWP (tem))
2526c290 4154 f = make_frame_without_minibuffer (tem, kb, display);
f9942c9e
JB
4155 else
4156 f = make_frame (1);
01f1ba30 4157
ecaca587
RS
4158 XSETFRAME (frame, f);
4159
a3c87d4e
JB
4160 /* Note that X Windows does support scroll bars. */
4161 FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
179956b9 4162
08a90d6a 4163 f->output_method = output_x_window;
7556890b
RS
4164 f->output_data.x = (struct x_output *) xmalloc (sizeof (struct x_output));
4165 bzero (f->output_data.x, sizeof (struct x_output));
4166 f->output_data.x->icon_bitmap = -1;
0ecca023 4167 f->output_data.x->fontset = -1;
333b20bb
GM
4168 f->output_data.x->scroll_bar_foreground_pixel = -1;
4169 f->output_data.x->scroll_bar_background_pixel = -1;
eaf1eea9 4170 record_unwind_protect (unwind_create_frame, frame);
08a90d6a 4171
f468da95 4172 f->icon_name
333b20bb
GM
4173 = x_get_arg (dpyinfo, parms, Qicon_name, "iconName", "Title",
4174 RES_TYPE_STRING);
f468da95
RS
4175 if (! STRINGP (f->icon_name))
4176 f->icon_name = Qnil;
80534dd6 4177
08a90d6a 4178 FRAME_X_DISPLAY_INFO (f) = dpyinfo;
f1d2ce7f 4179#if GLYPH_DEBUG
eaf1eea9
GM
4180 image_cache_refcount = FRAME_X_IMAGE_CACHE (f)->refcount;
4181 dpyinfo_refcount = dpyinfo->reference_count;
4182#endif /* GLYPH_DEBUG */
73410c76 4183#ifdef MULTI_KBOARD
e557f19d 4184 FRAME_KBOARD (f) = kb;
73410c76 4185#endif
08a90d6a 4186
9b2956e2
GM
4187 /* These colors will be set anyway later, but it's important
4188 to get the color reference counts right, so initialize them! */
4189 {
4190 Lisp_Object black;
4191 struct gcpro gcpro1;
cefecbcf
GM
4192
4193 /* Function x_decode_color can signal an error. Make
4194 sure to initialize color slots so that we won't try
4195 to free colors we haven't allocated. */
4196 f->output_data.x->foreground_pixel = -1;
4197 f->output_data.x->background_pixel = -1;
4198 f->output_data.x->cursor_pixel = -1;
4199 f->output_data.x->cursor_foreground_pixel = -1;
4200 f->output_data.x->border_pixel = -1;
4201 f->output_data.x->mouse_pixel = -1;
9b2956e2
GM
4202
4203 black = build_string ("black");
4204 GCPRO1 (black);
4205 f->output_data.x->foreground_pixel
4206 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
4207 f->output_data.x->background_pixel
4208 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
4209 f->output_data.x->cursor_pixel
4210 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
4211 f->output_data.x->cursor_foreground_pixel
4212 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
4213 f->output_data.x->border_pixel
4214 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
4215 f->output_data.x->mouse_pixel
4216 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
4217 UNGCPRO;
4218 }
4219
a59e4f3d
RS
4220 /* Specify the parent under which to make this X window. */
4221
4222 if (!NILP (parent))
4223 {
8c239ac3 4224 f->output_data.x->parent_desc = (Window) XFASTINT (parent);
7556890b 4225 f->output_data.x->explicit_parent = 1;
a59e4f3d
RS
4226 }
4227 else
4228 {
7556890b
RS
4229 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
4230 f->output_data.x->explicit_parent = 0;
a59e4f3d
RS
4231 }
4232
cf177271
JB
4233 /* Set the name; the functions to which we pass f expect the name to
4234 be set. */
4235 if (EQ (name, Qunbound) || NILP (name))
4236 {
08a90d6a 4237 f->name = build_string (dpyinfo->x_id_name);
cf177271
JB
4238 f->explicit_name = 0;
4239 }
4240 else
4241 {
4242 f->name = name;
4243 f->explicit_name = 1;
9ef48a9d
RS
4244 /* use the frame's title when getting resources for this frame. */
4245 specbind (Qx_resource_name, name);
cf177271 4246 }
01f1ba30 4247
01f1ba30
JB
4248 /* Extract the window parameters from the supplied values
4249 that are needed to determine window geometry. */
d387c960
JB
4250 {
4251 Lisp_Object font;
4252
333b20bb 4253 font = x_get_arg (dpyinfo, parms, Qfont, "font", "Font", RES_TYPE_STRING);
2ee3abaa 4254
6817eab4 4255 BLOCK_INPUT;
e5e548e3
RS
4256 /* First, try whatever font the caller has specified. */
4257 if (STRINGP (font))
942ea06d 4258 {
49965a29 4259 tem = Fquery_fontset (font, Qnil);
477f8642
KH
4260 if (STRINGP (tem))
4261 font = x_new_fontset (f, XSTRING (tem)->data);
942ea06d
KH
4262 else
4263 font = x_new_font (f, XSTRING (font)->data);
4264 }
333b20bb 4265
e5e548e3 4266 /* Try out a font which we hope has bold and italic variations. */
333b20bb
GM
4267 if (!STRINGP (font))
4268 font = x_new_font (f, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
e5e548e3 4269 if (!STRINGP (font))
a6ac02af 4270 font = x_new_font (f, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
e5e548e3 4271 if (! STRINGP (font))
a6ac02af 4272 font = x_new_font (f, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
e5e548e3
RS
4273 if (! STRINGP (font))
4274 /* This was formerly the first thing tried, but it finds too many fonts
4275 and takes too long. */
4276 font = x_new_font (f, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
4277 /* If those didn't work, look for something which will at least work. */
4278 if (! STRINGP (font))
a6ac02af 4279 font = x_new_font (f, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
6817eab4
JB
4280 UNBLOCK_INPUT;
4281 if (! STRINGP (font))
e5e548e3
RS
4282 font = build_string ("fixed");
4283
477f8642 4284 x_default_parameter (f, parms, Qfont, font,
333b20bb 4285 "font", "Font", RES_TYPE_STRING);
d387c960 4286 }
9ef48a9d 4287
e3881aa0 4288#ifdef USE_LUCID
82c90203
RS
4289 /* Prevent lwlib/xlwmenu.c from crashing because of a bug
4290 whereby it fails to get any font. */
7556890b 4291 xlwmenu_default_font = f->output_data.x->font;
dd254b21 4292#endif
82c90203 4293
cf177271 4294 x_default_parameter (f, parms, Qborder_width, make_number (2),
333b20bb
GM
4295 "borderWidth", "BorderWidth", RES_TYPE_NUMBER);
4296
ddf768c3
JB
4297 /* This defaults to 2 in order to match xterm. We recognize either
4298 internalBorderWidth or internalBorder (which is what xterm calls
4299 it). */
4300 if (NILP (Fassq (Qinternal_border_width, parms)))
4301 {
4302 Lisp_Object value;
4303
abb4b7ec 4304 value = x_get_arg (dpyinfo, parms, Qinternal_border_width,
333b20bb 4305 "internalBorder", "internalBorder", RES_TYPE_NUMBER);
ddf768c3
JB
4306 if (! EQ (value, Qunbound))
4307 parms = Fcons (Fcons (Qinternal_border_width, value),
4308 parms);
4309 }
dca97592 4310 x_default_parameter (f, parms, Qinternal_border_width, make_number (1),
333b20bb
GM
4311 "internalBorderWidth", "internalBorderWidth",
4312 RES_TYPE_NUMBER);
1ab3d87e 4313 x_default_parameter (f, parms, Qvertical_scroll_bars, Qleft,
333b20bb
GM
4314 "verticalScrollBars", "ScrollBars",
4315 RES_TYPE_SYMBOL);
01f1ba30 4316
b9dc4443 4317 /* Also do the stuff which must be set before the window exists. */
cf177271 4318 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
333b20bb 4319 "foreground", "Foreground", RES_TYPE_STRING);
cf177271 4320 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
0b60fc91 4321 "background", "Background", RES_TYPE_STRING);
cf177271 4322 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
333b20bb 4323 "pointerColor", "Foreground", RES_TYPE_STRING);
cf177271 4324 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
333b20bb 4325 "cursorColor", "Foreground", RES_TYPE_STRING);
cf177271 4326 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
333b20bb 4327 "borderColor", "BorderColor", RES_TYPE_STRING);
d62c8769
GM
4328 x_default_parameter (f, parms, Qscreen_gamma, Qnil,
4329 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT);
563b67aa
GM
4330 x_default_parameter (f, parms, Qline_spacing, Qnil,
4331 "lineSpacing", "LineSpacing", RES_TYPE_NUMBER);
333b20bb
GM
4332
4333 x_default_scroll_bar_color_parameter (f, parms, Qscroll_bar_foreground,
4334 "scrollBarForeground",
4335 "ScrollBarForeground", 1);
4336 x_default_scroll_bar_color_parameter (f, parms, Qscroll_bar_background,
4337 "scrollBarBackground",
4338 "ScrollBarBackground", 0);
4339
4340 /* Init faces before x_default_parameter is called for scroll-bar
4341 parameters because that function calls x_set_scroll_bar_width,
4342 which calls change_frame_size, which calls Fset_window_buffer,
4343 which runs hooks, which call Fvertical_motion. At the end, we
4344 end up in init_iterator with a null face cache, which should not
4345 happen. */
4346 init_frame_faces (f);
4347
c7bcb20d 4348 x_default_parameter (f, parms, Qmenu_bar_lines, make_number (1),
333b20bb 4349 "menuBar", "MenuBar", RES_TYPE_NUMBER);
e33455ca 4350 x_default_parameter (f, parms, Qtool_bar_lines, make_number (1),
333b20bb 4351 "toolBar", "ToolBar", RES_TYPE_NUMBER);
79873d50 4352 x_default_parameter (f, parms, Qbuffer_predicate, Qnil,
333b20bb
GM
4353 "bufferPredicate", "BufferPredicate",
4354 RES_TYPE_SYMBOL);
c2304e02 4355 x_default_parameter (f, parms, Qtitle, Qnil,
333b20bb 4356 "title", "Title", RES_TYPE_STRING);
ea0a1f53
GM
4357 x_default_parameter (f, parms, Qwait_for_wm, Qt,
4358 "waitForWM", "WaitForWM", RES_TYPE_BOOLEAN);
90eb1019 4359
7556890b 4360 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
35f59f6b
GM
4361
4362 /* Add the tool-bar height to the initial frame height so that the
4363 user gets a text display area of the size he specified with -g or
4364 via .Xdefaults. Later changes of the tool-bar height don't
4365 change the frame size. This is done so that users can create
4366 tall Emacs frames without having to guess how tall the tool-bar
4367 will get. */
4368 if (FRAME_TOOL_BAR_LINES (f))
4369 {
4370 int margin, relief, bar_height;
4371
4372 relief = (tool_bar_button_relief > 0
4373 ? tool_bar_button_relief
4374 : DEFAULT_TOOL_BAR_BUTTON_RELIEF);
4375
4376 if (INTEGERP (Vtool_bar_button_margin)
4377 && XINT (Vtool_bar_button_margin) > 0)
4378 margin = XFASTINT (Vtool_bar_button_margin);
4379 else if (CONSP (Vtool_bar_button_margin)
4380 && INTEGERP (XCDR (Vtool_bar_button_margin))
4381 && XINT (XCDR (Vtool_bar_button_margin)) > 0)
4382 margin = XFASTINT (XCDR (Vtool_bar_button_margin));
4383 else
4384 margin = 0;
4385
4386 bar_height = DEFAULT_TOOL_BAR_IMAGE_HEIGHT + 2 * margin + 2 * relief;
4387 f->height += (bar_height + CANON_Y_UNIT (f) - 1) / CANON_Y_UNIT (f);
4388 }
4389
4390 /* Compute the size of the X window. */
f676886a 4391 window_prompting = x_figure_window_size (f, parms);
01f1ba30 4392
f83f10ba 4393 if (window_prompting & XNegative)
2365c027 4394 {
f83f10ba 4395 if (window_prompting & YNegative)
7556890b 4396 f->output_data.x->win_gravity = SouthEastGravity;
f83f10ba 4397 else
7556890b 4398 f->output_data.x->win_gravity = NorthEastGravity;
f83f10ba
RS
4399 }
4400 else
4401 {
4402 if (window_prompting & YNegative)
7556890b 4403 f->output_data.x->win_gravity = SouthWestGravity;
f83f10ba 4404 else
7556890b 4405 f->output_data.x->win_gravity = NorthWestGravity;
2365c027
RS
4406 }
4407
7556890b 4408 f->output_data.x->size_hint_flags = window_prompting;
38d22040 4409
495fa05e
GM
4410 tem = x_get_arg (dpyinfo, parms, Qunsplittable, 0, 0, RES_TYPE_BOOLEAN);
4411 f->no_split = minibuffer_only || EQ (tem, Qt);
4412
6a1bcd01 4413 /* Create the X widget or window. */
a7f7d550
FP
4414#ifdef USE_X_TOOLKIT
4415 x_window (f, window_prompting, minibuffer_only);
4416#else
f676886a 4417 x_window (f);
a7f7d550 4418#endif
495fa05e 4419
f676886a
JB
4420 x_icon (f, parms);
4421 x_make_gc (f);
01f1ba30 4422
495fa05e
GM
4423 /* Now consider the frame official. */
4424 FRAME_X_DISPLAY_INFO (f)->reference_count++;
4425 Vframe_list = Fcons (frame, Vframe_list);
4426
f9942c9e
JB
4427 /* We need to do this after creating the X window, so that the
4428 icon-creation functions can say whose icon they're describing. */
cf177271 4429 x_default_parameter (f, parms, Qicon_type, Qnil,
333b20bb 4430 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL);
f9942c9e 4431
cf177271 4432 x_default_parameter (f, parms, Qauto_raise, Qnil,
333b20bb 4433 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
cf177271 4434 x_default_parameter (f, parms, Qauto_lower, Qnil,
333b20bb 4435 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
dbc4e1c1 4436 x_default_parameter (f, parms, Qcursor_type, Qbox,
333b20bb 4437 "cursorType", "CursorType", RES_TYPE_SYMBOL);
28d7281d
GM
4438 x_default_parameter (f, parms, Qscroll_bar_width, Qnil,
4439 "scrollBarWidth", "ScrollBarWidth",
4440 RES_TYPE_NUMBER);
f9942c9e 4441
f676886a 4442 /* Dimensions, especially f->height, must be done via change_frame_size.
01f1ba30 4443 Change will not be effected unless different from the current
b9dc4443 4444 f->height. */
f676886a
JB
4445 width = f->width;
4446 height = f->height;
6a1bcd01 4447
1ab3d87e
RS
4448 f->height = 0;
4449 SET_FRAME_WIDTH (f, 0);
8938a4fb 4450 change_frame_size (f, height, width, 1, 0, 0);
d043f1a4 4451
4a967a9b
GM
4452 /* Set up faces after all frame parameters are known. This call
4453 also merges in face attributes specified for new frames. If we
4454 don't do this, the `menu' face for instance won't have the right
4455 colors, and the menu bar won't appear in the specified colors for
4456 new frames. */
4457 call1 (Qface_set_after_frame_default, frame);
4458
495fa05e
GM
4459#ifdef USE_X_TOOLKIT
4460 /* Create the menu bar. */
4461 if (!minibuffer_only && FRAME_EXTERNAL_MENU_BAR (f))
4462 {
4463 /* If this signals an error, we haven't set size hints for the
4464 frame and we didn't make it visible. */
4465 initialize_frame_menubar (f);
4466
4467 /* This is a no-op, except under Motif where it arranges the
4468 main window for the widgets on it. */
4469 lw_set_main_areas (f->output_data.x->column_widget,
4470 f->output_data.x->menubar_widget,
4471 f->output_data.x->edit_widget);
4472 }
4473#endif /* USE_X_TOOLKIT */
4474
4475 /* Tell the server what size and position, etc, we want, and how
4476 badly we want them. This should be done after we have the menu
4477 bar so that its size can be taken into account. */
01f1ba30 4478 BLOCK_INPUT;
7989f084 4479 x_wm_set_size_hint (f, window_prompting, 0);
01f1ba30
JB
4480 UNBLOCK_INPUT;
4481
495fa05e
GM
4482 /* Make the window appear on the frame and enable display, unless
4483 the caller says not to. However, with explicit parent, Emacs
4484 cannot control visibility, so don't try. */
7556890b 4485 if (! f->output_data.x->explicit_parent)
a59e4f3d
RS
4486 {
4487 Lisp_Object visibility;
49795535 4488
333b20bb
GM
4489 visibility = x_get_arg (dpyinfo, parms, Qvisibility, 0, 0,
4490 RES_TYPE_SYMBOL);
a59e4f3d
RS
4491 if (EQ (visibility, Qunbound))
4492 visibility = Qt;
49795535 4493
a59e4f3d
RS
4494 if (EQ (visibility, Qicon))
4495 x_iconify_frame (f);
4496 else if (! NILP (visibility))
4497 x_make_frame_visible (f);
4498 else
4499 /* Must have been Qnil. */
4500 ;
4501 }
01f1ba30 4502
495fa05e 4503 UNGCPRO;
9e57df62
GM
4504
4505 /* Make sure windows on this frame appear in calls to next-window
4506 and similar functions. */
4507 Vwindow_list = Qnil;
4508
9ef48a9d 4509 return unbind_to (count, frame);
01f1ba30
JB
4510}
4511
eaf1eea9 4512
0d17d282
KH
4513/* FRAME is used only to get a handle on the X display. We don't pass the
4514 display info directly because we're called from frame.c, which doesn't
4515 know about that structure. */
e4f79258 4516
87498171 4517Lisp_Object
0d17d282
KH
4518x_get_focus_frame (frame)
4519 struct frame *frame;
87498171 4520{
0d17d282 4521 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (frame);
87498171 4522 Lisp_Object xfocus;
0d17d282 4523 if (! dpyinfo->x_focus_frame)
87498171
KH
4524 return Qnil;
4525
0d17d282 4526 XSETFRAME (xfocus, dpyinfo->x_focus_frame);
87498171
KH
4527 return xfocus;
4528}
f0614854 4529
3decc1e7
GM
4530
4531/* In certain situations, when the window manager follows a
4532 click-to-focus policy, there seems to be no way around calling
4533 XSetInputFocus to give another frame the input focus .
4534
4535 In an ideal world, XSetInputFocus should generally be avoided so
4536 that applications don't interfere with the window manager's focus
4537 policy. But I think it's okay to use when it's clearly done
4538 following a user-command. */
4539
4540DEFUN ("x-focus-frame", Fx_focus_frame, Sx_focus_frame, 1, 1, 0,
4541 "Set the input focus to FRAME.\n\
4542FRAME nil means use the selected frame.")
4543 (frame)
4544 Lisp_Object frame;
4545{
4546 struct frame *f = check_x_frame (frame);
4547 Display *dpy = FRAME_X_DISPLAY (f);
4548 int count;
4549
4550 BLOCK_INPUT;
4551 count = x_catch_errors (dpy);
4552 XSetInputFocus (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4553 RevertToParent, CurrentTime);
4554 x_uncatch_errors (dpy, count);
4555 UNBLOCK_INPUT;
4556
4557 return Qnil;
4558}
4559
f0614854 4560\f
2d764c78
EZ
4561DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0,
4562 "Internal function called by `color-defined-p', which see.")
b9dc4443
RS
4563 (color, frame)
4564 Lisp_Object color, frame;
e12d55b2 4565{
b9dc4443
RS
4566 XColor foo;
4567 FRAME_PTR f = check_x_frame (frame);
e12d55b2 4568
b9dc4443
RS
4569 CHECK_STRING (color, 1);
4570
2d764c78 4571 if (x_defined_color (f, XSTRING (color)->data, &foo, 0))
e12d55b2
RS
4572 return Qt;
4573 else
4574 return Qnil;
4575}
4576
2d764c78
EZ
4577DEFUN ("xw-color-values", Fxw_color_values, Sxw_color_values, 1, 2, 0,
4578 "Internal function called by `color-values', which see.")
b9dc4443
RS
4579 (color, frame)
4580 Lisp_Object color, frame;
01f1ba30 4581{
b9dc4443
RS
4582 XColor foo;
4583 FRAME_PTR f = check_x_frame (frame);
4584
4585 CHECK_STRING (color, 1);
01f1ba30 4586
2d764c78 4587 if (x_defined_color (f, XSTRING (color)->data, &foo, 0))
57c82a63
RS
4588 {
4589 Lisp_Object rgb[3];
4590
4591 rgb[0] = make_number (foo.red);
4592 rgb[1] = make_number (foo.green);
4593 rgb[2] = make_number (foo.blue);
4594 return Flist (3, rgb);
4595 }
01f1ba30
JB
4596 else
4597 return Qnil;
4598}
4599
2d764c78
EZ
4600DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0,
4601 "Internal function called by `display-color-p', which see.")
08a90d6a
RS
4602 (display)
4603 Lisp_Object display;
01f1ba30 4604{
08a90d6a 4605 struct x_display_info *dpyinfo = check_x_display_info (display);
11ae94fe 4606
b9dc4443 4607 if (dpyinfo->n_planes <= 2)
01f1ba30
JB
4608 return Qnil;
4609
b9dc4443 4610 switch (dpyinfo->visual->class)
01f1ba30
JB
4611 {
4612 case StaticColor:
4613 case PseudoColor:
4614 case TrueColor:
4615 case DirectColor:
4616 return Qt;
4617
4618 default:
4619 return Qnil;
4620 }
4621}
4622
d0c9d219 4623DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p, Sx_display_grayscale_p,
b9dc4443 4624 0, 1, 0,
08a90d6a 4625 "Return t if the X display supports shades of gray.\n\
ae6b58f9 4626Note that color displays do support shades of gray.\n\
08a90d6a
RS
4627The optional argument DISPLAY specifies which display to ask about.\n\
4628DISPLAY should be either a frame or a display name (a string).\n\
4629If omitted or nil, that stands for the selected frame's display.")
4630 (display)
4631 Lisp_Object display;
d0c9d219 4632{
08a90d6a 4633 struct x_display_info *dpyinfo = check_x_display_info (display);
d0c9d219 4634
ae6b58f9 4635 if (dpyinfo->n_planes <= 1)
b9dc4443
RS
4636 return Qnil;
4637
ae6b58f9
RS
4638 switch (dpyinfo->visual->class)
4639 {
4640 case StaticColor:
4641 case PseudoColor:
4642 case TrueColor:
4643 case DirectColor:
4644 case StaticGray:
4645 case GrayScale:
4646 return Qt;
4647
4648 default:
4649 return Qnil;
4650 }
d0c9d219
RS
4651}
4652
41beb8fc
RS
4653DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width,
4654 0, 1, 0,
08a90d6a
RS
4655 "Returns the width in pixels of the X display DISPLAY.\n\
4656The optional argument DISPLAY specifies which display to ask about.\n\
4657DISPLAY should be either a frame or a display name (a string).\n\
4658If omitted or nil, that stands for the selected frame's display.")
4659 (display)
4660 Lisp_Object display;
41beb8fc 4661{
08a90d6a 4662 struct x_display_info *dpyinfo = check_x_display_info (display);
b9dc4443
RS
4663
4664 return make_number (dpyinfo->width);
41beb8fc
RS
4665}
4666
4667DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
4668 Sx_display_pixel_height, 0, 1, 0,
08a90d6a
RS
4669 "Returns the height in pixels of the X display DISPLAY.\n\
4670The optional argument DISPLAY specifies which display to ask about.\n\
4671DISPLAY should be either a frame or a display name (a string).\n\
4672If omitted or nil, that stands for the selected frame's display.")
4673 (display)
4674 Lisp_Object display;
41beb8fc 4675{
08a90d6a 4676 struct x_display_info *dpyinfo = check_x_display_info (display);
b9dc4443
RS
4677
4678 return make_number (dpyinfo->height);
41beb8fc
RS
4679}
4680
4681DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
4682 0, 1, 0,
08a90d6a
RS
4683 "Returns the number of bitplanes of the X display DISPLAY.\n\
4684The optional argument DISPLAY specifies which display to ask about.\n\
4685DISPLAY should be either a frame or a display name (a string).\n\
4686If omitted or nil, that stands for the selected frame's display.")
4687 (display)
4688 Lisp_Object display;
41beb8fc 4689{
08a90d6a 4690 struct x_display_info *dpyinfo = check_x_display_info (display);
b9dc4443
RS
4691
4692 return make_number (dpyinfo->n_planes);
41beb8fc
RS
4693}
4694
4695DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
4696 0, 1, 0,
08a90d6a
RS
4697 "Returns the number of color cells of the X display DISPLAY.\n\
4698The optional argument DISPLAY specifies which display to ask about.\n\
4699DISPLAY should be either a frame or a display name (a string).\n\
4700If omitted or nil, that stands for the selected frame's display.")
4701 (display)
4702 Lisp_Object display;
41beb8fc 4703{
08a90d6a 4704 struct x_display_info *dpyinfo = check_x_display_info (display);
b9dc4443
RS
4705
4706 return make_number (DisplayCells (dpyinfo->display,
4707 XScreenNumberOfScreen (dpyinfo->screen)));
41beb8fc
RS
4708}
4709
9d317b2c
RS
4710DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
4711 Sx_server_max_request_size,
4712 0, 1, 0,
08a90d6a
RS
4713 "Returns the maximum request size of the X server of display DISPLAY.\n\
4714The optional argument DISPLAY specifies which display to ask about.\n\
4715DISPLAY should be either a frame or a display name (a string).\n\
4716If omitted or nil, that stands for the selected frame's display.")
4717 (display)
4718 Lisp_Object display;
9d317b2c 4719{
08a90d6a 4720 struct x_display_info *dpyinfo = check_x_display_info (display);
b9dc4443
RS
4721
4722 return make_number (MAXREQUEST (dpyinfo->display));
9d317b2c
RS
4723}
4724
41beb8fc 4725DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
08a90d6a
RS
4726 "Returns the vendor ID string of the X server of display DISPLAY.\n\
4727The optional argument DISPLAY specifies which display to ask about.\n\
4728DISPLAY should be either a frame or a display name (a string).\n\
4729If omitted or nil, that stands for the selected frame's display.")
4730 (display)
4731 Lisp_Object display;
41beb8fc 4732{
08a90d6a 4733 struct x_display_info *dpyinfo = check_x_display_info (display);
b9dc4443
RS
4734 char *vendor = ServerVendor (dpyinfo->display);
4735
41beb8fc
RS
4736 if (! vendor) vendor = "";
4737 return build_string (vendor);
4738}
4739
4740DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
08a90d6a 4741 "Returns the version numbers of the X server of display DISPLAY.\n\
41beb8fc
RS
4742The value is a list of three integers: the major and minor\n\
4743version numbers of the X Protocol in use, and the vendor-specific release\n\
08a90d6a
RS
4744number. See also the function `x-server-vendor'.\n\n\
4745The optional argument DISPLAY specifies which display to ask about.\n\
4746DISPLAY should be either a frame or a display name (a string).\n\
4747If omitted or nil, that stands for the selected frame's display.")
4748 (display)
4749 Lisp_Object display;
41beb8fc 4750{
08a90d6a 4751 struct x_display_info *dpyinfo = check_x_display_info (display);
b9dc4443 4752 Display *dpy = dpyinfo->display;
11ae94fe 4753
41beb8fc
RS
4754 return Fcons (make_number (ProtocolVersion (dpy)),
4755 Fcons (make_number (ProtocolRevision (dpy)),
4756 Fcons (make_number (VendorRelease (dpy)), Qnil)));
4757}
4758
4759DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
08a90d6a
RS
4760 "Returns the number of screens on the X server of display DISPLAY.\n\
4761The optional argument DISPLAY specifies which display to ask about.\n\
4762DISPLAY should be either a frame or a display name (a string).\n\
4763If omitted or nil, that stands for the selected frame's display.")
4764 (display)
4765 Lisp_Object display;
41beb8fc 4766{
08a90d6a 4767 struct x_display_info *dpyinfo = check_x_display_info (display);
b9dc4443
RS
4768
4769 return make_number (ScreenCount (dpyinfo->display));
41beb8fc
RS
4770}
4771
4772DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, 0,
08a90d6a
RS
4773 "Returns the height in millimeters of the X display DISPLAY.\n\
4774The optional argument DISPLAY specifies which display to ask about.\n\
4775DISPLAY should be either a frame or a display name (a string).\n\
4776If omitted or nil, that stands for the selected frame's display.")
4777 (display)
4778 Lisp_Object display;
41beb8fc 4779{
08a90d6a 4780 struct x_display_info *dpyinfo = check_x_display_info (display);
b9dc4443
RS
4781
4782 return make_number (HeightMMOfScreen (dpyinfo->screen));
41beb8fc
RS
4783}
4784
4785DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
08a90d6a
RS
4786 "Returns the width in millimeters of the X display DISPLAY.\n\
4787The optional argument DISPLAY specifies which display to ask about.\n\
4788DISPLAY should be either a frame or a display name (a string).\n\
4789If omitted or nil, that stands for the selected frame's display.")
4790 (display)
4791 Lisp_Object display;
41beb8fc 4792{
08a90d6a 4793 struct x_display_info *dpyinfo = check_x_display_info (display);
b9dc4443
RS
4794
4795 return make_number (WidthMMOfScreen (dpyinfo->screen));
41beb8fc
RS
4796}
4797
4798DEFUN ("x-display-backing-store", Fx_display_backing_store,
4799 Sx_display_backing_store, 0, 1, 0,
08a90d6a
RS
4800 "Returns an indication of whether X display DISPLAY does backing store.\n\
4801The value may be `always', `when-mapped', or `not-useful'.\n\
4802The optional argument DISPLAY specifies which display to ask about.\n\
4803DISPLAY should be either a frame or a display name (a string).\n\
4804If omitted or nil, that stands for the selected frame's display.")
4805 (display)
4806 Lisp_Object display;
41beb8fc 4807{
08a90d6a 4808 struct x_display_info *dpyinfo = check_x_display_info (display);
8ec8a5ec 4809 Lisp_Object result;
11ae94fe 4810
b9dc4443 4811 switch (DoesBackingStore (dpyinfo->screen))
41beb8fc
RS
4812 {
4813 case Always:
8ec8a5ec
GM
4814 result = intern ("always");
4815 break;
41beb8fc
RS
4816
4817 case WhenMapped:
8ec8a5ec
GM
4818 result = intern ("when-mapped");
4819 break;
41beb8fc
RS
4820
4821 case NotUseful:
8ec8a5ec
GM
4822 result = intern ("not-useful");
4823 break;
41beb8fc
RS
4824
4825 default:
4826 error ("Strange value for BackingStore parameter of screen");
8ec8a5ec 4827 result = Qnil;
41beb8fc 4828 }
8ec8a5ec
GM
4829
4830 return result;
41beb8fc
RS
4831}
4832
4833DEFUN ("x-display-visual-class", Fx_display_visual_class,
4834 Sx_display_visual_class, 0, 1, 0,
08a90d6a 4835 "Returns the visual class of the X display DISPLAY.\n\
41beb8fc 4836The value is one of the symbols `static-gray', `gray-scale',\n\
08a90d6a
RS
4837`static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
4838The optional argument DISPLAY specifies which display to ask about.\n\
4839DISPLAY should be either a frame or a display name (a string).\n\
4840If omitted or nil, that stands for the selected frame's display.")
4841 (display)
4842 Lisp_Object display;
41beb8fc 4843{
08a90d6a 4844 struct x_display_info *dpyinfo = check_x_display_info (display);
8ec8a5ec 4845 Lisp_Object result;
11ae94fe 4846
b9dc4443 4847 switch (dpyinfo->visual->class)
41beb8fc 4848 {
8ec8a5ec
GM
4849 case StaticGray:
4850 result = intern ("static-gray");
4851 break;
4852 case GrayScale:
4853 result = intern ("gray-scale");
4854 break;
4855 case StaticColor:
4856 result = intern ("static-color");
4857 break;
4858 case PseudoColor:
4859 result = intern ("pseudo-color");
4860 break;
4861 case TrueColor:
4862 result = intern ("true-color");
4863 break;
4864 case DirectColor:
4865 result = intern ("direct-color");
4866 break;
41beb8fc
RS
4867 default:
4868 error ("Display has an unknown visual class");
8ec8a5ec 4869 result = Qnil;
41beb8fc 4870 }
8ec8a5ec
GM
4871
4872 return result;
41beb8fc
RS
4873}
4874
4875DEFUN ("x-display-save-under", Fx_display_save_under,
4876 Sx_display_save_under, 0, 1, 0,
08a90d6a
RS
4877 "Returns t if the X display DISPLAY supports the save-under feature.\n\
4878The optional argument DISPLAY specifies which display to ask about.\n\
4879DISPLAY should be either a frame or a display name (a string).\n\
4880If omitted or nil, that stands for the selected frame's display.")
4881 (display)
4882 Lisp_Object display;
41beb8fc 4883{
08a90d6a 4884 struct x_display_info *dpyinfo = check_x_display_info (display);
11ae94fe 4885
b9dc4443 4886 if (DoesSaveUnders (dpyinfo->screen) == True)
41beb8fc
RS
4887 return Qt;
4888 else
4889 return Qnil;
4890}
4891\f
b9dc4443 4892int
55caf99c
RS
4893x_pixel_width (f)
4894 register struct frame *f;
01f1ba30 4895{
55caf99c 4896 return PIXEL_WIDTH (f);
01f1ba30
JB
4897}
4898
b9dc4443 4899int
55caf99c
RS
4900x_pixel_height (f)
4901 register struct frame *f;
01f1ba30 4902{
55caf99c
RS
4903 return PIXEL_HEIGHT (f);
4904}
4905
b9dc4443 4906int
55caf99c
RS
4907x_char_width (f)
4908 register struct frame *f;
4909{
7556890b 4910 return FONT_WIDTH (f->output_data.x->font);
55caf99c
RS
4911}
4912
b9dc4443 4913int
55caf99c
RS
4914x_char_height (f)
4915 register struct frame *f;
4916{
7556890b 4917 return f->output_data.x->line_height;
01f1ba30 4918}
b9dc4443
RS
4919
4920int
f03f2489
RS
4921x_screen_planes (f)
4922 register struct frame *f;
b9dc4443 4923{
f03f2489 4924 return FRAME_X_DISPLAY_INFO (f)->n_planes;
b9dc4443 4925}
01f1ba30 4926
a6ad00c0
GM
4927
4928\f
4929/************************************************************************
4930 X Displays
4931 ************************************************************************/
4932
01f1ba30 4933\f
a6ad00c0
GM
4934/* Mapping visual names to visuals. */
4935
4936static struct visual_class
4937{
4938 char *name;
4939 int class;
4940}
4941visual_classes[] =
4942{
4943 {"StaticGray", StaticGray},
4944 {"GrayScale", GrayScale},
4945 {"StaticColor", StaticColor},
4946 {"PseudoColor", PseudoColor},
4947 {"TrueColor", TrueColor},
4948 {"DirectColor", DirectColor},
4949 NULL
4950};
4951
4952
404daac1 4953#ifndef HAVE_XSCREENNUMBEROFSCREEN
a6ad00c0
GM
4954
4955/* Value is the screen number of screen SCR. This is a substitute for
4956 the X function with the same name when that doesn't exist. */
4957
404daac1
RS
4958int
4959XScreenNumberOfScreen (scr)
4960 register Screen *scr;
4961{
a6ad00c0
GM
4962 Display *dpy = scr->display;
4963 int i;
3df34fdb 4964
a6ad00c0
GM
4965 for (i = 0; i < dpy->nscreens; ++i)
4966 if (scr == dpy->screens[i])
4967 break;
404daac1 4968
a6ad00c0 4969 return i;
404daac1 4970}
a6ad00c0 4971
404daac1
RS
4972#endif /* not HAVE_XSCREENNUMBEROFSCREEN */
4973
01f1ba30 4974
a6ad00c0
GM
4975/* Select the visual that should be used on display DPYINFO. Set
4976 members of DPYINFO appropriately. Called from x_term_init. */
fe24a618 4977
a6ad00c0
GM
4978void
4979select_visual (dpyinfo)
4980 struct x_display_info *dpyinfo;
4981{
4982 Display *dpy = dpyinfo->display;
4983 Screen *screen = dpyinfo->screen;
4984 Lisp_Object value;
fe24a618 4985
a6ad00c0
GM
4986 /* See if a visual is specified. */
4987 value = display_x_get_resource (dpyinfo,
4988 build_string ("visualClass"),
4989 build_string ("VisualClass"),
4990 Qnil, Qnil);
4991 if (STRINGP (value))
4992 {
4993 /* VALUE should be of the form CLASS-DEPTH, where CLASS is one
4994 of `PseudoColor', `TrueColor' etc. and DEPTH is the color
4995 depth, a decimal number. NAME is compared with case ignored. */
4996 char *s = (char *) alloca (STRING_BYTES (XSTRING (value)) + 1);
4997 char *dash;
4998 int i, class = -1;
4999 XVisualInfo vinfo;
5000
5001 strcpy (s, XSTRING (value)->data);
5002 dash = index (s, '-');
5003 if (dash)
5004 {
5005 dpyinfo->n_planes = atoi (dash + 1);
5006 *dash = '\0';
5007 }
5008 else
5009 /* We won't find a matching visual with depth 0, so that
5010 an error will be printed below. */
5011 dpyinfo->n_planes = 0;
f0614854 5012
a6ad00c0
GM
5013 /* Determine the visual class. */
5014 for (i = 0; visual_classes[i].name; ++i)
5015 if (xstricmp (s, visual_classes[i].name) == 0)
5016 {
5017 class = visual_classes[i].class;
5018 break;
5019 }
01f1ba30 5020
a6ad00c0
GM
5021 /* Look up a matching visual for the specified class. */
5022 if (class == -1
5023 || !XMatchVisualInfo (dpy, XScreenNumberOfScreen (screen),
5024 dpyinfo->n_planes, class, &vinfo))
5025 fatal ("Invalid visual specification `%s'", XSTRING (value)->data);
5026
5027 dpyinfo->visual = vinfo.visual;
5028 }
01f1ba30
JB
5029 else
5030 {
a6ad00c0
GM
5031 int n_visuals;
5032 XVisualInfo *vinfo, vinfo_template;
5033
5034 dpyinfo->visual = DefaultVisualOfScreen (screen);
5035
5036#ifdef HAVE_X11R4
5037 vinfo_template.visualid = XVisualIDFromVisual (dpyinfo->visual);
5038#else
5039 vinfo_template.visualid = dpyinfo->visual->visualid;
5040#endif
5041 vinfo_template.screen = XScreenNumberOfScreen (screen);
5042 vinfo = XGetVisualInfo (dpy, VisualIDMask | VisualScreenMask,
5043 &vinfo_template, &n_visuals);
5044 if (n_visuals != 1)
5045 fatal ("Can't get proper X visual info");
5046
94ac875b 5047 dpyinfo->n_planes = vinfo->depth;
a6ad00c0
GM
5048 XFree ((char *) vinfo);
5049 }
01f1ba30 5050}
01f1ba30 5051
a6ad00c0 5052
b9dc4443
RS
5053/* Return the X display structure for the display named NAME.
5054 Open a new connection if necessary. */
5055
5056struct x_display_info *
5057x_display_info_for_name (name)
5058 Lisp_Object name;
5059{
08a90d6a 5060 Lisp_Object names;
b9dc4443
RS
5061 struct x_display_info *dpyinfo;
5062
5063 CHECK_STRING (name, 0);
5064
806048df
RS
5065 if (! EQ (Vwindow_system, intern ("x")))
5066 error ("Not using X Windows");
5067
08a90d6a
RS
5068 for (dpyinfo = x_display_list, names = x_display_name_list;
5069 dpyinfo;
8e713be6 5070 dpyinfo = dpyinfo->next, names = XCDR (names))
b9dc4443
RS
5071 {
5072 Lisp_Object tem;
8e713be6 5073 tem = Fstring_equal (XCAR (XCAR (names)), name);
08a90d6a 5074 if (!NILP (tem))
b9dc4443
RS
5075 return dpyinfo;
5076 }
5077
b7975ee4
KH
5078 /* Use this general default value to start with. */
5079 Vx_resource_name = Vinvocation_name;
5080
b9dc4443
RS
5081 validate_x_resource_name ();
5082
9b207e8e 5083 dpyinfo = x_term_init (name, (char *)0,
b7975ee4 5084 (char *) XSTRING (Vx_resource_name)->data);
b9dc4443 5085
08a90d6a 5086 if (dpyinfo == 0)
1b4ec1c8 5087 error ("Cannot connect to X server %s", XSTRING (name)->data);
08a90d6a 5088
b9dc4443
RS
5089 x_in_use = 1;
5090 XSETFASTINT (Vwindow_system_version, 11);
5091
5092 return dpyinfo;
5093}
5094
a6ad00c0 5095
01f1ba30 5096DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
08a90d6a 5097 1, 3, 0, "Open a connection to an X server.\n\
d387c960 5098DISPLAY is the name of the display to connect to.\n\
08a90d6a
RS
5099Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
5100If the optional third arg MUST-SUCCEED is non-nil,\n\
5101terminate Emacs if we can't open the connection.")
5102 (display, xrm_string, must_succeed)
5103 Lisp_Object display, xrm_string, must_succeed;
01f1ba30 5104{
01f1ba30 5105 unsigned char *xrm_option;
b9dc4443 5106 struct x_display_info *dpyinfo;
01f1ba30
JB
5107
5108 CHECK_STRING (display, 0);
d387c960
JB
5109 if (! NILP (xrm_string))
5110 CHECK_STRING (xrm_string, 1);
01f1ba30 5111
806048df
RS
5112 if (! EQ (Vwindow_system, intern ("x")))
5113 error ("Not using X Windows");
5114
d387c960
JB
5115 if (! NILP (xrm_string))
5116 xrm_option = (unsigned char *) XSTRING (xrm_string)->data;
01f1ba30
JB
5117 else
5118 xrm_option = (unsigned char *) 0;
d387c960
JB
5119
5120 validate_x_resource_name ();
5121
e1b1bee8 5122 /* This is what opens the connection and sets x_current_display.
b9dc4443
RS
5123 This also initializes many symbols, such as those used for input. */
5124 dpyinfo = x_term_init (display, xrm_option,
b7975ee4 5125 (char *) XSTRING (Vx_resource_name)->data);
f1c16f36 5126
08a90d6a
RS
5127 if (dpyinfo == 0)
5128 {
5129 if (!NILP (must_succeed))
1b4ec1c8
KH
5130 fatal ("Cannot connect to X server %s.\n\
5131Check the DISPLAY environment variable or use `-d'.\n\
5132Also use the `xhost' program to verify that it is set to permit\n\
5133connections from your machine.\n",
08a90d6a
RS
5134 XSTRING (display)->data);
5135 else
1b4ec1c8 5136 error ("Cannot connect to X server %s", XSTRING (display)->data);
08a90d6a
RS
5137 }
5138
b9dc4443 5139 x_in_use = 1;
01f1ba30 5140
b9dc4443 5141 XSETFASTINT (Vwindow_system_version, 11);
01f1ba30
JB
5142 return Qnil;
5143}
5144
08a90d6a
RS
5145DEFUN ("x-close-connection", Fx_close_connection,
5146 Sx_close_connection, 1, 1, 0,
5147 "Close the connection to DISPLAY's X server.\n\
5148For DISPLAY, specify either a frame or a display name (a string).\n\
5149If DISPLAY is nil, that stands for the selected frame's display.")
5150 (display)
5151 Lisp_Object display;
01f1ba30 5152{
08a90d6a 5153 struct x_display_info *dpyinfo = check_x_display_info (display);
08a90d6a 5154 int i;
3457bc6e 5155
08a90d6a
RS
5156 if (dpyinfo->reference_count > 0)
5157 error ("Display still has frames on it");
01f1ba30 5158
08a90d6a
RS
5159 BLOCK_INPUT;
5160 /* Free the fonts in the font table. */
5161 for (i = 0; i < dpyinfo->n_fonts; i++)
333b20bb
GM
5162 if (dpyinfo->font_table[i].name)
5163 {
6ecb43ce
KH
5164 if (dpyinfo->font_table[i].name != dpyinfo->font_table[i].full_name)
5165 xfree (dpyinfo->font_table[i].full_name);
333b20bb 5166 xfree (dpyinfo->font_table[i].name);
333b20bb
GM
5167 XFreeFont (dpyinfo->display, dpyinfo->font_table[i].font);
5168 }
5169
08a90d6a
RS
5170 x_destroy_all_bitmaps (dpyinfo);
5171 XSetCloseDownMode (dpyinfo->display, DestroyAll);
82c90203
RS
5172
5173#ifdef USE_X_TOOLKIT
5174 XtCloseDisplay (dpyinfo->display);
5175#else
08a90d6a 5176 XCloseDisplay (dpyinfo->display);
82c90203 5177#endif
08a90d6a
RS
5178
5179 x_delete_display (dpyinfo);
5180 UNBLOCK_INPUT;
3457bc6e 5181
01f1ba30
JB
5182 return Qnil;
5183}
5184
08a90d6a
RS
5185DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0,
5186 "Return the list of display names that Emacs has connections to.")
5187 ()
5188{
5189 Lisp_Object tail, result;
5190
5191 result = Qnil;
8e713be6
KR
5192 for (tail = x_display_name_list; ! NILP (tail); tail = XCDR (tail))
5193 result = Fcons (XCAR (XCAR (tail)), result);
08a90d6a
RS
5194
5195 return result;
5196}
5197
5198DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize, 1, 2, 0,
5199 "If ON is non-nil, report X errors as soon as the erring request is made.\n\
01f1ba30
JB
5200If ON is nil, allow buffering of requests.\n\
5201Turning on synchronization prohibits the Xlib routines from buffering\n\
5202requests and seriously degrades performance, but makes debugging much\n\
7a9a9813 5203easier.\n\
08a90d6a
RS
5204The optional second argument DISPLAY specifies which display to act on.\n\
5205DISPLAY should be either a frame or a display name (a string).\n\
5206If DISPLAY is omitted or nil, that stands for the selected frame's display.")
5207 (on, display)
5208 Lisp_Object display, on;
01f1ba30 5209{
08a90d6a 5210 struct x_display_info *dpyinfo = check_x_display_info (display);
11ae94fe 5211
b9dc4443 5212 XSynchronize (dpyinfo->display, !EQ (on, Qnil));
01f1ba30
JB
5213
5214 return Qnil;
5215}
5216
b9dc4443 5217/* Wait for responses to all X commands issued so far for frame F. */
6b7b1820
RS
5218
5219void
b9dc4443
RS
5220x_sync (f)
5221 FRAME_PTR f;
6b7b1820 5222{
4e87f4d2 5223 BLOCK_INPUT;
b9dc4443 5224 XSync (FRAME_X_DISPLAY (f), False);
4e87f4d2 5225 UNBLOCK_INPUT;
6b7b1820 5226}
333b20bb 5227
01f1ba30 5228\f
333b20bb
GM
5229/***********************************************************************
5230 Image types
5231 ***********************************************************************/
f1c16f36 5232
333b20bb
GM
5233/* Value is the number of elements of vector VECTOR. */
5234
5235#define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
5236
5237/* List of supported image types. Use define_image_type to add new
5238 types. Use lookup_image_type to find a type for a given symbol. */
5239
5240static struct image_type *image_types;
5241
333b20bb
GM
5242/* The symbol `image' which is the car of the lists used to represent
5243 images in Lisp. */
5244
5245extern Lisp_Object Qimage;
5246
5247/* The symbol `xbm' which is used as the type symbol for XBM images. */
5248
5249Lisp_Object Qxbm;
5250
5251/* Keywords. */
5252
0fe92f72 5253extern Lisp_Object QCwidth, QCheight, QCforeground, QCbackground, QCfile;
90ebdb19
GM
5254extern Lisp_Object QCdata;
5255Lisp_Object QCtype, QCascent, QCmargin, QCrelief;
d2dc8167 5256Lisp_Object QCconversion, QCcolor_symbols, QCheuristic_mask;
4a8e312c 5257Lisp_Object QCindex, QCmatrix, QCcolor_adjustment, QCmask;
333b20bb
GM
5258
5259/* Other symbols. */
5260
4a8e312c 5261Lisp_Object Qlaplace, Qemboss, Qedge_detection, Qheuristic;
333b20bb
GM
5262
5263/* Time in seconds after which images should be removed from the cache
5264 if not displayed. */
5265
fcf431dc 5266Lisp_Object Vimage_cache_eviction_delay;
333b20bb
GM
5267
5268/* Function prototypes. */
5269
5270static void define_image_type P_ ((struct image_type *type));
5271static struct image_type *lookup_image_type P_ ((Lisp_Object symbol));
5272static void image_error P_ ((char *format, Lisp_Object, Lisp_Object));
5273static void x_laplace P_ ((struct frame *, struct image *));
4a8e312c 5274static void x_emboss P_ ((struct frame *, struct image *));
45158a91
GM
5275static int x_build_heuristic_mask P_ ((struct frame *, struct image *,
5276 Lisp_Object));
333b20bb
GM
5277
5278
5279/* Define a new image type from TYPE. This adds a copy of TYPE to
5280 image_types and adds the symbol *TYPE->type to Vimage_types. */
5281
5282static void
5283define_image_type (type)
5284 struct image_type *type;
5285{
5286 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
5287 The initialized data segment is read-only. */
5288 struct image_type *p = (struct image_type *) xmalloc (sizeof *p);
5289 bcopy (type, p, sizeof *p);
5290 p->next = image_types;
5291 image_types = p;
5292 Vimage_types = Fcons (*p->type, Vimage_types);
5293}
5294
5295
5296/* Look up image type SYMBOL, and return a pointer to its image_type
5297 structure. Value is null if SYMBOL is not a known image type. */
5298
5299static INLINE struct image_type *
5300lookup_image_type (symbol)
5301 Lisp_Object symbol;
5302{
5303 struct image_type *type;
5304
5305 for (type = image_types; type; type = type->next)
5306 if (EQ (symbol, *type->type))
5307 break;
5308
5309 return type;
5310}
5311
5312
5313/* Value is non-zero if OBJECT is a valid Lisp image specification. A
5314 valid image specification is a list whose car is the symbol
5315 `image', and whose rest is a property list. The property list must
5316 contain a value for key `:type'. That value must be the name of a
5317 supported image type. The rest of the property list depends on the
5318 image type. */
5319
5320int
5321valid_image_p (object)
5322 Lisp_Object object;
5323{
5324 int valid_p = 0;
5325
5326 if (CONSP (object) && EQ (XCAR (object), Qimage))
5327 {
1783ffa2
GM
5328 Lisp_Object tem;
5329
5330 for (tem = XCDR (object); CONSP (tem); tem = XCDR (tem))
5331 if (EQ (XCAR (tem), QCtype))
5332 {
5333 tem = XCDR (tem);
5334 if (CONSP (tem) && SYMBOLP (XCAR (tem)))
5335 {
5336 struct image_type *type;
5337 type = lookup_image_type (XCAR (tem));
5338 if (type)
5339 valid_p = type->valid_p (object);
5340 }
5341
5342 break;
5343 }
333b20bb
GM
5344 }
5345
5346 return valid_p;
5347}
5348
5349
7ab1745f
GM
5350/* Log error message with format string FORMAT and argument ARG.
5351 Signaling an error, e.g. when an image cannot be loaded, is not a
5352 good idea because this would interrupt redisplay, and the error
5353 message display would lead to another redisplay. This function
5354 therefore simply displays a message. */
333b20bb
GM
5355
5356static void
5357image_error (format, arg1, arg2)
5358 char *format;
5359 Lisp_Object arg1, arg2;
5360{
7ab1745f 5361 add_to_log (format, arg1, arg2);
333b20bb
GM
5362}
5363
5364
5365\f
5366/***********************************************************************
5367 Image specifications
5368 ***********************************************************************/
5369
5370enum image_value_type
5371{
5372 IMAGE_DONT_CHECK_VALUE_TYPE,
5373 IMAGE_STRING_VALUE,
6f1be3b9 5374 IMAGE_STRING_OR_NIL_VALUE,
333b20bb
GM
5375 IMAGE_SYMBOL_VALUE,
5376 IMAGE_POSITIVE_INTEGER_VALUE,
3ed61e75 5377 IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR,
333b20bb 5378 IMAGE_NON_NEGATIVE_INTEGER_VALUE,
7c7ff7f5 5379 IMAGE_ASCENT_VALUE,
333b20bb
GM
5380 IMAGE_INTEGER_VALUE,
5381 IMAGE_FUNCTION_VALUE,
5382 IMAGE_NUMBER_VALUE,
5383 IMAGE_BOOL_VALUE
5384};
5385
5386/* Structure used when parsing image specifications. */
5387
5388struct image_keyword
5389{
5390 /* Name of keyword. */
5391 char *name;
5392
5393 /* The type of value allowed. */
5394 enum image_value_type type;
5395
5396 /* Non-zero means key must be present. */
5397 int mandatory_p;
5398
5399 /* Used to recognize duplicate keywords in a property list. */
5400 int count;
5401
5402 /* The value that was found. */
5403 Lisp_Object value;
5404};
5405
5406
bfd2209f
GM
5407static int parse_image_spec P_ ((Lisp_Object, struct image_keyword *,
5408 int, Lisp_Object));
333b20bb
GM
5409static Lisp_Object image_spec_value P_ ((Lisp_Object, Lisp_Object, int *));
5410
5411
5412/* Parse image spec SPEC according to KEYWORDS. A valid image spec
5413 has the format (image KEYWORD VALUE ...). One of the keyword/
5414 value pairs must be `:type TYPE'. KEYWORDS is a vector of
5415 image_keywords structures of size NKEYWORDS describing other
bfd2209f 5416 allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
333b20bb
GM
5417
5418static int
bfd2209f 5419parse_image_spec (spec, keywords, nkeywords, type)
333b20bb
GM
5420 Lisp_Object spec;
5421 struct image_keyword *keywords;
5422 int nkeywords;
5423 Lisp_Object type;
333b20bb
GM
5424{
5425 int i;
5426 Lisp_Object plist;
5427
5428 if (!CONSP (spec) || !EQ (XCAR (spec), Qimage))
5429 return 0;
5430
5431 plist = XCDR (spec);
5432 while (CONSP (plist))
5433 {
5434 Lisp_Object key, value;
5435
5436 /* First element of a pair must be a symbol. */
5437 key = XCAR (plist);
5438 plist = XCDR (plist);
5439 if (!SYMBOLP (key))
5440 return 0;
5441
5442 /* There must follow a value. */
5443 if (!CONSP (plist))
5444 return 0;
5445 value = XCAR (plist);
5446 plist = XCDR (plist);
5447
5448 /* Find key in KEYWORDS. Error if not found. */
5449 for (i = 0; i < nkeywords; ++i)
5450 if (strcmp (keywords[i].name, XSYMBOL (key)->name->data) == 0)
5451 break;
5452
5453 if (i == nkeywords)
bfd2209f 5454 continue;
333b20bb
GM
5455
5456 /* Record that we recognized the keyword. If a keywords
5457 was found more than once, it's an error. */
5458 keywords[i].value = value;
5459 ++keywords[i].count;
5460
5461 if (keywords[i].count > 1)
5462 return 0;
5463
5464 /* Check type of value against allowed type. */
5465 switch (keywords[i].type)
5466 {
5467 case IMAGE_STRING_VALUE:
5468 if (!STRINGP (value))
5469 return 0;
5470 break;
5471
6f1be3b9
GM
5472 case IMAGE_STRING_OR_NIL_VALUE:
5473 if (!STRINGP (value) && !NILP (value))
5474 return 0;
5475 break;
5476
333b20bb
GM
5477 case IMAGE_SYMBOL_VALUE:
5478 if (!SYMBOLP (value))
5479 return 0;
5480 break;
5481
5482 case IMAGE_POSITIVE_INTEGER_VALUE:
5483 if (!INTEGERP (value) || XINT (value) <= 0)
5484 return 0;
5485 break;
5486
3ed61e75
GM
5487 case IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR:
5488 if (INTEGERP (value) && XINT (value) >= 0)
5489 break;
5490 if (CONSP (value)
5491 && INTEGERP (XCAR (value)) && INTEGERP (XCDR (value))
5492 && XINT (XCAR (value)) >= 0 && XINT (XCDR (value)) >= 0)
5493 break;
5494 return 0;
5495
7c7ff7f5
GM
5496 case IMAGE_ASCENT_VALUE:
5497 if (SYMBOLP (value) && EQ (value, Qcenter))
5498 break;
5499 else if (INTEGERP (value)
5500 && XINT (value) >= 0
5501 && XINT (value) <= 100)
5502 break;
5503 return 0;
5504
333b20bb
GM
5505 case IMAGE_NON_NEGATIVE_INTEGER_VALUE:
5506 if (!INTEGERP (value) || XINT (value) < 0)
5507 return 0;
5508 break;
5509
5510 case IMAGE_DONT_CHECK_VALUE_TYPE:
5511 break;
5512
5513 case IMAGE_FUNCTION_VALUE:
5514 value = indirect_function (value);
5515 if (SUBRP (value)
5516 || COMPILEDP (value)
5517 || (CONSP (value) && EQ (XCAR (value), Qlambda)))
5518 break;
5519 return 0;
5520
5521 case IMAGE_NUMBER_VALUE:
5522 if (!INTEGERP (value) && !FLOATP (value))
5523 return 0;
5524 break;
5525
5526 case IMAGE_INTEGER_VALUE:
5527 if (!INTEGERP (value))
5528 return 0;
5529 break;
5530
5531 case IMAGE_BOOL_VALUE:
5532 if (!NILP (value) && !EQ (value, Qt))
5533 return 0;
5534 break;
5535
5536 default:
5537 abort ();
5538 break;
5539 }
5540
5541 if (EQ (key, QCtype) && !EQ (type, value))
5542 return 0;
5543 }
5544
5545 /* Check that all mandatory fields are present. */
5546 for (i = 0; i < nkeywords; ++i)
5547 if (keywords[i].mandatory_p && keywords[i].count == 0)
5548 return 0;
5549
5550 return NILP (plist);
5551}
5552
5553
5554/* Return the value of KEY in image specification SPEC. Value is nil
5555 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
5556 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
5557
5558static Lisp_Object
5559image_spec_value (spec, key, found)
5560 Lisp_Object spec, key;
5561 int *found;
5562{
5563 Lisp_Object tail;
5564
5565 xassert (valid_image_p (spec));
5566
5567 for (tail = XCDR (spec);
5568 CONSP (tail) && CONSP (XCDR (tail));
5569 tail = XCDR (XCDR (tail)))
5570 {
5571 if (EQ (XCAR (tail), key))
5572 {
5573 if (found)
5574 *found = 1;
5575 return XCAR (XCDR (tail));
5576 }
5577 }
5578
5579 if (found)
5580 *found = 0;
5581 return Qnil;
5582}
5583
5584
42677916
GM
5585DEFUN ("image-size", Fimage_size, Simage_size, 1, 3, 0,
5586 "Return the size of image SPEC as pair (WIDTH . HEIGHT).\n\
5587PIXELS non-nil means return the size in pixels, otherwise return the\n\
5588size in canonical character units.\n\
5589FRAME is the frame on which the image will be displayed. FRAME nil\n\
5590or omitted means use the selected frame.")
5591 (spec, pixels, frame)
5592 Lisp_Object spec, pixels, frame;
5593{
5594 Lisp_Object size;
5595
5596 size = Qnil;
5597 if (valid_image_p (spec))
5598 {
5599 struct frame *f = check_x_frame (frame);
83676598 5600 int id = lookup_image (f, spec);
42677916 5601 struct image *img = IMAGE_FROM_ID (f, id);
3ed61e75
GM
5602 int width = img->width + 2 * img->hmargin;
5603 int height = img->height + 2 * img->vmargin;
42677916
GM
5604
5605 if (NILP (pixels))
5606 size = Fcons (make_float ((double) width / CANON_X_UNIT (f)),
5607 make_float ((double) height / CANON_Y_UNIT (f)));
5608 else
5609 size = Fcons (make_number (width), make_number (height));
5610 }
5611 else
5612 error ("Invalid image specification");
5613
5614 return size;
5615}
5616
333b20bb 5617
b243755a
GM
5618DEFUN ("image-mask-p", Fimage_mask_p, Simage_mask_p, 1, 2, 0,
5619 "Return t if image SPEC has a mask bitmap.\n\
5620FRAME is the frame on which the image will be displayed. FRAME nil\n\
5621or omitted means use the selected frame.")
5622 (spec, frame)
5623 Lisp_Object spec, frame;
5624{
5625 Lisp_Object mask;
5626
5627 mask = Qnil;
5628 if (valid_image_p (spec))
5629 {
5630 struct frame *f = check_x_frame (frame);
83676598 5631 int id = lookup_image (f, spec);
b243755a
GM
5632 struct image *img = IMAGE_FROM_ID (f, id);
5633 if (img->mask)
5634 mask = Qt;
5635 }
5636 else
5637 error ("Invalid image specification");
5638
5639 return mask;
5640}
5641
5642
333b20bb
GM
5643\f
5644/***********************************************************************
5645 Image type independent image structures
5646 ***********************************************************************/
5647
5648static struct image *make_image P_ ((Lisp_Object spec, unsigned hash));
5649static void free_image P_ ((struct frame *f, struct image *img));
5650
5651
5652/* Allocate and return a new image structure for image specification
5653 SPEC. SPEC has a hash value of HASH. */
5654
5655static struct image *
5656make_image (spec, hash)
5657 Lisp_Object spec;
5658 unsigned hash;
5659{
5660 struct image *img = (struct image *) xmalloc (sizeof *img);
5661
5662 xassert (valid_image_p (spec));
5663 bzero (img, sizeof *img);
5664 img->type = lookup_image_type (image_spec_value (spec, QCtype, NULL));
5665 xassert (img->type != NULL);
5666 img->spec = spec;
5667 img->data.lisp_val = Qnil;
5668 img->ascent = DEFAULT_IMAGE_ASCENT;
5669 img->hash = hash;
5670 return img;
5671}
5672
5673
5674/* Free image IMG which was used on frame F, including its resources. */
5675
5676static void
5677free_image (f, img)
5678 struct frame *f;
5679 struct image *img;
5680{
5681 if (img)
5682 {
5683 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
5684
5685 /* Remove IMG from the hash table of its cache. */
5686 if (img->prev)
5687 img->prev->next = img->next;
5688 else
5689 c->buckets[img->hash % IMAGE_CACHE_BUCKETS_SIZE] = img->next;
5690
5691 if (img->next)
5692 img->next->prev = img->prev;
5693
5694 c->images[img->id] = NULL;
5695
5696 /* Free resources, then free IMG. */
5697 img->type->free (f, img);
5698 xfree (img);
5699 }
5700}
5701
5702
5703/* Prepare image IMG for display on frame F. Must be called before
5704 drawing an image. */
5705
5706void
5707prepare_image_for_display (f, img)
5708 struct frame *f;
5709 struct image *img;
5710{
5711 EMACS_TIME t;
5712
5713 /* We're about to display IMG, so set its timestamp to `now'. */
5714 EMACS_GET_TIME (t);
5715 img->timestamp = EMACS_SECS (t);
5716
5717 /* If IMG doesn't have a pixmap yet, load it now, using the image
5718 type dependent loader function. */
dd00328a 5719 if (img->pixmap == None && !img->load_failed_p)
209061be 5720 img->load_failed_p = img->type->load (f, img) == 0;
333b20bb
GM
5721}
5722
5723
7c7ff7f5
GM
5724/* Value is the number of pixels for the ascent of image IMG when
5725 drawn in face FACE. */
5726
5727int
5728image_ascent (img, face)
5729 struct image *img;
5730 struct face *face;
5731{
3ed61e75 5732 int height = img->height + img->vmargin;
7c7ff7f5
GM
5733 int ascent;
5734
5735 if (img->ascent == CENTERED_IMAGE_ASCENT)
5736 {
5737 if (face->font)
3694cb3f
MB
5738 /* This expression is arranged so that if the image can't be
5739 exactly centered, it will be moved slightly up. This is
5740 because a typical font is `top-heavy' (due to the presence
5741 uppercase letters), so the image placement should err towards
5742 being top-heavy too. It also just generally looks better. */
5743 ascent = (height + face->font->ascent - face->font->descent + 1) / 2;
7c7ff7f5
GM
5744 else
5745 ascent = height / 2;
5746 }
5747 else
5748 ascent = height * img->ascent / 100.0;
5749
5750 return ascent;
5751}
5752
5753
333b20bb
GM
5754\f
5755/***********************************************************************
5756 Helper functions for X image types
5757 ***********************************************************************/
5758
dd00328a
GM
5759static void x_clear_image_1 P_ ((struct frame *, struct image *, int,
5760 int, int));
333b20bb
GM
5761static void x_clear_image P_ ((struct frame *f, struct image *img));
5762static unsigned long x_alloc_image_color P_ ((struct frame *f,
5763 struct image *img,
5764 Lisp_Object color_name,
5765 unsigned long dflt));
5766
dd00328a
GM
5767
5768/* Clear X resources of image IMG on frame F. PIXMAP_P non-zero means
5769 free the pixmap if any. MASK_P non-zero means clear the mask
5770 pixmap if any. COLORS_P non-zero means free colors allocated for
5771 the image, if any. */
333b20bb
GM
5772
5773static void
dd00328a 5774x_clear_image_1 (f, img, pixmap_p, mask_p, colors_p)
333b20bb
GM
5775 struct frame *f;
5776 struct image *img;
dd00328a 5777 int pixmap_p, mask_p, colors_p;
333b20bb 5778{
dd00328a 5779 if (pixmap_p && img->pixmap)
333b20bb 5780 {
333b20bb 5781 XFreePixmap (FRAME_X_DISPLAY (f), img->pixmap);
dd00328a 5782 img->pixmap = None;
f4779de9
GM
5783 }
5784
dd00328a 5785 if (mask_p && img->mask)
f4779de9
GM
5786 {
5787 XFreePixmap (FRAME_X_DISPLAY (f), img->mask);
dd00328a 5788 img->mask = None;
333b20bb
GM
5789 }
5790
dd00328a 5791 if (colors_p && img->ncolors)
333b20bb 5792 {
462d5d40 5793 x_free_colors (f, img->colors, img->ncolors);
333b20bb
GM
5794 xfree (img->colors);
5795 img->colors = NULL;
5796 img->ncolors = 0;
5797 }
dd00328a
GM
5798}
5799
5800/* Free X resources of image IMG which is used on frame F. */
5801
5802static void
5803x_clear_image (f, img)
5804 struct frame *f;
5805 struct image *img;
5806{
5807 BLOCK_INPUT;
5808 x_clear_image_1 (f, img, 1, 1, 1);
f4779de9 5809 UNBLOCK_INPUT;
333b20bb
GM
5810}
5811
5812
5813/* Allocate color COLOR_NAME for image IMG on frame F. If color
5814 cannot be allocated, use DFLT. Add a newly allocated color to
5815 IMG->colors, so that it can be freed again. Value is the pixel
5816 color. */
5817
5818static unsigned long
5819x_alloc_image_color (f, img, color_name, dflt)
5820 struct frame *f;
5821 struct image *img;
5822 Lisp_Object color_name;
5823 unsigned long dflt;
5824{
5825 XColor color;
5826 unsigned long result;
5827
5828 xassert (STRINGP (color_name));
5829
2d764c78 5830 if (x_defined_color (f, XSTRING (color_name)->data, &color, 1))
333b20bb
GM
5831 {
5832 /* This isn't called frequently so we get away with simply
5833 reallocating the color vector to the needed size, here. */
5834 ++img->ncolors;
5835 img->colors =
5836 (unsigned long *) xrealloc (img->colors,
5837 img->ncolors * sizeof *img->colors);
5838 img->colors[img->ncolors - 1] = color.pixel;
5839 result = color.pixel;
5840 }
5841 else
5842 result = dflt;
5843
5844 return result;
5845}
5846
5847
5848\f
5849/***********************************************************************
5850 Image Cache
5851 ***********************************************************************/
5852
5853static void cache_image P_ ((struct frame *f, struct image *img));
ad18ffb1 5854static void postprocess_image P_ ((struct frame *, struct image *));
333b20bb
GM
5855
5856
5857/* Return a new, initialized image cache that is allocated from the
5858 heap. Call free_image_cache to free an image cache. */
5859
5860struct image_cache *
5861make_image_cache ()
5862{
5863 struct image_cache *c = (struct image_cache *) xmalloc (sizeof *c);
5864 int size;
5865
5866 bzero (c, sizeof *c);
5867 c->size = 50;
5868 c->images = (struct image **) xmalloc (c->size * sizeof *c->images);
5869 size = IMAGE_CACHE_BUCKETS_SIZE * sizeof *c->buckets;
5870 c->buckets = (struct image **) xmalloc (size);
5871 bzero (c->buckets, size);
5872 return c;
5873}
5874
5875
5876/* Free image cache of frame F. Be aware that X frames share images
5877 caches. */
5878
5879void
5880free_image_cache (f)
5881 struct frame *f;
5882{
5883 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
5884 if (c)
5885 {
5886 int i;
5887
5888 /* Cache should not be referenced by any frame when freed. */
5889 xassert (c->refcount == 0);
5890
5891 for (i = 0; i < c->used; ++i)
5892 free_image (f, c->images[i]);
5893 xfree (c->images);
333b20bb 5894 xfree (c->buckets);
e3130015 5895 xfree (c);
333b20bb
GM
5896 FRAME_X_IMAGE_CACHE (f) = NULL;
5897 }
5898}
5899
5900
5901/* Clear image cache of frame F. FORCE_P non-zero means free all
5902 images. FORCE_P zero means clear only images that haven't been
5903 displayed for some time. Should be called from time to time to
5904 reduce the number of loaded images. If image-eviction-seconds is
5905 non-nil, this frees images in the cache which weren't displayed for
5906 at least that many seconds. */
5907
5908void
5909clear_image_cache (f, force_p)
5910 struct frame *f;
5911 int force_p;
5912{
5913 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
5914
83676598 5915 if (c && INTEGERP (Vimage_cache_eviction_delay))
333b20bb
GM
5916 {
5917 EMACS_TIME t;
5918 unsigned long old;
f4779de9 5919 int i, nfreed;
333b20bb
GM
5920
5921 EMACS_GET_TIME (t);
fcf431dc 5922 old = EMACS_SECS (t) - XFASTINT (Vimage_cache_eviction_delay);
f4779de9
GM
5923
5924 /* Block input so that we won't be interrupted by a SIGIO
5925 while being in an inconsistent state. */
5926 BLOCK_INPUT;
333b20bb 5927
f4779de9 5928 for (i = nfreed = 0; i < c->used; ++i)
333b20bb
GM
5929 {
5930 struct image *img = c->images[i];
5931 if (img != NULL
f4779de9 5932 && (force_p || img->timestamp < old))
333b20bb
GM
5933 {
5934 free_image (f, img);
f4779de9 5935 ++nfreed;
333b20bb
GM
5936 }
5937 }
5938
5939 /* We may be clearing the image cache because, for example,
5940 Emacs was iconified for a longer period of time. In that
5941 case, current matrices may still contain references to
5942 images freed above. So, clear these matrices. */
f4779de9 5943 if (nfreed)
333b20bb 5944 {
f4779de9
GM
5945 Lisp_Object tail, frame;
5946
5947 FOR_EACH_FRAME (tail, frame)
5948 {
5949 struct frame *f = XFRAME (frame);
5950 if (FRAME_X_P (f)
5951 && FRAME_X_IMAGE_CACHE (f) == c)
83676598 5952 clear_current_matrices (f);
f4779de9
GM
5953 }
5954
333b20bb
GM
5955 ++windows_or_buffers_changed;
5956 }
f4779de9
GM
5957
5958 UNBLOCK_INPUT;
333b20bb
GM
5959 }
5960}
5961
5962
5963DEFUN ("clear-image-cache", Fclear_image_cache, Sclear_image_cache,
5964 0, 1, 0,
5965 "Clear the image cache of FRAME.\n\
5966FRAME nil or omitted means use the selected frame.\n\
5967FRAME t means clear the image caches of all frames.")
5968 (frame)
5969 Lisp_Object frame;
5970{
5971 if (EQ (frame, Qt))
5972 {
5973 Lisp_Object tail;
5974
5975 FOR_EACH_FRAME (tail, frame)
5976 if (FRAME_X_P (XFRAME (frame)))
5977 clear_image_cache (XFRAME (frame), 1);
5978 }
5979 else
5980 clear_image_cache (check_x_frame (frame), 1);
5981
5982 return Qnil;
5983}
5984
5985
ad18ffb1
GM
5986/* Compute masks and transform image IMG on frame F, as specified
5987 by the image's specification, */
5988
5989static void
5990postprocess_image (f, img)
5991 struct frame *f;
5992 struct image *img;
5993{
5994 /* Manipulation of the image's mask. */
5995 if (img->pixmap)
5996 {
5997 Lisp_Object conversion, spec;
5998 Lisp_Object mask;
5999
6000 spec = img->spec;
6001
6002 /* `:heuristic-mask t'
6003 `:mask heuristic'
6004 means build a mask heuristically.
6005 `:heuristic-mask (R G B)'
6006 `:mask (heuristic (R G B))'
6007 means build a mask from color (R G B) in the
6008 image.
6009 `:mask nil'
6010 means remove a mask, if any. */
6011
6012 mask = image_spec_value (spec, QCheuristic_mask, NULL);
6013 if (!NILP (mask))
6014 x_build_heuristic_mask (f, img, mask);
6015 else
6016 {
6017 int found_p;
6018
6019 mask = image_spec_value (spec, QCmask, &found_p);
6020
6021 if (EQ (mask, Qheuristic))
6022 x_build_heuristic_mask (f, img, Qt);
6023 else if (CONSP (mask)
6024 && EQ (XCAR (mask), Qheuristic))
6025 {
6026 if (CONSP (XCDR (mask)))
6027 x_build_heuristic_mask (f, img, XCAR (XCDR (mask)));
6028 else
6029 x_build_heuristic_mask (f, img, XCDR (mask));
6030 }
6031 else if (NILP (mask) && found_p && img->mask)
6032 {
6033 XFreePixmap (FRAME_X_DISPLAY (f), img->mask);
6034 img->mask = None;
6035 }
6036 }
6037
6038
6039 /* Should we apply an image transformation algorithm? */
6040 conversion = image_spec_value (spec, QCconversion, NULL);
6041 if (EQ (conversion, Qdisabled))
6042 x_disable_image (f, img);
6043 else if (EQ (conversion, Qlaplace))
6044 x_laplace (f, img);
6045 else if (EQ (conversion, Qemboss))
6046 x_emboss (f, img);
6047 else if (CONSP (conversion)
6048 && EQ (XCAR (conversion), Qedge_detection))
6049 {
6050 Lisp_Object tem;
6051 tem = XCDR (conversion);
6052 if (CONSP (tem))
6053 x_edge_detection (f, img,
6054 Fplist_get (tem, QCmatrix),
6055 Fplist_get (tem, QCcolor_adjustment));
6056 }
6057 }
6058}
6059
6060
333b20bb 6061/* Return the id of image with Lisp specification SPEC on frame F.
83676598 6062 SPEC must be a valid Lisp image specification (see valid_image_p). */
333b20bb
GM
6063
6064int
83676598 6065lookup_image (f, spec)
333b20bb
GM
6066 struct frame *f;
6067 Lisp_Object spec;
6068{
6069 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
6070 struct image *img;
6071 int i;
6072 unsigned hash;
6073 struct gcpro gcpro1;
4f7ca1f1 6074 EMACS_TIME now;
333b20bb
GM
6075
6076 /* F must be a window-system frame, and SPEC must be a valid image
6077 specification. */
6078 xassert (FRAME_WINDOW_P (f));
6079 xassert (valid_image_p (spec));
6080
6081 GCPRO1 (spec);
6082
6083 /* Look up SPEC in the hash table of the image cache. */
6084 hash = sxhash (spec, 0);
6085 i = hash % IMAGE_CACHE_BUCKETS_SIZE;
6086
6087 for (img = c->buckets[i]; img; img = img->next)
6088 if (img->hash == hash && !NILP (Fequal (img->spec, spec)))
6089 break;
6090
6091 /* If not found, create a new image and cache it. */
6092 if (img == NULL)
6093 {
ad18ffb1
GM
6094 extern Lisp_Object Qpostscript;
6095
28c7826c 6096 BLOCK_INPUT;
333b20bb
GM
6097 img = make_image (spec, hash);
6098 cache_image (f, img);
83676598 6099 img->load_failed_p = img->type->load (f, img) == 0;
333b20bb
GM
6100
6101 /* If we can't load the image, and we don't have a width and
6102 height, use some arbitrary width and height so that we can
6103 draw a rectangle for it. */
83676598 6104 if (img->load_failed_p)
333b20bb
GM
6105 {
6106 Lisp_Object value;
6107
6108 value = image_spec_value (spec, QCwidth, NULL);
6109 img->width = (INTEGERP (value)
6110 ? XFASTINT (value) : DEFAULT_IMAGE_WIDTH);
6111 value = image_spec_value (spec, QCheight, NULL);
6112 img->height = (INTEGERP (value)
6113 ? XFASTINT (value) : DEFAULT_IMAGE_HEIGHT);
6114 }
6115 else
6116 {
6117 /* Handle image type independent image attributes
7c7ff7f5 6118 `:ascent ASCENT', `:margin MARGIN', `:relief RELIEF'. */
14819cb3 6119 Lisp_Object ascent, margin, relief;
333b20bb
GM
6120
6121 ascent = image_spec_value (spec, QCascent, NULL);
6122 if (INTEGERP (ascent))
6123 img->ascent = XFASTINT (ascent);
7c7ff7f5
GM
6124 else if (EQ (ascent, Qcenter))
6125 img->ascent = CENTERED_IMAGE_ASCENT;
333b20bb
GM
6126
6127 margin = image_spec_value (spec, QCmargin, NULL);
6128 if (INTEGERP (margin) && XINT (margin) >= 0)
3ed61e75
GM
6129 img->vmargin = img->hmargin = XFASTINT (margin);
6130 else if (CONSP (margin) && INTEGERP (XCAR (margin))
6131 && INTEGERP (XCDR (margin)))
6132 {
6133 if (XINT (XCAR (margin)) > 0)
6134 img->hmargin = XFASTINT (XCAR (margin));
6135 if (XINT (XCDR (margin)) > 0)
6136 img->vmargin = XFASTINT (XCDR (margin));
6137 }
333b20bb
GM
6138
6139 relief = image_spec_value (spec, QCrelief, NULL);
6140 if (INTEGERP (relief))
6141 {
6142 img->relief = XINT (relief);
3ed61e75
GM
6143 img->hmargin += abs (img->relief);
6144 img->vmargin += abs (img->relief);
333b20bb
GM
6145 }
6146
ad18ffb1
GM
6147 /* Do image transformations and compute masks, unless we
6148 don't have the image yet. */
6149 if (!EQ (*img->type->type, Qpostscript))
6150 postprocess_image (f, img);
333b20bb 6151 }
dd00328a 6152
28c7826c
GM
6153 UNBLOCK_INPUT;
6154 xassert (!interrupt_input_blocked);
333b20bb
GM
6155 }
6156
4f7ca1f1
GM
6157 /* We're using IMG, so set its timestamp to `now'. */
6158 EMACS_GET_TIME (now);
6159 img->timestamp = EMACS_SECS (now);
6160
333b20bb
GM
6161 UNGCPRO;
6162
6163 /* Value is the image id. */
6164 return img->id;
6165}
6166
6167
6168/* Cache image IMG in the image cache of frame F. */
6169
6170static void
6171cache_image (f, img)
6172 struct frame *f;
6173 struct image *img;
6174{
6175 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
6176 int i;
6177
6178 /* Find a free slot in c->images. */
6179 for (i = 0; i < c->used; ++i)
6180 if (c->images[i] == NULL)
6181 break;
6182
6183 /* If no free slot found, maybe enlarge c->images. */
6184 if (i == c->used && c->used == c->size)
6185 {
6186 c->size *= 2;
6187 c->images = (struct image **) xrealloc (c->images,
6188 c->size * sizeof *c->images);
6189 }
6190
6191 /* Add IMG to c->images, and assign IMG an id. */
6192 c->images[i] = img;
6193 img->id = i;
6194 if (i == c->used)
6195 ++c->used;
6196
6197 /* Add IMG to the cache's hash table. */
6198 i = img->hash % IMAGE_CACHE_BUCKETS_SIZE;
6199 img->next = c->buckets[i];
6200 if (img->next)
6201 img->next->prev = img;
6202 img->prev = NULL;
6203 c->buckets[i] = img;
6204}
6205
6206
6207/* Call FN on every image in the image cache of frame F. Used to mark
6208 Lisp Objects in the image cache. */
6209
6210void
6211forall_images_in_image_cache (f, fn)
6212 struct frame *f;
6213 void (*fn) P_ ((struct image *img));
6214{
6215 if (FRAME_LIVE_P (f) && FRAME_X_P (f))
6216 {
6217 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
6218 if (c)
6219 {
6220 int i;
6221 for (i = 0; i < c->used; ++i)
6222 if (c->images[i])
6223 fn (c->images[i]);
6224 }
6225 }
6226}
6227
6228
6229\f
6230/***********************************************************************
6231 X support code
6232 ***********************************************************************/
6233
45158a91
GM
6234static int x_create_x_image_and_pixmap P_ ((struct frame *, int, int, int,
6235 XImage **, Pixmap *));
333b20bb
GM
6236static void x_destroy_x_image P_ ((XImage *));
6237static void x_put_x_image P_ ((struct frame *, XImage *, Pixmap, int, int));
6238
6239
6240/* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
6241 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
6242 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
6243 via xmalloc. Print error messages via image_error if an error
45158a91 6244 occurs. Value is non-zero if successful. */
333b20bb
GM
6245
6246static int
45158a91 6247x_create_x_image_and_pixmap (f, width, height, depth, ximg, pixmap)
333b20bb 6248 struct frame *f;
333b20bb
GM
6249 int width, height, depth;
6250 XImage **ximg;
6251 Pixmap *pixmap;
6252{
6253 Display *display = FRAME_X_DISPLAY (f);
6254 Screen *screen = FRAME_X_SCREEN (f);
6255 Window window = FRAME_X_WINDOW (f);
6256
6257 xassert (interrupt_input_blocked);
6258
6259 if (depth <= 0)
6260 depth = DefaultDepthOfScreen (screen);
6261 *ximg = XCreateImage (display, DefaultVisualOfScreen (screen),
6262 depth, ZPixmap, 0, NULL, width, height,
6263 depth > 16 ? 32 : depth > 8 ? 16 : 8, 0);
6264 if (*ximg == NULL)
6265 {
45158a91 6266 image_error ("Unable to allocate X image", Qnil, Qnil);
333b20bb
GM
6267 return 0;
6268 }
6269
6270 /* Allocate image raster. */
6271 (*ximg)->data = (char *) xmalloc ((*ximg)->bytes_per_line * height);
6272
6273 /* Allocate a pixmap of the same size. */
6274 *pixmap = XCreatePixmap (display, window, width, height, depth);
dd00328a 6275 if (*pixmap == None)
333b20bb
GM
6276 {
6277 x_destroy_x_image (*ximg);
6278 *ximg = NULL;
45158a91 6279 image_error ("Unable to create X pixmap", Qnil, Qnil);
333b20bb
GM
6280 return 0;
6281 }
6282
6283 return 1;
6284}
6285
6286
6287/* Destroy XImage XIMG. Free XIMG->data. */
6288
6289static void
6290x_destroy_x_image (ximg)
6291 XImage *ximg;
6292{
6293 xassert (interrupt_input_blocked);
6294 if (ximg)
6295 {
6296 xfree (ximg->data);
6297 ximg->data = NULL;
6298 XDestroyImage (ximg);
6299 }
6300}
6301
6302
6303/* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
6304 are width and height of both the image and pixmap. */
6305
ea6b19ca 6306static void
333b20bb
GM
6307x_put_x_image (f, ximg, pixmap, width, height)
6308 struct frame *f;
6309 XImage *ximg;
6310 Pixmap pixmap;
6311{
6312 GC gc;
6313
6314 xassert (interrupt_input_blocked);
6315 gc = XCreateGC (FRAME_X_DISPLAY (f), pixmap, 0, NULL);
6316 XPutImage (FRAME_X_DISPLAY (f), pixmap, gc, ximg, 0, 0, 0, 0, width, height);
6317 XFreeGC (FRAME_X_DISPLAY (f), gc);
6318}
6319
6320
6321\f
6322/***********************************************************************
5be6c3b0 6323 File Handling
333b20bb
GM
6324 ***********************************************************************/
6325
6326static Lisp_Object x_find_image_file P_ ((Lisp_Object));
5be6c3b0
GM
6327static char *slurp_file P_ ((char *, int *));
6328
333b20bb
GM
6329
6330/* Find image file FILE. Look in data-directory, then
6331 x-bitmap-file-path. Value is the full name of the file found, or
6332 nil if not found. */
6333
6334static Lisp_Object
6335x_find_image_file (file)
6336 Lisp_Object file;
6337{
6338 Lisp_Object file_found, search_path;
6339 struct gcpro gcpro1, gcpro2;
6340 int fd;
6341
6342 file_found = Qnil;
6343 search_path = Fcons (Vdata_directory, Vx_bitmap_file_path);
6344 GCPRO2 (file_found, search_path);
6345
6346 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
6347 fd = openp (search_path, file, "", &file_found, 0);
6348
939d6465 6349 if (fd == -1)
333b20bb
GM
6350 file_found = Qnil;
6351 else
6352 close (fd);
6353
6354 UNGCPRO;
6355 return file_found;
6356}
6357
6358
5be6c3b0
GM
6359/* Read FILE into memory. Value is a pointer to a buffer allocated
6360 with xmalloc holding FILE's contents. Value is null if an error
b243755a 6361 occurred. *SIZE is set to the size of the file. */
5be6c3b0
GM
6362
6363static char *
6364slurp_file (file, size)
6365 char *file;
6366 int *size;
6367{
6368 FILE *fp = NULL;
6369 char *buf = NULL;
6370 struct stat st;
6371
6372 if (stat (file, &st) == 0
6373 && (fp = fopen (file, "r")) != NULL
6374 && (buf = (char *) xmalloc (st.st_size),
6375 fread (buf, 1, st.st_size, fp) == st.st_size))
6376 {
6377 *size = st.st_size;
6378 fclose (fp);
6379 }
6380 else
6381 {
6382 if (fp)
6383 fclose (fp);
6384 if (buf)
6385 {
6386 xfree (buf);
6387 buf = NULL;
6388 }
6389 }
6390
6391 return buf;
6392}
6393
6394
333b20bb
GM
6395\f
6396/***********************************************************************
6397 XBM images
6398 ***********************************************************************/
6399
5be6c3b0 6400static int xbm_scan P_ ((char **, char *, char *, int *));
333b20bb 6401static int xbm_load P_ ((struct frame *f, struct image *img));
5be6c3b0
GM
6402static int xbm_load_image P_ ((struct frame *f, struct image *img,
6403 char *, char *));
333b20bb 6404static int xbm_image_p P_ ((Lisp_Object object));
5be6c3b0
GM
6405static int xbm_read_bitmap_data P_ ((char *, char *, int *, int *,
6406 unsigned char **));
6407static int xbm_file_p P_ ((Lisp_Object));
333b20bb
GM
6408
6409
6410/* Indices of image specification fields in xbm_format, below. */
6411
6412enum xbm_keyword_index
6413{
6414 XBM_TYPE,
6415 XBM_FILE,
6416 XBM_WIDTH,
6417 XBM_HEIGHT,
6418 XBM_DATA,
6419 XBM_FOREGROUND,
6420 XBM_BACKGROUND,
6421 XBM_ASCENT,
6422 XBM_MARGIN,
6423 XBM_RELIEF,
6424 XBM_ALGORITHM,
6425 XBM_HEURISTIC_MASK,
4a8e312c 6426 XBM_MASK,
333b20bb
GM
6427 XBM_LAST
6428};
6429
6430/* Vector of image_keyword structures describing the format
6431 of valid XBM image specifications. */
6432
6433static struct image_keyword xbm_format[XBM_LAST] =
6434{
6435 {":type", IMAGE_SYMBOL_VALUE, 1},
6436 {":file", IMAGE_STRING_VALUE, 0},
6437 {":width", IMAGE_POSITIVE_INTEGER_VALUE, 0},
6438 {":height", IMAGE_POSITIVE_INTEGER_VALUE, 0},
6439 {":data", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6f1be3b9
GM
6440 {":foreground", IMAGE_STRING_OR_NIL_VALUE, 0},
6441 {":background", IMAGE_STRING_OR_NIL_VALUE, 0},
7c7ff7f5 6442 {":ascent", IMAGE_ASCENT_VALUE, 0},
3ed61e75 6443 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
333b20bb 6444 {":relief", IMAGE_INTEGER_VALUE, 0},
d2dc8167 6445 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
4a8e312c
GM
6446 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6447 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
333b20bb
GM
6448};
6449
6450/* Structure describing the image type XBM. */
6451
6452static struct image_type xbm_type =
6453{
6454 &Qxbm,
6455 xbm_image_p,
6456 xbm_load,
6457 x_clear_image,
6458 NULL
6459};
6460
6461/* Tokens returned from xbm_scan. */
6462
6463enum xbm_token
6464{
6465 XBM_TK_IDENT = 256,
6466 XBM_TK_NUMBER
6467};
6468
6469
6470/* Return non-zero if OBJECT is a valid XBM-type image specification.
6471 A valid specification is a list starting with the symbol `image'
6472 The rest of the list is a property list which must contain an
6473 entry `:type xbm..
6474
6475 If the specification specifies a file to load, it must contain
6476 an entry `:file FILENAME' where FILENAME is a string.
6477
6478 If the specification is for a bitmap loaded from memory it must
6479 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
6480 WIDTH and HEIGHT are integers > 0. DATA may be:
6481
6482 1. a string large enough to hold the bitmap data, i.e. it must
6483 have a size >= (WIDTH + 7) / 8 * HEIGHT
6484
6485 2. a bool-vector of size >= WIDTH * HEIGHT
6486
6487 3. a vector of strings or bool-vectors, one for each line of the
6488 bitmap.
6489
5be6c3b0
GM
6490 4. A string containing an in-memory XBM file. WIDTH and HEIGHT
6491 may not be specified in this case because they are defined in the
6492 XBM file.
6493
333b20bb
GM
6494 Both the file and data forms may contain the additional entries
6495 `:background COLOR' and `:foreground COLOR'. If not present,
6496 foreground and background of the frame on which the image is
e3130015 6497 displayed is used. */
333b20bb
GM
6498
6499static int
6500xbm_image_p (object)
6501 Lisp_Object object;
6502{
6503 struct image_keyword kw[XBM_LAST];
6504
6505 bcopy (xbm_format, kw, sizeof kw);
bfd2209f 6506 if (!parse_image_spec (object, kw, XBM_LAST, Qxbm))
333b20bb
GM
6507 return 0;
6508
6509 xassert (EQ (kw[XBM_TYPE].value, Qxbm));
6510
6511 if (kw[XBM_FILE].count)
6512 {
6513 if (kw[XBM_WIDTH].count || kw[XBM_HEIGHT].count || kw[XBM_DATA].count)
6514 return 0;
6515 }
5be6c3b0
GM
6516 else if (kw[XBM_DATA].count && xbm_file_p (kw[XBM_DATA].value))
6517 {
6518 /* In-memory XBM file. */
6519 if (kw[XBM_WIDTH].count || kw[XBM_HEIGHT].count || kw[XBM_FILE].count)
6520 return 0;
6521 }
333b20bb
GM
6522 else
6523 {
6524 Lisp_Object data;
6525 int width, height;
6526
6527 /* Entries for `:width', `:height' and `:data' must be present. */
6528 if (!kw[XBM_WIDTH].count
6529 || !kw[XBM_HEIGHT].count
6530 || !kw[XBM_DATA].count)
6531 return 0;
6532
6533 data = kw[XBM_DATA].value;
6534 width = XFASTINT (kw[XBM_WIDTH].value);
6535 height = XFASTINT (kw[XBM_HEIGHT].value);
6536
6537 /* Check type of data, and width and height against contents of
6538 data. */
6539 if (VECTORP (data))
6540 {
6541 int i;
6542
6543 /* Number of elements of the vector must be >= height. */
6544 if (XVECTOR (data)->size < height)
6545 return 0;
6546
6547 /* Each string or bool-vector in data must be large enough
6548 for one line of the image. */
6549 for (i = 0; i < height; ++i)
6550 {
6551 Lisp_Object elt = XVECTOR (data)->contents[i];
6552
6553 if (STRINGP (elt))
6554 {
6555 if (XSTRING (elt)->size
6556 < (width + BITS_PER_CHAR - 1) / BITS_PER_CHAR)
6557 return 0;
6558 }
6559 else if (BOOL_VECTOR_P (elt))
6560 {
6561 if (XBOOL_VECTOR (elt)->size < width)
6562 return 0;
6563 }
6564 else
6565 return 0;
6566 }
6567 }
6568 else if (STRINGP (data))
6569 {
6570 if (XSTRING (data)->size
6571 < (width + BITS_PER_CHAR - 1) / BITS_PER_CHAR * height)
6572 return 0;
6573 }
6574 else if (BOOL_VECTOR_P (data))
6575 {
6576 if (XBOOL_VECTOR (data)->size < width * height)
6577 return 0;
6578 }
6579 else
6580 return 0;
6581 }
6582
333b20bb
GM
6583 return 1;
6584}
6585
6586
6587/* Scan a bitmap file. FP is the stream to read from. Value is
6588 either an enumerator from enum xbm_token, or a character for a
6589 single-character token, or 0 at end of file. If scanning an
6590 identifier, store the lexeme of the identifier in SVAL. If
6591 scanning a number, store its value in *IVAL. */
6592
6593static int
5be6c3b0
GM
6594xbm_scan (s, end, sval, ival)
6595 char **s, *end;
333b20bb
GM
6596 char *sval;
6597 int *ival;
6598{
6599 int c;
0a695da7
GM
6600
6601 loop:
333b20bb
GM
6602
6603 /* Skip white space. */
5be6c3b0 6604 while (*s < end && (c = *(*s)++, isspace (c)))
333b20bb
GM
6605 ;
6606
5be6c3b0 6607 if (*s >= end)
333b20bb
GM
6608 c = 0;
6609 else if (isdigit (c))
6610 {
6611 int value = 0, digit;
6612
5be6c3b0 6613 if (c == '0' && *s < end)
333b20bb 6614 {
5be6c3b0 6615 c = *(*s)++;
333b20bb
GM
6616 if (c == 'x' || c == 'X')
6617 {
5be6c3b0 6618 while (*s < end)
333b20bb 6619 {
5be6c3b0 6620 c = *(*s)++;
333b20bb
GM
6621 if (isdigit (c))
6622 digit = c - '0';
6623 else if (c >= 'a' && c <= 'f')
6624 digit = c - 'a' + 10;
6625 else if (c >= 'A' && c <= 'F')
6626 digit = c - 'A' + 10;
6627 else
6628 break;
6629 value = 16 * value + digit;
6630 }
6631 }
6632 else if (isdigit (c))
6633 {
6634 value = c - '0';
5be6c3b0
GM
6635 while (*s < end
6636 && (c = *(*s)++, isdigit (c)))
333b20bb
GM
6637 value = 8 * value + c - '0';
6638 }
6639 }
6640 else
6641 {
6642 value = c - '0';
5be6c3b0
GM
6643 while (*s < end
6644 && (c = *(*s)++, isdigit (c)))
333b20bb
GM
6645 value = 10 * value + c - '0';
6646 }
6647
5be6c3b0
GM
6648 if (*s < end)
6649 *s = *s - 1;
333b20bb
GM
6650 *ival = value;
6651 c = XBM_TK_NUMBER;
6652 }
6653 else if (isalpha (c) || c == '_')
6654 {
6655 *sval++ = c;
5be6c3b0
GM
6656 while (*s < end
6657 && (c = *(*s)++, (isalnum (c) || c == '_')))
333b20bb
GM
6658 *sval++ = c;
6659 *sval = 0;
5be6c3b0
GM
6660 if (*s < end)
6661 *s = *s - 1;
333b20bb
GM
6662 c = XBM_TK_IDENT;
6663 }
0a695da7
GM
6664 else if (c == '/' && **s == '*')
6665 {
6666 /* C-style comment. */
6667 ++*s;
6668 while (**s && (**s != '*' || *(*s + 1) != '/'))
6669 ++*s;
6670 if (**s)
6671 {
6672 *s += 2;
6673 goto loop;
6674 }
6675 }
333b20bb
GM
6676
6677 return c;
6678}
6679
6680
6681/* Replacement for XReadBitmapFileData which isn't available under old
5be6c3b0
GM
6682 X versions. CONTENTS is a pointer to a buffer to parse; END is the
6683 buffer's end. Set *WIDTH and *HEIGHT to the width and height of
6684 the image. Return in *DATA the bitmap data allocated with xmalloc.
6685 Value is non-zero if successful. DATA null means just test if
b243755a 6686 CONTENTS looks like an in-memory XBM file. */
333b20bb
GM
6687
6688static int
5be6c3b0
GM
6689xbm_read_bitmap_data (contents, end, width, height, data)
6690 char *contents, *end;
333b20bb
GM
6691 int *width, *height;
6692 unsigned char **data;
6693{
5be6c3b0 6694 char *s = contents;
333b20bb
GM
6695 char buffer[BUFSIZ];
6696 int padding_p = 0;
6697 int v10 = 0;
6698 int bytes_per_line, i, nbytes;
6699 unsigned char *p;
6700 int value;
6701 int LA1;
6702
6703#define match() \
5be6c3b0 6704 LA1 = xbm_scan (&s, end, buffer, &value)
333b20bb
GM
6705
6706#define expect(TOKEN) \
6707 if (LA1 != (TOKEN)) \
6708 goto failure; \
6709 else \
6710 match ()
6711
6712#define expect_ident(IDENT) \
6713 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
6714 match (); \
6715 else \
6716 goto failure
6717
333b20bb 6718 *width = *height = -1;
5be6c3b0
GM
6719 if (data)
6720 *data = NULL;
6721 LA1 = xbm_scan (&s, end, buffer, &value);
333b20bb
GM
6722
6723 /* Parse defines for width, height and hot-spots. */
6724 while (LA1 == '#')
6725 {
333b20bb
GM
6726 match ();
6727 expect_ident ("define");
6728 expect (XBM_TK_IDENT);
6729
6730 if (LA1 == XBM_TK_NUMBER);
6731 {
6732 char *p = strrchr (buffer, '_');
6733 p = p ? p + 1 : buffer;
6734 if (strcmp (p, "width") == 0)
6735 *width = value;
6736 else if (strcmp (p, "height") == 0)
6737 *height = value;
6738 }
6739 expect (XBM_TK_NUMBER);
6740 }
6741
6742 if (*width < 0 || *height < 0)
6743 goto failure;
5be6c3b0
GM
6744 else if (data == NULL)
6745 goto success;
333b20bb
GM
6746
6747 /* Parse bits. Must start with `static'. */
6748 expect_ident ("static");
6749 if (LA1 == XBM_TK_IDENT)
6750 {
6751 if (strcmp (buffer, "unsigned") == 0)
6752 {
6753 match ();
6754 expect_ident ("char");
6755 }
6756 else if (strcmp (buffer, "short") == 0)
6757 {
6758 match ();
6759 v10 = 1;
6760 if (*width % 16 && *width % 16 < 9)
6761 padding_p = 1;
6762 }
6763 else if (strcmp (buffer, "char") == 0)
6764 match ();
6765 else
6766 goto failure;
6767 }
6768 else
6769 goto failure;
6770
6771 expect (XBM_TK_IDENT);
6772 expect ('[');
6773 expect (']');
6774 expect ('=');
6775 expect ('{');
6776
6777 bytes_per_line = (*width + 7) / 8 + padding_p;
6778 nbytes = bytes_per_line * *height;
6779 p = *data = (char *) xmalloc (nbytes);
6780
6781 if (v10)
6782 {
333b20bb
GM
6783 for (i = 0; i < nbytes; i += 2)
6784 {
6785 int val = value;
6786 expect (XBM_TK_NUMBER);
6787
6788 *p++ = val;
6789 if (!padding_p || ((i + 2) % bytes_per_line))
6790 *p++ = value >> 8;
6791
6792 if (LA1 == ',' || LA1 == '}')
6793 match ();
6794 else
6795 goto failure;
6796 }
6797 }
6798 else
6799 {
6800 for (i = 0; i < nbytes; ++i)
6801 {
6802 int val = value;
6803 expect (XBM_TK_NUMBER);
6804
6805 *p++ = val;
6806
6807 if (LA1 == ',' || LA1 == '}')
6808 match ();
6809 else
6810 goto failure;
6811 }
6812 }
6813
5be6c3b0 6814 success:
333b20bb
GM
6815 return 1;
6816
6817 failure:
6818
5be6c3b0 6819 if (data && *data)
333b20bb
GM
6820 {
6821 xfree (*data);
6822 *data = NULL;
6823 }
6824 return 0;
6825
6826#undef match
6827#undef expect
6828#undef expect_ident
6829}
6830
6831
5be6c3b0
GM
6832/* Load XBM image IMG which will be displayed on frame F from buffer
6833 CONTENTS. END is the end of the buffer. Value is non-zero if
6834 successful. */
333b20bb
GM
6835
6836static int
5be6c3b0 6837xbm_load_image (f, img, contents, end)
333b20bb
GM
6838 struct frame *f;
6839 struct image *img;
5be6c3b0 6840 char *contents, *end;
333b20bb
GM
6841{
6842 int rc;
6843 unsigned char *data;
6844 int success_p = 0;
333b20bb 6845
5be6c3b0 6846 rc = xbm_read_bitmap_data (contents, end, &img->width, &img->height, &data);
333b20bb
GM
6847 if (rc)
6848 {
6849 int depth = DefaultDepthOfScreen (FRAME_X_SCREEN (f));
6850 unsigned long foreground = FRAME_FOREGROUND_PIXEL (f);
6851 unsigned long background = FRAME_BACKGROUND_PIXEL (f);
6852 Lisp_Object value;
6853
6854 xassert (img->width > 0 && img->height > 0);
6855
6856 /* Get foreground and background colors, maybe allocate colors. */
6857 value = image_spec_value (img->spec, QCforeground, NULL);
6858 if (!NILP (value))
6859 foreground = x_alloc_image_color (f, img, value, foreground);
6860
6861 value = image_spec_value (img->spec, QCbackground, NULL);
6862 if (!NILP (value))
6863 background = x_alloc_image_color (f, img, value, background);
6864
333b20bb
GM
6865 img->pixmap
6866 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f),
6867 FRAME_X_WINDOW (f),
6868 data,
6869 img->width, img->height,
6870 foreground, background,
6871 depth);
6872 xfree (data);
6873
dd00328a 6874 if (img->pixmap == None)
333b20bb
GM
6875 {
6876 x_clear_image (f, img);
5be6c3b0 6877 image_error ("Unable to create X pixmap for `%s'", img->spec, Qnil);
333b20bb
GM
6878 }
6879 else
6880 success_p = 1;
333b20bb
GM
6881 }
6882 else
45158a91 6883 image_error ("Error loading XBM image `%s'", img->spec, Qnil);
333b20bb 6884
333b20bb
GM
6885 return success_p;
6886}
6887
6888
5be6c3b0
GM
6889/* Value is non-zero if DATA looks like an in-memory XBM file. */
6890
6891static int
6892xbm_file_p (data)
6893 Lisp_Object data;
6894{
6895 int w, h;
6896 return (STRINGP (data)
6897 && xbm_read_bitmap_data (XSTRING (data)->data,
6898 (XSTRING (data)->data
6899 + STRING_BYTES (XSTRING (data))),
6900 &w, &h, NULL));
6901}
6902
6903
333b20bb
GM
6904/* Fill image IMG which is used on frame F with pixmap data. Value is
6905 non-zero if successful. */
6906
6907static int
6908xbm_load (f, img)
6909 struct frame *f;
6910 struct image *img;
6911{
6912 int success_p = 0;
6913 Lisp_Object file_name;
6914
6915 xassert (xbm_image_p (img->spec));
6916
6917 /* If IMG->spec specifies a file name, create a non-file spec from it. */
6918 file_name = image_spec_value (img->spec, QCfile, NULL);
6919 if (STRINGP (file_name))
5be6c3b0
GM
6920 {
6921 Lisp_Object file;
6922 char *contents;
6923 int size;
6924 struct gcpro gcpro1;
6925
6926 file = x_find_image_file (file_name);
6927 GCPRO1 (file);
6928 if (!STRINGP (file))
6929 {
6930 image_error ("Cannot find image file `%s'", file_name, Qnil);
6931 UNGCPRO;
6932 return 0;
6933 }
6934
6935 contents = slurp_file (XSTRING (file)->data, &size);
6936 if (contents == NULL)
6937 {
6938 image_error ("Error loading XBM image `%s'", img->spec, Qnil);
6939 UNGCPRO;
6940 return 0;
6941 }
6942
6943 success_p = xbm_load_image (f, img, contents, contents + size);
6944 UNGCPRO;
6945 }
333b20bb
GM
6946 else
6947 {
6948 struct image_keyword fmt[XBM_LAST];
6949 Lisp_Object data;
6950 int depth;
6951 unsigned long foreground = FRAME_FOREGROUND_PIXEL (f);
6952 unsigned long background = FRAME_BACKGROUND_PIXEL (f);
6953 char *bits;
9b207e8e 6954 int parsed_p;
5be6c3b0
GM
6955 int in_memory_file_p = 0;
6956
6957 /* See if data looks like an in-memory XBM file. */
6958 data = image_spec_value (img->spec, QCdata, NULL);
6959 in_memory_file_p = xbm_file_p (data);
333b20bb 6960
5be6c3b0 6961 /* Parse the image specification. */
333b20bb 6962 bcopy (xbm_format, fmt, sizeof fmt);
bfd2209f 6963 parsed_p = parse_image_spec (img->spec, fmt, XBM_LAST, Qxbm);
333b20bb
GM
6964 xassert (parsed_p);
6965
6966 /* Get specified width, and height. */
5be6c3b0
GM
6967 if (!in_memory_file_p)
6968 {
6969 img->width = XFASTINT (fmt[XBM_WIDTH].value);
6970 img->height = XFASTINT (fmt[XBM_HEIGHT].value);
6971 xassert (img->width > 0 && img->height > 0);
6972 }
333b20bb 6973
333b20bb 6974 /* Get foreground and background colors, maybe allocate colors. */
6f1be3b9
GM
6975 if (fmt[XBM_FOREGROUND].count
6976 && STRINGP (fmt[XBM_FOREGROUND].value))
333b20bb
GM
6977 foreground = x_alloc_image_color (f, img, fmt[XBM_FOREGROUND].value,
6978 foreground);
6f1be3b9
GM
6979 if (fmt[XBM_BACKGROUND].count
6980 && STRINGP (fmt[XBM_BACKGROUND].value))
333b20bb
GM
6981 background = x_alloc_image_color (f, img, fmt[XBM_BACKGROUND].value,
6982 background);
6983
5be6c3b0
GM
6984 if (in_memory_file_p)
6985 success_p = xbm_load_image (f, img, XSTRING (data)->data,
6986 (XSTRING (data)->data
6987 + STRING_BYTES (XSTRING (data))));
6988 else
333b20bb 6989 {
5be6c3b0
GM
6990 if (VECTORP (data))
6991 {
6992 int i;
6993 char *p;
6994 int nbytes = (img->width + BITS_PER_CHAR - 1) / BITS_PER_CHAR;
333b20bb 6995
5be6c3b0
GM
6996 p = bits = (char *) alloca (nbytes * img->height);
6997 for (i = 0; i < img->height; ++i, p += nbytes)
6998 {
6999 Lisp_Object line = XVECTOR (data)->contents[i];
7000 if (STRINGP (line))
7001 bcopy (XSTRING (line)->data, p, nbytes);
7002 else
7003 bcopy (XBOOL_VECTOR (line)->data, p, nbytes);
7004 }
7005 }
7006 else if (STRINGP (data))
7007 bits = XSTRING (data)->data;
7008 else
7009 bits = XBOOL_VECTOR (data)->data;
7010
7011 /* Create the pixmap. */
7012 depth = DefaultDepthOfScreen (FRAME_X_SCREEN (f));
7013 img->pixmap
7014 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f),
7015 FRAME_X_WINDOW (f),
7016 bits,
7017 img->width, img->height,
7018 foreground, background,
7019 depth);
7020 if (img->pixmap)
7021 success_p = 1;
7022 else
333b20bb 7023 {
5be6c3b0
GM
7024 image_error ("Unable to create pixmap for XBM image `%s'",
7025 img->spec, Qnil);
7026 x_clear_image (f, img);
333b20bb
GM
7027 }
7028 }
333b20bb
GM
7029 }
7030
7031 return success_p;
7032}
7033
7034
7035\f
7036/***********************************************************************
7037 XPM images
7038 ***********************************************************************/
7039
7040#if HAVE_XPM
7041
7042static int xpm_image_p P_ ((Lisp_Object object));
7043static int xpm_load P_ ((struct frame *f, struct image *img));
7044static int xpm_valid_color_symbols_p P_ ((Lisp_Object));
7045
7046#include "X11/xpm.h"
7047
7048/* The symbol `xpm' identifying XPM-format images. */
7049
7050Lisp_Object Qxpm;
7051
7052/* Indices of image specification fields in xpm_format, below. */
7053
7054enum xpm_keyword_index
7055{
7056 XPM_TYPE,
7057 XPM_FILE,
7058 XPM_DATA,
7059 XPM_ASCENT,
7060 XPM_MARGIN,
7061 XPM_RELIEF,
7062 XPM_ALGORITHM,
7063 XPM_HEURISTIC_MASK,
4a8e312c 7064 XPM_MASK,
333b20bb
GM
7065 XPM_COLOR_SYMBOLS,
7066 XPM_LAST
7067};
7068
7069/* Vector of image_keyword structures describing the format
7070 of valid XPM image specifications. */
7071
7072static struct image_keyword xpm_format[XPM_LAST] =
7073{
7074 {":type", IMAGE_SYMBOL_VALUE, 1},
7075 {":file", IMAGE_STRING_VALUE, 0},
7076 {":data", IMAGE_STRING_VALUE, 0},
7c7ff7f5 7077 {":ascent", IMAGE_ASCENT_VALUE, 0},
3ed61e75 7078 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
333b20bb 7079 {":relief", IMAGE_INTEGER_VALUE, 0},
d2dc8167 7080 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
333b20bb 7081 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
4a8e312c 7082 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
333b20bb
GM
7083 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
7084};
7085
7086/* Structure describing the image type XBM. */
7087
7088static struct image_type xpm_type =
7089{
7090 &Qxpm,
7091 xpm_image_p,
7092 xpm_load,
7093 x_clear_image,
7094 NULL
7095};
7096
7097
b243755a
GM
7098/* Define ALLOC_XPM_COLORS if we can use Emacs' own color allocation
7099 functions for allocating image colors. Our own functions handle
7100 color allocation failures more gracefully than the ones on the XPM
7101 lib. */
7102
7103#if defined XpmAllocColor && defined XpmFreeColors && defined XpmColorClosure
7104#define ALLOC_XPM_COLORS
7105#endif
7106
7107#ifdef ALLOC_XPM_COLORS
7108
f72c62ad 7109static void xpm_init_color_cache P_ ((struct frame *, XpmAttributes *));
b243755a
GM
7110static void xpm_free_color_cache P_ ((void));
7111static int xpm_lookup_color P_ ((struct frame *, char *, XColor *));
f72c62ad
GM
7112static int xpm_color_bucket P_ ((char *));
7113static struct xpm_cached_color *xpm_cache_color P_ ((struct frame *, char *,
7114 XColor *, int));
b243755a
GM
7115
7116/* An entry in a hash table used to cache color definitions of named
7117 colors. This cache is necessary to speed up XPM image loading in
7118 case we do color allocations ourselves. Without it, we would need
7119 a call to XParseColor per pixel in the image. */
7120
7121struct xpm_cached_color
7122{
7123 /* Next in collision chain. */
7124 struct xpm_cached_color *next;
7125
7126 /* Color definition (RGB and pixel color). */
7127 XColor color;
7128
7129 /* Color name. */
7130 char name[1];
7131};
7132
7133/* The hash table used for the color cache, and its bucket vector
7134 size. */
7135
7136#define XPM_COLOR_CACHE_BUCKETS 1001
7137struct xpm_cached_color **xpm_color_cache;
7138
b243755a
GM
7139/* Initialize the color cache. */
7140
7141static void
f72c62ad
GM
7142xpm_init_color_cache (f, attrs)
7143 struct frame *f;
7144 XpmAttributes *attrs;
b243755a
GM
7145{
7146 size_t nbytes = XPM_COLOR_CACHE_BUCKETS * sizeof *xpm_color_cache;
7147 xpm_color_cache = (struct xpm_cached_color **) xmalloc (nbytes);
7148 memset (xpm_color_cache, 0, nbytes);
7149 init_color_table ();
f72c62ad
GM
7150
7151 if (attrs->valuemask & XpmColorSymbols)
7152 {
7153 int i;
7154 XColor color;
7155
7156 for (i = 0; i < attrs->numsymbols; ++i)
7157 if (XParseColor (FRAME_X_DISPLAY (f), FRAME_X_COLORMAP (f),
7158 attrs->colorsymbols[i].value, &color))
7159 {
7160 color.pixel = lookup_rgb_color (f, color.red, color.green,
7161 color.blue);
7162 xpm_cache_color (f, attrs->colorsymbols[i].name, &color, -1);
7163 }
7164 }
b243755a
GM
7165}
7166
7167
7168/* Free the color cache. */
7169
7170static void
7171xpm_free_color_cache ()
7172{
7173 struct xpm_cached_color *p, *next;
7174 int i;
7175
7176 for (i = 0; i < XPM_COLOR_CACHE_BUCKETS; ++i)
7177 for (p = xpm_color_cache[i]; p; p = next)
7178 {
7179 next = p->next;
7180 xfree (p);
7181 }
7182
7183 xfree (xpm_color_cache);
7184 xpm_color_cache = NULL;
7185 free_color_table ();
7186}
7187
7188
f72c62ad
GM
7189/* Return the bucket index for color named COLOR_NAME in the color
7190 cache. */
7191
7192static int
7193xpm_color_bucket (color_name)
7194 char *color_name;
7195{
7196 unsigned h = 0;
7197 char *s;
7198
7199 for (s = color_name; *s; ++s)
7200 h = (h << 2) ^ *s;
7201 return h %= XPM_COLOR_CACHE_BUCKETS;
7202}
7203
7204
7205/* On frame F, cache values COLOR for color with name COLOR_NAME.
7206 BUCKET, if >= 0, is a precomputed bucket index. Value is the cache
7207 entry added. */
7208
7209static struct xpm_cached_color *
7210xpm_cache_color (f, color_name, color, bucket)
7211 struct frame *f;
7212 char *color_name;
7213 XColor *color;
7214 int bucket;
7215{
7216 size_t nbytes;
7217 struct xpm_cached_color *p;
7218
7219 if (bucket < 0)
7220 bucket = xpm_color_bucket (color_name);
7221
7222 nbytes = sizeof *p + strlen (color_name);
7223 p = (struct xpm_cached_color *) xmalloc (nbytes);
7224 strcpy (p->name, color_name);
7225 p->color = *color;
7226 p->next = xpm_color_cache[bucket];
7227 xpm_color_cache[bucket] = p;
7228 return p;
7229}
7230
7231
b243755a
GM
7232/* Look up color COLOR_NAME for frame F in the color cache. If found,
7233 return the cached definition in *COLOR. Otherwise, make a new
7234 entry in the cache and allocate the color. Value is zero if color
7235 allocation failed. */
7236
7237static int
7238xpm_lookup_color (f, color_name, color)
7239 struct frame *f;
7240 char *color_name;
7241 XColor *color;
7242{
b243755a 7243 struct xpm_cached_color *p;
83676598 7244 int h = xpm_color_bucket (color_name);
b243755a
GM
7245
7246 for (p = xpm_color_cache[h]; p; p = p->next)
7247 if (strcmp (p->name, color_name) == 0)
7248 break;
7249
7250 if (p != NULL)
7251 *color = p->color;
7252 else if (XParseColor (FRAME_X_DISPLAY (f), FRAME_X_COLORMAP (f),
7253 color_name, color))
7254 {
b243755a
GM
7255 color->pixel = lookup_rgb_color (f, color->red, color->green,
7256 color->blue);
f72c62ad 7257 p = xpm_cache_color (f, color_name, color, h);
b243755a 7258 }
f72c62ad 7259
b243755a
GM
7260 return p != NULL;
7261}
7262
7263
7264/* Callback for allocating color COLOR_NAME. Called from the XPM lib.
7265 CLOSURE is a pointer to the frame on which we allocate the
7266 color. Return in *COLOR the allocated color. Value is non-zero
7267 if successful. */
7268
7269static int
7270xpm_alloc_color (dpy, cmap, color_name, color, closure)
7271 Display *dpy;
7272 Colormap cmap;
7273 char *color_name;
7274 XColor *color;
7275 void *closure;
7276{
7277 return xpm_lookup_color ((struct frame *) closure, color_name, color);
7278}
7279
7280
7281/* Callback for freeing NPIXELS colors contained in PIXELS. CLOSURE
7282 is a pointer to the frame on which we allocate the color. Value is
7283 non-zero if successful. */
7284
7285static int
7286xpm_free_colors (dpy, cmap, pixels, npixels, closure)
7287 Display *dpy;
7288 Colormap cmap;
7289 Pixel *pixels;
7290 int npixels;
7291 void *closure;
7292{
7293 return 1;
7294}
7295
7296#endif /* ALLOC_XPM_COLORS */
7297
7298
333b20bb
GM
7299/* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
7300 for XPM images. Such a list must consist of conses whose car and
7301 cdr are strings. */
7302
7303static int
7304xpm_valid_color_symbols_p (color_symbols)
7305 Lisp_Object color_symbols;
7306{
7307 while (CONSP (color_symbols))
7308 {
7309 Lisp_Object sym = XCAR (color_symbols);
7310 if (!CONSP (sym)
7311 || !STRINGP (XCAR (sym))
7312 || !STRINGP (XCDR (sym)))
7313 break;
7314 color_symbols = XCDR (color_symbols);
7315 }
7316
7317 return NILP (color_symbols);
7318}
7319
7320
7321/* Value is non-zero if OBJECT is a valid XPM image specification. */
7322
7323static int
7324xpm_image_p (object)
7325 Lisp_Object object;
7326{
7327 struct image_keyword fmt[XPM_LAST];
7328 bcopy (xpm_format, fmt, sizeof fmt);
bfd2209f 7329 return (parse_image_spec (object, fmt, XPM_LAST, Qxpm)
333b20bb
GM
7330 /* Either `:file' or `:data' must be present. */
7331 && fmt[XPM_FILE].count + fmt[XPM_DATA].count == 1
7332 /* Either no `:color-symbols' or it's a list of conses
7333 whose car and cdr are strings. */
7334 && (fmt[XPM_COLOR_SYMBOLS].count == 0
7c7ff7f5 7335 || xpm_valid_color_symbols_p (fmt[XPM_COLOR_SYMBOLS].value)));
333b20bb
GM
7336}
7337
7338
7339/* Load image IMG which will be displayed on frame F. Value is
7340 non-zero if successful. */
7341
7342static int
7343xpm_load (f, img)
7344 struct frame *f;
7345 struct image *img;
7346{
9b207e8e 7347 int rc;
333b20bb
GM
7348 XpmAttributes attrs;
7349 Lisp_Object specified_file, color_symbols;
7350
7351 /* Configure the XPM lib. Use the visual of frame F. Allocate
7352 close colors. Return colors allocated. */
7353 bzero (&attrs, sizeof attrs);
9b2956e2
GM
7354 attrs.visual = FRAME_X_VISUAL (f);
7355 attrs.colormap = FRAME_X_COLORMAP (f);
333b20bb 7356 attrs.valuemask |= XpmVisual;
9b2956e2 7357 attrs.valuemask |= XpmColormap;
b243755a
GM
7358
7359#ifdef ALLOC_XPM_COLORS
7360 /* Allocate colors with our own functions which handle
7361 failing color allocation more gracefully. */
7362 attrs.color_closure = f;
7363 attrs.alloc_color = xpm_alloc_color;
7364 attrs.free_colors = xpm_free_colors;
7365 attrs.valuemask |= XpmAllocColor | XpmFreeColors | XpmColorClosure;
7366#else /* not ALLOC_XPM_COLORS */
7367 /* Let the XPM lib allocate colors. */
333b20bb 7368 attrs.valuemask |= XpmReturnAllocPixels;
e4c082be 7369#ifdef XpmAllocCloseColors
333b20bb
GM
7370 attrs.alloc_close_colors = 1;
7371 attrs.valuemask |= XpmAllocCloseColors;
b243755a 7372#else /* not XpmAllocCloseColors */
e4c082be
RS
7373 attrs.closeness = 600;
7374 attrs.valuemask |= XpmCloseness;
b243755a
GM
7375#endif /* not XpmAllocCloseColors */
7376#endif /* ALLOC_XPM_COLORS */
333b20bb
GM
7377
7378 /* If image specification contains symbolic color definitions, add
7379 these to `attrs'. */
7380 color_symbols = image_spec_value (img->spec, QCcolor_symbols, NULL);
7381 if (CONSP (color_symbols))
7382 {
7383 Lisp_Object tail;
7384 XpmColorSymbol *xpm_syms;
7385 int i, size;
7386
7387 attrs.valuemask |= XpmColorSymbols;
7388
7389 /* Count number of symbols. */
7390 attrs.numsymbols = 0;
7391 for (tail = color_symbols; CONSP (tail); tail = XCDR (tail))
7392 ++attrs.numsymbols;
7393
7394 /* Allocate an XpmColorSymbol array. */
7395 size = attrs.numsymbols * sizeof *xpm_syms;
7396 xpm_syms = (XpmColorSymbol *) alloca (size);
7397 bzero (xpm_syms, size);
7398 attrs.colorsymbols = xpm_syms;
7399
7400 /* Fill the color symbol array. */
7401 for (tail = color_symbols, i = 0;
7402 CONSP (tail);
7403 ++i, tail = XCDR (tail))
7404 {
7405 Lisp_Object name = XCAR (XCAR (tail));
7406 Lisp_Object color = XCDR (XCAR (tail));
7407 xpm_syms[i].name = (char *) alloca (XSTRING (name)->size + 1);
7408 strcpy (xpm_syms[i].name, XSTRING (name)->data);
7409 xpm_syms[i].value = (char *) alloca (XSTRING (color)->size + 1);
7410 strcpy (xpm_syms[i].value, XSTRING (color)->data);
7411 }
7412 }
7413
7414 /* Create a pixmap for the image, either from a file, or from a
7415 string buffer containing data in the same format as an XPM file. */
b243755a 7416#ifdef ALLOC_XPM_COLORS
f72c62ad 7417 xpm_init_color_cache (f, &attrs);
b243755a
GM
7418#endif
7419
333b20bb
GM
7420 specified_file = image_spec_value (img->spec, QCfile, NULL);
7421 if (STRINGP (specified_file))
7422 {
7423 Lisp_Object file = x_find_image_file (specified_file);
7424 if (!STRINGP (file))
7425 {
45158a91 7426 image_error ("Cannot find image file `%s'", specified_file, Qnil);
333b20bb
GM
7427 return 0;
7428 }
7429
7430 rc = XpmReadFileToPixmap (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
7431 XSTRING (file)->data, &img->pixmap, &img->mask,
7432 &attrs);
7433 }
7434 else
7435 {
7436 Lisp_Object buffer = image_spec_value (img->spec, QCdata, NULL);
7437 rc = XpmCreatePixmapFromBuffer (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
7438 XSTRING (buffer)->data,
7439 &img->pixmap, &img->mask,
7440 &attrs);
7441 }
333b20bb
GM
7442
7443 if (rc == XpmSuccess)
7444 {
b243755a
GM
7445#ifdef ALLOC_XPM_COLORS
7446 img->colors = colors_in_color_table (&img->ncolors);
7447#else /* not ALLOC_XPM_COLORS */
f47a9ec4
KR
7448 int i;
7449
333b20bb
GM
7450 img->ncolors = attrs.nalloc_pixels;
7451 img->colors = (unsigned long *) xmalloc (img->ncolors
7452 * sizeof *img->colors);
7453 for (i = 0; i < attrs.nalloc_pixels; ++i)
3b4ae1cc
GM
7454 {
7455 img->colors[i] = attrs.alloc_pixels[i];
7456#ifdef DEBUG_X_COLORS
7457 register_color (img->colors[i]);
7458#endif
7459 }
b243755a 7460#endif /* not ALLOC_XPM_COLORS */
333b20bb
GM
7461
7462 img->width = attrs.width;
7463 img->height = attrs.height;
7464 xassert (img->width > 0 && img->height > 0);
7465
7466 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
333b20bb 7467 XpmFreeAttributes (&attrs);
333b20bb
GM
7468 }
7469 else
7470 {
7471 switch (rc)
7472 {
7473 case XpmOpenFailed:
7474 image_error ("Error opening XPM file (%s)", img->spec, Qnil);
7475 break;
7476
7477 case XpmFileInvalid:
7478 image_error ("Invalid XPM file (%s)", img->spec, Qnil);
7479 break;
7480
7481 case XpmNoMemory:
7482 image_error ("Out of memory (%s)", img->spec, Qnil);
7483 break;
7484
7485 case XpmColorFailed:
7486 image_error ("Color allocation error (%s)", img->spec, Qnil);
7487 break;
7488
7489 default:
7490 image_error ("Unknown error (%s)", img->spec, Qnil);
7491 break;
7492 }
7493 }
7494
b243755a
GM
7495#ifdef ALLOC_XPM_COLORS
7496 xpm_free_color_cache ();
7497#endif
333b20bb
GM
7498 return rc == XpmSuccess;
7499}
7500
7501#endif /* HAVE_XPM != 0 */
7502
7503\f
7504/***********************************************************************
7505 Color table
7506 ***********************************************************************/
7507
7508/* An entry in the color table mapping an RGB color to a pixel color. */
7509
7510struct ct_color
7511{
7512 int r, g, b;
7513 unsigned long pixel;
7514
7515 /* Next in color table collision list. */
7516 struct ct_color *next;
7517};
7518
7519/* The bucket vector size to use. Must be prime. */
7520
7521#define CT_SIZE 101
7522
7523/* Value is a hash of the RGB color given by R, G, and B. */
7524
7525#define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
7526
7527/* The color hash table. */
7528
7529struct ct_color **ct_table;
7530
7531/* Number of entries in the color table. */
7532
7533int ct_colors_allocated;
7534
333b20bb
GM
7535/* Initialize the color table. */
7536
7537static void
7538init_color_table ()
7539{
7540 int size = CT_SIZE * sizeof (*ct_table);
7541 ct_table = (struct ct_color **) xmalloc (size);
7542 bzero (ct_table, size);
7543 ct_colors_allocated = 0;
7544}
7545
7546
7547/* Free memory associated with the color table. */
7548
7549static void
7550free_color_table ()
7551{
7552 int i;
7553 struct ct_color *p, *next;
7554
7555 for (i = 0; i < CT_SIZE; ++i)
7556 for (p = ct_table[i]; p; p = next)
7557 {
7558 next = p->next;
7559 xfree (p);
7560 }
7561
7562 xfree (ct_table);
7563 ct_table = NULL;
7564}
7565
7566
7567/* Value is a pixel color for RGB color R, G, B on frame F. If an
7568 entry for that color already is in the color table, return the
7569 pixel color of that entry. Otherwise, allocate a new color for R,
7570 G, B, and make an entry in the color table. */
7571
7572static unsigned long
7573lookup_rgb_color (f, r, g, b)
7574 struct frame *f;
7575 int r, g, b;
7576{
7577 unsigned hash = CT_HASH_RGB (r, g, b);
7578 int i = hash % CT_SIZE;
7579 struct ct_color *p;
7580
7581 for (p = ct_table[i]; p; p = p->next)
7582 if (p->r == r && p->g == g && p->b == b)
7583 break;
7584
7585 if (p == NULL)
7586 {
7587 XColor color;
7588 Colormap cmap;
7589 int rc;
7590
7591 color.red = r;
7592 color.green = g;
7593 color.blue = b;
7594
9b2956e2 7595 cmap = FRAME_X_COLORMAP (f);
d62c8769 7596 rc = x_alloc_nearest_color (f, cmap, &color);
333b20bb
GM
7597
7598 if (rc)
7599 {
7600 ++ct_colors_allocated;
7601
7602 p = (struct ct_color *) xmalloc (sizeof *p);
7603 p->r = r;
7604 p->g = g;
7605 p->b = b;
7606 p->pixel = color.pixel;
7607 p->next = ct_table[i];
7608 ct_table[i] = p;
7609 }
7610 else
7611 return FRAME_FOREGROUND_PIXEL (f);
7612 }
7613
7614 return p->pixel;
7615}
7616
7617
7618/* Look up pixel color PIXEL which is used on frame F in the color
7619 table. If not already present, allocate it. Value is PIXEL. */
7620
7621static unsigned long
7622lookup_pixel_color (f, pixel)
7623 struct frame *f;
7624 unsigned long pixel;
7625{
7626 int i = pixel % CT_SIZE;
7627 struct ct_color *p;
7628
7629 for (p = ct_table[i]; p; p = p->next)
7630 if (p->pixel == pixel)
7631 break;
7632
7633 if (p == NULL)
7634 {
7635 XColor color;
7636 Colormap cmap;
7637 int rc;
7638
9b2956e2 7639 cmap = FRAME_X_COLORMAP (f);
333b20bb 7640 color.pixel = pixel;
a31fedb7 7641 x_query_color (f, &color);
d62c8769 7642 rc = x_alloc_nearest_color (f, cmap, &color);
333b20bb
GM
7643
7644 if (rc)
7645 {
7646 ++ct_colors_allocated;
7647
7648 p = (struct ct_color *) xmalloc (sizeof *p);
7649 p->r = color.red;
7650 p->g = color.green;
7651 p->b = color.blue;
7652 p->pixel = pixel;
7653 p->next = ct_table[i];
7654 ct_table[i] = p;
7655 }
7656 else
7657 return FRAME_FOREGROUND_PIXEL (f);
7658 }
7659
7660 return p->pixel;
7661}
7662
7663
7664/* Value is a vector of all pixel colors contained in the color table,
7665 allocated via xmalloc. Set *N to the number of colors. */
7666
7667static unsigned long *
7668colors_in_color_table (n)
7669 int *n;
7670{
7671 int i, j;
7672 struct ct_color *p;
7673 unsigned long *colors;
7674
7675 if (ct_colors_allocated == 0)
7676 {
7677 *n = 0;
7678 colors = NULL;
7679 }
7680 else
7681 {
7682 colors = (unsigned long *) xmalloc (ct_colors_allocated
7683 * sizeof *colors);
7684 *n = ct_colors_allocated;
7685
7686 for (i = j = 0; i < CT_SIZE; ++i)
7687 for (p = ct_table[i]; p; p = p->next)
7688 colors[j++] = p->pixel;
7689 }
7690
7691 return colors;
7692}
7693
7694
7695\f
7696/***********************************************************************
7697 Algorithms
7698 ***********************************************************************/
7699
7700static void x_laplace_write_row P_ ((struct frame *, long *,
7701 int, XImage *, int));
7702static void x_laplace_read_row P_ ((struct frame *, Colormap,
7703 XColor *, int, XImage *, int));
4a8e312c
GM
7704static XColor *x_to_xcolors P_ ((struct frame *, struct image *, int));
7705static void x_from_xcolors P_ ((struct frame *, struct image *, XColor *));
7706static void x_detect_edges P_ ((struct frame *, struct image *, int[9], int));
7707
d2dc8167 7708/* Non-zero means draw a cross on images having `:conversion
14819cb3
GM
7709 disabled'. */
7710
7711int cross_disabled_images;
7712
4a8e312c
GM
7713/* Edge detection matrices for different edge-detection
7714 strategies. */
7715
7716static int emboss_matrix[9] = {
7717 /* x - 1 x x + 1 */
7718 2, -1, 0, /* y - 1 */
7719 -1, 0, 1, /* y */
7720 0, 1, -2 /* y + 1 */
7721};
333b20bb 7722
4a8e312c
GM
7723static int laplace_matrix[9] = {
7724 /* x - 1 x x + 1 */
7725 1, 0, 0, /* y - 1 */
7726 0, 0, 0, /* y */
7727 0, 0, -1 /* y + 1 */
7728};
333b20bb 7729
14819cb3
GM
7730/* Value is the intensity of the color whose red/green/blue values
7731 are R, G, and B. */
7732
7733#define COLOR_INTENSITY(R, G, B) ((2 * (R) + 3 * (G) + (B)) / 6)
7734
333b20bb 7735
4a8e312c
GM
7736/* On frame F, return an array of XColor structures describing image
7737 IMG->pixmap. Each XColor structure has its pixel color set. RGB_P
7738 non-zero means also fill the red/green/blue members of the XColor
7739 structures. Value is a pointer to the array of XColors structures,
7740 allocated with xmalloc; it must be freed by the caller. */
7741
7742static XColor *
7743x_to_xcolors (f, img, rgb_p)
333b20bb 7744 struct frame *f;
4a8e312c
GM
7745 struct image *img;
7746 int rgb_p;
333b20bb 7747{
4a8e312c
GM
7748 int x, y;
7749 XColor *colors, *p;
7750 XImage *ximg;
333b20bb 7751
4a8e312c
GM
7752 colors = (XColor *) xmalloc (img->width * img->height * sizeof *colors);
7753
7754 /* Get the X image IMG->pixmap. */
7755 ximg = XGetImage (FRAME_X_DISPLAY (f), img->pixmap,
7756 0, 0, img->width, img->height, ~0, ZPixmap);
333b20bb 7757
4a8e312c
GM
7758 /* Fill the `pixel' members of the XColor array. I wished there
7759 were an easy and portable way to circumvent XGetPixel. */
7760 p = colors;
7761 for (y = 0; y < img->height; ++y)
7762 {
7763 XColor *row = p;
7764
7765 for (x = 0; x < img->width; ++x, ++p)
7766 p->pixel = XGetPixel (ximg, x, y);
7767
7768 if (rgb_p)
a31fedb7 7769 x_query_colors (f, row, img->width);
4a8e312c
GM
7770 }
7771
7772 XDestroyImage (ximg);
4a8e312c 7773 return colors;
333b20bb
GM
7774}
7775
7776
4a8e312c
GM
7777/* Create IMG->pixmap from an array COLORS of XColor structures, whose
7778 RGB members are set. F is the frame on which this all happens.
7779 COLORS will be freed; an existing IMG->pixmap will be freed, too. */
333b20bb
GM
7780
7781static void
4a8e312c 7782x_from_xcolors (f, img, colors)
333b20bb 7783 struct frame *f;
4a8e312c
GM
7784 struct image *img;
7785 XColor *colors;
333b20bb 7786{
4a8e312c
GM
7787 int x, y;
7788 XImage *oimg;
7789 Pixmap pixmap;
7790 XColor *p;
7791
4a8e312c 7792 init_color_table ();
333b20bb 7793
4a8e312c
GM
7794 x_create_x_image_and_pixmap (f, img->width, img->height, 0,
7795 &oimg, &pixmap);
7796 p = colors;
7797 for (y = 0; y < img->height; ++y)
7798 for (x = 0; x < img->width; ++x, ++p)
7799 {
7800 unsigned long pixel;
7801 pixel = lookup_rgb_color (f, p->red, p->green, p->blue);
7802 XPutPixel (oimg, x, y, pixel);
7803 }
7804
7805 xfree (colors);
dd00328a 7806 x_clear_image_1 (f, img, 1, 0, 1);
4a8e312c
GM
7807
7808 x_put_x_image (f, oimg, pixmap, img->width, img->height);
7809 x_destroy_x_image (oimg);
7810 img->pixmap = pixmap;
7811 img->colors = colors_in_color_table (&img->ncolors);
7812 free_color_table ();
333b20bb
GM
7813}
7814
7815
4a8e312c
GM
7816/* On frame F, perform edge-detection on image IMG.
7817
7818 MATRIX is a nine-element array specifying the transformation
7819 matrix. See emboss_matrix for an example.
7820
7821 COLOR_ADJUST is a color adjustment added to each pixel of the
7822 outgoing image. */
333b20bb
GM
7823
7824static void
4a8e312c 7825x_detect_edges (f, img, matrix, color_adjust)
333b20bb
GM
7826 struct frame *f;
7827 struct image *img;
4a8e312c 7828 int matrix[9], color_adjust;
333b20bb 7829{
4a8e312c
GM
7830 XColor *colors = x_to_xcolors (f, img, 1);
7831 XColor *new, *p;
7832 int x, y, i, sum;
333b20bb 7833
4a8e312c
GM
7834 for (i = sum = 0; i < 9; ++i)
7835 sum += abs (matrix[i]);
333b20bb 7836
4a8e312c 7837#define COLOR(A, X, Y) ((A) + (Y) * img->width + (X))
333b20bb 7838
4a8e312c 7839 new = (XColor *) xmalloc (img->width * img->height * sizeof *new);
333b20bb 7840
4a8e312c
GM
7841 for (y = 0; y < img->height; ++y)
7842 {
7843 p = COLOR (new, 0, y);
7844 p->red = p->green = p->blue = 0xffff/2;
7845 p = COLOR (new, img->width - 1, y);
7846 p->red = p->green = p->blue = 0xffff/2;
7847 }
7848
7849 for (x = 1; x < img->width - 1; ++x)
7850 {
7851 p = COLOR (new, x, 0);
7852 p->red = p->green = p->blue = 0xffff/2;
7853 p = COLOR (new, x, img->height - 1);
7854 p->red = p->green = p->blue = 0xffff/2;
7855 }
333b20bb 7856
4a8e312c 7857 for (y = 1; y < img->height - 1; ++y)
333b20bb 7858 {
4a8e312c
GM
7859 p = COLOR (new, 1, y);
7860
7861 for (x = 1; x < img->width - 1; ++x, ++p)
7862 {
14819cb3 7863 int r, g, b, y1, x1;
4a8e312c
GM
7864
7865 r = g = b = i = 0;
7866 for (y1 = y - 1; y1 < y + 2; ++y1)
7867 for (x1 = x - 1; x1 < x + 2; ++x1, ++i)
7868 if (matrix[i])
7869 {
7870 XColor *t = COLOR (colors, x1, y1);
7871 r += matrix[i] * t->red;
7872 g += matrix[i] * t->green;
7873 b += matrix[i] * t->blue;
7874 }
333b20bb 7875
4a8e312c
GM
7876 r = (r / sum + color_adjust) & 0xffff;
7877 g = (g / sum + color_adjust) & 0xffff;
7878 b = (b / sum + color_adjust) & 0xffff;
14819cb3 7879 p->red = p->green = p->blue = COLOR_INTENSITY (r, g, b);
333b20bb 7880 }
333b20bb
GM
7881 }
7882
4a8e312c
GM
7883 xfree (colors);
7884 x_from_xcolors (f, img, new);
333b20bb 7885
4a8e312c
GM
7886#undef COLOR
7887}
7888
7889
7890/* Perform the pre-defined `emboss' edge-detection on image IMG
7891 on frame F. */
7892
7893static void
7894x_emboss (f, img)
7895 struct frame *f;
7896 struct image *img;
7897{
7898 x_detect_edges (f, img, emboss_matrix, 0xffff / 2);
7899}
7900
7901
7902/* Perform the pre-defined `laplace' edge-detection on image IMG
7903 on frame F. */
7904
7905static void
7906x_laplace (f, img)
7907 struct frame *f;
7908 struct image *img;
7909{
7910 x_detect_edges (f, img, laplace_matrix, 45000);
7911}
7912
7913
7914/* Perform edge-detection on image IMG on frame F, with specified
7915 transformation matrix MATRIX and color-adjustment COLOR_ADJUST.
7916
7917 MATRIX must be either
7918
7919 - a list of at least 9 numbers in row-major form
7920 - a vector of at least 9 numbers
7921
7922 COLOR_ADJUST nil means use a default; otherwise it must be a
7923 number. */
7924
7925static void
7926x_edge_detection (f, img, matrix, color_adjust)
7927 struct frame *f;
7928 struct image *img;
7929 Lisp_Object matrix, color_adjust;
7930{
7931 int i = 0;
7932 int trans[9];
333b20bb 7933
4a8e312c
GM
7934 if (CONSP (matrix))
7935 {
7936 for (i = 0;
7937 i < 9 && CONSP (matrix) && NUMBERP (XCAR (matrix));
7938 ++i, matrix = XCDR (matrix))
7939 trans[i] = XFLOATINT (XCAR (matrix));
7940 }
7941 else if (VECTORP (matrix) && ASIZE (matrix) >= 9)
7942 {
7943 for (i = 0; i < 9 && NUMBERP (AREF (matrix, i)); ++i)
7944 trans[i] = XFLOATINT (AREF (matrix, i));
7945 }
333b20bb 7946
4a8e312c
GM
7947 if (NILP (color_adjust))
7948 color_adjust = make_number (0xffff / 2);
333b20bb 7949
4a8e312c
GM
7950 if (i == 9 && NUMBERP (color_adjust))
7951 x_detect_edges (f, img, trans, (int) XFLOATINT (color_adjust));
333b20bb
GM
7952}
7953
7954
14819cb3
GM
7955/* Transform image IMG on frame F so that it looks disabled. */
7956
7957static void
7958x_disable_image (f, img)
7959 struct frame *f;
7960 struct image *img;
7961{
7962 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
dd00328a 7963
14819cb3
GM
7964 if (dpyinfo->n_planes >= 2)
7965 {
7966 /* Color (or grayscale). Convert to gray, and equalize. Just
7967 drawing such images with a stipple can look very odd, so
7968 we're using this method instead. */
7969 XColor *colors = x_to_xcolors (f, img, 1);
7970 XColor *p, *end;
7971 const int h = 15000;
7972 const int l = 30000;
7973
7974 for (p = colors, end = colors + img->width * img->height;
7975 p < end;
7976 ++p)
7977 {
7978 int i = COLOR_INTENSITY (p->red, p->green, p->blue);
7979 int i2 = (0xffff - h - l) * i / 0xffff + l;
7980 p->red = p->green = p->blue = i2;
7981 }
7982
7983 x_from_xcolors (f, img, colors);
7984 }
7985
7986 /* Draw a cross over the disabled image, if we must or if we
7987 should. */
7988 if (dpyinfo->n_planes < 2 || cross_disabled_images)
7989 {
7990 Display *dpy = FRAME_X_DISPLAY (f);
7991 GC gc;
7992
14819cb3
GM
7993 gc = XCreateGC (dpy, img->pixmap, 0, NULL);
7994 XSetForeground (dpy, gc, BLACK_PIX_DEFAULT (f));
7995 XDrawLine (dpy, img->pixmap, gc, 0, 0,
7996 img->width - 1, img->height - 1);
7997 XDrawLine (dpy, img->pixmap, gc, 0, img->height - 1,
7998 img->width - 1, 0);
7999 XFreeGC (dpy, gc);
8000
8001 if (img->mask)
8002 {
8003 gc = XCreateGC (dpy, img->mask, 0, NULL);
8004 XSetForeground (dpy, gc, WHITE_PIX_DEFAULT (f));
8005 XDrawLine (dpy, img->mask, gc, 0, 0,
8006 img->width - 1, img->height - 1);
8007 XDrawLine (dpy, img->mask, gc, 0, img->height - 1,
8008 img->width - 1, 0);
8009 XFreeGC (dpy, gc);
8010 }
14819cb3
GM
8011 }
8012}
8013
8014
333b20bb
GM
8015/* Build a mask for image IMG which is used on frame F. FILE is the
8016 name of an image file, for error messages. HOW determines how to
fcf431dc
GM
8017 determine the background color of IMG. If it is a list '(R G B)',
8018 with R, G, and B being integers >= 0, take that as the color of the
8019 background. Otherwise, determine the background color of IMG
8020 heuristically. Value is non-zero if successful. */
333b20bb
GM
8021
8022static int
45158a91 8023x_build_heuristic_mask (f, img, how)
333b20bb 8024 struct frame *f;
333b20bb
GM
8025 struct image *img;
8026 Lisp_Object how;
8027{
8028 Display *dpy = FRAME_X_DISPLAY (f);
333b20bb 8029 XImage *ximg, *mask_img;
fcf431dc 8030 int x, y, rc, look_at_corners_p;
8ec8a5ec 8031 unsigned long bg = 0;
333b20bb 8032
4a8e312c
GM
8033 if (img->mask)
8034 {
8035 XFreePixmap (FRAME_X_DISPLAY (f), img->mask);
dd00328a 8036 img->mask = None;
4a8e312c 8037 }
dd00328a 8038
333b20bb 8039 /* Create an image and pixmap serving as mask. */
45158a91 8040 rc = x_create_x_image_and_pixmap (f, img->width, img->height, 1,
333b20bb
GM
8041 &mask_img, &img->mask);
8042 if (!rc)
28c7826c 8043 return 0;
333b20bb
GM
8044
8045 /* Get the X image of IMG->pixmap. */
8046 ximg = XGetImage (dpy, img->pixmap, 0, 0, img->width, img->height,
8047 ~0, ZPixmap);
8048
fcf431dc
GM
8049 /* Determine the background color of ximg. If HOW is `(R G B)'
8050 take that as color. Otherwise, try to determine the color
8051 heuristically. */
8052 look_at_corners_p = 1;
8053
8054 if (CONSP (how))
8055 {
8056 int rgb[3], i = 0;
8057
8058 while (i < 3
8059 && CONSP (how)
8060 && NATNUMP (XCAR (how)))
8061 {
8062 rgb[i] = XFASTINT (XCAR (how)) & 0xffff;
8063 how = XCDR (how);
8064 }
8065
8066 if (i == 3 && NILP (how))
8067 {
8068 char color_name[30];
8069 XColor exact, color;
8070 Colormap cmap;
8071
8072 sprintf (color_name, "#%04x%04x%04x", rgb[0], rgb[1], rgb[2]);
8073
9b2956e2 8074 cmap = FRAME_X_COLORMAP (f);
fcf431dc
GM
8075 if (XLookupColor (dpy, cmap, color_name, &exact, &color))
8076 {
8077 bg = color.pixel;
8078 look_at_corners_p = 0;
8079 }
8080 }
8081 }
8082
8083 if (look_at_corners_p)
333b20bb
GM
8084 {
8085 unsigned long corners[4];
8086 int i, best_count;
8087
8088 /* Get the colors at the corners of ximg. */
8089 corners[0] = XGetPixel (ximg, 0, 0);
8090 corners[1] = XGetPixel (ximg, img->width - 1, 0);
8091 corners[2] = XGetPixel (ximg, img->width - 1, img->height - 1);
8092 corners[3] = XGetPixel (ximg, 0, img->height - 1);
8093
8094 /* Choose the most frequently found color as background. */
8095 for (i = best_count = 0; i < 4; ++i)
8096 {
8097 int j, n;
8098
8099 for (j = n = 0; j < 4; ++j)
8100 if (corners[i] == corners[j])
8101 ++n;
8102
8103 if (n > best_count)
8104 bg = corners[i], best_count = n;
8105 }
8106 }
8107
8108 /* Set all bits in mask_img to 1 whose color in ximg is different
8109 from the background color bg. */
8110 for (y = 0; y < img->height; ++y)
8111 for (x = 0; x < img->width; ++x)
8112 XPutPixel (mask_img, x, y, XGetPixel (ximg, x, y) != bg);
8113
8114 /* Put mask_img into img->mask. */
8115 x_put_x_image (f, mask_img, img->mask, img->width, img->height);
8116 x_destroy_x_image (mask_img);
8117 XDestroyImage (ximg);
8118
333b20bb
GM
8119 return 1;
8120}
8121
8122
8123\f
8124/***********************************************************************
8125 PBM (mono, gray, color)
8126 ***********************************************************************/
8127
8128static int pbm_image_p P_ ((Lisp_Object object));
8129static int pbm_load P_ ((struct frame *f, struct image *img));
63cec32f 8130static int pbm_scan_number P_ ((unsigned char **, unsigned char *));
333b20bb
GM
8131
8132/* The symbol `pbm' identifying images of this type. */
8133
8134Lisp_Object Qpbm;
8135
8136/* Indices of image specification fields in gs_format, below. */
8137
8138enum pbm_keyword_index
8139{
8140 PBM_TYPE,
8141 PBM_FILE,
63cec32f 8142 PBM_DATA,
333b20bb
GM
8143 PBM_ASCENT,
8144 PBM_MARGIN,
8145 PBM_RELIEF,
8146 PBM_ALGORITHM,
8147 PBM_HEURISTIC_MASK,
4a8e312c 8148 PBM_MASK,
be0b1fac
GM
8149 PBM_FOREGROUND,
8150 PBM_BACKGROUND,
333b20bb
GM
8151 PBM_LAST
8152};
8153
8154/* Vector of image_keyword structures describing the format
8155 of valid user-defined image specifications. */
8156
8157static struct image_keyword pbm_format[PBM_LAST] =
8158{
8159 {":type", IMAGE_SYMBOL_VALUE, 1},
63cec32f
GM
8160 {":file", IMAGE_STRING_VALUE, 0},
8161 {":data", IMAGE_STRING_VALUE, 0},
7c7ff7f5 8162 {":ascent", IMAGE_ASCENT_VALUE, 0},
3ed61e75 8163 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
333b20bb 8164 {":relief", IMAGE_INTEGER_VALUE, 0},
d2dc8167 8165 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
4a8e312c 8166 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
be0b1fac 8167 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6f1be3b9
GM
8168 {":foreground", IMAGE_STRING_OR_NIL_VALUE, 0},
8169 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
333b20bb
GM
8170};
8171
8172/* Structure describing the image type `pbm'. */
8173
8174static struct image_type pbm_type =
8175{
8176 &Qpbm,
8177 pbm_image_p,
8178 pbm_load,
8179 x_clear_image,
8180 NULL
8181};
8182
8183
8184/* Return non-zero if OBJECT is a valid PBM image specification. */
8185
8186static int
8187pbm_image_p (object)
8188 Lisp_Object object;
8189{
8190 struct image_keyword fmt[PBM_LAST];
8191
8192 bcopy (pbm_format, fmt, sizeof fmt);
8193
7c7ff7f5 8194 if (!parse_image_spec (object, fmt, PBM_LAST, Qpbm))
333b20bb 8195 return 0;
63cec32f
GM
8196
8197 /* Must specify either :data or :file. */
8198 return fmt[PBM_DATA].count + fmt[PBM_FILE].count == 1;
333b20bb
GM
8199}
8200
8201
63cec32f
GM
8202/* Scan a decimal number from *S and return it. Advance *S while
8203 reading the number. END is the end of the string. Value is -1 at
8204 end of input. */
333b20bb
GM
8205
8206static int
63cec32f
GM
8207pbm_scan_number (s, end)
8208 unsigned char **s, *end;
333b20bb 8209{
8ec8a5ec 8210 int c = 0, val = -1;
333b20bb 8211
63cec32f 8212 while (*s < end)
333b20bb
GM
8213 {
8214 /* Skip white-space. */
63cec32f 8215 while (*s < end && (c = *(*s)++, isspace (c)))
333b20bb
GM
8216 ;
8217
8218 if (c == '#')
8219 {
8220 /* Skip comment to end of line. */
63cec32f 8221 while (*s < end && (c = *(*s)++, c != '\n'))
333b20bb
GM
8222 ;
8223 }
8224 else if (isdigit (c))
8225 {
8226 /* Read decimal number. */
8227 val = c - '0';
63cec32f 8228 while (*s < end && (c = *(*s)++, isdigit (c)))
333b20bb
GM
8229 val = 10 * val + c - '0';
8230 break;
8231 }
8232 else
8233 break;
8234 }
8235
8236 return val;
8237}
8238
8239
8240/* Load PBM image IMG for use on frame F. */
8241
8242static int
8243pbm_load (f, img)
8244 struct frame *f;
8245 struct image *img;
8246{
333b20bb 8247 int raw_p, x, y;
b6d7acec 8248 int width, height, max_color_idx = 0;
333b20bb
GM
8249 XImage *ximg;
8250 Lisp_Object file, specified_file;
8251 enum {PBM_MONO, PBM_GRAY, PBM_COLOR} type;
8252 struct gcpro gcpro1;
63cec32f
GM
8253 unsigned char *contents = NULL;
8254 unsigned char *end, *p;
8255 int size;
333b20bb
GM
8256
8257 specified_file = image_spec_value (img->spec, QCfile, NULL);
63cec32f 8258 file = Qnil;
333b20bb 8259 GCPRO1 (file);
333b20bb 8260
63cec32f 8261 if (STRINGP (specified_file))
333b20bb 8262 {
63cec32f
GM
8263 file = x_find_image_file (specified_file);
8264 if (!STRINGP (file))
8265 {
8266 image_error ("Cannot find image file `%s'", specified_file, Qnil);
8267 UNGCPRO;
8268 return 0;
8269 }
333b20bb 8270
5be6c3b0 8271 contents = slurp_file (XSTRING (file)->data, &size);
63cec32f
GM
8272 if (contents == NULL)
8273 {
8274 image_error ("Error reading `%s'", file, Qnil);
8275 UNGCPRO;
8276 return 0;
8277 }
8278
8279 p = contents;
8280 end = contents + size;
8281 }
8282 else
333b20bb 8283 {
63cec32f
GM
8284 Lisp_Object data;
8285 data = image_spec_value (img->spec, QCdata, NULL);
8286 p = XSTRING (data)->data;
8287 end = p + STRING_BYTES (XSTRING (data));
333b20bb
GM
8288 }
8289
63cec32f
GM
8290 /* Check magic number. */
8291 if (end - p < 2 || *p++ != 'P')
333b20bb 8292 {
45158a91 8293 image_error ("Not a PBM image: `%s'", img->spec, Qnil);
63cec32f
GM
8294 error:
8295 xfree (contents);
333b20bb
GM
8296 UNGCPRO;
8297 return 0;
8298 }
8299
63cec32f 8300 switch (*p++)
333b20bb
GM
8301 {
8302 case '1':
8303 raw_p = 0, type = PBM_MONO;
8304 break;
8305
8306 case '2':
8307 raw_p = 0, type = PBM_GRAY;
8308 break;
8309
8310 case '3':
8311 raw_p = 0, type = PBM_COLOR;
8312 break;
8313
8314 case '4':
8315 raw_p = 1, type = PBM_MONO;
8316 break;
8317
8318 case '5':
8319 raw_p = 1, type = PBM_GRAY;
8320 break;
8321
8322 case '6':
8323 raw_p = 1, type = PBM_COLOR;
8324 break;
8325
8326 default:
45158a91 8327 image_error ("Not a PBM image: `%s'", img->spec, Qnil);
63cec32f 8328 goto error;
333b20bb
GM
8329 }
8330
8331 /* Read width, height, maximum color-component. Characters
8332 starting with `#' up to the end of a line are ignored. */
63cec32f
GM
8333 width = pbm_scan_number (&p, end);
8334 height = pbm_scan_number (&p, end);
333b20bb
GM
8335
8336 if (type != PBM_MONO)
8337 {
63cec32f 8338 max_color_idx = pbm_scan_number (&p, end);
333b20bb
GM
8339 if (raw_p && max_color_idx > 255)
8340 max_color_idx = 255;
8341 }
8342
63cec32f
GM
8343 if (width < 0
8344 || height < 0
333b20bb 8345 || (type != PBM_MONO && max_color_idx < 0))
63cec32f 8346 goto error;
333b20bb 8347
45158a91 8348 if (!x_create_x_image_and_pixmap (f, width, height, 0,
333b20bb 8349 &ximg, &img->pixmap))
28c7826c 8350 goto error;
333b20bb
GM
8351
8352 /* Initialize the color hash table. */
8353 init_color_table ();
8354
8355 if (type == PBM_MONO)
8356 {
8357 int c = 0, g;
be0b1fac
GM
8358 struct image_keyword fmt[PBM_LAST];
8359 unsigned long fg = FRAME_FOREGROUND_PIXEL (f);
8360 unsigned long bg = FRAME_BACKGROUND_PIXEL (f);
8361
8362 /* Parse the image specification. */
8363 bcopy (pbm_format, fmt, sizeof fmt);
8364 parse_image_spec (img->spec, fmt, PBM_LAST, Qpbm);
8365
8366 /* Get foreground and background colors, maybe allocate colors. */
6f1be3b9
GM
8367 if (fmt[PBM_FOREGROUND].count
8368 && STRINGP (fmt[PBM_FOREGROUND].value))
be0b1fac 8369 fg = x_alloc_image_color (f, img, fmt[PBM_FOREGROUND].value, fg);
6f1be3b9
GM
8370 if (fmt[PBM_BACKGROUND].count
8371 && STRINGP (fmt[PBM_BACKGROUND].value))
be0b1fac 8372 bg = x_alloc_image_color (f, img, fmt[PBM_BACKGROUND].value, bg);
333b20bb
GM
8373
8374 for (y = 0; y < height; ++y)
8375 for (x = 0; x < width; ++x)
8376 {
8377 if (raw_p)
8378 {
8379 if ((x & 7) == 0)
63cec32f 8380 c = *p++;
333b20bb
GM
8381 g = c & 0x80;
8382 c <<= 1;
8383 }
8384 else
63cec32f 8385 g = pbm_scan_number (&p, end);
333b20bb 8386
be0b1fac 8387 XPutPixel (ximg, x, y, g ? fg : bg);
333b20bb
GM
8388 }
8389 }
8390 else
8391 {
8392 for (y = 0; y < height; ++y)
8393 for (x = 0; x < width; ++x)
8394 {
8395 int r, g, b;
8396
8397 if (type == PBM_GRAY)
63cec32f 8398 r = g = b = raw_p ? *p++ : pbm_scan_number (&p, end);
333b20bb
GM
8399 else if (raw_p)
8400 {
63cec32f
GM
8401 r = *p++;
8402 g = *p++;
8403 b = *p++;
333b20bb
GM
8404 }
8405 else
8406 {
63cec32f
GM
8407 r = pbm_scan_number (&p, end);
8408 g = pbm_scan_number (&p, end);
8409 b = pbm_scan_number (&p, end);
333b20bb
GM
8410 }
8411
8412 if (r < 0 || g < 0 || b < 0)
8413 {
333b20bb
GM
8414 xfree (ximg->data);
8415 ximg->data = NULL;
8416 XDestroyImage (ximg);
45158a91
GM
8417 image_error ("Invalid pixel value in image `%s'",
8418 img->spec, Qnil);
63cec32f 8419 goto error;
333b20bb
GM
8420 }
8421
8422 /* RGB values are now in the range 0..max_color_idx.
8423 Scale this to the range 0..0xffff supported by X. */
8424 r = (double) r * 65535 / max_color_idx;
8425 g = (double) g * 65535 / max_color_idx;
8426 b = (double) b * 65535 / max_color_idx;
8427 XPutPixel (ximg, x, y, lookup_rgb_color (f, r, g, b));
8428 }
8429 }
8430
333b20bb
GM
8431 /* Store in IMG->colors the colors allocated for the image, and
8432 free the color table. */
8433 img->colors = colors_in_color_table (&img->ncolors);
8434 free_color_table ();
8435
8436 /* Put the image into a pixmap. */
8437 x_put_x_image (f, ximg, img->pixmap, width, height);
8438 x_destroy_x_image (ximg);
333b20bb
GM
8439
8440 img->width = width;
8441 img->height = height;
8442
8443 UNGCPRO;
63cec32f 8444 xfree (contents);
333b20bb
GM
8445 return 1;
8446}
8447
8448
8449\f
8450/***********************************************************************
8451 PNG
8452 ***********************************************************************/
8453
8454#if HAVE_PNG
8455
8456#include <png.h>
8457
8458/* Function prototypes. */
8459
8460static int png_image_p P_ ((Lisp_Object object));
8461static int png_load P_ ((struct frame *f, struct image *img));
8462
8463/* The symbol `png' identifying images of this type. */
8464
8465Lisp_Object Qpng;
8466
8467/* Indices of image specification fields in png_format, below. */
8468
8469enum png_keyword_index
8470{
8471 PNG_TYPE,
63448a4d 8472 PNG_DATA,
333b20bb
GM
8473 PNG_FILE,
8474 PNG_ASCENT,
8475 PNG_MARGIN,
8476 PNG_RELIEF,
8477 PNG_ALGORITHM,
8478 PNG_HEURISTIC_MASK,
4a8e312c 8479 PNG_MASK,
333b20bb
GM
8480 PNG_LAST
8481};
8482
8483/* Vector of image_keyword structures describing the format
8484 of valid user-defined image specifications. */
8485
8486static struct image_keyword png_format[PNG_LAST] =
8487{
8488 {":type", IMAGE_SYMBOL_VALUE, 1},
5ad6a5fb 8489 {":data", IMAGE_STRING_VALUE, 0},
63448a4d 8490 {":file", IMAGE_STRING_VALUE, 0},
7c7ff7f5 8491 {":ascent", IMAGE_ASCENT_VALUE, 0},
3ed61e75 8492 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
333b20bb 8493 {":relief", IMAGE_INTEGER_VALUE, 0},
d2dc8167 8494 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
4a8e312c
GM
8495 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
8496 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
333b20bb
GM
8497};
8498
06482119 8499/* Structure describing the image type `png'. */
333b20bb
GM
8500
8501static struct image_type png_type =
8502{
8503 &Qpng,
8504 png_image_p,
8505 png_load,
8506 x_clear_image,
8507 NULL
8508};
8509
8510
8511/* Return non-zero if OBJECT is a valid PNG image specification. */
8512
8513static int
8514png_image_p (object)
8515 Lisp_Object object;
8516{
8517 struct image_keyword fmt[PNG_LAST];
8518 bcopy (png_format, fmt, sizeof fmt);
8519
7c7ff7f5 8520 if (!parse_image_spec (object, fmt, PNG_LAST, Qpng))
333b20bb 8521 return 0;
63448a4d 8522
63cec32f
GM
8523 /* Must specify either the :data or :file keyword. */
8524 return fmt[PNG_FILE].count + fmt[PNG_DATA].count == 1;
333b20bb
GM
8525}
8526
8527
8528/* Error and warning handlers installed when the PNG library
8529 is initialized. */
8530
8531static void
8532my_png_error (png_ptr, msg)
8533 png_struct *png_ptr;
8534 char *msg;
8535{
8536 xassert (png_ptr != NULL);
8537 image_error ("PNG error: %s", build_string (msg), Qnil);
8538 longjmp (png_ptr->jmpbuf, 1);
8539}
8540
8541
8542static void
8543my_png_warning (png_ptr, msg)
8544 png_struct *png_ptr;
8545 char *msg;
8546{
8547 xassert (png_ptr != NULL);
8548 image_error ("PNG warning: %s", build_string (msg), Qnil);
8549}
8550
5ad6a5fb
GM
8551/* Memory source for PNG decoding. */
8552
63448a4d
WP
8553struct png_memory_storage
8554{
5ad6a5fb
GM
8555 unsigned char *bytes; /* The data */
8556 size_t len; /* How big is it? */
8557 int index; /* Where are we? */
63448a4d
WP
8558};
8559
5ad6a5fb
GM
8560
8561/* Function set as reader function when reading PNG image from memory.
8562 PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
8563 bytes from the input to DATA. */
8564
63448a4d 8565static void
5ad6a5fb
GM
8566png_read_from_memory (png_ptr, data, length)
8567 png_structp png_ptr;
8568 png_bytep data;
8569 png_size_t length;
63448a4d 8570{
5ad6a5fb
GM
8571 struct png_memory_storage *tbr
8572 = (struct png_memory_storage *) png_get_io_ptr (png_ptr);
63448a4d 8573
5ad6a5fb
GM
8574 if (length > tbr->len - tbr->index)
8575 png_error (png_ptr, "Read error");
8576
8577 bcopy (tbr->bytes + tbr->index, data, length);
8578 tbr->index = tbr->index + length;
63448a4d 8579}
333b20bb
GM
8580
8581/* Load PNG image IMG for use on frame F. Value is non-zero if
8582 successful. */
8583
8584static int
8585png_load (f, img)
8586 struct frame *f;
8587 struct image *img;
8588{
8589 Lisp_Object file, specified_file;
63448a4d 8590 Lisp_Object specified_data;
b6d7acec 8591 int x, y, i;
333b20bb
GM
8592 XImage *ximg, *mask_img = NULL;
8593 struct gcpro gcpro1;
8594 png_struct *png_ptr = NULL;
8595 png_info *info_ptr = NULL, *end_info = NULL;
8ec8a5ec 8596 FILE *volatile fp = NULL;
333b20bb 8597 png_byte sig[8];
8ec8a5ec
GM
8598 png_byte * volatile pixels = NULL;
8599 png_byte ** volatile rows = NULL;
333b20bb
GM
8600 png_uint_32 width, height;
8601 int bit_depth, color_type, interlace_type;
8602 png_byte channels;
8603 png_uint_32 row_bytes;
8604 int transparent_p;
8605 char *gamma_str;
8606 double screen_gamma, image_gamma;
8607 int intent;
63448a4d 8608 struct png_memory_storage tbr; /* Data to be read */
333b20bb
GM
8609
8610 /* Find out what file to load. */
8611 specified_file = image_spec_value (img->spec, QCfile, NULL);
63448a4d 8612 specified_data = image_spec_value (img->spec, QCdata, NULL);
5ad6a5fb
GM
8613 file = Qnil;
8614 GCPRO1 (file);
333b20bb 8615
63448a4d 8616 if (NILP (specified_data))
5ad6a5fb
GM
8617 {
8618 file = x_find_image_file (specified_file);
8619 if (!STRINGP (file))
63448a4d 8620 {
45158a91 8621 image_error ("Cannot find image file `%s'", specified_file, Qnil);
5ad6a5fb
GM
8622 UNGCPRO;
8623 return 0;
8624 }
333b20bb 8625
5ad6a5fb
GM
8626 /* Open the image file. */
8627 fp = fopen (XSTRING (file)->data, "rb");
8628 if (!fp)
8629 {
45158a91 8630 image_error ("Cannot open image file `%s'", file, Qnil);
5ad6a5fb
GM
8631 UNGCPRO;
8632 fclose (fp);
8633 return 0;
8634 }
63448a4d 8635
5ad6a5fb
GM
8636 /* Check PNG signature. */
8637 if (fread (sig, 1, sizeof sig, fp) != sizeof sig
8638 || !png_check_sig (sig, sizeof sig))
8639 {
45158a91 8640 image_error ("Not a PNG file: `%s'", file, Qnil);
5ad6a5fb
GM
8641 UNGCPRO;
8642 fclose (fp);
8643 return 0;
63448a4d 8644 }
5ad6a5fb 8645 }
63448a4d 8646 else
5ad6a5fb
GM
8647 {
8648 /* Read from memory. */
8649 tbr.bytes = XSTRING (specified_data)->data;
8650 tbr.len = STRING_BYTES (XSTRING (specified_data));
8651 tbr.index = 0;
63448a4d 8652
5ad6a5fb
GM
8653 /* Check PNG signature. */
8654 if (tbr.len < sizeof sig
8655 || !png_check_sig (tbr.bytes, sizeof sig))
8656 {
45158a91 8657 image_error ("Not a PNG image: `%s'", img->spec, Qnil);
5ad6a5fb
GM
8658 UNGCPRO;
8659 return 0;
63448a4d 8660 }
333b20bb 8661
5ad6a5fb
GM
8662 /* Need to skip past the signature. */
8663 tbr.bytes += sizeof (sig);
8664 }
8665
333b20bb
GM
8666 /* Initialize read and info structs for PNG lib. */
8667 png_ptr = png_create_read_struct (PNG_LIBPNG_VER_STRING, NULL,
8668 my_png_error, my_png_warning);
8669 if (!png_ptr)
8670 {
63448a4d 8671 if (fp) fclose (fp);
333b20bb
GM
8672 UNGCPRO;
8673 return 0;
8674 }
8675
8676 info_ptr = png_create_info_struct (png_ptr);
8677 if (!info_ptr)
8678 {
8679 png_destroy_read_struct (&png_ptr, NULL, NULL);
63448a4d 8680 if (fp) fclose (fp);
333b20bb
GM
8681 UNGCPRO;
8682 return 0;
8683 }
8684
8685 end_info = png_create_info_struct (png_ptr);
8686 if (!end_info)
8687 {
8688 png_destroy_read_struct (&png_ptr, &info_ptr, NULL);
63448a4d 8689 if (fp) fclose (fp);
333b20bb
GM
8690 UNGCPRO;
8691 return 0;
8692 }
8693
8694 /* Set error jump-back. We come back here when the PNG library
8695 detects an error. */
8696 if (setjmp (png_ptr->jmpbuf))
8697 {
8698 error:
8699 if (png_ptr)
8700 png_destroy_read_struct (&png_ptr, &info_ptr, &end_info);
8701 xfree (pixels);
8702 xfree (rows);
63448a4d 8703 if (fp) fclose (fp);
333b20bb
GM
8704 UNGCPRO;
8705 return 0;
8706 }
8707
8708 /* Read image info. */
63448a4d 8709 if (!NILP (specified_data))
5ad6a5fb 8710 png_set_read_fn (png_ptr, (void *) &tbr, png_read_from_memory);
63448a4d 8711 else
5ad6a5fb 8712 png_init_io (png_ptr, fp);
63448a4d 8713
333b20bb
GM
8714 png_set_sig_bytes (png_ptr, sizeof sig);
8715 png_read_info (png_ptr, info_ptr);
8716 png_get_IHDR (png_ptr, info_ptr, &width, &height, &bit_depth, &color_type,
8717 &interlace_type, NULL, NULL);
8718
8719 /* If image contains simply transparency data, we prefer to
8720 construct a clipping mask. */
8721 if (png_get_valid (png_ptr, info_ptr, PNG_INFO_tRNS))
8722 transparent_p = 1;
8723 else
8724 transparent_p = 0;
8725
8726 /* This function is easier to write if we only have to handle
8727 one data format: RGB or RGBA with 8 bits per channel. Let's
8728 transform other formats into that format. */
8729
8730 /* Strip more than 8 bits per channel. */
8731 if (bit_depth == 16)
8732 png_set_strip_16 (png_ptr);
8733
8734 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
8735 if available. */
8736 png_set_expand (png_ptr);
8737
8738 /* Convert grayscale images to RGB. */
8739 if (color_type == PNG_COLOR_TYPE_GRAY
8740 || color_type == PNG_COLOR_TYPE_GRAY_ALPHA)
8741 png_set_gray_to_rgb (png_ptr);
8742
8743 /* The value 2.2 is a guess for PC monitors from PNG example.c. */
8744 gamma_str = getenv ("SCREEN_GAMMA");
8745 screen_gamma = gamma_str ? atof (gamma_str) : 2.2;
8746
8747 /* Tell the PNG lib to handle gamma correction for us. */
8748
6c1aa34d 8749#if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
333b20bb
GM
8750 if (png_get_sRGB (png_ptr, info_ptr, &intent))
8751 /* There is a special chunk in the image specifying the gamma. */
8752 png_set_sRGB (png_ptr, info_ptr, intent);
6c1aa34d
GM
8753 else
8754#endif
8755 if (png_get_gAMA (png_ptr, info_ptr, &image_gamma))
333b20bb
GM
8756 /* Image contains gamma information. */
8757 png_set_gamma (png_ptr, screen_gamma, image_gamma);
8758 else
8759 /* Use a default of 0.5 for the image gamma. */
8760 png_set_gamma (png_ptr, screen_gamma, 0.5);
8761
8762 /* Handle alpha channel by combining the image with a background
8763 color. Do this only if a real alpha channel is supplied. For
8764 simple transparency, we prefer a clipping mask. */
8765 if (!transparent_p)
8766 {
8767 png_color_16 *image_background;
8768
8769 if (png_get_bKGD (png_ptr, info_ptr, &image_background))
8770 /* Image contains a background color with which to
8771 combine the image. */
8772 png_set_background (png_ptr, image_background,
8773 PNG_BACKGROUND_GAMMA_FILE, 1, 1.0);
8774 else
8775 {
8776 /* Image does not contain a background color with which
8777 to combine the image data via an alpha channel. Use
8778 the frame's background instead. */
8779 XColor color;
8780 Colormap cmap;
8781 png_color_16 frame_background;
8782
9b2956e2 8783 cmap = FRAME_X_COLORMAP (f);
333b20bb 8784 color.pixel = FRAME_BACKGROUND_PIXEL (f);
a31fedb7 8785 x_query_color (f, &color);
333b20bb
GM
8786
8787 bzero (&frame_background, sizeof frame_background);
8788 frame_background.red = color.red;
8789 frame_background.green = color.green;
8790 frame_background.blue = color.blue;
8791
8792 png_set_background (png_ptr, &frame_background,
8793 PNG_BACKGROUND_GAMMA_SCREEN, 0, 1.0);
8794 }
8795 }
8796
8797 /* Update info structure. */
8798 png_read_update_info (png_ptr, info_ptr);
8799
8800 /* Get number of channels. Valid values are 1 for grayscale images
8801 and images with a palette, 2 for grayscale images with transparency
8802 information (alpha channel), 3 for RGB images, and 4 for RGB
8803 images with alpha channel, i.e. RGBA. If conversions above were
8804 sufficient we should only have 3 or 4 channels here. */
8805 channels = png_get_channels (png_ptr, info_ptr);
8806 xassert (channels == 3 || channels == 4);
8807
8808 /* Number of bytes needed for one row of the image. */
8809 row_bytes = png_get_rowbytes (png_ptr, info_ptr);
8810
8811 /* Allocate memory for the image. */
8812 pixels = (png_byte *) xmalloc (row_bytes * height * sizeof *pixels);
8813 rows = (png_byte **) xmalloc (height * sizeof *rows);
8814 for (i = 0; i < height; ++i)
8815 rows[i] = pixels + i * row_bytes;
8816
8817 /* Read the entire image. */
8818 png_read_image (png_ptr, rows);
8819 png_read_end (png_ptr, info_ptr);
5ad6a5fb
GM
8820 if (fp)
8821 {
8822 fclose (fp);
8823 fp = NULL;
8824 }
333b20bb 8825
333b20bb 8826 /* Create the X image and pixmap. */
45158a91 8827 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg,
333b20bb 8828 &img->pixmap))
28c7826c 8829 goto error;
333b20bb
GM
8830
8831 /* Create an image and pixmap serving as mask if the PNG image
8832 contains an alpha channel. */
8833 if (channels == 4
8834 && !transparent_p
45158a91 8835 && !x_create_x_image_and_pixmap (f, width, height, 1,
333b20bb
GM
8836 &mask_img, &img->mask))
8837 {
8838 x_destroy_x_image (ximg);
8839 XFreePixmap (FRAME_X_DISPLAY (f), img->pixmap);
dd00328a 8840 img->pixmap = None;
333b20bb
GM
8841 goto error;
8842 }
8843
8844 /* Fill the X image and mask from PNG data. */
8845 init_color_table ();
8846
8847 for (y = 0; y < height; ++y)
8848 {
8849 png_byte *p = rows[y];
8850
8851 for (x = 0; x < width; ++x)
8852 {
8853 unsigned r, g, b;
8854
8855 r = *p++ << 8;
8856 g = *p++ << 8;
8857 b = *p++ << 8;
8858 XPutPixel (ximg, x, y, lookup_rgb_color (f, r, g, b));
8859
8860 /* An alpha channel, aka mask channel, associates variable
8861 transparency with an image. Where other image formats
8862 support binary transparency---fully transparent or fully
8863 opaque---PNG allows up to 254 levels of partial transparency.
8864 The PNG library implements partial transparency by combining
8865 the image with a specified background color.
8866
8867 I'm not sure how to handle this here nicely: because the
8868 background on which the image is displayed may change, for
8869 real alpha channel support, it would be necessary to create
8870 a new image for each possible background.
8871
8872 What I'm doing now is that a mask is created if we have
8873 boolean transparency information. Otherwise I'm using
8874 the frame's background color to combine the image with. */
8875
8876 if (channels == 4)
8877 {
8878 if (mask_img)
8879 XPutPixel (mask_img, x, y, *p > 0);
8880 ++p;
8881 }
8882 }
8883 }
8884
8885 /* Remember colors allocated for this image. */
8886 img->colors = colors_in_color_table (&img->ncolors);
8887 free_color_table ();
8888
8889 /* Clean up. */
8890 png_destroy_read_struct (&png_ptr, &info_ptr, &end_info);
8891 xfree (rows);
8892 xfree (pixels);
8893
8894 img->width = width;
8895 img->height = height;
8896
8897 /* Put the image into the pixmap, then free the X image and its buffer. */
8898 x_put_x_image (f, ximg, img->pixmap, width, height);
8899 x_destroy_x_image (ximg);
8900
8901 /* Same for the mask. */
8902 if (mask_img)
8903 {
8904 x_put_x_image (f, mask_img, img->mask, img->width, img->height);
8905 x_destroy_x_image (mask_img);
8906 }
8907
333b20bb
GM
8908 UNGCPRO;
8909 return 1;
8910}
8911
8912#endif /* HAVE_PNG != 0 */
8913
8914
8915\f
8916/***********************************************************************
8917 JPEG
8918 ***********************************************************************/
8919
8920#if HAVE_JPEG
8921
ba06aba4
GM
8922/* Work around a warning about HAVE_STDLIB_H being redefined in
8923 jconfig.h. */
8924#ifdef HAVE_STDLIB_H
8925#define HAVE_STDLIB_H_1
8926#undef HAVE_STDLIB_H
8927#endif /* HAVE_STLIB_H */
8928
333b20bb
GM
8929#include <jpeglib.h>
8930#include <jerror.h>
8931#include <setjmp.h>
8932
ba06aba4
GM
8933#ifdef HAVE_STLIB_H_1
8934#define HAVE_STDLIB_H 1
8935#endif
8936
333b20bb
GM
8937static int jpeg_image_p P_ ((Lisp_Object object));
8938static int jpeg_load P_ ((struct frame *f, struct image *img));
8939
8940/* The symbol `jpeg' identifying images of this type. */
8941
8942Lisp_Object Qjpeg;
8943
8944/* Indices of image specification fields in gs_format, below. */
8945
8946enum jpeg_keyword_index
8947{
8948 JPEG_TYPE,
8e39770a 8949 JPEG_DATA,
333b20bb
GM
8950 JPEG_FILE,
8951 JPEG_ASCENT,
8952 JPEG_MARGIN,
8953 JPEG_RELIEF,
8954 JPEG_ALGORITHM,
8955 JPEG_HEURISTIC_MASK,
4a8e312c 8956 JPEG_MASK,
333b20bb
GM
8957 JPEG_LAST
8958};
8959
8960/* Vector of image_keyword structures describing the format
8961 of valid user-defined image specifications. */
8962
8963static struct image_keyword jpeg_format[JPEG_LAST] =
8964{
8965 {":type", IMAGE_SYMBOL_VALUE, 1},
5ad6a5fb 8966 {":data", IMAGE_STRING_VALUE, 0},
8e39770a 8967 {":file", IMAGE_STRING_VALUE, 0},
7c7ff7f5 8968 {":ascent", IMAGE_ASCENT_VALUE, 0},
3ed61e75 8969 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
333b20bb 8970 {":relief", IMAGE_INTEGER_VALUE, 0},
d2dc8167 8971 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
4a8e312c
GM
8972 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
8973 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
333b20bb
GM
8974};
8975
8976/* Structure describing the image type `jpeg'. */
8977
8978static struct image_type jpeg_type =
8979{
8980 &Qjpeg,
8981 jpeg_image_p,
8982 jpeg_load,
8983 x_clear_image,
8984 NULL
8985};
8986
8987
8988/* Return non-zero if OBJECT is a valid JPEG image specification. */
8989
8990static int
8991jpeg_image_p (object)
8992 Lisp_Object object;
8993{
8994 struct image_keyword fmt[JPEG_LAST];
8995
8996 bcopy (jpeg_format, fmt, sizeof fmt);
8997
7c7ff7f5 8998 if (!parse_image_spec (object, fmt, JPEG_LAST, Qjpeg))
333b20bb 8999 return 0;
8e39770a 9000
63cec32f
GM
9001 /* Must specify either the :data or :file keyword. */
9002 return fmt[JPEG_FILE].count + fmt[JPEG_DATA].count == 1;
333b20bb
GM
9003}
9004
8e39770a 9005
333b20bb
GM
9006struct my_jpeg_error_mgr
9007{
9008 struct jpeg_error_mgr pub;
9009 jmp_buf setjmp_buffer;
9010};
9011
e3130015 9012
333b20bb
GM
9013static void
9014my_error_exit (cinfo)
9015 j_common_ptr cinfo;
9016{
9017 struct my_jpeg_error_mgr *mgr = (struct my_jpeg_error_mgr *) cinfo->err;
9018 longjmp (mgr->setjmp_buffer, 1);
9019}
9020
e3130015 9021
8e39770a
GM
9022/* Init source method for JPEG data source manager. Called by
9023 jpeg_read_header() before any data is actually read. See
9024 libjpeg.doc from the JPEG lib distribution. */
9025
9026static void
9027our_init_source (cinfo)
9028 j_decompress_ptr cinfo;
9029{
9030}
9031
9032
9033/* Fill input buffer method for JPEG data source manager. Called
9034 whenever more data is needed. We read the whole image in one step,
9035 so this only adds a fake end of input marker at the end. */
9036
9037static boolean
9038our_fill_input_buffer (cinfo)
9039 j_decompress_ptr cinfo;
9040{
9041 /* Insert a fake EOI marker. */
9042 struct jpeg_source_mgr *src = cinfo->src;
9043 static JOCTET buffer[2];
9044
9045 buffer[0] = (JOCTET) 0xFF;
9046 buffer[1] = (JOCTET) JPEG_EOI;
9047
9048 src->next_input_byte = buffer;
9049 src->bytes_in_buffer = 2;
9050 return TRUE;
9051}
9052
9053
9054/* Method to skip over NUM_BYTES bytes in the image data. CINFO->src
9055 is the JPEG data source manager. */
9056
9057static void
9058our_skip_input_data (cinfo, num_bytes)
9059 j_decompress_ptr cinfo;
9060 long num_bytes;
9061{
9062 struct jpeg_source_mgr *src = (struct jpeg_source_mgr *) cinfo->src;
9063
9064 if (src)
9065 {
9066 if (num_bytes > src->bytes_in_buffer)
5ad6a5fb 9067 ERREXIT (cinfo, JERR_INPUT_EOF);
8e39770a
GM
9068
9069 src->bytes_in_buffer -= num_bytes;
9070 src->next_input_byte += num_bytes;
9071 }
9072}
9073
9074
9075/* Method to terminate data source. Called by
9076 jpeg_finish_decompress() after all data has been processed. */
9077
9078static void
9079our_term_source (cinfo)
9080 j_decompress_ptr cinfo;
9081{
9082}
9083
9084
9085/* Set up the JPEG lib for reading an image from DATA which contains
9086 LEN bytes. CINFO is the decompression info structure created for
9087 reading the image. */
9088
9089static void
9090jpeg_memory_src (cinfo, data, len)
9091 j_decompress_ptr cinfo;
9092 JOCTET *data;
9093 unsigned int len;
9094{
9095 struct jpeg_source_mgr *src;
9096
9097 if (cinfo->src == NULL)
9098 {
9099 /* First time for this JPEG object? */
9100 cinfo->src = (struct jpeg_source_mgr *)
9101 (*cinfo->mem->alloc_small) ((j_common_ptr) cinfo, JPOOL_PERMANENT,
9102 sizeof (struct jpeg_source_mgr));
9103 src = (struct jpeg_source_mgr *) cinfo->src;
9104 src->next_input_byte = data;
9105 }
9106
9107 src = (struct jpeg_source_mgr *) cinfo->src;
9108 src->init_source = our_init_source;
9109 src->fill_input_buffer = our_fill_input_buffer;
9110 src->skip_input_data = our_skip_input_data;
9111 src->resync_to_restart = jpeg_resync_to_restart; /* Use default method. */
9112 src->term_source = our_term_source;
9113 src->bytes_in_buffer = len;
9114 src->next_input_byte = data;
9115}
9116
5ad6a5fb 9117
333b20bb
GM
9118/* Load image IMG for use on frame F. Patterned after example.c
9119 from the JPEG lib. */
9120
9121static int
9122jpeg_load (f, img)
9123 struct frame *f;
9124 struct image *img;
9125{
9126 struct jpeg_decompress_struct cinfo;
9127 struct my_jpeg_error_mgr mgr;
9128 Lisp_Object file, specified_file;
8e39770a 9129 Lisp_Object specified_data;
8ec8a5ec 9130 FILE * volatile fp = NULL;
333b20bb
GM
9131 JSAMPARRAY buffer;
9132 int row_stride, x, y;
9133 XImage *ximg = NULL;
b6d7acec 9134 int rc;
333b20bb
GM
9135 unsigned long *colors;
9136 int width, height;
9137 struct gcpro gcpro1;
9138
9139 /* Open the JPEG file. */
9140 specified_file = image_spec_value (img->spec, QCfile, NULL);
8e39770a 9141 specified_data = image_spec_value (img->spec, QCdata, NULL);
5ad6a5fb
GM
9142 file = Qnil;
9143 GCPRO1 (file);
8e39770a 9144
8e39770a 9145 if (NILP (specified_data))
333b20bb 9146 {
8e39770a 9147 file = x_find_image_file (specified_file);
8e39770a
GM
9148 if (!STRINGP (file))
9149 {
45158a91 9150 image_error ("Cannot find image file `%s'", specified_file, Qnil);
8e39770a
GM
9151 UNGCPRO;
9152 return 0;
9153 }
333b20bb 9154
8e39770a
GM
9155 fp = fopen (XSTRING (file)->data, "r");
9156 if (fp == NULL)
9157 {
9158 image_error ("Cannot open `%s'", file, Qnil);
9159 UNGCPRO;
9160 return 0;
9161 }
333b20bb
GM
9162 }
9163
5ad6a5fb
GM
9164 /* Customize libjpeg's error handling to call my_error_exit when an
9165 error is detected. This function will perform a longjmp. */
333b20bb 9166 cinfo.err = jpeg_std_error (&mgr.pub);
14358466 9167 mgr.pub.error_exit = my_error_exit;
333b20bb
GM
9168
9169 if ((rc = setjmp (mgr.setjmp_buffer)) != 0)
9170 {
5ad6a5fb
GM
9171 if (rc == 1)
9172 {
9173 /* Called from my_error_exit. Display a JPEG error. */
9174 char buffer[JMSG_LENGTH_MAX];
9175 cinfo.err->format_message ((j_common_ptr) &cinfo, buffer);
45158a91 9176 image_error ("Error reading JPEG image `%s': %s", img->spec,
5ad6a5fb
GM
9177 build_string (buffer));
9178 }
333b20bb
GM
9179
9180 /* Close the input file and destroy the JPEG object. */
5ad6a5fb 9181 if (fp)
8ec8a5ec 9182 fclose ((FILE *) fp);
333b20bb
GM
9183 jpeg_destroy_decompress (&cinfo);
9184
5ad6a5fb
GM
9185 /* If we already have an XImage, free that. */
9186 x_destroy_x_image (ximg);
333b20bb 9187
5ad6a5fb
GM
9188 /* Free pixmap and colors. */
9189 x_clear_image (f, img);
333b20bb 9190
5ad6a5fb
GM
9191 UNGCPRO;
9192 return 0;
333b20bb
GM
9193 }
9194
9195 /* Create the JPEG decompression object. Let it read from fp.
63448a4d 9196 Read the JPEG image header. */
333b20bb 9197 jpeg_create_decompress (&cinfo);
8e39770a
GM
9198
9199 if (NILP (specified_data))
8ec8a5ec 9200 jpeg_stdio_src (&cinfo, (FILE *) fp);
8e39770a
GM
9201 else
9202 jpeg_memory_src (&cinfo, XSTRING (specified_data)->data,
9203 STRING_BYTES (XSTRING (specified_data)));
63448a4d 9204
333b20bb
GM
9205 jpeg_read_header (&cinfo, TRUE);
9206
9207 /* Customize decompression so that color quantization will be used.
63448a4d 9208 Start decompression. */
333b20bb
GM
9209 cinfo.quantize_colors = TRUE;
9210 jpeg_start_decompress (&cinfo);
9211 width = img->width = cinfo.output_width;
9212 height = img->height = cinfo.output_height;
9213
333b20bb 9214 /* Create X image and pixmap. */
45158a91 9215 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg, &img->pixmap))
28c7826c 9216 longjmp (mgr.setjmp_buffer, 2);
333b20bb
GM
9217
9218 /* Allocate colors. When color quantization is used,
5ad6a5fb
GM
9219 cinfo.actual_number_of_colors has been set with the number of
9220 colors generated, and cinfo.colormap is a two-dimensional array
9221 of color indices in the range 0..cinfo.actual_number_of_colors.
9222 No more than 255 colors will be generated. */
333b20bb 9223 {
5ad6a5fb
GM
9224 int i, ir, ig, ib;
9225
9226 if (cinfo.out_color_components > 2)
9227 ir = 0, ig = 1, ib = 2;
9228 else if (cinfo.out_color_components > 1)
9229 ir = 0, ig = 1, ib = 0;
9230 else
9231 ir = 0, ig = 0, ib = 0;
9232
9233 /* Use the color table mechanism because it handles colors that
9234 cannot be allocated nicely. Such colors will be replaced with
9235 a default color, and we don't have to care about which colors
9236 can be freed safely, and which can't. */
9237 init_color_table ();
9238 colors = (unsigned long *) alloca (cinfo.actual_number_of_colors
9239 * sizeof *colors);
333b20bb 9240
5ad6a5fb
GM
9241 for (i = 0; i < cinfo.actual_number_of_colors; ++i)
9242 {
9243 /* Multiply RGB values with 255 because X expects RGB values
9244 in the range 0..0xffff. */
9245 int r = cinfo.colormap[ir][i] << 8;
9246 int g = cinfo.colormap[ig][i] << 8;
9247 int b = cinfo.colormap[ib][i] << 8;
9248 colors[i] = lookup_rgb_color (f, r, g, b);
9249 }
333b20bb 9250
5ad6a5fb
GM
9251 /* Remember those colors actually allocated. */
9252 img->colors = colors_in_color_table (&img->ncolors);
9253 free_color_table ();
333b20bb
GM
9254 }
9255
9256 /* Read pixels. */
9257 row_stride = width * cinfo.output_components;
9258 buffer = cinfo.mem->alloc_sarray ((j_common_ptr) &cinfo, JPOOL_IMAGE,
5ad6a5fb 9259 row_stride, 1);
333b20bb
GM
9260 for (y = 0; y < height; ++y)
9261 {
5ad6a5fb
GM
9262 jpeg_read_scanlines (&cinfo, buffer, 1);
9263 for (x = 0; x < cinfo.output_width; ++x)
9264 XPutPixel (ximg, x, y, colors[buffer[0][x]]);
333b20bb
GM
9265 }
9266
9267 /* Clean up. */
9268 jpeg_finish_decompress (&cinfo);
9269 jpeg_destroy_decompress (&cinfo);
5ad6a5fb 9270 if (fp)
8ec8a5ec 9271 fclose ((FILE *) fp);
333b20bb
GM
9272
9273 /* Put the image into the pixmap. */
9274 x_put_x_image (f, ximg, img->pixmap, width, height);
9275 x_destroy_x_image (ximg);
333b20bb
GM
9276 UNGCPRO;
9277 return 1;
9278}
9279
9280#endif /* HAVE_JPEG */
9281
9282
9283\f
9284/***********************************************************************
9285 TIFF
9286 ***********************************************************************/
9287
9288#if HAVE_TIFF
9289
cf4790ad 9290#include <tiffio.h>
333b20bb
GM
9291
9292static int tiff_image_p P_ ((Lisp_Object object));
9293static int tiff_load P_ ((struct frame *f, struct image *img));
9294
9295/* The symbol `tiff' identifying images of this type. */
9296
9297Lisp_Object Qtiff;
9298
9299/* Indices of image specification fields in tiff_format, below. */
9300
9301enum tiff_keyword_index
9302{
9303 TIFF_TYPE,
63448a4d 9304 TIFF_DATA,
333b20bb
GM
9305 TIFF_FILE,
9306 TIFF_ASCENT,
9307 TIFF_MARGIN,
9308 TIFF_RELIEF,
9309 TIFF_ALGORITHM,
9310 TIFF_HEURISTIC_MASK,
4a8e312c 9311 TIFF_MASK,
333b20bb
GM
9312 TIFF_LAST
9313};
9314
9315/* Vector of image_keyword structures describing the format
9316 of valid user-defined image specifications. */
9317
9318static struct image_keyword tiff_format[TIFF_LAST] =
9319{
9320 {":type", IMAGE_SYMBOL_VALUE, 1},
5ad6a5fb 9321 {":data", IMAGE_STRING_VALUE, 0},
63448a4d 9322 {":file", IMAGE_STRING_VALUE, 0},
7c7ff7f5 9323 {":ascent", IMAGE_ASCENT_VALUE, 0},
3ed61e75 9324 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
333b20bb 9325 {":relief", IMAGE_INTEGER_VALUE, 0},
d2dc8167 9326 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
4a8e312c
GM
9327 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
9328 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
333b20bb
GM
9329};
9330
9331/* Structure describing the image type `tiff'. */
9332
9333static struct image_type tiff_type =
9334{
9335 &Qtiff,
9336 tiff_image_p,
9337 tiff_load,
9338 x_clear_image,
9339 NULL
9340};
9341
9342
9343/* Return non-zero if OBJECT is a valid TIFF image specification. */
9344
9345static int
9346tiff_image_p (object)
9347 Lisp_Object object;
9348{
9349 struct image_keyword fmt[TIFF_LAST];
9350 bcopy (tiff_format, fmt, sizeof fmt);
9351
7c7ff7f5 9352 if (!parse_image_spec (object, fmt, TIFF_LAST, Qtiff))
333b20bb 9353 return 0;
5ad6a5fb 9354
63cec32f
GM
9355 /* Must specify either the :data or :file keyword. */
9356 return fmt[TIFF_FILE].count + fmt[TIFF_DATA].count == 1;
333b20bb
GM
9357}
9358
5ad6a5fb
GM
9359
9360/* Reading from a memory buffer for TIFF images Based on the PNG
9361 memory source, but we have to provide a lot of extra functions.
9362 Blah.
63448a4d
WP
9363
9364 We really only need to implement read and seek, but I am not
9365 convinced that the TIFF library is smart enough not to destroy
9366 itself if we only hand it the function pointers we need to
5ad6a5fb
GM
9367 override. */
9368
9369typedef struct
9370{
63448a4d
WP
9371 unsigned char *bytes;
9372 size_t len;
9373 int index;
5ad6a5fb
GM
9374}
9375tiff_memory_source;
63448a4d 9376
e3130015 9377
5ad6a5fb
GM
9378static size_t
9379tiff_read_from_memory (data, buf, size)
9380 thandle_t data;
9381 tdata_t buf;
9382 tsize_t size;
63448a4d 9383{
5ad6a5fb 9384 tiff_memory_source *src = (tiff_memory_source *) data;
63448a4d
WP
9385
9386 if (size > src->len - src->index)
5ad6a5fb
GM
9387 return (size_t) -1;
9388 bcopy (src->bytes + src->index, buf, size);
63448a4d
WP
9389 src->index += size;
9390 return size;
9391}
9392
e3130015 9393
5ad6a5fb
GM
9394static size_t
9395tiff_write_from_memory (data, buf, size)
9396 thandle_t data;
9397 tdata_t buf;
9398 tsize_t size;
63448a4d
WP
9399{
9400 return (size_t) -1;
9401}
9402
e3130015 9403
5ad6a5fb
GM
9404static toff_t
9405tiff_seek_in_memory (data, off, whence)
9406 thandle_t data;
9407 toff_t off;
9408 int whence;
63448a4d 9409{
5ad6a5fb 9410 tiff_memory_source *src = (tiff_memory_source *) data;
63448a4d
WP
9411 int idx;
9412
9413 switch (whence)
5ad6a5fb
GM
9414 {
9415 case SEEK_SET: /* Go from beginning of source. */
9416 idx = off;
9417 break;
9418
9419 case SEEK_END: /* Go from end of source. */
9420 idx = src->len + off;
9421 break;
9422
9423 case SEEK_CUR: /* Go from current position. */
9424 idx = src->index + off;
9425 break;
9426
9427 default: /* Invalid `whence'. */
9428 return -1;
9429 }
9430
9431 if (idx > src->len || idx < 0)
9432 return -1;
9433
63448a4d
WP
9434 src->index = idx;
9435 return src->index;
9436}
9437
e3130015 9438
5ad6a5fb
GM
9439static int
9440tiff_close_memory (data)
9441 thandle_t data;
63448a4d
WP
9442{
9443 /* NOOP */
5ad6a5fb 9444 return 0;
63448a4d
WP
9445}
9446
e3130015 9447
5ad6a5fb
GM
9448static int
9449tiff_mmap_memory (data, pbase, psize)
9450 thandle_t data;
9451 tdata_t *pbase;
9452 toff_t *psize;
63448a4d
WP
9453{
9454 /* It is already _IN_ memory. */
5ad6a5fb 9455 return 0;
63448a4d
WP
9456}
9457
e3130015 9458
5ad6a5fb
GM
9459static void
9460tiff_unmap_memory (data, base, size)
9461 thandle_t data;
9462 tdata_t base;
9463 toff_t size;
63448a4d
WP
9464{
9465 /* We don't need to do this. */
63448a4d
WP
9466}
9467
e3130015 9468
5ad6a5fb
GM
9469static toff_t
9470tiff_size_of_memory (data)
9471 thandle_t data;
63448a4d 9472{
5ad6a5fb 9473 return ((tiff_memory_source *) data)->len;
63448a4d 9474}
333b20bb 9475
e3130015 9476
333b20bb
GM
9477/* Load TIFF image IMG for use on frame F. Value is non-zero if
9478 successful. */
9479
9480static int
9481tiff_load (f, img)
9482 struct frame *f;
9483 struct image *img;
9484{
9485 Lisp_Object file, specified_file;
63448a4d 9486 Lisp_Object specified_data;
333b20bb
GM
9487 TIFF *tiff;
9488 int width, height, x, y;
9489 uint32 *buf;
9490 int rc;
9491 XImage *ximg;
9492 struct gcpro gcpro1;
63448a4d 9493 tiff_memory_source memsrc;
333b20bb
GM
9494
9495 specified_file = image_spec_value (img->spec, QCfile, NULL);
63448a4d 9496 specified_data = image_spec_value (img->spec, QCdata, NULL);
5ad6a5fb
GM
9497 file = Qnil;
9498 GCPRO1 (file);
63448a4d
WP
9499
9500 if (NILP (specified_data))
5ad6a5fb
GM
9501 {
9502 /* Read from a file */
9503 file = x_find_image_file (specified_file);
9504 if (!STRINGP (file))
63448a4d 9505 {
45158a91 9506 image_error ("Cannot find image file `%s'", file, Qnil);
5ad6a5fb
GM
9507 UNGCPRO;
9508 return 0;
9509 }
63448a4d 9510
5ad6a5fb
GM
9511 /* Try to open the image file. */
9512 tiff = TIFFOpen (XSTRING (file)->data, "r");
9513 if (tiff == NULL)
9514 {
9515 image_error ("Cannot open `%s'", file, Qnil);
9516 UNGCPRO;
9517 return 0;
63448a4d 9518 }
5ad6a5fb 9519 }
63448a4d 9520 else
5ad6a5fb
GM
9521 {
9522 /* Memory source! */
9523 memsrc.bytes = XSTRING (specified_data)->data;
9524 memsrc.len = STRING_BYTES (XSTRING (specified_data));
9525 memsrc.index = 0;
9526
9527 tiff = TIFFClientOpen ("memory_source", "r", &memsrc,
9528 (TIFFReadWriteProc) tiff_read_from_memory,
9529 (TIFFReadWriteProc) tiff_write_from_memory,
9530 tiff_seek_in_memory,
9531 tiff_close_memory,
9532 tiff_size_of_memory,
9533 tiff_mmap_memory,
9534 tiff_unmap_memory);
9535
9536 if (!tiff)
63448a4d 9537 {
45158a91 9538 image_error ("Cannot open memory source for `%s'", img->spec, Qnil);
5ad6a5fb
GM
9539 UNGCPRO;
9540 return 0;
63448a4d 9541 }
5ad6a5fb 9542 }
333b20bb
GM
9543
9544 /* Get width and height of the image, and allocate a raster buffer
9545 of width x height 32-bit values. */
9546 TIFFGetField (tiff, TIFFTAG_IMAGEWIDTH, &width);
9547 TIFFGetField (tiff, TIFFTAG_IMAGELENGTH, &height);
9548 buf = (uint32 *) xmalloc (width * height * sizeof *buf);
9549
9550 rc = TIFFReadRGBAImage (tiff, width, height, buf, 0);
9551 TIFFClose (tiff);
9552 if (!rc)
9553 {
45158a91 9554 image_error ("Error reading TIFF image `%s'", img->spec, Qnil);
333b20bb
GM
9555 xfree (buf);
9556 UNGCPRO;
9557 return 0;
9558 }
9559
333b20bb 9560 /* Create the X image and pixmap. */
45158a91 9561 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg, &img->pixmap))
333b20bb 9562 {
333b20bb
GM
9563 xfree (buf);
9564 UNGCPRO;
9565 return 0;
9566 }
9567
9568 /* Initialize the color table. */
9569 init_color_table ();
9570
9571 /* Process the pixel raster. Origin is in the lower-left corner. */
9572 for (y = 0; y < height; ++y)
9573 {
9574 uint32 *row = buf + y * width;
9575
9576 for (x = 0; x < width; ++x)
9577 {
9578 uint32 abgr = row[x];
9579 int r = TIFFGetR (abgr) << 8;
9580 int g = TIFFGetG (abgr) << 8;
9581 int b = TIFFGetB (abgr) << 8;
9582 XPutPixel (ximg, x, height - 1 - y, lookup_rgb_color (f, r, g, b));
9583 }
9584 }
9585
9586 /* Remember the colors allocated for the image. Free the color table. */
9587 img->colors = colors_in_color_table (&img->ncolors);
9588 free_color_table ();
9589
9590 /* Put the image into the pixmap, then free the X image and its buffer. */
9591 x_put_x_image (f, ximg, img->pixmap, width, height);
9592 x_destroy_x_image (ximg);
9593 xfree (buf);
333b20bb
GM
9594
9595 img->width = width;
9596 img->height = height;
9597
9598 UNGCPRO;
9599 return 1;
9600}
9601
9602#endif /* HAVE_TIFF != 0 */
9603
9604
9605\f
9606/***********************************************************************
9607 GIF
9608 ***********************************************************************/
9609
9610#if HAVE_GIF
9611
9612#include <gif_lib.h>
9613
9614static int gif_image_p P_ ((Lisp_Object object));
9615static int gif_load P_ ((struct frame *f, struct image *img));
9616
9617/* The symbol `gif' identifying images of this type. */
9618
9619Lisp_Object Qgif;
9620
9621/* Indices of image specification fields in gif_format, below. */
9622
9623enum gif_keyword_index
9624{
9625 GIF_TYPE,
63448a4d 9626 GIF_DATA,
333b20bb
GM
9627 GIF_FILE,
9628 GIF_ASCENT,
9629 GIF_MARGIN,
9630 GIF_RELIEF,
9631 GIF_ALGORITHM,
9632 GIF_HEURISTIC_MASK,
4a8e312c 9633 GIF_MASK,
333b20bb
GM
9634 GIF_IMAGE,
9635 GIF_LAST
9636};
9637
9638/* Vector of image_keyword structures describing the format
9639 of valid user-defined image specifications. */
9640
9641static struct image_keyword gif_format[GIF_LAST] =
9642{
9643 {":type", IMAGE_SYMBOL_VALUE, 1},
5ad6a5fb 9644 {":data", IMAGE_STRING_VALUE, 0},
63448a4d 9645 {":file", IMAGE_STRING_VALUE, 0},
7c7ff7f5 9646 {":ascent", IMAGE_ASCENT_VALUE, 0},
3ed61e75 9647 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
333b20bb 9648 {":relief", IMAGE_INTEGER_VALUE, 0},
d2dc8167 9649 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
333b20bb 9650 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
4a8e312c 9651 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
333b20bb
GM
9652 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0}
9653};
9654
9655/* Structure describing the image type `gif'. */
9656
9657static struct image_type gif_type =
9658{
9659 &Qgif,
9660 gif_image_p,
9661 gif_load,
9662 x_clear_image,
9663 NULL
9664};
9665
e3130015 9666
333b20bb
GM
9667/* Return non-zero if OBJECT is a valid GIF image specification. */
9668
9669static int
9670gif_image_p (object)
9671 Lisp_Object object;
9672{
9673 struct image_keyword fmt[GIF_LAST];
9674 bcopy (gif_format, fmt, sizeof fmt);
9675
7c7ff7f5 9676 if (!parse_image_spec (object, fmt, GIF_LAST, Qgif))
333b20bb 9677 return 0;
5ad6a5fb 9678
63cec32f
GM
9679 /* Must specify either the :data or :file keyword. */
9680 return fmt[GIF_FILE].count + fmt[GIF_DATA].count == 1;
333b20bb
GM
9681}
9682
e3130015 9683
63448a4d
WP
9684/* Reading a GIF image from memory
9685 Based on the PNG memory stuff to a certain extent. */
9686
5ad6a5fb
GM
9687typedef struct
9688{
63448a4d
WP
9689 unsigned char *bytes;
9690 size_t len;
9691 int index;
5ad6a5fb
GM
9692}
9693gif_memory_source;
63448a4d 9694
e3130015 9695
f036834a
GM
9696/* Make the current memory source available to gif_read_from_memory.
9697 It's done this way because not all versions of libungif support
9698 a UserData field in the GifFileType structure. */
9699static gif_memory_source *current_gif_memory_src;
9700
5ad6a5fb
GM
9701static int
9702gif_read_from_memory (file, buf, len)
9703 GifFileType *file;
9704 GifByteType *buf;
9705 int len;
63448a4d 9706{
f036834a 9707 gif_memory_source *src = current_gif_memory_src;
63448a4d 9708
5ad6a5fb
GM
9709 if (len > src->len - src->index)
9710 return -1;
63448a4d 9711
5ad6a5fb 9712 bcopy (src->bytes + src->index, buf, len);
63448a4d
WP
9713 src->index += len;
9714 return len;
9715}
333b20bb 9716
5ad6a5fb 9717
333b20bb
GM
9718/* Load GIF image IMG for use on frame F. Value is non-zero if
9719 successful. */
9720
9721static int
9722gif_load (f, img)
9723 struct frame *f;
9724 struct image *img;
9725{
9726 Lisp_Object file, specified_file;
63448a4d 9727 Lisp_Object specified_data;
333b20bb
GM
9728 int rc, width, height, x, y, i;
9729 XImage *ximg;
9730 ColorMapObject *gif_color_map;
9731 unsigned long pixel_colors[256];
9732 GifFileType *gif;
9733 struct gcpro gcpro1;
9734 Lisp_Object image;
9735 int ino, image_left, image_top, image_width, image_height;
63448a4d 9736 gif_memory_source memsrc;
9b784e96 9737 unsigned char *raster;
333b20bb
GM
9738
9739 specified_file = image_spec_value (img->spec, QCfile, NULL);
63448a4d 9740 specified_data = image_spec_value (img->spec, QCdata, NULL);
5ad6a5fb
GM
9741 file = Qnil;
9742 GCPRO1 (file);
63448a4d
WP
9743
9744 if (NILP (specified_data))
5ad6a5fb
GM
9745 {
9746 file = x_find_image_file (specified_file);
9747 if (!STRINGP (file))
63448a4d 9748 {
45158a91 9749 image_error ("Cannot find image file `%s'", specified_file, Qnil);
5ad6a5fb
GM
9750 UNGCPRO;
9751 return 0;
9752 }
333b20bb 9753
5ad6a5fb
GM
9754 /* Open the GIF file. */
9755 gif = DGifOpenFileName (XSTRING (file)->data);
9756 if (gif == NULL)
9757 {
9758 image_error ("Cannot open `%s'", file, Qnil);
9759 UNGCPRO;
9760 return 0;
63448a4d 9761 }
5ad6a5fb 9762 }
63448a4d 9763 else
5ad6a5fb
GM
9764 {
9765 /* Read from memory! */
f036834a 9766 current_gif_memory_src = &memsrc;
5ad6a5fb
GM
9767 memsrc.bytes = XSTRING (specified_data)->data;
9768 memsrc.len = STRING_BYTES (XSTRING (specified_data));
9769 memsrc.index = 0;
63448a4d 9770
5ad6a5fb
GM
9771 gif = DGifOpen(&memsrc, gif_read_from_memory);
9772 if (!gif)
9773 {
45158a91 9774 image_error ("Cannot open memory source `%s'", img->spec, Qnil);
5ad6a5fb
GM
9775 UNGCPRO;
9776 return 0;
63448a4d 9777 }
5ad6a5fb 9778 }
333b20bb
GM
9779
9780 /* Read entire contents. */
9781 rc = DGifSlurp (gif);
9782 if (rc == GIF_ERROR)
9783 {
45158a91 9784 image_error ("Error reading `%s'", img->spec, Qnil);
333b20bb
GM
9785 DGifCloseFile (gif);
9786 UNGCPRO;
9787 return 0;
9788 }
9789
3ccff1e3 9790 image = image_spec_value (img->spec, QCindex, NULL);
333b20bb
GM
9791 ino = INTEGERP (image) ? XFASTINT (image) : 0;
9792 if (ino >= gif->ImageCount)
9793 {
45158a91
GM
9794 image_error ("Invalid image number `%s' in image `%s'",
9795 image, img->spec);
333b20bb
GM
9796 DGifCloseFile (gif);
9797 UNGCPRO;
9798 return 0;
9799 }
9800
9801 width = img->width = gif->SWidth;
9802 height = img->height = gif->SHeight;
9803
333b20bb 9804 /* Create the X image and pixmap. */
45158a91 9805 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg, &img->pixmap))
333b20bb 9806 {
333b20bb
GM
9807 DGifCloseFile (gif);
9808 UNGCPRO;
9809 return 0;
9810 }
9811
9812 /* Allocate colors. */
9813 gif_color_map = gif->SavedImages[ino].ImageDesc.ColorMap;
9814 if (!gif_color_map)
9815 gif_color_map = gif->SColorMap;
9816 init_color_table ();
9817 bzero (pixel_colors, sizeof pixel_colors);
9818
9819 for (i = 0; i < gif_color_map->ColorCount; ++i)
9820 {
9821 int r = gif_color_map->Colors[i].Red << 8;
9822 int g = gif_color_map->Colors[i].Green << 8;
9823 int b = gif_color_map->Colors[i].Blue << 8;
9824 pixel_colors[i] = lookup_rgb_color (f, r, g, b);
9825 }
9826
9827 img->colors = colors_in_color_table (&img->ncolors);
9828 free_color_table ();
9829
9830 /* Clear the part of the screen image that are not covered by
9831 the image from the GIF file. Full animated GIF support
9832 requires more than can be done here (see the gif89 spec,
9833 disposal methods). Let's simply assume that the part
9834 not covered by a sub-image is in the frame's background color. */
9835 image_top = gif->SavedImages[ino].ImageDesc.Top;
9836 image_left = gif->SavedImages[ino].ImageDesc.Left;
9837 image_width = gif->SavedImages[ino].ImageDesc.Width;
9838 image_height = gif->SavedImages[ino].ImageDesc.Height;
9839
9840 for (y = 0; y < image_top; ++y)
9841 for (x = 0; x < width; ++x)
9842 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
9843
9844 for (y = image_top + image_height; y < height; ++y)
9845 for (x = 0; x < width; ++x)
9846 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
9847
9848 for (y = image_top; y < image_top + image_height; ++y)
9849 {
9850 for (x = 0; x < image_left; ++x)
9851 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
9852 for (x = image_left + image_width; x < width; ++x)
9853 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
9854 }
9855
9b784e96
GM
9856 /* Read the GIF image into the X image. We use a local variable
9857 `raster' here because RasterBits below is a char *, and invites
9858 problems with bytes >= 0x80. */
9859 raster = (unsigned char *) gif->SavedImages[ino].RasterBits;
9860
333b20bb
GM
9861 if (gif->SavedImages[ino].ImageDesc.Interlace)
9862 {
9863 static int interlace_start[] = {0, 4, 2, 1};
9864 static int interlace_increment[] = {8, 8, 4, 2};
9b207e8e 9865 int pass;
06482119
GM
9866 int row = interlace_start[0];
9867
9868 pass = 0;
333b20bb 9869
06482119 9870 for (y = 0; y < image_height; y++)
333b20bb 9871 {
06482119
GM
9872 if (row >= image_height)
9873 {
9874 row = interlace_start[++pass];
9875 while (row >= image_height)
9876 row = interlace_start[++pass];
9877 }
9878
9879 for (x = 0; x < image_width; x++)
9880 {
9b784e96 9881 int i = raster[(y * image_width) + x];
06482119
GM
9882 XPutPixel (ximg, x + image_left, row + image_top,
9883 pixel_colors[i]);
9884 }
9885
9886 row += interlace_increment[pass];
333b20bb
GM
9887 }
9888 }
9889 else
9890 {
9891 for (y = 0; y < image_height; ++y)
9892 for (x = 0; x < image_width; ++x)
9893 {
9b784e96 9894 int i = raster[y * image_width + x];
333b20bb
GM
9895 XPutPixel (ximg, x + image_left, y + image_top, pixel_colors[i]);
9896 }
9897 }
9898
9899 DGifCloseFile (gif);
9900
9901 /* Put the image into the pixmap, then free the X image and its buffer. */
9902 x_put_x_image (f, ximg, img->pixmap, width, height);
9903 x_destroy_x_image (ximg);
333b20bb
GM
9904
9905 UNGCPRO;
9906 return 1;
9907}
9908
9909#endif /* HAVE_GIF != 0 */
9910
9911
9912\f
9913/***********************************************************************
9914 Ghostscript
9915 ***********************************************************************/
9916
9917static int gs_image_p P_ ((Lisp_Object object));
9918static int gs_load P_ ((struct frame *f, struct image *img));
9919static void gs_clear_image P_ ((struct frame *f, struct image *img));
9920
fcf431dc 9921/* The symbol `postscript' identifying images of this type. */
333b20bb 9922
fcf431dc 9923Lisp_Object Qpostscript;
333b20bb
GM
9924
9925/* Keyword symbols. */
9926
9927Lisp_Object QCloader, QCbounding_box, QCpt_width, QCpt_height;
9928
9929/* Indices of image specification fields in gs_format, below. */
9930
9931enum gs_keyword_index
9932{
9933 GS_TYPE,
9934 GS_PT_WIDTH,
9935 GS_PT_HEIGHT,
9936 GS_FILE,
9937 GS_LOADER,
9938 GS_BOUNDING_BOX,
9939 GS_ASCENT,
9940 GS_MARGIN,
9941 GS_RELIEF,
9942 GS_ALGORITHM,
9943 GS_HEURISTIC_MASK,
4a8e312c 9944 GS_MASK,
333b20bb
GM
9945 GS_LAST
9946};
9947
9948/* Vector of image_keyword structures describing the format
9949 of valid user-defined image specifications. */
9950
9951static struct image_keyword gs_format[GS_LAST] =
9952{
9953 {":type", IMAGE_SYMBOL_VALUE, 1},
9954 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE, 1},
9955 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE, 1},
9956 {":file", IMAGE_STRING_VALUE, 1},
9957 {":loader", IMAGE_FUNCTION_VALUE, 0},
9958 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE, 1},
7c7ff7f5 9959 {":ascent", IMAGE_ASCENT_VALUE, 0},
3ed61e75 9960 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
333b20bb 9961 {":relief", IMAGE_INTEGER_VALUE, 0},
d2dc8167 9962 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
4a8e312c
GM
9963 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
9964 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
333b20bb
GM
9965};
9966
9967/* Structure describing the image type `ghostscript'. */
9968
9969static struct image_type gs_type =
9970{
fcf431dc 9971 &Qpostscript,
333b20bb
GM
9972 gs_image_p,
9973 gs_load,
9974 gs_clear_image,
9975 NULL
9976};
9977
9978
9979/* Free X resources of Ghostscript image IMG which is used on frame F. */
9980
9981static void
9982gs_clear_image (f, img)
9983 struct frame *f;
9984 struct image *img;
9985{
9986 /* IMG->data.ptr_val may contain a recorded colormap. */
9987 xfree (img->data.ptr_val);
9988 x_clear_image (f, img);
9989}
9990
9991
9992/* Return non-zero if OBJECT is a valid Ghostscript image
9993 specification. */
9994
9995static int
9996gs_image_p (object)
9997 Lisp_Object object;
9998{
9999 struct image_keyword fmt[GS_LAST];
10000 Lisp_Object tem;
10001 int i;
10002
10003 bcopy (gs_format, fmt, sizeof fmt);
10004
7c7ff7f5 10005 if (!parse_image_spec (object, fmt, GS_LAST, Qpostscript))
333b20bb
GM
10006 return 0;
10007
10008 /* Bounding box must be a list or vector containing 4 integers. */
10009 tem = fmt[GS_BOUNDING_BOX].value;
10010 if (CONSP (tem))
10011 {
10012 for (i = 0; i < 4; ++i, tem = XCDR (tem))
10013 if (!CONSP (tem) || !INTEGERP (XCAR (tem)))
10014 return 0;
10015 if (!NILP (tem))
10016 return 0;
10017 }
10018 else if (VECTORP (tem))
10019 {
10020 if (XVECTOR (tem)->size != 4)
10021 return 0;
10022 for (i = 0; i < 4; ++i)
10023 if (!INTEGERP (XVECTOR (tem)->contents[i]))
10024 return 0;
10025 }
10026 else
10027 return 0;
10028
10029 return 1;
10030}
10031
10032
10033/* Load Ghostscript image IMG for use on frame F. Value is non-zero
10034 if successful. */
10035
10036static int
10037gs_load (f, img)
10038 struct frame *f;
10039 struct image *img;
10040{
10041 char buffer[100];
10042 Lisp_Object window_and_pixmap_id = Qnil, loader, pt_height, pt_width;
10043 struct gcpro gcpro1, gcpro2;
10044 Lisp_Object frame;
10045 double in_width, in_height;
10046 Lisp_Object pixel_colors = Qnil;
10047
10048 /* Compute pixel size of pixmap needed from the given size in the
10049 image specification. Sizes in the specification are in pt. 1 pt
10050 = 1/72 in, xdpi and ydpi are stored in the frame's X display
10051 info. */
10052 pt_width = image_spec_value (img->spec, QCpt_width, NULL);
10053 in_width = XFASTINT (pt_width) / 72.0;
10054 img->width = in_width * FRAME_X_DISPLAY_INFO (f)->resx;
10055 pt_height = image_spec_value (img->spec, QCpt_height, NULL);
10056 in_height = XFASTINT (pt_height) / 72.0;
10057 img->height = in_height * FRAME_X_DISPLAY_INFO (f)->resy;
10058
10059 /* Create the pixmap. */
dd00328a 10060 xassert (img->pixmap == None);
333b20bb
GM
10061 img->pixmap = XCreatePixmap (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
10062 img->width, img->height,
10063 DefaultDepthOfScreen (FRAME_X_SCREEN (f)));
333b20bb
GM
10064
10065 if (!img->pixmap)
10066 {
45158a91 10067 image_error ("Unable to create pixmap for `%s'", img->spec, Qnil);
333b20bb
GM
10068 return 0;
10069 }
10070
10071 /* Call the loader to fill the pixmap. It returns a process object
10072 if successful. We do not record_unwind_protect here because
10073 other places in redisplay like calling window scroll functions
10074 don't either. Let the Lisp loader use `unwind-protect' instead. */
10075 GCPRO2 (window_and_pixmap_id, pixel_colors);
10076
10077 sprintf (buffer, "%lu %lu",
10078 (unsigned long) FRAME_X_WINDOW (f),
10079 (unsigned long) img->pixmap);
10080 window_and_pixmap_id = build_string (buffer);
10081
10082 sprintf (buffer, "%lu %lu",
10083 FRAME_FOREGROUND_PIXEL (f),
10084 FRAME_BACKGROUND_PIXEL (f));
10085 pixel_colors = build_string (buffer);
10086
10087 XSETFRAME (frame, f);
10088 loader = image_spec_value (img->spec, QCloader, NULL);
10089 if (NILP (loader))
10090 loader = intern ("gs-load-image");
10091
10092 img->data.lisp_val = call6 (loader, frame, img->spec,
10093 make_number (img->width),
10094 make_number (img->height),
10095 window_and_pixmap_id,
10096 pixel_colors);
10097 UNGCPRO;
10098 return PROCESSP (img->data.lisp_val);
10099}
10100
10101
10102/* Kill the Ghostscript process that was started to fill PIXMAP on
10103 frame F. Called from XTread_socket when receiving an event
10104 telling Emacs that Ghostscript has finished drawing. */
10105
10106void
10107x_kill_gs_process (pixmap, f)
10108 Pixmap pixmap;
10109 struct frame *f;
10110{
10111 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
10112 int class, i;
10113 struct image *img;
10114
10115 /* Find the image containing PIXMAP. */
10116 for (i = 0; i < c->used; ++i)
10117 if (c->images[i]->pixmap == pixmap)
10118 break;
10119
daba7643
GM
10120 /* Should someone in between have cleared the image cache, for
10121 instance, give up. */
10122 if (i == c->used)
10123 return;
10124
333b20bb
GM
10125 /* Kill the GS process. We should have found PIXMAP in the image
10126 cache and its image should contain a process object. */
333b20bb
GM
10127 img = c->images[i];
10128 xassert (PROCESSP (img->data.lisp_val));
10129 Fkill_process (img->data.lisp_val, Qnil);
10130 img->data.lisp_val = Qnil;
10131
10132 /* On displays with a mutable colormap, figure out the colors
10133 allocated for the image by looking at the pixels of an XImage for
10134 img->pixmap. */
383d6ffc 10135 class = FRAME_X_VISUAL (f)->class;
333b20bb
GM
10136 if (class != StaticColor && class != StaticGray && class != TrueColor)
10137 {
10138 XImage *ximg;
10139
10140 BLOCK_INPUT;
10141
10142 /* Try to get an XImage for img->pixmep. */
10143 ximg = XGetImage (FRAME_X_DISPLAY (f), img->pixmap,
10144 0, 0, img->width, img->height, ~0, ZPixmap);
10145 if (ximg)
10146 {
10147 int x, y;
10148
10149 /* Initialize the color table. */
10150 init_color_table ();
10151
10152 /* For each pixel of the image, look its color up in the
10153 color table. After having done so, the color table will
10154 contain an entry for each color used by the image. */
10155 for (y = 0; y < img->height; ++y)
10156 for (x = 0; x < img->width; ++x)
10157 {
10158 unsigned long pixel = XGetPixel (ximg, x, y);
10159 lookup_pixel_color (f, pixel);
10160 }
10161
10162 /* Record colors in the image. Free color table and XImage. */
10163 img->colors = colors_in_color_table (&img->ncolors);
10164 free_color_table ();
10165 XDestroyImage (ximg);
10166
10167#if 0 /* This doesn't seem to be the case. If we free the colors
10168 here, we get a BadAccess later in x_clear_image when
10169 freeing the colors. */
10170 /* We have allocated colors once, but Ghostscript has also
10171 allocated colors on behalf of us. So, to get the
10172 reference counts right, free them once. */
10173 if (img->ncolors)
462d5d40 10174 x_free_colors (f, img->colors, img->ncolors);
333b20bb
GM
10175#endif
10176 }
10177 else
10178 image_error ("Cannot get X image of `%s'; colors will not be freed",
45158a91 10179 img->spec, Qnil);
333b20bb
GM
10180
10181 UNBLOCK_INPUT;
10182 }
ad18ffb1
GM
10183
10184 /* Now that we have the pixmap, compute mask and transform the
10185 image if requested. */
10186 BLOCK_INPUT;
10187 postprocess_image (f, img);
10188 UNBLOCK_INPUT;
333b20bb
GM
10189}
10190
10191
10192\f
10193/***********************************************************************
10194 Window properties
10195 ***********************************************************************/
10196
10197DEFUN ("x-change-window-property", Fx_change_window_property,
10198 Sx_change_window_property, 2, 3, 0,
10199 "Change window property PROP to VALUE on the X window of FRAME.\n\
10200PROP and VALUE must be strings. FRAME nil or omitted means use the\n\
10201selected frame. Value is VALUE.")
10202 (prop, value, frame)
10203 Lisp_Object frame, prop, value;
10204{
10205 struct frame *f = check_x_frame (frame);
10206 Atom prop_atom;
10207
10208 CHECK_STRING (prop, 1);
10209 CHECK_STRING (value, 2);
10210
10211 BLOCK_INPUT;
10212 prop_atom = XInternAtom (FRAME_X_DISPLAY (f), XSTRING (prop)->data, False);
10213 XChangeProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
10214 prop_atom, XA_STRING, 8, PropModeReplace,
10215 XSTRING (value)->data, XSTRING (value)->size);
10216
10217 /* Make sure the property is set when we return. */
10218 XFlush (FRAME_X_DISPLAY (f));
10219 UNBLOCK_INPUT;
10220
10221 return value;
10222}
10223
10224
10225DEFUN ("x-delete-window-property", Fx_delete_window_property,
10226 Sx_delete_window_property, 1, 2, 0,
10227 "Remove window property PROP from X window of FRAME.\n\
10228FRAME nil or omitted means use the selected frame. Value is PROP.")
10229 (prop, frame)
10230 Lisp_Object prop, frame;
10231{
10232 struct frame *f = check_x_frame (frame);
10233 Atom prop_atom;
10234
10235 CHECK_STRING (prop, 1);
10236 BLOCK_INPUT;
10237 prop_atom = XInternAtom (FRAME_X_DISPLAY (f), XSTRING (prop)->data, False);
10238 XDeleteProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), prop_atom);
10239
10240 /* Make sure the property is removed when we return. */
10241 XFlush (FRAME_X_DISPLAY (f));
10242 UNBLOCK_INPUT;
10243
10244 return prop;
10245}
10246
10247
10248DEFUN ("x-window-property", Fx_window_property, Sx_window_property,
10249 1, 2, 0,
10250 "Value is the value of window property PROP on FRAME.\n\
10251If FRAME is nil or omitted, use the selected frame. Value is nil\n\
10252if FRAME hasn't a property with name PROP or if PROP has no string\n\
10253value.")
10254 (prop, frame)
10255 Lisp_Object prop, frame;
10256{
10257 struct frame *f = check_x_frame (frame);
10258 Atom prop_atom;
10259 int rc;
10260 Lisp_Object prop_value = Qnil;
10261 char *tmp_data = NULL;
10262 Atom actual_type;
10263 int actual_format;
10264 unsigned long actual_size, bytes_remaining;
10265
10266 CHECK_STRING (prop, 1);
10267 BLOCK_INPUT;
10268 prop_atom = XInternAtom (FRAME_X_DISPLAY (f), XSTRING (prop)->data, False);
10269 rc = XGetWindowProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
10270 prop_atom, 0, 0, False, XA_STRING,
10271 &actual_type, &actual_format, &actual_size,
10272 &bytes_remaining, (unsigned char **) &tmp_data);
10273 if (rc == Success)
10274 {
10275 int size = bytes_remaining;
10276
10277 XFree (tmp_data);
10278 tmp_data = NULL;
10279
10280 rc = XGetWindowProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
10281 prop_atom, 0, bytes_remaining,
10282 False, XA_STRING,
10283 &actual_type, &actual_format,
10284 &actual_size, &bytes_remaining,
10285 (unsigned char **) &tmp_data);
4c8c7926 10286 if (rc == Success && tmp_data)
333b20bb
GM
10287 prop_value = make_string (tmp_data, size);
10288
10289 XFree (tmp_data);
10290 }
10291
10292 UNBLOCK_INPUT;
10293 return prop_value;
10294}
10295
10296
10297\f
10298/***********************************************************************
10299 Busy cursor
10300 ***********************************************************************/
10301
4ae9a85e 10302/* If non-null, an asynchronous timer that, when it expires, displays
0af913d7 10303 an hourglass cursor on all frames. */
333b20bb 10304
0af913d7 10305static struct atimer *hourglass_atimer;
333b20bb 10306
0af913d7 10307/* Non-zero means an hourglass cursor is currently shown. */
333b20bb 10308
0af913d7 10309static int hourglass_shown_p;
333b20bb 10310
0af913d7 10311/* Number of seconds to wait before displaying an hourglass cursor. */
333b20bb 10312
0af913d7 10313static Lisp_Object Vhourglass_delay;
333b20bb 10314
0af913d7 10315/* Default number of seconds to wait before displaying an hourglass
4ae9a85e
GM
10316 cursor. */
10317
0af913d7 10318#define DEFAULT_HOURGLASS_DELAY 1
4ae9a85e
GM
10319
10320/* Function prototypes. */
10321
0af913d7
GM
10322static void show_hourglass P_ ((struct atimer *));
10323static void hide_hourglass P_ ((void));
4ae9a85e
GM
10324
10325
0af913d7 10326/* Cancel a currently active hourglass timer, and start a new one. */
4ae9a85e
GM
10327
10328void
0af913d7 10329start_hourglass ()
333b20bb 10330{
4ae9a85e 10331 EMACS_TIME delay;
3caa99d3 10332 int secs, usecs = 0;
4ae9a85e 10333
0af913d7 10334 cancel_hourglass ();
4ae9a85e 10335
0af913d7
GM
10336 if (INTEGERP (Vhourglass_delay)
10337 && XINT (Vhourglass_delay) > 0)
10338 secs = XFASTINT (Vhourglass_delay);
10339 else if (FLOATP (Vhourglass_delay)
10340 && XFLOAT_DATA (Vhourglass_delay) > 0)
3caa99d3
GM
10341 {
10342 Lisp_Object tem;
0af913d7 10343 tem = Ftruncate (Vhourglass_delay, Qnil);
3caa99d3 10344 secs = XFASTINT (tem);
0af913d7 10345 usecs = (XFLOAT_DATA (Vhourglass_delay) - secs) * 1000000;
3caa99d3 10346 }
4ae9a85e 10347 else
0af913d7 10348 secs = DEFAULT_HOURGLASS_DELAY;
4ae9a85e 10349
3caa99d3 10350 EMACS_SET_SECS_USECS (delay, secs, usecs);
0af913d7
GM
10351 hourglass_atimer = start_atimer (ATIMER_RELATIVE, delay,
10352 show_hourglass, NULL);
4ae9a85e
GM
10353}
10354
10355
0af913d7 10356/* Cancel the hourglass cursor timer if active, hide a busy cursor if
4ae9a85e
GM
10357 shown. */
10358
10359void
0af913d7 10360cancel_hourglass ()
4ae9a85e 10361{
0af913d7 10362 if (hourglass_atimer)
99f01f62 10363 {
0af913d7
GM
10364 cancel_atimer (hourglass_atimer);
10365 hourglass_atimer = NULL;
99f01f62
GM
10366 }
10367
0af913d7
GM
10368 if (hourglass_shown_p)
10369 hide_hourglass ();
4ae9a85e
GM
10370}
10371
10372
0af913d7
GM
10373/* Timer function of hourglass_atimer. TIMER is equal to
10374 hourglass_atimer.
4ae9a85e 10375
0af913d7
GM
10376 Display an hourglass pointer on all frames by mapping the frames'
10377 hourglass_window. Set the hourglass_p flag in the frames'
10378 output_data.x structure to indicate that an hourglass cursor is
10379 shown on the frames. */
4ae9a85e
GM
10380
10381static void
0af913d7 10382show_hourglass (timer)
4ae9a85e
GM
10383 struct atimer *timer;
10384{
10385 /* The timer implementation will cancel this timer automatically
0af913d7 10386 after this function has run. Set hourglass_atimer to null
4ae9a85e 10387 so that we know the timer doesn't have to be canceled. */
0af913d7 10388 hourglass_atimer = NULL;
4ae9a85e 10389
0af913d7 10390 if (!hourglass_shown_p)
333b20bb
GM
10391 {
10392 Lisp_Object rest, frame;
4ae9a85e
GM
10393
10394 BLOCK_INPUT;
10395
333b20bb 10396 FOR_EACH_FRAME (rest, frame)
5f7a1890
GM
10397 {
10398 struct frame *f = XFRAME (frame);
10399
10400 if (FRAME_LIVE_P (f) && FRAME_X_P (f) && FRAME_X_DISPLAY (f))
10401 {
10402 Display *dpy = FRAME_X_DISPLAY (f);
10403
10404#ifdef USE_X_TOOLKIT
10405 if (f->output_data.x->widget)
10406#else
10407 if (FRAME_OUTER_WINDOW (f))
10408#endif
10409 {
0af913d7 10410 f->output_data.x->hourglass_p = 1;
4ae9a85e 10411
0af913d7 10412 if (!f->output_data.x->hourglass_window)
5f7a1890
GM
10413 {
10414 unsigned long mask = CWCursor;
10415 XSetWindowAttributes attrs;
4ae9a85e 10416
0af913d7 10417 attrs.cursor = f->output_data.x->hourglass_cursor;
4ae9a85e 10418
0af913d7 10419 f->output_data.x->hourglass_window
5f7a1890
GM
10420 = XCreateWindow (dpy, FRAME_OUTER_WINDOW (f),
10421 0, 0, 32000, 32000, 0, 0,
10422 InputOnly,
10423 CopyFromParent,
10424 mask, &attrs);
10425 }
4ae9a85e 10426
0af913d7 10427 XMapRaised (dpy, f->output_data.x->hourglass_window);
5f7a1890
GM
10428 XFlush (dpy);
10429 }
10430 }
10431 }
333b20bb 10432
0af913d7 10433 hourglass_shown_p = 1;
4ae9a85e
GM
10434 UNBLOCK_INPUT;
10435 }
333b20bb
GM
10436}
10437
10438
0af913d7
GM
10439/* Hide the hourglass pointer on all frames, if it is currently
10440 shown. */
333b20bb 10441
4ae9a85e 10442static void
0af913d7 10443hide_hourglass ()
4ae9a85e 10444{
0af913d7 10445 if (hourglass_shown_p)
333b20bb 10446 {
4ae9a85e
GM
10447 Lisp_Object rest, frame;
10448
10449 BLOCK_INPUT;
10450 FOR_EACH_FRAME (rest, frame)
333b20bb 10451 {
4ae9a85e
GM
10452 struct frame *f = XFRAME (frame);
10453
10454 if (FRAME_X_P (f)
10455 /* Watch out for newly created frames. */
0af913d7 10456 && f->output_data.x->hourglass_window)
4ae9a85e 10457 {
0af913d7
GM
10458 XUnmapWindow (FRAME_X_DISPLAY (f),
10459 f->output_data.x->hourglass_window);
10460 /* Sync here because XTread_socket looks at the
10461 hourglass_p flag that is reset to zero below. */
4ae9a85e 10462 XSync (FRAME_X_DISPLAY (f), False);
0af913d7 10463 f->output_data.x->hourglass_p = 0;
4ae9a85e 10464 }
333b20bb 10465 }
333b20bb 10466
0af913d7 10467 hourglass_shown_p = 0;
4ae9a85e
GM
10468 UNBLOCK_INPUT;
10469 }
333b20bb
GM
10470}
10471
10472
10473\f
10474/***********************************************************************
10475 Tool tips
10476 ***********************************************************************/
10477
10478static Lisp_Object x_create_tip_frame P_ ((struct x_display_info *,
275841bf 10479 Lisp_Object, Lisp_Object));
06d62053 10480static void compute_tip_xy P_ ((struct frame *, Lisp_Object, Lisp_Object,
ab452f99 10481 Lisp_Object, int, int, int *, int *));
333b20bb 10482
44b5a125 10483/* The frame of a currently visible tooltip. */
333b20bb 10484
44b5a125 10485Lisp_Object tip_frame;
333b20bb
GM
10486
10487/* If non-nil, a timer started that hides the last tooltip when it
10488 fires. */
10489
10490Lisp_Object tip_timer;
10491Window tip_window;
10492
06d62053
GM
10493/* If non-nil, a vector of 3 elements containing the last args
10494 with which x-show-tip was called. See there. */
10495
10496Lisp_Object last_show_tip_args;
10497
d63931a2
GM
10498/* Maximum size for tooltips; a cons (COLUMNS . ROWS). */
10499
10500Lisp_Object Vx_max_tooltip_size;
10501
eaf1eea9
GM
10502
10503static Lisp_Object
10504unwind_create_tip_frame (frame)
10505 Lisp_Object frame;
10506{
c844a81a
GM
10507 Lisp_Object deleted;
10508
10509 deleted = unwind_create_frame (frame);
10510 if (EQ (deleted, Qt))
10511 {
10512 tip_window = None;
10513 tip_frame = Qnil;
10514 }
10515
10516 return deleted;
eaf1eea9
GM
10517}
10518
10519
333b20bb 10520/* Create a frame for a tooltip on the display described by DPYINFO.
275841bf
GM
10521 PARMS is a list of frame parameters. TEXT is the string to
10522 display in the tip frame. Value is the frame.
eaf1eea9
GM
10523
10524 Note that functions called here, esp. x_default_parameter can
10525 signal errors, for instance when a specified color name is
10526 undefined. We have to make sure that we're in a consistent state
10527 when this happens. */
333b20bb
GM
10528
10529static Lisp_Object
275841bf 10530x_create_tip_frame (dpyinfo, parms, text)
333b20bb 10531 struct x_display_info *dpyinfo;
275841bf 10532 Lisp_Object parms, text;
333b20bb
GM
10533{
10534 struct frame *f;
10535 Lisp_Object frame, tem;
10536 Lisp_Object name;
333b20bb
GM
10537 long window_prompting = 0;
10538 int width, height;
eaf1eea9 10539 int count = BINDING_STACK_SIZE ();
b6d7acec 10540 struct gcpro gcpro1, gcpro2, gcpro3;
333b20bb 10541 struct kboard *kb;
06d62053 10542 int face_change_count_before = face_change_count;
275841bf
GM
10543 Lisp_Object buffer;
10544 struct buffer *old_buffer;
333b20bb
GM
10545
10546 check_x ();
10547
10548 /* Use this general default value to start with until we know if
10549 this frame has a specified name. */
10550 Vx_resource_name = Vinvocation_name;
10551
10552#ifdef MULTI_KBOARD
10553 kb = dpyinfo->kboard;
10554#else
10555 kb = &the_only_kboard;
10556#endif
10557
10558 /* Get the name of the frame to use for resource lookup. */
10559 name = x_get_arg (dpyinfo, parms, Qname, "name", "Name", RES_TYPE_STRING);
10560 if (!STRINGP (name)
10561 && !EQ (name, Qunbound)
10562 && !NILP (name))
10563 error ("Invalid frame name--not a string or nil");
10564 Vx_resource_name = name;
10565
10566 frame = Qnil;
10567 GCPRO3 (parms, name, frame);
44b5a125 10568 f = make_frame (1);
333b20bb 10569 XSETFRAME (frame, f);
275841bf
GM
10570
10571 buffer = Fget_buffer_create (build_string (" *tip*"));
10572 Fset_window_buffer (FRAME_ROOT_WINDOW (f), buffer);
10573 old_buffer = current_buffer;
10574 set_buffer_internal_1 (XBUFFER (buffer));
d63931a2 10575 current_buffer->truncate_lines = Qnil;
275841bf
GM
10576 Ferase_buffer ();
10577 Finsert (1, &text);
10578 set_buffer_internal_1 (old_buffer);
10579
333b20bb 10580 FRAME_CAN_HAVE_SCROLL_BARS (f) = 0;
8a1a7743 10581 record_unwind_protect (unwind_create_tip_frame, frame);
333b20bb 10582
eaf1eea9
GM
10583 /* By setting the output method, we're essentially saying that
10584 the frame is live, as per FRAME_LIVE_P. If we get a signal
10585 from this point on, x_destroy_window might screw up reference
10586 counts etc. */
333b20bb
GM
10587 f->output_method = output_x_window;
10588 f->output_data.x = (struct x_output *) xmalloc (sizeof (struct x_output));
10589 bzero (f->output_data.x, sizeof (struct x_output));
10590 f->output_data.x->icon_bitmap = -1;
10591 f->output_data.x->fontset = -1;
61d461a8
GM
10592 f->output_data.x->scroll_bar_foreground_pixel = -1;
10593 f->output_data.x->scroll_bar_background_pixel = -1;
333b20bb
GM
10594 f->icon_name = Qnil;
10595 FRAME_X_DISPLAY_INFO (f) = dpyinfo;
f1d2ce7f 10596#if GLYPH_DEBUG
eaf1eea9
GM
10597 image_cache_refcount = FRAME_X_IMAGE_CACHE (f)->refcount;
10598 dpyinfo_refcount = dpyinfo->reference_count;
10599#endif /* GLYPH_DEBUG */
333b20bb
GM
10600#ifdef MULTI_KBOARD
10601 FRAME_KBOARD (f) = kb;
10602#endif
10603 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
10604 f->output_data.x->explicit_parent = 0;
10605
61d461a8
GM
10606 /* These colors will be set anyway later, but it's important
10607 to get the color reference counts right, so initialize them! */
10608 {
10609 Lisp_Object black;
10610 struct gcpro gcpro1;
10611
10612 black = build_string ("black");
10613 GCPRO1 (black);
10614 f->output_data.x->foreground_pixel
10615 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
10616 f->output_data.x->background_pixel
10617 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
10618 f->output_data.x->cursor_pixel
10619 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
10620 f->output_data.x->cursor_foreground_pixel
10621 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
10622 f->output_data.x->border_pixel
10623 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
10624 f->output_data.x->mouse_pixel
10625 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
10626 UNGCPRO;
10627 }
10628
333b20bb
GM
10629 /* Set the name; the functions to which we pass f expect the name to
10630 be set. */
10631 if (EQ (name, Qunbound) || NILP (name))
10632 {
10633 f->name = build_string (dpyinfo->x_id_name);
10634 f->explicit_name = 0;
10635 }
10636 else
10637 {
10638 f->name = name;
10639 f->explicit_name = 1;
10640 /* use the frame's title when getting resources for this frame. */
10641 specbind (Qx_resource_name, name);
10642 }
10643
eaf1eea9
GM
10644 /* Extract the window parameters from the supplied values that are
10645 needed to determine window geometry. */
333b20bb
GM
10646 {
10647 Lisp_Object font;
10648
10649 font = x_get_arg (dpyinfo, parms, Qfont, "font", "Font", RES_TYPE_STRING);
10650
10651 BLOCK_INPUT;
10652 /* First, try whatever font the caller has specified. */
10653 if (STRINGP (font))
10654 {
10655 tem = Fquery_fontset (font, Qnil);
10656 if (STRINGP (tem))
10657 font = x_new_fontset (f, XSTRING (tem)->data);
10658 else
10659 font = x_new_font (f, XSTRING (font)->data);
10660 }
10661
10662 /* Try out a font which we hope has bold and italic variations. */
10663 if (!STRINGP (font))
10664 font = x_new_font (f, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
10665 if (!STRINGP (font))
10666 font = x_new_font (f, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10667 if (! STRINGP (font))
10668 font = x_new_font (f, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10669 if (! STRINGP (font))
10670 /* This was formerly the first thing tried, but it finds too many fonts
10671 and takes too long. */
10672 font = x_new_font (f, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
10673 /* If those didn't work, look for something which will at least work. */
10674 if (! STRINGP (font))
10675 font = x_new_font (f, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
10676 UNBLOCK_INPUT;
10677 if (! STRINGP (font))
10678 font = build_string ("fixed");
10679
10680 x_default_parameter (f, parms, Qfont, font,
10681 "font", "Font", RES_TYPE_STRING);
10682 }
10683
10684 x_default_parameter (f, parms, Qborder_width, make_number (2),
10685 "borderWidth", "BorderWidth", RES_TYPE_NUMBER);
10686
10687 /* This defaults to 2 in order to match xterm. We recognize either
10688 internalBorderWidth or internalBorder (which is what xterm calls
10689 it). */
10690 if (NILP (Fassq (Qinternal_border_width, parms)))
10691 {
10692 Lisp_Object value;
10693
10694 value = x_get_arg (dpyinfo, parms, Qinternal_border_width,
10695 "internalBorder", "internalBorder", RES_TYPE_NUMBER);
10696 if (! EQ (value, Qunbound))
10697 parms = Fcons (Fcons (Qinternal_border_width, value),
10698 parms);
10699 }
10700
10701 x_default_parameter (f, parms, Qinternal_border_width, make_number (1),
10702 "internalBorderWidth", "internalBorderWidth",
10703 RES_TYPE_NUMBER);
10704
10705 /* Also do the stuff which must be set before the window exists. */
10706 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
10707 "foreground", "Foreground", RES_TYPE_STRING);
10708 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
10709 "background", "Background", RES_TYPE_STRING);
10710 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
10711 "pointerColor", "Foreground", RES_TYPE_STRING);
10712 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
10713 "cursorColor", "Foreground", RES_TYPE_STRING);
10714 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
10715 "borderColor", "BorderColor", RES_TYPE_STRING);
10716
10717 /* Init faces before x_default_parameter is called for scroll-bar
10718 parameters because that function calls x_set_scroll_bar_width,
10719 which calls change_frame_size, which calls Fset_window_buffer,
10720 which runs hooks, which call Fvertical_motion. At the end, we
10721 end up in init_iterator with a null face cache, which should not
10722 happen. */
10723 init_frame_faces (f);
10724
10725 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
10726 window_prompting = x_figure_window_size (f, parms);
10727
10728 if (window_prompting & XNegative)
10729 {
10730 if (window_prompting & YNegative)
10731 f->output_data.x->win_gravity = SouthEastGravity;
10732 else
10733 f->output_data.x->win_gravity = NorthEastGravity;
10734 }
10735 else
10736 {
10737 if (window_prompting & YNegative)
10738 f->output_data.x->win_gravity = SouthWestGravity;
10739 else
10740 f->output_data.x->win_gravity = NorthWestGravity;
10741 }
10742
10743 f->output_data.x->size_hint_flags = window_prompting;
10744 {
10745 XSetWindowAttributes attrs;
10746 unsigned long mask;
10747
10748 BLOCK_INPUT;
c51d2b5e
GM
10749 mask = CWBackPixel | CWOverrideRedirect | CWEventMask;
10750 if (DoesSaveUnders (dpyinfo->screen))
10751 mask |= CWSaveUnder;
10752
9b2956e2
GM
10753 /* Window managers look at the override-redirect flag to determine
10754 whether or net to give windows a decoration (Xlib spec, chapter
333b20bb
GM
10755 3.2.8). */
10756 attrs.override_redirect = True;
10757 attrs.save_under = True;
10758 attrs.background_pixel = FRAME_BACKGROUND_PIXEL (f);
10759 /* Arrange for getting MapNotify and UnmapNotify events. */
10760 attrs.event_mask = StructureNotifyMask;
10761 tip_window
10762 = FRAME_X_WINDOW (f)
10763 = XCreateWindow (FRAME_X_DISPLAY (f),
10764 FRAME_X_DISPLAY_INFO (f)->root_window,
10765 /* x, y, width, height */
10766 0, 0, 1, 1,
10767 /* Border. */
10768 1,
10769 CopyFromParent, InputOutput, CopyFromParent,
10770 mask, &attrs);
10771 UNBLOCK_INPUT;
10772 }
10773
10774 x_make_gc (f);
10775
333b20bb
GM
10776 x_default_parameter (f, parms, Qauto_raise, Qnil,
10777 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
10778 x_default_parameter (f, parms, Qauto_lower, Qnil,
10779 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
10780 x_default_parameter (f, parms, Qcursor_type, Qbox,
10781 "cursorType", "CursorType", RES_TYPE_SYMBOL);
10782
10783 /* Dimensions, especially f->height, must be done via change_frame_size.
10784 Change will not be effected unless different from the current
10785 f->height. */
10786 width = f->width;
10787 height = f->height;
10788 f->height = 0;
10789 SET_FRAME_WIDTH (f, 0);
8938a4fb 10790 change_frame_size (f, height, width, 1, 0, 0);
333b20bb 10791
035d5114 10792 /* Set up faces after all frame parameters are known. This call
6801a572
GM
10793 also merges in face attributes specified for new frames.
10794
10795 Frame parameters may be changed if .Xdefaults contains
10796 specifications for the default font. For example, if there is an
10797 `Emacs.default.attributeBackground: pink', the `background-color'
10798 attribute of the frame get's set, which let's the internal border
10799 of the tooltip frame appear in pink. Prevent this. */
10800 {
10801 Lisp_Object bg = Fframe_parameter (frame, Qbackground_color);
10802
10803 /* Set tip_frame here, so that */
10804 tip_frame = frame;
10805 call1 (Qface_set_after_frame_default, frame);
10806
10807 if (!EQ (bg, Fframe_parameter (frame, Qbackground_color)))
10808 Fmodify_frame_parameters (frame, Fcons (Fcons (Qbackground_color, bg),
10809 Qnil));
10810 }
035d5114 10811
333b20bb
GM
10812 f->no_split = 1;
10813
10814 UNGCPRO;
10815
10816 /* It is now ok to make the frame official even if we get an error
10817 below. And the frame needs to be on Vframe_list or making it
10818 visible won't work. */
10819 Vframe_list = Fcons (frame, Vframe_list);
10820
10821 /* Now that the frame is official, it counts as a reference to
10822 its display. */
10823 FRAME_X_DISPLAY_INFO (f)->reference_count++;
10824
06d62053
GM
10825 /* Setting attributes of faces of the tooltip frame from resources
10826 and similar will increment face_change_count, which leads to the
10827 clearing of all current matrices. Since this isn't necessary
10828 here, avoid it by resetting face_change_count to the value it
10829 had before we created the tip frame. */
10830 face_change_count = face_change_count_before;
10831
eaf1eea9 10832 /* Discard the unwind_protect. */
333b20bb
GM
10833 return unbind_to (count, frame);
10834}
10835
10836
06d62053
GM
10837/* Compute where to display tip frame F. PARMS is the list of frame
10838 parameters for F. DX and DY are specified offsets from the current
ab452f99
GM
10839 location of the mouse. WIDTH and HEIGHT are the width and height
10840 of the tooltip. Return coordinates relative to the root window of
10841 the display in *ROOT_X, and *ROOT_Y. */
06d62053
GM
10842
10843static void
ab452f99 10844compute_tip_xy (f, parms, dx, dy, width, height, root_x, root_y)
06d62053
GM
10845 struct frame *f;
10846 Lisp_Object parms, dx, dy;
ab452f99 10847 int width, height;
06d62053
GM
10848 int *root_x, *root_y;
10849{
10850 Lisp_Object left, top;
10851 int win_x, win_y;
10852 Window root, child;
10853 unsigned pmask;
10854
10855 /* User-specified position? */
10856 left = Fcdr (Fassq (Qleft, parms));
10857 top = Fcdr (Fassq (Qtop, parms));
10858
10859 /* Move the tooltip window where the mouse pointer is. Resize and
10860 show it. */
ab452f99
GM
10861 if (!INTEGERP (left) && !INTEGERP (top))
10862 {
10863 BLOCK_INPUT;
10864 XQueryPointer (FRAME_X_DISPLAY (f), FRAME_X_DISPLAY_INFO (f)->root_window,
10865 &root, &child, root_x, root_y, &win_x, &win_y, &pmask);
10866 UNBLOCK_INPUT;
10867 }
06d62053 10868
06d62053
GM
10869 if (INTEGERP (top))
10870 *root_y = XINT (top);
ab452f99
GM
10871 else if (*root_y + XINT (dy) - height < 0)
10872 *root_y -= XINT (dy);
10873 else
10874 {
10875 *root_y -= height;
10876 *root_y += XINT (dy);
10877 }
10878
10879 if (INTEGERP (left))
10880 *root_x = XINT (left);
10881 else if (*root_x + XINT (dx) + width > FRAME_X_DISPLAY_INFO (f)->width)
10882 *root_x -= width + XINT (dx);
10883 else
10884 *root_x += XINT (dx);
06d62053
GM
10885}
10886
10887
0634ce98 10888DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
e82d09c9 10889 "Show STRING in a \"tooltip\" window on frame FRAME.\n\
0634ce98
GM
10890A tooltip window is a small X window displaying a string.\n\
10891\n\
333b20bb 10892FRAME nil or omitted means use the selected frame.\n\
0634ce98 10893\n\
333b20bb
GM
10894PARMS is an optional list of frame parameters which can be\n\
10895used to change the tooltip's appearance.\n\
0634ce98 10896\n\
333b20bb 10897Automatically hide the tooltip after TIMEOUT seconds.\n\
0634ce98
GM
10898TIMEOUT nil means use the default timeout of 5 seconds.\n\
10899\n\
10900If the list of frame parameters PARAMS contains a `left' parameters,\n\
10901the tooltip is displayed at that x-position. Otherwise it is\n\
10902displayed at the mouse position, with offset DX added (default is 5 if\n\
10903DX isn't specified). Likewise for the y-position; if a `top' frame\n\
10904parameter is specified, it determines the y-position of the tooltip\n\
10905window, otherwise it is displayed at the mouse position, with offset\n\
61a925c1
GM
10906DY added (default is -10).\n\
10907\n\
10908A tooltip's maximum size is specified by `x-max-tooltip-size'.\n\
10909Text larger than the specified size is clipped.")
0634ce98
GM
10910 (string, frame, parms, timeout, dx, dy)
10911 Lisp_Object string, frame, parms, timeout, dx, dy;
333b20bb
GM
10912{
10913 struct frame *f;
10914 struct window *w;
d63931a2 10915 Lisp_Object buffer, top, left, max_width, max_height;
06d62053 10916 int root_x, root_y;
333b20bb
GM
10917 struct buffer *old_buffer;
10918 struct text_pos pos;
10919 int i, width, height;
393f2d14 10920 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
333b20bb 10921 int old_windows_or_buffers_changed = windows_or_buffers_changed;
06d62053 10922 int count = BINDING_STACK_SIZE ();
333b20bb
GM
10923
10924 specbind (Qinhibit_redisplay, Qt);
10925
393f2d14 10926 GCPRO4 (string, parms, frame, timeout);
333b20bb
GM
10927
10928 CHECK_STRING (string, 0);
10929 f = check_x_frame (frame);
10930 if (NILP (timeout))
10931 timeout = make_number (5);
10932 else
10933 CHECK_NATNUM (timeout, 2);
0634ce98
GM
10934
10935 if (NILP (dx))
10936 dx = make_number (5);
10937 else
10938 CHECK_NUMBER (dx, 5);
10939
10940 if (NILP (dy))
12c67a7f 10941 dy = make_number (-10);
0634ce98
GM
10942 else
10943 CHECK_NUMBER (dy, 6);
333b20bb 10944
06d62053
GM
10945 if (NILP (last_show_tip_args))
10946 last_show_tip_args = Fmake_vector (make_number (3), Qnil);
10947
10948 if (!NILP (tip_frame))
10949 {
10950 Lisp_Object last_string = AREF (last_show_tip_args, 0);
10951 Lisp_Object last_frame = AREF (last_show_tip_args, 1);
10952 Lisp_Object last_parms = AREF (last_show_tip_args, 2);
10953
10954 if (EQ (frame, last_frame)
10955 && !NILP (Fequal (last_string, string))
10956 && !NILP (Fequal (last_parms, parms)))
10957 {
10958 struct frame *f = XFRAME (tip_frame);
10959
10960 /* Only DX and DY have changed. */
10961 if (!NILP (tip_timer))
ae782866
GM
10962 {
10963 Lisp_Object timer = tip_timer;
10964 tip_timer = Qnil;
10965 call1 (Qcancel_timer, timer);
10966 }
06d62053
GM
10967
10968 BLOCK_INPUT;
ab452f99
GM
10969 compute_tip_xy (f, parms, dx, dy, PIXEL_WIDTH (f),
10970 PIXEL_HEIGHT (f), &root_x, &root_y);
06d62053 10971 XMoveWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
ab452f99 10972 root_x, root_y);
06d62053
GM
10973 UNBLOCK_INPUT;
10974 goto start_timer;
10975 }
10976 }
10977
333b20bb
GM
10978 /* Hide a previous tip, if any. */
10979 Fx_hide_tip ();
10980
06d62053
GM
10981 ASET (last_show_tip_args, 0, string);
10982 ASET (last_show_tip_args, 1, frame);
10983 ASET (last_show_tip_args, 2, parms);
10984
333b20bb
GM
10985 /* Add default values to frame parameters. */
10986 if (NILP (Fassq (Qname, parms)))
10987 parms = Fcons (Fcons (Qname, build_string ("tooltip")), parms);
10988 if (NILP (Fassq (Qinternal_border_width, parms)))
10989 parms = Fcons (Fcons (Qinternal_border_width, make_number (3)), parms);
10990 if (NILP (Fassq (Qborder_width, parms)))
10991 parms = Fcons (Fcons (Qborder_width, make_number (1)), parms);
10992 if (NILP (Fassq (Qborder_color, parms)))
10993 parms = Fcons (Fcons (Qborder_color, build_string ("lightyellow")), parms);
10994 if (NILP (Fassq (Qbackground_color, parms)))
10995 parms = Fcons (Fcons (Qbackground_color, build_string ("lightyellow")),
10996 parms);
10997
10998 /* Create a frame for the tooltip, and record it in the global
10999 variable tip_frame. */
275841bf 11000 frame = x_create_tip_frame (FRAME_X_DISPLAY_INFO (f), parms, string);
44b5a125 11001 f = XFRAME (frame);
333b20bb 11002
d63931a2 11003 /* Set up the frame's root window. */
333b20bb
GM
11004 w = XWINDOW (FRAME_ROOT_WINDOW (f));
11005 w->left = w->top = make_number (0);
d63931a2
GM
11006
11007 if (CONSP (Vx_max_tooltip_size)
11008 && INTEGERP (XCAR (Vx_max_tooltip_size))
11009 && XINT (XCAR (Vx_max_tooltip_size)) > 0
11010 && INTEGERP (XCDR (Vx_max_tooltip_size))
11011 && XINT (XCDR (Vx_max_tooltip_size)) > 0)
11012 {
11013 w->width = XCAR (Vx_max_tooltip_size);
11014 w->height = XCDR (Vx_max_tooltip_size);
11015 }
11016 else
11017 {
11018 w->width = make_number (80);
11019 w->height = make_number (40);
11020 }
11021
11022 f->window_width = XINT (w->width);
333b20bb
GM
11023 adjust_glyphs (f);
11024 w->pseudo_window_p = 1;
11025
11026 /* Display the tooltip text in a temporary buffer. */
333b20bb 11027 old_buffer = current_buffer;
275841bf 11028 set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f))->buffer));
d63931a2 11029 current_buffer->truncate_lines = Qnil;
333b20bb
GM
11030 clear_glyph_matrix (w->desired_matrix);
11031 clear_glyph_matrix (w->current_matrix);
11032 SET_TEXT_POS (pos, BEGV, BEGV_BYTE);
11033 try_window (FRAME_ROOT_WINDOW (f), pos);
11034
11035 /* Compute width and height of the tooltip. */
11036 width = height = 0;
11037 for (i = 0; i < w->desired_matrix->nrows; ++i)
11038 {
11039 struct glyph_row *row = &w->desired_matrix->rows[i];
11040 struct glyph *last;
11041 int row_width;
11042
11043 /* Stop at the first empty row at the end. */
11044 if (!row->enabled_p || !row->displays_text_p)
11045 break;
11046
d7bf0342
GM
11047 /* Let the row go over the full width of the frame. */
11048 row->full_width_p = 1;
333b20bb 11049
e3130015 11050 /* There's a glyph at the end of rows that is used to place
333b20bb
GM
11051 the cursor there. Don't include the width of this glyph. */
11052 if (row->used[TEXT_AREA])
11053 {
11054 last = &row->glyphs[TEXT_AREA][row->used[TEXT_AREA] - 1];
11055 row_width = row->pixel_width - last->pixel_width;
11056 }
11057 else
11058 row_width = row->pixel_width;
11059
11060 height += row->height;
11061 width = max (width, row_width);
11062 }
11063
11064 /* Add the frame's internal border to the width and height the X
11065 window should have. */
11066 height += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
11067 width += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
11068
11069 /* Move the tooltip window where the mouse pointer is. Resize and
11070 show it. */
ab452f99 11071 compute_tip_xy (f, parms, dx, dy, width, height, &root_x, &root_y);
0634ce98 11072
0634ce98 11073 BLOCK_INPUT;
333b20bb 11074 XMoveResizeWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
ab452f99 11075 root_x, root_y, width, height);
333b20bb
GM
11076 XMapRaised (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f));
11077 UNBLOCK_INPUT;
06d62053 11078
333b20bb
GM
11079 /* Draw into the window. */
11080 w->must_be_updated_p = 1;
11081 update_single_window (w, 1);
11082
11083 /* Restore original current buffer. */
11084 set_buffer_internal_1 (old_buffer);
11085 windows_or_buffers_changed = old_windows_or_buffers_changed;
11086
06d62053 11087 start_timer:
333b20bb
GM
11088 /* Let the tip disappear after timeout seconds. */
11089 tip_timer = call3 (intern ("run-at-time"), timeout, Qnil,
11090 intern ("x-hide-tip"));
a744a2ec
DL
11091
11092 UNGCPRO;
333b20bb
GM
11093 return unbind_to (count, Qnil);
11094}
11095
11096
11097DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0,
e82d09c9 11098 "Hide the current tooltip window, if there is any.\n\
333b20bb
GM
11099Value is t is tooltip was open, nil otherwise.")
11100 ()
11101{
44b5a125 11102 int count;
c0006262
GM
11103 Lisp_Object deleted, frame, timer;
11104 struct gcpro gcpro1, gcpro2;
44b5a125
GM
11105
11106 /* Return quickly if nothing to do. */
c0006262 11107 if (NILP (tip_timer) && NILP (tip_frame))
44b5a125 11108 return Qnil;
333b20bb 11109
c0006262
GM
11110 frame = tip_frame;
11111 timer = tip_timer;
11112 GCPRO2 (frame, timer);
11113 tip_frame = tip_timer = deleted = Qnil;
11114
44b5a125 11115 count = BINDING_STACK_SIZE ();
333b20bb 11116 specbind (Qinhibit_redisplay, Qt);
44b5a125 11117 specbind (Qinhibit_quit, Qt);
333b20bb 11118
c0006262 11119 if (!NILP (timer))
ae782866 11120 call1 (Qcancel_timer, timer);
333b20bb 11121
c0006262 11122 if (FRAMEP (frame))
333b20bb 11123 {
44b5a125
GM
11124 Fdelete_frame (frame, Qnil);
11125 deleted = Qt;
f6c44811
GM
11126
11127#ifdef USE_LUCID
11128 /* Bloodcurdling hack alert: The Lucid menu bar widget's
11129 redisplay procedure is not called when a tip frame over menu
11130 items is unmapped. Redisplay the menu manually... */
11131 {
11132 struct frame *f = SELECTED_FRAME ();
11133 Widget w = f->output_data.x->menubar_widget;
11134 extern void xlwmenu_redisplay P_ ((Widget));
11135
11136 if (!DoesSaveUnders (FRAME_X_DISPLAY_INFO (f)->screen)
dbc64aa7 11137 && w != NULL)
f6c44811
GM
11138 {
11139 BLOCK_INPUT;
11140 xlwmenu_redisplay (w);
11141 UNBLOCK_INPUT;
11142 }
11143 }
11144#endif /* USE_LUCID */
333b20bb
GM
11145 }
11146
c0006262 11147 UNGCPRO;
44b5a125 11148 return unbind_to (count, deleted);
333b20bb
GM
11149}
11150
11151
11152\f
11153/***********************************************************************
11154 File selection dialog
11155 ***********************************************************************/
11156
11157#ifdef USE_MOTIF
11158
11159/* Callback for "OK" and "Cancel" on file selection dialog. */
11160
11161static void
11162file_dialog_cb (widget, client_data, call_data)
11163 Widget widget;
11164 XtPointer call_data, client_data;
11165{
11166 int *result = (int *) client_data;
11167 XmAnyCallbackStruct *cb = (XmAnyCallbackStruct *) call_data;
11168 *result = cb->reason;
11169}
11170
11171
a779d213
GM
11172/* Callback for unmapping a file selection dialog. This is used to
11173 capture the case where a dialog is closed via a window manager's
11174 closer button, for example. Using a XmNdestroyCallback didn't work
11175 in this case. */
11176
11177static void
11178file_dialog_unmap_cb (widget, client_data, call_data)
11179 Widget widget;
11180 XtPointer call_data, client_data;
11181{
11182 int *result = (int *) client_data;
11183 *result = XmCR_CANCEL;
11184}
11185
11186
333b20bb
GM
11187DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 4, 0,
11188 "Read file name, prompting with PROMPT in directory DIR.\n\
11189Use a file selection dialog.\n\
11190Select DEFAULT-FILENAME in the dialog's file selection box, if\n\
11191specified. Don't let the user enter a file name in the file\n\
11192selection dialog's entry field, if MUSTMATCH is non-nil.")
11193 (prompt, dir, default_filename, mustmatch)
11194 Lisp_Object prompt, dir, default_filename, mustmatch;
11195{
11196 int result;
0fe92f72 11197 struct frame *f = SELECTED_FRAME ();
333b20bb
GM
11198 Lisp_Object file = Qnil;
11199 Widget dialog, text, list, help;
11200 Arg al[10];
11201 int ac = 0;
11202 extern XtAppContext Xt_app_con;
11203 char *title;
11204 XmString dir_xmstring, pattern_xmstring;
11205 int popup_activated_flag;
11206 int count = specpdl_ptr - specpdl;
11207 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
11208
11209 GCPRO5 (prompt, dir, default_filename, mustmatch, file);
11210 CHECK_STRING (prompt, 0);
11211 CHECK_STRING (dir, 1);
11212
11213 /* Prevent redisplay. */
11214 specbind (Qinhibit_redisplay, Qt);
11215
11216 BLOCK_INPUT;
11217
11218 /* Create the dialog with PROMPT as title, using DIR as initial
11219 directory and using "*" as pattern. */
11220 dir = Fexpand_file_name (dir, Qnil);
11221 dir_xmstring = XmStringCreateLocalized (XSTRING (dir)->data);
11222 pattern_xmstring = XmStringCreateLocalized ("*");
11223
11224 XtSetArg (al[ac], XmNtitle, XSTRING (prompt)->data); ++ac;
11225 XtSetArg (al[ac], XmNdirectory, dir_xmstring); ++ac;
11226 XtSetArg (al[ac], XmNpattern, pattern_xmstring); ++ac;
11227 XtSetArg (al[ac], XmNresizePolicy, XmRESIZE_GROW); ++ac;
11228 XtSetArg (al[ac], XmNdialogStyle, XmDIALOG_APPLICATION_MODAL); ++ac;
11229 dialog = XmCreateFileSelectionDialog (f->output_data.x->widget,
11230 "fsb", al, ac);
11231 XmStringFree (dir_xmstring);
11232 XmStringFree (pattern_xmstring);
11233
11234 /* Add callbacks for OK and Cancel. */
11235 XtAddCallback (dialog, XmNokCallback, file_dialog_cb,
11236 (XtPointer) &result);
11237 XtAddCallback (dialog, XmNcancelCallback, file_dialog_cb,
11238 (XtPointer) &result);
a779d213
GM
11239 XtAddCallback (dialog, XmNunmapCallback, file_dialog_unmap_cb,
11240 (XtPointer) &result);
333b20bb
GM
11241
11242 /* Disable the help button since we can't display help. */
11243 help = XmFileSelectionBoxGetChild (dialog, XmDIALOG_HELP_BUTTON);
11244 XtSetSensitive (help, False);
11245
11246 /* Mark OK button as default. */
11247 XtVaSetValues (XmFileSelectionBoxGetChild (dialog, XmDIALOG_OK_BUTTON),
11248 XmNshowAsDefault, True, NULL);
11249
11250 /* If MUSTMATCH is non-nil, disable the file entry field of the
11251 dialog, so that the user must select a file from the files list
11252 box. We can't remove it because we wouldn't have a way to get at
11253 the result file name, then. */
11254 text = XmFileSelectionBoxGetChild (dialog, XmDIALOG_TEXT);
11255 if (!NILP (mustmatch))
11256 {
11257 Widget label;
11258 label = XmFileSelectionBoxGetChild (dialog, XmDIALOG_SELECTION_LABEL);
11259 XtSetSensitive (text, False);
11260 XtSetSensitive (label, False);
11261 }
11262
11263 /* Manage the dialog, so that list boxes get filled. */
11264 XtManageChild (dialog);
11265
11266 /* Select DEFAULT_FILENAME in the files list box. DEFAULT_FILENAME
11267 must include the path for this to work. */
11268 list = XmFileSelectionBoxGetChild (dialog, XmDIALOG_LIST);
11269 if (STRINGP (default_filename))
11270 {
11271 XmString default_xmstring;
11272 int item_pos;
11273
11274 default_xmstring
11275 = XmStringCreateLocalized (XSTRING (default_filename)->data);
11276
11277 if (!XmListItemExists (list, default_xmstring))
11278 {
11279 /* Add a new item if DEFAULT_FILENAME is not in the list. */
11280 XmListAddItem (list, default_xmstring, 0);
11281 item_pos = 0;
11282 }
11283 else
11284 item_pos = XmListItemPos (list, default_xmstring);
11285 XmStringFree (default_xmstring);
11286
11287 /* Select the item and scroll it into view. */
11288 XmListSelectPos (list, item_pos, True);
11289 XmListSetPos (list, item_pos);
11290 }
11291
563b384d
GM
11292 /* Process events until the user presses Cancel or OK. Block
11293 and unblock input here so that we get a chance of processing
11294 expose events. */
11295 UNBLOCK_INPUT;
03100098 11296 result = 0;
a779d213 11297 while (result == 0)
563b384d
GM
11298 {
11299 BLOCK_INPUT;
11300 XtAppProcessEvent (Xt_app_con, XtIMAll);
11301 UNBLOCK_INPUT;
11302 }
11303 BLOCK_INPUT;
03100098 11304
333b20bb
GM
11305 /* Get the result. */
11306 if (result == XmCR_OK)
11307 {
11308 XmString text;
11309 String data;
11310
d1670063 11311 XtVaGetValues (dialog, XmNtextString, &text, NULL);
333b20bb
GM
11312 XmStringGetLtoR (text, XmFONTLIST_DEFAULT_TAG, &data);
11313 XmStringFree (text);
11314 file = build_string (data);
11315 XtFree (data);
11316 }
11317 else
11318 file = Qnil;
11319
11320 /* Clean up. */
11321 XtUnmanageChild (dialog);
11322 XtDestroyWidget (dialog);
11323 UNBLOCK_INPUT;
11324 UNGCPRO;
11325
11326 /* Make "Cancel" equivalent to C-g. */
11327 if (NILP (file))
11328 Fsignal (Qquit, Qnil);
11329
11330 return unbind_to (count, file);
11331}
11332
11333#endif /* USE_MOTIF */
11334
333b20bb
GM
11335
11336\f
82bab41c
GM
11337/***********************************************************************
11338 Keyboard
11339 ***********************************************************************/
11340
11341#ifdef HAVE_XKBGETKEYBOARD
11342#include <X11/XKBlib.h>
11343#include <X11/keysym.h>
11344#endif
11345
11346DEFUN ("x-backspace-delete-keys-p", Fx_backspace_delete_keys_p,
11347 Sx_backspace_delete_keys_p, 0, 1, 0,
11348 "Check if both Backspace and Delete keys are on the keyboard of FRAME.\n\
11349FRAME nil means use the selected frame.\n\
11350Value is t if we know that both keys are present, and are mapped to the\n\
11351usual X keysyms.")
11352 (frame)
11353 Lisp_Object frame;
11354{
11355#ifdef HAVE_XKBGETKEYBOARD
11356 XkbDescPtr kb;
11357 struct frame *f = check_x_frame (frame);
11358 Display *dpy = FRAME_X_DISPLAY (f);
11359 Lisp_Object have_keys;
46f6a258 11360 int major, minor, op, event, error;
82bab41c
GM
11361
11362 BLOCK_INPUT;
46f6a258
GM
11363
11364 /* Check library version in case we're dynamically linked. */
11365 major = XkbMajorVersion;
11366 minor = XkbMinorVersion;
11367 if (!XkbLibraryVersion (&major, &minor))
c1efd260
GM
11368 {
11369 UNBLOCK_INPUT;
11370 return Qnil;
11371 }
46f6a258
GM
11372
11373 /* Check that the server supports XKB. */
11374 major = XkbMajorVersion;
11375 minor = XkbMinorVersion;
11376 if (!XkbQueryExtension (dpy, &op, &event, &error, &major, &minor))
c1efd260
GM
11377 {
11378 UNBLOCK_INPUT;
11379 return Qnil;
11380 }
46f6a258
GM
11381
11382 have_keys = Qnil;
c1efd260 11383 kb = XkbGetMap (dpy, XkbAllMapComponentsMask, XkbUseCoreKbd);
82bab41c
GM
11384 if (kb)
11385 {
11386 int delete_keycode = 0, backspace_keycode = 0, i;
c1efd260
GM
11387
11388 if (XkbGetNames (dpy, XkbAllNamesMask, kb) == Success)
82bab41c 11389 {
c1efd260
GM
11390 for (i = kb->min_key_code;
11391 (i < kb->max_key_code
11392 && (delete_keycode == 0 || backspace_keycode == 0));
11393 ++i)
11394 {
d63931a2
GM
11395 /* The XKB symbolic key names can be seen most easily in
11396 the PS file generated by `xkbprint -label name
11397 $DISPLAY'. */
c1efd260
GM
11398 if (bcmp ("DELE", kb->names->keys[i].name, 4) == 0)
11399 delete_keycode = i;
11400 else if (bcmp ("BKSP", kb->names->keys[i].name, 4) == 0)
11401 backspace_keycode = i;
11402 }
11403
11404 XkbFreeNames (kb, 0, True);
82bab41c
GM
11405 }
11406
c1efd260 11407 XkbFreeClientMap (kb, 0, True);
82bab41c
GM
11408
11409 if (delete_keycode
11410 && backspace_keycode
11411 && XKeysymToKeycode (dpy, XK_Delete) == delete_keycode
11412 && XKeysymToKeycode (dpy, XK_BackSpace) == backspace_keycode)
11413 have_keys = Qt;
11414 }
11415 UNBLOCK_INPUT;
11416 return have_keys;
11417#else /* not HAVE_XKBGETKEYBOARD */
11418 return Qnil;
11419#endif /* not HAVE_XKBGETKEYBOARD */
11420}
11421
11422
11423\f
333b20bb
GM
11424/***********************************************************************
11425 Initialization
11426 ***********************************************************************/
11427
11428void
11429syms_of_xfns ()
11430{
11431 /* This is zero if not using X windows. */
11432 x_in_use = 0;
11433
11434 /* The section below is built by the lisp expression at the top of the file,
11435 just above where these variables are declared. */
11436 /*&&& init symbols here &&&*/
11437 Qauto_raise = intern ("auto-raise");
11438 staticpro (&Qauto_raise);
11439 Qauto_lower = intern ("auto-lower");
11440 staticpro (&Qauto_lower);
11441 Qbar = intern ("bar");
dbc4e1c1 11442 staticpro (&Qbar);
f9942c9e
JB
11443 Qborder_color = intern ("border-color");
11444 staticpro (&Qborder_color);
11445 Qborder_width = intern ("border-width");
11446 staticpro (&Qborder_width);
dbc4e1c1
JB
11447 Qbox = intern ("box");
11448 staticpro (&Qbox);
f9942c9e
JB
11449 Qcursor_color = intern ("cursor-color");
11450 staticpro (&Qcursor_color);
dbc4e1c1
JB
11451 Qcursor_type = intern ("cursor-type");
11452 staticpro (&Qcursor_type);
f9942c9e
JB
11453 Qgeometry = intern ("geometry");
11454 staticpro (&Qgeometry);
f9942c9e
JB
11455 Qicon_left = intern ("icon-left");
11456 staticpro (&Qicon_left);
11457 Qicon_top = intern ("icon-top");
11458 staticpro (&Qicon_top);
11459 Qicon_type = intern ("icon-type");
11460 staticpro (&Qicon_type);
80534dd6
KH
11461 Qicon_name = intern ("icon-name");
11462 staticpro (&Qicon_name);
f9942c9e
JB
11463 Qinternal_border_width = intern ("internal-border-width");
11464 staticpro (&Qinternal_border_width);
11465 Qleft = intern ("left");
11466 staticpro (&Qleft);
1ab3d87e
RS
11467 Qright = intern ("right");
11468 staticpro (&Qright);
f9942c9e
JB
11469 Qmouse_color = intern ("mouse-color");
11470 staticpro (&Qmouse_color);
baaed68e
JB
11471 Qnone = intern ("none");
11472 staticpro (&Qnone);
f9942c9e
JB
11473 Qparent_id = intern ("parent-id");
11474 staticpro (&Qparent_id);
4701395c
KH
11475 Qscroll_bar_width = intern ("scroll-bar-width");
11476 staticpro (&Qscroll_bar_width);
8af1d7ca
JB
11477 Qsuppress_icon = intern ("suppress-icon");
11478 staticpro (&Qsuppress_icon);
01f1ba30 11479 Qundefined_color = intern ("undefined-color");
f9942c9e 11480 staticpro (&Qundefined_color);
a3c87d4e
JB
11481 Qvertical_scroll_bars = intern ("vertical-scroll-bars");
11482 staticpro (&Qvertical_scroll_bars);
49795535
JB
11483 Qvisibility = intern ("visibility");
11484 staticpro (&Qvisibility);
f9942c9e
JB
11485 Qwindow_id = intern ("window-id");
11486 staticpro (&Qwindow_id);
2cbebefb
RS
11487 Qouter_window_id = intern ("outer-window-id");
11488 staticpro (&Qouter_window_id);
f9942c9e
JB
11489 Qx_frame_parameter = intern ("x-frame-parameter");
11490 staticpro (&Qx_frame_parameter);
9ef48a9d
RS
11491 Qx_resource_name = intern ("x-resource-name");
11492 staticpro (&Qx_resource_name);
4fe1de12
RS
11493 Quser_position = intern ("user-position");
11494 staticpro (&Quser_position);
11495 Quser_size = intern ("user-size");
11496 staticpro (&Quser_size);
333b20bb
GM
11497 Qscroll_bar_foreground = intern ("scroll-bar-foreground");
11498 staticpro (&Qscroll_bar_foreground);
11499 Qscroll_bar_background = intern ("scroll-bar-background");
11500 staticpro (&Qscroll_bar_background);
d62c8769
GM
11501 Qscreen_gamma = intern ("screen-gamma");
11502 staticpro (&Qscreen_gamma);
563b67aa
GM
11503 Qline_spacing = intern ("line-spacing");
11504 staticpro (&Qline_spacing);
7c7ff7f5
GM
11505 Qcenter = intern ("center");
11506 staticpro (&Qcenter);
96db09e4
KH
11507 Qcompound_text = intern ("compound-text");
11508 staticpro (&Qcompound_text);
ae782866
GM
11509 Qcancel_timer = intern ("cancel-timer");
11510 staticpro (&Qcancel_timer);
ea0a1f53
GM
11511 Qwait_for_wm = intern ("wait-for-wm");
11512 staticpro (&Qwait_for_wm);
f9942c9e
JB
11513 /* This is the end of symbol initialization. */
11514
58cad5ed
KH
11515 /* Text property `display' should be nonsticky by default. */
11516 Vtext_property_default_nonsticky
11517 = Fcons (Fcons (Qdisplay, Qt), Vtext_property_default_nonsticky);
11518
11519
333b20bb
GM
11520 Qlaplace = intern ("laplace");
11521 staticpro (&Qlaplace);
4a8e312c
GM
11522 Qemboss = intern ("emboss");
11523 staticpro (&Qemboss);
11524 Qedge_detection = intern ("edge-detection");
11525 staticpro (&Qedge_detection);
11526 Qheuristic = intern ("heuristic");
11527 staticpro (&Qheuristic);
11528 QCmatrix = intern (":matrix");
11529 staticpro (&QCmatrix);
11530 QCcolor_adjustment = intern (":color-adjustment");
11531 staticpro (&QCcolor_adjustment);
11532 QCmask = intern (":mask");
11533 staticpro (&QCmask);
11534
a367641f
RS
11535 Qface_set_after_frame_default = intern ("face-set-after-frame-default");
11536 staticpro (&Qface_set_after_frame_default);
11537
01f1ba30
JB
11538 Fput (Qundefined_color, Qerror_conditions,
11539 Fcons (Qundefined_color, Fcons (Qerror, Qnil)));
11540 Fput (Qundefined_color, Qerror_message,
11541 build_string ("Undefined color"));
11542
f9942c9e
JB
11543 init_x_parm_symbols ();
11544
14819cb3
GM
11545 DEFVAR_BOOL ("cross-disabled-images", &cross_disabled_images,
11546 "Non-nil means always draw a cross over disabled images.\n\
d2dc8167 11547Disabled images are those having an `:conversion disabled' property.\n\
14819cb3
GM
11548A cross is always drawn on black & white displays.");
11549 cross_disabled_images = 0;
11550
f1c7b5a6
RS
11551 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path,
11552 "List of directories to search for bitmap files for X.");
e241c09b 11553 Vx_bitmap_file_path = decode_env_path ((char *) 0, PATH_BITMAPS);
f1c7b5a6 11554
16ae08a9 11555 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape,
d387c960 11556 "The shape of the pointer when over text.\n\
af01ef26
RS
11557Changing the value does not affect existing frames\n\
11558unless you set the mouse color.");
01f1ba30
JB
11559 Vx_pointer_shape = Qnil;
11560
d387c960 11561 DEFVAR_LISP ("x-resource-name", &Vx_resource_name,
498e9ac3 11562 "The name Emacs uses to look up X resources.\n\
d387c960
JB
11563`x-get-resource' uses this as the first component of the instance name\n\
11564when requesting resource values.\n\
11565Emacs initially sets `x-resource-name' to the name under which Emacs\n\
11566was invoked, or to the value specified with the `-name' or `-rn'\n\
498e9ac3
RS
11567switches, if present.\n\
11568\n\
11569It may be useful to bind this variable locally around a call\n\
11570to `x-get-resource'. See also the variable `x-resource-class'.");
d387c960 11571 Vx_resource_name = Qnil;
ac63d3d6 11572
498e9ac3
RS
11573 DEFVAR_LISP ("x-resource-class", &Vx_resource_class,
11574 "The class Emacs uses to look up X resources.\n\
11575`x-get-resource' uses this as the first component of the instance class\n\
11576when requesting resource values.\n\
11577Emacs initially sets `x-resource-class' to \"Emacs\".\n\
11578\n\
11579Setting this variable permanently is not a reasonable thing to do,\n\
11580but binding this variable locally around a call to `x-get-resource'\n\
333b20bb 11581is a reasonable practice. See also the variable `x-resource-name'.");
498e9ac3
RS
11582 Vx_resource_class = build_string (EMACS_CLASS);
11583
ca0ecbf5 11584#if 0 /* This doesn't really do anything. */
d3b06468 11585 DEFVAR_LISP ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape,
ca0ecbf5
RS
11586 "The shape of the pointer when not over text.\n\
11587This variable takes effect when you create a new frame\n\
11588or when you set the mouse color.");
af01ef26 11589#endif
01f1ba30
JB
11590 Vx_nontext_pointer_shape = Qnil;
11591
0af913d7 11592 DEFVAR_LISP ("x-hourglass-pointer-shape", &Vx_hourglass_pointer_shape,
333b20bb
GM
11593 "The shape of the pointer when Emacs is busy.\n\
11594This variable takes effect when you create a new frame\n\
11595or when you set the mouse color.");
0af913d7 11596 Vx_hourglass_pointer_shape = Qnil;
333b20bb 11597
0af913d7
GM
11598 DEFVAR_BOOL ("display-hourglass", &display_hourglass_p,
11599 "Non-zero means Emacs displays an hourglass pointer on window systems.");
11600 display_hourglass_p = 1;
333b20bb 11601
0af913d7
GM
11602 DEFVAR_LISP ("hourglass-delay", &Vhourglass_delay,
11603 "*Seconds to wait before displaying an hourglass pointer.\n\
3caa99d3 11604Value must be an integer or float.");
0af913d7 11605 Vhourglass_delay = make_number (DEFAULT_HOURGLASS_DELAY);
4ae9a85e 11606
ca0ecbf5 11607#if 0 /* This doesn't really do anything. */
d3b06468 11608 DEFVAR_LISP ("x-mode-pointer-shape", &Vx_mode_pointer_shape,
ca0ecbf5
RS
11609 "The shape of the pointer when over the mode line.\n\
11610This variable takes effect when you create a new frame\n\
11611or when you set the mouse color.");
af01ef26 11612#endif
01f1ba30
JB
11613 Vx_mode_pointer_shape = Qnil;
11614
d3b06468 11615 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
ca0ecbf5
RS
11616 &Vx_sensitive_text_pointer_shape,
11617 "The shape of the pointer when over mouse-sensitive text.\n\
11618This variable takes effect when you create a new frame\n\
11619or when you set the mouse color.");
11620 Vx_sensitive_text_pointer_shape = Qnil;
95f80c78 11621
8fb4ec9c
GM
11622 DEFVAR_LISP ("x-window-horizontal-drag-cursor",
11623 &Vx_window_horizontal_drag_shape,
11624 "Pointer shape to use for indicating a window can be dragged horizontally.\n\
11625This variable takes effect when you create a new frame\n\
11626or when you set the mouse color.");
11627 Vx_window_horizontal_drag_shape = Qnil;
11628
01f1ba30
JB
11629 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel,
11630 "A string indicating the foreground color of the cursor box.");
11631 Vx_cursor_fore_pixel = Qnil;
11632
d63931a2
GM
11633 DEFVAR_LISP ("x-max-tooltip-size", &Vx_max_tooltip_size,
11634 "Maximum size for tooltips. Value is a pair (COLUMNS . ROWS).\n\
11635Text larger than this is clipped.");
11636 Vx_max_tooltip_size = Fcons (make_number (80), make_number (40));
11637
01f1ba30 11638 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager,
2d38195d
RS
11639 "Non-nil if no X window manager is in use.\n\
11640Emacs doesn't try to figure this out; this is always nil\n\
11641unless you set it to something else.");
11642 /* We don't have any way to find this out, so set it to nil
11643 and maybe the user would like to set it to t. */
11644 Vx_no_window_manager = Qnil;
1d3dac41 11645
942ea06d
KH
11646 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
11647 &Vx_pixel_size_width_font_regexp,
11648 "Regexp matching a font name whose width is the same as `PIXEL_SIZE'.\n\
11649\n\
dcc13cda 11650Since Emacs gets width of a font matching with this regexp from\n\
942ea06d
KH
11651PIXEL_SIZE field of the name, font finding mechanism gets faster for\n\
11652such a font. This is especially effective for such large fonts as\n\
11653Chinese, Japanese, and Korean.");
11654 Vx_pixel_size_width_font_regexp = Qnil;
11655
fcf431dc 11656 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay,
333b20bb
GM
11657 "Time after which cached images are removed from the cache.\n\
11658When an image has not been displayed this many seconds, remove it\n\
11659from the image cache. Value must be an integer or nil with nil\n\
11660meaning don't clear the cache.");
fcf431dc 11661 Vimage_cache_eviction_delay = make_number (30 * 60);
333b20bb 11662
1d3dac41 11663#ifdef USE_X_TOOLKIT
f1d238ef 11664 Fprovide (intern ("x-toolkit"));
fc2cdd9a 11665
5b827abb
KH
11666#ifdef USE_MOTIF
11667 Fprovide (intern ("motif"));
fc2cdd9a
GM
11668
11669 DEFVAR_LISP ("motif-version-string", &Vmotif_version_string,
11670 "Version info for LessTif/Motif.");
11671 Vmotif_version_string = build_string (XmVERSION_STRING);
11672#endif /* USE_MOTIF */
11673#endif /* USE_X_TOOLKIT */
01f1ba30 11674
01f1ba30 11675 defsubr (&Sx_get_resource);
333b20bb
GM
11676
11677 /* X window properties. */
11678 defsubr (&Sx_change_window_property);
11679 defsubr (&Sx_delete_window_property);
11680 defsubr (&Sx_window_property);
11681
2d764c78 11682 defsubr (&Sxw_display_color_p);
d0c9d219 11683 defsubr (&Sx_display_grayscale_p);
2d764c78
EZ
11684 defsubr (&Sxw_color_defined_p);
11685 defsubr (&Sxw_color_values);
9d317b2c 11686 defsubr (&Sx_server_max_request_size);
41beb8fc
RS
11687 defsubr (&Sx_server_vendor);
11688 defsubr (&Sx_server_version);
11689 defsubr (&Sx_display_pixel_width);
11690 defsubr (&Sx_display_pixel_height);
11691 defsubr (&Sx_display_mm_width);
11692 defsubr (&Sx_display_mm_height);
11693 defsubr (&Sx_display_screens);
11694 defsubr (&Sx_display_planes);
11695 defsubr (&Sx_display_color_cells);
11696 defsubr (&Sx_display_visual_class);
11697 defsubr (&Sx_display_backing_store);
11698 defsubr (&Sx_display_save_under);
8af1d7ca 11699 defsubr (&Sx_parse_geometry);
f676886a 11700 defsubr (&Sx_create_frame);
01f1ba30 11701 defsubr (&Sx_open_connection);
08a90d6a
RS
11702 defsubr (&Sx_close_connection);
11703 defsubr (&Sx_display_list);
01f1ba30 11704 defsubr (&Sx_synchronize);
3decc1e7 11705 defsubr (&Sx_focus_frame);
82bab41c
GM
11706 defsubr (&Sx_backspace_delete_keys_p);
11707
942ea06d
KH
11708 /* Setting callback functions for fontset handler. */
11709 get_font_info_func = x_get_font_info;
333b20bb
GM
11710
11711#if 0 /* This function pointer doesn't seem to be used anywhere.
11712 And the pointer assigned has the wrong type, anyway. */
942ea06d 11713 list_fonts_func = x_list_fonts;
333b20bb
GM
11714#endif
11715
942ea06d 11716 load_font_func = x_load_font;
bc1958c4 11717 find_ccl_program_func = x_find_ccl_program;
942ea06d
KH
11718 query_font_func = x_query_font;
11719 set_frame_fontset_func = x_set_font;
11720 check_window_system_func = check_x;
333b20bb
GM
11721
11722 /* Images. */
11723 Qxbm = intern ("xbm");
11724 staticpro (&Qxbm);
11725 QCtype = intern (":type");
11726 staticpro (&QCtype);
d2dc8167
GM
11727 QCconversion = intern (":conversion");
11728 staticpro (&QCconversion);
333b20bb
GM
11729 QCheuristic_mask = intern (":heuristic-mask");
11730 staticpro (&QCheuristic_mask);
11731 QCcolor_symbols = intern (":color-symbols");
11732 staticpro (&QCcolor_symbols);
333b20bb
GM
11733 QCascent = intern (":ascent");
11734 staticpro (&QCascent);
11735 QCmargin = intern (":margin");
11736 staticpro (&QCmargin);
11737 QCrelief = intern (":relief");
11738 staticpro (&QCrelief);
fcf431dc
GM
11739 Qpostscript = intern ("postscript");
11740 staticpro (&Qpostscript);
333b20bb
GM
11741 QCloader = intern (":loader");
11742 staticpro (&QCloader);
11743 QCbounding_box = intern (":bounding-box");
11744 staticpro (&QCbounding_box);
11745 QCpt_width = intern (":pt-width");
11746 staticpro (&QCpt_width);
11747 QCpt_height = intern (":pt-height");
11748 staticpro (&QCpt_height);
3ccff1e3
GM
11749 QCindex = intern (":index");
11750 staticpro (&QCindex);
333b20bb
GM
11751 Qpbm = intern ("pbm");
11752 staticpro (&Qpbm);
11753
11754#if HAVE_XPM
11755 Qxpm = intern ("xpm");
11756 staticpro (&Qxpm);
11757#endif
11758
11759#if HAVE_JPEG
11760 Qjpeg = intern ("jpeg");
11761 staticpro (&Qjpeg);
11762#endif
11763
11764#if HAVE_TIFF
11765 Qtiff = intern ("tiff");
11766 staticpro (&Qtiff);
11767#endif
11768
11769#if HAVE_GIF
11770 Qgif = intern ("gif");
11771 staticpro (&Qgif);
11772#endif
11773
11774#if HAVE_PNG
11775 Qpng = intern ("png");
11776 staticpro (&Qpng);
11777#endif
11778
11779 defsubr (&Sclear_image_cache);
42677916 11780 defsubr (&Simage_size);
b243755a 11781 defsubr (&Simage_mask_p);
333b20bb 11782
0af913d7
GM
11783 hourglass_atimer = NULL;
11784 hourglass_shown_p = 0;
333b20bb
GM
11785
11786 defsubr (&Sx_show_tip);
11787 defsubr (&Sx_hide_tip);
333b20bb 11788 tip_timer = Qnil;
44b5a125
GM
11789 staticpro (&tip_timer);
11790 tip_frame = Qnil;
11791 staticpro (&tip_frame);
333b20bb 11792
06d62053
GM
11793 last_show_tip_args = Qnil;
11794 staticpro (&last_show_tip_args);
11795
333b20bb
GM
11796#ifdef USE_MOTIF
11797 defsubr (&Sx_file_dialog);
11798#endif
11799}
11800
11801
11802void
11803init_xfns ()
11804{
11805 image_types = NULL;
11806 Vimage_types = Qnil;
11807
11808 define_image_type (&xbm_type);
11809 define_image_type (&gs_type);
11810 define_image_type (&pbm_type);
11811
11812#if HAVE_XPM
11813 define_image_type (&xpm_type);
11814#endif
11815
11816#if HAVE_JPEG
11817 define_image_type (&jpeg_type);
11818#endif
11819
11820#if HAVE_TIFF
11821 define_image_type (&tiff_type);
11822#endif
11823
11824#if HAVE_GIF
11825 define_image_type (&gif_type);
11826#endif
11827
11828#if HAVE_PNG
11829 define_image_type (&png_type);
11830#endif
01f1ba30
JB
11831}
11832
11833#endif /* HAVE_X_WINDOWS */