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