HCoop / bpt / emacs.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
(struct image): Add `background', `background_valid', and
[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
GM		 4982 for (i = 0; i < dpy->nscreens; ++i)
4983 if (scr == dpy->screens[i])
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
5771
333b20bb
GM		 5772\f
5773/***********************************************************************
5774 Helper functions for X image types
5775 ***********************************************************************/
5776
dd00328a
GM		 5777static void x_clear_image_1 P_ ((struct frame *, struct image *, int,
5778 int, int));
333b20bb
GM		 5779static void x_clear_image P_ ((struct frame *f, struct image *img));
5780static unsigned long x_alloc_image_color P_ ((struct frame *f,
5781 struct image *img,
5782 Lisp_Object color_name,
5783 unsigned long dflt));
5784
dd00328a
GM		 5785
5786/* Clear X resources of image IMG on frame F. PIXMAP_P non-zero means
5787 free the pixmap if any. MASK_P non-zero means clear the mask
5788 pixmap if any. COLORS_P non-zero means free colors allocated for
5789 the image, if any. */
333b20bb
GM		 5790
5791static void
dd00328a 5792x_clear_image_1 (f, img, pixmap_p, mask_p, colors_p)
333b20bb
GM		 5793 struct frame *f;
5794 struct image *img;
dd00328a 5795 int pixmap_p, mask_p, colors_p;
333b20bb 5796{
dd00328a 5797 if (pixmap_p && img->pixmap)
333b20bb 5798 {
333b20bb 5799 XFreePixmap (FRAME_X_DISPLAY (f), img->pixmap);
dd00328a 5800 img->pixmap = None;
f4779de9
GM		 5801 }
5802
dd00328a 5803 if (mask_p && img->mask)
f4779de9
GM		 5804 {
5805 XFreePixmap (FRAME_X_DISPLAY (f), img->mask);
dd00328a 5806 img->mask = None;
333b20bb
GM		 5807 }
5808
dd00328a 5809 if (colors_p && img->ncolors)
333b20bb 5810 {
462d5d40 5811 x_free_colors (f, img->colors, img->ncolors);
333b20bb
GM		 5812 xfree (img->colors);
5813 img->colors = NULL;
5814 img->ncolors = 0;
5815 }
dd00328a
GM		 5816}
5817
5818/* Free X resources of image IMG which is used on frame F. */
5819
5820static void
5821x_clear_image (f, img)
5822 struct frame *f;
5823 struct image *img;
5824{
5825 BLOCK_INPUT;
5826 x_clear_image_1 (f, img, 1, 1, 1);
f4779de9 5827 UNBLOCK_INPUT;
333b20bb
GM		 5828}
5829
5830
5831/* Allocate color COLOR_NAME for image IMG on frame F. If color
5832 cannot be allocated, use DFLT. Add a newly allocated color to
5833 IMG->colors, so that it can be freed again. Value is the pixel
5834 color. */
5835
5836static unsigned long
5837x_alloc_image_color (f, img, color_name, dflt)
5838 struct frame *f;
5839 struct image *img;
5840 Lisp_Object color_name;
5841 unsigned long dflt;
5842{
5843 XColor color;
5844 unsigned long result;
5845
5846 xassert (STRINGP (color_name));
5847
2d764c78 5848 if (x_defined_color (f, XSTRING (color_name)->data, &color, 1))
333b20bb
GM		 5849 {
5850 /* This isn't called frequently so we get away with simply
5851 reallocating the color vector to the needed size, here. */
5852 ++img->ncolors;
5853 img->colors =
5854 (unsigned long *) xrealloc (img->colors,
5855 img->ncolors * sizeof *img->colors);
5856 img->colors[img->ncolors - 1] = color.pixel;
5857 result = color.pixel;
5858 }
5859 else
5860 result = dflt;
5861
5862 return result;
5863}
5864
5865
5866\f
5867/***********************************************************************
5868 Image Cache
5869 ***********************************************************************/
5870
5871static void cache_image P_ ((struct frame *f, struct image *img));
ad18ffb1 5872static void postprocess_image P_ ((struct frame *, struct image *));
333b20bb
GM		 5873
5874
5875/* Return a new, initialized image cache that is allocated from the
5876 heap. Call free_image_cache to free an image cache. */
5877
5878struct image_cache *
5879make_image_cache ()
5880{
5881 struct image_cache *c = (struct image_cache *) xmalloc (sizeof *c);
5882 int size;
5883
5884 bzero (c, sizeof *c);
5885 c->size = 50;
5886 c->images = (struct image **) xmalloc (c->size * sizeof *c->images);
5887 size = IMAGE_CACHE_BUCKETS_SIZE * sizeof *c->buckets;
5888 c->buckets = (struct image **) xmalloc (size);
5889 bzero (c->buckets, size);
5890 return c;
5891}
5892
5893
5894/* Free image cache of frame F. Be aware that X frames share images
5895 caches. */
5896
5897void
5898free_image_cache (f)
5899 struct frame *f;
5900{
5901 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
5902 if (c)
5903 {
5904 int i;
5905
5906 /* Cache should not be referenced by any frame when freed. */
5907 xassert (c->refcount == 0);
5908
5909 for (i = 0; i < c->used; ++i)
5910 free_image (f, c->images[i]);
5911 xfree (c->images);
333b20bb 5912 xfree (c->buckets);
e3130015 5913 xfree (c);
333b20bb
GM		 5914 FRAME_X_IMAGE_CACHE (f) = NULL;
5915 }
5916}
5917
5918
5919/* Clear image cache of frame F. FORCE_P non-zero means free all
5920 images. FORCE_P zero means clear only images that haven't been
5921 displayed for some time. Should be called from time to time to
5922 reduce the number of loaded images. If image-eviction-seconds is
5923 non-nil, this frees images in the cache which weren't displayed for
5924 at least that many seconds. */
5925
5926void
5927clear_image_cache (f, force_p)
5928 struct frame *f;
5929 int force_p;
5930{
5931 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
5932
83676598 5933 if (c && INTEGERP (Vimage_cache_eviction_delay))
333b20bb
GM		 5934 {
5935 EMACS_TIME t;
5936 unsigned long old;
f4779de9 5937 int i, nfreed;
333b20bb
GM		 5938
5939 EMACS_GET_TIME (t);
fcf431dc 5940 old = EMACS_SECS (t) - XFASTINT (Vimage_cache_eviction_delay);
f4779de9
GM		 5941
5942 /* Block input so that we won't be interrupted by a SIGIO
5943 while being in an inconsistent state. */
5944 BLOCK_INPUT;
333b20bb 5945
f4779de9 5946 for (i = nfreed = 0; i < c->used; ++i)
333b20bb
GM		 5947 {
5948 struct image *img = c->images[i];
5949 if (img != NULL
f4779de9 5950 && (force_p || img->timestamp < old))
333b20bb
GM		 5951 {
5952 free_image (f, img);
f4779de9 5953 ++nfreed;
333b20bb
GM		 5954 }
5955 }
5956
5957 /* We may be clearing the image cache because, for example,
5958 Emacs was iconified for a longer period of time. In that
5959 case, current matrices may still contain references to
5960 images freed above. So, clear these matrices. */
f4779de9 5961 if (nfreed)
333b20bb 5962 {
f4779de9
GM		 5963 Lisp_Object tail, frame;
5964
5965 FOR_EACH_FRAME (tail, frame)
5966 {
5967 struct frame *f = XFRAME (frame);
5968 if (FRAME_X_P (f)
5969 && FRAME_X_IMAGE_CACHE (f) == c)
83676598 5970 clear_current_matrices (f);
f4779de9
GM		 5971 }
5972
333b20bb
GM		 5973 ++windows_or_buffers_changed;
5974 }
f4779de9
GM		 5975
5976 UNBLOCK_INPUT;
333b20bb
GM		 5977 }
5978}
5979
5980
5981DEFUN ("clear-image-cache", Fclear_image_cache, Sclear_image_cache,
5982 0, 1, 0,
7ee72033 5983 doc: /* Clear the image cache of FRAME.
c061c855 5984FRAME nil or omitted means use the selected frame.
7ee72033
MB		 5985FRAME t means clear the image caches of all frames. */)
5986 (frame)
333b20bb
GM		 5987 Lisp_Object frame;
5988{
5989 if (EQ (frame, Qt))
5990 {
5991 Lisp_Object tail;
5992
5993 FOR_EACH_FRAME (tail, frame)
5994 if (FRAME_X_P (XFRAME (frame)))
5995 clear_image_cache (XFRAME (frame), 1);
5996 }
5997 else
5998 clear_image_cache (check_x_frame (frame), 1);
5999
6000 return Qnil;
6001}
6002
6003
ad18ffb1
GM		 6004/* Compute masks and transform image IMG on frame F, as specified
6005 by the image's specification, */
6006
6007static void
6008postprocess_image (f, img)
6009 struct frame *f;
6010 struct image *img;
6011{
6012 /* Manipulation of the image's mask. */
6013 if (img->pixmap)
6014 {
6015 Lisp_Object conversion, spec;
6016 Lisp_Object mask;
6017
6018 spec = img->spec;
6019
6020 /* `:heuristic-mask t'
6021 `:mask heuristic'
6022 means build a mask heuristically.
6023 `:heuristic-mask (R G B)'
6024 `:mask (heuristic (R G B))'
6025 means build a mask from color (R G B) in the
6026 image.
6027 `:mask nil'
6028 means remove a mask, if any. */
6029
6030 mask = image_spec_value (spec, QCheuristic_mask, NULL);
6031 if (!NILP (mask))
6032 x_build_heuristic_mask (f, img, mask);
6033 else
6034 {
6035 int found_p;
6036
6037 mask = image_spec_value (spec, QCmask, &found_p);
6038
6039 if (EQ (mask, Qheuristic))
6040 x_build_heuristic_mask (f, img, Qt);
6041 else if (CONSP (mask)
6042 && EQ (XCAR (mask), Qheuristic))
6043 {
6044 if (CONSP (XCDR (mask)))
6045 x_build_heuristic_mask (f, img, XCAR (XCDR (mask)));
6046 else
6047 x_build_heuristic_mask (f, img, XCDR (mask));
6048 }
6049 else if (NILP (mask) && found_p && img->mask)
6050 {
6051 XFreePixmap (FRAME_X_DISPLAY (f), img->mask);
6052 img->mask = None;
6053 }
6054 }
6055
6056
6057 /* Should we apply an image transformation algorithm? */
6058 conversion = image_spec_value (spec, QCconversion, NULL);
6059 if (EQ (conversion, Qdisabled))
6060 x_disable_image (f, img);
6061 else if (EQ (conversion, Qlaplace))
6062 x_laplace (f, img);
6063 else if (EQ (conversion, Qemboss))
6064 x_emboss (f, img);
6065 else if (CONSP (conversion)
6066 && EQ (XCAR (conversion), Qedge_detection))
6067 {
6068 Lisp_Object tem;
6069 tem = XCDR (conversion);
6070 if (CONSP (tem))
6071 x_edge_detection (f, img,
6072 Fplist_get (tem, QCmatrix),
6073 Fplist_get (tem, QCcolor_adjustment));
6074 }
6075 }
6076}
6077
6078
333b20bb 6079/* Return the id of image with Lisp specification SPEC on frame F.
83676598 6080 SPEC must be a valid Lisp image specification (see valid_image_p). */
333b20bb
GM		 6081
6082int
83676598 6083lookup_image (f, spec)
333b20bb
GM		 6084 struct frame *f;
6085 Lisp_Object spec;
6086{
6087 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
6088 struct image *img;
6089 int i;
6090 unsigned hash;
6091 struct gcpro gcpro1;
4f7ca1f1 6092 EMACS_TIME now;
333b20bb
GM		 6093
6094 /* F must be a window-system frame, and SPEC must be a valid image
6095 specification. */
6096 xassert (FRAME_WINDOW_P (f));
6097 xassert (valid_image_p (spec));
6098
6099 GCPRO1 (spec);
6100
6101 /* Look up SPEC in the hash table of the image cache. */
6102 hash = sxhash (spec, 0);
6103 i = hash % IMAGE_CACHE_BUCKETS_SIZE;
6104
6105 for (img = c->buckets[i]; img; img = img->next)
6106 if (img->hash == hash && !NILP (Fequal (img->spec, spec)))
6107 break;
6108
6109 /* If not found, create a new image and cache it. */
6110 if (img == NULL)
6111 {
ad18ffb1
GM		 6112 extern Lisp_Object Qpostscript;
6113
28c7826c 6114 BLOCK_INPUT;
333b20bb
GM		 6115 img = make_image (spec, hash);
6116 cache_image (f, img);
83676598 6117 img->load_failed_p = img->type->load (f, img) == 0;
333b20bb
GM		 6118
6119 /* If we can't load the image, and we don't have a width and
6120 height, use some arbitrary width and height so that we can
6121 draw a rectangle for it. */
83676598 6122 if (img->load_failed_p)
333b20bb
GM		 6123 {
6124 Lisp_Object value;
6125
6126 value = image_spec_value (spec, QCwidth, NULL);
6127 img->width = (INTEGERP (value)
6128 ? XFASTINT (value) : DEFAULT_IMAGE_WIDTH);
6129 value = image_spec_value (spec, QCheight, NULL);
6130 img->height = (INTEGERP (value)
6131 ? XFASTINT (value) : DEFAULT_IMAGE_HEIGHT);
6132 }
6133 else
6134 {
6135 /* Handle image type independent image attributes
7c7ff7f5 6136 `:ascent ASCENT', `:margin MARGIN', `:relief RELIEF'. */
14819cb3 6137 Lisp_Object ascent, margin, relief;
333b20bb
GM		 6138
6139 ascent = image_spec_value (spec, QCascent, NULL);
6140 if (INTEGERP (ascent))
6141 img->ascent = XFASTINT (ascent);
7c7ff7f5
GM		 6142 else if (EQ (ascent, Qcenter))
6143 img->ascent = CENTERED_IMAGE_ASCENT;
333b20bb
GM		 6144
6145 margin = image_spec_value (spec, QCmargin, NULL);
6146 if (INTEGERP (margin) && XINT (margin) >= 0)
3ed61e75
GM		 6147 img->vmargin = img->hmargin = XFASTINT (margin);
6148 else if (CONSP (margin) && INTEGERP (XCAR (margin))
6149 && INTEGERP (XCDR (margin)))
6150 {
6151 if (XINT (XCAR (margin)) > 0)
6152 img->hmargin = XFASTINT (XCAR (margin));
6153 if (XINT (XCDR (margin)) > 0)
6154 img->vmargin = XFASTINT (XCDR (margin));
6155 }
333b20bb
GM		 6156
6157 relief = image_spec_value (spec, QCrelief, NULL);
6158 if (INTEGERP (relief))
6159 {
6160 img->relief = XINT (relief);
3ed61e75
GM		 6161 img->hmargin += abs (img->relief);
6162 img->vmargin += abs (img->relief);
333b20bb
GM		 6163 }
6164
ad18ffb1
GM		 6165 /* Do image transformations and compute masks, unless we
6166 don't have the image yet. */
6167 if (!EQ (*img->type->type, Qpostscript))
6168 postprocess_image (f, img);
333b20bb 6169 }
dd00328a 6170
28c7826c
GM		 6171 UNBLOCK_INPUT;
6172 xassert (!interrupt_input_blocked);
333b20bb
GM		 6173 }
6174
4f7ca1f1
GM		 6175 /* We're using IMG, so set its timestamp to `now'. */
6176 EMACS_GET_TIME (now);
6177 img->timestamp = EMACS_SECS (now);
6178
333b20bb
GM		 6179 UNGCPRO;
6180
6181 /* Value is the image id. */
6182 return img->id;
6183}
6184
6185
6186/* Cache image IMG in the image cache of frame F. */
6187
6188static void
6189cache_image (f, img)
6190 struct frame *f;
6191 struct image *img;
6192{
6193 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
6194 int i;
6195
6196 /* Find a free slot in c->images. */
6197 for (i = 0; i < c->used; ++i)
6198 if (c->images[i] == NULL)
6199 break;
6200
6201 /* If no free slot found, maybe enlarge c->images. */
6202 if (i == c->used && c->used == c->size)
6203 {
6204 c->size *= 2;
6205 c->images = (struct image **) xrealloc (c->images,
6206 c->size * sizeof *c->images);
6207 }
6208
6209 /* Add IMG to c->images, and assign IMG an id. */
6210 c->images[i] = img;
6211 img->id = i;
6212 if (i == c->used)
6213 ++c->used;
6214
6215 /* Add IMG to the cache's hash table. */
6216 i = img->hash % IMAGE_CACHE_BUCKETS_SIZE;
6217 img->next = c->buckets[i];
6218 if (img->next)
6219 img->next->prev = img;
6220 img->prev = NULL;
6221 c->buckets[i] = img;
6222}
6223
6224
6225/* Call FN on every image in the image cache of frame F. Used to mark
6226 Lisp Objects in the image cache. */
6227
6228void
6229forall_images_in_image_cache (f, fn)
6230 struct frame *f;
6231 void (*fn) P_ ((struct image *img));
6232{
6233 if (FRAME_LIVE_P (f) && FRAME_X_P (f))
6234 {
6235 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
6236 if (c)
6237 {
6238 int i;
6239 for (i = 0; i < c->used; ++i)
6240 if (c->images[i])
6241 fn (c->images[i]);
6242 }
6243 }
6244}
6245
6246
6247\f
6248/***********************************************************************
6249 X support code
6250 ***********************************************************************/
6251
45158a91
GM		 6252static int x_create_x_image_and_pixmap P_ ((struct frame *, int, int, int,
6253 XImage **, Pixmap *));
333b20bb
GM		 6254static void x_destroy_x_image P_ ((XImage *));
6255static void x_put_x_image P_ ((struct frame *, XImage *, Pixmap, int, int));
6256
6257
6258/* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
6259 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
6260 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
6261 via xmalloc. Print error messages via image_error if an error
45158a91 6262 occurs. Value is non-zero if successful. */
333b20bb
GM		 6263
6264static int
45158a91 6265x_create_x_image_and_pixmap (f, width, height, depth, ximg, pixmap)
333b20bb 6266 struct frame *f;
333b20bb
GM		 6267 int width, height, depth;
6268 XImage **ximg;
6269 Pixmap *pixmap;
6270{
6271 Display *display = FRAME_X_DISPLAY (f);
6272 Screen *screen = FRAME_X_SCREEN (f);
6273 Window window = FRAME_X_WINDOW (f);
6274
6275 xassert (interrupt_input_blocked);
6276
6277 if (depth <= 0)
6278 depth = DefaultDepthOfScreen (screen);
6279 *ximg = XCreateImage (display, DefaultVisualOfScreen (screen),
6280 depth, ZPixmap, 0, NULL, width, height,
6281 depth > 16 ? 32 : depth > 8 ? 16 : 8, 0);
6282 if (*ximg == NULL)
6283 {
45158a91 6284 image_error ("Unable to allocate X image", Qnil, Qnil);
333b20bb
GM		 6285 return 0;
6286 }
6287
6288 /* Allocate image raster. */
6289 (*ximg)->data = (char *) xmalloc ((*ximg)->bytes_per_line * height);
6290
6291 /* Allocate a pixmap of the same size. */
6292 *pixmap = XCreatePixmap (display, window, width, height, depth);
dd00328a 6293 if (*pixmap == None)
333b20bb
GM		 6294 {
6295 x_destroy_x_image (*ximg);
6296 *ximg = NULL;
45158a91 6297 image_error ("Unable to create X pixmap", Qnil, Qnil);
333b20bb
GM		 6298 return 0;
6299 }
6300
6301 return 1;
6302}
6303
6304
6305/* Destroy XImage XIMG. Free XIMG->data. */
6306
6307static void
6308x_destroy_x_image (ximg)
6309 XImage *ximg;
6310{
6311 xassert (interrupt_input_blocked);
6312 if (ximg)
6313 {
6314 xfree (ximg->data);
6315 ximg->data = NULL;
6316 XDestroyImage (ximg);
6317 }
6318}
6319
6320
6321/* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
6322 are width and height of both the image and pixmap. */
6323
ea6b19ca 6324static void
333b20bb
GM		 6325x_put_x_image (f, ximg, pixmap, width, height)
6326 struct frame *f;
6327 XImage *ximg;
6328 Pixmap pixmap;
6329{
6330 GC gc;
6331
6332 xassert (interrupt_input_blocked);
6333 gc = XCreateGC (FRAME_X_DISPLAY (f), pixmap, 0, NULL);
6334 XPutImage (FRAME_X_DISPLAY (f), pixmap, gc, ximg, 0, 0, 0, 0, width, height);
6335 XFreeGC (FRAME_X_DISPLAY (f), gc);
6336}
6337
6338
6339\f
6340/***********************************************************************
5be6c3b0 6341 File Handling
333b20bb
GM		 6342 ***********************************************************************/
6343
6344static Lisp_Object x_find_image_file P_ ((Lisp_Object));
5be6c3b0
GM		 6345static char *slurp_file P_ ((char *, int *));
6346
333b20bb
GM		 6347
6348/* Find image file FILE. Look in data-directory, then
6349 x-bitmap-file-path. Value is the full name of the file found, or
6350 nil if not found. */
6351
6352static Lisp_Object
6353x_find_image_file (file)
6354 Lisp_Object file;
6355{
6356 Lisp_Object file_found, search_path;
6357 struct gcpro gcpro1, gcpro2;
6358 int fd;
6359
6360 file_found = Qnil;
6361 search_path = Fcons (Vdata_directory, Vx_bitmap_file_path);
6362 GCPRO2 (file_found, search_path);
6363
6364 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
c0ec53ad 6365 fd = openp (search_path, file, Qnil, &file_found, 0);
333b20bb 6366
939d6465 6367 if (fd == -1)
333b20bb
GM		 6368 file_found = Qnil;
6369 else
6370 close (fd);
6371
6372 UNGCPRO;
6373 return file_found;
6374}
6375
6376
5be6c3b0
GM		 6377/* Read FILE into memory. Value is a pointer to a buffer allocated
6378 with xmalloc holding FILE's contents. Value is null if an error
b243755a 6379 occurred. *SIZE is set to the size of the file. */
5be6c3b0
GM		 6380
6381static char *
6382slurp_file (file, size)
6383 char *file;
6384 int *size;
6385{
6386 FILE *fp = NULL;
6387 char *buf = NULL;
6388 struct stat st;
6389
6390 if (stat (file, &st) == 0
6391 && (fp = fopen (file, "r")) != NULL
6392 && (buf = (char *) xmalloc (st.st_size),
6393 fread (buf, 1, st.st_size, fp) == st.st_size))
6394 {
6395 *size = st.st_size;
6396 fclose (fp);
6397 }
6398 else
6399 {
6400 if (fp)
6401 fclose (fp);
6402 if (buf)
6403 {
6404 xfree (buf);
6405 buf = NULL;
6406 }
6407 }
6408
6409 return buf;
6410}
6411
6412
333b20bb
GM		 6413\f
6414/***********************************************************************
6415 XBM images
6416 ***********************************************************************/
6417
5be6c3b0 6418static int xbm_scan P_ ((char **, char *, char *, int *));
333b20bb 6419static int xbm_load P_ ((struct frame *f, struct image *img));
5be6c3b0
GM		 6420static int xbm_load_image P_ ((struct frame *f, struct image *img,
6421 char *, char *));
333b20bb 6422static int xbm_image_p P_ ((Lisp_Object object));
5be6c3b0
GM		 6423static int xbm_read_bitmap_data P_ ((char *, char *, int *, int *,
6424 unsigned char **));
6425static int xbm_file_p P_ ((Lisp_Object));
333b20bb
GM		 6426
6427
6428/* Indices of image specification fields in xbm_format, below. */
6429
6430enum xbm_keyword_index
6431{
6432 XBM_TYPE,
6433 XBM_FILE,
6434 XBM_WIDTH,
6435 XBM_HEIGHT,
6436 XBM_DATA,
6437 XBM_FOREGROUND,
6438 XBM_BACKGROUND,
6439 XBM_ASCENT,
6440 XBM_MARGIN,
6441 XBM_RELIEF,
6442 XBM_ALGORITHM,
6443 XBM_HEURISTIC_MASK,
4a8e312c 6444 XBM_MASK,
333b20bb
GM		 6445 XBM_LAST
6446};
6447
6448/* Vector of image_keyword structures describing the format
6449 of valid XBM image specifications. */
6450
6451static struct image_keyword xbm_format[XBM_LAST] =
6452{
6453 {":type", IMAGE_SYMBOL_VALUE, 1},
6454 {":file", IMAGE_STRING_VALUE, 0},
6455 {":width", IMAGE_POSITIVE_INTEGER_VALUE, 0},
6456 {":height", IMAGE_POSITIVE_INTEGER_VALUE, 0},
6457 {":data", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6f1be3b9
GM		 6458 {":foreground", IMAGE_STRING_OR_NIL_VALUE, 0},
6459 {":background", IMAGE_STRING_OR_NIL_VALUE, 0},
7c7ff7f5 6460 {":ascent", IMAGE_ASCENT_VALUE, 0},
3ed61e75 6461 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
333b20bb 6462 {":relief", IMAGE_INTEGER_VALUE, 0},
d2dc8167 6463 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
4a8e312c
GM		 6464 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6465 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
333b20bb
GM		 6466};
6467
6468/* Structure describing the image type XBM. */
6469
6470static struct image_type xbm_type =
6471{
6472 &Qxbm,
6473 xbm_image_p,
6474 xbm_load,
6475 x_clear_image,
6476 NULL
6477};
6478
6479/* Tokens returned from xbm_scan. */
6480
6481enum xbm_token
6482{
6483 XBM_TK_IDENT = 256,
6484 XBM_TK_NUMBER
6485};
6486
6487
6488/* Return non-zero if OBJECT is a valid XBM-type image specification.
6489 A valid specification is a list starting with the symbol `image'
6490 The rest of the list is a property list which must contain an
6491 entry `:type xbm..
6492
6493 If the specification specifies a file to load, it must contain
6494 an entry `:file FILENAME' where FILENAME is a string.
6495
6496 If the specification is for a bitmap loaded from memory it must
6497 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
6498 WIDTH and HEIGHT are integers > 0. DATA may be:
6499
6500 1. a string large enough to hold the bitmap data, i.e. it must
6501 have a size >= (WIDTH + 7) / 8 * HEIGHT
6502
6503 2. a bool-vector of size >= WIDTH * HEIGHT
6504
6505 3. a vector of strings or bool-vectors, one for each line of the
6506 bitmap.
6507
5be6c3b0
GM		 6508 4. A string containing an in-memory XBM file. WIDTH and HEIGHT
6509 may not be specified in this case because they are defined in the
6510 XBM file.
6511
333b20bb
GM		 6512 Both the file and data forms may contain the additional entries
6513 `:background COLOR' and `:foreground COLOR'. If not present,
6514 foreground and background of the frame on which the image is
e3130015 6515 displayed is used. */
333b20bb
GM		 6516
6517static int
6518xbm_image_p (object)
6519 Lisp_Object object;
6520{
6521 struct image_keyword kw[XBM_LAST];
6522
6523 bcopy (xbm_format, kw, sizeof kw);
bfd2209f 6524 if (!parse_image_spec (object, kw, XBM_LAST, Qxbm))
333b20bb
GM		 6525 return 0;
6526
6527 xassert (EQ (kw[XBM_TYPE].value, Qxbm));
6528
6529 if (kw[XBM_FILE].count)
6530 {
6531 if (kw[XBM_WIDTH].count || kw[XBM_HEIGHT].count || kw[XBM_DATA].count)
6532 return 0;
6533 }
5be6c3b0
GM		 6534 else if (kw[XBM_DATA].count && xbm_file_p (kw[XBM_DATA].value))
6535 {
6536 /* In-memory XBM file. */
6537 if (kw[XBM_WIDTH].count || kw[XBM_HEIGHT].count || kw[XBM_FILE].count)
6538 return 0;
6539 }
333b20bb
GM		 6540 else
6541 {
6542 Lisp_Object data;
6543 int width, height;
6544
6545 /* Entries for `:width', `:height' and `:data' must be present. */
6546 if (!kw[XBM_WIDTH].count
6547 || !kw[XBM_HEIGHT].count
6548 || !kw[XBM_DATA].count)
6549 return 0;
6550
6551 data = kw[XBM_DATA].value;
6552 width = XFASTINT (kw[XBM_WIDTH].value);
6553 height = XFASTINT (kw[XBM_HEIGHT].value);
6554
6555 /* Check type of data, and width and height against contents of
6556 data. */
6557 if (VECTORP (data))
6558 {
6559 int i;
6560
6561 /* Number of elements of the vector must be >= height. */
6562 if (XVECTOR (data)->size < height)
6563 return 0;
6564
6565 /* Each string or bool-vector in data must be large enough
6566 for one line of the image. */
6567 for (i = 0; i < height; ++i)
6568 {
6569 Lisp_Object elt = XVECTOR (data)->contents[i];
6570
6571 if (STRINGP (elt))
6572 {
6573 if (XSTRING (elt)->size
6574 < (width + BITS_PER_CHAR - 1) / BITS_PER_CHAR)
6575 return 0;
6576 }
6577 else if (BOOL_VECTOR_P (elt))
6578 {
6579 if (XBOOL_VECTOR (elt)->size < width)
6580 return 0;
6581 }
6582 else
6583 return 0;
6584 }
6585 }
6586 else if (STRINGP (data))
6587 {
6588 if (XSTRING (data)->size
6589 < (width + BITS_PER_CHAR - 1) / BITS_PER_CHAR * height)
6590 return 0;
6591 }
6592 else if (BOOL_VECTOR_P (data))
6593 {
6594 if (XBOOL_VECTOR (data)->size < width * height)
6595 return 0;
6596 }
6597 else
6598 return 0;
6599 }
6600
333b20bb
GM		 6601 return 1;
6602}
6603
6604
6605/* Scan a bitmap file. FP is the stream to read from. Value is
6606 either an enumerator from enum xbm_token, or a character for a
6607 single-character token, or 0 at end of file. If scanning an
6608 identifier, store the lexeme of the identifier in SVAL. If
6609 scanning a number, store its value in *IVAL. */
6610
6611static int
5be6c3b0
GM		 6612xbm_scan (s, end, sval, ival)
6613 char **s, *end;
333b20bb
GM		 6614 char *sval;
6615 int *ival;
6616{
6617 int c;
0a695da7
GM		 6618
6619 loop:
333b20bb
GM		 6620
6621 /* Skip white space. */
5be6c3b0 6622 while (*s < end && (c = *(*s)++, isspace (c)))
333b20bb
GM		 6623 ;
6624
5be6c3b0 6625 if (*s >= end)
333b20bb
GM		 6626 c = 0;
6627 else if (isdigit (c))
6628 {
6629 int value = 0, digit;
6630
5be6c3b0 6631 if (c == '0' && *s < end)
333b20bb 6632 {
5be6c3b0 6633 c = *(*s)++;
333b20bb
GM		 6634 if (c == 'x' || c == 'X')
6635 {
5be6c3b0 6636 while (*s < end)
333b20bb 6637 {
5be6c3b0 6638 c = *(*s)++;
333b20bb
GM		 6639 if (isdigit (c))
6640 digit = c - '0';
6641 else if (c >= 'a' && c <= 'f')
6642 digit = c - 'a' + 10;
6643 else if (c >= 'A' && c <= 'F')
6644 digit = c - 'A' + 10;
6645 else
6646 break;
6647 value = 16 * value + digit;
6648 }
6649 }
6650 else if (isdigit (c))
6651 {
6652 value = c - '0';
5be6c3b0
GM		 6653 while (*s < end
6654 && (c = *(*s)++, isdigit (c)))
333b20bb
GM		 6655 value = 8 * value + c - '0';
6656 }
6657 }
6658 else
6659 {
6660 value = c - '0';
5be6c3b0
GM		 6661 while (*s < end
6662 && (c = *(*s)++, isdigit (c)))
333b20bb
GM		 6663 value = 10 * value + c - '0';
6664 }
6665
5be6c3b0
GM		 6666 if (*s < end)
6667 *s = *s - 1;
333b20bb
GM		 6668 *ival = value;
6669 c = XBM_TK_NUMBER;
6670 }
6671 else if (isalpha (c) || c == '_')
6672 {
6673 *sval++ = c;
5be6c3b0
GM		 6674 while (*s < end
6675 && (c = *(*s)++, (isalnum (c) || c == '_')))
333b20bb
GM		 6676 *sval++ = c;
6677 *sval = 0;
5be6c3b0
GM		 6678 if (*s < end)
6679 *s = *s - 1;
333b20bb
GM		 6680 c = XBM_TK_IDENT;
6681 }
0a695da7
GM		 6682 else if (c == '/' && **s == '*')
6683 {
6684 /* C-style comment. */
6685 ++*s;
6686 while (**s && (**s != '*' || *(*s + 1) != '/'))
6687 ++*s;
6688 if (**s)
6689 {
6690 *s += 2;
6691 goto loop;
6692 }
6693 }
333b20bb
GM		 6694
6695 return c;
6696}
6697
6698
6699/* Replacement for XReadBitmapFileData which isn't available under old
5be6c3b0
GM		 6700 X versions. CONTENTS is a pointer to a buffer to parse; END is the
6701 buffer's end. Set *WIDTH and *HEIGHT to the width and height of
6702 the image. Return in *DATA the bitmap data allocated with xmalloc.
6703 Value is non-zero if successful. DATA null means just test if
b243755a 6704 CONTENTS looks like an in-memory XBM file. */
333b20bb
GM		 6705
6706static int
5be6c3b0
GM		 6707xbm_read_bitmap_data (contents, end, width, height, data)
6708 char *contents, *end;
333b20bb
GM		 6709 int *width, *height;
6710 unsigned char **data;
6711{
5be6c3b0 6712 char *s = contents;
333b20bb
GM		 6713 char buffer[BUFSIZ];
6714 int padding_p = 0;
6715 int v10 = 0;
6716 int bytes_per_line, i, nbytes;
6717 unsigned char *p;
6718 int value;
6719 int LA1;
6720
6721#define match() \
5be6c3b0 6722 LA1 = xbm_scan (&s, end, buffer, &value)
333b20bb
GM		 6723
6724#define expect(TOKEN) \
6725 if (LA1 != (TOKEN)) \
6726 goto failure; \
6727 else \
6728 match ()
6729
6730#define expect_ident(IDENT) \
6731 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
6732 match (); \
6733 else \
6734 goto failure
6735
333b20bb 6736 *width = *height = -1;
5be6c3b0
GM		 6737 if (data)
6738 *data = NULL;
6739 LA1 = xbm_scan (&s, end, buffer, &value);
333b20bb
GM		 6740
6741 /* Parse defines for width, height and hot-spots. */
6742 while (LA1 == '#')
6743 {
333b20bb
GM		 6744 match ();
6745 expect_ident ("define");
6746 expect (XBM_TK_IDENT);
6747
6748 if (LA1 == XBM_TK_NUMBER);
6749 {
6750 char *p = strrchr (buffer, '_');
6751 p = p ? p + 1 : buffer;
6752 if (strcmp (p, "width") == 0)
6753 *width = value;
6754 else if (strcmp (p, "height") == 0)
6755 *height = value;
6756 }
6757 expect (XBM_TK_NUMBER);
6758 }
6759
6760 if (*width < 0 || *height < 0)
6761 goto failure;
5be6c3b0
GM		 6762 else if (data == NULL)
6763 goto success;
333b20bb
GM		 6764
6765 /* Parse bits. Must start with `static'. */
6766 expect_ident ("static");
6767 if (LA1 == XBM_TK_IDENT)
6768 {
6769 if (strcmp (buffer, "unsigned") == 0)
6770 {
6771 match ();
6772 expect_ident ("char");
6773 }
6774 else if (strcmp (buffer, "short") == 0)
6775 {
6776 match ();
6777 v10 = 1;
6778 if (*width % 16 && *width % 16 < 9)
6779 padding_p = 1;
6780 }
6781 else if (strcmp (buffer, "char") == 0)
6782 match ();
6783 else
6784 goto failure;
6785 }
6786 else
6787 goto failure;
6788
6789 expect (XBM_TK_IDENT);
6790 expect ('[');
6791 expect (']');
6792 expect ('=');
6793 expect ('{');
6794
6795 bytes_per_line = (*width + 7) / 8 + padding_p;
6796 nbytes = bytes_per_line * *height;
6797 p = *data = (char *) xmalloc (nbytes);
6798
6799 if (v10)
6800 {
333b20bb
GM		 6801 for (i = 0; i < nbytes; i += 2)
6802 {
6803 int val = value;
6804 expect (XBM_TK_NUMBER);
6805
6806 *p++ = val;
6807 if (!padding_p || ((i + 2) % bytes_per_line))
6808 *p++ = value >> 8;
6809
6810 if (LA1 == ',' || LA1 == '}')
6811 match ();
6812 else
6813 goto failure;
6814 }
6815 }
6816 else
6817 {
6818 for (i = 0; i < nbytes; ++i)
6819 {
6820 int val = value;
6821 expect (XBM_TK_NUMBER);
6822
6823 *p++ = val;
6824
6825 if (LA1 == ',' || LA1 == '}')
6826 match ();
6827 else
6828 goto failure;
6829 }
6830 }
6831
5be6c3b0 6832 success:
333b20bb
GM		 6833 return 1;
6834
6835 failure:
6836
5be6c3b0 6837 if (data && *data)
333b20bb
GM		 6838 {
6839 xfree (*data);
6840 *data = NULL;
6841 }
6842 return 0;
6843
6844#undef match
6845#undef expect
6846#undef expect_ident
6847}
6848
6849
5be6c3b0
GM		 6850/* Load XBM image IMG which will be displayed on frame F from buffer
6851 CONTENTS. END is the end of the buffer. Value is non-zero if
6852 successful. */
333b20bb
GM		 6853
6854static int
5be6c3b0 6855xbm_load_image (f, img, contents, end)
333b20bb
GM		 6856 struct frame *f;
6857 struct image *img;
5be6c3b0 6858 char *contents, *end;
333b20bb
GM		 6859{
6860 int rc;
6861 unsigned char *data;
6862 int success_p = 0;
333b20bb 6863
5be6c3b0 6864 rc = xbm_read_bitmap_data (contents, end, &img->width, &img->height, &data);
333b20bb
GM		 6865 if (rc)
6866 {
6867 int depth = DefaultDepthOfScreen (FRAME_X_SCREEN (f));
6868 unsigned long foreground = FRAME_FOREGROUND_PIXEL (f);
6869 unsigned long background = FRAME_BACKGROUND_PIXEL (f);
6870 Lisp_Object value;
6871
6872 xassert (img->width > 0 && img->height > 0);
6873
6874 /* Get foreground and background colors, maybe allocate colors. */
6875 value = image_spec_value (img->spec, QCforeground, NULL);
6876 if (!NILP (value))
6877 foreground = x_alloc_image_color (f, img, value, foreground);
6878
6879 value = image_spec_value (img->spec, QCbackground, NULL);
6880 if (!NILP (value))
6881 background = x_alloc_image_color (f, img, value, background);
6882
333b20bb
GM		 6883 img->pixmap
6884 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f),
6885 FRAME_X_WINDOW (f),
6886 data,
6887 img->width, img->height,
6888 foreground, background,
6889 depth);
6890 xfree (data);
6891
dd00328a 6892 if (img->pixmap == None)
333b20bb
GM		 6893 {
6894 x_clear_image (f, img);
5be6c3b0 6895 image_error ("Unable to create X pixmap for `%s'", img->spec, Qnil);
333b20bb
GM		 6896 }
6897 else
6898 success_p = 1;
333b20bb
GM		 6899 }
6900 else
45158a91 6901 image_error ("Error loading XBM image `%s'", img->spec, Qnil);
333b20bb 6902
333b20bb
GM		 6903 return success_p;
6904}
6905
6906
5be6c3b0
GM		 6907/* Value is non-zero if DATA looks like an in-memory XBM file. */
6908
6909static int
6910xbm_file_p (data)
6911 Lisp_Object data;
6912{
6913 int w, h;
6914 return (STRINGP (data)
6915 && xbm_read_bitmap_data (XSTRING (data)->data,
6916 (XSTRING (data)->data
6917 + STRING_BYTES (XSTRING (data))),
6918 &w, &h, NULL));
6919}
6920
6921
333b20bb
GM		 6922/* Fill image IMG which is used on frame F with pixmap data. Value is
6923 non-zero if successful. */
6924
6925static int
6926xbm_load (f, img)
6927 struct frame *f;
6928 struct image *img;
6929{
6930 int success_p = 0;
6931 Lisp_Object file_name;
6932
6933 xassert (xbm_image_p (img->spec));
6934
6935 /* If IMG->spec specifies a file name, create a non-file spec from it. */
6936 file_name = image_spec_value (img->spec, QCfile, NULL);
6937 if (STRINGP (file_name))
5be6c3b0
GM		 6938 {
6939 Lisp_Object file;
6940 char *contents;
6941 int size;
6942 struct gcpro gcpro1;
6943
6944 file = x_find_image_file (file_name);
6945 GCPRO1 (file);
6946 if (!STRINGP (file))
6947 {
6948 image_error ("Cannot find image file `%s'", file_name, Qnil);
6949 UNGCPRO;
6950 return 0;
6951 }
6952
6953 contents = slurp_file (XSTRING (file)->data, &size);
6954 if (contents == NULL)
6955 {
6956 image_error ("Error loading XBM image `%s'", img->spec, Qnil);
6957 UNGCPRO;
6958 return 0;
6959 }
6960
6961 success_p = xbm_load_image (f, img, contents, contents + size);
6962 UNGCPRO;
6963 }
333b20bb
GM		 6964 else
6965 {
6966 struct image_keyword fmt[XBM_LAST];
6967 Lisp_Object data;
6968 int depth;
6969 unsigned long foreground = FRAME_FOREGROUND_PIXEL (f);
6970 unsigned long background = FRAME_BACKGROUND_PIXEL (f);
6971 char *bits;
9b207e8e 6972 int parsed_p;
5be6c3b0
GM		 6973 int in_memory_file_p = 0;
6974
6975 /* See if data looks like an in-memory XBM file. */
6976 data = image_spec_value (img->spec, QCdata, NULL);
6977 in_memory_file_p = xbm_file_p (data);
333b20bb 6978
5be6c3b0 6979 /* Parse the image specification. */
333b20bb 6980 bcopy (xbm_format, fmt, sizeof fmt);
bfd2209f 6981 parsed_p = parse_image_spec (img->spec, fmt, XBM_LAST, Qxbm);
333b20bb
GM		 6982 xassert (parsed_p);
6983
6984 /* Get specified width, and height. */
5be6c3b0
GM		 6985 if (!in_memory_file_p)
6986 {
6987 img->width = XFASTINT (fmt[XBM_WIDTH].value);
6988 img->height = XFASTINT (fmt[XBM_HEIGHT].value);
6989 xassert (img->width > 0 && img->height > 0);
6990 }
333b20bb 6991
333b20bb 6992 /* Get foreground and background colors, maybe allocate colors. */
6f1be3b9
GM		 6993 if (fmt[XBM_FOREGROUND].count
6994 && STRINGP (fmt[XBM_FOREGROUND].value))
333b20bb
GM		 6995 foreground = x_alloc_image_color (f, img, fmt[XBM_FOREGROUND].value,
6996 foreground);
6f1be3b9
GM		 6997 if (fmt[XBM_BACKGROUND].count
6998 && STRINGP (fmt[XBM_BACKGROUND].value))
333b20bb
GM		 6999 background = x_alloc_image_color (f, img, fmt[XBM_BACKGROUND].value,
7000 background);
7001
5be6c3b0
GM		 7002 if (in_memory_file_p)
7003 success_p = xbm_load_image (f, img, XSTRING (data)->data,
7004 (XSTRING (data)->data
7005 + STRING_BYTES (XSTRING (data))));
7006 else
333b20bb 7007 {
5be6c3b0
GM		 7008 if (VECTORP (data))
7009 {
7010 int i;
7011 char *p;
7012 int nbytes = (img->width + BITS_PER_CHAR - 1) / BITS_PER_CHAR;
333b20bb 7013
5be6c3b0
GM		 7014 p = bits = (char *) alloca (nbytes * img->height);
7015 for (i = 0; i < img->height; ++i, p += nbytes)
7016 {
7017 Lisp_Object line = XVECTOR (data)->contents[i];
7018 if (STRINGP (line))
7019 bcopy (XSTRING (line)->data, p, nbytes);
7020 else
7021 bcopy (XBOOL_VECTOR (line)->data, p, nbytes);
7022 }
7023 }
7024 else if (STRINGP (data))
7025 bits = XSTRING (data)->data;
7026 else
7027 bits = XBOOL_VECTOR (data)->data;
7028
7029 /* Create the pixmap. */
7030 depth = DefaultDepthOfScreen (FRAME_X_SCREEN (f));
7031 img->pixmap
7032 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f),
7033 FRAME_X_WINDOW (f),
7034 bits,
7035 img->width, img->height,
7036 foreground, background,
7037 depth);
7038 if (img->pixmap)
7039 success_p = 1;
7040 else
333b20bb 7041 {
5be6c3b0
GM		 7042 image_error ("Unable to create pixmap for XBM image `%s'",
7043 img->spec, Qnil);
7044 x_clear_image (f, img);
333b20bb
GM		 7045 }
7046 }
333b20bb
GM		 7047 }
7048
7049 return success_p;
7050}
7051
7052
7053\f
7054/***********************************************************************
7055 XPM images
7056 ***********************************************************************/
7057
7058#if HAVE_XPM
7059
7060static int xpm_image_p P_ ((Lisp_Object object));
7061static int xpm_load P_ ((struct frame *f, struct image *img));
7062static int xpm_valid_color_symbols_p P_ ((Lisp_Object));
7063
7064#include "X11/xpm.h"
7065
7066/* The symbol `xpm' identifying XPM-format images. */
7067
7068Lisp_Object Qxpm;
7069
7070/* Indices of image specification fields in xpm_format, below. */
7071
7072enum xpm_keyword_index
7073{
7074 XPM_TYPE,
7075 XPM_FILE,
7076 XPM_DATA,
7077 XPM_ASCENT,
7078 XPM_MARGIN,
7079 XPM_RELIEF,
7080 XPM_ALGORITHM,
7081 XPM_HEURISTIC_MASK,
4a8e312c 7082 XPM_MASK,
333b20bb
GM		 7083 XPM_COLOR_SYMBOLS,
7084 XPM_LAST
7085};
7086
7087/* Vector of image_keyword structures describing the format
7088 of valid XPM image specifications. */
7089
7090static struct image_keyword xpm_format[XPM_LAST] =
7091{
7092 {":type", IMAGE_SYMBOL_VALUE, 1},
7093 {":file", IMAGE_STRING_VALUE, 0},
7094 {":data", IMAGE_STRING_VALUE, 0},
7c7ff7f5 7095 {":ascent", IMAGE_ASCENT_VALUE, 0},
3ed61e75 7096 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
333b20bb 7097 {":relief", IMAGE_INTEGER_VALUE, 0},
d2dc8167 7098 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
333b20bb 7099 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
4a8e312c 7100 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
333b20bb
GM		 7101 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
7102};
7103
7104/* Structure describing the image type XBM. */
7105
7106static struct image_type xpm_type =
7107{
7108 &Qxpm,
7109 xpm_image_p,
7110 xpm_load,
7111 x_clear_image,
7112 NULL
7113};
7114
7115
b243755a
GM		 7116/* Define ALLOC_XPM_COLORS if we can use Emacs' own color allocation
7117 functions for allocating image colors. Our own functions handle
7118 color allocation failures more gracefully than the ones on the XPM
7119 lib. */
7120
7121#if defined XpmAllocColor && defined XpmFreeColors && defined XpmColorClosure
7122#define ALLOC_XPM_COLORS
7123#endif
7124
7125#ifdef ALLOC_XPM_COLORS
7126
f72c62ad 7127static void xpm_init_color_cache P_ ((struct frame *, XpmAttributes *));
b243755a
GM		 7128static void xpm_free_color_cache P_ ((void));
7129static int xpm_lookup_color P_ ((struct frame *, char *, XColor *));
f72c62ad
GM		 7130static int xpm_color_bucket P_ ((char *));
7131static struct xpm_cached_color *xpm_cache_color P_ ((struct frame *, char *,
7132 XColor *, int));
b243755a
GM		 7133
7134/* An entry in a hash table used to cache color definitions of named
7135 colors. This cache is necessary to speed up XPM image loading in
7136 case we do color allocations ourselves. Without it, we would need
7137 a call to XParseColor per pixel in the image. */
7138
7139struct xpm_cached_color
7140{
7141 /* Next in collision chain. */
7142 struct xpm_cached_color *next;
7143
7144 /* Color definition (RGB and pixel color). */
7145 XColor color;
7146
7147 /* Color name. */
7148 char name[1];
7149};
7150
7151/* The hash table used for the color cache, and its bucket vector
7152 size. */
7153
7154#define XPM_COLOR_CACHE_BUCKETS 1001
7155struct xpm_cached_color **xpm_color_cache;
7156
b243755a
GM		 7157/* Initialize the color cache. */
7158
7159static void
f72c62ad
GM		 7160xpm_init_color_cache (f, attrs)
7161 struct frame *f;
7162 XpmAttributes *attrs;
b243755a
GM		 7163{
7164 size_t nbytes = XPM_COLOR_CACHE_BUCKETS * sizeof *xpm_color_cache;
7165 xpm_color_cache = (struct xpm_cached_color **) xmalloc (nbytes);
7166 memset (xpm_color_cache, 0, nbytes);
7167 init_color_table ();
f72c62ad
GM		 7168
7169 if (attrs->valuemask & XpmColorSymbols)
7170 {
7171 int i;
7172 XColor color;
7173
7174 for (i = 0; i < attrs->numsymbols; ++i)
7175 if (XParseColor (FRAME_X_DISPLAY (f), FRAME_X_COLORMAP (f),
7176 attrs->colorsymbols[i].value, &color))
7177 {
7178 color.pixel = lookup_rgb_color (f, color.red, color.green,
7179 color.blue);
7180 xpm_cache_color (f, attrs->colorsymbols[i].name, &color, -1);
7181 }
7182 }
b243755a
GM		 7183}
7184
7185
7186/* Free the color cache. */
7187
7188static void
7189xpm_free_color_cache ()
7190{
7191 struct xpm_cached_color *p, *next;
7192 int i;
7193
7194 for (i = 0; i < XPM_COLOR_CACHE_BUCKETS; ++i)
7195 for (p = xpm_color_cache[i]; p; p = next)
7196 {
7197 next = p->next;
7198 xfree (p);
7199 }
7200
7201 xfree (xpm_color_cache);
7202 xpm_color_cache = NULL;
7203 free_color_table ();
7204}
7205
7206
f72c62ad
GM		 7207/* Return the bucket index for color named COLOR_NAME in the color
7208 cache. */
7209
7210static int
7211xpm_color_bucket (color_name)
7212 char *color_name;
7213{
7214 unsigned h = 0;
7215 char *s;
7216
7217 for (s = color_name; *s; ++s)
7218 h = (h << 2) ^ *s;
7219 return h %= XPM_COLOR_CACHE_BUCKETS;
7220}
7221
7222
7223/* On frame F, cache values COLOR for color with name COLOR_NAME.
7224 BUCKET, if >= 0, is a precomputed bucket index. Value is the cache
7225 entry added. */
7226
7227static struct xpm_cached_color *
7228xpm_cache_color (f, color_name, color, bucket)
7229 struct frame *f;
7230 char *color_name;
7231 XColor *color;
7232 int bucket;
7233{
7234 size_t nbytes;
7235 struct xpm_cached_color *p;
7236
7237 if (bucket < 0)
7238 bucket = xpm_color_bucket (color_name);
7239
7240 nbytes = sizeof *p + strlen (color_name);
7241 p = (struct xpm_cached_color *) xmalloc (nbytes);
7242 strcpy (p->name, color_name);
7243 p->color = *color;
7244 p->next = xpm_color_cache[bucket];
7245 xpm_color_cache[bucket] = p;
7246 return p;
7247}
7248
7249
b243755a
GM		 7250/* Look up color COLOR_NAME for frame F in the color cache. If found,
7251 return the cached definition in *COLOR. Otherwise, make a new
7252 entry in the cache and allocate the color. Value is zero if color
7253 allocation failed. */
7254
7255static int
7256xpm_lookup_color (f, color_name, color)
7257 struct frame *f;
7258 char *color_name;
7259 XColor *color;
7260{
b243755a 7261 struct xpm_cached_color *p;
83676598 7262 int h = xpm_color_bucket (color_name);
b243755a
GM		 7263
7264 for (p = xpm_color_cache[h]; p; p = p->next)
7265 if (strcmp (p->name, color_name) == 0)
7266 break;
7267
7268 if (p != NULL)
7269 *color = p->color;
7270 else if (XParseColor (FRAME_X_DISPLAY (f), FRAME_X_COLORMAP (f),
7271 color_name, color))
7272 {
b243755a
GM		 7273 color->pixel = lookup_rgb_color (f, color->red, color->green,
7274 color->blue);
f72c62ad 7275 p = xpm_cache_color (f, color_name, color, h);
b243755a 7276 }
f72c62ad 7277
b243755a
GM		 7278 return p != NULL;
7279}
7280
7281
7282/* Callback for allocating color COLOR_NAME. Called from the XPM lib.
7283 CLOSURE is a pointer to the frame on which we allocate the
7284 color. Return in *COLOR the allocated color. Value is non-zero
7285 if successful. */
7286
7287static int
7288xpm_alloc_color (dpy, cmap, color_name, color, closure)
7289 Display *dpy;
7290 Colormap cmap;
7291 char *color_name;
7292 XColor *color;
7293 void *closure;
7294{
7295 return xpm_lookup_color ((struct frame *) closure, color_name, color);
7296}
7297
7298
7299/* Callback for freeing NPIXELS colors contained in PIXELS. CLOSURE
7300 is a pointer to the frame on which we allocate the color. Value is
7301 non-zero if successful. */
7302
7303static int
7304xpm_free_colors (dpy, cmap, pixels, npixels, closure)
7305 Display *dpy;
7306 Colormap cmap;
7307 Pixel *pixels;
7308 int npixels;
7309 void *closure;
7310{
7311 return 1;
7312}
7313
7314#endif /* ALLOC_XPM_COLORS */
7315
7316
333b20bb
GM		 7317/* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
7318 for XPM images. Such a list must consist of conses whose car and
7319 cdr are strings. */
7320
7321static int
7322xpm_valid_color_symbols_p (color_symbols)
7323 Lisp_Object color_symbols;
7324{
7325 while (CONSP (color_symbols))
7326 {
7327 Lisp_Object sym = XCAR (color_symbols);
7328 if (!CONSP (sym)
7329 || !STRINGP (XCAR (sym))
7330 || !STRINGP (XCDR (sym)))
7331 break;
7332 color_symbols = XCDR (color_symbols);
7333 }
7334
7335 return NILP (color_symbols);
7336}
7337
7338
7339/* Value is non-zero if OBJECT is a valid XPM image specification. */
7340
7341static int
7342xpm_image_p (object)
7343 Lisp_Object object;
7344{
7345 struct image_keyword fmt[XPM_LAST];
7346 bcopy (xpm_format, fmt, sizeof fmt);
bfd2209f 7347 return (parse_image_spec (object, fmt, XPM_LAST, Qxpm)
333b20bb
GM		 7348 /* Either `:file' or `:data' must be present. */
7349 && fmt[XPM_FILE].count + fmt[XPM_DATA].count == 1
7350 /* Either no `:color-symbols' or it's a list of conses
7351 whose car and cdr are strings. */
7352 && (fmt[XPM_COLOR_SYMBOLS].count == 0
7c7ff7f5 7353 || xpm_valid_color_symbols_p (fmt[XPM_COLOR_SYMBOLS].value)));
333b20bb
GM		 7354}
7355
7356
7357/* Load image IMG which will be displayed on frame F. Value is
7358 non-zero if successful. */
7359
7360static int
7361xpm_load (f, img)
7362 struct frame *f;
7363 struct image *img;
7364{
9b207e8e 7365 int rc;
333b20bb
GM		 7366 XpmAttributes attrs;
7367 Lisp_Object specified_file, color_symbols;
7368
7369 /* Configure the XPM lib. Use the visual of frame F. Allocate
7370 close colors. Return colors allocated. */
7371 bzero (&attrs, sizeof attrs);
9b2956e2
GM		 7372 attrs.visual = FRAME_X_VISUAL (f);
7373 attrs.colormap = FRAME_X_COLORMAP (f);
333b20bb 7374 attrs.valuemask |= XpmVisual;
9b2956e2 7375 attrs.valuemask |= XpmColormap;
b243755a
GM		 7376
7377#ifdef ALLOC_XPM_COLORS
7378 /* Allocate colors with our own functions which handle
7379 failing color allocation more gracefully. */
7380 attrs.color_closure = f;
7381 attrs.alloc_color = xpm_alloc_color;
7382 attrs.free_colors = xpm_free_colors;
7383 attrs.valuemask |= XpmAllocColor | XpmFreeColors | XpmColorClosure;
7384#else /* not ALLOC_XPM_COLORS */
7385 /* Let the XPM lib allocate colors. */
333b20bb 7386 attrs.valuemask |= XpmReturnAllocPixels;
e4c082be 7387#ifdef XpmAllocCloseColors
333b20bb
GM		 7388 attrs.alloc_close_colors = 1;
7389 attrs.valuemask |= XpmAllocCloseColors;
b243755a 7390#else /* not XpmAllocCloseColors */
e4c082be
RS		 7391 attrs.closeness = 600;
7392 attrs.valuemask |= XpmCloseness;
b243755a
GM		 7393#endif /* not XpmAllocCloseColors */
7394#endif /* ALLOC_XPM_COLORS */
333b20bb
GM		 7395
7396 /* If image specification contains symbolic color definitions, add
7397 these to `attrs'. */
7398 color_symbols = image_spec_value (img->spec, QCcolor_symbols, NULL);
7399 if (CONSP (color_symbols))
7400 {
7401 Lisp_Object tail;
7402 XpmColorSymbol *xpm_syms;
7403 int i, size;
7404
7405 attrs.valuemask |= XpmColorSymbols;
7406
7407 /* Count number of symbols. */
7408 attrs.numsymbols = 0;
7409 for (tail = color_symbols; CONSP (tail); tail = XCDR (tail))
7410 ++attrs.numsymbols;
7411
7412 /* Allocate an XpmColorSymbol array. */
7413 size = attrs.numsymbols * sizeof *xpm_syms;
7414 xpm_syms = (XpmColorSymbol *) alloca (size);
7415 bzero (xpm_syms, size);
7416 attrs.colorsymbols = xpm_syms;
7417
7418 /* Fill the color symbol array. */
7419 for (tail = color_symbols, i = 0;
7420 CONSP (tail);
7421 ++i, tail = XCDR (tail))
7422 {
7423 Lisp_Object name = XCAR (XCAR (tail));
7424 Lisp_Object color = XCDR (XCAR (tail));
7425 xpm_syms[i].name = (char *) alloca (XSTRING (name)->size + 1);
7426 strcpy (xpm_syms[i].name, XSTRING (name)->data);
7427 xpm_syms[i].value = (char *) alloca (XSTRING (color)->size + 1);
7428 strcpy (xpm_syms[i].value, XSTRING (color)->data);
7429 }
7430 }
7431
7432 /* Create a pixmap for the image, either from a file, or from a
7433 string buffer containing data in the same format as an XPM file. */
b243755a 7434#ifdef ALLOC_XPM_COLORS
f72c62ad 7435 xpm_init_color_cache (f, &attrs);
b243755a
GM		 7436#endif
7437
333b20bb
GM		 7438 specified_file = image_spec_value (img->spec, QCfile, NULL);
7439 if (STRINGP (specified_file))
7440 {
7441 Lisp_Object file = x_find_image_file (specified_file);
7442 if (!STRINGP (file))
7443 {
45158a91 7444 image_error ("Cannot find image file `%s'", specified_file, Qnil);
333b20bb
GM		 7445 return 0;
7446 }
7447
7448 rc = XpmReadFileToPixmap (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
7449 XSTRING (file)->data, &img->pixmap, &img->mask,
7450 &attrs);
7451 }
7452 else
7453 {
7454 Lisp_Object buffer = image_spec_value (img->spec, QCdata, NULL);
7455 rc = XpmCreatePixmapFromBuffer (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
7456 XSTRING (buffer)->data,
7457 &img->pixmap, &img->mask,
7458 &attrs);
7459 }
333b20bb
GM		 7460
7461 if (rc == XpmSuccess)
7462 {
b243755a
GM		 7463#ifdef ALLOC_XPM_COLORS
7464 img->colors = colors_in_color_table (&img->ncolors);
7465#else /* not ALLOC_XPM_COLORS */
f47a9ec4
KR		 7466 int i;
7467
333b20bb
GM		 7468 img->ncolors = attrs.nalloc_pixels;
7469 img->colors = (unsigned long *) xmalloc (img->ncolors
7470 * sizeof *img->colors);
7471 for (i = 0; i < attrs.nalloc_pixels; ++i)
3b4ae1cc
GM		 7472 {
7473 img->colors[i] = attrs.alloc_pixels[i];
7474#ifdef DEBUG_X_COLORS
7475 register_color (img->colors[i]);
7476#endif
7477 }
b243755a 7478#endif /* not ALLOC_XPM_COLORS */
333b20bb
GM		 7479
7480 img->width = attrs.width;
7481 img->height = attrs.height;
7482 xassert (img->width > 0 && img->height > 0);
7483
7484 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
333b20bb 7485 XpmFreeAttributes (&attrs);
333b20bb
GM		 7486 }
7487 else
7488 {
7489 switch (rc)
7490 {
7491 case XpmOpenFailed:
7492 image_error ("Error opening XPM file (%s)", img->spec, Qnil);
7493 break;
7494
7495 case XpmFileInvalid:
7496 image_error ("Invalid XPM file (%s)", img->spec, Qnil);
7497 break;
7498
7499 case XpmNoMemory:
7500 image_error ("Out of memory (%s)", img->spec, Qnil);
7501 break;
7502
7503 case XpmColorFailed:
7504 image_error ("Color allocation error (%s)", img->spec, Qnil);
7505 break;
7506
7507 default:
7508 image_error ("Unknown error (%s)", img->spec, Qnil);
7509 break;
7510 }
7511 }
7512
b243755a
GM		 7513#ifdef ALLOC_XPM_COLORS
7514 xpm_free_color_cache ();
7515#endif
333b20bb
GM		 7516 return rc == XpmSuccess;
7517}
7518
7519#endif /* HAVE_XPM != 0 */
7520
7521\f
7522/***********************************************************************
7523 Color table
7524 ***********************************************************************/
7525
7526/* An entry in the color table mapping an RGB color to a pixel color. */
7527
7528struct ct_color
7529{
7530 int r, g, b;
7531 unsigned long pixel;
7532
7533 /* Next in color table collision list. */
7534 struct ct_color *next;
7535};
7536
7537/* The bucket vector size to use. Must be prime. */
7538
7539#define CT_SIZE 101
7540
7541/* Value is a hash of the RGB color given by R, G, and B. */
7542
7543#define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
7544
7545/* The color hash table. */
7546
7547struct ct_color **ct_table;
7548
7549/* Number of entries in the color table. */
7550
7551int ct_colors_allocated;
7552
333b20bb
GM		 7553/* Initialize the color table. */
7554
7555static void
7556init_color_table ()
7557{
7558 int size = CT_SIZE * sizeof (*ct_table);
7559 ct_table = (struct ct_color **) xmalloc (size);
7560 bzero (ct_table, size);
7561 ct_colors_allocated = 0;
7562}
7563
7564
7565/* Free memory associated with the color table. */
7566
7567static void
7568free_color_table ()
7569{
7570 int i;
7571 struct ct_color *p, *next;
7572
7573 for (i = 0; i < CT_SIZE; ++i)
7574 for (p = ct_table[i]; p; p = next)
7575 {
7576 next = p->next;
7577 xfree (p);
7578 }
7579
7580 xfree (ct_table);
7581 ct_table = NULL;
7582}
7583
7584
7585/* Value is a pixel color for RGB color R, G, B on frame F. If an
7586 entry for that color already is in the color table, return the
7587 pixel color of that entry. Otherwise, allocate a new color for R,
7588 G, B, and make an entry in the color table. */
7589
7590static unsigned long
7591lookup_rgb_color (f, r, g, b)
7592 struct frame *f;
7593 int r, g, b;
7594{
7595 unsigned hash = CT_HASH_RGB (r, g, b);
7596 int i = hash % CT_SIZE;
7597 struct ct_color *p;
7598
7599 for (p = ct_table[i]; p; p = p->next)
7600 if (p->r == r && p->g == g && p->b == b)
7601 break;
7602
7603 if (p == NULL)
7604 {
7605 XColor color;
7606 Colormap cmap;
7607 int rc;
7608
7609 color.red = r;
7610 color.green = g;
7611 color.blue = b;
7612
9b2956e2 7613 cmap = FRAME_X_COLORMAP (f);
d62c8769 7614 rc = x_alloc_nearest_color (f, cmap, &color);
333b20bb
GM		 7615
7616 if (rc)
7617 {
7618 ++ct_colors_allocated;
7619
7620 p = (struct ct_color *) xmalloc (sizeof *p);
7621 p->r = r;
7622 p->g = g;
7623 p->b = b;
7624 p->pixel = color.pixel;
7625 p->next = ct_table[i];
7626 ct_table[i] = p;
7627 }
7628 else
7629 return FRAME_FOREGROUND_PIXEL (f);
7630 }
7631
7632 return p->pixel;
7633}
7634
7635
7636/* Look up pixel color PIXEL which is used on frame F in the color
7637 table. If not already present, allocate it. Value is PIXEL. */
7638
7639static unsigned long
7640lookup_pixel_color (f, pixel)
7641 struct frame *f;
7642 unsigned long pixel;
7643{
7644 int i = pixel % CT_SIZE;
7645 struct ct_color *p;
7646
7647 for (p = ct_table[i]; p; p = p->next)
7648 if (p->pixel == pixel)
7649 break;
7650
7651 if (p == NULL)
7652 {
7653 XColor color;
7654 Colormap cmap;
7655 int rc;
7656
9b2956e2 7657 cmap = FRAME_X_COLORMAP (f);
333b20bb 7658 color.pixel = pixel;
a31fedb7 7659 x_query_color (f, &color);
d62c8769 7660 rc = x_alloc_nearest_color (f, cmap, &color);
333b20bb
GM		 7661
7662 if (rc)
7663 {
7664 ++ct_colors_allocated;
7665
7666 p = (struct ct_color *) xmalloc (sizeof *p);
7667 p->r = color.red;
7668 p->g = color.green;
7669 p->b = color.blue;
7670 p->pixel = pixel;
7671 p->next = ct_table[i];
7672 ct_table[i] = p;
7673 }
7674 else
7675 return FRAME_FOREGROUND_PIXEL (f);
7676 }
7677
7678 return p->pixel;
7679}
7680
7681
7682/* Value is a vector of all pixel colors contained in the color table,
7683 allocated via xmalloc. Set *N to the number of colors. */
7684
7685static unsigned long *
7686colors_in_color_table (n)
7687 int *n;
7688{
7689 int i, j;
7690 struct ct_color *p;
7691 unsigned long *colors;
7692
7693 if (ct_colors_allocated == 0)
7694 {
7695 *n = 0;
7696 colors = NULL;
7697 }
7698 else
7699 {
7700 colors = (unsigned long *) xmalloc (ct_colors_allocated
7701 * sizeof *colors);
7702 *n = ct_colors_allocated;
7703
7704 for (i = j = 0; i < CT_SIZE; ++i)
7705 for (p = ct_table[i]; p; p = p->next)
7706 colors[j++] = p->pixel;
7707 }
7708
7709 return colors;
7710}
7711
7712
7713\f
7714/***********************************************************************
7715 Algorithms
7716 ***********************************************************************/
7717
4a8e312c
GM		 7718static XColor *x_to_xcolors P_ ((struct frame *, struct image *, int));
7719static void x_from_xcolors P_ ((struct frame *, struct image *, XColor *));
7720static void x_detect_edges P_ ((struct frame *, struct image *, int[9], int));
7721
d2dc8167 7722/* Non-zero means draw a cross on images having `:conversion
14819cb3
GM		 7723 disabled'. */
7724
7725int cross_disabled_images;
7726
4a8e312c
GM		 7727/* Edge detection matrices for different edge-detection
7728 strategies. */
7729
7730static int emboss_matrix[9] = {
7731 /* x - 1 x x + 1 */
7732 2, -1, 0, /* y - 1 */
7733 -1, 0, 1, /* y */
7734 0, 1, -2 /* y + 1 */
7735};
333b20bb 7736
4a8e312c
GM		 7737static int laplace_matrix[9] = {
7738 /* x - 1 x x + 1 */
7739 1, 0, 0, /* y - 1 */
7740 0, 0, 0, /* y */
7741 0, 0, -1 /* y + 1 */
7742};
333b20bb 7743
14819cb3
GM		 7744/* Value is the intensity of the color whose red/green/blue values
7745 are R, G, and B. */
7746
7747#define COLOR_INTENSITY(R, G, B) ((2 * (R) + 3 * (G) + (B)) / 6)
7748
333b20bb 7749
4a8e312c
GM		 7750/* On frame F, return an array of XColor structures describing image
7751 IMG->pixmap. Each XColor structure has its pixel color set. RGB_P
7752 non-zero means also fill the red/green/blue members of the XColor
7753 structures. Value is a pointer to the array of XColors structures,
7754 allocated with xmalloc; it must be freed by the caller. */
7755
7756static XColor *
7757x_to_xcolors (f, img, rgb_p)
333b20bb 7758 struct frame *f;
4a8e312c
GM		 7759 struct image *img;
7760 int rgb_p;
333b20bb 7761{
4a8e312c
GM		 7762 int x, y;
7763 XColor *colors, *p;
7764 XImage *ximg;
333b20bb 7765
4a8e312c
GM		 7766 colors = (XColor *) xmalloc (img->width * img->height * sizeof *colors);
7767
7768 /* Get the X image IMG->pixmap. */
7769 ximg = XGetImage (FRAME_X_DISPLAY (f), img->pixmap,
7770 0, 0, img->width, img->height, ~0, ZPixmap);
333b20bb 7771
4a8e312c
GM		 7772 /* Fill the `pixel' members of the XColor array. I wished there
7773 were an easy and portable way to circumvent XGetPixel. */
7774 p = colors;
7775 for (y = 0; y < img->height; ++y)
7776 {
7777 XColor *row = p;
7778
7779 for (x = 0; x < img->width; ++x, ++p)
7780 p->pixel = XGetPixel (ximg, x, y);
7781
7782 if (rgb_p)
a31fedb7 7783 x_query_colors (f, row, img->width);
4a8e312c
GM		 7784 }
7785
7786 XDestroyImage (ximg);
4a8e312c 7787 return colors;
333b20bb
GM		 7788}
7789
7790
4a8e312c
GM		 7791/* Create IMG->pixmap from an array COLORS of XColor structures, whose
7792 RGB members are set. F is the frame on which this all happens.
7793 COLORS will be freed; an existing IMG->pixmap will be freed, too. */
333b20bb
GM		 7794
7795static void
4a8e312c 7796x_from_xcolors (f, img, colors)
333b20bb 7797 struct frame *f;
4a8e312c
GM		 7798 struct image *img;
7799 XColor *colors;
333b20bb 7800{
4a8e312c
GM		 7801 int x, y;
7802 XImage *oimg;
7803 Pixmap pixmap;
7804 XColor *p;
7805
4a8e312c 7806 init_color_table ();
333b20bb 7807
4a8e312c
GM		 7808 x_create_x_image_and_pixmap (f, img->width, img->height, 0,
7809 &oimg, &pixmap);
7810 p = colors;
7811 for (y = 0; y < img->height; ++y)
7812 for (x = 0; x < img->width; ++x, ++p)
7813 {
7814 unsigned long pixel;
7815 pixel = lookup_rgb_color (f, p->red, p->green, p->blue);
7816 XPutPixel (oimg, x, y, pixel);
7817 }
7818
7819 xfree (colors);
dd00328a 7820 x_clear_image_1 (f, img, 1, 0, 1);
4a8e312c
GM		 7821
7822 x_put_x_image (f, oimg, pixmap, img->width, img->height);
7823 x_destroy_x_image (oimg);
7824 img->pixmap = pixmap;
7825 img->colors = colors_in_color_table (&img->ncolors);
7826 free_color_table ();
333b20bb
GM		 7827}
7828
7829
4a8e312c
GM		 7830/* On frame F, perform edge-detection on image IMG.
7831
7832 MATRIX is a nine-element array specifying the transformation
7833 matrix. See emboss_matrix for an example.
7834
7835 COLOR_ADJUST is a color adjustment added to each pixel of the
7836 outgoing image. */
333b20bb
GM		 7837
7838static void
4a8e312c 7839x_detect_edges (f, img, matrix, color_adjust)
333b20bb
GM		 7840 struct frame *f;
7841 struct image *img;
4a8e312c 7842 int matrix[9], color_adjust;
333b20bb 7843{
4a8e312c
GM		 7844 XColor *colors = x_to_xcolors (f, img, 1);
7845 XColor *new, *p;
7846 int x, y, i, sum;
333b20bb 7847
4a8e312c
GM		 7848 for (i = sum = 0; i < 9; ++i)
7849 sum += abs (matrix[i]);
333b20bb 7850
4a8e312c 7851#define COLOR(A, X, Y) ((A) + (Y) * img->width + (X))
333b20bb 7852
4a8e312c 7853 new = (XColor *) xmalloc (img->width * img->height * sizeof *new);
333b20bb 7854
4a8e312c
GM		 7855 for (y = 0; y < img->height; ++y)
7856 {
7857 p = COLOR (new, 0, y);
7858 p->red = p->green = p->blue = 0xffff/2;
7859 p = COLOR (new, img->width - 1, y);
7860 p->red = p->green = p->blue = 0xffff/2;
7861 }
7862
7863 for (x = 1; x < img->width - 1; ++x)
7864 {
7865 p = COLOR (new, x, 0);
7866 p->red = p->green = p->blue = 0xffff/2;
7867 p = COLOR (new, x, img->height - 1);
7868 p->red = p->green = p->blue = 0xffff/2;
7869 }
333b20bb 7870
4a8e312c 7871 for (y = 1; y < img->height - 1; ++y)
333b20bb 7872 {
4a8e312c
GM		 7873 p = COLOR (new, 1, y);
7874
7875 for (x = 1; x < img->width - 1; ++x, ++p)
7876 {
14819cb3 7877 int r, g, b, y1, x1;
4a8e312c
GM		 7878
7879 r = g = b = i = 0;
7880 for (y1 = y - 1; y1 < y + 2; ++y1)
7881 for (x1 = x - 1; x1 < x + 2; ++x1, ++i)
7882 if (matrix[i])
7883 {
7884 XColor *t = COLOR (colors, x1, y1);
7885 r += matrix[i] * t->red;
7886 g += matrix[i] * t->green;
7887 b += matrix[i] * t->blue;
7888 }
333b20bb 7889
4a8e312c
GM		 7890 r = (r / sum + color_adjust) & 0xffff;
7891 g = (g / sum + color_adjust) & 0xffff;
7892 b = (b / sum + color_adjust) & 0xffff;
14819cb3 7893 p->red = p->green = p->blue = COLOR_INTENSITY (r, g, b);
333b20bb 7894 }
333b20bb
GM		 7895 }
7896
4a8e312c
GM		 7897 xfree (colors);
7898 x_from_xcolors (f, img, new);
333b20bb 7899
4a8e312c
GM		 7900#undef COLOR
7901}
7902
7903
7904/* Perform the pre-defined `emboss' edge-detection on image IMG
7905 on frame F. */
7906
7907static void
7908x_emboss (f, img)
7909 struct frame *f;
7910 struct image *img;
7911{
7912 x_detect_edges (f, img, emboss_matrix, 0xffff / 2);
7913}
7914
7915
7916/* Perform the pre-defined `laplace' edge-detection on image IMG
7917 on frame F. */
7918
7919static void
7920x_laplace (f, img)
7921 struct frame *f;
7922 struct image *img;
7923{
7924 x_detect_edges (f, img, laplace_matrix, 45000);
7925}
7926
7927
7928/* Perform edge-detection on image IMG on frame F, with specified
7929 transformation matrix MATRIX and color-adjustment COLOR_ADJUST.
7930
7931 MATRIX must be either
7932
7933 - a list of at least 9 numbers in row-major form
7934 - a vector of at least 9 numbers
7935
7936 COLOR_ADJUST nil means use a default; otherwise it must be a
7937 number. */
7938
7939static void
7940x_edge_detection (f, img, matrix, color_adjust)
7941 struct frame *f;
7942 struct image *img;
7943 Lisp_Object matrix, color_adjust;
7944{
7945 int i = 0;
7946 int trans[9];
333b20bb 7947
4a8e312c
GM		 7948 if (CONSP (matrix))
7949 {
7950 for (i = 0;
7951 i < 9 && CONSP (matrix) && NUMBERP (XCAR (matrix));
7952 ++i, matrix = XCDR (matrix))
7953 trans[i] = XFLOATINT (XCAR (matrix));
7954 }
7955 else if (VECTORP (matrix) && ASIZE (matrix) >= 9)
7956 {
7957 for (i = 0; i < 9 && NUMBERP (AREF (matrix, i)); ++i)
7958 trans[i] = XFLOATINT (AREF (matrix, i));
7959 }
333b20bb 7960
4a8e312c
GM		 7961 if (NILP (color_adjust))
7962 color_adjust = make_number (0xffff / 2);
333b20bb 7963
4a8e312c
GM		 7964 if (i == 9 && NUMBERP (color_adjust))
7965 x_detect_edges (f, img, trans, (int) XFLOATINT (color_adjust));
333b20bb
GM		 7966}
7967
7968
14819cb3
GM		 7969/* Transform image IMG on frame F so that it looks disabled. */
7970
7971static void
7972x_disable_image (f, img)
7973 struct frame *f;
7974 struct image *img;
7975{
7976 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
dd00328a 7977
14819cb3
GM		 7978 if (dpyinfo->n_planes >= 2)
7979 {
7980 /* Color (or grayscale). Convert to gray, and equalize. Just
7981 drawing such images with a stipple can look very odd, so
7982 we're using this method instead. */
7983 XColor *colors = x_to_xcolors (f, img, 1);
7984 XColor *p, *end;
7985 const int h = 15000;
7986 const int l = 30000;
7987
7988 for (p = colors, end = colors + img->width * img->height;
7989 p < end;
7990 ++p)
7991 {
7992 int i = COLOR_INTENSITY (p->red, p->green, p->blue);
7993 int i2 = (0xffff - h - l) * i / 0xffff + l;
7994 p->red = p->green = p->blue = i2;
7995 }
7996
7997 x_from_xcolors (f, img, colors);
7998 }
7999
8000 /* Draw a cross over the disabled image, if we must or if we
8001 should. */
8002 if (dpyinfo->n_planes < 2 || cross_disabled_images)
8003 {
8004 Display *dpy = FRAME_X_DISPLAY (f);
8005 GC gc;
8006
14819cb3
GM		 8007 gc = XCreateGC (dpy, img->pixmap, 0, NULL);
8008 XSetForeground (dpy, gc, BLACK_PIX_DEFAULT (f));
8009 XDrawLine (dpy, img->pixmap, gc, 0, 0,
8010 img->width - 1, img->height - 1);
8011 XDrawLine (dpy, img->pixmap, gc, 0, img->height - 1,
8012 img->width - 1, 0);
8013 XFreeGC (dpy, gc);
8014
8015 if (img->mask)
8016 {
8017 gc = XCreateGC (dpy, img->mask, 0, NULL);
8018 XSetForeground (dpy, gc, WHITE_PIX_DEFAULT (f));
8019 XDrawLine (dpy, img->mask, gc, 0, 0,
8020 img->width - 1, img->height - 1);
8021 XDrawLine (dpy, img->mask, gc, 0, img->height - 1,
8022 img->width - 1, 0);
8023 XFreeGC (dpy, gc);
8024 }
14819cb3
GM		 8025 }
8026}
8027
8028
333b20bb
GM		 8029/* Build a mask for image IMG which is used on frame F. FILE is the
8030 name of an image file, for error messages. HOW determines how to
fcf431dc
GM		 8031 determine the background color of IMG. If it is a list '(R G B)',
8032 with R, G, and B being integers >= 0, take that as the color of the
8033 background. Otherwise, determine the background color of IMG
8034 heuristically. Value is non-zero if successful. */
333b20bb
GM		 8035
8036static int
45158a91 8037x_build_heuristic_mask (f, img, how)
333b20bb 8038 struct frame *f;
333b20bb
GM		 8039 struct image *img;
8040 Lisp_Object how;
8041{
8042 Display *dpy = FRAME_X_DISPLAY (f);
333b20bb 8043 XImage *ximg, *mask_img;
fcf431dc 8044 int x, y, rc, look_at_corners_p;
8ec8a5ec 8045 unsigned long bg = 0;
333b20bb 8046
4a8e312c
GM		 8047 if (img->mask)
8048 {
8049 XFreePixmap (FRAME_X_DISPLAY (f), img->mask);
dd00328a 8050 img->mask = None;
4a8e312c 8051 }
dd00328a 8052
333b20bb 8053 /* Create an image and pixmap serving as mask. */
45158a91 8054 rc = x_create_x_image_and_pixmap (f, img->width, img->height, 1,
333b20bb
GM		 8055 &mask_img, &img->mask);
8056 if (!rc)
28c7826c 8057 return 0;
333b20bb
GM		 8058
8059 /* Get the X image of IMG->pixmap. */
8060 ximg = XGetImage (dpy, img->pixmap, 0, 0, img->width, img->height,
8061 ~0, ZPixmap);
8062
fcf431dc
GM		 8063 /* Determine the background color of ximg. If HOW is `(R G B)'
8064 take that as color. Otherwise, try to determine the color
8065 heuristically. */
8066 look_at_corners_p = 1;
8067
8068 if (CONSP (how))
8069 {
8070 int rgb[3], i = 0;
8071
8072 while (i < 3
8073 && CONSP (how)
8074 && NATNUMP (XCAR (how)))
8075 {
8076 rgb[i] = XFASTINT (XCAR (how)) & 0xffff;
8077 how = XCDR (how);
8078 }
8079
8080 if (i == 3 && NILP (how))
8081 {
8082 char color_name[30];
8083 XColor exact, color;
8084 Colormap cmap;
8085
8086 sprintf (color_name, "#%04x%04x%04x", rgb[0], rgb[1], rgb[2]);
8087
9b2956e2 8088 cmap = FRAME_X_COLORMAP (f);
fcf431dc
GM		 8089 if (XLookupColor (dpy, cmap, color_name, &exact, &color))
8090 {
8091 bg = color.pixel;
8092 look_at_corners_p = 0;
8093 }
8094 }
8095 }
8096
8097 if (look_at_corners_p)
333b20bb
GM		 8098 {
8099 unsigned long corners[4];
8100 int i, best_count;
8101
8102 /* Get the colors at the corners of ximg. */
8103 corners[0] = XGetPixel (ximg, 0, 0);
8104 corners[1] = XGetPixel (ximg, img->width - 1, 0);
8105 corners[2] = XGetPixel (ximg, img->width - 1, img->height - 1);
8106 corners[3] = XGetPixel (ximg, 0, img->height - 1);
8107
8108 /* Choose the most frequently found color as background. */
8109 for (i = best_count = 0; i < 4; ++i)
8110 {
8111 int j, n;
8112
8113 for (j = n = 0; j < 4; ++j)
8114 if (corners[i] == corners[j])
8115 ++n;
8116
8117 if (n > best_count)
8118 bg = corners[i], best_count = n;
8119 }
8120 }
8121
8122 /* Set all bits in mask_img to 1 whose color in ximg is different
8123 from the background color bg. */
8124 for (y = 0; y < img->height; ++y)
8125 for (x = 0; x < img->width; ++x)
8126 XPutPixel (mask_img, x, y, XGetPixel (ximg, x, y) != bg);
8127
8128 /* Put mask_img into img->mask. */
8129 x_put_x_image (f, mask_img, img->mask, img->width, img->height);
8130 x_destroy_x_image (mask_img);
8131 XDestroyImage (ximg);
8132
333b20bb
GM		 8133 return 1;
8134}
8135
8136
8137\f
8138/***********************************************************************
8139 PBM (mono, gray, color)
8140 ***********************************************************************/
8141
8142static int pbm_image_p P_ ((Lisp_Object object));
8143static int pbm_load P_ ((struct frame *f, struct image *img));
63cec32f 8144static int pbm_scan_number P_ ((unsigned char **, unsigned char *));
333b20bb
GM		 8145
8146/* The symbol `pbm' identifying images of this type. */
8147
8148Lisp_Object Qpbm;
8149
8150/* Indices of image specification fields in gs_format, below. */
8151
8152enum pbm_keyword_index
8153{
8154 PBM_TYPE,
8155 PBM_FILE,
63cec32f 8156 PBM_DATA,
333b20bb
GM		 8157 PBM_ASCENT,
8158 PBM_MARGIN,
8159 PBM_RELIEF,
8160 PBM_ALGORITHM,
8161 PBM_HEURISTIC_MASK,
4a8e312c 8162 PBM_MASK,
be0b1fac
GM		 8163 PBM_FOREGROUND,
8164 PBM_BACKGROUND,
333b20bb
GM		 8165 PBM_LAST
8166};
8167
8168/* Vector of image_keyword structures describing the format
8169 of valid user-defined image specifications. */
8170
8171static struct image_keyword pbm_format[PBM_LAST] =
8172{
8173 {":type", IMAGE_SYMBOL_VALUE, 1},
63cec32f
GM		 8174 {":file", IMAGE_STRING_VALUE, 0},
8175 {":data", IMAGE_STRING_VALUE, 0},
7c7ff7f5 8176 {":ascent", IMAGE_ASCENT_VALUE, 0},
3ed61e75 8177 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
333b20bb 8178 {":relief", IMAGE_INTEGER_VALUE, 0},
d2dc8167 8179 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
4a8e312c 8180 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
be0b1fac 8181 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6f1be3b9
GM		 8182 {":foreground", IMAGE_STRING_OR_NIL_VALUE, 0},
8183 {":background", IMAGE_STRING_OR_NIL_VALUE, 0}
333b20bb
GM		 8184};
8185
8186/* Structure describing the image type `pbm'. */
8187
8188static struct image_type pbm_type =
8189{
8190 &Qpbm,
8191 pbm_image_p,
8192 pbm_load,
8193 x_clear_image,
8194 NULL
8195};
8196
8197
8198/* Return non-zero if OBJECT is a valid PBM image specification. */
8199
8200static int
8201pbm_image_p (object)
8202 Lisp_Object object;
8203{
8204 struct image_keyword fmt[PBM_LAST];
8205
8206 bcopy (pbm_format, fmt, sizeof fmt);
8207
7c7ff7f5 8208 if (!parse_image_spec (object, fmt, PBM_LAST, Qpbm))
333b20bb 8209 return 0;
63cec32f
GM		 8210
8211 /* Must specify either :data or :file. */
8212 return fmt[PBM_DATA].count + fmt[PBM_FILE].count == 1;
333b20bb
GM		 8213}
8214
8215
63cec32f
GM		 8216/* Scan a decimal number from *S and return it. Advance *S while
8217 reading the number. END is the end of the string. Value is -1 at
8218 end of input. */
333b20bb
GM		 8219
8220static int
63cec32f
GM		 8221pbm_scan_number (s, end)
8222 unsigned char **s, *end;
333b20bb 8223{
8ec8a5ec 8224 int c = 0, val = -1;
333b20bb 8225
63cec32f 8226 while (*s < end)
333b20bb
GM		 8227 {
8228 /* Skip white-space. */
63cec32f 8229 while (*s < end && (c = *(*s)++, isspace (c)))
333b20bb
GM		 8230 ;
8231
8232 if (c == '#')
8233 {
8234 /* Skip comment to end of line. */
63cec32f 8235 while (*s < end && (c = *(*s)++, c != '\n'))
333b20bb
GM		 8236 ;
8237 }
8238 else if (isdigit (c))
8239 {
8240 /* Read decimal number. */
8241 val = c - '0';
63cec32f 8242 while (*s < end && (c = *(*s)++, isdigit (c)))
333b20bb
GM		 8243 val = 10 * val + c - '0';
8244 break;
8245 }
8246 else
8247 break;
8248 }
8249
8250 return val;
8251}
8252
8253
8254/* Load PBM image IMG for use on frame F. */
8255
8256static int
8257pbm_load (f, img)
8258 struct frame *f;
8259 struct image *img;
8260{
333b20bb 8261 int raw_p, x, y;
b6d7acec 8262 int width, height, max_color_idx = 0;
333b20bb
GM		 8263 XImage *ximg;
8264 Lisp_Object file, specified_file;
8265 enum {PBM_MONO, PBM_GRAY, PBM_COLOR} type;
8266 struct gcpro gcpro1;
63cec32f
GM		 8267 unsigned char *contents = NULL;
8268 unsigned char *end, *p;
8269 int size;
333b20bb
GM		 8270
8271 specified_file = image_spec_value (img->spec, QCfile, NULL);
63cec32f 8272 file = Qnil;
333b20bb 8273 GCPRO1 (file);
333b20bb 8274
63cec32f 8275 if (STRINGP (specified_file))
333b20bb 8276 {
63cec32f
GM		 8277 file = x_find_image_file (specified_file);
8278 if (!STRINGP (file))
8279 {
8280 image_error ("Cannot find image file `%s'", specified_file, Qnil);
8281 UNGCPRO;
8282 return 0;
8283 }
333b20bb 8284
5be6c3b0 8285 contents = slurp_file (XSTRING (file)->data, &size);
63cec32f
GM		 8286 if (contents == NULL)
8287 {
8288 image_error ("Error reading `%s'", file, Qnil);
8289 UNGCPRO;
8290 return 0;
8291 }
8292
8293 p = contents;
8294 end = contents + size;
8295 }
8296 else
333b20bb 8297 {
63cec32f
GM		 8298 Lisp_Object data;
8299 data = image_spec_value (img->spec, QCdata, NULL);
8300 p = XSTRING (data)->data;
8301 end = p + STRING_BYTES (XSTRING (data));
333b20bb
GM		 8302 }
8303
63cec32f
GM		 8304 /* Check magic number. */
8305 if (end - p < 2 || *p++ != 'P')
333b20bb 8306 {
45158a91 8307 image_error ("Not a PBM image: `%s'", img->spec, Qnil);
63cec32f
GM		 8308 error:
8309 xfree (contents);
333b20bb
GM		 8310 UNGCPRO;
8311 return 0;
8312 }
8313
63cec32f 8314 switch (*p++)
333b20bb
GM		 8315 {
8316 case '1':
8317 raw_p = 0, type = PBM_MONO;
8318 break;
8319
8320 case '2':
8321 raw_p = 0, type = PBM_GRAY;
8322 break;
8323
8324 case '3':
8325 raw_p = 0, type = PBM_COLOR;
8326 break;
8327
8328 case '4':
8329 raw_p = 1, type = PBM_MONO;
8330 break;
8331
8332 case '5':
8333 raw_p = 1, type = PBM_GRAY;
8334 break;
8335
8336 case '6':
8337 raw_p = 1, type = PBM_COLOR;
8338 break;
8339
8340 default:
45158a91 8341 image_error ("Not a PBM image: `%s'", img->spec, Qnil);
63cec32f 8342 goto error;
333b20bb
GM		 8343 }
8344
8345 /* Read width, height, maximum color-component. Characters
8346 starting with `#' up to the end of a line are ignored. */
63cec32f
GM		 8347 width = pbm_scan_number (&p, end);
8348 height = pbm_scan_number (&p, end);
333b20bb
GM		 8349
8350 if (type != PBM_MONO)
8351 {
63cec32f 8352 max_color_idx = pbm_scan_number (&p, end);
333b20bb
GM		 8353 if (raw_p && max_color_idx > 255)
8354 max_color_idx = 255;
8355 }
8356
63cec32f
GM		 8357 if (width < 0
8358 || height < 0
333b20bb 8359 || (type != PBM_MONO && max_color_idx < 0))
63cec32f 8360 goto error;
333b20bb 8361
45158a91 8362 if (!x_create_x_image_and_pixmap (f, width, height, 0,
333b20bb 8363 &ximg, &img->pixmap))
28c7826c 8364 goto error;
333b20bb
GM		 8365
8366 /* Initialize the color hash table. */
8367 init_color_table ();
8368
8369 if (type == PBM_MONO)
8370 {
8371 int c = 0, g;
be0b1fac
GM		 8372 struct image_keyword fmt[PBM_LAST];
8373 unsigned long fg = FRAME_FOREGROUND_PIXEL (f);
8374 unsigned long bg = FRAME_BACKGROUND_PIXEL (f);
8375
8376 /* Parse the image specification. */
8377 bcopy (pbm_format, fmt, sizeof fmt);
8378 parse_image_spec (img->spec, fmt, PBM_LAST, Qpbm);
8379
8380 /* Get foreground and background colors, maybe allocate colors. */
6f1be3b9
GM		 8381 if (fmt[PBM_FOREGROUND].count
8382 && STRINGP (fmt[PBM_FOREGROUND].value))
be0b1fac 8383 fg = x_alloc_image_color (f, img, fmt[PBM_FOREGROUND].value, fg);
6f1be3b9
GM		 8384 if (fmt[PBM_BACKGROUND].count
8385 && STRINGP (fmt[PBM_BACKGROUND].value))
be0b1fac 8386 bg = x_alloc_image_color (f, img, fmt[PBM_BACKGROUND].value, bg);
333b20bb
GM		 8387
8388 for (y = 0; y < height; ++y)
8389 for (x = 0; x < width; ++x)
8390 {
8391 if (raw_p)
8392 {
8393 if ((x & 7) == 0)
63cec32f 8394 c = *p++;
333b20bb
GM		 8395 g = c & 0x80;
8396 c <<= 1;
8397 }
8398 else
63cec32f 8399 g = pbm_scan_number (&p, end);
333b20bb 8400
be0b1fac 8401 XPutPixel (ximg, x, y, g ? fg : bg);
333b20bb
GM		 8402 }
8403 }
8404 else
8405 {
8406 for (y = 0; y < height; ++y)
8407 for (x = 0; x < width; ++x)
8408 {
8409 int r, g, b;
8410
8411 if (type == PBM_GRAY)
63cec32f 8412 r = g = b = raw_p ? *p++ : pbm_scan_number (&p, end);
333b20bb
GM		 8413 else if (raw_p)
8414 {
63cec32f
GM		 8415 r = *p++;
8416 g = *p++;
8417 b = *p++;
333b20bb
GM		 8418 }
8419 else
8420 {
63cec32f
GM		 8421 r = pbm_scan_number (&p, end);
8422 g = pbm_scan_number (&p, end);
8423 b = pbm_scan_number (&p, end);
333b20bb
GM		 8424 }
8425
8426 if (r < 0 || g < 0 || b < 0)
8427 {
333b20bb
GM		 8428 xfree (ximg->data);
8429 ximg->data = NULL;
8430 XDestroyImage (ximg);
45158a91
GM		 8431 image_error ("Invalid pixel value in image `%s'",
8432 img->spec, Qnil);
63cec32f 8433 goto error;
333b20bb
GM		 8434 }
8435
8436 /* RGB values are now in the range 0..max_color_idx.
8437 Scale this to the range 0..0xffff supported by X. */
8438 r = (double) r * 65535 / max_color_idx;
8439 g = (double) g * 65535 / max_color_idx;
8440 b = (double) b * 65535 / max_color_idx;
8441 XPutPixel (ximg, x, y, lookup_rgb_color (f, r, g, b));
8442 }
8443 }
8444
333b20bb
GM		 8445 /* Store in IMG->colors the colors allocated for the image, and
8446 free the color table. */
8447 img->colors = colors_in_color_table (&img->ncolors);
8448 free_color_table ();
8449
8450 /* Put the image into a pixmap. */
8451 x_put_x_image (f, ximg, img->pixmap, width, height);
8452 x_destroy_x_image (ximg);
333b20bb
GM		 8453
8454 img->width = width;
8455 img->height = height;
8456
8457 UNGCPRO;
63cec32f 8458 xfree (contents);
333b20bb
GM		 8459 return 1;
8460}
8461
8462
8463\f
8464/***********************************************************************
8465 PNG
8466 ***********************************************************************/
8467
8468#if HAVE_PNG
8469
8470#include <png.h>
8471
8472/* Function prototypes. */
8473
8474static int png_image_p P_ ((Lisp_Object object));
8475static int png_load P_ ((struct frame *f, struct image *img));
8476
8477/* The symbol `png' identifying images of this type. */
8478
8479Lisp_Object Qpng;
8480
8481/* Indices of image specification fields in png_format, below. */
8482
8483enum png_keyword_index
8484{
8485 PNG_TYPE,
63448a4d 8486 PNG_DATA,
333b20bb
GM		 8487 PNG_FILE,
8488 PNG_ASCENT,
8489 PNG_MARGIN,
8490 PNG_RELIEF,
8491 PNG_ALGORITHM,
8492 PNG_HEURISTIC_MASK,
4a8e312c 8493 PNG_MASK,
333b20bb
GM		 8494 PNG_LAST
8495};
8496
8497/* Vector of image_keyword structures describing the format
8498 of valid user-defined image specifications. */
8499
8500static struct image_keyword png_format[PNG_LAST] =
8501{
8502 {":type", IMAGE_SYMBOL_VALUE, 1},
5ad6a5fb 8503 {":data", IMAGE_STRING_VALUE, 0},
63448a4d 8504 {":file", IMAGE_STRING_VALUE, 0},
7c7ff7f5 8505 {":ascent", IMAGE_ASCENT_VALUE, 0},
3ed61e75 8506 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
333b20bb 8507 {":relief", IMAGE_INTEGER_VALUE, 0},
d2dc8167 8508 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
4a8e312c
GM		 8509 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
8510 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
333b20bb
GM		 8511};
8512
06482119 8513/* Structure describing the image type `png'. */
333b20bb
GM		 8514
8515static struct image_type png_type =
8516{
8517 &Qpng,
8518 png_image_p,
8519 png_load,
8520 x_clear_image,
8521 NULL
8522};
8523
8524
8525/* Return non-zero if OBJECT is a valid PNG image specification. */
8526
8527static int
8528png_image_p (object)
8529 Lisp_Object object;
8530{
8531 struct image_keyword fmt[PNG_LAST];
8532 bcopy (png_format, fmt, sizeof fmt);
8533
7c7ff7f5 8534 if (!parse_image_spec (object, fmt, PNG_LAST, Qpng))
333b20bb 8535 return 0;
63448a4d 8536
63cec32f
GM		 8537 /* Must specify either the :data or :file keyword. */
8538 return fmt[PNG_FILE].count + fmt[PNG_DATA].count == 1;
333b20bb
GM		 8539}
8540
8541
8542/* Error and warning handlers installed when the PNG library
8543 is initialized. */
8544
8545static void
8546my_png_error (png_ptr, msg)
8547 png_struct *png_ptr;
8548 char *msg;
8549{
8550 xassert (png_ptr != NULL);
8551 image_error ("PNG error: %s", build_string (msg), Qnil);
8552 longjmp (png_ptr->jmpbuf, 1);
8553}
8554
8555
8556static void
8557my_png_warning (png_ptr, msg)
8558 png_struct *png_ptr;
8559 char *msg;
8560{
8561 xassert (png_ptr != NULL);
8562 image_error ("PNG warning: %s", build_string (msg), Qnil);
8563}
8564
5ad6a5fb
GM		 8565/* Memory source for PNG decoding. */
8566
63448a4d
WP		 8567struct png_memory_storage
8568{
5ad6a5fb
GM		 8569 unsigned char *bytes; /* The data */
8570 size_t len; /* How big is it? */
8571 int index; /* Where are we? */
63448a4d
WP		 8572};
8573
5ad6a5fb
GM		 8574
8575/* Function set as reader function when reading PNG image from memory.
8576 PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
8577 bytes from the input to DATA. */
8578
63448a4d 8579static void
5ad6a5fb
GM		 8580png_read_from_memory (png_ptr, data, length)
8581 png_structp png_ptr;
8582 png_bytep data;
8583 png_size_t length;
63448a4d 8584{
5ad6a5fb
GM		 8585 struct png_memory_storage *tbr
8586 = (struct png_memory_storage *) png_get_io_ptr (png_ptr);
63448a4d 8587
5ad6a5fb
GM		 8588 if (length > tbr->len - tbr->index)
8589 png_error (png_ptr, "Read error");
8590
8591 bcopy (tbr->bytes + tbr->index, data, length);
8592 tbr->index = tbr->index + length;
63448a4d 8593}
333b20bb
GM		 8594
8595/* Load PNG image IMG for use on frame F. Value is non-zero if
8596 successful. */
8597
8598static int
8599png_load (f, img)
8600 struct frame *f;
8601 struct image *img;
8602{
8603 Lisp_Object file, specified_file;
63448a4d 8604 Lisp_Object specified_data;
b6d7acec 8605 int x, y, i;
333b20bb
GM		 8606 XImage *ximg, *mask_img = NULL;
8607 struct gcpro gcpro1;
8608 png_struct *png_ptr = NULL;
8609 png_info *info_ptr = NULL, *end_info = NULL;
8ec8a5ec 8610 FILE *volatile fp = NULL;
333b20bb 8611 png_byte sig[8];
8ec8a5ec
GM		 8612 png_byte * volatile pixels = NULL;
8613 png_byte ** volatile rows = NULL;
333b20bb
GM		 8614 png_uint_32 width, height;
8615 int bit_depth, color_type, interlace_type;
8616 png_byte channels;
8617 png_uint_32 row_bytes;
8618 int transparent_p;
8619 char *gamma_str;
8620 double screen_gamma, image_gamma;
8621 int intent;
63448a4d 8622 struct png_memory_storage tbr; /* Data to be read */
333b20bb
GM		 8623
8624 /* Find out what file to load. */
8625 specified_file = image_spec_value (img->spec, QCfile, NULL);
63448a4d 8626 specified_data = image_spec_value (img->spec, QCdata, NULL);
5ad6a5fb
GM		 8627 file = Qnil;
8628 GCPRO1 (file);
333b20bb 8629
63448a4d 8630 if (NILP (specified_data))
5ad6a5fb
GM		 8631 {
8632 file = x_find_image_file (specified_file);
8633 if (!STRINGP (file))
63448a4d 8634 {
45158a91 8635 image_error ("Cannot find image file `%s'", specified_file, Qnil);
5ad6a5fb
GM		 8636 UNGCPRO;
8637 return 0;
8638 }
333b20bb 8639
5ad6a5fb
GM		 8640 /* Open the image file. */
8641 fp = fopen (XSTRING (file)->data, "rb");
8642 if (!fp)
8643 {
45158a91 8644 image_error ("Cannot open image file `%s'", file, Qnil);
5ad6a5fb
GM		 8645 UNGCPRO;
8646 fclose (fp);
8647 return 0;
8648 }
63448a4d 8649
5ad6a5fb
GM		 8650 /* Check PNG signature. */
8651 if (fread (sig, 1, sizeof sig, fp) != sizeof sig
8652 || !png_check_sig (sig, sizeof sig))
8653 {
45158a91 8654 image_error ("Not a PNG file: `%s'", file, Qnil);
5ad6a5fb
GM		 8655 UNGCPRO;
8656 fclose (fp);
8657 return 0;
63448a4d 8658 }
5ad6a5fb 8659 }
63448a4d 8660 else
5ad6a5fb
GM		 8661 {
8662 /* Read from memory. */
8663 tbr.bytes = XSTRING (specified_data)->data;
8664 tbr.len = STRING_BYTES (XSTRING (specified_data));
8665 tbr.index = 0;
63448a4d 8666
5ad6a5fb
GM		 8667 /* Check PNG signature. */
8668 if (tbr.len < sizeof sig
8669 || !png_check_sig (tbr.bytes, sizeof sig))
8670 {
45158a91 8671 image_error ("Not a PNG image: `%s'", img->spec, Qnil);
5ad6a5fb
GM		 8672 UNGCPRO;
8673 return 0;
63448a4d 8674 }
333b20bb 8675
5ad6a5fb
GM		 8676 /* Need to skip past the signature. */
8677 tbr.bytes += sizeof (sig);
8678 }
8679
333b20bb
GM		 8680 /* Initialize read and info structs for PNG lib. */
8681 png_ptr = png_create_read_struct (PNG_LIBPNG_VER_STRING, NULL,
8682 my_png_error, my_png_warning);
8683 if (!png_ptr)
8684 {
63448a4d 8685 if (fp) fclose (fp);
333b20bb
GM		 8686 UNGCPRO;
8687 return 0;
8688 }
8689
8690 info_ptr = png_create_info_struct (png_ptr);
8691 if (!info_ptr)
8692 {
8693 png_destroy_read_struct (&png_ptr, NULL, NULL);
63448a4d 8694 if (fp) fclose (fp);
333b20bb
GM		 8695 UNGCPRO;
8696 return 0;
8697 }
8698
8699 end_info = png_create_info_struct (png_ptr);
8700 if (!end_info)
8701 {
8702 png_destroy_read_struct (&png_ptr, &info_ptr, NULL);
63448a4d 8703 if (fp) fclose (fp);
333b20bb
GM		 8704 UNGCPRO;
8705 return 0;
8706 }
8707
8708 /* Set error jump-back. We come back here when the PNG library
8709 detects an error. */
8710 if (setjmp (png_ptr->jmpbuf))
8711 {
8712 error:
8713 if (png_ptr)
8714 png_destroy_read_struct (&png_ptr, &info_ptr, &end_info);
8715 xfree (pixels);
8716 xfree (rows);
63448a4d 8717 if (fp) fclose (fp);
333b20bb
GM		 8718 UNGCPRO;
8719 return 0;
8720 }
8721
8722 /* Read image info. */
63448a4d 8723 if (!NILP (specified_data))
5ad6a5fb 8724 png_set_read_fn (png_ptr, (void *) &tbr, png_read_from_memory);
63448a4d 8725 else
5ad6a5fb 8726 png_init_io (png_ptr, fp);
63448a4d 8727
333b20bb
GM		 8728 png_set_sig_bytes (png_ptr, sizeof sig);
8729 png_read_info (png_ptr, info_ptr);
8730 png_get_IHDR (png_ptr, info_ptr, &width, &height, &bit_depth, &color_type,
8731 &interlace_type, NULL, NULL);
8732
8733 /* If image contains simply transparency data, we prefer to
8734 construct a clipping mask. */
8735 if (png_get_valid (png_ptr, info_ptr, PNG_INFO_tRNS))
8736 transparent_p = 1;
8737 else
8738 transparent_p = 0;
8739
8740 /* This function is easier to write if we only have to handle
8741 one data format: RGB or RGBA with 8 bits per channel. Let's
8742 transform other formats into that format. */
8743
8744 /* Strip more than 8 bits per channel. */
8745 if (bit_depth == 16)
8746 png_set_strip_16 (png_ptr);
8747
8748 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
8749 if available. */
8750 png_set_expand (png_ptr);
8751
8752 /* Convert grayscale images to RGB. */
8753 if (color_type == PNG_COLOR_TYPE_GRAY
8754 || color_type == PNG_COLOR_TYPE_GRAY_ALPHA)
8755 png_set_gray_to_rgb (png_ptr);
8756
8757 /* The value 2.2 is a guess for PC monitors from PNG example.c. */
8758 gamma_str = getenv ("SCREEN_GAMMA");
8759 screen_gamma = gamma_str ? atof (gamma_str) : 2.2;
8760
8761 /* Tell the PNG lib to handle gamma correction for us. */
8762
6c1aa34d 8763#if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
333b20bb
GM		 8764 if (png_get_sRGB (png_ptr, info_ptr, &intent))
8765 /* There is a special chunk in the image specifying the gamma. */
8766 png_set_sRGB (png_ptr, info_ptr, intent);
6c1aa34d
GM		 8767 else
8768#endif
8769 if (png_get_gAMA (png_ptr, info_ptr, &image_gamma))
333b20bb
GM		 8770 /* Image contains gamma information. */
8771 png_set_gamma (png_ptr, screen_gamma, image_gamma);
8772 else
8773 /* Use a default of 0.5 for the image gamma. */
8774 png_set_gamma (png_ptr, screen_gamma, 0.5);
8775
8776 /* Handle alpha channel by combining the image with a background
8777 color. Do this only if a real alpha channel is supplied. For
8778 simple transparency, we prefer a clipping mask. */
8779 if (!transparent_p)
8780 {
8781 png_color_16 *image_background;
8782
8783 if (png_get_bKGD (png_ptr, info_ptr, &image_background))
8784 /* Image contains a background color with which to
8785 combine the image. */
8786 png_set_background (png_ptr, image_background,
8787 PNG_BACKGROUND_GAMMA_FILE, 1, 1.0);
8788 else
8789 {
8790 /* Image does not contain a background color with which
8791 to combine the image data via an alpha channel. Use
8792 the frame's background instead. */
8793 XColor color;
8794 Colormap cmap;
8795 png_color_16 frame_background;
8796
9b2956e2 8797 cmap = FRAME_X_COLORMAP (f);
333b20bb 8798 color.pixel = FRAME_BACKGROUND_PIXEL (f);
a31fedb7 8799 x_query_color (f, &color);
333b20bb
GM		 8800
8801 bzero (&frame_background, sizeof frame_background);
8802 frame_background.red = color.red;
8803 frame_background.green = color.green;
8804 frame_background.blue = color.blue;
8805
8806 png_set_background (png_ptr, &frame_background,
8807 PNG_BACKGROUND_GAMMA_SCREEN, 0, 1.0);
8808 }
8809 }
8810
8811 /* Update info structure. */
8812 png_read_update_info (png_ptr, info_ptr);
8813
8814 /* Get number of channels. Valid values are 1 for grayscale images
8815 and images with a palette, 2 for grayscale images with transparency
8816 information (alpha channel), 3 for RGB images, and 4 for RGB
8817 images with alpha channel, i.e. RGBA. If conversions above were
8818 sufficient we should only have 3 or 4 channels here. */
8819 channels = png_get_channels (png_ptr, info_ptr);
8820 xassert (channels == 3 || channels == 4);
8821
8822 /* Number of bytes needed for one row of the image. */
8823 row_bytes = png_get_rowbytes (png_ptr, info_ptr);
8824
8825 /* Allocate memory for the image. */
8826 pixels = (png_byte *) xmalloc (row_bytes * height * sizeof *pixels);
8827 rows = (png_byte **) xmalloc (height * sizeof *rows);
8828 for (i = 0; i < height; ++i)
8829 rows[i] = pixels + i * row_bytes;
8830
8831 /* Read the entire image. */
8832 png_read_image (png_ptr, rows);
8833 png_read_end (png_ptr, info_ptr);
5ad6a5fb
GM		 8834 if (fp)
8835 {
8836 fclose (fp);
8837 fp = NULL;
8838 }
333b20bb 8839
333b20bb 8840 /* Create the X image and pixmap. */
45158a91 8841 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg,
333b20bb 8842 &img->pixmap))
28c7826c 8843 goto error;
333b20bb
GM		 8844
8845 /* Create an image and pixmap serving as mask if the PNG image
8846 contains an alpha channel. */
8847 if (channels == 4
8848 && !transparent_p
45158a91 8849 && !x_create_x_image_and_pixmap (f, width, height, 1,
333b20bb
GM		 8850 &mask_img, &img->mask))
8851 {
8852 x_destroy_x_image (ximg);
8853 XFreePixmap (FRAME_X_DISPLAY (f), img->pixmap);
dd00328a 8854 img->pixmap = None;
333b20bb
GM		 8855 goto error;
8856 }
8857
8858 /* Fill the X image and mask from PNG data. */
8859 init_color_table ();
8860
8861 for (y = 0; y < height; ++y)
8862 {
8863 png_byte *p = rows[y];
8864
8865 for (x = 0; x < width; ++x)
8866 {
8867 unsigned r, g, b;
8868
8869 r = *p++ << 8;
8870 g = *p++ << 8;
8871 b = *p++ << 8;
8872 XPutPixel (ximg, x, y, lookup_rgb_color (f, r, g, b));
8873
8874 /* An alpha channel, aka mask channel, associates variable
8875 transparency with an image. Where other image formats
8876 support binary transparency---fully transparent or fully
8877 opaque---PNG allows up to 254 levels of partial transparency.
8878 The PNG library implements partial transparency by combining
8879 the image with a specified background color.
8880
8881 I'm not sure how to handle this here nicely: because the
8882 background on which the image is displayed may change, for
8883 real alpha channel support, it would be necessary to create
8884 a new image for each possible background.
8885
8886 What I'm doing now is that a mask is created if we have
8887 boolean transparency information. Otherwise I'm using
8888 the frame's background color to combine the image with. */
8889
8890 if (channels == 4)
8891 {
8892 if (mask_img)
8893 XPutPixel (mask_img, x, y, *p > 0);
8894 ++p;
8895 }
8896 }
8897 }
8898
8899 /* Remember colors allocated for this image. */
8900 img->colors = colors_in_color_table (&img->ncolors);
8901 free_color_table ();
8902
8903 /* Clean up. */
8904 png_destroy_read_struct (&png_ptr, &info_ptr, &end_info);
8905 xfree (rows);
8906 xfree (pixels);
8907
8908 img->width = width;
8909 img->height = height;
8910
8911 /* Put the image into the pixmap, then free the X image and its buffer. */
8912 x_put_x_image (f, ximg, img->pixmap, width, height);
8913 x_destroy_x_image (ximg);
8914
8915 /* Same for the mask. */
8916 if (mask_img)
8917 {
8918 x_put_x_image (f, mask_img, img->mask, img->width, img->height);
8919 x_destroy_x_image (mask_img);
8920 }
8921
333b20bb
GM		 8922 UNGCPRO;
8923 return 1;
8924}
8925
8926#endif /* HAVE_PNG != 0 */
8927
8928
8929\f
8930/***********************************************************************
8931 JPEG
8932 ***********************************************************************/
8933
8934#if HAVE_JPEG
8935
ba06aba4
GM		 8936/* Work around a warning about HAVE_STDLIB_H being redefined in
8937 jconfig.h. */
8938#ifdef HAVE_STDLIB_H
8939#define HAVE_STDLIB_H_1
8940#undef HAVE_STDLIB_H
8941#endif /* HAVE_STLIB_H */
8942
333b20bb
GM		 8943#include <jpeglib.h>
8944#include <jerror.h>
8945#include <setjmp.h>
8946
ba06aba4
GM		 8947#ifdef HAVE_STLIB_H_1
8948#define HAVE_STDLIB_H 1
8949#endif
8950
333b20bb
GM		 8951static int jpeg_image_p P_ ((Lisp_Object object));
8952static int jpeg_load P_ ((struct frame *f, struct image *img));
8953
8954/* The symbol `jpeg' identifying images of this type. */
8955
8956Lisp_Object Qjpeg;
8957
8958/* Indices of image specification fields in gs_format, below. */
8959
8960enum jpeg_keyword_index
8961{
8962 JPEG_TYPE,
8e39770a 8963 JPEG_DATA,
333b20bb
GM		 8964 JPEG_FILE,
8965 JPEG_ASCENT,
8966 JPEG_MARGIN,
8967 JPEG_RELIEF,
8968 JPEG_ALGORITHM,
8969 JPEG_HEURISTIC_MASK,
4a8e312c 8970 JPEG_MASK,
333b20bb
GM		 8971 JPEG_LAST
8972};
8973
8974/* Vector of image_keyword structures describing the format
8975 of valid user-defined image specifications. */
8976
8977static struct image_keyword jpeg_format[JPEG_LAST] =
8978{
8979 {":type", IMAGE_SYMBOL_VALUE, 1},
5ad6a5fb 8980 {":data", IMAGE_STRING_VALUE, 0},
8e39770a 8981 {":file", IMAGE_STRING_VALUE, 0},
7c7ff7f5 8982 {":ascent", IMAGE_ASCENT_VALUE, 0},
3ed61e75 8983 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
333b20bb 8984 {":relief", IMAGE_INTEGER_VALUE, 0},
d2dc8167 8985 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
4a8e312c
GM		 8986 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
8987 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
333b20bb
GM		 8988};
8989
8990/* Structure describing the image type `jpeg'. */
8991
8992static struct image_type jpeg_type =
8993{
8994 &Qjpeg,
8995 jpeg_image_p,
8996 jpeg_load,
8997 x_clear_image,
8998 NULL
8999};
9000
9001
9002/* Return non-zero if OBJECT is a valid JPEG image specification. */
9003
9004static int
9005jpeg_image_p (object)
9006 Lisp_Object object;
9007{
9008 struct image_keyword fmt[JPEG_LAST];
9009
9010 bcopy (jpeg_format, fmt, sizeof fmt);
9011
7c7ff7f5 9012 if (!parse_image_spec (object, fmt, JPEG_LAST, Qjpeg))
333b20bb 9013 return 0;
8e39770a 9014
63cec32f
GM		 9015 /* Must specify either the :data or :file keyword. */
9016 return fmt[JPEG_FILE].count + fmt[JPEG_DATA].count == 1;
333b20bb
GM		 9017}
9018
8e39770a 9019
333b20bb
GM		 9020struct my_jpeg_error_mgr
9021{
9022 struct jpeg_error_mgr pub;
9023 jmp_buf setjmp_buffer;
9024};
9025
e3130015 9026
333b20bb
GM		 9027static void
9028my_error_exit (cinfo)
9029 j_common_ptr cinfo;
9030{
9031 struct my_jpeg_error_mgr *mgr = (struct my_jpeg_error_mgr *) cinfo->err;
9032 longjmp (mgr->setjmp_buffer, 1);
9033}
9034
e3130015 9035
8e39770a
GM		 9036/* Init source method for JPEG data source manager. Called by
9037 jpeg_read_header() before any data is actually read. See
9038 libjpeg.doc from the JPEG lib distribution. */
9039
9040static void
9041our_init_source (cinfo)
9042 j_decompress_ptr cinfo;
9043{
9044}
9045
9046
9047/* Fill input buffer method for JPEG data source manager. Called
9048 whenever more data is needed. We read the whole image in one step,
9049 so this only adds a fake end of input marker at the end. */
9050
9051static boolean
9052our_fill_input_buffer (cinfo)
9053 j_decompress_ptr cinfo;
9054{
9055 /* Insert a fake EOI marker. */
9056 struct jpeg_source_mgr *src = cinfo->src;
9057 static JOCTET buffer[2];
9058
9059 buffer[0] = (JOCTET) 0xFF;
9060 buffer[1] = (JOCTET) JPEG_EOI;
9061
9062 src->next_input_byte = buffer;
9063 src->bytes_in_buffer = 2;
9064 return TRUE;
9065}
9066
9067
9068/* Method to skip over NUM_BYTES bytes in the image data. CINFO->src
9069 is the JPEG data source manager. */
9070
9071static void
9072our_skip_input_data (cinfo, num_bytes)
9073 j_decompress_ptr cinfo;
9074 long num_bytes;
9075{
9076 struct jpeg_source_mgr *src = (struct jpeg_source_mgr *) cinfo->src;
9077
9078 if (src)
9079 {
9080 if (num_bytes > src->bytes_in_buffer)
5ad6a5fb 9081 ERREXIT (cinfo, JERR_INPUT_EOF);
8e39770a
GM		 9082
9083 src->bytes_in_buffer -= num_bytes;
9084 src->next_input_byte += num_bytes;
9085 }
9086}
9087
9088
9089/* Method to terminate data source. Called by
9090 jpeg_finish_decompress() after all data has been processed. */
9091
9092static void
9093our_term_source (cinfo)
9094 j_decompress_ptr cinfo;
9095{
9096}
9097
9098
9099/* Set up the JPEG lib for reading an image from DATA which contains
9100 LEN bytes. CINFO is the decompression info structure created for
9101 reading the image. */
9102
9103static void
9104jpeg_memory_src (cinfo, data, len)
9105 j_decompress_ptr cinfo;
9106 JOCTET *data;
9107 unsigned int len;
9108{
9109 struct jpeg_source_mgr *src;
9110
9111 if (cinfo->src == NULL)
9112 {
9113 /* First time for this JPEG object? */
9114 cinfo->src = (struct jpeg_source_mgr *)
9115 (*cinfo->mem->alloc_small) ((j_common_ptr) cinfo, JPOOL_PERMANENT,
9116 sizeof (struct jpeg_source_mgr));
9117 src = (struct jpeg_source_mgr *) cinfo->src;
9118 src->next_input_byte = data;
9119 }
9120
9121 src = (struct jpeg_source_mgr *) cinfo->src;
9122 src->init_source = our_init_source;
9123 src->fill_input_buffer = our_fill_input_buffer;
9124 src->skip_input_data = our_skip_input_data;
9125 src->resync_to_restart = jpeg_resync_to_restart; /* Use default method. */
9126 src->term_source = our_term_source;
9127 src->bytes_in_buffer = len;
9128 src->next_input_byte = data;
9129}
9130
5ad6a5fb 9131
333b20bb
GM		 9132/* Load image IMG for use on frame F. Patterned after example.c
9133 from the JPEG lib. */
9134
9135static int
9136jpeg_load (f, img)
9137 struct frame *f;
9138 struct image *img;
9139{
9140 struct jpeg_decompress_struct cinfo;
9141 struct my_jpeg_error_mgr mgr;
9142 Lisp_Object file, specified_file;
8e39770a 9143 Lisp_Object specified_data;
8ec8a5ec 9144 FILE * volatile fp = NULL;
333b20bb
GM		 9145 JSAMPARRAY buffer;
9146 int row_stride, x, y;
9147 XImage *ximg = NULL;
b6d7acec 9148 int rc;
333b20bb
GM		 9149 unsigned long *colors;
9150 int width, height;
9151 struct gcpro gcpro1;
9152
9153 /* Open the JPEG file. */
9154 specified_file = image_spec_value (img->spec, QCfile, NULL);
8e39770a 9155 specified_data = image_spec_value (img->spec, QCdata, NULL);
5ad6a5fb
GM		 9156 file = Qnil;
9157 GCPRO1 (file);
8e39770a 9158
8e39770a 9159 if (NILP (specified_data))
333b20bb 9160 {
8e39770a 9161 file = x_find_image_file (specified_file);
8e39770a
GM		 9162 if (!STRINGP (file))
9163 {
45158a91 9164 image_error ("Cannot find image file `%s'", specified_file, Qnil);
8e39770a
GM		 9165 UNGCPRO;
9166 return 0;
9167 }
333b20bb 9168
8e39770a
GM		 9169 fp = fopen (XSTRING (file)->data, "r");
9170 if (fp == NULL)
9171 {
9172 image_error ("Cannot open `%s'", file, Qnil);
9173 UNGCPRO;
9174 return 0;
9175 }
333b20bb
GM		 9176 }
9177
5ad6a5fb
GM		 9178 /* Customize libjpeg's error handling to call my_error_exit when an
9179 error is detected. This function will perform a longjmp. */
333b20bb 9180 cinfo.err = jpeg_std_error (&mgr.pub);
14358466 9181 mgr.pub.error_exit = my_error_exit;
333b20bb
GM		 9182
9183 if ((rc = setjmp (mgr.setjmp_buffer)) != 0)
9184 {
5ad6a5fb
GM		 9185 if (rc == 1)
9186 {
9187 /* Called from my_error_exit. Display a JPEG error. */
9188 char buffer[JMSG_LENGTH_MAX];
9189 cinfo.err->format_message ((j_common_ptr) &cinfo, buffer);
45158a91 9190 image_error ("Error reading JPEG image `%s': %s", img->spec,
5ad6a5fb
GM		 9191 build_string (buffer));
9192 }
333b20bb
GM		 9193
9194 /* Close the input file and destroy the JPEG object. */
5ad6a5fb 9195 if (fp)
8ec8a5ec 9196 fclose ((FILE *) fp);
333b20bb
GM		 9197 jpeg_destroy_decompress (&cinfo);
9198
5ad6a5fb
GM		 9199 /* If we already have an XImage, free that. */
9200 x_destroy_x_image (ximg);
333b20bb 9201
5ad6a5fb
GM		 9202 /* Free pixmap and colors. */
9203 x_clear_image (f, img);
333b20bb 9204
5ad6a5fb
GM		 9205 UNGCPRO;
9206 return 0;
333b20bb
GM		 9207 }
9208
9209 /* Create the JPEG decompression object. Let it read from fp.
63448a4d 9210 Read the JPEG image header. */
333b20bb 9211 jpeg_create_decompress (&cinfo);
8e39770a
GM		 9212
9213 if (NILP (specified_data))
8ec8a5ec 9214 jpeg_stdio_src (&cinfo, (FILE *) fp);
8e39770a
GM		 9215 else
9216 jpeg_memory_src (&cinfo, XSTRING (specified_data)->data,
9217 STRING_BYTES (XSTRING (specified_data)));
63448a4d 9218
333b20bb
GM		 9219 jpeg_read_header (&cinfo, TRUE);
9220
9221 /* Customize decompression so that color quantization will be used.
63448a4d 9222 Start decompression. */
333b20bb
GM		 9223 cinfo.quantize_colors = TRUE;
9224 jpeg_start_decompress (&cinfo);
9225 width = img->width = cinfo.output_width;
9226 height = img->height = cinfo.output_height;
9227
333b20bb 9228 /* Create X image and pixmap. */
45158a91 9229 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg, &img->pixmap))
28c7826c 9230 longjmp (mgr.setjmp_buffer, 2);
333b20bb
GM		 9231
9232 /* Allocate colors. When color quantization is used,
5ad6a5fb
GM		 9233 cinfo.actual_number_of_colors has been set with the number of
9234 colors generated, and cinfo.colormap is a two-dimensional array
9235 of color indices in the range 0..cinfo.actual_number_of_colors.
9236 No more than 255 colors will be generated. */
333b20bb 9237 {
5ad6a5fb
GM		 9238 int i, ir, ig, ib;
9239
9240 if (cinfo.out_color_components > 2)
9241 ir = 0, ig = 1, ib = 2;
9242 else if (cinfo.out_color_components > 1)
9243 ir = 0, ig = 1, ib = 0;
9244 else
9245 ir = 0, ig = 0, ib = 0;
9246
9247 /* Use the color table mechanism because it handles colors that
9248 cannot be allocated nicely. Such colors will be replaced with
9249 a default color, and we don't have to care about which colors
9250 can be freed safely, and which can't. */
9251 init_color_table ();
9252 colors = (unsigned long *) alloca (cinfo.actual_number_of_colors
9253 * sizeof *colors);
333b20bb 9254
5ad6a5fb
GM		 9255 for (i = 0; i < cinfo.actual_number_of_colors; ++i)
9256 {
9257 /* Multiply RGB values with 255 because X expects RGB values
9258 in the range 0..0xffff. */
9259 int r = cinfo.colormap[ir][i] << 8;
9260 int g = cinfo.colormap[ig][i] << 8;
9261 int b = cinfo.colormap[ib][i] << 8;
9262 colors[i] = lookup_rgb_color (f, r, g, b);
9263 }
333b20bb 9264
5ad6a5fb
GM		 9265 /* Remember those colors actually allocated. */
9266 img->colors = colors_in_color_table (&img->ncolors);
9267 free_color_table ();
333b20bb
GM		 9268 }
9269
9270 /* Read pixels. */
9271 row_stride = width * cinfo.output_components;
9272 buffer = cinfo.mem->alloc_sarray ((j_common_ptr) &cinfo, JPOOL_IMAGE,
5ad6a5fb 9273 row_stride, 1);
333b20bb
GM		 9274 for (y = 0; y < height; ++y)
9275 {
5ad6a5fb
GM		 9276 jpeg_read_scanlines (&cinfo, buffer, 1);
9277 for (x = 0; x < cinfo.output_width; ++x)
9278 XPutPixel (ximg, x, y, colors[buffer[0][x]]);
333b20bb
GM		 9279 }
9280
9281 /* Clean up. */
9282 jpeg_finish_decompress (&cinfo);
9283 jpeg_destroy_decompress (&cinfo);
5ad6a5fb 9284 if (fp)
8ec8a5ec 9285 fclose ((FILE *) fp);
333b20bb
GM		 9286
9287 /* Put the image into the pixmap. */
9288 x_put_x_image (f, ximg, img->pixmap, width, height);
9289 x_destroy_x_image (ximg);
333b20bb
GM		 9290 UNGCPRO;
9291 return 1;
9292}
9293
9294#endif /* HAVE_JPEG */
9295
9296
9297\f
9298/***********************************************************************
9299 TIFF
9300 ***********************************************************************/
9301
9302#if HAVE_TIFF
9303
cf4790ad 9304#include <tiffio.h>
333b20bb
GM		 9305
9306static int tiff_image_p P_ ((Lisp_Object object));
9307static int tiff_load P_ ((struct frame *f, struct image *img));
9308
9309/* The symbol `tiff' identifying images of this type. */
9310
9311Lisp_Object Qtiff;
9312
9313/* Indices of image specification fields in tiff_format, below. */
9314
9315enum tiff_keyword_index
9316{
9317 TIFF_TYPE,
63448a4d 9318 TIFF_DATA,
333b20bb
GM		 9319 TIFF_FILE,
9320 TIFF_ASCENT,
9321 TIFF_MARGIN,
9322 TIFF_RELIEF,
9323 TIFF_ALGORITHM,
9324 TIFF_HEURISTIC_MASK,
4a8e312c 9325 TIFF_MASK,
333b20bb
GM		 9326 TIFF_LAST
9327};
9328
9329/* Vector of image_keyword structures describing the format
9330 of valid user-defined image specifications. */
9331
9332static struct image_keyword tiff_format[TIFF_LAST] =
9333{
9334 {":type", IMAGE_SYMBOL_VALUE, 1},
5ad6a5fb 9335 {":data", IMAGE_STRING_VALUE, 0},
63448a4d 9336 {":file", IMAGE_STRING_VALUE, 0},
7c7ff7f5 9337 {":ascent", IMAGE_ASCENT_VALUE, 0},
3ed61e75 9338 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
333b20bb 9339 {":relief", IMAGE_INTEGER_VALUE, 0},
d2dc8167 9340 {":conversions", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
4a8e312c
GM		 9341 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
9342 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
333b20bb
GM		 9343};
9344
9345/* Structure describing the image type `tiff'. */
9346
9347static struct image_type tiff_type =
9348{
9349 &Qtiff,
9350 tiff_image_p,
9351 tiff_load,
9352 x_clear_image,
9353 NULL
9354};
9355
9356
9357/* Return non-zero if OBJECT is a valid TIFF image specification. */
9358
9359static int
9360tiff_image_p (object)
9361 Lisp_Object object;
9362{
9363 struct image_keyword fmt[TIFF_LAST];
9364 bcopy (tiff_format, fmt, sizeof fmt);
9365
7c7ff7f5 9366 if (!parse_image_spec (object, fmt, TIFF_LAST, Qtiff))
333b20bb 9367 return 0;
5ad6a5fb 9368
63cec32f
GM		 9369 /* Must specify either the :data or :file keyword. */
9370 return fmt[TIFF_FILE].count + fmt[TIFF_DATA].count == 1;
333b20bb
GM		 9371}
9372
5ad6a5fb
GM		 9373
9374/* Reading from a memory buffer for TIFF images Based on the PNG
9375 memory source, but we have to provide a lot of extra functions.
9376 Blah.
63448a4d
WP		 9377
9378 We really only need to implement read and seek, but I am not
9379 convinced that the TIFF library is smart enough not to destroy
9380 itself if we only hand it the function pointers we need to
5ad6a5fb
GM		 9381 override. */
9382
9383typedef struct
9384{
63448a4d
WP		 9385 unsigned char *bytes;
9386 size_t len;
9387 int index;
5ad6a5fb
GM		 9388}
9389tiff_memory_source;
63448a4d 9390
e3130015 9391
5ad6a5fb
GM		 9392static size_t
9393tiff_read_from_memory (data, buf, size)
9394 thandle_t data;
9395 tdata_t buf;
9396 tsize_t size;
63448a4d 9397{
5ad6a5fb 9398 tiff_memory_source *src = (tiff_memory_source *) data;
63448a4d
WP		 9399
9400 if (size > src->len - src->index)
5ad6a5fb
GM		 9401 return (size_t) -1;
9402 bcopy (src->bytes + src->index, buf, size);
63448a4d
WP		 9403 src->index += size;
9404 return size;
9405}
9406
e3130015 9407
5ad6a5fb
GM		 9408static size_t
9409tiff_write_from_memory (data, buf, size)
9410 thandle_t data;
9411 tdata_t buf;
9412 tsize_t size;
63448a4d
WP		 9413{
9414 return (size_t) -1;
9415}
9416
e3130015 9417
5ad6a5fb
GM		 9418static toff_t
9419tiff_seek_in_memory (data, off, whence)
9420 thandle_t data;
9421 toff_t off;
9422 int whence;
63448a4d 9423{
5ad6a5fb 9424 tiff_memory_source *src = (tiff_memory_source *) data;
63448a4d
WP		 9425 int idx;
9426
9427 switch (whence)
5ad6a5fb
GM		 9428 {
9429 case SEEK_SET: /* Go from beginning of source. */
9430 idx = off;
9431 break;
9432
9433 case SEEK_END: /* Go from end of source. */
9434 idx = src->len + off;
9435 break;
9436
9437 case SEEK_CUR: /* Go from current position. */
9438 idx = src->index + off;
9439 break;
9440
9441 default: /* Invalid `whence'. */
9442 return -1;
9443 }
9444
9445 if (idx > src->len || idx < 0)
9446 return -1;
9447
63448a4d
WP		 9448 src->index = idx;
9449 return src->index;
9450}
9451
e3130015 9452
5ad6a5fb
GM		 9453static int
9454tiff_close_memory (data)
9455 thandle_t data;
63448a4d
WP		 9456{
9457 /* NOOP */
5ad6a5fb 9458 return 0;
63448a4d
WP		 9459}
9460
e3130015 9461
5ad6a5fb
GM		 9462static int
9463tiff_mmap_memory (data, pbase, psize)
9464 thandle_t data;
9465 tdata_t *pbase;
9466 toff_t *psize;
63448a4d
WP		 9467{
9468 /* It is already _IN_ memory. */
5ad6a5fb 9469 return 0;
63448a4d
WP		 9470}
9471
e3130015 9472
5ad6a5fb
GM		 9473static void
9474tiff_unmap_memory (data, base, size)
9475 thandle_t data;
9476 tdata_t base;
9477 toff_t size;
63448a4d
WP		 9478{
9479 /* We don't need to do this. */
63448a4d
WP		 9480}
9481
e3130015 9482
5ad6a5fb
GM		 9483static toff_t
9484tiff_size_of_memory (data)
9485 thandle_t data;
63448a4d 9486{
5ad6a5fb 9487 return ((tiff_memory_source *) data)->len;
63448a4d 9488}
333b20bb 9489
e3130015 9490
c6892044
GM		 9491static void
9492tiff_error_handler (title, format, ap)
9493 const char *title, *format;
9494 va_list ap;
9495{
9496 char buf[512];
9497 int len;
9498
9499 len = sprintf (buf, "TIFF error: %s ", title);
9500 vsprintf (buf + len, format, ap);
9501 add_to_log (buf, Qnil, Qnil);
9502}
9503
9504
9505static void
9506tiff_warning_handler (title, format, ap)
9507 const char *title, *format;
9508 va_list ap;
9509{
9510 char buf[512];
9511 int len;
9512
9513 len = sprintf (buf, "TIFF warning: %s ", title);
9514 vsprintf (buf + len, format, ap);
9515 add_to_log (buf, Qnil, Qnil);
9516}
9517
9518
333b20bb
GM		 9519/* Load TIFF image IMG for use on frame F. Value is non-zero if
9520 successful. */
9521
9522static int
9523tiff_load (f, img)
9524 struct frame *f;
9525 struct image *img;
9526{
9527 Lisp_Object file, specified_file;
63448a4d 9528 Lisp_Object specified_data;
333b20bb
GM		 9529 TIFF *tiff;
9530 int width, height, x, y;
9531 uint32 *buf;
9532 int rc;
9533 XImage *ximg;
9534 struct gcpro gcpro1;
63448a4d 9535 tiff_memory_source memsrc;
333b20bb
GM		 9536
9537 specified_file = image_spec_value (img->spec, QCfile, NULL);
63448a4d 9538 specified_data = image_spec_value (img->spec, QCdata, NULL);
5ad6a5fb
GM		 9539 file = Qnil;
9540 GCPRO1 (file);
63448a4d 9541
c6892044
GM		 9542 TIFFSetErrorHandler (tiff_error_handler);
9543 TIFFSetWarningHandler (tiff_warning_handler);
9544
63448a4d 9545 if (NILP (specified_data))
5ad6a5fb
GM		 9546 {
9547 /* Read from a file */
9548 file = x_find_image_file (specified_file);
9549 if (!STRINGP (file))
63448a4d 9550 {
45158a91 9551 image_error ("Cannot find image file `%s'", file, Qnil);
5ad6a5fb
GM		 9552 UNGCPRO;
9553 return 0;
9554 }
63448a4d 9555
5ad6a5fb
GM		 9556 /* Try to open the image file. */
9557 tiff = TIFFOpen (XSTRING (file)->data, "r");
9558 if (tiff == NULL)
9559 {
9560 image_error ("Cannot open `%s'", file, Qnil);
9561 UNGCPRO;
9562 return 0;
63448a4d 9563 }
5ad6a5fb 9564 }
63448a4d 9565 else
5ad6a5fb
GM		 9566 {
9567 /* Memory source! */
9568 memsrc.bytes = XSTRING (specified_data)->data;
9569 memsrc.len = STRING_BYTES (XSTRING (specified_data));
9570 memsrc.index = 0;
9571
9572 tiff = TIFFClientOpen ("memory_source", "r", &memsrc,
9573 (TIFFReadWriteProc) tiff_read_from_memory,
9574 (TIFFReadWriteProc) tiff_write_from_memory,
9575 tiff_seek_in_memory,
9576 tiff_close_memory,
9577 tiff_size_of_memory,
9578 tiff_mmap_memory,
9579 tiff_unmap_memory);
9580
9581 if (!tiff)
63448a4d 9582 {
45158a91 9583 image_error ("Cannot open memory source for `%s'", img->spec, Qnil);
5ad6a5fb
GM		 9584 UNGCPRO;
9585 return 0;
63448a4d 9586 }
5ad6a5fb 9587 }
333b20bb
GM		 9588
9589 /* Get width and height of the image, and allocate a raster buffer
9590 of width x height 32-bit values. */
9591 TIFFGetField (tiff, TIFFTAG_IMAGEWIDTH, &width);
9592 TIFFGetField (tiff, TIFFTAG_IMAGELENGTH, &height);
9593 buf = (uint32 *) xmalloc (width * height * sizeof *buf);
9594
9595 rc = TIFFReadRGBAImage (tiff, width, height, buf, 0);
9596 TIFFClose (tiff);
9597 if (!rc)
9598 {
45158a91 9599 image_error ("Error reading TIFF image `%s'", img->spec, Qnil);
333b20bb
GM		 9600 xfree (buf);
9601 UNGCPRO;
9602 return 0;
9603 }
9604
333b20bb 9605 /* Create the X image and pixmap. */
45158a91 9606 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg, &img->pixmap))
333b20bb 9607 {
333b20bb
GM		 9608 xfree (buf);
9609 UNGCPRO;
9610 return 0;
9611 }
9612
9613 /* Initialize the color table. */
9614 init_color_table ();
9615
9616 /* Process the pixel raster. Origin is in the lower-left corner. */
9617 for (y = 0; y < height; ++y)
9618 {
9619 uint32 *row = buf + y * width;
9620
9621 for (x = 0; x < width; ++x)
9622 {
9623 uint32 abgr = row[x];
9624 int r = TIFFGetR (abgr) << 8;
9625 int g = TIFFGetG (abgr) << 8;
9626 int b = TIFFGetB (abgr) << 8;
9627 XPutPixel (ximg, x, height - 1 - y, lookup_rgb_color (f, r, g, b));
9628 }
9629 }
9630
9631 /* Remember the colors allocated for the image. Free the color table. */
9632 img->colors = colors_in_color_table (&img->ncolors);
9633 free_color_table ();
9634
9635 /* Put the image into the pixmap, then free the X image and its buffer. */
9636 x_put_x_image (f, ximg, img->pixmap, width, height);
9637 x_destroy_x_image (ximg);
9638 xfree (buf);
333b20bb
GM		 9639
9640 img->width = width;
9641 img->height = height;
9642
9643 UNGCPRO;
9644 return 1;
9645}
9646
9647#endif /* HAVE_TIFF != 0 */
9648
9649
9650\f
9651/***********************************************************************
9652 GIF
9653 ***********************************************************************/
9654
9655#if HAVE_GIF
9656
9657#include <gif_lib.h>
9658
9659static int gif_image_p P_ ((Lisp_Object object));
9660static int gif_load P_ ((struct frame *f, struct image *img));
9661
9662/* The symbol `gif' identifying images of this type. */
9663
9664Lisp_Object Qgif;
9665
9666/* Indices of image specification fields in gif_format, below. */
9667
9668enum gif_keyword_index
9669{
9670 GIF_TYPE,
63448a4d 9671 GIF_DATA,
333b20bb
GM		 9672 GIF_FILE,
9673 GIF_ASCENT,
9674 GIF_MARGIN,
9675 GIF_RELIEF,
9676 GIF_ALGORITHM,
9677 GIF_HEURISTIC_MASK,
4a8e312c 9678 GIF_MASK,
333b20bb
GM		 9679 GIF_IMAGE,
9680 GIF_LAST
9681};
9682
9683/* Vector of image_keyword structures describing the format
9684 of valid user-defined image specifications. */
9685
9686static struct image_keyword gif_format[GIF_LAST] =
9687{
9688 {":type", IMAGE_SYMBOL_VALUE, 1},
5ad6a5fb 9689 {":data", IMAGE_STRING_VALUE, 0},
63448a4d 9690 {":file", IMAGE_STRING_VALUE, 0},
7c7ff7f5 9691 {":ascent", IMAGE_ASCENT_VALUE, 0},
3ed61e75 9692 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
333b20bb 9693 {":relief", IMAGE_INTEGER_VALUE, 0},
d2dc8167 9694 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
333b20bb 9695 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
4a8e312c 9696 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
333b20bb
GM		 9697 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0}
9698};
9699
9700/* Structure describing the image type `gif'. */
9701
9702static struct image_type gif_type =
9703{
9704 &Qgif,
9705 gif_image_p,
9706 gif_load,
9707 x_clear_image,
9708 NULL
9709};
9710
e3130015 9711
333b20bb
GM		 9712/* Return non-zero if OBJECT is a valid GIF image specification. */
9713
9714static int
9715gif_image_p (object)
9716 Lisp_Object object;
9717{
9718 struct image_keyword fmt[GIF_LAST];
9719 bcopy (gif_format, fmt, sizeof fmt);
9720
7c7ff7f5 9721 if (!parse_image_spec (object, fmt, GIF_LAST, Qgif))
333b20bb 9722 return 0;
5ad6a5fb 9723
63cec32f
GM		 9724 /* Must specify either the :data or :file keyword. */
9725 return fmt[GIF_FILE].count + fmt[GIF_DATA].count == 1;
333b20bb
GM		 9726}
9727
e3130015 9728
63448a4d
WP		 9729/* Reading a GIF image from memory
9730 Based on the PNG memory stuff to a certain extent. */
9731
5ad6a5fb
GM		 9732typedef struct
9733{
63448a4d
WP		 9734 unsigned char *bytes;
9735 size_t len;
9736 int index;
5ad6a5fb
GM		 9737}
9738gif_memory_source;
63448a4d 9739
e3130015 9740
f036834a
GM		 9741/* Make the current memory source available to gif_read_from_memory.
9742 It's done this way because not all versions of libungif support
9743 a UserData field in the GifFileType structure. */
9744static gif_memory_source *current_gif_memory_src;
9745
5ad6a5fb
GM		 9746static int
9747gif_read_from_memory (file, buf, len)
9748 GifFileType *file;
9749 GifByteType *buf;
9750 int len;
63448a4d 9751{
f036834a 9752 gif_memory_source *src = current_gif_memory_src;
63448a4d 9753
5ad6a5fb
GM		 9754 if (len > src->len - src->index)
9755 return -1;
63448a4d 9756
5ad6a5fb 9757 bcopy (src->bytes + src->index, buf, len);
63448a4d
WP		 9758 src->index += len;
9759 return len;
9760}
333b20bb 9761
5ad6a5fb 9762
333b20bb
GM		 9763/* Load GIF image IMG for use on frame F. Value is non-zero if
9764 successful. */
9765
9766static int
9767gif_load (f, img)
9768 struct frame *f;
9769 struct image *img;
9770{
9771 Lisp_Object file, specified_file;
63448a4d 9772 Lisp_Object specified_data;
333b20bb
GM		 9773 int rc, width, height, x, y, i;
9774 XImage *ximg;
9775 ColorMapObject *gif_color_map;
9776 unsigned long pixel_colors[256];
9777 GifFileType *gif;
9778 struct gcpro gcpro1;
9779 Lisp_Object image;
9780 int ino, image_left, image_top, image_width, image_height;
63448a4d 9781 gif_memory_source memsrc;
9b784e96 9782 unsigned char *raster;
333b20bb
GM		 9783
9784 specified_file = image_spec_value (img->spec, QCfile, NULL);
63448a4d 9785 specified_data = image_spec_value (img->spec, QCdata, NULL);
5ad6a5fb
GM		 9786 file = Qnil;
9787 GCPRO1 (file);
63448a4d
WP		 9788
9789 if (NILP (specified_data))
5ad6a5fb
GM		 9790 {
9791 file = x_find_image_file (specified_file);
9792 if (!STRINGP (file))
63448a4d 9793 {
45158a91 9794 image_error ("Cannot find image file `%s'", specified_file, Qnil);
5ad6a5fb
GM		 9795 UNGCPRO;
9796 return 0;
9797 }
333b20bb 9798
5ad6a5fb
GM		 9799 /* Open the GIF file. */
9800 gif = DGifOpenFileName (XSTRING (file)->data);
9801 if (gif == NULL)
9802 {
9803 image_error ("Cannot open `%s'", file, Qnil);
9804 UNGCPRO;
9805 return 0;
63448a4d 9806 }
5ad6a5fb 9807 }
63448a4d 9808 else
5ad6a5fb
GM		 9809 {
9810 /* Read from memory! */
f036834a 9811 current_gif_memory_src = &memsrc;
5ad6a5fb
GM		 9812 memsrc.bytes = XSTRING (specified_data)->data;
9813 memsrc.len = STRING_BYTES (XSTRING (specified_data));
9814 memsrc.index = 0;
63448a4d 9815
5ad6a5fb
GM		 9816 gif = DGifOpen(&memsrc, gif_read_from_memory);
9817 if (!gif)
9818 {
45158a91 9819 image_error ("Cannot open memory source `%s'", img->spec, Qnil);
5ad6a5fb
GM		 9820 UNGCPRO;
9821 return 0;
63448a4d 9822 }
5ad6a5fb 9823 }
333b20bb
GM		 9824
9825 /* Read entire contents. */
9826 rc = DGifSlurp (gif);
9827 if (rc == GIF_ERROR)
9828 {
45158a91 9829 image_error ("Error reading `%s'", img->spec, Qnil);
333b20bb
GM		 9830 DGifCloseFile (gif);
9831 UNGCPRO;
9832 return 0;
9833 }
9834
3ccff1e3 9835 image = image_spec_value (img->spec, QCindex, NULL);
333b20bb
GM		 9836 ino = INTEGERP (image) ? XFASTINT (image) : 0;
9837 if (ino >= gif->ImageCount)
9838 {
45158a91
GM		 9839 image_error ("Invalid image number `%s' in image `%s'",
9840 image, img->spec);
333b20bb
GM		 9841 DGifCloseFile (gif);
9842 UNGCPRO;
9843 return 0;
9844 }
9845
9846 width = img->width = gif->SWidth;
9847 height = img->height = gif->SHeight;
9848
333b20bb 9849 /* Create the X image and pixmap. */
45158a91 9850 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg, &img->pixmap))
333b20bb 9851 {
333b20bb
GM		 9852 DGifCloseFile (gif);
9853 UNGCPRO;
9854 return 0;
9855 }
9856
9857 /* Allocate colors. */
9858 gif_color_map = gif->SavedImages[ino].ImageDesc.ColorMap;
9859 if (!gif_color_map)
9860 gif_color_map = gif->SColorMap;
9861 init_color_table ();
9862 bzero (pixel_colors, sizeof pixel_colors);
9863
9864 for (i = 0; i < gif_color_map->ColorCount; ++i)
9865 {
9866 int r = gif_color_map->Colors[i].Red << 8;
9867 int g = gif_color_map->Colors[i].Green << 8;
9868 int b = gif_color_map->Colors[i].Blue << 8;
9869 pixel_colors[i] = lookup_rgb_color (f, r, g, b);
9870 }
9871
9872 img->colors = colors_in_color_table (&img->ncolors);
9873 free_color_table ();
9874
9875 /* Clear the part of the screen image that are not covered by
9876 the image from the GIF file. Full animated GIF support
9877 requires more than can be done here (see the gif89 spec,
9878 disposal methods). Let's simply assume that the part
9879 not covered by a sub-image is in the frame's background color. */
9880 image_top = gif->SavedImages[ino].ImageDesc.Top;
9881 image_left = gif->SavedImages[ino].ImageDesc.Left;
9882 image_width = gif->SavedImages[ino].ImageDesc.Width;
9883 image_height = gif->SavedImages[ino].ImageDesc.Height;
9884
9885 for (y = 0; y < image_top; ++y)
9886 for (x = 0; x < width; ++x)
9887 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
9888
9889 for (y = image_top + image_height; y < height; ++y)
9890 for (x = 0; x < width; ++x)
9891 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
9892
9893 for (y = image_top; y < image_top + image_height; ++y)
9894 {
9895 for (x = 0; x < image_left; ++x)
9896 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
9897 for (x = image_left + image_width; x < width; ++x)
9898 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
9899 }
9900
9b784e96
GM		 9901 /* Read the GIF image into the X image. We use a local variable
9902 `raster' here because RasterBits below is a char *, and invites
9903 problems with bytes >= 0x80. */
9904 raster = (unsigned char *) gif->SavedImages[ino].RasterBits;
9905
333b20bb
GM		 9906 if (gif->SavedImages[ino].ImageDesc.Interlace)
9907 {
9908 static int interlace_start[] = {0, 4, 2, 1};
9909 static int interlace_increment[] = {8, 8, 4, 2};
9b207e8e 9910 int pass;
06482119
GM		 9911 int row = interlace_start[0];
9912
9913 pass = 0;
333b20bb 9914
06482119 9915 for (y = 0; y < image_height; y++)
333b20bb 9916 {
06482119
GM		 9917 if (row >= image_height)
9918 {
9919 row = interlace_start[++pass];
9920 while (row >= image_height)
9921 row = interlace_start[++pass];
9922 }
9923
9924 for (x = 0; x < image_width; x++)
9925 {
9b784e96 9926 int i = raster[(y * image_width) + x];
06482119
GM		 9927 XPutPixel (ximg, x + image_left, row + image_top,
9928 pixel_colors[i]);
9929 }
9930
9931 row += interlace_increment[pass];
333b20bb
GM		 9932 }
9933 }
9934 else
9935 {
9936 for (y = 0; y < image_height; ++y)
9937 for (x = 0; x < image_width; ++x)
9938 {
9b784e96 9939 int i = raster[y * image_width + x];
333b20bb
GM		 9940 XPutPixel (ximg, x + image_left, y + image_top, pixel_colors[i]);
9941 }
9942 }
9943
9944 DGifCloseFile (gif);
9945
9946 /* Put the image into the pixmap, then free the X image and its buffer. */
9947 x_put_x_image (f, ximg, img->pixmap, width, height);
9948 x_destroy_x_image (ximg);
333b20bb
GM		 9949
9950 UNGCPRO;
9951 return 1;
9952}
9953
9954#endif /* HAVE_GIF != 0 */
9955
9956
9957\f
9958/***********************************************************************
9959 Ghostscript
9960 ***********************************************************************/
9961
9962static int gs_image_p P_ ((Lisp_Object object));
9963static int gs_load P_ ((struct frame *f, struct image *img));
9964static void gs_clear_image P_ ((struct frame *f, struct image *img));
9965
fcf431dc 9966/* The symbol `postscript' identifying images of this type. */
333b20bb 9967
fcf431dc 9968Lisp_Object Qpostscript;
333b20bb
GM		 9969
9970/* Keyword symbols. */
9971
9972Lisp_Object QCloader, QCbounding_box, QCpt_width, QCpt_height;
9973
9974/* Indices of image specification fields in gs_format, below. */
9975
9976enum gs_keyword_index
9977{
9978 GS_TYPE,
9979 GS_PT_WIDTH,
9980 GS_PT_HEIGHT,
9981 GS_FILE,
9982 GS_LOADER,
9983 GS_BOUNDING_BOX,
9984 GS_ASCENT,
9985 GS_MARGIN,
9986 GS_RELIEF,
9987 GS_ALGORITHM,
9988 GS_HEURISTIC_MASK,
4a8e312c 9989 GS_MASK,
333b20bb
GM		 9990 GS_LAST
9991};
9992
9993/* Vector of image_keyword structures describing the format
9994 of valid user-defined image specifications. */
9995
9996static struct image_keyword gs_format[GS_LAST] =
9997{
9998 {":type", IMAGE_SYMBOL_VALUE, 1},
9999 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE, 1},
10000 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE, 1},
10001 {":file", IMAGE_STRING_VALUE, 1},
10002 {":loader", IMAGE_FUNCTION_VALUE, 0},
10003 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE, 1},
7c7ff7f5 10004 {":ascent", IMAGE_ASCENT_VALUE, 0},
3ed61e75 10005 {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0},
333b20bb 10006 {":relief", IMAGE_INTEGER_VALUE, 0},
d2dc8167 10007 {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
4a8e312c
GM		 10008 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
10009 {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
333b20bb
GM		 10010};
10011
10012/* Structure describing the image type `ghostscript'. */
10013
10014static struct image_type gs_type =
10015{
fcf431dc 10016 &Qpostscript,
333b20bb
GM		 10017 gs_image_p,
10018 gs_load,
10019 gs_clear_image,
10020 NULL
10021};
10022
10023
10024/* Free X resources of Ghostscript image IMG which is used on frame F. */
10025
10026static void
10027gs_clear_image (f, img)
10028 struct frame *f;
10029 struct image *img;
10030{
10031 /* IMG->data.ptr_val may contain a recorded colormap. */
10032 xfree (img->data.ptr_val);
10033 x_clear_image (f, img);
10034}
10035
10036
10037/* Return non-zero if OBJECT is a valid Ghostscript image
10038 specification. */
10039
10040static int
10041gs_image_p (object)
10042 Lisp_Object object;
10043{
10044 struct image_keyword fmt[GS_LAST];
10045 Lisp_Object tem;
10046 int i;
10047
10048 bcopy (gs_format, fmt, sizeof fmt);
10049
7c7ff7f5 10050 if (!parse_image_spec (object, fmt, GS_LAST, Qpostscript))
333b20bb
GM		 10051 return 0;
10052
10053 /* Bounding box must be a list or vector containing 4 integers. */
10054 tem = fmt[GS_BOUNDING_BOX].value;
10055 if (CONSP (tem))
10056 {
10057 for (i = 0; i < 4; ++i, tem = XCDR (tem))
10058 if (!CONSP (tem) || !INTEGERP (XCAR (tem)))
10059 return 0;
10060 if (!NILP (tem))
10061 return 0;
10062 }
10063 else if (VECTORP (tem))
10064 {
10065 if (XVECTOR (tem)->size != 4)
10066 return 0;
10067 for (i = 0; i < 4; ++i)
10068 if (!INTEGERP (XVECTOR (tem)->contents[i]))
10069 return 0;
10070 }
10071 else
10072 return 0;
10073
10074 return 1;
10075}
10076
10077
10078/* Load Ghostscript image IMG for use on frame F. Value is non-zero
10079 if successful. */
10080
10081static int
10082gs_load (f, img)
10083 struct frame *f;
10084 struct image *img;
10085{
10086 char buffer[100];
10087 Lisp_Object window_and_pixmap_id = Qnil, loader, pt_height, pt_width;
10088 struct gcpro gcpro1, gcpro2;
10089 Lisp_Object frame;
10090 double in_width, in_height;
10091 Lisp_Object pixel_colors = Qnil;
10092
10093 /* Compute pixel size of pixmap needed from the given size in the
10094 image specification. Sizes in the specification are in pt. 1 pt
10095 = 1/72 in, xdpi and ydpi are stored in the frame's X display
10096 info. */
10097 pt_width = image_spec_value (img->spec, QCpt_width, NULL);
10098 in_width = XFASTINT (pt_width) / 72.0;
10099 img->width = in_width * FRAME_X_DISPLAY_INFO (f)->resx;
10100 pt_height = image_spec_value (img->spec, QCpt_height, NULL);
10101 in_height = XFASTINT (pt_height) / 72.0;
10102 img->height = in_height * FRAME_X_DISPLAY_INFO (f)->resy;
10103
10104 /* Create the pixmap. */
dd00328a 10105 xassert (img->pixmap == None);
333b20bb
GM		 10106 img->pixmap = XCreatePixmap (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
10107 img->width, img->height,
10108 DefaultDepthOfScreen (FRAME_X_SCREEN (f)));
333b20bb
GM		 10109
10110 if (!img->pixmap)
10111 {
45158a91 10112 image_error ("Unable to create pixmap for `%s'", img->spec, Qnil);
333b20bb
GM		 10113 return 0;
10114 }
10115
10116 /* Call the loader to fill the pixmap. It returns a process object
10117 if successful. We do not record_unwind_protect here because
10118 other places in redisplay like calling window scroll functions
10119 don't either. Let the Lisp loader use `unwind-protect' instead. */
10120 GCPRO2 (window_and_pixmap_id, pixel_colors);
10121
10122 sprintf (buffer, "%lu %lu",
10123 (unsigned long) FRAME_X_WINDOW (f),
10124 (unsigned long) img->pixmap);
10125 window_and_pixmap_id = build_string (buffer);
10126
10127 sprintf (buffer, "%lu %lu",
10128 FRAME_FOREGROUND_PIXEL (f),
10129 FRAME_BACKGROUND_PIXEL (f));
10130 pixel_colors = build_string (buffer);
10131
10132 XSETFRAME (frame, f);
10133 loader = image_spec_value (img->spec, QCloader, NULL);
10134 if (NILP (loader))
10135 loader = intern ("gs-load-image");
10136
10137 img->data.lisp_val = call6 (loader, frame, img->spec,
10138 make_number (img->width),
10139 make_number (img->height),
10140 window_and_pixmap_id,
10141 pixel_colors);
10142 UNGCPRO;
10143 return PROCESSP (img->data.lisp_val);
10144}
10145
10146
10147/* Kill the Ghostscript process that was started to fill PIXMAP on
10148 frame F. Called from XTread_socket when receiving an event
10149 telling Emacs that Ghostscript has finished drawing. */
10150
10151void
10152x_kill_gs_process (pixmap, f)
10153 Pixmap pixmap;
10154 struct frame *f;
10155{
10156 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
10157 int class, i;
10158 struct image *img;
10159
10160 /* Find the image containing PIXMAP. */
10161 for (i = 0; i < c->used; ++i)
10162 if (c->images[i]->pixmap == pixmap)
10163 break;
10164
daba7643
GM		 10165 /* Should someone in between have cleared the image cache, for
10166 instance, give up. */
10167 if (i == c->used)
10168 return;
10169
333b20bb
GM		 10170 /* Kill the GS process. We should have found PIXMAP in the image
10171 cache and its image should contain a process object. */
333b20bb
GM		 10172 img = c->images[i];
10173 xassert (PROCESSP (img->data.lisp_val));
10174 Fkill_process (img->data.lisp_val, Qnil);
10175 img->data.lisp_val = Qnil;
10176
10177 /* On displays with a mutable colormap, figure out the colors
10178 allocated for the image by looking at the pixels of an XImage for
10179 img->pixmap. */
383d6ffc 10180 class = FRAME_X_VISUAL (f)->class;
333b20bb
GM		 10181 if (class != StaticColor && class != StaticGray && class != TrueColor)
10182 {
10183 XImage *ximg;
10184
10185 BLOCK_INPUT;
10186
10187 /* Try to get an XImage for img->pixmep. */
10188 ximg = XGetImage (FRAME_X_DISPLAY (f), img->pixmap,
10189 0, 0, img->width, img->height, ~0, ZPixmap);
10190 if (ximg)
10191 {
10192 int x, y;
10193
10194 /* Initialize the color table. */
10195 init_color_table ();
10196
10197 /* For each pixel of the image, look its color up in the
10198 color table. After having done so, the color table will
10199 contain an entry for each color used by the image. */
10200 for (y = 0; y < img->height; ++y)
10201 for (x = 0; x < img->width; ++x)
10202 {
10203 unsigned long pixel = XGetPixel (ximg, x, y);
10204 lookup_pixel_color (f, pixel);
10205 }
10206
10207 /* Record colors in the image. Free color table and XImage. */
10208 img->colors = colors_in_color_table (&img->ncolors);
10209 free_color_table ();
10210 XDestroyImage (ximg);
10211
10212#if 0 /* This doesn't seem to be the case. If we free the colors
10213 here, we get a BadAccess later in x_clear_image when
10214 freeing the colors. */
10215 /* We have allocated colors once, but Ghostscript has also
10216 allocated colors on behalf of us. So, to get the
10217 reference counts right, free them once. */
10218 if (img->ncolors)
462d5d40 10219 x_free_colors (f, img->colors, img->ncolors);
333b20bb
GM		 10220#endif
10221 }
10222 else
10223 image_error ("Cannot get X image of `%s'; colors will not be freed",
45158a91 10224 img->spec, Qnil);
333b20bb
GM		 10225
10226 UNBLOCK_INPUT;
10227 }
ad18ffb1
GM		 10228
10229 /* Now that we have the pixmap, compute mask and transform the
10230 image if requested. */
10231 BLOCK_INPUT;
10232 postprocess_image (f, img);
10233 UNBLOCK_INPUT;
333b20bb
GM		 10234}
10235
10236
10237\f
10238/***********************************************************************
10239 Window properties
10240 ***********************************************************************/
10241
10242DEFUN ("x-change-window-property", Fx_change_window_property,
10243 Sx_change_window_property, 2, 3, 0,
7ee72033 10244 doc: /* Change window property PROP to VALUE on the X window of FRAME.
c061c855 10245PROP and VALUE must be strings. FRAME nil or omitted means use the
7ee72033
MB		 10246selected frame. Value is VALUE. */)
10247 (prop, value, frame)
333b20bb
GM		 10248 Lisp_Object frame, prop, value;
10249{
10250 struct frame *f = check_x_frame (frame);
10251 Atom prop_atom;
10252
10253 CHECK_STRING (prop, 1);
10254 CHECK_STRING (value, 2);
10255
10256 BLOCK_INPUT;
10257 prop_atom = XInternAtom (FRAME_X_DISPLAY (f), XSTRING (prop)->data, False);
10258 XChangeProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
10259 prop_atom, XA_STRING, 8, PropModeReplace,
10260 XSTRING (value)->data, XSTRING (value)->size);
10261
10262 /* Make sure the property is set when we return. */
10263 XFlush (FRAME_X_DISPLAY (f));
10264 UNBLOCK_INPUT;
10265
10266 return value;
10267}
10268
10269
10270DEFUN ("x-delete-window-property", Fx_delete_window_property,
10271 Sx_delete_window_property, 1, 2, 0,
7ee72033
MB		 10272 doc: /* Remove window property PROP from X window of FRAME.
10273FRAME nil or omitted means use the selected frame. Value is PROP. */)
10274 (prop, frame)
333b20bb
GM		 10275 Lisp_Object prop, frame;
10276{
10277 struct frame *f = check_x_frame (frame);
10278 Atom prop_atom;
10279
10280 CHECK_STRING (prop, 1);
10281 BLOCK_INPUT;
10282 prop_atom = XInternAtom (FRAME_X_DISPLAY (f), XSTRING (prop)->data, False);
10283 XDeleteProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), prop_atom);
10284
10285 /* Make sure the property is removed when we return. */
10286 XFlush (FRAME_X_DISPLAY (f));
10287 UNBLOCK_INPUT;
10288
10289 return prop;
10290}
10291
10292
10293DEFUN ("x-window-property", Fx_window_property, Sx_window_property,
10294 1, 2, 0,
7ee72033 10295 doc: /* Value is the value of window property PROP on FRAME.
c061c855
GM		 10296If FRAME is nil or omitted, use the selected frame. Value is nil
10297if FRAME hasn't a property with name PROP or if PROP has no string
7ee72033
MB		 10298value. */)
10299 (prop, frame)
333b20bb
GM		 10300 Lisp_Object prop, frame;
10301{
10302 struct frame *f = check_x_frame (frame);
10303 Atom prop_atom;
10304 int rc;
10305 Lisp_Object prop_value = Qnil;
10306 char *tmp_data = NULL;
10307 Atom actual_type;
10308 int actual_format;
10309 unsigned long actual_size, bytes_remaining;
10310
10311 CHECK_STRING (prop, 1);
10312 BLOCK_INPUT;
10313 prop_atom = XInternAtom (FRAME_X_DISPLAY (f), XSTRING (prop)->data, False);
10314 rc = XGetWindowProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
10315 prop_atom, 0, 0, False, XA_STRING,
10316 &actual_type, &actual_format, &actual_size,
10317 &bytes_remaining, (unsigned char **) &tmp_data);
10318 if (rc == Success)
10319 {
10320 int size = bytes_remaining;
10321
10322 XFree (tmp_data);
10323 tmp_data = NULL;
10324
10325 rc = XGetWindowProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
10326 prop_atom, 0, bytes_remaining,
10327 False, XA_STRING,
10328 &actual_type, &actual_format,
10329 &actual_size, &bytes_remaining,
10330 (unsigned char **) &tmp_data);
4c8c7926 10331 if (rc == Success && tmp_data)
333b20bb
GM		 10332 prop_value = make_string (tmp_data, size);
10333
10334 XFree (tmp_data);
10335 }
10336
10337 UNBLOCK_INPUT;
10338 return prop_value;
10339}
10340
10341
10342\f
10343/***********************************************************************
10344 Busy cursor
10345 ***********************************************************************/
10346
4ae9a85e 10347/* If non-null, an asynchronous timer that, when it expires, displays
0af913d7 10348 an hourglass cursor on all frames. */
333b20bb 10349
0af913d7 10350static struct atimer *hourglass_atimer;
333b20bb 10351
0af913d7 10352/* Non-zero means an hourglass cursor is currently shown. */
333b20bb 10353
0af913d7 10354static int hourglass_shown_p;
333b20bb 10355
0af913d7 10356/* Number of seconds to wait before displaying an hourglass cursor. */
333b20bb 10357
0af913d7 10358static Lisp_Object Vhourglass_delay;
333b20bb 10359
0af913d7 10360/* Default number of seconds to wait before displaying an hourglass
4ae9a85e
GM		 10361 cursor. */
10362
0af913d7 10363#define DEFAULT_HOURGLASS_DELAY 1
4ae9a85e
GM		 10364
10365/* Function prototypes. */
10366
0af913d7
GM		 10367static void show_hourglass P_ ((struct atimer *));
10368static void hide_hourglass P_ ((void));
4ae9a85e
GM		 10369
10370
0af913d7 10371/* Cancel a currently active hourglass timer, and start a new one. */
4ae9a85e
GM		 10372
10373void
0af913d7 10374start_hourglass ()
333b20bb 10375{
4ae9a85e 10376 EMACS_TIME delay;
3caa99d3 10377 int secs, usecs = 0;
4ae9a85e 10378
0af913d7 10379 cancel_hourglass ();
4ae9a85e 10380
0af913d7
GM		 10381 if (INTEGERP (Vhourglass_delay)
10382 && XINT (Vhourglass_delay) > 0)
10383 secs = XFASTINT (Vhourglass_delay);
10384 else if (FLOATP (Vhourglass_delay)
10385 && XFLOAT_DATA (Vhourglass_delay) > 0)
3caa99d3
GM		 10386 {
10387 Lisp_Object tem;
0af913d7 10388 tem = Ftruncate (Vhourglass_delay, Qnil);
3caa99d3 10389 secs = XFASTINT (tem);
0af913d7 10390 usecs = (XFLOAT_DATA (Vhourglass_delay) - secs) * 1000000;
3caa99d3 10391 }
4ae9a85e 10392 else
0af913d7 10393 secs = DEFAULT_HOURGLASS_DELAY;
4ae9a85e 10394
3caa99d3 10395 EMACS_SET_SECS_USECS (delay, secs, usecs);
0af913d7
GM		 10396 hourglass_atimer = start_atimer (ATIMER_RELATIVE, delay,
10397 show_hourglass, NULL);
4ae9a85e
GM		 10398}
10399
10400
0af913d7 10401/* Cancel the hourglass cursor timer if active, hide a busy cursor if
4ae9a85e
GM		 10402 shown. */
10403
10404void
0af913d7 10405cancel_hourglass ()
4ae9a85e 10406{
0af913d7 10407 if (hourglass_atimer)
99f01f62 10408 {
0af913d7
GM		 10409 cancel_atimer (hourglass_atimer);
10410 hourglass_atimer = NULL;
99f01f62
GM		 10411 }
10412
0af913d7
GM		 10413 if (hourglass_shown_p)
10414 hide_hourglass ();
4ae9a85e
GM		 10415}
10416
10417
0af913d7
GM		 10418/* Timer function of hourglass_atimer. TIMER is equal to
10419 hourglass_atimer.
4ae9a85e 10420
0af913d7
GM		 10421 Display an hourglass pointer on all frames by mapping the frames'
10422 hourglass_window. Set the hourglass_p flag in the frames'
10423 output_data.x structure to indicate that an hourglass cursor is
10424 shown on the frames. */
4ae9a85e
GM		 10425
10426static void
0af913d7 10427show_hourglass (timer)
4ae9a85e
GM		 10428 struct atimer *timer;
10429{
10430 /* The timer implementation will cancel this timer automatically
0af913d7 10431 after this function has run. Set hourglass_atimer to null
4ae9a85e 10432 so that we know the timer doesn't have to be canceled. */
0af913d7 10433 hourglass_atimer = NULL;
4ae9a85e 10434
0af913d7 10435 if (!hourglass_shown_p)
333b20bb
GM		 10436 {
10437 Lisp_Object rest, frame;
4ae9a85e
GM		 10438
10439 BLOCK_INPUT;
10440
333b20bb 10441 FOR_EACH_FRAME (rest, frame)
5f7a1890
GM		 10442 {
10443 struct frame *f = XFRAME (frame);
10444
10445 if (FRAME_LIVE_P (f) && FRAME_X_P (f) && FRAME_X_DISPLAY (f))
10446 {
10447 Display *dpy = FRAME_X_DISPLAY (f);
10448
10449#ifdef USE_X_TOOLKIT
10450 if (f->output_data.x->widget)
10451#else
10452 if (FRAME_OUTER_WINDOW (f))
10453#endif
10454 {
0af913d7 10455 f->output_data.x->hourglass_p = 1;
4ae9a85e 10456
0af913d7 10457 if (!f->output_data.x->hourglass_window)
5f7a1890
GM		 10458 {
10459 unsigned long mask = CWCursor;
10460 XSetWindowAttributes attrs;
4ae9a85e 10461
0af913d7 10462 attrs.cursor = f->output_data.x->hourglass_cursor;
4ae9a85e 10463
0af913d7 10464 f->output_data.x->hourglass_window
5f7a1890
GM		 10465 = XCreateWindow (dpy, FRAME_OUTER_WINDOW (f),
10466 0, 0, 32000, 32000, 0, 0,
10467 InputOnly,
10468 CopyFromParent,
10469 mask, &attrs);
10470 }
4ae9a85e 10471
0af913d7 10472 XMapRaised (dpy, f->output_data.x->hourglass_window);
5f7a1890
GM		 10473 XFlush (dpy);
10474 }
10475 }
10476 }
333b20bb 10477
0af913d7 10478 hourglass_shown_p = 1;
4ae9a85e
GM		 10479 UNBLOCK_INPUT;
10480 }
333b20bb
GM		 10481}
10482
10483
0af913d7
GM		 10484/* Hide the hourglass pointer on all frames, if it is currently
10485 shown. */
333b20bb 10486
4ae9a85e 10487static void
0af913d7 10488hide_hourglass ()
4ae9a85e 10489{
0af913d7 10490 if (hourglass_shown_p)
333b20bb 10491 {
4ae9a85e
GM		 10492 Lisp_Object rest, frame;
10493
10494 BLOCK_INPUT;
10495 FOR_EACH_FRAME (rest, frame)
333b20bb 10496 {
4ae9a85e
GM		 10497 struct frame *f = XFRAME (frame);
10498
10499 if (FRAME_X_P (f)
10500 /* Watch out for newly created frames. */
0af913d7 10501 && f->output_data.x->hourglass_window)
4ae9a85e 10502 {
0af913d7
GM		 10503 XUnmapWindow (FRAME_X_DISPLAY (f),
10504 f->output_data.x->hourglass_window);
10505 /* Sync here because XTread_socket looks at the
10506 hourglass_p flag that is reset to zero below. */
4ae9a85e 10507 XSync (FRAME_X_DISPLAY (f), False);
0af913d7 10508 f->output_data.x->hourglass_p = 0;
4ae9a85e 10509 }
333b20bb 10510 }
333b20bb 10511
0af913d7 10512 hourglass_shown_p = 0;
4ae9a85e
GM		 10513 UNBLOCK_INPUT;
10514 }
333b20bb
GM		 10515}
10516
10517
10518\f
10519/***********************************************************************
10520 Tool tips
10521 ***********************************************************************/
10522
10523static Lisp_Object x_create_tip_frame P_ ((struct x_display_info *,
275841bf 10524 Lisp_Object, Lisp_Object));
06d62053 10525static void compute_tip_xy P_ ((struct frame *, Lisp_Object, Lisp_Object,
ab452f99 10526 Lisp_Object, int, int, int *, int *));
333b20bb 10527
44b5a125 10528/* The frame of a currently visible tooltip. */
333b20bb 10529
44b5a125 10530Lisp_Object tip_frame;
333b20bb
GM		 10531
10532/* If non-nil, a timer started that hides the last tooltip when it
10533 fires. */
10534
10535Lisp_Object tip_timer;
10536Window tip_window;
10537
06d62053
GM		 10538/* If non-nil, a vector of 3 elements containing the last args
10539 with which x-show-tip was called. See there. */
10540
10541Lisp_Object last_show_tip_args;
10542
d63931a2
GM		 10543/* Maximum size for tooltips; a cons (COLUMNS . ROWS). */
10544
10545Lisp_Object Vx_max_tooltip_size;
10546
eaf1eea9
GM		 10547
10548static Lisp_Object
10549unwind_create_tip_frame (frame)
10550 Lisp_Object frame;
10551{
c844a81a
GM		 10552 Lisp_Object deleted;
10553
10554 deleted = unwind_create_frame (frame);
10555 if (EQ (deleted, Qt))
10556 {
10557 tip_window = None;
10558 tip_frame = Qnil;
10559 }
10560
10561 return deleted;
eaf1eea9
GM		 10562}
10563
10564
333b20bb 10565/* Create a frame for a tooltip on the display described by DPYINFO.
275841bf
GM		 10566 PARMS is a list of frame parameters. TEXT is the string to
10567 display in the tip frame. Value is the frame.
eaf1eea9
GM		 10568
10569 Note that functions called here, esp. x_default_parameter can
10570 signal errors, for instance when a specified color name is
10571 undefined. We have to make sure that we're in a consistent state
10572 when this happens. */
333b20bb
GM		 10573
10574static Lisp_Object
275841bf 10575x_create_tip_frame (dpyinfo, parms, text)
333b20bb 10576 struct x_display_info *dpyinfo;
275841bf 10577 Lisp_Object parms, text;
333b20bb
GM		 10578{
10579 struct frame *f;
10580 Lisp_Object frame, tem;
10581 Lisp_Object name;
333b20bb
GM		 10582 long window_prompting = 0;
10583 int width, height;
eaf1eea9 10584 int count = BINDING_STACK_SIZE ();
b6d7acec 10585 struct gcpro gcpro1, gcpro2, gcpro3;
333b20bb 10586 struct kboard *kb;
06d62053 10587 int face_change_count_before = face_change_count;
275841bf
GM		 10588 Lisp_Object buffer;
10589 struct buffer *old_buffer;
333b20bb
GM		 10590
10591 check_x ();
10592
10593 /* Use this general default value to start with until we know if
10594 this frame has a specified name. */
10595 Vx_resource_name = Vinvocation_name;
10596
10597#ifdef MULTI_KBOARD
10598 kb = dpyinfo->kboard;
10599#else
10600 kb = &the_only_kboard;
10601#endif
10602
10603 /* Get the name of the frame to use for resource lookup. */
10604 name = x_get_arg (dpyinfo, parms, Qname, "name", "Name", RES_TYPE_STRING);
10605 if (!STRINGP (name)
10606 && !EQ (name, Qunbound)
10607 && !NILP (name))
10608 error ("Invalid frame name--not a string or nil");
10609 Vx_resource_name = name;
10610
10611 frame = Qnil;
10612 GCPRO3 (parms, name, frame);
44b5a125 10613 f = make_frame (1);
333b20bb 10614 XSETFRAME (frame, f);
275841bf
GM		 10615
10616 buffer = Fget_buffer_create (build_string (" *tip*"));
10617 Fset_window_buffer (FRAME_ROOT_WINDOW (f), buffer);
10618 old_buffer = current_buffer;
10619 set_buffer_internal_1 (XBUFFER (buffer));
d63931a2 10620 current_buffer->truncate_lines = Qnil;
275841bf
GM		 10621 Ferase_buffer ();
10622 Finsert (1, &text);
10623 set_buffer_internal_1 (old_buffer);
10624
333b20bb 10625 FRAME_CAN_HAVE_SCROLL_BARS (f) = 0;
8a1a7743 10626 record_unwind_protect (unwind_create_tip_frame, frame);
333b20bb 10627
eaf1eea9
GM		 10628 /* By setting the output method, we're essentially saying that
10629 the frame is live, as per FRAME_LIVE_P. If we get a signal
10630 from this point on, x_destroy_window might screw up reference
10631 counts etc. */
333b20bb
GM		 10632 f->output_method = output_x_window;
10633 f->output_data.x = (struct x_output *) xmalloc (sizeof (struct x_output));
10634 bzero (f->output_data.x, sizeof (struct x_output));
10635 f->output_data.x->icon_bitmap = -1;
10636 f->output_data.x->fontset = -1;
61d461a8
GM		 10637 f->output_data.x->scroll_bar_foreground_pixel = -1;
10638 f->output_data.x->scroll_bar_background_pixel = -1;
f15340b7
MB		 10639#ifdef USE_TOOLKIT_SCROLL_BARS
10640 f->output_data.x->scroll_bar_top_shadow_pixel = -1;
10641 f->output_data.x->scroll_bar_bottom_shadow_pixel = -1;
10642#endif /* USE_TOOLKIT_SCROLL_BARS */
333b20bb
GM		 10643 f->icon_name = Qnil;
10644 FRAME_X_DISPLAY_INFO (f) = dpyinfo;
f1d2ce7f 10645#if GLYPH_DEBUG
eaf1eea9
GM		 10646 image_cache_refcount = FRAME_X_IMAGE_CACHE (f)->refcount;
10647 dpyinfo_refcount = dpyinfo->reference_count;
10648#endif /* GLYPH_DEBUG */
333b20bb
GM		 10649#ifdef MULTI_KBOARD
10650 FRAME_KBOARD (f) = kb;
10651#endif
10652 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
10653 f->output_data.x->explicit_parent = 0;
10654
61d461a8
GM		 10655 /* These colors will be set anyway later, but it's important
10656 to get the color reference counts right, so initialize them! */
10657 {
10658 Lisp_Object black;
10659 struct gcpro gcpro1;
10660
10661 black = build_string ("black");
10662 GCPRO1 (black);
10663 f->output_data.x->foreground_pixel
10664 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
10665 f->output_data.x->background_pixel
10666 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
10667 f->output_data.x->cursor_pixel
10668 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
10669 f->output_data.x->cursor_foreground_pixel
10670 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
10671 f->output_data.x->border_pixel
10672 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
10673 f->output_data.x->mouse_pixel
10674 = x_decode_color (f, black, BLACK_PIX_DEFAULT (f));
10675 UNGCPRO;
10676 }
10677
333b20bb
GM		 10678 /* Set the name; the functions to which we pass f expect the name to
10679 be set. */
10680 if (EQ (name, Qunbound) || NILP (name))
10681 {
10682 f->name = build_string (dpyinfo->x_id_name);
10683 f->explicit_name = 0;
10684 }
10685 else
10686 {
10687 f->name = name;
10688 f->explicit_name = 1;
10689 /* use the frame's title when getting resources for this frame. */
10690 specbind (Qx_resource_name, name);
10691 }
10692
eaf1eea9
GM		 10693 /* Extract the window parameters from the supplied values that are
10694 needed to determine window geometry. */
333b20bb
GM		 10695 {
10696 Lisp_Object font;
10697
10698 font = x_get_arg (dpyinfo, parms, Qfont, "font", "Font", RES_TYPE_STRING);
10699
10700 BLOCK_INPUT;
10701 /* First, try whatever font the caller has specified. */
10702 if (STRINGP (font))
10703 {
10704 tem = Fquery_fontset (font, Qnil);
10705 if (STRINGP (tem))
10706 font = x_new_fontset (f, XSTRING (tem)->data);
10707 else
10708 font = x_new_font (f, XSTRING (font)->data);
10709 }
10710
10711 /* Try out a font which we hope has bold and italic variations. */
10712 if (!STRINGP (font))
10713 font = x_new_font (f, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
10714 if (!STRINGP (font))
10715 font = x_new_font (f, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10716 if (! STRINGP (font))
10717 font = x_new_font (f, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10718 if (! STRINGP (font))
10719 /* This was formerly the first thing tried, but it finds too many fonts
10720 and takes too long. */
10721 font = x_new_font (f, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
10722 /* If those didn't work, look for something which will at least work. */
10723 if (! STRINGP (font))
10724 font = x_new_font (f, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
10725 UNBLOCK_INPUT;
10726 if (! STRINGP (font))
10727 font = build_string ("fixed");
10728
10729 x_default_parameter (f, parms, Qfont, font,
10730 "font", "Font", RES_TYPE_STRING);
10731 }
10732
10733 x_default_parameter (f, parms, Qborder_width, make_number (2),
10734 "borderWidth", "BorderWidth", RES_TYPE_NUMBER);
10735
10736 /* This defaults to 2 in order to match xterm. We recognize either
10737 internalBorderWidth or internalBorder (which is what xterm calls
10738 it). */
10739 if (NILP (Fassq (Qinternal_border_width, parms)))
10740 {
10741 Lisp_Object value;
10742
10743 value = x_get_arg (dpyinfo, parms, Qinternal_border_width,
10744 "internalBorder", "internalBorder", RES_TYPE_NUMBER);
10745 if (! EQ (value, Qunbound))
10746 parms = Fcons (Fcons (Qinternal_border_width, value),
10747 parms);
10748 }
10749
10750 x_default_parameter (f, parms, Qinternal_border_width, make_number (1),
10751 "internalBorderWidth", "internalBorderWidth",
10752 RES_TYPE_NUMBER);
10753
10754 /* Also do the stuff which must be set before the window exists. */
10755 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
10756 "foreground", "Foreground", RES_TYPE_STRING);
10757 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
10758 "background", "Background", RES_TYPE_STRING);
10759 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
10760 "pointerColor", "Foreground", RES_TYPE_STRING);
10761 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
10762 "cursorColor", "Foreground", RES_TYPE_STRING);
10763 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
10764 "borderColor", "BorderColor", RES_TYPE_STRING);
10765
10766 /* Init faces before x_default_parameter is called for scroll-bar
10767 parameters because that function calls x_set_scroll_bar_width,
10768 which calls change_frame_size, which calls Fset_window_buffer,
10769 which runs hooks, which call Fvertical_motion. At the end, we
10770 end up in init_iterator with a null face cache, which should not
10771 happen. */
10772 init_frame_faces (f);
10773
10774 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
10775 window_prompting = x_figure_window_size (f, parms);
10776
10777 if (window_prompting & XNegative)
10778 {
10779 if (window_prompting & YNegative)
10780 f->output_data.x->win_gravity = SouthEastGravity;
10781 else
10782 f->output_data.x->win_gravity = NorthEastGravity;
10783 }
10784 else
10785 {
10786 if (window_prompting & YNegative)
10787 f->output_data.x->win_gravity = SouthWestGravity;
10788 else
10789 f->output_data.x->win_gravity = NorthWestGravity;
10790 }
10791
10792 f->output_data.x->size_hint_flags = window_prompting;
10793 {
10794 XSetWindowAttributes attrs;
10795 unsigned long mask;
10796
10797 BLOCK_INPUT;
c51d2b5e
GM		 10798 mask = CWBackPixel | CWOverrideRedirect | CWEventMask;
10799 if (DoesSaveUnders (dpyinfo->screen))
10800 mask |= CWSaveUnder;
10801
9b2956e2
GM		 10802 /* Window managers look at the override-redirect flag to determine
10803 whether or net to give windows a decoration (Xlib spec, chapter
333b20bb
GM		 10804 3.2.8). */
10805 attrs.override_redirect = True;
10806 attrs.save_under = True;
10807 attrs.background_pixel = FRAME_BACKGROUND_PIXEL (f);
10808 /* Arrange for getting MapNotify and UnmapNotify events. */
10809 attrs.event_mask = StructureNotifyMask;
10810 tip_window
10811 = FRAME_X_WINDOW (f)
10812 = XCreateWindow (FRAME_X_DISPLAY (f),
10813 FRAME_X_DISPLAY_INFO (f)->root_window,
10814 /* x, y, width, height */
10815 0, 0, 1, 1,
10816 /* Border. */
10817 1,
10818 CopyFromParent, InputOutput, CopyFromParent,
10819 mask, &attrs);
10820 UNBLOCK_INPUT;
10821 }
10822
10823 x_make_gc (f);
10824
333b20bb
GM		 10825 x_default_parameter (f, parms, Qauto_raise, Qnil,
10826 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
10827 x_default_parameter (f, parms, Qauto_lower, Qnil,
10828 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
10829 x_default_parameter (f, parms, Qcursor_type, Qbox,
10830 "cursorType", "CursorType", RES_TYPE_SYMBOL);
10831
10832 /* Dimensions, especially f->height, must be done via change_frame_size.
10833 Change will not be effected unless different from the current
10834 f->height. */
10835 width = f->width;
10836 height = f->height;
10837 f->height = 0;
10838 SET_FRAME_WIDTH (f, 0);
8938a4fb 10839 change_frame_size (f, height, width, 1, 0, 0);
333b20bb 10840
035d5114 10841 /* Set up faces after all frame parameters are known. This call
6801a572
GM		 10842 also merges in face attributes specified for new frames.
10843
10844 Frame parameters may be changed if .Xdefaults contains
10845 specifications for the default font. For example, if there is an
10846 `Emacs.default.attributeBackground: pink', the `background-color'
10847 attribute of the frame get's set, which let's the internal border
10848 of the tooltip frame appear in pink. Prevent this. */
10849 {
10850 Lisp_Object bg = Fframe_parameter (frame, Qbackground_color);
10851
10852 /* Set tip_frame here, so that */
10853 tip_frame = frame;
10854 call1 (Qface_set_after_frame_default, frame);
10855
10856 if (!EQ (bg, Fframe_parameter (frame, Qbackground_color)))
10857 Fmodify_frame_parameters (frame, Fcons (Fcons (Qbackground_color, bg),
10858 Qnil));
10859 }
035d5114 10860
333b20bb
GM		 10861 f->no_split = 1;
10862
10863 UNGCPRO;
10864
10865 /* It is now ok to make the frame official even if we get an error
10866 below. And the frame needs to be on Vframe_list or making it
10867 visible won't work. */
10868 Vframe_list = Fcons (frame, Vframe_list);
10869
10870 /* Now that the frame is official, it counts as a reference to
10871 its display. */
10872 FRAME_X_DISPLAY_INFO (f)->reference_count++;
10873
06d62053
GM		 10874 /* Setting attributes of faces of the tooltip frame from resources
10875 and similar will increment face_change_count, which leads to the
10876 clearing of all current matrices. Since this isn't necessary
10877 here, avoid it by resetting face_change_count to the value it
10878 had before we created the tip frame. */
10879 face_change_count = face_change_count_before;
10880
eaf1eea9 10881 /* Discard the unwind_protect. */
333b20bb
GM		 10882 return unbind_to (count, frame);
10883}
10884
10885
06d62053
GM		 10886/* Compute where to display tip frame F. PARMS is the list of frame
10887 parameters for F. DX and DY are specified offsets from the current
ab452f99
GM		 10888 location of the mouse. WIDTH and HEIGHT are the width and height
10889 of the tooltip. Return coordinates relative to the root window of
10890 the display in *ROOT_X, and *ROOT_Y. */
06d62053
GM		 10891
10892static void
ab452f99 10893compute_tip_xy (f, parms, dx, dy, width, height, root_x, root_y)
06d62053
GM		 10894 struct frame *f;
10895 Lisp_Object parms, dx, dy;
ab452f99 10896 int width, height;
06d62053
GM		 10897 int *root_x, *root_y;
10898{
10899 Lisp_Object left, top;
10900 int win_x, win_y;
10901 Window root, child;
10902 unsigned pmask;
10903
10904 /* User-specified position? */
10905 left = Fcdr (Fassq (Qleft, parms));
10906 top = Fcdr (Fassq (Qtop, parms));
10907
10908 /* Move the tooltip window where the mouse pointer is. Resize and
10909 show it. */
ab452f99
GM		 10910 if (!INTEGERP (left) && !INTEGERP (top))
10911 {
10912 BLOCK_INPUT;
10913 XQueryPointer (FRAME_X_DISPLAY (f), FRAME_X_DISPLAY_INFO (f)->root_window,
10914 &root, &child, root_x, root_y, &win_x, &win_y, &pmask);
10915 UNBLOCK_INPUT;
10916 }
06d62053 10917
06d62053
GM		 10918 if (INTEGERP (top))
10919 *root_y = XINT (top);
ab452f99
GM		 10920 else if (*root_y + XINT (dy) - height < 0)
10921 *root_y -= XINT (dy);
10922 else
10923 {
10924 *root_y -= height;
10925 *root_y += XINT (dy);
10926 }
10927
10928 if (INTEGERP (left))
10929 *root_x = XINT (left);
10930 else if (*root_x + XINT (dx) + width > FRAME_X_DISPLAY_INFO (f)->width)
10931 *root_x -= width + XINT (dx);
10932 else
10933 *root_x += XINT (dx);
06d62053
GM		 10934}
10935
10936
0634ce98 10937DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
7ee72033 10938 doc: /* Show STRING in a "tooltip" window on frame FRAME.
c061c855
GM		 10939A tooltip window is a small X window displaying a string.
10940
10941FRAME nil or omitted means use the selected frame.
10942
10943PARMS is an optional list of frame parameters which can be used to
10944change the tooltip's appearance.
10945
10946Automatically hide the tooltip after TIMEOUT seconds. TIMEOUT nil
10947means use the default timeout of 5 seconds.
10948
10949If the list of frame parameters PARAMS contains a `left' parameters,
10950the tooltip is displayed at that x-position. Otherwise it is
10951displayed at the mouse position, with offset DX added (default is 5 if
10952DX isn't specified). Likewise for the y-position; if a `top' frame
10953parameter is specified, it determines the y-position of the tooltip
10954window, otherwise it is displayed at the mouse position, with offset
10955DY added (default is -10).
10956
10957A tooltip's maximum size is specified by `x-max-tooltip-size'.
7ee72033
MB		 10958Text larger than the specified size is clipped. */)
10959 (string, frame, parms, timeout, dx, dy)
0634ce98 10960 Lisp_Object string, frame, parms, timeout, dx, dy;
333b20bb
GM		 10961{
10962 struct frame *f;
10963 struct window *w;
06d62053 10964 int root_x, root_y;
333b20bb
GM		 10965 struct buffer *old_buffer;
10966 struct text_pos pos;
10967 int i, width, height;
393f2d14 10968 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
333b20bb 10969 int old_windows_or_buffers_changed = windows_or_buffers_changed;
06d62053 10970 int count = BINDING_STACK_SIZE ();
333b20bb
GM		 10971
10972 specbind (Qinhibit_redisplay, Qt);
10973
393f2d14 10974 GCPRO4 (string, parms, frame, timeout);
333b20bb
GM		 10975
10976 CHECK_STRING (string, 0);
10977 f = check_x_frame (frame);
10978 if (NILP (timeout))
10979 timeout = make_number (5);
10980 else
10981 CHECK_NATNUM (timeout, 2);
0634ce98
GM		 10982
10983 if (NILP (dx))
10984 dx = make_number (5);
10985 else
10986 CHECK_NUMBER (dx, 5);
10987
10988 if (NILP (dy))
12c67a7f 10989 dy = make_number (-10);
0634ce98
GM		 10990 else
10991 CHECK_NUMBER (dy, 6);
333b20bb 10992
06d62053
GM		 10993 if (NILP (last_show_tip_args))
10994 last_show_tip_args = Fmake_vector (make_number (3), Qnil);
10995
10996 if (!NILP (tip_frame))
10997 {
10998 Lisp_Object last_string = AREF (last_show_tip_args, 0);
10999 Lisp_Object last_frame = AREF (last_show_tip_args, 1);
11000 Lisp_Object last_parms = AREF (last_show_tip_args, 2);
11001
11002 if (EQ (frame, last_frame)
11003 && !NILP (Fequal (last_string, string))
11004 && !NILP (Fequal (last_parms, parms)))
11005 {
11006 struct frame *f = XFRAME (tip_frame);
11007
11008 /* Only DX and DY have changed. */
11009 if (!NILP (tip_timer))
ae782866
GM		 11010 {
11011 Lisp_Object timer = tip_timer;
11012 tip_timer = Qnil;
11013 call1 (Qcancel_timer, timer);
11014 }
06d62053
GM		 11015
11016 BLOCK_INPUT;
ab452f99
GM		 11017 compute_tip_xy (f, parms, dx, dy, PIXEL_WIDTH (f),
11018 PIXEL_HEIGHT (f), &root_x, &root_y);
06d62053 11019 XMoveWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
ab452f99 11020 root_x, root_y);
06d62053
GM		 11021 UNBLOCK_INPUT;
11022 goto start_timer;
11023 }
11024 }
11025
333b20bb
GM		 11026 /* Hide a previous tip, if any. */
11027 Fx_hide_tip ();
11028
06d62053
GM		 11029 ASET (last_show_tip_args, 0, string);
11030 ASET (last_show_tip_args, 1, frame);
11031 ASET (last_show_tip_args, 2, parms);
11032
333b20bb
GM		 11033 /* Add default values to frame parameters. */
11034 if (NILP (Fassq (Qname, parms)))
11035 parms = Fcons (Fcons (Qname, build_string ("tooltip")), parms);
11036 if (NILP (Fassq (Qinternal_border_width, parms)))
11037 parms = Fcons (Fcons (Qinternal_border_width, make_number (3)), parms);
11038 if (NILP (Fassq (Qborder_width, parms)))
11039 parms = Fcons (Fcons (Qborder_width, make_number (1)), parms);
11040 if (NILP (Fassq (Qborder_color, parms)))
11041 parms = Fcons (Fcons (Qborder_color, build_string ("lightyellow")), parms);
11042 if (NILP (Fassq (Qbackground_color, parms)))
11043 parms = Fcons (Fcons (Qbackground_color, build_string ("lightyellow")),
11044 parms);
11045
11046 /* Create a frame for the tooltip, and record it in the global
11047 variable tip_frame. */
275841bf 11048 frame = x_create_tip_frame (FRAME_X_DISPLAY_INFO (f), parms, string);
44b5a125 11049 f = XFRAME (frame);
333b20bb 11050
d63931a2 11051 /* Set up the frame's root window. */
333b20bb
GM		 11052 w = XWINDOW (FRAME_ROOT_WINDOW (f));
11053 w->left = w->top = make_number (0);
d63931a2
GM		 11054
11055 if (CONSP (Vx_max_tooltip_size)
11056 && INTEGERP (XCAR (Vx_max_tooltip_size))
11057 && XINT (XCAR (Vx_max_tooltip_size)) > 0
11058 && INTEGERP (XCDR (Vx_max_tooltip_size))
11059 && XINT (XCDR (Vx_max_tooltip_size)) > 0)
11060 {
11061 w->width = XCAR (Vx_max_tooltip_size);
11062 w->height = XCDR (Vx_max_tooltip_size);
11063 }
11064 else
11065 {
11066 w->width = make_number (80);
11067 w->height = make_number (40);
11068 }
11069
11070 f->window_width = XINT (w->width);
333b20bb
GM		 11071 adjust_glyphs (f);
11072 w->pseudo_window_p = 1;
11073
11074 /* Display the tooltip text in a temporary buffer. */
333b20bb 11075 old_buffer = current_buffer;
275841bf 11076 set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f))->buffer));
d63931a2 11077 current_buffer->truncate_lines = Qnil;
333b20bb
GM		 11078 clear_glyph_matrix (w->desired_matrix);
11079 clear_glyph_matrix (w->current_matrix);
11080 SET_TEXT_POS (pos, BEGV, BEGV_BYTE);
11081 try_window (FRAME_ROOT_WINDOW (f), pos);
11082
11083 /* Compute width and height of the tooltip. */
11084 width = height = 0;
11085 for (i = 0; i < w->desired_matrix->nrows; ++i)
11086 {
11087 struct glyph_row *row = &w->desired_matrix->rows[i];
11088 struct glyph *last;
11089 int row_width;
11090
11091 /* Stop at the first empty row at the end. */
11092 if (!row->enabled_p || !row->displays_text_p)
11093 break;
11094
d7bf0342
GM		 11095 /* Let the row go over the full width of the frame. */
11096 row->full_width_p = 1;
333b20bb 11097
e3130015 11098 /* There's a glyph at the end of rows that is used to place
333b20bb
GM		 11099 the cursor there. Don't include the width of this glyph. */
11100 if (row->used[TEXT_AREA])
11101 {
11102 last = &row->glyphs[TEXT_AREA][row->used[TEXT_AREA] - 1];
11103 row_width = row->pixel_width - last->pixel_width;
11104 }
11105 else
11106 row_width = row->pixel_width;
11107
11108 height += row->height;
11109 width = max (width, row_width);
11110 }
11111
11112 /* Add the frame's internal border to the width and height the X
11113 window should have. */
11114 height += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
11115 width += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
11116
11117 /* Move the tooltip window where the mouse pointer is. Resize and
11118 show it. */
ab452f99 11119 compute_tip_xy (f, parms, dx, dy, width, height, &root_x, &root_y);
0634ce98 11120
0634ce98 11121 BLOCK_INPUT;
333b20bb 11122 XMoveResizeWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
ab452f99 11123 root_x, root_y, width, height);
333b20bb
GM		 11124 XMapRaised (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f));
11125 UNBLOCK_INPUT;
06d62053 11126
333b20bb
GM		 11127 /* Draw into the window. */
11128 w->must_be_updated_p = 1;
11129 update_single_window (w, 1);
11130
11131 /* Restore original current buffer. */
11132 set_buffer_internal_1 (old_buffer);
11133 windows_or_buffers_changed = old_windows_or_buffers_changed;
11134
06d62053 11135 start_timer:
333b20bb
GM		 11136 /* Let the tip disappear after timeout seconds. */
11137 tip_timer = call3 (intern ("run-at-time"), timeout, Qnil,
11138 intern ("x-hide-tip"));
a744a2ec
DL		 11139
11140 UNGCPRO;
333b20bb
GM		 11141 return unbind_to (count, Qnil);
11142}
11143
11144
11145DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0,
7ee72033
MB		 11146 doc: /* Hide the current tooltip window, if there is any.
11147Value is t if tooltip was open, nil otherwise. */)
11148 ()
333b20bb 11149{
44b5a125 11150 int count;
c0006262
GM		 11151 Lisp_Object deleted, frame, timer;
11152 struct gcpro gcpro1, gcpro2;
44b5a125
GM		 11153
11154 /* Return quickly if nothing to do. */
c0006262 11155 if (NILP (tip_timer) && NILP (tip_frame))
44b5a125 11156 return Qnil;
333b20bb 11157
c0006262
GM		 11158 frame = tip_frame;
11159 timer = tip_timer;
11160 GCPRO2 (frame, timer);
11161 tip_frame = tip_timer = deleted = Qnil;
11162
44b5a125 11163 count = BINDING_STACK_SIZE ();
333b20bb 11164 specbind (Qinhibit_redisplay, Qt);
44b5a125 11165 specbind (Qinhibit_quit, Qt);
333b20bb 11166
c0006262 11167 if (!NILP (timer))
ae782866 11168 call1 (Qcancel_timer, timer);
333b20bb 11169
c0006262 11170 if (FRAMEP (frame))
333b20bb 11171 {
44b5a125
GM		 11172 Fdelete_frame (frame, Qnil);
11173 deleted = Qt;
f6c44811
GM		 11174
11175#ifdef USE_LUCID
11176 /* Bloodcurdling hack alert: The Lucid menu bar widget's
11177 redisplay procedure is not called when a tip frame over menu
11178 items is unmapped. Redisplay the menu manually... */
11179 {
11180 struct frame *f = SELECTED_FRAME ();
11181 Widget w = f->output_data.x->menubar_widget;
11182 extern void xlwmenu_redisplay P_ ((Widget));
9180dc8c 11183
f6c44811 11184 if (!DoesSaveUnders (FRAME_X_DISPLAY_INFO (f)->screen)
dbc64aa7 11185 && w != NULL)
f6c44811
GM		 11186 {
11187 BLOCK_INPUT;
11188 xlwmenu_redisplay (w);
11189 UNBLOCK_INPUT;
11190 }
11191 }
11192#endif /* USE_LUCID */
333b20bb
GM		 11193 }
11194
c0006262 11195 UNGCPRO;
44b5a125 11196 return unbind_to (count, deleted);
333b20bb
GM		 11197}
11198
11199
11200\f
11201/***********************************************************************
11202 File selection dialog
11203 ***********************************************************************/
11204
11205#ifdef USE_MOTIF
11206
11207/* Callback for "OK" and "Cancel" on file selection dialog. */
11208
11209static void
11210file_dialog_cb (widget, client_data, call_data)
11211 Widget widget;
11212 XtPointer call_data, client_data;
11213{
11214 int *result = (int *) client_data;
11215 XmAnyCallbackStruct *cb = (XmAnyCallbackStruct *) call_data;
11216 *result = cb->reason;
11217}
11218
11219
a779d213
GM		 11220/* Callback for unmapping a file selection dialog. This is used to
11221 capture the case where a dialog is closed via a window manager's
11222 closer button, for example. Using a XmNdestroyCallback didn't work
11223 in this case. */
11224
11225static void
11226file_dialog_unmap_cb (widget, client_data, call_data)
11227 Widget widget;
11228 XtPointer call_data, client_data;
11229{
11230 int *result = (int *) client_data;
11231 *result = XmCR_CANCEL;
11232}
11233
11234
333b20bb 11235DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 4, 0,
7ee72033 11236 doc: /* Read file name, prompting with PROMPT in directory DIR.
c061c855
GM		 11237Use a file selection dialog.
11238Select DEFAULT-FILENAME in the dialog's file selection box, if
11239specified. Don't let the user enter a file name in the file
7ee72033
MB		 11240selection dialog's entry field, if MUSTMATCH is non-nil. */)
11241 (prompt, dir, default_filename, mustmatch)
333b20bb
GM		 11242 Lisp_Object prompt, dir, default_filename, mustmatch;
11243{
11244 int result;
0fe92f72 11245 struct frame *f = SELECTED_FRAME ();
333b20bb
GM		 11246 Lisp_Object file = Qnil;
11247 Widget dialog, text, list, help;
11248 Arg al[10];
11249 int ac = 0;
11250 extern XtAppContext Xt_app_con;
333b20bb 11251 XmString dir_xmstring, pattern_xmstring;
333b20bb
GM		 11252 int count = specpdl_ptr - specpdl;
11253 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
11254
11255 GCPRO5 (prompt, dir, default_filename, mustmatch, file);
11256 CHECK_STRING (prompt, 0);
11257 CHECK_STRING (dir, 1);
11258
11259 /* Prevent redisplay. */
11260 specbind (Qinhibit_redisplay, Qt);
11261
11262 BLOCK_INPUT;
11263
11264 /* Create the dialog with PROMPT as title, using DIR as initial
11265 directory and using "*" as pattern. */
11266 dir = Fexpand_file_name (dir, Qnil);
11267 dir_xmstring = XmStringCreateLocalized (XSTRING (dir)->data);
11268 pattern_xmstring = XmStringCreateLocalized ("*");
11269
11270 XtSetArg (al[ac], XmNtitle, XSTRING (prompt)->data); ++ac;
11271 XtSetArg (al[ac], XmNdirectory, dir_xmstring); ++ac;
11272 XtSetArg (al[ac], XmNpattern, pattern_xmstring); ++ac;
11273 XtSetArg (al[ac], XmNresizePolicy, XmRESIZE_GROW); ++ac;
11274 XtSetArg (al[ac], XmNdialogStyle, XmDIALOG_APPLICATION_MODAL); ++ac;
11275 dialog = XmCreateFileSelectionDialog (f->output_data.x->widget,
11276 "fsb", al, ac);
11277 XmStringFree (dir_xmstring);
11278 XmStringFree (pattern_xmstring);
11279
11280 /* Add callbacks for OK and Cancel. */
11281 XtAddCallback (dialog, XmNokCallback, file_dialog_cb,
11282 (XtPointer) &result);
11283 XtAddCallback (dialog, XmNcancelCallback, file_dialog_cb,
11284 (XtPointer) &result);
a779d213
GM		 11285 XtAddCallback (dialog, XmNunmapCallback, file_dialog_unmap_cb,
11286 (XtPointer) &result);
333b20bb
GM		 11287
11288 /* Disable the help button since we can't display help. */
11289 help = XmFileSelectionBoxGetChild (dialog, XmDIALOG_HELP_BUTTON);
11290 XtSetSensitive (help, False);
11291
11292 /* Mark OK button as default. */
11293 XtVaSetValues (XmFileSelectionBoxGetChild (dialog, XmDIALOG_OK_BUTTON),
11294 XmNshowAsDefault, True, NULL);
11295
11296 /* If MUSTMATCH is non-nil, disable the file entry field of the
11297 dialog, so that the user must select a file from the files list
11298 box. We can't remove it because we wouldn't have a way to get at
11299 the result file name, then. */
11300 text = XmFileSelectionBoxGetChild (dialog, XmDIALOG_TEXT);
11301 if (!NILP (mustmatch))
11302 {
11303 Widget label;
11304 label = XmFileSelectionBoxGetChild (dialog, XmDIALOG_SELECTION_LABEL);
11305 XtSetSensitive (text, False);
11306 XtSetSensitive (label, False);
11307 }
11308
11309 /* Manage the dialog, so that list boxes get filled. */
11310 XtManageChild (dialog);
11311
11312 /* Select DEFAULT_FILENAME in the files list box. DEFAULT_FILENAME
11313 must include the path for this to work. */
11314 list = XmFileSelectionBoxGetChild (dialog, XmDIALOG_LIST);
11315 if (STRINGP (default_filename))
11316 {
11317 XmString default_xmstring;
11318 int item_pos;
11319
11320 default_xmstring
11321 = XmStringCreateLocalized (XSTRING (default_filename)->data);
11322
11323 if (!XmListItemExists (list, default_xmstring))
11324 {
11325 /* Add a new item if DEFAULT_FILENAME is not in the list. */
11326 XmListAddItem (list, default_xmstring, 0);
11327 item_pos = 0;
11328 }
11329 else
11330 item_pos = XmListItemPos (list, default_xmstring);
11331 XmStringFree (default_xmstring);
11332
11333 /* Select the item and scroll it into view. */
11334 XmListSelectPos (list, item_pos, True);
11335 XmListSetPos (list, item_pos);
11336 }
11337
563b384d
GM		 11338 /* Process events until the user presses Cancel or OK. Block
11339 and unblock input here so that we get a chance of processing
11340 expose events. */
11341 UNBLOCK_INPUT;
03100098 11342 result = 0;
a779d213 11343 while (result == 0)
563b384d
GM		 11344 {
11345 BLOCK_INPUT;
11346 XtAppProcessEvent (Xt_app_con, XtIMAll);
11347 UNBLOCK_INPUT;
11348 }
11349 BLOCK_INPUT;
03100098 11350
333b20bb
GM		 11351 /* Get the result. */
11352 if (result == XmCR_OK)
11353 {
11354 XmString text;
11355 String data;
11356
d1670063 11357 XtVaGetValues (dialog, XmNtextString, &text, NULL);
333b20bb
GM		 11358 XmStringGetLtoR (text, XmFONTLIST_DEFAULT_TAG, &data);
11359 XmStringFree (text);
11360 file = build_string (data);
11361 XtFree (data);
11362 }
11363 else
11364 file = Qnil;
11365
11366 /* Clean up. */
11367 XtUnmanageChild (dialog);
11368 XtDestroyWidget (dialog);
11369 UNBLOCK_INPUT;
11370 UNGCPRO;
11371
11372 /* Make "Cancel" equivalent to C-g. */
11373 if (NILP (file))
11374 Fsignal (Qquit, Qnil);
11375
11376 return unbind_to (count, file);
11377}
11378
11379#endif /* USE_MOTIF */
11380
333b20bb
GM		 11381
11382\f
82bab41c
GM		 11383/***********************************************************************
11384 Keyboard
11385 ***********************************************************************/
11386
11387#ifdef HAVE_XKBGETKEYBOARD
11388#include <X11/XKBlib.h>
11389#include <X11/keysym.h>
11390#endif
11391
11392DEFUN ("x-backspace-delete-keys-p", Fx_backspace_delete_keys_p,
11393 Sx_backspace_delete_keys_p, 0, 1, 0,
7ee72033 11394 doc: /* Check if both Backspace and Delete keys are on the keyboard of FRAME.
c061c855
GM		 11395FRAME nil means use the selected frame.
11396Value is t if we know that both keys are present, and are mapped to the
7ee72033
MB		 11397usual X keysyms. */)
11398 (frame)
82bab41c
GM		 11399 Lisp_Object frame;
11400{
11401#ifdef HAVE_XKBGETKEYBOARD
11402 XkbDescPtr kb;
11403 struct frame *f = check_x_frame (frame);
11404 Display *dpy = FRAME_X_DISPLAY (f);
11405 Lisp_Object have_keys;
46f6a258 11406 int major, minor, op, event, error;
82bab41c
GM		 11407
11408 BLOCK_INPUT;
46f6a258
GM		 11409
11410 /* Check library version in case we're dynamically linked. */
11411 major = XkbMajorVersion;
11412 minor = XkbMinorVersion;
11413 if (!XkbLibraryVersion (&major, &minor))
c1efd260
GM		 11414 {
11415 UNBLOCK_INPUT;
11416 return Qnil;
11417 }
46f6a258
GM		 11418
11419 /* Check that the server supports XKB. */
11420 major = XkbMajorVersion;
11421 minor = XkbMinorVersion;
11422 if (!XkbQueryExtension (dpy, &op, &event, &error, &major, &minor))
c1efd260
GM		 11423 {
11424 UNBLOCK_INPUT;
11425 return Qnil;
11426 }
46f6a258
GM		 11427
11428 have_keys = Qnil;
c1efd260 11429 kb = XkbGetMap (dpy, XkbAllMapComponentsMask, XkbUseCoreKbd);
82bab41c
GM		 11430 if (kb)
11431 {
11432 int delete_keycode = 0, backspace_keycode = 0, i;
c1efd260
GM		 11433
11434 if (XkbGetNames (dpy, XkbAllNamesMask, kb) == Success)
82bab41c 11435 {
c1efd260
GM		 11436 for (i = kb->min_key_code;
11437 (i < kb->max_key_code
11438 && (delete_keycode == 0 || backspace_keycode == 0));
11439 ++i)
11440 {
d63931a2
GM		 11441 /* The XKB symbolic key names can be seen most easily in
11442 the PS file generated by `xkbprint -label name
11443 $DISPLAY'. */
c1efd260
GM		 11444 if (bcmp ("DELE", kb->names->keys[i].name, 4) == 0)
11445 delete_keycode = i;
11446 else if (bcmp ("BKSP", kb->names->keys[i].name, 4) == 0)
11447 backspace_keycode = i;
11448 }
11449
11450 XkbFreeNames (kb, 0, True);
82bab41c
GM		 11451 }
11452
c1efd260 11453 XkbFreeClientMap (kb, 0, True);
82bab41c
GM		 11454
11455 if (delete_keycode
11456 && backspace_keycode
11457 && XKeysymToKeycode (dpy, XK_Delete) == delete_keycode
11458 && XKeysymToKeycode (dpy, XK_BackSpace) == backspace_keycode)
11459 have_keys = Qt;
11460 }
11461 UNBLOCK_INPUT;
11462 return have_keys;
11463#else /* not HAVE_XKBGETKEYBOARD */
11464 return Qnil;
11465#endif /* not HAVE_XKBGETKEYBOARD */
11466}
11467
11468
11469\f
333b20bb
GM		 11470/***********************************************************************
11471 Initialization
11472 ***********************************************************************/
11473
11474void
11475syms_of_xfns ()
11476{
11477 /* This is zero if not using X windows. */
11478 x_in_use = 0;
11479
11480 /* The section below is built by the lisp expression at the top of the file,
11481 just above where these variables are declared. */
11482 /*&&& init symbols here &&&*/
11483 Qauto_raise = intern ("auto-raise");
11484 staticpro (&Qauto_raise);
11485 Qauto_lower = intern ("auto-lower");
11486 staticpro (&Qauto_lower);
11487 Qbar = intern ("bar");
dbc4e1c1 11488 staticpro (&Qbar);
f9942c9e
JB		 11489 Qborder_color = intern ("border-color");
11490 staticpro (&Qborder_color);
11491 Qborder_width = intern ("border-width");
11492 staticpro (&Qborder_width);
dbc4e1c1
JB		 11493 Qbox = intern ("box");
11494 staticpro (&Qbox);
f9942c9e
JB		 11495 Qcursor_color = intern ("cursor-color");
11496 staticpro (&Qcursor_color);
dbc4e1c1
JB		 11497 Qcursor_type = intern ("cursor-type");
11498 staticpro (&Qcursor_type);
f9942c9e
JB		 11499 Qgeometry = intern ("geometry");
11500 staticpro (&Qgeometry);
f9942c9e
JB		 11501 Qicon_left = intern ("icon-left");
11502 staticpro (&Qicon_left);
11503 Qicon_top = intern ("icon-top");
11504 staticpro (&Qicon_top);
11505 Qicon_type = intern ("icon-type");
11506 staticpro (&Qicon_type);
80534dd6
KH		 11507 Qicon_name = intern ("icon-name");
11508 staticpro (&Qicon_name);
f9942c9e
JB		 11509 Qinternal_border_width = intern ("internal-border-width");
11510 staticpro (&Qinternal_border_width);
11511 Qleft = intern ("left");
11512 staticpro (&Qleft);
1ab3d87e
RS		 11513 Qright = intern ("right");
11514 staticpro (&Qright);
f9942c9e
JB		 11515 Qmouse_color = intern ("mouse-color");
11516 staticpro (&Qmouse_color);
baaed68e
JB		 11517 Qnone = intern ("none");
11518 staticpro (&Qnone);
f9942c9e
JB		 11519 Qparent_id = intern ("parent-id");
11520 staticpro (&Qparent_id);
4701395c
KH		 11521 Qscroll_bar_width = intern ("scroll-bar-width");
11522 staticpro (&Qscroll_bar_width);
8af1d7ca
JB		 11523 Qsuppress_icon = intern ("suppress-icon");
11524 staticpro (&Qsuppress_icon);
01f1ba30 11525 Qundefined_color = intern ("undefined-color");
f9942c9e 11526 staticpro (&Qundefined_color);
a3c87d4e
JB		 11527 Qvertical_scroll_bars = intern ("vertical-scroll-bars");
11528 staticpro (&Qvertical_scroll_bars);
49795535
JB		 11529 Qvisibility = intern ("visibility");
11530 staticpro (&Qvisibility);
f9942c9e
JB		 11531 Qwindow_id = intern ("window-id");
11532 staticpro (&Qwindow_id);
2cbebefb
RS		 11533 Qouter_window_id = intern ("outer-window-id");
11534 staticpro (&Qouter_window_id);
f9942c9e
JB		 11535 Qx_frame_parameter = intern ("x-frame-parameter");
11536 staticpro (&Qx_frame_parameter);
9ef48a9d
RS		 11537 Qx_resource_name = intern ("x-resource-name");
11538 staticpro (&Qx_resource_name);
4fe1de12
RS		 11539 Quser_position = intern ("user-position");
11540 staticpro (&Quser_position);
11541 Quser_size = intern ("user-size");
11542 staticpro (&Quser_size);
333b20bb
GM		 11543 Qscroll_bar_foreground = intern ("scroll-bar-foreground");
11544 staticpro (&Qscroll_bar_foreground);
11545 Qscroll_bar_background = intern ("scroll-bar-background");
11546 staticpro (&Qscroll_bar_background);
d62c8769
GM		 11547 Qscreen_gamma = intern ("screen-gamma");
11548 staticpro (&Qscreen_gamma);
563b67aa
GM		 11549 Qline_spacing = intern ("line-spacing");
11550 staticpro (&Qline_spacing);
7c7ff7f5
GM		 11551 Qcenter = intern ("center");
11552 staticpro (&Qcenter);
96db09e4
KH		 11553 Qcompound_text = intern ("compound-text");
11554 staticpro (&Qcompound_text);
ae782866
GM		 11555 Qcancel_timer = intern ("cancel-timer");
11556 staticpro (&Qcancel_timer);
ea0a1f53
GM		 11557 Qwait_for_wm = intern ("wait-for-wm");
11558 staticpro (&Qwait_for_wm);
f9942c9e
JB		 11559 /* This is the end of symbol initialization. */
11560
58cad5ed
KH		 11561 /* Text property `display' should be nonsticky by default. */
11562 Vtext_property_default_nonsticky
11563 = Fcons (Fcons (Qdisplay, Qt), Vtext_property_default_nonsticky);
11564
11565
333b20bb
GM		 11566 Qlaplace = intern ("laplace");
11567 staticpro (&Qlaplace);
4a8e312c
GM		 11568 Qemboss = intern ("emboss");
11569 staticpro (&Qemboss);
11570 Qedge_detection = intern ("edge-detection");
11571 staticpro (&Qedge_detection);
11572 Qheuristic = intern ("heuristic");
11573 staticpro (&Qheuristic);
11574 QCmatrix = intern (":matrix");
11575 staticpro (&QCmatrix);
11576 QCcolor_adjustment = intern (":color-adjustment");
11577 staticpro (&QCcolor_adjustment);
11578 QCmask = intern (":mask");
11579 staticpro (&QCmask);
11580
a367641f
RS		 11581 Qface_set_after_frame_default = intern ("face-set-after-frame-default");
11582 staticpro (&Qface_set_after_frame_default);
11583
01f1ba30
JB		 11584 Fput (Qundefined_color, Qerror_conditions,
11585 Fcons (Qundefined_color, Fcons (Qerror, Qnil)));
11586 Fput (Qundefined_color, Qerror_message,
11587 build_string ("Undefined color"));
11588
f9942c9e
JB		 11589 init_x_parm_symbols ();
11590
7ee72033
MB		 11591 DEFVAR_BOOL ("cross-disabled-images", &cross_disabled_images,
11592 doc: /* Non-nil means always draw a cross over disabled images.
c061c855
GM		 11593Disabled images are those having an `:conversion disabled' property.
11594A cross is always drawn on black & white displays. */);
14819cb3
GM		 11595 cross_disabled_images = 0;
11596
7ee72033
MB		 11597 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path,
11598 doc: /* List of directories to search for bitmap files for X. */);
e241c09b 11599 Vx_bitmap_file_path = decode_env_path ((char *) 0, PATH_BITMAPS);
f1c7b5a6 11600
7ee72033
MB		 11601 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape,
11602 doc: /* The shape of the pointer when over text.
c061c855
GM		 11603Changing the value does not affect existing frames
11604unless you set the mouse color. */);
01f1ba30
JB		 11605 Vx_pointer_shape = Qnil;
11606
7ee72033
MB		 11607 DEFVAR_LISP ("x-resource-name", &Vx_resource_name,
11608 doc: /* The name Emacs uses to look up X resources.
c061c855
GM		 11609`x-get-resource' uses this as the first component of the instance name
11610when requesting resource values.
11611Emacs initially sets `x-resource-name' to the name under which Emacs
11612was invoked, or to the value specified with the `-name' or `-rn'
11613switches, if present.
11614
11615It may be useful to bind this variable locally around a call
11616to `x-get-resource'. See also the variable `x-resource-class'. */);
d387c960 11617 Vx_resource_name = Qnil;
ac63d3d6 11618
7ee72033
MB		 11619 DEFVAR_LISP ("x-resource-class", &Vx_resource_class,
11620 doc: /* The class Emacs uses to look up X resources.
c061c855
GM		 11621`x-get-resource' uses this as the first component of the instance class
11622when requesting resource values.
11623
11624Emacs initially sets `x-resource-class' to "Emacs".
11625
11626Setting this variable permanently is not a reasonable thing to do,
11627but binding this variable locally around a call to `x-get-resource'
11628is a reasonable practice. See also the variable `x-resource-name'. */);
498e9ac3
RS		 11629 Vx_resource_class = build_string (EMACS_CLASS);
11630
ca0ecbf5 11631#if 0 /* This doesn't really do anything. */
7ee72033
MB		 11632 DEFVAR_LISP ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape,
11633 doc: /* The shape of the pointer when not over text.
c061c855
GM		 11634This variable takes effect when you create a new frame
11635or when you set the mouse color. */);
af01ef26 11636#endif
01f1ba30
JB		 11637 Vx_nontext_pointer_shape = Qnil;
11638
7ee72033
MB		 11639 DEFVAR_LISP ("x-hourglass-pointer-shape", &Vx_hourglass_pointer_shape,
11640 doc: /* The shape of the pointer when Emacs is busy.
c061c855
GM		 11641This variable takes effect when you create a new frame
11642or when you set the mouse color. */);
0af913d7 11643 Vx_hourglass_pointer_shape = Qnil;
333b20bb 11644
7ee72033
MB		 11645 DEFVAR_BOOL ("display-hourglass", &display_hourglass_p,
11646 doc: /* Non-zero means Emacs displays an hourglass pointer on window systems. */);
0af913d7 11647 display_hourglass_p = 1;
333b20bb 11648
7ee72033
MB		 11649 DEFVAR_LISP ("hourglass-delay", &Vhourglass_delay,
11650 doc: /* *Seconds to wait before displaying an hourglass pointer.
c061c855 11651Value must be an integer or float. */);
0af913d7 11652 Vhourglass_delay = make_number (DEFAULT_HOURGLASS_DELAY);
4ae9a85e 11653
ca0ecbf5 11654#if 0 /* This doesn't really do anything. */
7ee72033
MB		 11655 DEFVAR_LISP ("x-mode-pointer-shape", &Vx_mode_pointer_shape,
11656 doc: /* The shape of the pointer when over the mode line.
c061c855
GM		 11657This variable takes effect when you create a new frame
11658or when you set the mouse color. */);
af01ef26 11659#endif
01f1ba30
JB		 11660 Vx_mode_pointer_shape = Qnil;
11661
d3b06468 11662 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
7ee72033
MB		 11663 &Vx_sensitive_text_pointer_shape,
11664 doc: /* The shape of the pointer when over mouse-sensitive text.
c061c855
GM		 11665This variable takes effect when you create a new frame
11666or when you set the mouse color. */);
ca0ecbf5 11667 Vx_sensitive_text_pointer_shape = Qnil;
95f80c78 11668
8fb4ec9c 11669 DEFVAR_LISP ("x-window-horizontal-drag-cursor",
7ee72033
MB		 11670 &Vx_window_horizontal_drag_shape,
11671 doc: /* Pointer shape to use for indicating a window can be dragged horizontally.
c061c855
GM		 11672This variable takes effect when you create a new frame
11673or when you set the mouse color. */);
8fb4ec9c
GM		 11674 Vx_window_horizontal_drag_shape = Qnil;
11675
7ee72033
MB		 11676 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel,
11677 doc: /* A string indicating the foreground color of the cursor box. */);
01f1ba30
JB		 11678 Vx_cursor_fore_pixel = Qnil;
11679
7ee72033
MB		 11680 DEFVAR_LISP ("x-max-tooltip-size", &Vx_max_tooltip_size,
11681 doc: /* Maximum size for tooltips. Value is a pair (COLUMNS . ROWS).
c061c855 11682Text larger than this is clipped. */);
d63931a2
GM		 11683 Vx_max_tooltip_size = Fcons (make_number (80), make_number (40));
11684
7ee72033
MB		 11685 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager,
11686 doc: /* Non-nil if no X window manager is in use.
c061c855
GM		 11687Emacs doesn't try to figure this out; this is always nil
11688unless you set it to something else. */);
2d38195d
RS		 11689 /* We don't have any way to find this out, so set it to nil
11690 and maybe the user would like to set it to t. */
11691 Vx_no_window_manager = Qnil;
1d3dac41 11692
942ea06d 11693 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
7ee72033
MB		 11694 &Vx_pixel_size_width_font_regexp,
11695 doc: /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'.
c061c855
GM		 11696
11697Since Emacs gets width of a font matching with this regexp from
11698PIXEL_SIZE field of the name, font finding mechanism gets faster for
11699such a font. This is especially effective for such large fonts as
11700Chinese, Japanese, and Korean. */);
942ea06d
KH		 11701 Vx_pixel_size_width_font_regexp = Qnil;
11702
7ee72033
MB		 11703 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay,
11704 doc: /* Time after which cached images are removed from the cache.
c061c855
GM		 11705When an image has not been displayed this many seconds, remove it
11706from the image cache. Value must be an integer or nil with nil
11707meaning don't clear the cache. */);
fcf431dc 11708 Vimage_cache_eviction_delay = make_number (30 * 60);
333b20bb 11709
1d3dac41 11710#ifdef USE_X_TOOLKIT
6f3f6a8d 11711 Fprovide (intern ("x-toolkit"), Qnil);
5b827abb 11712#ifdef USE_MOTIF
6f3f6a8d 11713 Fprovide (intern ("motif"), Qnil);
fc2cdd9a 11714
7ee72033
MB		 11715 DEFVAR_LISP ("motif-version-string", &Vmotif_version_string,
11716 doc: /* Version info for LessTif/Motif. */);
fc2cdd9a
GM		 11717 Vmotif_version_string = build_string (XmVERSION_STRING);
11718#endif /* USE_MOTIF */
11719#endif /* USE_X_TOOLKIT */
01f1ba30 11720
01f1ba30 11721 defsubr (&Sx_get_resource);
333b20bb
GM		 11722
11723 /* X window properties. */
11724 defsubr (&Sx_change_window_property);
11725 defsubr (&Sx_delete_window_property);
11726 defsubr (&Sx_window_property);
11727
2d764c78 11728 defsubr (&Sxw_display_color_p);
d0c9d219 11729 defsubr (&Sx_display_grayscale_p);
2d764c78
EZ		 11730 defsubr (&Sxw_color_defined_p);
11731 defsubr (&Sxw_color_values);
9d317b2c 11732 defsubr (&Sx_server_max_request_size);
41beb8fc
RS		 11733 defsubr (&Sx_server_vendor);
11734 defsubr (&Sx_server_version);
11735 defsubr (&Sx_display_pixel_width);
11736 defsubr (&Sx_display_pixel_height);
11737 defsubr (&Sx_display_mm_width);
11738 defsubr (&Sx_display_mm_height);
11739 defsubr (&Sx_display_screens);
11740 defsubr (&Sx_display_planes);
11741 defsubr (&Sx_display_color_cells);
11742 defsubr (&Sx_display_visual_class);
11743 defsubr (&Sx_display_backing_store);
11744 defsubr (&Sx_display_save_under);
8af1d7ca 11745 defsubr (&Sx_parse_geometry);
f676886a 11746 defsubr (&Sx_create_frame);
01f1ba30 11747 defsubr (&Sx_open_connection);
08a90d6a
RS		 11748 defsubr (&Sx_close_connection);
11749 defsubr (&Sx_display_list);
01f1ba30 11750 defsubr (&Sx_synchronize);
3decc1e7 11751 defsubr (&Sx_focus_frame);
82bab41c
GM		 11752 defsubr (&Sx_backspace_delete_keys_p);
11753
942ea06d
KH		 11754 /* Setting callback functions for fontset handler. */
11755 get_font_info_func = x_get_font_info;
333b20bb
GM		 11756
11757#if 0 /* This function pointer doesn't seem to be used anywhere.
11758 And the pointer assigned has the wrong type, anyway. */
942ea06d 11759 list_fonts_func = x_list_fonts;
333b20bb
GM		 11760#endif
11761
942ea06d 11762 load_font_func = x_load_font;
bc1958c4 11763 find_ccl_program_func = x_find_ccl_program;
942ea06d
KH		 11764 query_font_func = x_query_font;
11765 set_frame_fontset_func = x_set_font;
11766 check_window_system_func = check_x;
333b20bb
GM		 11767
11768 /* Images. */
11769 Qxbm = intern ("xbm");
11770 staticpro (&Qxbm);
11771 QCtype = intern (":type");
11772 staticpro (&QCtype);
d2dc8167
GM		 11773 QCconversion = intern (":conversion");
11774 staticpro (&QCconversion);
333b20bb
GM		 11775 QCheuristic_mask = intern (":heuristic-mask");
11776 staticpro (&QCheuristic_mask);
11777 QCcolor_symbols = intern (":color-symbols");
11778 staticpro (&QCcolor_symbols);
333b20bb
GM		 11779 QCascent = intern (":ascent");
11780 staticpro (&QCascent);
11781 QCmargin = intern (":margin");
11782 staticpro (&QCmargin);
11783 QCrelief = intern (":relief");
11784 staticpro (&QCrelief);
fcf431dc
GM		 11785 Qpostscript = intern ("postscript");
11786 staticpro (&Qpostscript);
333b20bb
GM		 11787 QCloader = intern (":loader");
11788 staticpro (&QCloader);
11789 QCbounding_box = intern (":bounding-box");
11790 staticpro (&QCbounding_box);
11791 QCpt_width = intern (":pt-width");
11792 staticpro (&QCpt_width);
11793 QCpt_height = intern (":pt-height");
11794 staticpro (&QCpt_height);
3ccff1e3
GM		 11795 QCindex = intern (":index");
11796 staticpro (&QCindex);
333b20bb
GM		 11797 Qpbm = intern ("pbm");
11798 staticpro (&Qpbm);
11799
11800#if HAVE_XPM
11801 Qxpm = intern ("xpm");
11802 staticpro (&Qxpm);
11803#endif
11804
11805#if HAVE_JPEG
11806 Qjpeg = intern ("jpeg");
11807 staticpro (&Qjpeg);
11808#endif
11809
11810#if HAVE_TIFF
11811 Qtiff = intern ("tiff");
11812 staticpro (&Qtiff);
11813#endif
11814
11815#if HAVE_GIF
11816 Qgif = intern ("gif");
11817 staticpro (&Qgif);
11818#endif
11819
11820#if HAVE_PNG
11821 Qpng = intern ("png");
11822 staticpro (&Qpng);
11823#endif
11824
11825 defsubr (&Sclear_image_cache);
42677916 11826 defsubr (&Simage_size);
b243755a 11827 defsubr (&Simage_mask_p);
333b20bb 11828
0af913d7
GM		 11829 hourglass_atimer = NULL;
11830 hourglass_shown_p = 0;
333b20bb
GM		 11831
11832 defsubr (&Sx_show_tip);
11833 defsubr (&Sx_hide_tip);
333b20bb 11834 tip_timer = Qnil;
44b5a125
GM		 11835 staticpro (&tip_timer);
11836 tip_frame = Qnil;
11837 staticpro (&tip_frame);
333b20bb 11838
06d62053
GM		 11839 last_show_tip_args = Qnil;
11840 staticpro (&last_show_tip_args);
11841
333b20bb
GM		 11842#ifdef USE_MOTIF
11843 defsubr (&Sx_file_dialog);
11844#endif
11845}
11846
11847
11848void
11849init_xfns ()
11850{
11851 image_types = NULL;
11852 Vimage_types = Qnil;
11853
11854 define_image_type (&xbm_type);
11855 define_image_type (&gs_type);
11856 define_image_type (&pbm_type);
11857
11858#if HAVE_XPM
11859 define_image_type (&xpm_type);
11860#endif
11861
11862#if HAVE_JPEG
11863 define_image_type (&jpeg_type);
11864#endif
11865
11866#if HAVE_TIFF
11867 define_image_type (&tiff_type);
11868#endif
11869
11870#if HAVE_GIF
11871 define_image_type (&gif_type);
11872#endif
11873
11874#if HAVE_PNG
11875 define_image_type (&png_type);
11876#endif
01f1ba30
JB		 11877}
11878
11879#endif /* HAVE_X_WINDOWS */
Unnamed repository; edit this file 'description' to name the repository.