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