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