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