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